3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
21 use Digest
::MD5
qw(md5_base64);
22 use Storable
qw(thaw freeze);
28 use C4
::Output
; # to get the template
31 use C4
::Branch
; # GetBranches
32 use C4
::VirtualShelves
;
33 use POSIX qw
/strftime/;
36 use vars
qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout);
39 $VERSION = 3.02; # set version for version checking
42 @EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
43 @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &get_all_subpermissions &get_user_subpermissions);
44 %EXPORT_TAGS = (EditPermissions
=> [qw(get_all_subpermissions get_user_subpermissions)]);
45 $ldap = C4
::Context
->config('useldapserver') || 0;
46 $cas = C4
::Context
->preference('casAuthentication');
47 $caslogout = C4
::Context
->preference('casLogout');
49 require C4
::Auth_with_ldap
; # no import
50 import C4
::Auth_with_ldap
qw(checkpw_ldap);
53 require C4
::Auth_with_cas
; # no import
54 import C4
::Auth_with_cas
qw(checkpw_cas login_cas logout_cas login_cas_url);
61 C4::Auth - Authenticates Koha users
71 my ($template, $borrowernumber, $cookie)
72 = get_template_and_user(
74 template_name => "opac-main.tmpl",
78 flagsrequired => {borrow => 1, catalogue => '*', tools => 'import_patrons' },
82 output_html_with_http_headers $query, $cookie, $template->output;
86 The main function of this module is to provide
87 authentification. However the get_template_and_user function has
88 been provided so that a users login information is passed along
89 automatically. This gets loaded into the template.
95 =item get_template_and_user
97 my ($template, $borrowernumber, $cookie)
98 = get_template_and_user(
100 template_name => "opac-main.tmpl",
103 authnotrequired => 1,
104 flagsrequired => {borrow => 1, catalogue => '*', tools => 'import_patrons' },
108 This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
109 to C<&checkauth> (in this module) to perform authentification.
110 See C<&checkauth> for an explanation of these parameters.
112 The C<template_name> is then used to find the correct template for
113 the page. The authenticated users details are loaded onto the
114 template in the HTML::Template LOOP variable C<USER_INFO>. Also the
115 C<sessionID> is passed to the template. This can be used in templates
116 if cookies are disabled. It needs to be put as and input to every
119 More information on the C<gettemplate> sub can be found in the
124 sub get_template_and_user
{
127 gettemplate
( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
128 my ( $user, $cookie, $sessionID, $flags ) = checkauth
(
130 $in->{'authnotrequired'},
131 $in->{'flagsrequired'},
133 ) unless ($in->{'template_name'}=~/maintenance/);
136 my $insecure = C4
::Context
->preference('insecure');
137 if ($user or $insecure) {
139 # load the template variables for stylesheets and JavaScript
140 $template->param( css_libs
=> $in->{'css_libs'} );
141 $template->param( css_module
=> $in->{'css_module'} );
142 $template->param( css_page
=> $in->{'css_page'} );
143 $template->param( css_widgets
=> $in->{'css_widgets'} );
145 $template->param( js_libs
=> $in->{'js_libs'} );
146 $template->param( js_module
=> $in->{'js_module'} );
147 $template->param( js_page
=> $in->{'js_page'} );
148 $template->param( js_widgets
=> $in->{'js_widgets'} );
151 $template->param( loggedinusername
=> $user );
152 $template->param( sessionID
=> $sessionID );
154 my ($total, $pubshelves, $barshelves) = C4
::Context
->get_shelves_userenv();
155 if (defined($pubshelves)) {
156 $template->param( pubshelves
=> scalar (@
$pubshelves),
157 pubshelvesloop
=> $pubshelves,
159 $template->param( pubtotal
=> $total->{'pubtotal'}, ) if ($total->{'pubtotal'} > scalar (@
$pubshelves));
161 if (defined($barshelves)) {
162 $template->param( barshelves
=> scalar (@
$barshelves),
163 barshelvesloop
=> $barshelves,
165 $template->param( bartotal
=> $total->{'bartotal'}, ) if ($total->{'bartotal'} > scalar (@
$barshelves));
168 $borrowernumber = getborrowernumber
($user);
169 my ( $borr ) = GetMemberDetails
( $borrowernumber );
172 $template->param( "USER_INFO" => \
@bordat );
174 my $all_perms = get_all_subpermissions
();
176 my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
177 editcatalogue updatecharges management tools editauthorities serials reports acquisition);
178 # We are going to use the $flags returned by checkauth
179 # to create the template's parameters that will indicate
180 # which menus the user can access.
181 if (( $flags && $flags->{superlibrarian
}==1) or $insecure==1) {
182 $template->param( CAN_user_circulate
=> 1 );
183 $template->param( CAN_user_catalogue
=> 1 );
184 $template->param( CAN_user_parameters
=> 1 );
185 $template->param( CAN_user_borrowers
=> 1 );
186 $template->param( CAN_user_permissions
=> 1 );
187 $template->param( CAN_user_reserveforothers
=> 1 );
188 $template->param( CAN_user_borrow
=> 1 );
189 $template->param( CAN_user_editcatalogue
=> 1 );
190 $template->param( CAN_user_updatecharges
=> 1 );
191 $template->param( CAN_user_acquisition
=> 1 );
192 $template->param( CAN_user_management
=> 1 );
193 $template->param( CAN_user_tools
=> 1 );
194 $template->param( CAN_user_editauthorities
=> 1 );
195 $template->param( CAN_user_serials
=> 1 );
196 $template->param( CAN_user_reports
=> 1 );
197 $template->param( CAN_user_staffaccess
=> 1 );
198 foreach my $module (keys %$all_perms) {
199 foreach my $subperm (keys %{ $all_perms->{$module} }) {
200 $template->param( "CAN_user_${module}_${subperm}" => 1 );
205 if (C4
::Context
->preference('GranularPermissions')) {
207 foreach my $module (keys %$all_perms) {
208 if ( $flags->{$module} == 1) {
209 foreach my $subperm (keys %{ $all_perms->{$module} }) {
210 $template->param( "CAN_user_${module}_${subperm}" => 1 );
212 } elsif ( ref($flags->{$module}) ) {
213 foreach my $subperm (keys %{ $flags->{$module} } ) {
214 $template->param( "CAN_user_${module}_${subperm}" => 1 );
220 foreach my $module (keys %$all_perms) {
221 foreach my $subperm (keys %{ $all_perms->{$module} }) {
222 $template->param( "CAN_user_${module}_${subperm}" => 1 );
228 foreach my $module (keys %$flags) {
229 if ( $flags->{$module} == 1 or ref($flags->{$module}) ) {
230 $template->param( "CAN_user_$module" => 1 );
231 if ($module eq "parameters") {
232 $template->param( CAN_user_management
=> 1 );
237 # Logged-in opac search history
238 # If the requested template is an opac one and opac search history is enabled
239 if ($in->{'type'} == "opac" && C4
::Context
->preference('EnableOpacSearchHistory')) {
240 my $dbh = C4
::Context
->dbh;
241 my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
242 my $sth = $dbh->prepare($query);
243 $sth->execute($borrowernumber);
245 # If at least one search has already been performed
246 if ($sth->fetchrow_array > 0) {
247 # We show the link in opac
248 $template->param(ShowOpacRecentSearchLink
=> 1);
251 # And if there's a cookie with searches performed when the user was not logged in,
252 # we add them to the logged-in search history
254 my $searchcookie = $in->{'query'}->cookie('KohaOpacRecentSearches');
256 $searchcookie = uri_unescape
($searchcookie);
257 if (thaw
($searchcookie)) {
258 @recentSearches = @
{thaw
($searchcookie)};
261 if (@recentSearches > 0) {
262 my $query = "INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time) VALUES";
264 foreach my $asearch (@recentSearches) {
266 $query .= $borrowernumber . ", ";
267 $query .= '"' . $in->{'query'}->cookie("CGISESSID") . "\", ";
268 $query .= '"' . $asearch->{'query_desc'} . "\", ";
269 $query .= '"' . $asearch->{'query_cgi'} . "\", ";
270 $query .= $asearch->{'total'} . ", ";
271 $query .= 'FROM_UNIXTIME(' . $asearch->{'time'} . "))";
272 if ($icount < @recentSearches) { $query .= ", ";}
276 my $sth = $dbh->prepare($query);
279 # And then, delete the cookie's content
280 my $newsearchcookie = $in->{'query'}->cookie(
281 -name
=> 'KohaOpacRecentSearches',
282 -value
=> freeze
([]),
285 $cookie = [$cookie, $newsearchcookie];
290 else { # if this is an anonymous session, setup to display public lists...
292 # load the template variables for stylesheets and JavaScript
293 $template->param( css_libs
=> $in->{'css_libs'} );
294 $template->param( css_module
=> $in->{'css_module'} );
295 $template->param( css_page
=> $in->{'css_page'} );
296 $template->param( css_widgets
=> $in->{'css_widgets'} );
298 $template->param( js_libs
=> $in->{'js_libs'} );
299 $template->param( js_module
=> $in->{'js_module'} );
300 $template->param( js_page
=> $in->{'js_page'} );
301 $template->param( js_widgets
=> $in->{'js_widgets'} );
303 $template->param( sessionID
=> $sessionID );
305 my ($total, $pubshelves) = C4
::Context
->get_shelves_userenv(); # an anonymous user has no 'barshelves'...
306 if (defined(($pubshelves))) {
307 $template->param( pubshelves
=> scalar (@
$pubshelves),
308 pubshelvesloop
=> $pubshelves,
310 $template->param( pubtotal
=> $total->{'pubtotal'}, ) if ($total->{'pubtotal'} > scalar (@
$pubshelves));
314 # Anonymous opac search history
315 # If opac search history is enabled and at least one search has already been performed
316 if (C4
::Context
->preference('EnableOpacSearchHistory') && $in->{'query'}->cookie('KohaOpacRecentSearches')) {
317 # We show the link in opac
318 if (thaw
(uri_unescape
($in->{'query'}->cookie('KohaOpacRecentSearches')))) {
319 my @recentSearches = @
{thaw
(uri_unescape
($in->{'query'}->cookie('KohaOpacRecentSearches')))};
320 if (@recentSearches > 0) {
321 $template->param(ShowOpacRecentSearchLink
=> 1);
326 # these template parameters are set the same regardless of $in->{'type'}
328 "BiblioDefaultView".C4
::Context
->preference("BiblioDefaultView") => 1,
329 EnhancedMessagingPreferences
=> C4
::Context
->preference('EnhancedMessagingPreferences'),
330 GoogleJackets
=> C4
::Context
->preference("GoogleJackets"),
331 KohaAdminEmailAddress
=> "" . C4
::Context
->preference("KohaAdminEmailAddress"),
332 LoginBranchcode
=> (C4
::Context
->userenv?C4
::Context
->userenv->{"branch"}:"insecure"),
333 LoginFirstname
=> (C4
::Context
->userenv?C4
::Context
->userenv->{"firstname"}:"Bel"),
334 LoginSurname
=> C4
::Context
->userenv?C4
::Context
->userenv->{"surname"}:"Inconnu",
335 TagsEnabled
=> C4
::Context
->preference("TagsEnabled"),
336 hide_marc
=> C4
::Context
->preference("hide_marc"),
337 'item-level_itypes' => C4
::Context
->preference('item-level_itypes'),
338 patronimages
=> C4
::Context
->preference("patronimages"),
339 singleBranchMode
=> C4
::Context
->preference("singleBranchMode"),
340 XSLTDetailsDisplay
=> C4
::Context
->preference("XSLTDetailsDisplay"),
341 XSLTResultsDisplay
=> C4
::Context
->preference("XSLTResultsDisplay"),
344 if ( $in->{'type'} eq "intranet" ) {
346 AmazonContent
=> C4
::Context
->preference("AmazonContent"),
347 AmazonSimilarItems
=> C4
::Context
->preference("AmazonSimilarItems"),
348 AutoLocation
=> C4
::Context
->preference("AutoLocation"),
349 "BiblioDefaultView".C4
::Context
->preference("IntranetBiblioDefaultView") => 1,
350 CircAutocompl
=> C4
::Context
->preference("CircAutocompl"),
351 FRBRizeEditions
=> C4
::Context
->preference("FRBRizeEditions"),
352 IndependantBranches
=> C4
::Context
->preference("IndependantBranches"),
353 IntranetNav
=> C4
::Context
->preference("IntranetNav"),
354 IntranetmainUserblock
=> C4
::Context
->preference("IntranetmainUserblock"),
355 LibraryName
=> C4
::Context
->preference("LibraryName"),
356 LoginBranchname
=> (C4
::Context
->userenv?C4
::Context
->userenv->{"branchname"}:"insecure"),
357 TemplateEncoding
=> C4
::Context
->preference("TemplateEncoding"),
358 advancedMARCEditor
=> C4
::Context
->preference("advancedMARCEditor"),
359 canreservefromotherbranches
=> C4
::Context
->preference('canreservefromotherbranches'),
360 intranetcolorstylesheet
=> C4
::Context
->preference("intranetcolorstylesheet"),
361 intranetreadinghistory
=> C4
::Context
->preference("intranetreadinghistory"),
362 intranetstylesheet
=> C4
::Context
->preference("intranetstylesheet"),
363 intranetuserjs
=> C4
::Context
->preference("intranetuserjs"),
364 intranetbookbag
=> C4
::Context
->preference("intranetbookbag"),
365 noItemTypeImages
=> C4
::Context
->preference("noItemTypeImages"),
366 suggestion
=> C4
::Context
->preference("suggestion"),
367 virtualshelves
=> C4
::Context
->preference("virtualshelves"),
368 StaffSerialIssueDisplayCount
=> C4
::Context
->preference("StaffSerialIssueDisplayCount"),
369 NoZebra
=> C4
::Context
->preference('NoZebra'),
373 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
374 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
375 my $LibraryNameTitle = C4
::Context
->preference("LibraryName");
376 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?
)>/ /sgi;
377 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
378 # variables passed from CGI: opac_css_override and opac_search_limits.
379 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
380 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
381 my $mylibraryfirst = C4
::Context
->preference("SearchMyLibraryFirst");
383 if($opac_limit_override && ($opac_search_limit =~ /branch:(\w+)/) ){
384 $opac_name = C4
::Branch
::GetBranchName
($1) # opac_search_limit is a branch, so we use it.
385 } elsif($mylibraryfirst){
386 $opac_name = C4
::Branch
::GetBranchName
($mylibraryfirst);
389 AmazonContent
=> "" . C4
::Context
->preference("AmazonContent"),
390 AnonSuggestions
=> "" . C4
::Context
->preference("AnonSuggestions"),
391 AuthorisedValueImages
=> C4
::Context
->preference("AuthorisedValueImages"),
392 LibraryName
=> "" . C4
::Context
->preference("LibraryName"),
393 LibraryNameTitle
=> "" . $LibraryNameTitle,
394 LoginBranchname
=> C4
::Context
->userenv?C4
::Context
->userenv->{"branchname"}:"",
395 OPACAmazonEnabled
=> C4
::Context
->preference("OPACAmazonEnabled"),
396 OPACAmazonSimilarItems
=> C4
::Context
->preference("OPACAmazonSimilarItems"),
397 OPACAmazonCoverImages
=> C4
::Context
->preference("OPACAmazonCoverImages"),
398 OPACAmazonReviews
=> C4
::Context
->preference("OPACAmazonReviews"),
399 OPACFRBRizeEditions
=> C4
::Context
->preference("OPACFRBRizeEditions"),
400 OPACItemHolds
=> C4
::Context
->preference("OPACItemHolds"),
401 OPACShelfBrowser
=> "". C4
::Context
->preference("OPACShelfBrowser"),
402 OPACURLOpenInNewWindow
=> "" . C4
::Context
->preference("OPACURLOpenInNewWindow"),
403 OPACUserCSS
=> "". C4
::Context
->preference("OPACUserCSS"),
404 OPACViewOthersSuggestions
=> "" . C4
::Context
->preference("OPACViewOthersSuggestions"),
405 OpacAuthorities
=> C4
::Context
->preference("OpacAuthorities"),
406 OPACBaseURL
=> ($in->{'query'}->https() ?
"https://" : "http://") . $ENV{'SERVER_NAME'} .
407 ($ENV{'SERVER_PORT'} eq ($in->{'query'}->https() ?
"443" : "80") ?
'' : ":$ENV{'SERVER_PORT'}"),
408 opac_name
=> $opac_name,
409 opac_css_override
=> $ENV{'OPAC_CSS_OVERRIDE'},
410 opac_search_limit
=> $opac_search_limit,
411 opac_limit_override
=> $opac_limit_override,
412 OpacBrowser
=> C4
::Context
->preference("OpacBrowser"),
413 OpacCloud
=> C4
::Context
->preference("OpacCloud"),
414 OpacMainUserBlock
=> "" . C4
::Context
->preference("OpacMainUserBlock"),
415 OpacNav
=> "" . C4
::Context
->preference("OpacNav"),
416 OpacPasswordChange
=> C4
::Context
->preference("OpacPasswordChange"),
417 OPACPatronDetails
=> C4
::Context
->preference("OPACPatronDetails"),
418 OPACFinesTab
=> C4
::Context
->preference("OPACFinesTab"),
419 OpacTopissue
=> C4
::Context
->preference("OpacTopissue"),
420 RequestOnOpac
=> C4
::Context
->preference("RequestOnOpac"),
421 TemplateEncoding
=> "". C4
::Context
->preference("TemplateEncoding"),
422 'Version' => C4
::Context
->preference('Version'),
423 hidelostitems
=> C4
::Context
->preference("hidelostitems"),
424 mylibraryfirst
=> (C4
::Context
->preference("SearchMyLibraryFirst") && C4
::Context
->userenv) ? C4
::Context
->userenv->{'branch'} : '',
425 opaclayoutstylesheet
=> "" . C4
::Context
->preference("opaclayoutstylesheet"),
426 opaccolorstylesheet
=> "" . C4
::Context
->preference("opaccolorstylesheet"),
427 opacstylesheet
=> "" . C4
::Context
->preference("opacstylesheet"),
428 opacbookbag
=> "" . C4
::Context
->preference("opacbookbag"),
429 opaccredits
=> "" . C4
::Context
->preference("opaccredits"),
430 opacheader
=> "" . C4
::Context
->preference("opacheader"),
431 opaclanguagesdisplay
=> "" . C4
::Context
->preference("opaclanguagesdisplay"),
432 opacreadinghistory
=> C4
::Context
->preference("opacreadinghistory"),
433 opacsmallimage
=> "" . C4
::Context
->preference("opacsmallimage"),
434 opacuserjs
=> C4
::Context
->preference("opacuserjs"),
435 opacuserlogin
=> "" . C4
::Context
->preference("opacuserlogin"),
436 reviewson
=> C4
::Context
->preference("reviewson"),
437 suggestion
=> "" . C4
::Context
->preference("suggestion"),
438 virtualshelves
=> "" . C4
::Context
->preference("virtualshelves"),
439 OPACSerialIssueDisplayCount
=> C4
::Context
->preference("OPACSerialIssueDisplayCount"),
442 $template->param(listloop
=>[{shelfname
=>"Freelist", shelfnumber
=>110}]);
443 return ( $template, $borrowernumber, $cookie, $flags);
448 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
450 Verifies that the user is authorized to run this script. If
451 the user is authorized, a (userid, cookie, session-id, flags)
452 quadruple is returned. If the user is not authorized but does
453 not have the required privilege (see $flagsrequired below), it
454 displays an error page and exits. Otherwise, it displays the
455 login page and exits.
457 Note that C<&checkauth> will return if and only if the user
458 is authorized, so it should be called early on, before any
459 unfinished operations (e.g., if you've opened a file, then
460 C<&checkauth> won't close it for you).
462 C<$query> is the CGI object for the script calling C<&checkauth>.
464 The C<$noauth> argument is optional. If it is set, then no
465 authorization is required for the script.
467 C<&checkauth> fetches user and session information from C<$query> and
468 ensures that the user is authorized to run scripts that require
471 The C<$flagsrequired> argument specifies the required privileges
472 the user must have if the username and password are correct.
473 It should be specified as a reference-to-hash; keys in the hash
474 should be the "flags" for the user, as specified in the Members
475 intranet module. Any key specified must correspond to a "flag"
476 in the userflags table. E.g., { circulate => 1 } would specify
477 that the user must have the "circulate" privilege in order to
478 proceed. To make sure that access control is correct, the
479 C<$flagsrequired> parameter must be specified correctly.
481 If the GranularPermissions system preference is ON, the
482 value of each key in the C<flagsrequired> hash takes on an additional
487 The user must have access to all subfunctions of the module
488 specified by the hash key.
492 The user must have access to at least one subfunction of the module
493 specified by the hash key.
495 =item specific permission, e.g., 'export_catalog'
497 The user must have access to the specific subfunction list, which
498 must correspond to a row in the permissions table.
500 The C<$type> argument specifies whether the template should be
501 retrieved from the opac or intranet directory tree. "opac" is
502 assumed if it is not specified; however, if C<$type> is specified,
503 "intranet" is assumed if it is not "opac".
505 If C<$query> does not have a valid session ID associated with it
506 (i.e., the user has not logged in) or if the session has expired,
507 C<&checkauth> presents the user with a login page (from the point of
508 view of the original script, C<&checkauth> does not return). Once the
509 user has authenticated, C<&checkauth> restarts the original script
510 (this time, C<&checkauth> returns).
512 The login page is provided using a HTML::Template, which is set in the
513 systempreferences table or at the top of this file. The variable C<$type>
514 selects which template to use, either the opac or the intranet
515 authentification template.
517 C<&checkauth> returns a user ID, a cookie, and a session ID. The
518 cookie should be sent back to the browser; it verifies that the user
523 sub _version_check
($$) {
527 # If Version syspref is unavailable, it means Koha is beeing installed,
528 # and so we must redirect to OPAC maintenance page or to the WebInstaller
529 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
530 if (C4
::Context
->preference('OpacMaintenance') && $type eq 'opac') {
531 warn "OPAC Install required, redirecting to maintenance";
532 print $query->redirect("/cgi-bin/koha/maintenance.pl");
534 unless ($version = C4
::Context
->preference('Version')) { # assignment, not comparison
535 if ($type ne 'opac') {
536 warn "Install required, redirecting to Installer";
537 print $query->redirect("/cgi-bin/koha/installer/install.pl");
540 warn "OPAC Install required, redirecting to maintenance";
541 print $query->redirect("/cgi-bin/koha/maintenance.pl");
546 # check that database and koha version are the same
547 # there is no DB version, it's a fresh install,
548 # go to web installer
549 # there is a DB version, compare it to the code version
550 my $kohaversion=C4
::Context
::KOHAVERSION
;
551 # remove the 3 last . to have a Perl number
552 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
553 $debug and print STDERR
"kohaversion : $kohaversion\n";
554 if ($version < $kohaversion){
555 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
556 if ($type ne 'opac'){
557 warn sprintf($warning, 'Installer');
558 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
560 warn sprintf("OPAC: " . $warning, 'maintenance');
561 print $query->redirect("/cgi-bin/koha/maintenance.pl");
569 open L
, ">>/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
570 printf L
join("\n",@_);
576 $debug and warn "Checking Auth";
577 # $authnotrequired will be set for scripts which will run without authentication
578 my $authnotrequired = shift;
579 my $flagsrequired = shift;
581 $type = 'opac' unless $type;
583 my $dbh = C4
::Context
->dbh;
584 my $timeout = C4
::Context
->preference('timeout');
586 if ($timeout =~ /(\d+)[dD]/) {
587 $timeout = $1 * 86400;
589 $timeout = 600 unless $timeout;
591 _version_check
($type,$query);
595 my ( $userid, $cookie, $sessionID, $flags, $barshelves, $pubshelves );
596 my $logout = $query->param('logout.x');
598 if ( $userid = $ENV{'REMOTE_USER'} ) {
599 # Using Basic Authentication, no cookies required
600 $cookie = $query->cookie(
601 -name
=> 'CGISESSID',
607 elsif ( $sessionID = $query->cookie("CGISESSID")) { # assignment, not comparison
608 my $session = get_session
($sessionID);
609 C4
::Context
->_new_userenv($sessionID);
610 my ($ip, $lasttime, $sessiontype);
612 C4
::Context
::set_userenv
(
613 $session->param('number'), $session->param('id'),
614 $session->param('cardnumber'), $session->param('firstname'),
615 $session->param('surname'), $session->param('branch'),
616 $session->param('branchname'), $session->param('flags'),
617 $session->param('emailaddress'), $session->param('branchprinter')
619 C4
::Context
::set_shelves_userenv
('bar',$session->param('barshelves'));
620 C4
::Context
::set_shelves_userenv
('pub',$session->param('pubshelves'));
621 C4
::Context
::set_shelves_userenv
('tot',$session->param('totshelves'));
622 $debug and printf STDERR
"AUTH_SESSION: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
623 $ip = $session->param('ip');
624 $lasttime = $session->param('lasttime');
625 $userid = $session->param('id');
626 $sessiontype = $session->param('sessiontype');
628 if ( ($query->param('koha_login_context')) && ($query->param('userid') ne $session->param('id')) ) {
629 #if a user enters an id ne to the id in the current session, we need to log them in...
630 #first we need to clear the anonymous session...
631 $debug and warn "query id = " . $query->param('userid') . " but session id = " . $session->param('id');
634 C4
::Context
->_unset_userenv($sessionID);
639 # voluntary logout the user
642 C4
::Context
->_unset_userenv($sessionID);
643 _session_log
(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime
"%c",localtime));
647 if ($cas and $caslogout) {
651 elsif ( $lasttime < time() - $timeout ) {
653 $info{'timed_out'} = 1;
655 C4
::Context
->_unset_userenv($sessionID);
656 _session_log
(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime
"%c",localtime));
660 elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
661 # Different ip than originally logged in from
662 $info{'oldip'} = $ip;
663 $info{'newip'} = $ENV{'REMOTE_ADDR'};
664 $info{'different_ip'} = 1;
666 C4
::Context
->_unset_userenv($sessionID);
667 _session_log
(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime
"%c",localtime), $info{'newip'});
672 $cookie = $query->cookie( CGISESSID
=> $session->id );
673 $session->param('lasttime',time());
674 unless ( $sessiontype eq 'anon' ) { #if this is an anonymous session, we want to update the session, but not behave as if they are logged in...
675 $flags = haspermission
($userid, $flagsrequired);
679 $info{'nopermission'} = 1;
684 unless ($userid || $sessionID) {
685 #we initiate a session prior to checking for a username to allow for anonymous sessions...
686 my $session = get_session
("") or die "Auth ERROR: Cannot get_session()";
687 my $sessionID = $session->id;
688 C4
::Context
->_new_userenv($sessionID);
689 $cookie = $query->cookie(CGISESSID
=> $sessionID);
690 $userid = $query->param('userid');
691 if ($cas || $userid) {
692 my $password = $query->param('password');
693 my ($return, $cardnumber);
694 if ($cas && $query->param('ticket')) {
696 ( $return, $cardnumber, $retuserid ) = checkpw
( $dbh, $userid, $password, $query );
697 $userid = $retuserid;
698 $info{'invalidCasLogin'} = 1 unless ($return);
700 ( $return, $cardnumber ) = checkpw
( $dbh, $userid, $password, $query );
703 _session_log
(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},localtime);
704 if ( $flags = haspermission
( $userid, $flagsrequired ) ) {
708 $info{'nopermission'} = 1;
709 C4
::Context
->_unset_userenv($sessionID);
712 my ($borrowernumber, $firstname, $surname, $userflags,
713 $branchcode, $branchname, $branchprinter, $emailaddress);
715 if ( $return == 1 ) {
717 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
718 branches.branchname as branchname,
719 branches.branchprinter as branchprinter,
722 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
724 my $sth = $dbh->prepare("$select where userid=?");
725 $sth->execute($userid);
726 unless ($sth->rows) {
727 $debug and print STDERR
"AUTH_1: no rows for userid='$userid'\n";
728 $sth = $dbh->prepare("$select where cardnumber=?");
729 $sth->execute($cardnumber);
730 unless ($sth->rows) {
731 $debug and print STDERR
"AUTH_2a: no rows for cardnumber='$cardnumber'\n";
732 $sth->execute($userid);
733 unless ($sth->rows) {
734 $debug and print STDERR
"AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
739 ($borrowernumber, $firstname, $surname, $userflags,
740 $branchcode, $branchname, $branchprinter, $emailaddress) = $sth->fetchrow;
741 $debug and print STDERR
"AUTH_3 results: " .
742 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
744 print STDERR
"AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
747 # launch a sequence to check if we have a ip for the branch, i
748 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
750 my $ip = $ENV{'REMOTE_ADDR'};
751 # if they specify at login, use that
752 if ($query->param('branch')) {
753 $branchcode = $query->param('branch');
754 $branchname = GetBranchName
($branchcode);
756 my $branches = GetBranches
();
757 if (C4
::Context
->boolean_preference('IndependantBranches') && C4
::Context
->boolean_preference('Autolocation')){
758 # we have to check they are coming from the right ip range
759 my $domain = $branches->{$branchcode}->{'branchip'};
760 if ($ip !~ /^$domain/){
762 $info{'wrongip'} = 1;
767 foreach my $br ( keys %$branches ) {
768 # now we work with the treatment of ip
769 my $domain = $branches->{$br}->{'branchip'};
770 if ( $domain && $ip =~ /^$domain/ ) {
771 $branchcode = $branches->{$br}->{'branchcode'};
773 # new op dev : add the branchprinter and branchname in the cookie
774 $branchprinter = $branches->{$br}->{'branchprinter'};
775 $branchname = $branches->{$br}->{'branchname'};
778 $session->param('number',$borrowernumber);
779 $session->param('id',$userid);
780 $session->param('cardnumber',$cardnumber);
781 $session->param('firstname',$firstname);
782 $session->param('surname',$surname);
783 $session->param('branch',$branchcode);
784 $session->param('branchname',$branchname);
785 $session->param('flags',$userflags);
786 $session->param('emailaddress',$emailaddress);
787 $session->param('ip',$session->remote_addr());
788 $session->param('lasttime',time());
789 $debug and printf STDERR
"AUTH_4: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
791 elsif ( $return == 2 ) {
792 #We suppose the user is the superlibrarian
794 $session->param('number',0);
795 $session->param('id',C4
::Context
->config('user'));
796 $session->param('cardnumber',C4
::Context
->config('user'));
797 $session->param('firstname',C4
::Context
->config('user'));
798 $session->param('surname',C4
::Context
->config('user'));
799 $session->param('branch','NO_LIBRARY_SET');
800 $session->param('branchname','NO_LIBRARY_SET');
801 $session->param('flags',1);
802 $session->param('emailaddress', C4
::Context
->preference('KohaAdminEmailAddress'));
803 $session->param('ip',$session->remote_addr());
804 $session->param('lasttime',time());
806 C4
::Context
::set_userenv
(
807 $session->param('number'), $session->param('id'),
808 $session->param('cardnumber'), $session->param('firstname'),
809 $session->param('surname'), $session->param('branch'),
810 $session->param('branchname'), $session->param('flags'),
811 $session->param('emailaddress'), $session->param('branchprinter')
814 # Grab borrower's shelves and public shelves and add them to the session
815 # $row_count determines how many records are returned from the db query
816 # and the number of lists to be displayed of each type in the 'Lists' button drop down
817 my $row_count = 10; # FIXME:This probably should be a syspref
818 my ($total, $totshelves, $barshelves, $pubshelves);
819 ($barshelves, $totshelves) = C4
::VirtualShelves
::GetRecentShelves
(1, $row_count, $borrowernumber);
820 $total->{'bartotal'} = $totshelves;
821 ($pubshelves, $totshelves) = C4
::VirtualShelves
::GetRecentShelves
(2, $row_count, undef);
822 $total->{'pubtotal'} = $totshelves;
823 $session->param('barshelves', $barshelves->[0]);
824 $session->param('pubshelves', $pubshelves->[0]);
825 $session->param('totshelves', $total);
827 C4
::Context
::set_shelves_userenv
('bar',$barshelves->[0]);
828 C4
::Context
::set_shelves_userenv
('pub',$pubshelves->[0]);
829 C4
::Context
::set_shelves_userenv
('tot',$total);
833 $info{'invalid_username_or_password'} = 1;
834 C4
::Context
->_unset_userenv($sessionID);
837 } # END if ( $userid = $query->param('userid') )
838 elsif ($type eq "opac") {
839 # if we are here this is an anonymous session; add public lists to it and a few other items...
840 # anonymous sessions are created only for the OPAC
841 $debug and warn "Initiating an anonymous session...";
843 # Grab the public shelves and add to the session...
844 my $row_count = 20; # FIXME:This probably should be a syspref
845 my ($total, $totshelves, $pubshelves);
846 ($pubshelves, $totshelves) = C4
::VirtualShelves
::GetRecentShelves
(2, $row_count, undef);
847 $total->{'pubtotal'} = $totshelves;
848 $session->param('pubshelves', $pubshelves->[0]);
849 $session->param('totshelves', $total);
850 C4
::Context
::set_shelves_userenv
('pub',$pubshelves->[0]);
851 C4
::Context
::set_shelves_userenv
('tot',$total);
853 # setting a couple of other session vars...
854 $session->param('ip',$session->remote_addr());
855 $session->param('lasttime',time());
856 $session->param('sessiontype','anon');
858 } # END unless ($userid)
859 my $insecure = C4
::Context
->boolean_preference('insecure');
861 # finished authentification, now respond
862 if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
866 $cookie = $query->cookie( CGISESSID
=> '' );
868 return ( $userid, $cookie, $sessionID, $flags );
873 # AUTH rejected, show the login/password template, after checking the DB.
877 # get the inputs from the incoming query
879 foreach my $name ( param
$query) {
880 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
881 my $value = $query->param($name);
882 push @inputs, { name
=> $name, value
=> $value };
884 # get the branchloop, which we need for authentication
885 my $branches = GetBranches
();
887 for my $branch_hash (sort keys %$branches) {
888 push @branch_loop, {branchcode
=> "$branch_hash", branchname
=> $branches->{$branch_hash}->{'branchname'}, };
891 my $template_name = ( $type eq 'opac' ) ?
'opac-auth.tmpl' : 'auth.tmpl';
892 my $template = gettemplate
( $template_name, $type, $query );
893 $template->param(branchloop
=> \
@branch_loop,);
897 casAuthentication
=> C4
::Context
->preference("casAuthentication"),
898 suggestion
=> C4
::Context
->preference("suggestion"),
899 virtualshelves
=> C4
::Context
->preference("virtualshelves"),
900 LibraryName
=> C4
::Context
->preference("LibraryName"),
901 opacuserlogin
=> C4
::Context
->preference("opacuserlogin"),
902 OpacNav
=> C4
::Context
->preference("OpacNav"),
903 opaccredits
=> C4
::Context
->preference("opaccredits"),
904 opacreadinghistory
=> C4
::Context
->preference("opacreadinghistory"),
905 opacsmallimage
=> C4
::Context
->preference("opacsmallimage"),
906 opaclayoutstylesheet
=> C4
::Context
->preference("opaclayoutstylesheet"),
907 opaccolorstylesheet
=> C4
::Context
->preference("opaccolorstylesheet"),
908 opaclanguagesdisplay
=> C4
::Context
->preference("opaclanguagesdisplay"),
909 opacuserjs
=> C4
::Context
->preference("opacuserjs"),
910 opacbookbag
=> "" . C4
::Context
->preference("opacbookbag"),
911 OpacCloud
=> C4
::Context
->preference("OpacCloud"),
912 OpacTopissue
=> C4
::Context
->preference("OpacTopissue"),
913 OpacAuthorities
=> C4
::Context
->preference("OpacAuthorities"),
914 OpacBrowser
=> C4
::Context
->preference("OpacBrowser"),
915 opacheader
=> C4
::Context
->preference("opacheader"),
916 TagsEnabled
=> C4
::Context
->preference("TagsEnabled"),
917 OPACUserCSS
=> C4
::Context
->preference("OPACUserCSS"),
918 intranetcolorstylesheet
=>
919 C4
::Context
->preference("intranetcolorstylesheet"),
920 intranetstylesheet
=> C4
::Context
->preference("intranetstylesheet"),
921 intranetbookbag
=> C4
::Context
->preference("intranetbookbag"),
922 IntranetNav
=> C4
::Context
->preference("IntranetNav"),
923 intranetuserjs
=> C4
::Context
->preference("intranetuserjs"),
924 TemplateEncoding
=> C4
::Context
->preference("TemplateEncoding"),
925 IndependantBranches
=> C4
::Context
->preference("IndependantBranches"),
926 AutoLocation
=> C4
::Context
->preference("AutoLocation"),
927 wrongip
=> $info{'wrongip'}
929 $template->param( loginprompt
=> 1 ) unless $info{'nopermission'};
933 casServerUrl
=> login_cas_url
(),
934 invalidCasLogin
=> $info{'invalidCasLogin'}
938 my $self_url = $query->url( -absolute
=> 1 );
941 LibraryName
=> C4
::Context
->preference("LibraryName"),
943 $template->param( \
%info );
944 # $cookie = $query->cookie(CGISESSID => $session->id
946 print $query->header(
947 -type
=> 'text/html',
957 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
959 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
960 cookie, determine if the user has the privileges specified by C<$userflags>.
962 C<check_api_auth> is is meant for authenticating users of web services, and
963 consequently will always return and will not attempt to redirect the user
966 If a valid session cookie is already present, check_api_auth will return a status
967 of "ok", the cookie, and the Koha session ID.
969 If no session cookie is present, check_api_auth will check the 'userid' and 'password
970 parameters and create a session cookie and Koha session if the supplied credentials
973 Possible return values in C<$status> are:
977 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
979 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
981 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
983 =item "expired -- session cookie has expired; API user should resubmit userid and password
991 my $flagsrequired = shift;
993 my $dbh = C4
::Context
->dbh;
994 my $timeout = C4
::Context
->preference('timeout');
995 $timeout = 600 unless $timeout;
997 unless (C4
::Context
->preference('Version')) {
998 # database has not been installed yet
999 return ("maintenance", undef, undef);
1001 my $kohaversion=C4
::Context
::KOHAVERSION
;
1002 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1003 if (C4
::Context
->preference('Version') < $kohaversion) {
1004 # database in need of version update; assume that
1005 # no API should be called while databsae is in
1007 return ("maintenance", undef, undef);
1010 # FIXME -- most of what follows is a copy-and-paste
1011 # of code from checkauth. There is an obvious need
1012 # for refactoring to separate the various parts of
1013 # the authentication code, but as of 2007-11-19 this
1014 # is deferred so as to not introduce bugs into the
1015 # regular authentication code for Koha 3.0.
1017 # see if we have a valid session cookie already
1018 # however, if a userid parameter is present (i.e., from
1019 # a form submission, assume that any current cookie
1021 my $sessionID = undef;
1022 unless ($query->param('userid')) {
1023 $sessionID = $query->cookie("CGISESSID");
1026 my $session = get_session
($sessionID);
1027 C4
::Context
->_new_userenv($sessionID);
1029 C4
::Context
::set_userenv
(
1030 $session->param('number'), $session->param('id'),
1031 $session->param('cardnumber'), $session->param('firstname'),
1032 $session->param('surname'), $session->param('branch'),
1033 $session->param('branchname'), $session->param('flags'),
1034 $session->param('emailaddress'), $session->param('branchprinter')
1037 my $ip = $session->param('ip');
1038 my $lasttime = $session->param('lasttime');
1039 my $userid = $session->param('id');
1040 if ( $lasttime < time() - $timeout ) {
1043 C4
::Context
->_unset_userenv($sessionID);
1046 return ("expired", undef, undef);
1047 } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1048 # IP address changed
1050 C4
::Context
->_unset_userenv($sessionID);
1053 return ("expired", undef, undef);
1055 my $cookie = $query->cookie( CGISESSID
=> $session->id );
1056 $session->param('lasttime',time());
1057 my $flags = haspermission
($userid, $flagsrequired);
1059 return ("ok", $cookie, $sessionID);
1062 C4
::Context
->_unset_userenv($sessionID);
1065 return ("failed", undef, undef);
1069 return ("expired", undef, undef);
1073 my $userid = $query->param('userid');
1074 my $password = $query->param('password');
1075 unless ($userid and $password) {
1076 # caller did something wrong, fail the authenticateion
1077 return ("failed", undef, undef);
1079 my ($return, $cardnumber);
1080 if ($cas && $query->param('ticket')) {
1082 ( $return, $cardnumber, $retuserid ) = checkpw
( $dbh, $userid, $password, $query );
1083 $userid = $retuserid;
1085 ( $return, $cardnumber ) = checkpw
( $dbh, $userid, $password, $query );
1087 if ($return and haspermission
( $userid, $flagsrequired)) {
1088 my $session = get_session
("");
1089 return ("failed", undef, undef) unless $session;
1091 my $sessionID = $session->id;
1092 C4
::Context
->_new_userenv($sessionID);
1093 my $cookie = $query->cookie(CGISESSID
=> $sessionID);
1094 if ( $return == 1 ) {
1096 $borrowernumber, $firstname, $surname,
1097 $userflags, $branchcode, $branchname,
1098 $branchprinter, $emailaddress
1102 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname,branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1104 $sth->execute($userid);
1106 $borrowernumber, $firstname, $surname,
1107 $userflags, $branchcode, $branchname,
1108 $branchprinter, $emailaddress
1109 ) = $sth->fetchrow if ( $sth->rows );
1111 unless ($sth->rows ) {
1112 my $sth = $dbh->prepare(
1113 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1115 $sth->execute($cardnumber);
1117 $borrowernumber, $firstname, $surname,
1118 $userflags, $branchcode, $branchname,
1119 $branchprinter, $emailaddress
1120 ) = $sth->fetchrow if ( $sth->rows );
1122 unless ( $sth->rows ) {
1123 $sth->execute($userid);
1125 $borrowernumber, $firstname, $surname, $userflags,
1126 $branchcode, $branchname, $branchprinter, $emailaddress
1127 ) = $sth->fetchrow if ( $sth->rows );
1131 my $ip = $ENV{'REMOTE_ADDR'};
1132 # if they specify at login, use that
1133 if ($query->param('branch')) {
1134 $branchcode = $query->param('branch');
1135 $branchname = GetBranchName
($branchcode);
1137 my $branches = GetBranches
();
1139 foreach my $br ( keys %$branches ) {
1140 # now we work with the treatment of ip
1141 my $domain = $branches->{$br}->{'branchip'};
1142 if ( $domain && $ip =~ /^$domain/ ) {
1143 $branchcode = $branches->{$br}->{'branchcode'};
1145 # new op dev : add the branchprinter and branchname in the cookie
1146 $branchprinter = $branches->{$br}->{'branchprinter'};
1147 $branchname = $branches->{$br}->{'branchname'};
1150 $session->param('number',$borrowernumber);
1151 $session->param('id',$userid);
1152 $session->param('cardnumber',$cardnumber);
1153 $session->param('firstname',$firstname);
1154 $session->param('surname',$surname);
1155 $session->param('branch',$branchcode);
1156 $session->param('branchname',$branchname);
1157 $session->param('flags',$userflags);
1158 $session->param('emailaddress',$emailaddress);
1159 $session->param('ip',$session->remote_addr());
1160 $session->param('lasttime',time());
1161 } elsif ( $return == 2 ) {
1162 #We suppose the user is the superlibrarian
1163 $session->param('number',0);
1164 $session->param('id',C4
::Context
->config('user'));
1165 $session->param('cardnumber',C4
::Context
->config('user'));
1166 $session->param('firstname',C4
::Context
->config('user'));
1167 $session->param('surname',C4
::Context
->config('user'));
1168 $session->param('branch','NO_LIBRARY_SET');
1169 $session->param('branchname','NO_LIBRARY_SET');
1170 $session->param('flags',1);
1171 $session->param('emailaddress', C4
::Context
->preference('KohaAdminEmailAddress'));
1172 $session->param('ip',$session->remote_addr());
1173 $session->param('lasttime',time());
1175 C4
::Context
::set_userenv
(
1176 $session->param('number'), $session->param('id'),
1177 $session->param('cardnumber'), $session->param('firstname'),
1178 $session->param('surname'), $session->param('branch'),
1179 $session->param('branchname'), $session->param('flags'),
1180 $session->param('emailaddress'), $session->param('branchprinter')
1182 return ("ok", $cookie, $sessionID);
1184 return ("failed", undef, undef);
1189 =item check_cookie_auth
1191 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1193 Given a CGISESSID cookie set during a previous login to Koha, determine
1194 if the user has the privileges specified by C<$userflags>.
1196 C<check_cookie_auth> is meant for authenticating special services
1197 such as tools/upload-file.pl that are invoked by other pages that
1198 have been authenticated in the usual way.
1200 Possible return values in C<$status> are:
1204 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1206 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1208 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1210 =item "expired -- session cookie has expired; API user should resubmit userid and password
1216 sub check_cookie_auth
{
1218 my $flagsrequired = shift;
1220 my $dbh = C4
::Context
->dbh;
1221 my $timeout = C4
::Context
->preference('timeout');
1222 $timeout = 600 unless $timeout;
1224 unless (C4
::Context
->preference('Version')) {
1225 # database has not been installed yet
1226 return ("maintenance", undef);
1228 my $kohaversion=C4
::Context
::KOHAVERSION
;
1229 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1230 if (C4
::Context
->preference('Version') < $kohaversion) {
1231 # database in need of version update; assume that
1232 # no API should be called while databsae is in
1234 return ("maintenance", undef);
1237 # FIXME -- most of what follows is a copy-and-paste
1238 # of code from checkauth. There is an obvious need
1239 # for refactoring to separate the various parts of
1240 # the authentication code, but as of 2007-11-23 this
1241 # is deferred so as to not introduce bugs into the
1242 # regular authentication code for Koha 3.0.
1244 # see if we have a valid session cookie already
1245 # however, if a userid parameter is present (i.e., from
1246 # a form submission, assume that any current cookie
1248 unless (defined $cookie and $cookie) {
1249 return ("failed", undef);
1251 my $sessionID = $cookie;
1252 my $session = get_session
($sessionID);
1253 C4
::Context
->_new_userenv($sessionID);
1255 C4
::Context
::set_userenv
(
1256 $session->param('number'), $session->param('id'),
1257 $session->param('cardnumber'), $session->param('firstname'),
1258 $session->param('surname'), $session->param('branch'),
1259 $session->param('branchname'), $session->param('flags'),
1260 $session->param('emailaddress'), $session->param('branchprinter')
1263 my $ip = $session->param('ip');
1264 my $lasttime = $session->param('lasttime');
1265 my $userid = $session->param('id');
1266 if ( $lasttime < time() - $timeout ) {
1269 C4
::Context
->_unset_userenv($sessionID);
1272 return ("expired", undef);
1273 } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1274 # IP address changed
1276 C4
::Context
->_unset_userenv($sessionID);
1279 return ("expired", undef);
1281 $session->param('lasttime',time());
1282 my $flags = haspermission
($userid, $flagsrequired);
1284 return ("ok", $sessionID);
1287 C4
::Context
->_unset_userenv($sessionID);
1290 return ("failed", undef);
1294 return ("expired", undef);
1301 my $session = get_session($sessionID);
1303 Given a session ID, retrieve the CGI::Session object used to store
1304 the session's state. The session object can be used to store
1305 data that needs to be accessed by different scripts during a
1308 If the C<$sessionID> parameter is an empty string, a new session
1314 my $sessionID = shift;
1315 my $storage_method = C4
::Context
->preference('SessionStorage');
1316 my $dbh = C4
::Context
->dbh;
1318 if ($storage_method eq 'mysql'){
1319 $session = new CGI
::Session
("driver:MySQL;serializer:yaml;id:md5", $sessionID, {Handle
=>$dbh});
1321 elsif ($storage_method eq 'Pg') {
1322 $session = new CGI
::Session
("driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, {Handle
=>$dbh});
1325 # catch all defaults to tmp should work on all systems
1326 $session = new CGI
::Session
("driver:File;serializer:yaml;id:md5", $sessionID, {Directory
=>'/tmp'});
1333 my ( $dbh, $userid, $password, $query ) = @_;
1335 $debug and print "## checkpw - checking LDAP\n";
1336 my ($retval,$retcard) = checkpw_ldap
(@_); # EXTERNAL AUTH
1337 ($retval) and return ($retval,$retcard);
1340 if ($cas && $query->param('ticket')) {
1341 $debug and print STDERR
"## checkpw - checking CAS\n";
1342 # In case of a CAS authentication, we use the ticket instead of the password
1343 my $ticket = $query->param('ticket');
1344 my ($retval,$retcard,$retuserid) = checkpw_cas
($dbh, $ticket, $query); # EXTERNAL AUTH
1345 ($retval) and return ($retval,$retcard,$retuserid);
1352 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1354 $sth->execute($userid);
1356 my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1357 $surname, $branchcode, $flags )
1359 if ( md5_base64
($password) eq $md5password and $md5password ne "!") {
1361 C4
::Context
->set_userenv( "$borrowernumber", $userid, $cardnumber,
1362 $firstname, $surname, $branchcode, $flags );
1363 return 1, $cardnumber;
1368 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1370 $sth->execute($userid);
1372 my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1373 $surname, $branchcode, $flags )
1375 if ( md5_base64
($password) eq $md5password ) {
1377 C4
::Context
->set_userenv( $borrowernumber, $userid, $cardnumber,
1378 $firstname, $surname, $branchcode, $flags );
1382 if ( $userid && $userid eq C4
::Context
->config('user')
1383 && "$password" eq C4
::Context
->config('pass') )
1386 # Koha superuser account
1387 # C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1390 if ( $userid && $userid eq 'demo'
1391 && "$password" eq 'demo'
1392 && C4
::Context
->config('demo') )
1395 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1396 # some features won't be effective : modify systempref, modify MARC structure,
1404 my $authflags = getuserflags($flags, $userid, [$dbh]);
1406 Translates integer flags into permissions strings hash.
1408 C<$flags> is the integer userflags value ( borrowers.userflags )
1409 C<$userid> is the members.userid, used for building subpermissions
1410 C<$authflags> is a hashref of permissions
1417 my $dbh = @_ ?
shift : C4
::Context
->dbh;
1419 $flags = 0 unless $flags;
1420 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1423 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1424 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1425 $userflags->{$flag} = 1;
1428 $userflags->{$flag} = 0;
1432 # get subpermissions and merge with top-level permissions
1433 my $user_subperms = get_user_subpermissions
($userid);
1434 foreach my $module (keys %$user_subperms) {
1435 next if $userflags->{$module} == 1; # user already has permission for everything in this module
1436 $userflags->{$module} = $user_subperms->{$module};
1442 =item get_user_subpermissions
1446 my $user_perm_hashref = get_user_subpermissions($userid);
1450 Given the userid (note, not the borrowernumber) of a staff user,
1451 return a hashref of hashrefs of the specific subpermissions
1452 accorded to the user. An example return is
1456 export_catalog => 1,
1457 import_patrons => 1,
1461 The top-level hash-key is a module or function code from
1462 userflags.flag, while the second-level key is a code
1465 The results of this function do not give a complete picture
1466 of the functions that a staff user can access; it is also
1467 necessary to check borrowers.flags.
1471 sub get_user_subpermissions
{
1474 my $dbh = C4
::Context
->dbh;
1475 my $sth = $dbh->prepare("SELECT flag, user_permissions.code
1476 FROM user_permissions
1477 JOIN permissions USING (module_bit, code)
1478 JOIN userflags ON (module_bit = bit)
1479 JOIN borrowers USING (borrowernumber)
1481 $sth->execute($userid);
1483 my $user_perms = {};
1484 while (my $perm = $sth->fetchrow_hashref) {
1485 $user_perms->{$perm->{'flag'}}->{$perm->{'code'}} = 1;
1490 =item get_all_subpermissions
1494 my $perm_hashref = get_all_subpermissions();
1498 Returns a hashref of hashrefs defining all specific
1499 permissions currently defined. The return value
1500 has the same structure as that of C<get_user_subpermissions>,
1501 except that the innermost hash value is the description
1502 of the subpermission.
1506 sub get_all_subpermissions
{
1507 my $dbh = C4
::Context
->dbh;
1508 my $sth = $dbh->prepare("SELECT flag, code, description
1510 JOIN userflags ON (module_bit = bit)");
1514 while (my $perm = $sth->fetchrow_hashref) {
1515 $all_perms->{$perm->{'flag'}}->{$perm->{'code'}} = $perm->{'description'};
1522 $flags = ($userid, $flagsrequired);
1524 C<$userid> the userid of the member
1525 C<$flags> is a hashref of required flags like C<$borrower-<{authflags}>
1527 Returns member's flags or 0 if a permission is not met.
1532 my ($userid, $flagsrequired) = @_;
1533 my $sth = C4
::Context
->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1534 $sth->execute($userid);
1535 my $flags = getuserflags
( $sth->fetchrow(), $userid );
1536 if ( $userid eq C4
::Context
->config('user') ) {
1537 # Super User Account from /etc/koha.conf
1538 $flags->{'superlibrarian'} = 1;
1540 elsif ( $userid eq 'demo' && C4
::Context
->config('demo') ) {
1541 # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1542 $flags->{'superlibrarian'} = 1;
1544 return $flags if $flags->{superlibrarian
};
1545 foreach my $module ( keys %$flagsrequired ) {
1546 if (C4
::Context
->preference('GranularPermissions')) {
1547 my $subperm = $flagsrequired->{$module};
1548 if ($subperm eq '*') {
1549 return 0 unless ( $flags->{$module} == 1 or ref($flags->{$module}) );
1551 return 0 unless ( $flags->{$module} == 1 or
1552 ( ref($flags->{$module}) and
1553 exists $flags->{$module}->{$subperm} and
1554 $flags->{$module}->{$subperm} == 1
1559 return 0 unless ( $flags->{$module} );
1563 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1567 sub getborrowernumber
{
1569 my $userenv = C4
::Context
->userenv;
1570 if ( defined( $userenv ) && ref( $userenv ) eq 'HASH' && $userenv->{number
} ) {
1571 return $userenv->{number
};
1573 my $dbh = C4
::Context
->dbh;
1574 for my $field ( 'userid', 'cardnumber' ) {
1576 $dbh->prepare("select borrowernumber from borrowers where $field=?");
1577 $sth->execute($userid);
1579 my ($bnumber) = $sth->fetchrow;
1586 END { } # module clean-up code here (global destructor)