Lines 24-30
use Carp qw/croak/;
Link Here
|
24 |
use Digest::MD5 qw(md5_base64); |
24 |
use Digest::MD5 qw(md5_base64); |
25 |
use JSON qw/encode_json/; |
25 |
use JSON qw/encode_json/; |
26 |
use URI::Escape; |
26 |
use URI::Escape; |
27 |
use CGI::Session; |
27 |
use Data::Session; |
28 |
|
28 |
|
29 |
require Exporter; |
29 |
require Exporter; |
30 |
use C4::Context; |
30 |
use C4::Context; |
Lines 1232-1238
sub checkauth {
Link Here
|
1232 |
$session->param( 'desk_name', $desk_name); |
1232 |
$session->param( 'desk_name', $desk_name); |
1233 |
$session->param( 'flags', $userflags ); |
1233 |
$session->param( 'flags', $userflags ); |
1234 |
$session->param( 'emailaddress', $emailaddress ); |
1234 |
$session->param( 'emailaddress', $emailaddress ); |
1235 |
$session->param( 'ip', $session->remote_addr() ); |
1235 |
$session->param( 'ip', $ENV{REMOTE_ADDR} ); |
1236 |
$session->param( 'lasttime', time() ); |
1236 |
$session->param( 'lasttime', time() ); |
1237 |
$session->param( 'interface', $type); |
1237 |
$session->param( 'interface', $type); |
1238 |
$session->param( 'shibboleth', $shibSuccess ); |
1238 |
$session->param( 'shibboleth', $shibSuccess ); |
Lines 1261-1267
sub checkauth {
Link Here
|
1261 |
C4::Context->_unset_userenv($sessionID); |
1261 |
C4::Context->_unset_userenv($sessionID); |
1262 |
} |
1262 |
} |
1263 |
$session->param( 'lasttime', time() ); |
1263 |
$session->param( 'lasttime', time() ); |
1264 |
$session->param( 'ip', $session->remote_addr() ); |
1264 |
$session->param( 'ip', $ENV{REMOTE_ADDR} ); |
1265 |
$session->param( 'sessiontype', 'anon' ); |
1265 |
$session->param( 'sessiontype', 'anon' ); |
1266 |
$session->param( 'interface', $type); |
1266 |
$session->param( 'interface', $type); |
1267 |
} |
1267 |
} |
Lines 1273-1279
sub checkauth {
Link Here
|
1273 |
$debug and warn "Initiating an anonymous session..."; |
1273 |
$debug and warn "Initiating an anonymous session..."; |
1274 |
|
1274 |
|
1275 |
# setting a couple of other session vars... |
1275 |
# setting a couple of other session vars... |
1276 |
$session->param( 'ip', $session->remote_addr() ); |
1276 |
$session->param( 'ip', $ENV{REMOTE_ADDR} ); |
1277 |
$session->param( 'lasttime', time() ); |
1277 |
$session->param( 'lasttime', time() ); |
1278 |
$session->param( 'sessiontype', 'anon' ); |
1278 |
$session->param( 'sessiontype', 'anon' ); |
1279 |
$session->param( 'interface', $type); |
1279 |
$session->param( 'interface', $type); |
Lines 1686-1692
sub check_api_auth {
Link Here
|
1686 |
$session->param( 'branchname', $branchname ); |
1686 |
$session->param( 'branchname', $branchname ); |
1687 |
$session->param( 'flags', $userflags ); |
1687 |
$session->param( 'flags', $userflags ); |
1688 |
$session->param( 'emailaddress', $emailaddress ); |
1688 |
$session->param( 'emailaddress', $emailaddress ); |
1689 |
$session->param( 'ip', $session->remote_addr() ); |
1689 |
$session->param( 'ip', $ENV{REMOTE_ADDR} ); |
1690 |
$session->param( 'lasttime', time() ); |
1690 |
$session->param( 'lasttime', time() ); |
1691 |
$session->param( 'interface', 'api' ); |
1691 |
$session->param( 'interface', 'api' ); |
1692 |
} |
1692 |
} |
Lines 1833-1842
sub check_cookie_auth {
Link Here
|
1833 |
|
1833 |
|
1834 |
=head2 get_session |
1834 |
=head2 get_session |
1835 |
|
1835 |
|
1836 |
use CGI::Session; |
|
|
1837 |
my $session = get_session($sessionID); |
1836 |
my $session = get_session($sessionID); |
1838 |
|
1837 |
|
1839 |
Given a session ID, retrieve the CGI::Session object used to store |
1838 |
Given a session ID, retrieve the Data::Session object used to store |
1840 |
the session's state. The session object can be used to store |
1839 |
the session's state. The session object can be used to store |
1841 |
data that needs to be accessed by different scripts during a |
1840 |
data that needs to be accessed by different scripts during a |
1842 |
user's session. |
1841 |
user's session. |
Lines 1850-1880
sub _get_session_params {
Link Here
|
1850 |
my $storage_method = C4::Context->preference('SessionStorage'); |
1849 |
my $storage_method = C4::Context->preference('SessionStorage'); |
1851 |
if ( $storage_method eq 'mysql' ) { |
1850 |
if ( $storage_method eq 'mysql' ) { |
1852 |
my $dbh = C4::Context->dbh; |
1851 |
my $dbh = C4::Context->dbh; |
1853 |
return { dsn => "serializer:yamlxs;driver:MySQL;id:md5", dsn_args => { Handle => $dbh } }; |
1852 |
# Note that the doc is wrong, type is required, if not provided it default to File |
1854 |
} |
1853 |
return { dbh => $dbh, type => 'serialize:yamlxs;driver:mysql;id:MD5' }; |
1855 |
elsif ( $storage_method eq 'Pg' ) { |
1854 |
} elsif ( $storage_method eq 'Pg' ) { |
1856 |
my $dbh = C4::Context->dbh; |
1855 |
die "The system preference SessionStorage is set to 'Pg' but this is not supported yet!"; |
1857 |
return { dsn => "serializer:yamlxs;driver:PostgreSQL;id:md5", dsn_args => { Handle => $dbh } }; |
1856 |
} elsif ( $storage_method eq 'memcached' and my $memcached = Koha::Caches->get_instance->memcached_cache ) { |
1858 |
} |
1857 |
return { |
1859 |
elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) { |
1858 |
type => 'serialize:yamlxs;driver:Memcached;id:SHA1', |
1860 |
my $memcached = Koha::Caches->get_instance()->memcached_cache; |
1859 |
cache => $memcached, |
1861 |
return { dsn => "serializer:yamlxs;driver:memcached;id:md5", dsn_args => { Memcached => $memcached } }; |
1860 |
}; |
|
|
1861 |
} elsif ( $storage_method ne 'tmp' ) { |
1862 |
warn "The system preference SessionStorage is set to an invalid value '$storage_method'"; |
1862 |
} |
1863 |
} |
1863 |
else { |
1864 |
else { |
1864 |
# catch all defaults to tmp should work on all systems |
1865 |
# catch all defaults to tmp should work on all systems |
|
|
1866 |
if ( $storage_method ne 'tmp' ) { |
1867 |
warn "The session has not been correctly retrieved, defaulting to temporary storage: " . $Data::Session::errstr; |
1868 |
} |
1865 |
my $dir = C4::Context::temporary_directory; |
1869 |
my $dir = C4::Context::temporary_directory; |
1866 |
my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is |
1870 |
my $instance = C4::Context->config('database'); #actually for packages not exactly the instance name, but generally safer to leave it as it is |
1867 |
return { dsn => "serializer:yamlxs;driver:File;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } }; |
1871 |
return { type => 'serialize:yamlxs;driver:File;id:MD5', directory => "$dir/cgisess_$instance" }; |
1868 |
} |
1872 |
} |
1869 |
} |
1873 |
} |
1870 |
|
1874 |
|
1871 |
sub get_session { |
1875 |
sub get_session { |
1872 |
my $sessionID = shift; |
1876 |
my $sessionID = shift; |
1873 |
my $params = _get_session_params(); |
1877 |
my $params = _get_session_params(); |
1874 |
my $session = CGI::Session->new( $params->{dsn}, $sessionID, $params->{dsn_args} ); |
1878 |
my $session = Data::Session->new( %$params ) || die $Data::Session::errstr; |
1875 |
if ( ! $session ){ |
|
|
1876 |
die CGI::Session->errstr(); |
1877 |
} |
1878 |
return $session; |
1879 |
return $session; |
1879 |
} |
1880 |
} |
1880 |
|
1881 |
|