View | Details | Raw Unified | Return to bug 39206
Collapse All | Expand All

(-)a/Koha/CookieManager.pm (-41 / +89 lines)
Lines 25-31 use CGI::Cookie; Link Here
25
25
26
use C4::Context;
26
use C4::Context;
27
27
28
use constant DENY_LIST_VAR => 'do_not_remove_cookie';
28
# The cookies on the following list are removed unless koha-conf.xml indicates otherwise.
29
# koha-conf.xml may also contain additional cookies to be removed.
30
# Not including here: always_show_holds, catalogue_editor_, issues-table-load-immediately-circulation,
31
# and ItemEditorSessionTemplateId.
32
# TODO Not sure about branch (rotatingcollections), patronSessionConfirmation (circulation.pl)
33
use constant MANAGED_COOKIE_PREFIXES => qw{
34
    bib_list
35
    CGISESSID
36
    holdfor holdforclub
37
    intranet_bib_list
38
    JWT
39
    KohaOpacLanguage
40
    LastCreatedItem
41
    marctagstructure_selectdisplay
42
    search_path_code
43
    searchToOrder
44
};
45
use constant PATH_EXCEPTIONS => {
46
    always_show_holds => '/cgi-bin/koha/reserve',
47
};
48
use constant KEEP_COOKIE_CONF_VAR   => 'do_not_remove_cookie';
49
use constant REMOVE_COOKIE_CONF_VAR => 'remove_cookie';
29
50
30
our $cookies;
51
our $cookies;
31
52
Lines 41-58 Koha::CookieManager - Object for unified handling of cookies in Koha Link Here
41
    # Replace cookies
62
    # Replace cookies
42
    $cookie_list = $mgr->replace_in_list( [ $cookie1, $cookie2_old ], $cookie2_new );
63
    $cookie_list = $mgr->replace_in_list( [ $cookie1, $cookie2_old ], $cookie2_new );
43
64
44
    # Clear cookies (governed by deny list entries in koha-conf)
65
    # Clear cookies
45
    $cookie_list = $mgr->clear_unless( $cookie1, $cookie2, $cookie3_name );
66
    $cookie_list = $mgr->clear_unless( $cookie1, $cookie2, $cookie3_name );
46
67
47
=head1 DESCRIPTION
68
=head1 DESCRIPTION
48
69
49
The current object allows you to clear cookies in a list based on the deny list
70
The current object allows you to remove cookies on the hardcoded list
50
in koha-conf.xml. It also offers a method to replace the old version of a cookie
71
in this module, refined by 'keep' or 'remove' entries in koha-conf.xml.
72
Note that a keep entry overrules a remove.
73
74
This module also offers a method to replace the old version of a cookie
51
by a new one.
75
by a new one.
52
76
53
It could be extended by (gradually) routing cookie creation through it in order
77
The module could be extended by (gradually) routing cookie creation
54
to consistently fill cookie parameters like httponly, secure and samesite flag,
78
through it in order to consistently fill cookie parameters like httponly,
55
etc. And could serve to register all our cookies in a central location.
79
secure and samesite flag, etc. And could serve to register all our cookies
80
in a central location.
56
81
57
=head1 METHODS
82
=head1 METHODS
58
83
Lines 64-74 etc. And could serve to register all our cookies in a central location. Link Here
64
89
65
sub new {
90
sub new {
66
    my ( $class, $params ) = @_;
91
    my ( $class, $params ) = @_;
67
    my $self   = bless $params // {}, $class;
92
    my $self = bless $params // {}, $class;
68
    my $denied = C4::Context->config(DENY_LIST_VAR) || [];    # expecting scalar or arrayref
93
69
    $denied                 = [$denied] if ref($denied) eq q{};
94
    # Get keep and remove list from koha-conf (scalar or arrayref)
70
    $self->{_remove_unless} = { map { $_ => 1 } @$denied };
95
    my $keep_list = C4::Context->config(KEEP_COOKIE_CONF_VAR) || [];
71
    $self->{_secure}        = C4::Context->https_enabled;
96
    $self->{_keep_list} = ref($keep_list) ? $keep_list : [$keep_list];
97
    my $remove_list = C4::Context->config(REMOVE_COOKIE_CONF_VAR) || [];
98
    $self->{_remove_list} = ref($remove_list) ? $remove_list : [$remove_list];
99
100
    $self->{_secure} = C4::Context->https_enabled;
72
    return $self;
101
    return $self;
73
}
102
}
74
103
Lines 80-88 sub new { Link Here
80
    Note: in the example above $query->cookie is a list of cookie names as returned
109
    Note: in the example above $query->cookie is a list of cookie names as returned
81
    by the CGI object.
110
    by the CGI object.
82
111
83
    Returns an arrayref of cookie objects: empty, expired cookies for those passed
112
    Returns an arrayref of cookie objects: empty, expired cookies for
84
    by name or objects that are not on the deny list, together with the remaining
113
    cookies on the remove list, together with the remaining (untouched)
85
    (untouched) cookie objects that are on the deny list.
114
    cookie objects.
86
115
87
=cut
116
=cut
88
117
Lines 102-118 sub clear_unless { Link Here
102
        }
131
        }
103
        next if !$name;
132
        next if !$name;
104
133
105
        if ( $self->_should_be_cleared($name) ) {
134
        if ( $self->_should_be_removed($name) ) {
106
            next if $seen->{$name};
135
            next if $seen->{$name};
107
            push @rv, CGI::Cookie->new(
108
109
                # -expires explicitly omitted to create shortlived 'session' cookie
110
                # -HttpOnly explicitly set to 0: not really needed here for the
111
                # cleared httponly cookies, while the js cookies should be 0
112
                -name => $name, -value => q{}, -HttpOnly => 0,
113
                $self->{_secure} ? ( -secure => 1 ) : (),
114
            );
115
            $seen->{$name} = 1;    # prevent duplicates
136
            $seen->{$name} = 1;    # prevent duplicates
137
            if ($type) {
138
                $c->max_age(0);
139
                push @rv, _correct_path($c);
140
            } else {
141
                push @rv, _correct_path( CGI::Cookie->new( -name => $name, -value => q{}, '-max-age' => 0 ) );
142
            }
116
        } elsif ( $type eq 'CGI::Cookie' ) {    # keep the last occurrence
143
        } elsif ( $type eq 'CGI::Cookie' ) {    # keep the last occurrence
117
            @rv = @{ $self->replace_in_list( \@rv, $c ) };
144
            @rv = @{ $self->replace_in_list( \@rv, $c ) };
118
        }
145
        }
Lines 120-141 sub clear_unless { Link Here
120
    return \@rv;
147
    return \@rv;
121
}
148
}
122
149
123
sub _should_be_cleared {    # when it is not on the deny list in koha-conf
124
    my ( $self, $name ) = @_;
125
126
    return if $self->{_remove_unless}->{$name};    # exact match
127
128
    # Now try the entries as regex
129
    foreach my $k ( keys %{ $self->{_remove_unless} } ) {
130
        my $reg = $self->{_remove_unless}->{$k};
131
132
        # The entry in koha-conf should match the complete string
133
        # So adding a ^ and $
134
        return if $name =~ qr/^${k}$/;
135
    }
136
    return 1;
137
}
138
139
=head2 replace_in_list
150
=head2 replace_in_list
140
151
141
    $list2 = $mgr->replace_in_list( $list1, $cookie );
152
    $list2 = $mgr->replace_in_list( $list1, $cookie );
Lines 162-168 sub replace_in_list { Link Here
162
    return \@result;
173
    return \@result;
163
}
174
}
164
175
165
=head1 INTERNAL ROUTINES
176
# INTERNAL ROUTINES
177
178
sub _should_be_removed {
179
    my ( $self, $name ) = @_;
180
181
    # Is this a controlled cookie? Or is it added as 'keep' or 'remove' in koha-conf.xml?
182
    # The conf entries are treated as prefix (no longer as regex).
183
    return unless grep { $name =~ /^$_/ } MANAGED_COOKIE_PREFIXES(), @{ $self->{_remove_list} };
184
    return !grep { $name =~ /^$_/ } @{ $self->{_keep_list} };
185
}
186
187
sub _correct_path {
188
    my $cookie_object = shift;
189
    my $path          = PATH_EXCEPTIONS->{ $cookie_object->name } or return $cookie_object;
190
    $cookie_object->path($path);
191
    return $cookie_object;
192
}
193
194
=head1 ADDITIONAL COMMENTS
195
196
    How do the keep or remove lines in koha-conf.xml work?
197
198
    <do_not_remove_cookie>some_cookie</do_not_remove_cookie>
199
    The name some_cookie should refer here to a cookie that is on the
200
    hardcoded list in this module. If you do not want it to be cleared
201
    (removed) on logout, include this line.
202
    You might want to do this e.g. for KohaOpacLanguage.
203
204
    <remove_cookie>another_cookie</remove_cookie>
205
    The name another_cookie refers here to a cookie that is not on the
206
    hardcoded list but you want this cookie to be cleared/removed on logout.
207
    It could be a custom cookie.
208
209
    Note that both directives use the cookie name as a prefix. So if you
210
    add a remove line for cookie1, it also affects cookie12, etc.
211
    Since a keep line overrules a remove line, this allows you to add
212
    lines for removing cookie1 and not removing cookie12 in order to
213
    remove cookie1, cookie11, cookie13 but not cookie12, etc.
166
214
167
=cut
215
=cut
168
216
(-)a/t/CookieManager.t (-51 / +47 lines)
Lines 19-27 Link Here
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
use CGI;
21
use CGI;
22
use Data::Dumper qw(Dumper);
22
23
#use Data::Dumper qw(Dumper);
23
use Test::NoWarnings;
24
use Test::NoWarnings;
24
use Test::More tests => 4;
25
use Test::More tests => 5;
25
26
26
use t::lib::Mocks;
27
use t::lib::Mocks;
27
28
Lines 29-57 use C4::Context; Link Here
29
use Koha::CookieManager;
30
use Koha::CookieManager;
30
31
31
subtest 'new' => sub {
32
subtest 'new' => sub {
32
    plan tests => 3;
33
    plan tests => 4;
33
34
34
    t::lib::Mocks::mock_config( Koha::CookieManager::DENY_LIST_VAR, 'just_one' );
35
    t::lib::Mocks::mock_config( Koha::CookieManager::KEEP_COOKIE_CONF_VAR, 'just_one' );
35
    my $cmgr = Koha::CookieManager->new;
36
    my $cmgr = Koha::CookieManager->new;
36
    is( scalar keys %{ $cmgr->{_remove_unless} }, 1, 'one entry' );
37
    is( scalar @{ $cmgr->{_keep_list} }, 1, 'one entry to keep' );
37
    is( exists $cmgr->{_secure},                  1, 'secure key found' );
38
    is( exists $cmgr->{_secure},         1, 'secure key found' );
38
39
39
    t::lib::Mocks::mock_config( Koha::CookieManager::DENY_LIST_VAR, [ 'two', 'entries' ] );
40
    t::lib::Mocks::mock_config( Koha::CookieManager::KEEP_COOKIE_CONF_VAR,   [ 'two', 'entries' ] );
41
    t::lib::Mocks::mock_config( Koha::CookieManager::REMOVE_COOKIE_CONF_VAR, ['test'] );
40
    $cmgr = Koha::CookieManager->new;
42
    $cmgr = Koha::CookieManager->new;
41
    is( scalar keys %{ $cmgr->{_remove_unless} }, 2, 'two entries' );
43
    is( scalar @{ $cmgr->{_keep_list} },   2, 'two entries to keep' );
44
    is( scalar @{ $cmgr->{_remove_list} }, 1, 'one entry to remove' );
42
};
45
};
43
46
44
subtest 'clear_unless' => sub {
47
subtest 'clear_unless' => sub {
45
    plan tests => 17;
48
    plan tests => 14;
46
49
47
    t::lib::Mocks::mock_config( Koha::CookieManager::DENY_LIST_VAR, [ 'aap', 'noot' ] );
50
    t::lib::Mocks::mock_config( Koha::CookieManager::KEEP_COOKIE_CONF_VAR,   [ 'aap', 'noot' ] );
51
    t::lib::Mocks::mock_config( Koha::CookieManager::REMOVE_COOKIE_CONF_VAR, ['mies'] );
48
52
49
    my $q    = CGI->new;
53
    my $q    = CGI->new;
50
    my $cmgr = Koha::CookieManager->new;
54
    my $cmgr = Koha::CookieManager->new;
51
55
52
    my $cookie1 = $q->cookie( -name => 'aap',  -value => 'aap', -expires => '+1d' );
56
    my $cookie1 = $q->cookie( -name => 'aap',  -value => 'aap', -expires => '+1d' );
53
    my $cookie2 = $q->cookie( -name => 'noot', -value => 'noot' );
57
    my $cookie2 = $q->cookie( -name => 'noot', -value => 'noot' );
54
    my $cookie3 = $q->cookie( -name => 'wim',  -value => q{wim},  -HttpOnly => 1 );
58
    my $cookie3 = $q->cookie( -name => 'wim',  -value => q{wim},  -HttpOnly => 0 );
55
    my $cookie4 = $q->cookie( -name => 'aap',  -value => q{aap2}, -HttpOnly => 1 );
59
    my $cookie4 = $q->cookie( -name => 'aap',  -value => q{aap2}, -HttpOnly => 1 );
56
    my $list    = [ $cookie1, $cookie2, $cookie3, $cookie4, 'mies', 'zus' ];    # 4 cookies, 2 names
60
    my $list    = [ $cookie1, $cookie2, $cookie3, $cookie4, 'mies', 'zus' ];    # 4 cookies, 2 names
57
61
Lines 59-112 subtest 'clear_unless' => sub { Link Here
59
    is( @{ $cmgr->clear_unless },                                 0, 'Empty list' );
63
    is( @{ $cmgr->clear_unless },                                 0, 'Empty list' );
60
    is( @{ $cmgr->clear_unless( { hash => 1 }, ['array'], $q ) }, 0, 'Empty list for invalid arguments' );
64
    is( @{ $cmgr->clear_unless( { hash => 1 }, ['array'], $q ) }, 0, 'Empty list for invalid arguments' );
61
65
62
    # Pass list, expect 5 cookies (3 cleared, last aap kept)
66
    # Pass list, expecting 4 cookies (2 kept, 1 untouched, 1 cleared); duplicate aap and zus discarded
63
    my @rv = @{ $cmgr->clear_unless(@$list) };
67
    my @rv = @{ $cmgr->clear_unless(@$list) };
64
    is( @rv,              5,       '5 expected' );
68
    is( @rv,              4,       '4 expected' );
65
    is( $rv[0]->name,     'noot',  '1st cookie' );
69
    is( $rv[0]->name,     'noot',  '1st cookie' );
66
    is( $rv[1]->name,     'wim',   '2nd cookie' );
70
    is( $rv[1]->name,     'wim',   '2nd cookie' );
67
    is( $rv[2]->name,     'aap',   '3rd cookie' );
71
    is( $rv[2]->name,     'aap',   '3rd cookie' );
68
    is( $rv[3]->name,     'mies',  '4th cookie' );
72
    is( $rv[3]->name,     'mies',  '4th cookie' );
69
    is( $rv[4]->name,     'zus',   '5th cookie' );
73
    is( $rv[0]->value,    q{noot}, 'noot kept' );
70
    is( $rv[0]->value,    q{noot}, 'noot not empty' );
74
    is( $rv[1]->value,    q{wim},  'wim untouched' );
71
    is( $rv[1]->value,    q{},     'wim empty' );
75
    is( $rv[2]->value,    q{aap2}, 'aap kept, last entry' );
72
    is( $rv[2]->value,    q{aap2}, 'aap not empty' );
76
    is( $rv[3]->value,    q{},     'mies cleared' );
73
    is( $rv[3]->value,    q{},     'mies empty' );
77
    is( $rv[1]->httponly, undef,   'wim still not httponly' );
74
    is( $rv[4]->value,    q{},     'zus empty' );
75
    is( $rv[1]->httponly, 0,       'cleared wim is not httponly' );
76
    is( $rv[2]->httponly, 1,       'aap httponly' );
78
    is( $rv[2]->httponly, 1,       'aap httponly' );
77
79
78
    # Test with numeric suffix (via regex)
80
    # Test with prefix (note trailing underscore)
79
    t::lib::Mocks::mock_config( Koha::CookieManager::DENY_LIST_VAR, ['catalogue_editor_\d+'] );
81
    t::lib::Mocks::mock_config( Koha::CookieManager::KEEP_COOKIE_CONF_VAR,   'catalogue_editor_' );
82
    t::lib::Mocks::mock_config( Koha::CookieManager::REMOVE_COOKIE_CONF_VAR, 'catalogue_editor' );
80
    $cmgr    = Koha::CookieManager->new;
83
    $cmgr    = Koha::CookieManager->new;
81
    $cookie1 = $q->cookie( -name => 'catalogue_editor_abc',  -value => '1', -expires => '+1y' );
84
    $cookie1 = $q->cookie( -name => 'catalogue_editor',   -value => '1' );
82
    $cookie2 = $q->cookie( -name => 'catalogue_editor_345',  -value => '1', -expires => '+1y' );
85
    $cookie2 = $q->cookie( -name => 'catalogue_editor2',  -value => '2' );
83
    $cookie3 = $q->cookie( -name => 'catalogue_editor_',     -value => '1', -expires => '+1y' );
86
    $cookie3 = $q->cookie( -name => 'catalogue_editor_3', -value => '3' );
84
    $cookie4 = $q->cookie( -name => 'catalogue_editor_123x', -value => '1', -expires => '+1y' );
87
85
88
    $list = [ $cookie1, $cookie2, $cookie3, 'catalogue_editor4' ];
86
    $list = [ $cookie1, $cookie2, $cookie3, $cookie4 ];
89
    my $result = [ map { defined( $_->max_age ) ? () : $_->name } @{ $cmgr->clear_unless(@$list) } ];
87
    @rv   = @{ $cmgr->clear_unless(@$list) };
90
    is_deeply( $result, ['catalogue_editor_3'], 'Only cookie3 is kept (not expired)' );
88
    is_deeply(
91
};
89
        [ map { $_->value ? $_->name : () } @rv ],
90
        ['catalogue_editor_345'],
91
        'Cookie2 should be found only'
92
    );
93
94
    # Test with another regex (yes, highly realistic examples :)
95
    t::lib::Mocks::mock_config( Koha::CookieManager::DENY_LIST_VAR, ['next_\w+_number\d{2}_(now|never)'] );
96
    $cmgr = Koha::CookieManager->new;
97
    my $cookie5;
98
    $cookie1 = $q->cookie( -name => 'next_mynewword_number99_never',          -value => '1', -expires => '+1y' );  #fine
99
    $cookie2 = $q->cookie( -name => 'prefixed_next_mynewword_number99_never', -value => '1', -expires => '+1y' )
100
        ;    # wrong prefix
101
    $cookie3 = $q->cookie( -name => 'next_mynew-word_number99_never', -value => '1', -expires => '+1y' )
102
        ;    # wrong: hyphen in word
103
    $cookie4 =
104
        $q->cookie( -name => 'mynewword_number999_never', -value => '1', -expires => '+1y' );    # wrong: three digits
105
    $cookie5 =
106
        $q->cookie( -name => 'next_mynewword_number99_always', -value => '1', -expires => '+1y' );    # wrong: always
107
    @rv = @{ $cmgr->clear_unless( $cookie1, $cookie2, $cookie3, $cookie4, $cookie5 ) };
108
    is_deeply( [ map { $_->value ? $_->name : () } @rv ], ['next_mynewword_number99_never'], 'Only cookie1 matched' );
109
92
93
subtest 'path exception' => sub {
94
    plan tests => 4;
95
96
    t::lib::Mocks::mock_config( Koha::CookieManager::REMOVE_COOKIE_CONF_VAR, ['always_show_holds'] );
97
    my $q       = CGI->new;
98
    my $cmgr    = Koha::CookieManager->new;
99
    my $cookie1 = $q->cookie( -name => 'always_show_holds', -value => 'DO', path => '/cgi-bin/koha/reserve' );
100
    my @rv      = @{ $cmgr->clear_unless($cookie1) };
101
    is( $rv[0]->name,    'always_show_holds',     'Check name' );
102
    is( $rv[0]->path,    '/cgi-bin/koha/reserve', 'Check path' );
103
    is( $rv[0]->max_age, 0,                       'Check max_age' );
104
    my $cookie2 = $q->cookie( -name => 'always_show_holds', -value => 'DONT' );    # default path
105
    @rv = @{ $cmgr->clear_unless($cookie2) };
106
    is( $rv[0]->path, '/cgi-bin/koha/reserve', 'Check path cookie2, corrected here' );
110
};
107
};
111
108
112
subtest 'replace_in_list' => sub {
109
subtest 'replace_in_list' => sub {
113
- 

Return to bug 39206