From bc65380ba94e379744ec31e3a299064e80e8aebc Mon Sep 17 00:00:00 2001 From: Marcel de Rooy Date: Fri, 11 Mar 2022 10:15:30 +0000 Subject: [PATCH] Bug 29957: Introduce Koha::CookieManager Content-Type: text/plain; charset=utf-8 Test plan: Run t/CookieManager.t Signed-off-by: Marcel de Rooy --- Koha/CookieManager.pm | 151 ++++++++++++++++++++++++++++++++++++++++++ t/CookieManager.t | 122 ++++++++++++++++++++++++++++++++++ 2 files changed, 273 insertions(+) create mode 100644 Koha/CookieManager.pm create mode 100755 t/CookieManager.t diff --git a/Koha/CookieManager.pm b/Koha/CookieManager.pm new file mode 100644 index 0000000000..cba829a196 --- /dev/null +++ b/Koha/CookieManager.pm @@ -0,0 +1,151 @@ +package Koha::CookieManager; + +# Copyright 2022 Rijksmuseum, Koha Development Team +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . + +use Modern::Perl; +use CGI::Cookie; +# use Data::Dumper qw( Dumper ); +# use List::MoreUtils qw( uniq ); + +use C4::Context; + +use constant ALLOW_LIST_VAR => 'removable_cookie'; + +our $cookies; + +=head1 NAME + +Koha::CookieManager - Object for unified handling of cookies in Koha + +=head1 SYNOPSIS + + use Koha::CookieManager; + my $mgr = Koha::CookieManager->new; + + # Replace cookies + $cookie_list = $mgr->replace_in_list( [ $cookie1, $cookie2_old ], $cookie2_new ); + + # Clear cookies (governed by koha-conf removable_cookie lines) + $cookie_list = $mgr->clear_if_allowed( $cookie1, $cookie2, $cookie3_name ); + + +=head1 DESCRIPTION + +The current object allows you to clear cookies in a list based on the allow +list in koha-conf.xml. It also offers a method to replace the old version of +a cookie by a new one. + +It could be extended by (gradually) routing cookie creation through it in order +to consistently fill cookie parameters like httponly, secure and samesite flag, +etc. And could serve to register all our cookies in a central location. + +=head1 METHODS + +=head2 new + + my $mgr = Koha::CookieManager->new({}); # parameters for extensions + +=cut + +sub new { + my ( $class, $params ) = @_; + my $self = bless $params//{}, $class; + my $allowed = C4::Context->config(ALLOW_LIST_VAR) || []; # expecting scalar or arrayref + $allowed = [ $allowed ] if ref($allowed) eq q{}; + $self->{_remove_allowed} = { map { $_ => 1 } @$allowed }; + $self->{_secure} = C4::Context->https_enabled; + return $self; +} + +=head2 clear_if_allowed + + $cookies = $self->clear_if_allowed( $query->cookie, @$cookies ); + + Arguments: either cookie names or cookie objects (CGI::Cookie). + Note: in the example above $query->cookie is a list of cookie names as returned + by the CGI object. + + Returns an arrayref of cookie objects: empty, expired cookies for those passed + by name or object that are on the allow list, together with the remaining + (untouched) cookie objects not on that list. + +=cut + +sub clear_if_allowed { + my ( $self, @cookies ) = @_; + my @rv; + my $seen = {}; + foreach my $c ( @cookies ) { + my $name; + my $type = ref($c); + if( $type eq 'CGI::Cookie' ) { + $name = $c->name; + } elsif( $type ) { # not expected: ignore + next; + } else { + $name = $c; + } + + if( $self->{_remove_allowed}->{$name} ) { + next if $seen->{ $name }; + push @rv, CGI::Cookie->new( + # -expires explicitly omitted to create shortlived 'session' cookie + # -HttpOnly explicitly set to 0: not really needed here for the + # cleared httponly cookies, while the js cookies should be 0 + -name => $name, -value => q{}, -HttpOnly => 0, + $self->{_secure} ? ( -secure => 1 ) : (), + ); + $seen->{ $name } = 1; # prevent duplicates + } elsif( $type eq 'CGI::Cookie' ) { + push @rv, $c; + } + } + return \@rv; +} + +=head2 replace_in_list + + $list2 = $mgr->replace_in_list( $list1, $cookie ); + + Add $cookie to $list1, removing older occurrences in list1. + $list1 is a list of CGI::Cookie objects. + $cookie must be a CGI::Cookie object; if it is not, only + cookie objects in list1 are returned (filtering list1). + + Returns an arrayref of CGI::Cookie objects. + +=cut + +sub replace_in_list { + my ( $self, $list, $cookie ) = @_; + my $name = ref($cookie) eq 'CGI::Cookie' ? $cookie->name : q{}; + + my @result; + foreach my $c ( @$list ) { + next if ref($c) ne 'CGI::Cookie'; + push @result, $c if !$name or $c->name ne $name; + } + push @result, $cookie if $name; + return \@result; +} + +=head1 INTERNAL ROUTINES + +=cut + +1; diff --git a/t/CookieManager.t b/t/CookieManager.t new file mode 100755 index 0000000000..c7c46e35af --- /dev/null +++ b/t/CookieManager.t @@ -0,0 +1,122 @@ +#!/usr/bin/perl +# +# Copyright 2022 Rijksmuseum, Koha Development Team +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . + +use Modern::Perl; +use CGI; +use Data::Dumper qw(Dumper); +use Test::More tests => 3; + +use t::lib::Mocks; + +use C4::Context; +use Koha::CookieManager; + +subtest 'new' => sub { + plan tests => 3; + + t::lib::Mocks::mock_config( Koha::CookieManager::ALLOW_LIST_VAR, 'just_one' ); + my $cmgr = Koha::CookieManager->new; + is( scalar keys %{$cmgr->{_remove_allowed}}, 1, 'one entry' ); + is( exists $cmgr->{_secure}, 1, 'secure key found' ); + + t::lib::Mocks::mock_config( Koha::CookieManager::ALLOW_LIST_VAR, [ 'two', 'entries' ] ); + $cmgr = Koha::CookieManager->new; + is( scalar keys %{$cmgr->{_remove_allowed}}, 2, 'two entries' ); +}; + +subtest 'clear_if_allowed' => sub { + plan tests => 13; + + t::lib::Mocks::mock_config( Koha::CookieManager::ALLOW_LIST_VAR, [ 'aap', 'noot', 'mies' ] ); + + my $q = CGI->new; + my $cmgr = Koha::CookieManager->new; + + my $cookie1 = $q->cookie( + -name => 'aap', + -value => 'aap', + -expires => '+1d', + -HttpOnly => 1, + -secure => 1, + ); + my $cookie2 = $q->cookie( + -name => 'noot', + -value => 'noot', + -expires => '+1d', + -HttpOnly => 1, + -secure => 1, + ); + my $cookie3 = $q->cookie( -name => 'wim', -value => q{wim}, -HttpOnly => 1 ); + my $cookie4 = $q->cookie( -name => 'aap', -value => q{aap2} ); + my $list = [ $cookie1, $cookie2, $cookie3, $cookie4, 'mies', 'zus' ]; # 4 cookies, 2 names + + # No results expected + is( @{$cmgr->clear_if_allowed}, 0, 'Empty list' ); + is( @{$cmgr->clear_if_allowed( 'scalar', [], $q )}, 0, 'Empty list for invalid arguments' ); + + # Pass list, expect 4 cookies (3 cleared) + my @rv = @{$cmgr->clear_if_allowed( @$list )}; + is( @rv, 4, 'Four expected' ); + is( $rv[0]->name, 'aap', 'First cookie' ); + is( $rv[1]->name, 'noot', '2nd cookie' ); + is( $rv[2]->name, 'wim', '3rd cookie' ); + is( $rv[3]->name, 'mies', '4th cookie' ); + is( $rv[0]->value, q{}, 'aap should be empty' ); + is( $rv[1]->value, q{}, 'noot should be empty' ); + is( $rv[2]->value, 'wim', 'wim not empty' ); + is( $rv[3]->value, q{}, 'mies empty' ); + is( $rv[0]->httponly, 0, 'cleared aap isnt httponly' ); + is( $rv[2]->httponly, 1, 'wim still httponly' ); +}; + +subtest 'replace_in_list' => sub { + plan tests => 13; + + my $q = CGI->new; + my $cmgr = Koha::CookieManager->new; + + my $cookie1 = $q->cookie( -name => 'c1', -value => q{c1} ); + my $cookie2 = $q->cookie( -name => 'c2', -value => q{c2} ); + my $cookie3 = $q->cookie( -name => 'c3', -value => q{c3} ); + my $cookie4 = $q->cookie( -name => 'c2', -value => q{c4} ); # name c2 ! + + # Unusual arguments (show that $cmgr handles the cookie mocks in Auth.t) + my $res = $cmgr->replace_in_list( [ 1, 2, 3 ], 4 ); + is( @$res, 0, 'No cookies' ); + $res = $cmgr->replace_in_list( [ 1, 2, 3 ], $cookie1 ); + is( @$res, 1, 'One cookie added' ); + is( $res->[0]->name, 'c1', '1st cookie' ); + $res = $cmgr->replace_in_list( [ $cookie2, 2, 3 ], 4 ); # filter 2,3 and ignore 4 + is( @$res, 1, 'One cookie found' ); + is( $res->[0]->name, 'c2', 'c2 found' ); + + # Pass c1 c2, add c3 + $res = $cmgr->replace_in_list( [ $cookie1, $cookie2 ], $cookie3 ); + is( @$res, 3, 'Returns three' ); + is( $res->[2]->name, 'c3', '3rd cookie' ); + is( $res->[2]->value, 'c3', 'value c3' ); + + # Pass c1 c2 c3 and replace c2 + $res = $cmgr->replace_in_list( [ $cookie1, $cookie2, $cookie3 ], $cookie4 ); + is( @$res, 3, 'Returns three' ); + is( $res->[0]->name, 'c1', '1st cookie' ); + is( $res->[1]->name, 'c3', '2nd cookie' ); + is( $res->[2]->name, 'c2', '3rd cookie' ); + is( $res->[2]->value, 'c4', 'value replaced' ); +}; -- 2.20.1