@@ -, +, @@ 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/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(-) --- a/C4/Auth.pm +++ a/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; } --- a/C4/Context.pm +++ a/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, --- a/C4/InstallAuth.pm +++ a/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'); } --- a/C4/Installer/PerlDependencies.pm +++ a/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', @@ -847,6 +832,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; --- a/circ/circulation.pl +++ a/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; --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref +++ a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref @@ -97,7 +97,6 @@ Administration: default: mysql choices: mysql: in the MySQL database. - Pg: in the PostgreSQL database (not supported). tmp: as temporary files. memcached: in a memcached server. - --- a/members/routing-lists.pl +++ a/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; --- a/tools/background-job-progress.pl +++ a/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; --