From dd69031ff7df462bf1c84caa330b335743ae1aa5 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. Signed-off-by: Benjamin Rokseth --- C4/Auth.pm | 48 ++++++++++++---------- C4/Context.pm | 4 +- C4/InstallAuth.pm | 19 +++++---- C4/Installer/PerlDependencies.pm | 30 +++++++------- circ/circulation.pl | 2 +- .../prog/en/modules/admin/preferences/admin.pref | 1 - members/routing-lists.pl | 1 - tools/background-job-progress.pl | 1 - 8 files changed, 55 insertions(+), 51 deletions(-) diff --git a/C4/Auth.pm b/C4/Auth.pm index 6b7dc66..2176bc2 100644 --- a/C4/Auth.pm +++ b/C4/Auth.pm @@ -23,7 +23,7 @@ use Digest::MD5 qw(md5_base64); use File::Spec; use JSON qw/encode_json/; use URI::Escape; -use CGI::Session; +use Data::Session; require Exporter; use C4::Context; @@ -1111,7 +1111,7 @@ sub checkauth { $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( 'shibboleth', $shibSuccess ); $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch); @@ -1129,7 +1129,7 @@ sub checkauth { $session->param( 'branchname', 'NO_LIBRARY_SET' ); $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() ); } if ($persona) { @@ -1154,7 +1154,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' ); } } # END if ( $userid = $query->param('userid') ) @@ -1165,7 +1165,7 @@ sub checkauth { $debug and warn "Initiating an anonymous session..."; # 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' ); } @@ -1559,7 +1559,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() ); } elsif ( $return == 2 ) { @@ -1573,7 +1573,7 @@ sub check_api_auth { $session->param( 'branchname', 'NO_LIBRARY_SET' ); $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() ); } C4::Context->set_userenv( @@ -1709,10 +1709,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. @@ -1728,20 +1727,25 @@ sub get_session { my $dbh = C4::Context->dbh; my $session; if ( $storage_method eq 'mysql' ) { - $session = new CGI::Session( "driver:MySQL;serializer:yaml;id:md5", $sessionID, { Handle => $dbh } ); - } - elsif ( $storage_method eq 'Pg' ) { - $session = new CGI::Session( "driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, { Handle => $dbh } ); - } - elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) { - my $memcached = Koha::Caches->get_instance()->memcached_cache; - $session = new CGI::Session( "driver:memcached;serializer:yaml;id:md5", $sessionID, { Memcached => $memcached } ); + # Note that the doc is wrong, type is required, if not provided it default to File + $session = Data::Session->new( dbh => $dbh, type => 'driver:mysql;id:MD5;serialize:YAML' ) or die $Data::Session::errstr; + } elsif ( $storage_method eq 'Pg' ) { + warn "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 ) { + $session = Data::Session->new( + type => 'driver:Memcached;id:SHA1;serialize:DataDumper', + 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 - my $dir = File::Spec->tmpdir; - my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is - $session = new CGI::Session( "driver:File;serializer:yaml;id:md5", $sessionID, { Directory => "$dir/cgisess_$instance" } ); + if ( $storage_method eq 'tmp' or not $session ) { + if ( $storage_method ne 'tmp' ) { + warn "The session has not been correctly retrieved, defaulting to temporary storage: " . $Data::Session::errstr; + } + my $dir = '/tmp/'; #File::Spec->tmpdir; + my $instance = C4::Context->config('database'); #actually for packages not exactly the instance name, but generally safer to leave it as it is + $session = Data::Session->new( type => 'driver:File;id:MD5;serialize:YAML', directory => "$dir/cgisess_$instance" ) or die $Data::Session::errstr; } return $session; } diff --git a/C4/Context.pm b/C4/Context.pm index c9d9617..ce86187 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -858,9 +858,7 @@ set_userenv is called in Auth.pm #' sub set_userenv { shift @_; - my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $branchprinter, $persona, $shibboleth)= - map { Encode::is_utf8( $_ ) ? $_ : Encode::decode('UTF-8', $_) } # CGI::Session doesn't handle utf-8, so we decode it here - @_; + my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $branchprinter, $persona, $shibboleth) = @_; my $var=$context->{"activeuser"} || ''; my $cell = { "number" => $usernum, diff --git a/C4/InstallAuth.pm b/C4/InstallAuth.pm index c91bde8..8d7a8d2 100644 --- a/C4/InstallAuth.pm +++ b/C4/InstallAuth.pm @@ -20,13 +20,14 @@ package C4::InstallAuth; use strict; #use warnings; FIXME - Bug 2505 use Digest::MD5 qw(md5_base64); +use Data::Session; +use File::Spec; require Exporter; use C4::Context; use C4::Output; use C4::Templates; use C4::Koha; -use CGI::Session; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); @@ -239,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 = - new CGI::Session( "driver:File;serializer:yaml", $sessionID, - { Directory => '/tmp' } ); + my $session = Data::Session->new( + type => 'driver:File;id:MD5;serialize:YAML', + directory => $dir + ) or die $Data::Session::errstr; if ( $session->param('cardnumber') ) { C4::Context->set_userenv( $session->param('number'), @@ -282,8 +285,10 @@ sub checkauth { } } unless ($userid) { - my $session = - new CGI::Session( "driver:File;serializer:yaml", undef, { Directory => '/tmp' } ); + my $session = Data::Session->new( + type => 'driver:File;id:MD5;serialize:YAML', + directory => $dir + ) or die $Data::Session::errstr; $sessionID = $session->id; $userid = $query->param('userid'); C4::Context->_new_userenv($sessionID); @@ -324,7 +329,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/C4/Installer/PerlDependencies.pm b/C4/Installer/PerlDependencies.pm index b531e6c..f95c780 100644 --- a/C4/Installer/PerlDependencies.pm +++ b/C4/Installer/PerlDependencies.pm @@ -322,11 +322,6 @@ our $PERL_DEPS = { 'required' => '1', 'min_ver' => '5.43' }, - 'CGI::Session::Serialize::yaml' => { - 'usage' => 'Core', - 'required' => '1', - 'min_ver' => '4.2' - }, 'CGI::Carp' => { 'usage' => 'Core', 'required' => '1', @@ -432,16 +427,6 @@ our $PERL_DEPS = { 'required' => '1', 'min_ver' => '2' }, - 'CGI::Session' => { - 'usage' => 'Core', - 'required' => '1', - 'min_ver' => '4.2' - }, - 'CGI::Session::Driver::memcached' => { - 'usage' => 'Memcached Feature (Experimental)', - 'required' => '0', - 'min_ver' => '0.04', - }, 'POSIX' => { 'usage' => 'Core', 'required' => '1', @@ -857,6 +842,21 @@ our $PERL_DEPS = { required => 1, min_ver => '0.058', }, + 'Data::Session' => { + usage => 'core', + required => 1, + min_version => '1.17', + }, + 'Data::Session::Driver::Memcached' => { + usage => 'core', + required => 1, + min_version => '1.17', + }, + 'Data::Session::Driver::mysql' => { + usage => 'core', + required => 1, + min_version => '1.17', + }, }; 1; diff --git a/circ/circulation.pl b/circ/circulation.pl index ded56c4..d8a2b6b 100755 --- a/circ/circulation.pl +++ b/circ/circulation.pl @@ -40,7 +40,7 @@ use MARC::Record; use C4::Reserves; use Koha::Holds; use C4::Context; -use CGI::Session; +use Data::Session; use C4::Members::Attributes qw(GetBorrowerAttributes); use Koha::AuthorisedValues; use Koha::Patron; 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 5d8091c..3f20c86 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 @@ -94,7 +94,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 7c99170..ae3a2ae 100755 --- a/members/routing-lists.pl +++ b/members/routing-lists.pl @@ -27,7 +27,6 @@ use C4::Members::Attributes qw(GetBorrowerAttributes); use C4::Context; use C4::Serials; use Koha::Patron::Images; -use CGI::Session; my $query = new CGI; diff --git a/tools/background-job-progress.pl b/tools/background-job-progress.pl index 811f5b2..e083d57 100755 --- a/tools/background-job-progress.pl +++ b/tools/background-job-progress.pl @@ -23,7 +23,6 @@ use strict; # standard or CPAN modules used use IO::File; use CGI qw ( -utf8 ); -use CGI::Session; use C4::Context; use C4::Auth qw/check_cookie_auth/; use C4::BackgroundJob; -- 2.1.4