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

(-)a/Koha/CookieManager.pm (-20 / +19 lines)
Lines 24-30 use CGI::Cookie; Link Here
24
24
25
use C4::Context;
25
use C4::Context;
26
26
27
use constant ALLOW_LIST_VAR => 'removable_cookie';
27
use constant DENY_LIST_VAR => 'do_not_remove_cookie';
28
28
29
our $cookies;
29
our $cookies;
30
30
Lines 40-54 Koha::CookieManager - Object for unified handling of cookies in Koha Link Here
40
    # Replace cookies
40
    # Replace cookies
41
    $cookie_list = $mgr->replace_in_list( [ $cookie1, $cookie2_old ], $cookie2_new );
41
    $cookie_list = $mgr->replace_in_list( [ $cookie1, $cookie2_old ], $cookie2_new );
42
42
43
    # Clear cookies (governed by koha-conf removable_cookie lines)
43
    # Clear cookies (governed by deny list entries in koha-conf)
44
    $cookie_list = $mgr->clear_if_allowed( $cookie1, $cookie2, $cookie3_name );
44
    $cookie_list = $mgr->clear_unless( $cookie1, $cookie2, $cookie3_name );
45
46
45
47
=head1 DESCRIPTION
46
=head1 DESCRIPTION
48
47
49
The current object allows you to clear cookies in a list based on the allow
48
The current object allows you to clear cookies in a list based on the deny list
50
list in koha-conf.xml. It also offers a method to replace the old version of
49
in koha-conf.xml. It also offers a method to replace the old version of a cookie
51
a cookie by a new one.
50
by a new one.
52
51
53
It could be extended by (gradually) routing cookie creation through it in order
52
It could be extended by (gradually) routing cookie creation through it in order
54
to consistently fill cookie parameters like httponly, secure and samesite flag,
53
to consistently fill cookie parameters like httponly, secure and samesite flag,
Lines 65-92 etc. And could serve to register all our cookies in a central location. Link Here
65
sub new {
64
sub new {
66
    my ( $class, $params ) = @_;
65
    my ( $class, $params ) = @_;
67
    my $self = bless $params//{}, $class;
66
    my $self = bless $params//{}, $class;
68
    my $allowed = C4::Context->config(ALLOW_LIST_VAR) || []; # expecting scalar or arrayref
67
    my $denied = C4::Context->config(DENY_LIST_VAR) || []; # expecting scalar or arrayref
69
    $allowed = [ $allowed ] if ref($allowed) eq q{};
68
    $denied = [ $denied ] if ref($denied) eq q{};
70
    $self->{_remove_allowed} = { map { $_ => 1 } @$allowed };
69
    $self->{_remove_unless} = { map { $_ => 1 } @$denied };
71
    $self->{_secure} = C4::Context->https_enabled;
70
    $self->{_secure} = C4::Context->https_enabled;
72
    return $self;
71
    return $self;
73
}
72
}
74
73
75
=head2 clear_if_allowed
74
=head2 clear_unless
76
75
77
    $cookies = $self->clear_if_allowed( $query->cookie, @$cookies );
76
    $cookies = $self->clear_unless( $query->cookie, @$cookies );
78
77
79
    Arguments: either cookie names or cookie objects (CGI::Cookie).
78
    Arguments: either cookie names or cookie objects (CGI::Cookie).
80
    Note: in the example above $query->cookie is a list of cookie names as returned
79
    Note: in the example above $query->cookie is a list of cookie names as returned
81
    by the CGI object.
80
    by the CGI object.
82
81
83
    Returns an arrayref of cookie objects: empty, expired cookies for those passed
82
    Returns an arrayref of cookie objects: empty, expired cookies for those passed
84
    by name or object that are on the allow list, together with the remaining
83
    by name or objects that are not on the deny list, together with the remaining
85
    (untouched) cookie objects not on that list.
84
    (untouched) cookie objects that are on the deny list.
86
85
87
=cut
86
=cut
88
87
89
sub clear_if_allowed {
88
sub clear_unless {
90
    my ( $self, @cookies ) = @_;
89
    my ( $self, @cookies ) = @_;
91
    my @rv;
90
    my @rv;
92
    my $seen = {};
91
    my $seen = {};
Lines 101-108 sub clear_if_allowed { Link Here
101
            $name = $c;
100
            $name = $c;
102
        }
101
        }
103
102
104
        if( $self->{_remove_allowed}->{$name} ) {
103
        if( !$self->{_remove_unless}->{$name} ) {
105
            next if $seen->{ $name };
104
            next if $seen->{$name};
106
            push @rv, CGI::Cookie->new(
105
            push @rv, CGI::Cookie->new(
107
                # -expires explicitly omitted to create shortlived 'session' cookie
106
                # -expires explicitly omitted to create shortlived 'session' cookie
108
                # -HttpOnly explicitly set to 0: not really needed here for the
107
                # -HttpOnly explicitly set to 0: not really needed here for the
Lines 110-118 sub clear_if_allowed { Link Here
110
                -name => $name, -value => q{}, -HttpOnly => 0,
109
                -name => $name, -value => q{}, -HttpOnly => 0,
111
                $self->{_secure} ? ( -secure => 1 ) : (),
110
                $self->{_secure} ? ( -secure => 1 ) : (),
112
            );
111
            );
113
            $seen->{ $name } = 1; # prevent duplicates
112
            $seen->{$name} = 1; # prevent duplicates
114
        } elsif( $type eq 'CGI::Cookie' ) {
113
        } elsif( $type eq 'CGI::Cookie' ) { # keep the last occurrence
115
            push @rv, $c;
114
            @rv = @{ $self->replace_in_list( \@rv, $c ) };
116
        }
115
        }
117
    }
116
    }
118
    return \@rv;
117
    return \@rv;
(-)a/t/CookieManager.t (-37 / +26 lines)
Lines 30-88 use Koha::CookieManager; Link Here
30
subtest 'new' => sub {
30
subtest 'new' => sub {
31
    plan tests => 3;
31
    plan tests => 3;
32
32
33
    t::lib::Mocks::mock_config( Koha::CookieManager::ALLOW_LIST_VAR, 'just_one' );
33
    t::lib::Mocks::mock_config( Koha::CookieManager::DENY_LIST_VAR, 'just_one' );
34
    my $cmgr = Koha::CookieManager->new;
34
    my $cmgr = Koha::CookieManager->new;
35
    is( scalar keys %{$cmgr->{_remove_allowed}}, 1, 'one entry' );
35
    is( scalar keys %{$cmgr->{_remove_unless}}, 1, 'one entry' );
36
    is( exists $cmgr->{_secure}, 1, 'secure key found' );
36
    is( exists $cmgr->{_secure}, 1, 'secure key found' );
37
37
38
    t::lib::Mocks::mock_config( Koha::CookieManager::ALLOW_LIST_VAR, [ 'two', 'entries' ] );
38
    t::lib::Mocks::mock_config( Koha::CookieManager::DENY_LIST_VAR, [ 'two', 'entries' ] );
39
    $cmgr = Koha::CookieManager->new;
39
    $cmgr = Koha::CookieManager->new;
40
    is( scalar keys %{$cmgr->{_remove_allowed}}, 2, 'two entries' );
40
    is( scalar keys %{$cmgr->{_remove_unless}}, 2, 'two entries' );
41
};
41
};
42
42
43
subtest 'clear_if_allowed' => sub {
43
subtest 'clear_unless' => sub {
44
    plan tests => 13;
44
    plan tests => 15;
45
45
46
    t::lib::Mocks::mock_config( Koha::CookieManager::ALLOW_LIST_VAR, [ 'aap', 'noot', 'mies' ] );
46
    t::lib::Mocks::mock_config( Koha::CookieManager::DENY_LIST_VAR, [ 'aap', 'noot' ] );
47
47
48
    my $q = CGI->new;
48
    my $q = CGI->new;
49
    my $cmgr = Koha::CookieManager->new;
49
    my $cmgr = Koha::CookieManager->new;
50
50
51
    my $cookie1 = $q->cookie(
51
    my $cookie1 = $q->cookie( -name => 'aap', -value => 'aap', -expires => '+1d' );
52
        -name => 'aap',
52
    my $cookie2 = $q->cookie( -name => 'noot', -value => 'noot' );
53
        -value => 'aap',
54
        -expires => '+1d',
55
        -HttpOnly => 1,
56
        -secure => 1,
57
    );
58
    my $cookie2 = $q->cookie(
59
        -name => 'noot',
60
        -value => 'noot',
61
        -expires => '+1d',
62
        -HttpOnly => 1,
63
        -secure => 1,
64
    );
65
    my $cookie3 = $q->cookie( -name => 'wim', -value => q{wim}, -HttpOnly => 1 );
53
    my $cookie3 = $q->cookie( -name => 'wim', -value => q{wim}, -HttpOnly => 1 );
66
    my $cookie4 = $q->cookie( -name => 'aap', -value => q{aap2} );
54
    my $cookie4 = $q->cookie( -name => 'aap', -value => q{aap2}, -HttpOnly => 1 );
67
    my $list = [ $cookie1, $cookie2, $cookie3, $cookie4, 'mies', 'zus' ]; # 4 cookies, 2 names
55
    my $list = [ $cookie1, $cookie2, $cookie3, $cookie4, 'mies', 'zus' ]; # 4 cookies, 2 names
68
56
69
    # No results expected
57
    # No results expected
70
    is( @{$cmgr->clear_if_allowed}, 0, 'Empty list' );
58
    is( @{$cmgr->clear_unless}, 0, 'Empty list' );
71
    is( @{$cmgr->clear_if_allowed( 'scalar', [], $q )}, 0, 'Empty list for invalid arguments' );
59
    is( @{$cmgr->clear_unless( { hash => 1 }, [ 'array' ], $q )}, 0, 'Empty list for invalid arguments' );
72
60
73
    # Pass list, expect 4 cookies (3 cleared)
61
    # Pass list, expect 5 cookies (3 cleared, last aap kept)
74
    my @rv = @{$cmgr->clear_if_allowed( @$list )};
62
    my @rv = @{$cmgr->clear_unless( @$list )};
75
    is( @rv, 4, 'Four expected' );
63
    is( @rv, 5, '5 expected' );
76
    is( $rv[0]->name, 'aap', 'First cookie' );
64
    is( $rv[0]->name, 'noot', '1st cookie' );
77
    is( $rv[1]->name, 'noot', '2nd cookie' );
65
    is( $rv[1]->name, 'wim', '2nd cookie' );
78
    is( $rv[2]->name, 'wim', '3rd cookie' );
66
    is( $rv[2]->name, 'aap', '3rd cookie' );
79
    is( $rv[3]->name, 'mies', '4th cookie' );
67
    is( $rv[3]->name, 'mies', '4th cookie' );
80
    is( $rv[0]->value, q{}, 'aap should be empty' );
68
    is( $rv[4]->name, 'zus', '5th cookie' );
81
    is( $rv[1]->value, q{}, 'noot should be empty' );
69
    is( $rv[0]->value, q{noot}, 'noot not empty' );
82
    is( $rv[2]->value, 'wim', 'wim not empty' );
70
    is( $rv[1]->value, q{}, 'wim empty' );
71
    is( $rv[2]->value, q{aap2}, 'aap not empty' );
83
    is( $rv[3]->value, q{}, 'mies empty' );
72
    is( $rv[3]->value, q{}, 'mies empty' );
84
    is( $rv[0]->httponly, 0, 'cleared aap isnt httponly' );
73
    is( $rv[4]->value, q{}, 'zus empty' );
85
    is( $rv[2]->httponly, 1, 'wim still httponly' );
74
    is( $rv[1]->httponly, 0, 'cleared wim isnt httponly' );
75
    is( $rv[2]->httponly, 1, 'aap httponly' );
86
};
76
};
87
77
88
subtest 'replace_in_list' => sub {
78
subtest 'replace_in_list' => sub {
89
- 

Return to bug 29957