From 5236bb87be9107ff490ffe5595db0c69e3d1e303 Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Tue, 11 Oct 2016 14:35:48 +0100 Subject: [PATCH] Bug 17427: Replace CGI::Session with Data::Session CGI::Session is not maintained for ages and seems quite buggy. It would be the culprit of random logout problems. Another issue is the following crazy code in CGI::Session::Driver::DBI sub DESTROY { my $self = shift; unless ( defined $self->{Handle} && $self->{Handle} -> ping ) { $self->set_error(__PACKAGE__ . '::DESTROY(). Database handle has gone away'); return; } unless ( $self->{Handle}->{AutoCommit} ) { $self->{Handle}->commit; } if ( $self->{_disconnect} ) { $self->{Handle}->disconnect; } } If AutoCommit is off, it will commit anyway... It causes some tests to fail (api) if SessionStorage is set to MySQL Note that PostgreSQL is not supported yet so no need to implement it. Test plan: 0/ The dependencies are not packaged for debian so far, so install it via cpan 1/ Test the 3 different values for SessionStorage 2/ Using different browsers (or sessions) login into Koha with different users. Naviguate => you should not be logged out 3/ Set SessionStorage to Memcached, stop memcached make sure that it defaults to file. --- C4/Auth.pm | 48 +++++++++---------- C4/InstallAuth.pm | 18 ++++--- circ/circulation.pl | 2 +- cpanfile | 4 +- .../en/modules/admin/preferences/admin.pref | 1 - members/routing-lists.pl | 1 - tools/background-job-progress.pl | 1 - 7 files changed, 38 insertions(+), 37 deletions(-) diff --git a/C4/Auth.pm b/C4/Auth.pm index adc1b5dd0d0..dec14051073 100644 --- a/C4/Auth.pm +++ b/C4/Auth.pm @@ -24,6 +24,7 @@ use Carp qw( croak ); use Digest::MD5 qw( md5_base64 ); use CGI::Session; use CGI::Session::ErrorHandler; +use Data::Session; use URI; use URI::QueryParam; @@ -1228,7 +1229,7 @@ sub checkauth { $session->param( 'desk_name', $desk_name); $session->param( 'flags', $userflags ); $session->param( 'emailaddress', $emailaddress ); - $session->param( 'ip', $session->remote_addr() ); + $session->param( 'ip', $ENV{REMOTE_ADDR} ); $session->param( 'lasttime', time() ); $session->param( 'interface', $type); $session->param( 'shibboleth', $shibSuccess ); @@ -1256,7 +1257,7 @@ sub checkauth { C4::Context::_unset_userenv($sessionID); } $session->param( 'lasttime', time() ); - $session->param( 'ip', $session->remote_addr() ); + $session->param( 'ip', $ENV{REMOTE_ADDR} ); $session->param( 'sessiontype', 'anon' ); $session->param( 'interface', $type); } @@ -1266,7 +1267,7 @@ sub checkauth { # anonymous sessions are created only for the OPAC # setting a couple of other session vars... - $session->param( 'ip', $session->remote_addr() ); + $session->param( 'ip', $ENV{REMOTE_ADDR} ); $session->param( 'lasttime', time() ); $session->param( 'sessiontype', 'anon' ); $session->param( 'interface', $type); @@ -1663,7 +1664,7 @@ sub check_api_auth { $session->param( 'branchname', $branchname ); $session->param( 'flags', $userflags ); $session->param( 'emailaddress', $emailaddress ); - $session->param( 'ip', $session->remote_addr() ); + $session->param( 'ip', $ENV{REMOTE_ADDR} ); $session->param( 'lasttime', time() ); $session->param( 'interface', 'api' ); } @@ -1819,10 +1820,9 @@ sub check_cookie_auth { =head2 get_session - use CGI::Session; my $session = get_session($sessionID); -Given a session ID, retrieve the CGI::Session object used to store +Given a session ID, retrieve the Data::Session object used to store the session's state. The session object can be used to store data that needs to be accessed by different scripts during a user's session. @@ -1836,35 +1836,33 @@ sub _get_session_params { my $storage_method = C4::Context->preference('SessionStorage'); if ( $storage_method eq 'mysql' ) { my $dbh = C4::Context->dbh; - return { dsn => "serializer:yamlxs;driver:MySQL;id:md5", dsn_args => { Handle => $dbh } }; - } - elsif ( $storage_method eq 'Pg' ) { - my $dbh = C4::Context->dbh; - return { dsn => "serializer:yamlxs;driver:PostgreSQL;id:md5", dsn_args => { Handle => $dbh } }; - } - elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) { - my $memcached = Koha::Caches->get_instance()->memcached_cache; - return { dsn => "serializer:yamlxs;driver:memcached;id:md5", dsn_args => { Memcached => $memcached } }; + # Note that the doc is wrong, type is required, if not provided it default to File + return { dbh => $dbh, type => 'serialize:yamlxs;driver:mysql;id:MD5' }; + } elsif ( $storage_method eq 'Pg' ) { + die "The system preference SessionStorage is set to 'Pg' but this is not supported yet!"; + } elsif ( $storage_method eq 'memcached' and my $memcached = Koha::Caches->get_instance->memcached_cache ) { + return { + type => 'serialize:yamlxs;driver:Memcached;id:SHA1', + cache => $memcached, + }; + } elsif ( $storage_method ne 'tmp' ) { + warn "The system preference SessionStorage is set to an invalid value '$storage_method'"; } else { # catch all defaults to tmp should work on all systems + if ( $storage_method ne 'tmp' ) { + warn "The session has not been correctly retrieved, defaulting to temporary storage: " . $Data::Session::errstr; + } my $dir = C4::Context::temporary_directory; - my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is - return { dsn => "serializer:yamlxs;driver:File;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } }; + my $instance = C4::Context->config('database'); #actually for packages not exactly the instance name, but generally safer to leave it as it is + return { type => 'serialize:yamlxs;driver:File;id:MD5', directory => "$dir/cgisess_$instance" }; } } sub get_session { my $sessionID = shift; my $params = _get_session_params(); - my $session; - if( $sessionID ) { # find existing - CGI::Session::ErrorHandler->set_error( q{} ); # clear error, cpan issue #111463 - $session = CGI::Session->load( $params->{dsn}, $sessionID, $params->{dsn_args} ); - } else { - $session = CGI::Session->new( $params->{dsn}, $sessionID, $params->{dsn_args} ); - # no need to flush here - } + my $session = Data::Session->new( %$params ) || die $Data::Session::errstr; return $session; } diff --git a/C4/InstallAuth.pm b/C4/InstallAuth.pm index 56dd8e32602..e4a89cd3fe9 100644 --- a/C4/InstallAuth.pm +++ b/C4/InstallAuth.pm @@ -18,7 +18,7 @@ package C4::InstallAuth; # along with Koha; if not, see . use Modern::Perl; -use CGI::Session; +use Data::Session; use File::Spec; require Exporter; @@ -240,11 +240,13 @@ sub checkauth { my %info; my ( $userid, $cookie, $sessionID, $flags, $envcookie ); my $logout = $query->param('logout.x'); + my $dir = File::Spec->tmpdir; if ( $sessionID = $query->cookie("CGISESSID") ) { C4::Context->_new_userenv($sessionID); - my $session = - CGI::Session->new( "driver:File", $sessionID, - { Directory => $sessdir } ); + my $session = Data::Session->new( + type => 'driver:File;id:MD5', + directory => $dir + ) or die $Data::Session::errstr; if ( $session->param('cardnumber') ) { C4::Context->set_userenv( $session->param('number'), @@ -283,8 +285,10 @@ sub checkauth { } } unless ($userid) { - my $session = - CGI::Session->new( "driver:File", undef, { Directory => $sessdir } ); + my $session = Data::Session->new( + type => 'driver:File;id:MD5', + directory => $dir + ) or die $Data::Session::errstr; $sessionID = $session->id; $userid = $query->param('userid'); C4::Context->_new_userenv($sessionID); @@ -327,7 +331,7 @@ sub checkauth { $session->param( 'flags', 1 ); $session->param( 'emailaddress', C4::Context->preference('KohaAdminEmailAddress') ); - $session->param( 'ip', $session->remote_addr() ); + $session->param( 'ip', $ENV{REMOTE_ADDR} ); $session->param( 'lasttime', time() ); $userid = C4::Context->config('user'); } diff --git a/circ/circulation.pl b/circ/circulation.pl index 7b35a8c8608..0e9c4b5e4d4 100755 --- a/circ/circulation.pl +++ b/circ/circulation.pl @@ -40,7 +40,7 @@ use C4::Search qw( new_record_from_zebra ); use C4::Reserves; use Koha::Holds; use C4::Context; -use CGI::Session; +use Data::Session; use Koha::AuthorisedValues; use Koha::CsvProfiles; use Koha::Patrons; diff --git a/cpanfile b/cpanfile index 3dddcad3623..9922d269f9e 100644 --- a/cpanfile +++ b/cpanfile @@ -11,7 +11,6 @@ requires 'CGI', '3.15'; requires 'CGI::Carp', '1.29'; requires 'CGI::Compile', '>= 0.17, != 0.24'; requires 'CGI::Emulate::PSGI', '0.20'; -requires 'CGI::Session', '4.2'; requires 'CPAN::Meta', '2.150006'; requires 'Cache::Memcached', '1.30'; requires 'Cache::Memcached::Fast::Safe', '0.06'; @@ -28,6 +27,9 @@ requires 'DBIx::Class::Schema::Loader', '0.07039'; requires 'DBIx::RunSQL', '0.14'; requires 'Data::Dumper', '2.121'; requires 'Data::ICal', '0.13'; +requires 'Data::Session', '1.18'; +requires 'Data::Session::Driver::Memcached', '1.18'; +requires 'Data::Session::Driver::mysql', '1.18'; requires 'Date::Calc', '5.4'; requires 'Date::Manip', '5.44'; requires 'DateTime', '0.58'; diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref index c25ee189628..fc18e0392c6 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref @@ -113,7 +113,6 @@ Administration: default: mysql choices: mysql: MySQL database - Pg: PostgreSQL database (not supported) tmp: Temporary files memcached: Memcached server - diff --git a/members/routing-lists.pl b/members/routing-lists.pl index 81ad7980ab0..44e98b3ac4f 100755 --- a/members/routing-lists.pl +++ b/members/routing-lists.pl @@ -25,7 +25,6 @@ use C4::Members; use C4::Context; use C4::Serials; use Koha::Patrons; -use CGI::Session; my $query = CGI->new; diff --git a/tools/background-job-progress.pl b/tools/background-job-progress.pl index ae6df95e863..61ad09b80b9 100755 --- a/tools/background-job-progress.pl +++ b/tools/background-job-progress.pl @@ -21,7 +21,6 @@ use Modern::Perl; # standard or CPAN modules used use CGI qw ( -utf8 ); -use CGI::Session; use C4::Context; use C4::Auth qw( check_cookie_auth ); use C4::BackgroundJob; -- 2.25.1