@@ -, +, @@ 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; } --- 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(-) --- a/C4/Auth.pm +++ a/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; } --- a/C4/InstallAuth.pm +++ a/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'); } --- a/circ/circulation.pl +++ a/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; --- a/cpanfile +++ a/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'; --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref +++ a/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 - --- a/members/routing-lists.pl +++ a/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; --- a/tools/background-job-progress.pl +++ a/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; --