From 5afbb61e760121fd28aa75a5e82d355684786c39 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 | 128 ++++++++++++++++++++++++++++++++++++++++++ t/CookieManager.t | 108 +++++++++++++++++++++++++++++++++++ 2 files changed, 236 insertions(+) create mode 100644 Koha/CookieManager.pm create mode 100644 t/CookieManager.t diff --git a/Koha/CookieManager.pm b/Koha/CookieManager.pm new file mode 100644 index 0000000000..093d99fc69 --- /dev/null +++ b/Koha/CookieManager.pm @@ -0,0 +1,128 @@ +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 handling cookies in Koha + +=head1 SYNOPSIS + + use Koha::CookieManager; + +=head1 DESCRIPTION + +TODO Add a nice description + +=head1 METHODS + +=head2 new + +=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. + + Returns a list 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( +# -name => $name, -value => q{}, -expires => '-1d', -HttpOnly => 1, + -name => $name, -value => q{}, -HttpOnly => 1, + $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 ); + + Replace $cookie if it is already on $list1, otherwise add it. + $list1 is a list of CGI::Cookie objects. + $cookie must be a CGI::Cookie object. + +=cut + +sub replace_in_list { + my ( $self, $list, $cookie ) = @_; + return if ref($cookie) ne 'CGI::Cookie'; + + my @result; + foreach my $c ( @$list ) { + next if ref($c) ne 'CGI::Cookie'; + push @result, $c if $c->name ne $cookie->name; + } + return [ @result, $cookie ]; +} + +=head1 INTERNAL ROUTINES + +=cut + +1; diff --git a/t/CookieManager.t b/t/CookieManager.t new file mode 100644 index 0000000000..deadb0c5ea --- /dev/null +++ b/t/CookieManager.t @@ -0,0 +1,108 @@ +#!/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 => 9; + + t::lib::Mocks::mock_config( Koha::CookieManager::ALLOW_LIST_VAR, [ 'aap', 'noot' ] ); + + 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 => 'mies', -value => q{mies} ); + my $cookie4 = $q->cookie( -name => 'aap', -value => q{aap2} ); + my $list = [ $cookie1, $cookie2, $cookie3, $cookie4, 'searchToOrder' ]; + + # No results + is( scalar $cmgr->clear_if_allowed, 0, 'Empty list' ); + is( scalar $cmgr->clear_if_allowed( 'scalar', [], $q ), 0, 'Empty list for invalid arguments' ); + + my @rv = $cmgr->clear_if_allowed( @$list ); + is( @rv, 3, 'Only expecting three cookies: aap noot and mies' ); + is( $rv[0]->name, 'aap', 'First cookie' ); + is( $rv[1]->name, 'noot', '2nd cookie' ); + is( $rv[2]->name, 'mies', '3rd cookie' ); + is( $rv[0]->value, q{}, 'aap should be empty' ); + is( $rv[1]->value, q{}, 'noot should be empty' ); + is( $rv[2]->value, 'mies', 'mies not empty' ); +}; + +subtest 'replace_in_list' => sub { + plan tests => 8; + + 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 ! + + # Bad arguments + my $res = $cmgr->replace_in_list( [ 1, 2, 3 ], 4 ); + is( $res, undef, 'No cookie passed' ); + $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( [ $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