Lines 24-29
use Carp qw( croak );
Link Here
|
24 |
use Digest::MD5 qw( md5_base64 ); |
24 |
use Digest::MD5 qw( md5_base64 ); |
25 |
use CGI::Session; |
25 |
use CGI::Session; |
26 |
use CGI::Session::ErrorHandler; |
26 |
use CGI::Session::ErrorHandler; |
|
|
27 |
use Data::Session; |
27 |
use URI; |
28 |
use URI; |
28 |
use URI::QueryParam; |
29 |
use URI::QueryParam; |
29 |
|
30 |
|
Lines 1228-1234
sub checkauth {
Link Here
|
1228 |
$session->param( 'desk_name', $desk_name); |
1229 |
$session->param( 'desk_name', $desk_name); |
1229 |
$session->param( 'flags', $userflags ); |
1230 |
$session->param( 'flags', $userflags ); |
1230 |
$session->param( 'emailaddress', $emailaddress ); |
1231 |
$session->param( 'emailaddress', $emailaddress ); |
1231 |
$session->param( 'ip', $session->remote_addr() ); |
1232 |
$session->param( 'ip', $ENV{REMOTE_ADDR} ); |
1232 |
$session->param( 'lasttime', time() ); |
1233 |
$session->param( 'lasttime', time() ); |
1233 |
$session->param( 'interface', $type); |
1234 |
$session->param( 'interface', $type); |
1234 |
$session->param( 'shibboleth', $shibSuccess ); |
1235 |
$session->param( 'shibboleth', $shibSuccess ); |
Lines 1256-1262
sub checkauth {
Link Here
|
1256 |
C4::Context::_unset_userenv($sessionID); |
1257 |
C4::Context::_unset_userenv($sessionID); |
1257 |
} |
1258 |
} |
1258 |
$session->param( 'lasttime', time() ); |
1259 |
$session->param( 'lasttime', time() ); |
1259 |
$session->param( 'ip', $session->remote_addr() ); |
1260 |
$session->param( 'ip', $ENV{REMOTE_ADDR} ); |
1260 |
$session->param( 'sessiontype', 'anon' ); |
1261 |
$session->param( 'sessiontype', 'anon' ); |
1261 |
$session->param( 'interface', $type); |
1262 |
$session->param( 'interface', $type); |
1262 |
} |
1263 |
} |
Lines 1266-1272
sub checkauth {
Link Here
|
1266 |
# anonymous sessions are created only for the OPAC |
1267 |
# anonymous sessions are created only for the OPAC |
1267 |
|
1268 |
|
1268 |
# setting a couple of other session vars... |
1269 |
# setting a couple of other session vars... |
1269 |
$session->param( 'ip', $session->remote_addr() ); |
1270 |
$session->param( 'ip', $ENV{REMOTE_ADDR} ); |
1270 |
$session->param( 'lasttime', time() ); |
1271 |
$session->param( 'lasttime', time() ); |
1271 |
$session->param( 'sessiontype', 'anon' ); |
1272 |
$session->param( 'sessiontype', 'anon' ); |
1272 |
$session->param( 'interface', $type); |
1273 |
$session->param( 'interface', $type); |
Lines 1663-1669
sub check_api_auth {
Link Here
|
1663 |
$session->param( 'branchname', $branchname ); |
1664 |
$session->param( 'branchname', $branchname ); |
1664 |
$session->param( 'flags', $userflags ); |
1665 |
$session->param( 'flags', $userflags ); |
1665 |
$session->param( 'emailaddress', $emailaddress ); |
1666 |
$session->param( 'emailaddress', $emailaddress ); |
1666 |
$session->param( 'ip', $session->remote_addr() ); |
1667 |
$session->param( 'ip', $ENV{REMOTE_ADDR} ); |
1667 |
$session->param( 'lasttime', time() ); |
1668 |
$session->param( 'lasttime', time() ); |
1668 |
$session->param( 'interface', 'api' ); |
1669 |
$session->param( 'interface', 'api' ); |
1669 |
} |
1670 |
} |
Lines 1819-1828
sub check_cookie_auth {
Link Here
|
1819 |
|
1820 |
|
1820 |
=head2 get_session |
1821 |
=head2 get_session |
1821 |
|
1822 |
|
1822 |
use CGI::Session; |
|
|
1823 |
my $session = get_session($sessionID); |
1823 |
my $session = get_session($sessionID); |
1824 |
|
1824 |
|
1825 |
Given a session ID, retrieve the CGI::Session object used to store |
1825 |
Given a session ID, retrieve the Data::Session object used to store |
1826 |
the session's state. The session object can be used to store |
1826 |
the session's state. The session object can be used to store |
1827 |
data that needs to be accessed by different scripts during a |
1827 |
data that needs to be accessed by different scripts during a |
1828 |
user's session. |
1828 |
user's session. |
Lines 1836-1870
sub _get_session_params {
Link Here
|
1836 |
my $storage_method = C4::Context->preference('SessionStorage'); |
1836 |
my $storage_method = C4::Context->preference('SessionStorage'); |
1837 |
if ( $storage_method eq 'mysql' ) { |
1837 |
if ( $storage_method eq 'mysql' ) { |
1838 |
my $dbh = C4::Context->dbh; |
1838 |
my $dbh = C4::Context->dbh; |
1839 |
return { dsn => "serializer:yamlxs;driver:MySQL;id:md5", dsn_args => { Handle => $dbh } }; |
1839 |
# Note that the doc is wrong, type is required, if not provided it default to File |
1840 |
} |
1840 |
return { dbh => $dbh, type => 'serialize:yamlxs;driver:mysql;id:MD5' }; |
1841 |
elsif ( $storage_method eq 'Pg' ) { |
1841 |
} elsif ( $storage_method eq 'Pg' ) { |
1842 |
my $dbh = C4::Context->dbh; |
1842 |
die "The system preference SessionStorage is set to 'Pg' but this is not supported yet!"; |
1843 |
return { dsn => "serializer:yamlxs;driver:PostgreSQL;id:md5", dsn_args => { Handle => $dbh } }; |
1843 |
} elsif ( $storage_method eq 'memcached' and my $memcached = Koha::Caches->get_instance->memcached_cache ) { |
1844 |
} |
1844 |
return { |
1845 |
elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) { |
1845 |
type => 'serialize:yamlxs;driver:Memcached;id:SHA1', |
1846 |
my $memcached = Koha::Caches->get_instance()->memcached_cache; |
1846 |
cache => $memcached, |
1847 |
return { dsn => "serializer:yamlxs;driver:memcached;id:md5", dsn_args => { Memcached => $memcached } }; |
1847 |
}; |
|
|
1848 |
} elsif ( $storage_method ne 'tmp' ) { |
1849 |
warn "The system preference SessionStorage is set to an invalid value '$storage_method'"; |
1848 |
} |
1850 |
} |
1849 |
else { |
1851 |
else { |
1850 |
# catch all defaults to tmp should work on all systems |
1852 |
# catch all defaults to tmp should work on all systems |
|
|
1853 |
if ( $storage_method ne 'tmp' ) { |
1854 |
warn "The session has not been correctly retrieved, defaulting to temporary storage: " . $Data::Session::errstr; |
1855 |
} |
1851 |
my $dir = C4::Context::temporary_directory; |
1856 |
my $dir = C4::Context::temporary_directory; |
1852 |
my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is |
1857 |
my $instance = C4::Context->config('database'); #actually for packages not exactly the instance name, but generally safer to leave it as it is |
1853 |
return { dsn => "serializer:yamlxs;driver:File;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } }; |
1858 |
return { type => 'serialize:yamlxs;driver:File;id:MD5', directory => "$dir/cgisess_$instance" }; |
1854 |
} |
1859 |
} |
1855 |
} |
1860 |
} |
1856 |
|
1861 |
|
1857 |
sub get_session { |
1862 |
sub get_session { |
1858 |
my $sessionID = shift; |
1863 |
my $sessionID = shift; |
1859 |
my $params = _get_session_params(); |
1864 |
my $params = _get_session_params(); |
1860 |
my $session; |
1865 |
my $session = Data::Session->new( %$params ) || die $Data::Session::errstr; |
1861 |
if( $sessionID ) { # find existing |
|
|
1862 |
CGI::Session::ErrorHandler->set_error( q{} ); # clear error, cpan issue #111463 |
1863 |
$session = CGI::Session->load( $params->{dsn}, $sessionID, $params->{dsn_args} ); |
1864 |
} else { |
1865 |
$session = CGI::Session->new( $params->{dsn}, $sessionID, $params->{dsn_args} ); |
1866 |
# no need to flush here |
1867 |
} |
1868 |
return $session; |
1866 |
return $session; |
1869 |
} |
1867 |
} |
1870 |
|
1868 |
|