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
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use Digest::MD5 qw(md5_base64);
23 use JSON qw/encode_json/;
29 use C4::Templates; # to get the template
31 use C4::Search::History;
34 use Koha::AuthUtils qw(get_script_name hash_password);
36 use Koha::DateUtils qw(dt_from_string);
37 use Koha::Library::Groups;
40 use Koha::Patron::Consents;
41 use POSIX qw/strftime/;
42 use List::MoreUtils qw/ any /;
43 use Encode qw( encode is_utf8);
46 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout $shib $shib_login);
49 sub psgi_env { any { /^psgi\./ } keys %ENV }
52 if (psgi_env) { die 'psgi:exit' }
58 @EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
59 @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash
60 &get_all_subpermissions &get_user_subpermissions track_login_daily
62 %EXPORT_TAGS = ( EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)] );
63 $ldap = C4::Context->config('useldapserver') || 0;
64 $cas = C4::Context->preference('casAuthentication');
65 $shib = C4::Context->config('useshibboleth') || 0;
66 $caslogout = C4::Context->preference('casLogout');
67 require C4::Auth_with_cas; # no import
70 require C4::Auth_with_ldap;
71 import C4::Auth_with_ldap qw(checkpw_ldap);
74 require C4::Auth_with_shibboleth;
75 import C4::Auth_with_shibboleth
76 qw(shib_ok checkpw_shib logout_shib login_shib_url get_login_shib);
78 # Check for good config
79 $shib = 0 unless shib_ok();
82 import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url logout_if_required);
89 C4::Auth - Authenticates Koha users
99 my ($template, $borrowernumber, $cookie)
100 = get_template_and_user(
102 template_name => "opac-main.tt",
105 authnotrequired => 0,
106 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
110 output_html_with_http_headers $query, $cookie, $template->output;
114 The main function of this module is to provide
115 authentification. However the get_template_and_user function has
116 been provided so that a users login information is passed along
117 automatically. This gets loaded into the template.
121 =head2 get_template_and_user
123 my ($template, $borrowernumber, $cookie)
124 = get_template_and_user(
126 template_name => "opac-main.tt",
129 authnotrequired => 0,
130 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
134 This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
135 to C<&checkauth> (in this module) to perform authentification.
136 See C<&checkauth> for an explanation of these parameters.
138 The C<template_name> is then used to find the correct template for
139 the page. The authenticated users details are loaded onto the
140 template in the logged_in_user variable (which is a Koha::Patron object). Also the
141 C<sessionID> is passed to the template. This can be used in templates
142 if cookies are disabled. It needs to be put as and input to every
145 More information on the C<gettemplate> sub can be found in the
150 sub get_template_and_user {
153 my ( $user, $cookie, $sessionID, $flags );
155 # Get shibboleth login attribute
156 $shib_login = get_login_shib() if $shib;
158 C4::Context->interface( $in->{type} );
160 $in->{'authnotrequired'} ||= 0;
162 # the following call includes a bad template check; might croak
163 my $template = C4::Templates::gettemplate(
164 $in->{'template_name'},
169 if ( $in->{'template_name'} !~ m/maintenance/ ) {
170 ( $user, $cookie, $sessionID, $flags ) = checkauth(
172 $in->{'authnotrequired'},
173 $in->{'flagsrequired'},
178 # If we enforce GDPR and the user did not consent, redirect
179 if( $in->{type} eq 'opac' && $user &&
180 $in->{'template_name'} !~ /opac-patron-consent/ &&
181 C4::Context->preference('GDPR_Policy') eq 'Enforced' )
183 my $consent = Koha::Patron::Consents->search({
184 borrowernumber => getborrowernumber($user),
185 type => 'GDPR_PROCESSING',
186 given_on => { '!=', undef },
189 print $in->{query}->redirect(-uri => '/cgi-bin/koha/opac-patron-consent.pl', -cookie => $cookie);
194 if ( $in->{type} eq 'opac' && $user ) {
198 # If the user logged in is the SCO user and they try to go out of the SCO module,
199 # log the user out removing the CGISESSID cookie
200 $in->{template_name} !~ m|sco/|
201 && C4::Context->preference('AutoSelfCheckID')
202 && $user eq C4::Context->preference('AutoSelfCheckID')
208 # If the user logged in is the SCI user and they try to go out of the SCI module,
209 # kick them out unless it is SCO with a valid permission
210 # or they are a superlibrarian
211 $in->{template_name} !~ m|sci/|
212 && haspermission( $user, { self_check => 'self_checkin_module' } )
214 $in->{template_name} =~ m|sco/| && haspermission(
215 $user, { self_check => 'self_checkout_module' }
218 && $flags && $flags->{superlibrarian} != 1
225 $template = C4::Templates::gettemplate( 'opac-auth.tt', 'opac',
227 $cookie = $in->{query}->cookie(
228 -name => 'CGISESSID',
236 script_name => get_script_name(),
239 print $in->{query}->header(
244 'X-Frame-Options' => 'SAMEORIGIN'
255 # It's possible for $user to be the borrowernumber if they don't have a
256 # userid defined (and are logging in through some other method, such
257 # as SSL certs against an email address)
259 $borrowernumber = getborrowernumber($user) if defined($user);
260 if ( !defined($borrowernumber) && defined($user) ) {
261 $patron = Koha::Patrons->find( $user );
263 $borrowernumber = $user;
265 # A bit of a hack, but I don't know there's a nicer way
267 $user = $patron->firstname . ' ' . $patron->surname;
270 $patron = Koha::Patrons->find( $borrowernumber );
271 # FIXME What to do if $patron does not exist?
275 $template->param( loggedinusername => $user ); # OBSOLETE - Do not reuse this in template, use logged_in_user.userid instead
276 $template->param( loggedinusernumber => $borrowernumber ); # FIXME Should be replaced with logged_in_user.borrowernumber
277 $template->param( logged_in_user => $patron );
278 $template->param( sessionID => $sessionID );
280 if ( $in->{'type'} eq 'opac' ) {
281 require Koha::Virtualshelves;
282 my $some_private_shelves = Koha::Virtualshelves->get_some_shelves(
284 borrowernumber => $borrowernumber,
288 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
294 some_private_shelves => $some_private_shelves,
295 some_public_shelves => $some_public_shelves,
299 my $all_perms = get_all_subpermissions();
301 my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
302 editcatalogue updatecharges tools editauthorities serials reports acquisition clubs);
304 # We are going to use the $flags returned by checkauth
305 # to create the template's parameters that will indicate
306 # which menus the user can access.
307 if ( $flags && $flags->{superlibrarian} == 1 ) {
308 $template->param( CAN_user_circulate => 1 );
309 $template->param( CAN_user_catalogue => 1 );
310 $template->param( CAN_user_parameters => 1 );
311 $template->param( CAN_user_borrowers => 1 );
312 $template->param( CAN_user_permissions => 1 );
313 $template->param( CAN_user_reserveforothers => 1 );
314 $template->param( CAN_user_editcatalogue => 1 );
315 $template->param( CAN_user_updatecharges => 1 );
316 $template->param( CAN_user_acquisition => 1 );
317 $template->param( CAN_user_tools => 1 );
318 $template->param( CAN_user_editauthorities => 1 );
319 $template->param( CAN_user_serials => 1 );
320 $template->param( CAN_user_reports => 1 );
321 $template->param( CAN_user_staffaccess => 1 );
322 $template->param( CAN_user_plugins => 1 );
323 $template->param( CAN_user_coursereserves => 1 );
324 $template->param( CAN_user_clubs => 1 );
325 $template->param( CAN_user_ill => 1 );
327 foreach my $module ( keys %$all_perms ) {
328 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
329 $template->param( "CAN_user_${module}_${subperm}" => 1 );
335 foreach my $module ( keys %$all_perms ) {
336 if ( defined($flags->{$module}) && $flags->{$module} == 1 ) {
337 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
338 $template->param( "CAN_user_${module}_${subperm}" => 1 );
340 } elsif ( ref( $flags->{$module} ) ) {
341 foreach my $subperm ( keys %{ $flags->{$module} } ) {
342 $template->param( "CAN_user_${module}_${subperm}" => 1 );
349 foreach my $module ( keys %$flags ) {
350 if ( $flags->{$module} == 1 or ref( $flags->{$module} ) ) {
351 $template->param( "CAN_user_$module" => 1 );
356 # Logged-in opac search history
357 # If the requested template is an opac one and opac search history is enabled
358 if ( $in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory') ) {
359 my $dbh = C4::Context->dbh;
360 my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
361 my $sth = $dbh->prepare($query);
362 $sth->execute($borrowernumber);
364 # If at least one search has already been performed
365 if ( $sth->fetchrow_array > 0 ) {
367 # We show the link in opac
368 $template->param( EnableOpacSearchHistory => 1 );
370 if (C4::Context->preference('LoadSearchHistoryToTheFirstLoggedUser'))
372 # And if there are searches performed when the user was not logged in,
373 # we add them to the logged-in search history
374 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
375 if (@recentSearches) {
376 my $dbh = C4::Context->dbh;
378 INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, type, total, time )
379 VALUES (?, ?, ?, ?, ?, ?, ?)
381 my $sth = $dbh->prepare($query);
382 $sth->execute( $borrowernumber,
383 $in->{query}->cookie("CGISESSID"),
386 $_->{type} || 'biblio',
389 ) foreach @recentSearches;
391 # clear out the search history from the session now that
392 # we've saved it to the database
395 C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } );
397 } elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) {
398 $template->param( EnableSearchHistory => 1 );
401 else { # if this is an anonymous session, setup to display public lists...
403 # If shibboleth is enabled, and we're in an anonymous session, we should allow
404 # the user to attempt login via shibboleth.
406 $template->param( shibbolethAuthentication => $shib,
407 shibbolethLoginUrl => login_shib_url( $in->{'query'} ),
410 # If shibboleth is enabled and we have a shibboleth login attribute,
411 # but we are in an anonymous session, then we clearly have an invalid
412 # shibboleth koha account.
414 $template->param( invalidShibLogin => '1' );
418 $template->param( sessionID => $sessionID );
420 if ( $in->{'type'} eq 'opac' ){
421 require Koha::Virtualshelves;
422 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
428 some_public_shelves => $some_public_shelves,
433 # Anonymous opac search history
434 # If opac search history is enabled and at least one search has already been performed
435 if ( C4::Context->preference('EnableOpacSearchHistory') ) {
436 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
437 if (@recentSearches) {
438 $template->param( EnableOpacSearchHistory => 1 );
442 if ( C4::Context->preference('dateformat') ) {
443 $template->param( dateformat => C4::Context->preference('dateformat') );
446 $template->param(auth_forwarded_hash => scalar $in->{'query'}->param('auth_forwarded_hash'));
448 # these template parameters are set the same regardless of $in->{'type'}
450 # Set the using_https variable for templates
451 # FIXME Under Plack the CGI->https method always returns 'OFF'
452 my $https = $in->{query}->https();
453 my $using_https = ( defined $https and $https ne 'OFF' ) ? 1 : 0;
455 my $minPasswordLength = C4::Context->preference('minPasswordLength');
456 $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
458 "BiblioDefaultView" . C4::Context->preference("BiblioDefaultView") => 1,
459 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
460 GoogleJackets => C4::Context->preference("GoogleJackets"),
461 OpenLibraryCovers => C4::Context->preference("OpenLibraryCovers"),
462 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
463 LoginBranchcode => ( C4::Context->userenv ? C4::Context->userenv->{"branch"} : undef ),
464 LoginFirstname => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
465 LoginSurname => C4::Context->userenv ? C4::Context->userenv->{"surname"} : "Inconnu",
466 emailaddress => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
467 TagsEnabled => C4::Context->preference("TagsEnabled"),
468 hide_marc => C4::Context->preference("hide_marc"),
469 item_level_itypes => C4::Context->preference('item-level_itypes'),
470 patronimages => C4::Context->preference("patronimages"),
471 singleBranchMode => ( Koha::Libraries->search->count == 1 ),
472 XSLTDetailsDisplay => C4::Context->preference("XSLTDetailsDisplay"),
473 XSLTResultsDisplay => C4::Context->preference("XSLTResultsDisplay"),
474 using_https => $using_https,
475 noItemTypeImages => C4::Context->preference("noItemTypeImages"),
476 marcflavour => C4::Context->preference("marcflavour"),
477 OPACBaseURL => C4::Context->preference('OPACBaseURL'),
478 minPasswordLength => $minPasswordLength,
480 if ( $in->{'type'} eq "intranet" ) {
482 AmazonCoverImages => C4::Context->preference("AmazonCoverImages"),
483 AutoLocation => C4::Context->preference("AutoLocation"),
484 "BiblioDefaultView" . C4::Context->preference("IntranetBiblioDefaultView") => 1,
485 CircAutocompl => C4::Context->preference("CircAutocompl"),
486 FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
487 IndependentBranches => C4::Context->preference("IndependentBranches"),
488 IntranetNav => C4::Context->preference("IntranetNav"),
489 IntranetmainUserblock => C4::Context->preference("IntranetmainUserblock"),
490 LibraryName => C4::Context->preference("LibraryName"),
491 LoginBranchname => ( C4::Context->userenv ? C4::Context->userenv->{"branchname"} : undef ),
492 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
493 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
494 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
495 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
496 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
497 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
498 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
499 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
500 intranetbookbag => C4::Context->preference("intranetbookbag"),
501 suggestion => C4::Context->preference("suggestion"),
502 virtualshelves => C4::Context->preference("virtualshelves"),
503 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
504 EasyAnalyticalRecords => C4::Context->preference('EasyAnalyticalRecords'),
505 LocalCoverImages => C4::Context->preference('LocalCoverImages'),
506 OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'),
507 AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'),
508 EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'),
509 UseKohaPlugins => C4::Context->preference('UseKohaPlugins'),
510 UseCourseReserves => C4::Context->preference("UseCourseReserves"),
511 useDischarge => C4::Context->preference('useDischarge'),
512 pending_checkout_notes => scalar Koha::Checkouts->search({ noteseen => 0 }),
516 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
518 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
519 my $LibraryNameTitle = C4::Context->preference("LibraryName");
520 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
521 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
523 # clean up the busc param in the session
524 # if the page is not opac-detail and not the "add to list" page
525 # and not the "edit comments" page
526 if ( C4::Context->preference("OpacBrowseResults")
527 && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
529 unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
530 or $pagename =~ /^addbybiblionumber$/
531 or $pagename =~ /^review$/ ) {
532 my $sessionSearch = get_session( $sessionID || $in->{'query'}->cookie("CGISESSID") );
533 $sessionSearch->clear( ["busc"] ) if ( $sessionSearch->param("busc") );
537 # variables passed from CGI: opac_css_override and opac_search_limits.
538 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
539 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
542 ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:(\w+)/ ) ||
543 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:(\w+)/ ) ||
544 ( $in->{'query'}->param('multibranchlimit') && $in->{'query'}->param('multibranchlimit') =~ /multibranchlimit-(\w+)/ )
546 $opac_name = $1; # opac_search_limit is a branch, so we use it.
547 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
548 $opac_name = $in->{'query'}->param('multibranchlimit');
549 } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
550 $opac_name = C4::Context->userenv->{'branch'};
553 my @search_groups = Koha::Library::Groups->get_search_groups({ interface => 'opac' });
555 OpacAdditionalStylesheet => C4::Context->preference("OpacAdditionalStylesheet"),
556 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
557 LibrarySearchGroups => \@search_groups,
558 opac_name => $opac_name,
559 LibraryName => "" . C4::Context->preference("LibraryName"),
560 LibraryNameTitle => "" . $LibraryNameTitle,
561 LoginBranchname => C4::Context->userenv ? C4::Context->userenv->{"branchname"} : "",
562 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
563 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
564 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
565 OPACShelfBrowser => "" . C4::Context->preference("OPACShelfBrowser"),
566 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
567 OPACUserCSS => "" . C4::Context->preference("OPACUserCSS"),
568 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
569 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
570 opac_search_limit => $opac_search_limit,
571 opac_limit_override => $opac_limit_override,
572 OpacBrowser => C4::Context->preference("OpacBrowser"),
573 OpacCloud => C4::Context->preference("OpacCloud"),
574 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
575 OpacMainUserBlock => "" . C4::Context->preference("OpacMainUserBlock"),
576 OpacNav => "" . C4::Context->preference("OpacNav"),
577 OpacNavRight => "" . C4::Context->preference("OpacNavRight"),
578 OpacNavBottom => "" . C4::Context->preference("OpacNavBottom"),
579 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
580 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
581 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
582 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
583 OpacTopissue => C4::Context->preference("OpacTopissue"),
584 RequestOnOpac => C4::Context->preference("RequestOnOpac"),
585 'Version' => C4::Context->preference('Version'),
586 hidelostitems => C4::Context->preference("hidelostitems"),
587 mylibraryfirst => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
588 opaclayoutstylesheet => "" . C4::Context->preference("opaclayoutstylesheet"),
589 opacbookbag => "" . C4::Context->preference("opacbookbag"),
590 opaccredits => "" . C4::Context->preference("opaccredits"),
591 OpacFavicon => C4::Context->preference("OpacFavicon"),
592 opacheader => "" . C4::Context->preference("opacheader"),
593 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
594 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
595 OPACUserJS => C4::Context->preference("OPACUserJS"),
596 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
597 OpenLibrarySearch => C4::Context->preference("OpenLibrarySearch"),
598 ShowReviewer => C4::Context->preference("ShowReviewer"),
599 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
600 suggestion => "" . C4::Context->preference("suggestion"),
601 virtualshelves => "" . C4::Context->preference("virtualshelves"),
602 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
603 OPACXSLTDetailsDisplay => C4::Context->preference("OPACXSLTDetailsDisplay"),
604 OPACXSLTResultsDisplay => C4::Context->preference("OPACXSLTResultsDisplay"),
605 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
606 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
607 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
608 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
609 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
610 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
611 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
612 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
613 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
614 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
615 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
616 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
617 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
618 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
619 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
620 useDischarge => C4::Context->preference('useDischarge'),
623 $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
626 # Check if we were asked using parameters to force a specific language
627 if ( defined $in->{'query'}->param('language') ) {
629 # Extract the language, let C4::Languages::getlanguage choose
631 my $language = C4::Languages::getlanguage( $in->{'query'} );
632 my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
633 if ( ref $cookie eq 'ARRAY' ) {
634 push @{$cookie}, $languagecookie;
636 $cookie = [ $cookie, $languagecookie ];
640 return ( $template, $borrowernumber, $cookie, $flags );
645 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
647 Verifies that the user is authorized to run this script. If
648 the user is authorized, a (userid, cookie, session-id, flags)
649 quadruple is returned. If the user is not authorized but does
650 not have the required privilege (see $flagsrequired below), it
651 displays an error page and exits. Otherwise, it displays the
652 login page and exits.
654 Note that C<&checkauth> will return if and only if the user
655 is authorized, so it should be called early on, before any
656 unfinished operations (e.g., if you've opened a file, then
657 C<&checkauth> won't close it for you).
659 C<$query> is the CGI object for the script calling C<&checkauth>.
661 The C<$noauth> argument is optional. If it is set, then no
662 authorization is required for the script.
664 C<&checkauth> fetches user and session information from C<$query> and
665 ensures that the user is authorized to run scripts that require
668 The C<$flagsrequired> argument specifies the required privileges
669 the user must have if the username and password are correct.
670 It should be specified as a reference-to-hash; keys in the hash
671 should be the "flags" for the user, as specified in the Members
672 intranet module. Any key specified must correspond to a "flag"
673 in the userflags table. E.g., { circulate => 1 } would specify
674 that the user must have the "circulate" privilege in order to
675 proceed. To make sure that access control is correct, the
676 C<$flagsrequired> parameter must be specified correctly.
678 Koha also has a concept of sub-permissions, also known as
679 granular permissions. This makes the value of each key
680 in the C<flagsrequired> hash take on an additional
685 The user must have access to all subfunctions of the module
686 specified by the hash key.
690 The user must have access to at least one subfunction of the module
691 specified by the hash key.
693 specific permission, e.g., 'export_catalog'
695 The user must have access to the specific subfunction list, which
696 must correspond to a row in the permissions table.
698 The C<$type> argument specifies whether the template should be
699 retrieved from the opac or intranet directory tree. "opac" is
700 assumed if it is not specified; however, if C<$type> is specified,
701 "intranet" is assumed if it is not "opac".
703 If C<$query> does not have a valid session ID associated with it
704 (i.e., the user has not logged in) or if the session has expired,
705 C<&checkauth> presents the user with a login page (from the point of
706 view of the original script, C<&checkauth> does not return). Once the
707 user has authenticated, C<&checkauth> restarts the original script
708 (this time, C<&checkauth> returns).
710 The login page is provided using a HTML::Template, which is set in the
711 systempreferences table or at the top of this file. The variable C<$type>
712 selects which template to use, either the opac or the intranet
713 authentification template.
715 C<&checkauth> returns a user ID, a cookie, and a session ID. The
716 cookie should be sent back to the browser; it verifies that the user
726 # If version syspref is unavailable, it means Koha is being installed,
727 # and so we must redirect to OPAC maintenance page or to the WebInstaller
728 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
729 if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
730 warn "OPAC Install required, redirecting to maintenance";
731 print $query->redirect("/cgi-bin/koha/maintenance.pl");
734 unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
735 if ( $type ne 'opac' ) {
736 warn "Install required, redirecting to Installer";
737 print $query->redirect("/cgi-bin/koha/installer/install.pl");
739 warn "OPAC Install required, redirecting to maintenance";
740 print $query->redirect("/cgi-bin/koha/maintenance.pl");
745 # check that database and koha version are the same
746 # there is no DB version, it's a fresh install,
747 # go to web installer
748 # there is a DB version, compare it to the code version
749 my $kohaversion = Koha::version();
751 # remove the 3 last . to have a Perl number
752 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
753 $debug and print STDERR "kohaversion : $kohaversion\n";
754 if ( $version < $kohaversion ) {
755 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
756 if ( $type ne 'opac' ) {
757 warn sprintf( $warning, 'Installer' );
758 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
760 warn sprintf( "OPAC: " . $warning, 'maintenance' );
761 print $query->redirect("/cgi-bin/koha/maintenance.pl");
769 open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
770 printf $fh join( "\n", @_ );
774 sub _timeout_syspref {
775 my $timeout = C4::Context->preference('timeout') || 600;
777 # value in days, convert in seconds
778 if ( $timeout =~ /(\d+)[dD]/ ) {
779 $timeout = $1 * 86400;
786 $debug and warn "Checking Auth";
788 # Get shibboleth login attribute
789 $shib_login = get_login_shib() if $shib;
791 # $authnotrequired will be set for scripts which will run without authentication
792 my $authnotrequired = shift;
793 my $flagsrequired = shift;
795 my $emailaddress = shift;
796 $type = 'opac' unless $type;
798 my $dbh = C4::Context->dbh;
799 my $timeout = _timeout_syspref();
801 _version_check( $type, $query );
806 my ( $userid, $cookie, $sessionID, $flags );
807 my $logout = $query->param('logout.x');
809 my $anon_search_history;
811 # This parameter is the name of the CAS server we want to authenticate against,
812 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
813 my $casparam = $query->param('cas');
814 my $q_userid = $query->param('userid') // '';
818 # Basic authentication is incompatible with the use of Shibboleth,
819 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
820 # and it may not be the attribute we want to use to match the koha login.
822 # Also, do not consider an empty REMOTE_USER.
824 # Finally, after those tests, we can assume (although if it would be better with
825 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
826 # and we can affect it to $userid.
827 if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
829 # Using Basic Authentication, no cookies required
830 $cookie = $query->cookie(
831 -name => 'CGISESSID',
838 elsif ( $emailaddress) {
839 # the Google OpenID Connect passes an email address
841 elsif ( $sessionID = $query->cookie("CGISESSID") )
842 { # assignment, not comparison
843 $session = get_session($sessionID);
844 C4::Context->_new_userenv($sessionID);
845 my ( $ip, $lasttime, $sessiontype );
848 $s_userid = $session->param('id') // '';
849 C4::Context->set_userenv(
850 $session->param('number'), $s_userid,
851 $session->param('cardnumber'), $session->param('firstname'),
852 $session->param('surname'), $session->param('branch'),
853 $session->param('branchname'), $session->param('flags'),
854 $session->param('emailaddress'), $session->param('branchprinter'),
855 $session->param('shibboleth')
857 C4::Context::set_shelves_userenv( 'bar', $session->param('barshelves') );
858 C4::Context::set_shelves_userenv( 'pub', $session->param('pubshelves') );
859 C4::Context::set_shelves_userenv( 'tot', $session->param('totshelves') );
860 $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
861 $ip = $session->param('ip');
862 $lasttime = $session->param('lasttime');
864 $sessiontype = $session->param('sessiontype') || '';
866 if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
867 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
868 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
871 #if a user enters an id ne to the id in the current session, we need to log them in...
872 #first we need to clear the anonymous session...
873 $debug and warn "query id = $q_userid but session id = $s_userid";
874 $anon_search_history = $session->param('search_history');
877 C4::Context->_unset_userenv($sessionID);
883 # voluntary logout the user
884 # check wether the user was using their shibboleth session or a local one
885 my $shibSuccess = C4::Context->userenv->{'shibboleth'};
888 C4::Context->_unset_userenv($sessionID);
890 #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
894 if ($cas and $caslogout) {
895 logout_cas($query, $type);
898 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
899 if ( $shib and $shib_login and $shibSuccess) {
903 elsif ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
906 $info{'timed_out'} = 1;
911 C4::Context->_unset_userenv($sessionID);
913 #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
917 elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
919 # Different ip than originally logged in from
920 $info{'oldip'} = $ip;
921 $info{'newip'} = $ENV{'REMOTE_ADDR'};
922 $info{'different_ip'} = 1;
925 C4::Context->_unset_userenv($sessionID);
927 #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
932 $cookie = $query->cookie(
933 -name => 'CGISESSID',
934 -value => $session->id,
937 $session->param( 'lasttime', time() );
938 unless ( $sessiontype && $sessiontype eq 'anon' ) { #if this is an anonymous session, we want to update the session, but not behave as if they are logged in...
939 $flags = haspermission( $userid, $flagsrequired );
943 $info{'nopermission'} = 1;
948 unless ( $userid || $sessionID ) {
949 #we initiate a session prior to checking for a username to allow for anonymous sessions...
950 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
952 # Save anonymous search history in new session so it can be retrieved
953 # by get_template_and_user to store it in user's search history after
954 # a successful login.
955 if ($anon_search_history) {
956 $session->param( 'search_history', $anon_search_history );
959 $sessionID = $session->id;
960 C4::Context->_new_userenv($sessionID);
961 $cookie = $query->cookie(
962 -name => 'CGISESSID',
963 -value => $session->id,
966 my $pki_field = C4::Context->preference('AllowPKIAuth');
967 if ( !defined($pki_field) ) {
968 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
971 if ( ( $cas && $query->param('ticket') )
973 || ( $shib && $shib_login )
974 || $pki_field ne 'None'
977 my $password = $query->param('password');
979 my ( $return, $cardnumber );
981 # If shib is enabled and we have a shib login, does the login match a valid koha user
982 if ( $shib && $shib_login ) {
985 # Do not pass password here, else shib will not be checked in checkpw.
986 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $q_userid, undef, $query );
987 $userid = $retuserid;
988 $shibSuccess = $return;
989 $info{'invalidShibLogin'} = 1 unless ($return);
992 # If shib login and match were successful, skip further login methods
993 unless ($shibSuccess) {
994 if ( $cas && $query->param('ticket') ) {
996 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
997 checkpw( $dbh, $userid, $password, $query, $type );
998 $userid = $retuserid;
999 $info{'invalidCasLogin'} = 1 unless ($return);
1002 elsif ( $emailaddress ) {
1003 my $value = $emailaddress;
1005 # If we're looking up the email, there's a chance that the person
1006 # doesn't have a userid. So if there is none, we pass along the
1007 # borrower number, and the bits of code that need to know the user
1008 # ID will have to be smart enough to handle that.
1009 my $patrons = Koha::Patrons->search({ email => $value });
1010 if ($patrons->count) {
1012 # First the userid, then the borrowernum
1013 my $patron = $patrons->next;
1014 $value = $patron->userid || $patron->borrowernumber;
1018 $return = $value ? 1 : 0;
1023 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1024 || ( $pki_field eq 'emailAddress'
1025 && $ENV{'SSL_CLIENT_S_DN_Email'} )
1029 if ( $pki_field eq 'Common Name' ) {
1030 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1032 elsif ( $pki_field eq 'emailAddress' ) {
1033 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1035 # If we're looking up the email, there's a chance that the person
1036 # doesn't have a userid. So if there is none, we pass along the
1037 # borrower number, and the bits of code that need to know the user
1038 # ID will have to be smart enough to handle that.
1039 my $patrons = Koha::Patrons->search({ email => $value });
1040 if ($patrons->count) {
1042 # First the userid, then the borrowernum
1043 my $patron = $patrons->next;
1044 $value = $patron->userid || $patron->borrowernumber;
1050 $return = $value ? 1 : 0;
1056 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1057 checkpw( $dbh, $q_userid, $password, $query, $type );
1058 $userid = $retuserid if ($retuserid);
1059 $info{'invalid_username_or_password'} = 1 unless ($return);
1063 # $return: 1 = valid user
1066 #_session_log(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
1067 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1071 $info{'nopermission'} = 1;
1072 C4::Context->_unset_userenv($sessionID);
1074 my ( $borrowernumber, $firstname, $surname, $userflags,
1075 $branchcode, $branchname, $branchprinter, $emailaddress );
1077 if ( $return == 1 ) {
1079 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1080 branches.branchname as branchname,
1081 branches.branchprinter as branchprinter,
1084 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1086 my $sth = $dbh->prepare("$select where userid=?");
1087 $sth->execute($userid);
1088 unless ( $sth->rows ) {
1089 $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
1090 $sth = $dbh->prepare("$select where cardnumber=?");
1091 $sth->execute($cardnumber);
1093 unless ( $sth->rows ) {
1094 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1095 $sth->execute($userid);
1096 unless ( $sth->rows ) {
1097 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1102 ( $borrowernumber, $firstname, $surname, $userflags,
1103 $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow;
1104 $debug and print STDERR "AUTH_3 results: " .
1105 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1107 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1110 # launch a sequence to check if we have a ip for the branch, i
1111 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1113 my $ip = $ENV{'REMOTE_ADDR'};
1115 # if they specify at login, use that
1116 if ( $query->param('branch') ) {
1117 $branchcode = $query->param('branch');
1118 my $library = Koha::Libraries->find($branchcode);
1119 $branchname = $library? $library->branchname: '';
1121 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1122 if ( $type ne 'opac' and C4::Context->boolean_preference('AutoLocation') ) {
1124 # we have to check they are coming from the right ip range
1125 my $domain = $branches->{$branchcode}->{'branchip'};
1126 $domain =~ s|\.\*||g;
1127 if ( $ip !~ /^$domain/ ) {
1129 $cookie = $query->cookie(
1130 -name => 'CGISESSID',
1134 $info{'wrongip'} = 1;
1138 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 $session->param( 'shibboleth', $shibSuccess );
1162 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1164 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1165 C4::Context->set_userenv(
1166 $session->param('number'), $session->param('id'),
1167 $session->param('cardnumber'), $session->param('firstname'),
1168 $session->param('surname'), $session->param('branch'),
1169 $session->param('branchname'), $session->param('flags'),
1170 $session->param('emailaddress'), $session->param('branchprinter'),
1171 $session->param('shibboleth')
1175 # $return: 0 = invalid user
1176 # reset to anonymous session
1178 $debug and warn "Login failed, resetting anonymous session...";
1180 $info{'invalid_username_or_password'} = 1;
1181 C4::Context->_unset_userenv($sessionID);
1183 $session->param( 'lasttime', time() );
1184 $session->param( 'ip', $session->remote_addr() );
1185 $session->param( 'sessiontype', 'anon' );
1187 } # END if ( $q_userid
1188 elsif ( $type eq "opac" ) {
1190 # if we are here this is an anonymous session; add public lists to it and a few other items...
1191 # anonymous sessions are created only for the OPAC
1192 $debug and warn "Initiating an anonymous session...";
1194 # setting a couple of other session vars...
1195 $session->param( 'ip', $session->remote_addr() );
1196 $session->param( 'lasttime', time() );
1197 $session->param( 'sessiontype', 'anon' );
1199 } # END unless ($userid)
1201 # finished authentification, now respond
1202 if ( $loggedin || $authnotrequired )
1206 $cookie = $query->cookie(
1207 -name => 'CGISESSID',
1213 track_login_daily( $userid );
1215 return ( $userid, $cookie, $sessionID, $flags );
1220 # AUTH rejected, show the login/password template, after checking the DB.
1224 # get the inputs from the incoming query
1226 foreach my $name ( param $query) {
1227 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1228 my @value = $query->multi_param($name);
1229 push @inputs, { name => $name, value => $_ } for @value;
1232 my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1234 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1235 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1236 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1238 my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1239 my $template = C4::Templates::gettemplate( $template_name, $type, $query );
1241 OpacAdditionalStylesheet => C4::Context->preference("OpacAdditionalStylesheet"),
1242 opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
1245 script_name => get_script_name(),
1246 casAuthentication => C4::Context->preference("casAuthentication"),
1247 shibbolethAuthentication => $shib,
1248 SessionRestrictionByIP => C4::Context->preference("SessionRestrictionByIP"),
1249 suggestion => C4::Context->preference("suggestion"),
1250 virtualshelves => C4::Context->preference("virtualshelves"),
1251 LibraryName => "" . C4::Context->preference("LibraryName"),
1252 LibraryNameTitle => "" . $LibraryNameTitle,
1253 opacuserlogin => C4::Context->preference("opacuserlogin"),
1254 OpacNav => C4::Context->preference("OpacNav"),
1255 OpacNavRight => C4::Context->preference("OpacNavRight"),
1256 OpacNavBottom => C4::Context->preference("OpacNavBottom"),
1257 opaccredits => C4::Context->preference("opaccredits"),
1258 OpacFavicon => C4::Context->preference("OpacFavicon"),
1259 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1260 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1261 OPACUserJS => C4::Context->preference("OPACUserJS"),
1262 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1263 OpacCloud => C4::Context->preference("OpacCloud"),
1264 OpacTopissue => C4::Context->preference("OpacTopissue"),
1265 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1266 OpacBrowser => C4::Context->preference("OpacBrowser"),
1267 opacheader => C4::Context->preference("opacheader"),
1268 TagsEnabled => C4::Context->preference("TagsEnabled"),
1269 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1270 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1271 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1272 intranetbookbag => C4::Context->preference("intranetbookbag"),
1273 IntranetNav => C4::Context->preference("IntranetNav"),
1274 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1275 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
1276 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1277 IndependentBranches => C4::Context->preference("IndependentBranches"),
1278 AutoLocation => C4::Context->preference("AutoLocation"),
1279 wrongip => $info{'wrongip'},
1280 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1281 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1282 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1283 too_many_login_attempts => ( $patron and $patron->account_locked )
1286 $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1287 $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1288 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1289 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1291 if ( $type eq 'opac' ) {
1292 require Koha::Virtualshelves;
1293 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1299 some_public_shelves => $some_public_shelves,
1305 # Is authentication against multiple CAS servers enabled?
1306 if ( C4::Auth_with_cas::multipleAuth && !$casparam ) {
1307 my $casservers = C4::Auth_with_cas::getMultipleAuth();
1309 foreach my $key ( keys %$casservers ) {
1310 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1313 casServersLoop => \@tmplservers
1317 casServerUrl => login_cas_url($query, undef, $type),
1322 invalidCasLogin => $info{'invalidCasLogin'}
1328 shibbolethAuthentication => $shib,
1329 shibbolethLoginUrl => login_shib_url($query),
1333 if (C4::Context->preference('GoogleOpenIDConnect')) {
1334 if ($query->param("OpenIDConnectFailed")) {
1335 my $reason = $query->param('OpenIDConnectFailed');
1336 $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1341 LibraryName => C4::Context->preference("LibraryName"),
1343 $template->param(%info);
1345 # $cookie = $query->cookie(CGISESSID => $session->id
1347 print $query->header(
1348 { type => 'text/html',
1351 'X-Frame-Options' => 'SAMEORIGIN'
1358 =head2 check_api_auth
1360 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1362 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1363 cookie, determine if the user has the privileges specified by C<$userflags>.
1365 C<check_api_auth> is is meant for authenticating users of web services, and
1366 consequently will always return and will not attempt to redirect the user
1369 If a valid session cookie is already present, check_api_auth will return a status
1370 of "ok", the cookie, and the Koha session ID.
1372 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1373 parameters and create a session cookie and Koha session if the supplied credentials
1376 Possible return values in C<$status> are:
1380 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1382 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1384 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1386 =item "expired -- session cookie has expired; API user should resubmit userid and password
1392 sub check_api_auth {
1395 my $flagsrequired = shift;
1396 my $dbh = C4::Context->dbh;
1397 my $timeout = _timeout_syspref();
1399 unless ( C4::Context->preference('Version') ) {
1401 # database has not been installed yet
1402 return ( "maintenance", undef, undef );
1404 my $kohaversion = Koha::version();
1405 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1406 if ( C4::Context->preference('Version') < $kohaversion ) {
1408 # database in need of version update; assume that
1409 # no API should be called while databsae is in
1411 return ( "maintenance", undef, undef );
1414 # FIXME -- most of what follows is a copy-and-paste
1415 # of code from checkauth. There is an obvious need
1416 # for refactoring to separate the various parts of
1417 # the authentication code, but as of 2007-11-19 this
1418 # is deferred so as to not introduce bugs into the
1419 # regular authentication code for Koha 3.0.
1421 # see if we have a valid session cookie already
1422 # however, if a userid parameter is present (i.e., from
1423 # a form submission, assume that any current cookie
1425 my $sessionID = undef;
1426 unless ( $query->param('userid') ) {
1427 $sessionID = $query->cookie("CGISESSID");
1429 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1430 my $session = get_session($sessionID);
1431 C4::Context->_new_userenv($sessionID);
1433 C4::Context->set_userenv(
1434 $session->param('number'), $session->param('id'),
1435 $session->param('cardnumber'), $session->param('firstname'),
1436 $session->param('surname'), $session->param('branch'),
1437 $session->param('branchname'), $session->param('flags'),
1438 $session->param('emailaddress'), $session->param('branchprinter')
1441 my $ip = $session->param('ip');
1442 my $lasttime = $session->param('lasttime');
1443 my $userid = $session->param('id');
1444 if ( $lasttime < time() - $timeout ) {
1449 C4::Context->_unset_userenv($sessionID);
1452 return ( "expired", undef, undef );
1453 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1455 # IP address changed
1458 C4::Context->_unset_userenv($sessionID);
1461 return ( "expired", undef, undef );
1463 my $cookie = $query->cookie(
1464 -name => 'CGISESSID',
1465 -value => $session->id,
1468 $session->param( 'lasttime', time() );
1469 my $flags = haspermission( $userid, $flagsrequired );
1471 return ( "ok", $cookie, $sessionID );
1475 C4::Context->_unset_userenv($sessionID);
1478 return ( "failed", undef, undef );
1482 return ( "expired", undef, undef );
1487 my $userid = $query->param('userid');
1488 my $password = $query->param('password');
1489 my ( $return, $cardnumber, $cas_ticket );
1492 if ( $cas && $query->param('PT') ) {
1494 $debug and print STDERR "## check_api_auth - checking CAS\n";
1496 # In case of a CAS authentication, we use the ticket instead of the password
1497 my $PT = $query->param('PT');
1498 ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $dbh, $PT, $query ); # EXTERNAL AUTH
1501 # User / password auth
1502 unless ( $userid and $password ) {
1504 # caller did something wrong, fail the authenticateion
1505 return ( "failed", undef, undef );
1508 ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $dbh, $userid, $password, $query );
1511 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1512 my $session = get_session("");
1513 return ( "failed", undef, undef ) unless $session;
1515 my $sessionID = $session->id;
1516 C4::Context->_new_userenv($sessionID);
1517 my $cookie = $query->cookie(
1518 -name => 'CGISESSID',
1519 -value => $sessionID,
1522 if ( $return == 1 ) {
1524 $borrowernumber, $firstname, $surname,
1525 $userflags, $branchcode, $branchname,
1526 $branchprinter, $emailaddress
1530 "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=?"
1532 $sth->execute($userid);
1534 $borrowernumber, $firstname, $surname,
1535 $userflags, $branchcode, $branchname,
1536 $branchprinter, $emailaddress
1537 ) = $sth->fetchrow if ( $sth->rows );
1539 unless ( $sth->rows ) {
1540 my $sth = $dbh->prepare(
1541 "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=?"
1543 $sth->execute($cardnumber);
1545 $borrowernumber, $firstname, $surname,
1546 $userflags, $branchcode, $branchname,
1547 $branchprinter, $emailaddress
1548 ) = $sth->fetchrow if ( $sth->rows );
1550 unless ( $sth->rows ) {
1551 $sth->execute($userid);
1553 $borrowernumber, $firstname, $surname, $userflags,
1554 $branchcode, $branchname, $branchprinter, $emailaddress
1555 ) = $sth->fetchrow if ( $sth->rows );
1559 my $ip = $ENV{'REMOTE_ADDR'};
1561 # if they specify at login, use that
1562 if ( $query->param('branch') ) {
1563 $branchcode = $query->param('branch');
1564 my $library = Koha::Libraries->find($branchcode);
1565 $branchname = $library? $library->branchname: '';
1567 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1568 foreach my $br ( keys %$branches ) {
1570 # now we work with the treatment of ip
1571 my $domain = $branches->{$br}->{'branchip'};
1572 if ( $domain && $ip =~ /^$domain/ ) {
1573 $branchcode = $branches->{$br}->{'branchcode'};
1575 # new op dev : add the branchprinter and branchname in the cookie
1576 $branchprinter = $branches->{$br}->{'branchprinter'};
1577 $branchname = $branches->{$br}->{'branchname'};
1580 $session->param( 'number', $borrowernumber );
1581 $session->param( 'id', $userid );
1582 $session->param( 'cardnumber', $cardnumber );
1583 $session->param( 'firstname', $firstname );
1584 $session->param( 'surname', $surname );
1585 $session->param( 'branch', $branchcode );
1586 $session->param( 'branchname', $branchname );
1587 $session->param( 'flags', $userflags );
1588 $session->param( 'emailaddress', $emailaddress );
1589 $session->param( 'ip', $session->remote_addr() );
1590 $session->param( 'lasttime', time() );
1592 $session->param( 'cas_ticket', $cas_ticket);
1593 C4::Context->set_userenv(
1594 $session->param('number'), $session->param('id'),
1595 $session->param('cardnumber'), $session->param('firstname'),
1596 $session->param('surname'), $session->param('branch'),
1597 $session->param('branchname'), $session->param('flags'),
1598 $session->param('emailaddress'), $session->param('branchprinter')
1600 return ( "ok", $cookie, $sessionID );
1602 return ( "failed", undef, undef );
1607 =head2 check_cookie_auth
1609 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1611 Given a CGISESSID cookie set during a previous login to Koha, determine
1612 if the user has the privileges specified by C<$userflags>.
1614 C<check_cookie_auth> is meant for authenticating special services
1615 such as tools/upload-file.pl that are invoked by other pages that
1616 have been authenticated in the usual way.
1618 Possible return values in C<$status> are:
1622 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1624 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1626 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1628 =item "expired -- session cookie has expired; API user should resubmit userid and password
1634 sub check_cookie_auth {
1636 my $flagsrequired = shift;
1639 my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1640 my $dbh = C4::Context->dbh;
1641 my $timeout = _timeout_syspref();
1643 unless ( C4::Context->preference('Version') ) {
1645 # database has not been installed yet
1646 return ( "maintenance", undef );
1648 my $kohaversion = Koha::version();
1649 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1650 if ( C4::Context->preference('Version') < $kohaversion ) {
1652 # database in need of version update; assume that
1653 # no API should be called while databsae is in
1655 return ( "maintenance", undef );
1658 # FIXME -- most of what follows is a copy-and-paste
1659 # of code from checkauth. There is an obvious need
1660 # for refactoring to separate the various parts of
1661 # the authentication code, but as of 2007-11-23 this
1662 # is deferred so as to not introduce bugs into the
1663 # regular authentication code for Koha 3.0.
1665 # see if we have a valid session cookie already
1666 # however, if a userid parameter is present (i.e., from
1667 # a form submission, assume that any current cookie
1669 unless ( defined $cookie and $cookie ) {
1670 return ( "failed", undef );
1672 my $sessionID = $cookie;
1673 my $session = get_session($sessionID);
1674 C4::Context->_new_userenv($sessionID);
1676 C4::Context->set_userenv(
1677 $session->param('number'), $session->param('id'),
1678 $session->param('cardnumber'), $session->param('firstname'),
1679 $session->param('surname'), $session->param('branch'),
1680 $session->param('branchname'), $session->param('flags'),
1681 $session->param('emailaddress'), $session->param('branchprinter')
1684 my $ip = $session->param('ip');
1685 my $lasttime = $session->param('lasttime');
1686 my $userid = $session->param('id');
1687 if ( $lasttime < time() - $timeout ) {
1692 C4::Context->_unset_userenv($sessionID);
1695 return ("expired", undef);
1696 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1698 # IP address changed
1701 C4::Context->_unset_userenv($sessionID);
1704 return ( "expired", undef );
1706 $session->param( 'lasttime', time() );
1707 my $flags = haspermission( $userid, $flagsrequired );
1709 return ( "ok", $sessionID );
1713 C4::Context->_unset_userenv($sessionID);
1716 return ( "failed", undef );
1720 return ( "expired", undef );
1727 my $session = get_session($sessionID);
1729 Given a session ID, retrieve the CGI::Session object used to store
1730 the session's state. The session object can be used to store
1731 data that needs to be accessed by different scripts during a
1734 If the C<$sessionID> parameter is an empty string, a new session
1739 sub _get_session_params {
1740 my $storage_method = C4::Context->preference('SessionStorage');
1741 if ( $storage_method eq 'mysql' ) {
1742 my $dbh = C4::Context->dbh;
1743 return { dsn => "driver:MySQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1745 elsif ( $storage_method eq 'Pg' ) {
1746 my $dbh = C4::Context->dbh;
1747 return { dsn => "driver:PostgreSQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1749 elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1750 my $memcached = Koha::Caches->get_instance()->memcached_cache;
1751 return { dsn => "driver:memcached;serializer:yaml;id:md5", dsn_args => { Memcached => $memcached } };
1754 # catch all defaults to tmp should work on all systems
1755 my $dir = C4::Context::temporary_directory;
1756 my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1757 return { dsn => "driver:File;serializer:yaml;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1762 my $sessionID = shift;
1763 my $params = _get_session_params();
1764 return new CGI::Session( $params->{dsn}, $sessionID, $params->{dsn_args} );
1768 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1769 # (or something similar)
1770 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1771 # not having a userenv defined could cause a crash.
1773 my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1774 $type = 'opac' unless $type;
1777 my $patron = Koha::Patrons->find({ userid => $userid });
1778 my $check_internal_as_fallback = 0;
1780 # Note: checkpw_* routines returns:
1783 # -1 if user bind failed (LDAP only)
1785 if ( $patron and $patron->account_locked ) {
1786 # Nothing to check, account is locked
1787 } elsif ($ldap && defined($password)) {
1788 $debug and print STDERR "## checkpw - checking LDAP\n";
1789 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
1790 if ( $retval == 1 ) {
1791 @return = ( $retval, $retcard, $retuserid );
1794 $check_internal_as_fallback = 1 if $retval == 0;
1796 } elsif ( $cas && $query && $query->param('ticket') ) {
1797 $debug and print STDERR "## checkpw - checking CAS\n";
1799 # In case of a CAS authentication, we use the ticket instead of the password
1800 my $ticket = $query->param('ticket');
1801 $query->delete('ticket'); # remove ticket to come back to original URL
1802 my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $dbh, $ticket, $query, $type ); # EXTERNAL AUTH
1804 @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1808 $passwd_ok = $retval;
1811 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1812 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1814 elsif ( $shib && $shib_login && !$password ) {
1816 $debug and print STDERR "## checkpw - checking Shibboleth\n";
1818 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1819 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1820 # shibboleth-authenticated user
1822 # Then, we check if it matches a valid koha user
1824 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
1826 @return = ( $retval, $retcard, $retuserid );
1828 $passwd_ok = $retval;
1831 $check_internal_as_fallback = 1;
1835 if ( $check_internal_as_fallback ) {
1836 @return = checkpw_internal( $dbh, $userid, $password, $no_set_userenv);
1837 $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1842 $patron->update({ login_attempts => 0 });
1844 $patron->update({ login_attempts => $patron->login_attempts + 1 });
1850 sub checkpw_internal {
1851 my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
1853 $password = Encode::encode( 'UTF-8', $password )
1854 if Encode::is_utf8($password);
1858 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1860 $sth->execute($userid);
1862 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1863 $surname, $branchcode, $branchname, $flags )
1866 if ( checkpw_hash( $password, $stored_hash ) ) {
1868 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1869 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1870 return 1, $cardnumber, $userid;
1875 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1877 $sth->execute($userid);
1879 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1880 $surname, $branchcode, $branchname, $flags )
1883 if ( checkpw_hash( $password, $stored_hash ) ) {
1885 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1886 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1887 return 1, $cardnumber, $userid;
1894 my ( $password, $stored_hash ) = @_;
1896 return if $stored_hash eq '!';
1898 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1900 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1901 $hash = hash_password( $password, $stored_hash );
1903 $hash = md5_base64($password);
1905 return $hash eq $stored_hash;
1910 my $authflags = getuserflags($flags, $userid, [$dbh]);
1912 Translates integer flags into permissions strings hash.
1914 C<$flags> is the integer userflags value ( borrowers.userflags )
1915 C<$userid> is the members.userid, used for building subpermissions
1916 C<$authflags> is a hashref of permissions
1923 my $dbh = @_ ? shift : C4::Context->dbh;
1926 # I don't want to do this, but if someone logs in as the database
1927 # user, it would be preferable not to spam them to death with
1928 # numeric warnings. So, we make $flags numeric.
1929 no warnings 'numeric';
1932 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1935 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1936 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1937 $userflags->{$flag} = 1;
1940 $userflags->{$flag} = 0;
1944 # get subpermissions and merge with top-level permissions
1945 my $user_subperms = get_user_subpermissions($userid);
1946 foreach my $module ( keys %$user_subperms ) {
1947 next if $userflags->{$module} == 1; # user already has permission for everything in this module
1948 $userflags->{$module} = $user_subperms->{$module};
1954 =head2 get_user_subpermissions
1956 $user_perm_hashref = get_user_subpermissions($userid);
1958 Given the userid (note, not the borrowernumber) of a staff user,
1959 return a hashref of hashrefs of the specific subpermissions
1960 accorded to the user. An example return is
1964 export_catalog => 1,
1965 import_patrons => 1,
1969 The top-level hash-key is a module or function code from
1970 userflags.flag, while the second-level key is a code
1973 The results of this function do not give a complete picture
1974 of the functions that a staff user can access; it is also
1975 necessary to check borrowers.flags.
1979 sub get_user_subpermissions {
1982 my $dbh = C4::Context->dbh;
1983 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
1984 FROM user_permissions
1985 JOIN permissions USING (module_bit, code)
1986 JOIN userflags ON (module_bit = bit)
1987 JOIN borrowers USING (borrowernumber)
1988 WHERE userid = ?" );
1989 $sth->execute($userid);
1991 my $user_perms = {};
1992 while ( my $perm = $sth->fetchrow_hashref ) {
1993 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1998 =head2 get_all_subpermissions
2000 my $perm_hashref = get_all_subpermissions();
2002 Returns a hashref of hashrefs defining all specific
2003 permissions currently defined. The return value
2004 has the same structure as that of C<get_user_subpermissions>,
2005 except that the innermost hash value is the description
2006 of the subpermission.
2010 sub get_all_subpermissions {
2011 my $dbh = C4::Context->dbh;
2012 my $sth = $dbh->prepare( "SELECT flag, code
2014 JOIN userflags ON (module_bit = bit)" );
2018 while ( my $perm = $sth->fetchrow_hashref ) {
2019 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2024 =head2 haspermission
2026 $flags = ($userid, $flagsrequired);
2028 C<$userid> the userid of the member
2029 C<$flags> is a hashref of required flags like C<$borrower-<{authflags}>
2031 Returns member's flags or 0 if a permission is not met.
2036 my ( $userid, $flagsrequired ) = @_;
2037 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2038 $sth->execute($userid);
2039 my $row = $sth->fetchrow();
2040 my $flags = getuserflags( $row, $userid );
2042 return $flags if $flags->{superlibrarian};
2044 foreach my $module ( keys %$flagsrequired ) {
2045 my $subperm = $flagsrequired->{$module};
2046 if ( $subperm eq '*' ) {
2047 return 0 unless ( $flags->{$module} == 1 or ref( $flags->{$module} ) );
2050 ( defined $flags->{$module} and
2051 $flags->{$module} == 1 )
2053 ( ref( $flags->{$module} ) and
2054 exists $flags->{$module}->{$subperm} and
2055 $flags->{$module}->{$subperm} == 1 )
2061 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2064 sub getborrowernumber {
2066 my $userenv = C4::Context->userenv;
2067 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2068 return $userenv->{number};
2070 my $dbh = C4::Context->dbh;
2071 for my $field ( 'userid', 'cardnumber' ) {
2073 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2074 $sth->execute($userid);
2076 my ($bnumber) = $sth->fetchrow;
2083 =head2 track_login_daily
2085 track_login_daily( $userid );
2087 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2091 sub track_login_daily {
2093 return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2095 my $cache = Koha::Caches->get_instance();
2096 my $cache_key = "track_login_" . $userid;
2097 my $cached = $cache->get_from_cache($cache_key);
2098 my $today = dt_from_string()->ymd;
2099 return if $cached && $cached eq $today;
2101 my $patron = Koha::Patrons->find({ userid => $userid });
2102 return unless $patron;
2103 $patron->track_login;
2104 $cache->set_in_cache( $cache_key, $today );
2107 END { } # module clean-up code here (global destructor)
2117 Crypt::Eksblowfish::Bcrypt(3)