From f1406faf5bafb4518570a47f8ebed199b183023c 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 This is just a POC and will only works with SessionStorage set to MySQL. Please test it and tell me if you find bug. If it looks bug free I will submit a follow-up to cover the other combinations of SessionStorage (temporary storage and Memcached) --- C4/Auth.pm | 31 +++++++++++++------------------ C4/Context.pm | 4 +--- C4/InstallAuth.pm | 13 +++++++------ C4/Installer/PerlDependencies.pm | 15 --------------- circ/circulation.pl | 2 +- members/routing-lists.pl | 1 - tools/background-job-progress.pl | 1 - 7 files changed, 22 insertions(+), 45 deletions(-) diff --git a/C4/Auth.pm b/C4/Auth.pm index 6b7dc66..356964a 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; @@ -905,7 +905,7 @@ sub checkauth { unless ( $userid || $sessionID ) { #we initiate a session prior to checking for a username to allow for anonymous sessions... - my $session = get_session("") or die "Auth ERROR: Cannot get_session()"; + my $session = get_session("") or return;#die "Auth ERROR: Cannot get_session()"; # Save anonymous search history in new session so it can be retrieved # by get_template_and_user to store it in user's search history after @@ -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,16 @@ 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 } ); + $session = Data::Session->new( dbh => $dbh, id => $sessionID ); } elsif ( $storage_method eq 'Pg' ) { - $session = new CGI::Session( "driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, { Handle => $dbh } ); + die "not implemented yet"; } 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 } ); + die "not implemented yet"; } 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" } ); + die "not implemented yet"; } return $session; } diff --git a/C4/Context.pm b/C4/Context.pm index 5f49bbe..b1d8b92 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -857,9 +857,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..d9d7754 100644 --- a/C4/InstallAuth.pm +++ b/C4/InstallAuth.pm @@ -26,7 +26,6 @@ use C4::Context; use C4::Output; use C4::Templates; use C4::Koha; -use CGI::Session; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); @@ -241,9 +240,10 @@ sub checkauth { my $logout = $query->param('logout.x'); if ( $sessionID = $query->cookie("CGISESSID") ) { C4::Context->_new_userenv($sessionID); - my $session = - new CGI::Session( "driver:File;serializer:yaml", $sessionID, - { Directory => '/tmp' } ); + # FIXME Use Data::Session instead + my $session; + #new CGI::Session( "driver:File;serializer:yaml", $sessionID, + # { Directory => '/tmp' } ); if ( $session->param('cardnumber') ) { C4::Context->set_userenv( $session->param('number'), @@ -282,8 +282,9 @@ sub checkauth { } } unless ($userid) { - my $session = - new CGI::Session( "driver:File;serializer:yaml", undef, { Directory => '/tmp' } ); + # FIXME Use Data::Session instead + my $session;# = + # new CGI::Session( "driver:File;serializer:yaml", undef, { Directory => '/tmp' } ); $sessionID = $session->id; $userid = $query->param('userid'); C4::Context->_new_userenv($sessionID); diff --git a/C4/Installer/PerlDependencies.pm b/C4/Installer/PerlDependencies.pm index de00fd7..e389f6b 100644 --- a/C4/Installer/PerlDependencies.pm +++ b/C4/Installer/PerlDependencies.pm @@ -317,11 +317,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', @@ -427,16 +422,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', diff --git a/circ/circulation.pl b/circ/circulation.pl index fcd967d..cf19804 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::Patron; use Koha::Patron::Debarments qw(GetDebarments); 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.8.1