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>.
24 use Digest::MD5 qw( md5_base64 );
26 use CGI::Session::ErrorHandler;
31 use C4::Templates; # to get the template
33 use C4::Search::History;
37 use Koha::AuthUtils qw( get_script_name hash_password );
38 use Koha::Auth::TwoFactorAuth;
40 use Koha::DateUtils qw( dt_from_string );
41 use Koha::Library::Groups;
43 use Koha::Cash::Registers;
46 use Koha::Patron::Consents;
47 use List::MoreUtils qw( any );
49 use C4::Auth_with_shibboleth qw( shib_ok get_login_shib login_shib_url logout_shib checkpw_shib );
51 use C4::Log qw( logaction );
52 use Koha::CookieManager;
53 use Koha::Auth::Permissions;
57 use vars qw($ldap $cas $caslogout);
58 our (@ISA, @EXPORT_OK);
60 #NOTE: The utility of keeping the safe_exit function is that it can be easily re-defined in unit tests and plugins
62 # It's fine for us to "exit" because CGI::Compile (used in Plack::App::WrapCGI) redefines "exit" for us automatically.
63 # Since we only seem to use C4::Auth::safe_exit in a CGI context, we don't actually need PSGI detection at all here.
69 C4::Context->set_remote_address;
75 checkauth check_api_auth get_session check_cookie_auth checkpw checkpw_internal checkpw_hash
76 get_all_subpermissions get_user_subpermissions track_login_daily in_iprange
77 get_template_and_user haspermission
80 $ldap = C4::Context->config('useldapserver') || 0;
81 $cas = C4::Context->preference('casAuthentication');
82 $caslogout = C4::Context->preference('casLogout');
85 require C4::Auth_with_ldap;
86 import C4::Auth_with_ldap qw(checkpw_ldap);
89 require C4::Auth_with_cas; # no import
90 import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url logout_if_required multipleAuth getMultipleAuth);
97 C4::Auth - Authenticates Koha users
101 use CGI qw ( -utf8 );
105 my $query = CGI->new;
107 my ($template, $borrowernumber, $cookie)
108 = get_template_and_user(
110 template_name => "opac-main.tt",
113 authnotrequired => 0,
114 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
118 output_html_with_http_headers $query, $cookie, $template->output;
122 The main function of this module is to provide
123 authentification. However the get_template_and_user function has
124 been provided so that a users login information is passed along
125 automatically. This gets loaded into the template.
129 =head2 get_template_and_user
131 my ($template, $borrowernumber, $cookie)
132 = get_template_and_user(
134 template_name => "opac-main.tt",
137 authnotrequired => 0,
138 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
142 This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
143 to C<&checkauth> (in this module) to perform authentification.
144 See C<&checkauth> for an explanation of these parameters.
146 The C<template_name> is then used to find the correct template for
147 the page. The authenticated users details are loaded onto the
148 template in the logged_in_user variable (which is a Koha::Patron object). Also the
149 C<sessionID> is passed to the template. This can be used in templates
150 if cookies are disabled. It needs to be put as and input to every
153 More information on the C<gettemplate> sub can be found in the
158 sub get_template_and_user {
161 my ( $user, $cookie, $sessionID, $flags );
164 my $cookie_mgr = Koha::CookieManager->new;
166 # Get shibboleth login attribute
167 my $shib = C4::Context->config('useshibboleth') && shib_ok();
168 my $shib_login = $shib ? get_login_shib() : undef;
170 C4::Context->interface( $in->{type} );
172 $in->{'authnotrequired'} ||= 0;
174 # the following call includes a bad template check; might croak
175 my $template = C4::Templates::gettemplate(
176 $in->{'template_name'},
181 if ( $in->{'template_name'} !~ m/maintenance/ ) {
182 ( $user, $cookie, $sessionID, $flags ) = checkauth(
184 $in->{'authnotrequired'},
185 $in->{'flagsrequired'},
188 $in->{template_name},
192 # If we enforce GDPR and the user did not consent, redirect
193 # Exceptions for consent page itself and SCI/SCO system
194 if( $in->{type} eq 'opac' && $user &&
195 $in->{'template_name'} !~ /^(opac-patron-consent|sc[io]\/)/ &&
196 C4::Context->preference('GDPR_Policy') eq 'Enforced' )
198 my $consent = Koha::Patron::Consents->search({
199 borrowernumber => getborrowernumber($user),
200 type => 'GDPR_PROCESSING',
201 given_on => { '!=', undef },
204 print $in->{query}->redirect(-uri => '/cgi-bin/koha/opac-patron-consent.pl', -cookie => $cookie);
209 if ( $in->{type} eq 'opac' && $user ) {
212 my $session = get_session($sessionID);
214 $is_sco_user = $session->param('sco_user');
220 # If the user logged in is the SCO user and they try to go out of the SCO module,
221 # log the user out removing the CGISESSID cookie
222 $in->{template_name} !~ m|sco/| && $in->{template_name} !~ m|errors/errorpage.tt|
226 C4::Context->preference('AutoSelfCheckID')
227 && $user eq C4::Context->preference('AutoSelfCheckID')
235 # If the user logged in is the SCI user and they try to go out of the SCI module,
236 # kick them out unless it is SCO with a valid permission
237 # or they are a superlibrarian
238 $in->{template_name} !~ m|sci/|
239 && haspermission( $user, { self_check => 'self_checkin_module' } )
241 $in->{template_name} =~ m|sco/| && haspermission(
242 $user, { self_check => 'self_checkout_module' }
245 && $flags && $flags->{superlibrarian} != 1
252 $template = C4::Templates::gettemplate( 'opac-auth.tt', 'opac',
254 $cookie = $cookie_mgr->replace_in_list( $cookie, $in->{query}->cookie(
255 -name => 'CGISESSID',
258 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
264 script_name => get_script_name(),
267 print $in->{query}->header(
272 'X-Frame-Options' => 'SAMEORIGIN'
283 # It's possible for $user to be the borrowernumber if they don't have a
284 # userid defined (and are logging in through some other method, such
285 # as SSL certs against an email address)
287 $borrowernumber = getborrowernumber($user) if defined($user);
288 if ( !defined($borrowernumber) && defined($user) ) {
289 $patron = Koha::Patrons->find( $user );
291 $borrowernumber = $user;
293 # A bit of a hack, but I don't know there's a nicer way
295 $user = $patron->firstname . ' ' . $patron->surname;
298 $patron = Koha::Patrons->find( $borrowernumber );
299 # FIXME What to do if $patron does not exist?
303 $template->param( loggedinusername => $user ); # OBSOLETE - Do not reuse this in template, use logged_in_user.userid instead
304 $template->param( loggedinusernumber => $borrowernumber ); # FIXME Should be replaced with logged_in_user.borrowernumber
305 $template->param( logged_in_user => $patron );
306 $template->param( sessionID => $sessionID );
308 if ( $in->{'type'} eq 'opac' ) {
309 require Koha::Virtualshelves;
310 my $some_private_shelves = Koha::Virtualshelves->get_some_shelves(
312 borrowernumber => $borrowernumber,
316 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
322 some_private_shelves => $some_private_shelves,
323 some_public_shelves => $some_public_shelves,
327 # We are going to use the $flags returned by checkauth
328 # to create the template's parameters that will indicate
329 # which menus the user can access.
330 my $authz = Koha::Auth::Permissions->get_authz_from_flags({ flags => $flags });
331 foreach my $permission ( keys %{ $authz } ){
332 $template->param( $permission => $authz->{$permission} );
335 # Logged-in opac search history
336 # If the requested template is an opac one and opac search history is enabled
337 if ( $in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory') ) {
338 my $dbh = C4::Context->dbh;
339 my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
340 my $sth = $dbh->prepare($query);
341 $sth->execute($borrowernumber);
343 # If at least one search has already been performed
344 if ( $sth->fetchrow_array > 0 ) {
346 # We show the link in opac
347 $template->param( EnableOpacSearchHistory => 1 );
349 if (C4::Context->preference('LoadSearchHistoryToTheFirstLoggedUser'))
351 # And if there are searches performed when the user was not logged in,
352 # we add them to the logged-in search history
353 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
354 if (@recentSearches) {
356 INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, type, total, time )
357 VALUES (?, ?, ?, ?, ?, ?, ?)
359 my $sth = $dbh->prepare($query);
360 $sth->execute( $borrowernumber,
361 $in->{query}->cookie("CGISESSID"),
364 $_->{type} || 'biblio',
367 ) foreach @recentSearches;
369 # clear out the search history from the session now that
370 # we've saved it to the database
373 C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } );
375 } elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) {
376 $template->param( EnableSearchHistory => 1 );
379 else { # if this is an anonymous session, setup to display public lists...
381 # If shibboleth is enabled, and we're in an anonymous session, we should allow
382 # the user to attempt login via shibboleth.
384 $template->param( shibbolethAuthentication => $shib,
385 shibbolethLoginUrl => login_shib_url( $in->{'query'} ),
388 # If shibboleth is enabled and we have a shibboleth login attribute,
389 # but we are in an anonymous session, then we clearly have an invalid
390 # shibboleth koha account.
392 $template->param( invalidShibLogin => '1' );
396 $template->param( sessionID => $sessionID );
398 if ( $in->{'type'} eq 'opac' ){
399 require Koha::Virtualshelves;
400 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
406 some_public_shelves => $some_public_shelves,
409 # Set default branch if one has been passed by the environment.
410 $template->param( default_branch => $ENV{OPAC_BRANCH_DEFAULT} ) if $ENV{OPAC_BRANCH_DEFAULT};
414 # Sysprefs disabled via URL param
415 # Note that value must be defined in order to override via ENV
416 foreach my $syspref (
422 OpacAdditionalStylesheet
424 intranetcolorstylesheet
429 $ENV{"OVERRIDE_SYSPREF_$syspref"} = q{}
430 if $in->{'query'}->param("DISABLE_SYSPREF_$syspref");
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 my $minPasswordLength = C4::Context->preference('minPasswordLength');
451 $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
453 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
454 GoogleJackets => C4::Context->preference("GoogleJackets"),
455 OpenLibraryCovers => C4::Context->preference("OpenLibraryCovers"),
456 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
457 LoginFirstname => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
458 LoginSurname => C4::Context->userenv ? C4::Context->userenv->{"surname"} : "Inconnu",
459 emailaddress => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
460 TagsEnabled => C4::Context->preference("TagsEnabled"),
461 hide_marc => C4::Context->preference("hide_marc"),
462 item_level_itypes => C4::Context->preference('item-level_itypes'),
463 patronimages => C4::Context->preference("patronimages"),
464 singleBranchMode => ( Koha::Libraries->search->count == 1 ),
465 noItemTypeImages => C4::Context->preference("noItemTypeImages"),
466 marcflavour => C4::Context->preference("marcflavour"),
467 OPACBaseURL => C4::Context->preference('OPACBaseURL'),
468 minPasswordLength => $minPasswordLength,
470 if ( $in->{'type'} eq "intranet" ) {
472 AmazonCoverImages => C4::Context->preference("AmazonCoverImages"),
473 AutoLocation => C4::Context->preference("AutoLocation"),
474 PatronAutoComplete => C4::Context->preference("PatronAutoComplete"),
475 FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
476 IndependentBranches => C4::Context->preference("IndependentBranches"),
477 IntranetNav => C4::Context->preference("IntranetNav"),
478 IntranetmainUserblock => C4::Context->preference("IntranetmainUserblock"),
479 LibraryName => C4::Context->preference("LibraryName"),
480 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
481 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
482 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
483 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
484 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
485 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
486 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
487 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
488 suggestion => C4::Context->preference("suggestion"),
489 virtualshelves => C4::Context->preference("virtualshelves"),
490 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
491 EasyAnalyticalRecords => C4::Context->preference('EasyAnalyticalRecords'),
492 LocalCoverImages => C4::Context->preference('LocalCoverImages'),
493 OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'),
494 AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'),
495 EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'),
496 UseCourseReserves => C4::Context->preference("UseCourseReserves"),
497 useDischarge => C4::Context->preference('useDischarge'),
498 pending_checkout_notes => Koha::Checkouts->search({ noteseen => 0 }),
499 plugins_enabled => C4::Context->config("enable_plugins"),
503 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
505 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
506 my $LibraryNameTitle = C4::Context->preference("LibraryName");
507 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
508 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
510 # clean up the busc param in the session
511 # if the page is not opac-detail and not the "add to list" page
512 # and not the "edit comments" page
513 if ( C4::Context->preference("OpacBrowseResults")
514 && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
516 unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
517 or $pagename =~ /^showmarc$/
518 or $pagename =~ /^addbybiblionumber$/
519 or $pagename =~ /^review$/ )
521 my $sessionSearch = get_session( $sessionID );
522 $sessionSearch->clear( ["busc"] ) if $sessionSearch;
526 # variables passed from CGI: opac_css_override and opac_search_limits.
527 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
528 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
531 ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:([\w-]+)/ ) ||
532 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:([\w-]+)/ ) ||
533 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /multibranchlimit:(\w+)/ )
535 $opac_name = $1; # opac_search_limit is a branch, so we use it.
536 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
537 $opac_name = $in->{'query'}->param('multibranchlimit');
538 } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
539 $opac_name = C4::Context->userenv->{'branch'};
542 my @search_groups = Koha::Library::Groups->get_search_groups({ interface => 'opac' })->as_list;
544 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
545 LibrarySearchGroups => \@search_groups,
546 opac_name => $opac_name,
547 LibraryName => "" . C4::Context->preference("LibraryName"),
548 LibraryNameTitle => "" . $LibraryNameTitle,
549 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
550 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
551 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
552 OPACShelfBrowser => "" . C4::Context->preference("OPACShelfBrowser"),
553 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
554 OPACUserCSS => "" . C4::Context->preference("OPACUserCSS"),
555 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
556 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
557 opac_search_limit => $opac_search_limit,
558 opac_limit_override => $opac_limit_override,
559 OpacBrowser => C4::Context->preference("OpacBrowser"),
560 OpacCloud => C4::Context->preference("OpacCloud"),
561 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
562 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
563 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
564 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
565 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
566 OpacTopissue => C4::Context->preference("OpacTopissue"),
567 'Version' => C4::Context->preference('Version'),
568 hidelostitems => C4::Context->preference("hidelostitems"),
569 mylibraryfirst => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
570 opacbookbag => "" . C4::Context->preference("opacbookbag"),
571 OpacFavicon => C4::Context->preference("OpacFavicon"),
572 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
573 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
574 OPACUserJS => C4::Context->preference("OPACUserJS"),
575 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
576 OpenLibrarySearch => C4::Context->preference("OpenLibrarySearch"),
577 ShowReviewer => C4::Context->preference("ShowReviewer"),
578 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
579 suggestion => "" . C4::Context->preference("suggestion"),
580 virtualshelves => "" . C4::Context->preference("virtualshelves"),
581 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
582 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
583 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
584 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
585 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
586 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
587 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
588 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
589 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
590 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
591 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
592 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
593 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
594 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
595 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
596 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
597 useDischarge => C4::Context->preference('useDischarge'),
600 $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
603 # Check if we were asked using parameters to force a specific language
604 if ( defined $in->{'query'}->param('language') ) {
606 # Extract the language, let C4::Languages::getlanguage choose
608 my $language = C4::Languages::getlanguage( $in->{'query'} );
609 my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
610 $cookie = $cookie_mgr->replace_in_list( $cookie, $languagecookie );
613 return ( $template, $borrowernumber, $cookie, $flags );
618 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
620 Verifies that the user is authorized to run this script. If
621 the user is authorized, a (userid, cookie, session-id, flags)
622 quadruple is returned. If the user is not authorized but does
623 not have the required privilege (see $flagsrequired below), it
624 displays an error page and exits. Otherwise, it displays the
625 login page and exits.
627 Note that C<&checkauth> will return if and only if the user
628 is authorized, so it should be called early on, before any
629 unfinished operations (e.g., if you've opened a file, then
630 C<&checkauth> won't close it for you).
632 C<$query> is the CGI object for the script calling C<&checkauth>.
634 The C<$noauth> argument is optional. If it is set, then no
635 authorization is required for the script.
637 C<&checkauth> fetches user and session information from C<$query> and
638 ensures that the user is authorized to run scripts that require
641 The C<$flagsrequired> argument specifies the required privileges
642 the user must have if the username and password are correct.
643 It should be specified as a reference-to-hash; keys in the hash
644 should be the "flags" for the user, as specified in the Members
645 intranet module. Any key specified must correspond to a "flag"
646 in the userflags table. E.g., { circulate => 1 } would specify
647 that the user must have the "circulate" privilege in order to
648 proceed. To make sure that access control is correct, the
649 C<$flagsrequired> parameter must be specified correctly.
651 Koha also has a concept of sub-permissions, also known as
652 granular permissions. This makes the value of each key
653 in the C<flagsrequired> hash take on an additional
658 The user must have access to all subfunctions of the module
659 specified by the hash key.
663 The user must have access to at least one subfunction of the module
664 specified by the hash key.
666 specific permission, e.g., 'export_catalog'
668 The user must have access to the specific subfunction list, which
669 must correspond to a row in the permissions table.
671 The C<$type> argument specifies whether the template should be
672 retrieved from the opac or intranet directory tree. "opac" is
673 assumed if it is not specified; however, if C<$type> is specified,
674 "intranet" is assumed if it is not "opac".
676 If C<$query> does not have a valid session ID associated with it
677 (i.e., the user has not logged in) or if the session has expired,
678 C<&checkauth> presents the user with a login page (from the point of
679 view of the original script, C<&checkauth> does not return). Once the
680 user has authenticated, C<&checkauth> restarts the original script
681 (this time, C<&checkauth> returns).
683 The login page is provided using a HTML::Template, which is set in the
684 systempreferences table or at the top of this file. The variable C<$type>
685 selects which template to use, either the opac or the intranet
686 authentification template.
688 C<&checkauth> returns a user ID, a cookie, and a session ID. The
689 cookie should be sent back to the browser; it verifies that the user
699 # If version syspref is unavailable, it means Koha is being installed,
700 # and so we must redirect to OPAC maintenance page or to the WebInstaller
701 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
702 if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
703 warn "OPAC Install required, redirecting to maintenance";
704 print $query->redirect("/cgi-bin/koha/maintenance.pl");
707 unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
708 if ( $type ne 'opac' ) {
709 warn "Install required, redirecting to Installer";
710 print $query->redirect("/cgi-bin/koha/installer/install.pl");
712 warn "OPAC Install required, redirecting to maintenance";
713 print $query->redirect("/cgi-bin/koha/maintenance.pl");
718 # check that database and koha version are the same
719 # there is no DB version, it's a fresh install,
720 # go to web installer
721 # there is a DB version, compare it to the code version
722 my $kohaversion = Koha::version();
724 # remove the 3 last . to have a Perl number
725 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
726 Koha::Logger->get->debug("kohaversion : $kohaversion");
727 if ( $version < $kohaversion ) {
728 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
729 if ( $type ne 'opac' ) {
730 warn sprintf( $warning, 'Installer' );
731 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
733 warn sprintf( "OPAC: " . $warning, 'maintenance' );
734 print $query->redirect("/cgi-bin/koha/maintenance.pl");
740 sub _timeout_syspref {
741 my $default_timeout = 600;
742 my $timeout = C4::Context->preference('timeout') || $default_timeout;
744 # value in days, convert in seconds
745 if ( $timeout =~ /^(\d+)[dD]$/ ) {
746 $timeout = $1 * 86400;
748 # value in hours, convert in seconds
749 elsif ( $timeout =~ /^(\d+)[hH]$/ ) {
750 $timeout = $1 * 3600;
752 elsif ( $timeout !~ m/^\d+$/ ) {
753 warn "The value of the system preference 'timeout' is not correct, defaulting to $default_timeout";
754 $timeout = $default_timeout;
763 # Get shibboleth login attribute
764 my $shib = C4::Context->config('useshibboleth') && shib_ok();
765 my $shib_login = $shib ? get_login_shib() : undef;
767 # $authnotrequired will be set for scripts which will run without authentication
768 my $authnotrequired = shift;
769 my $flagsrequired = shift;
771 my $emailaddress = shift;
772 my $template_name = shift;
773 $type = 'opac' unless $type;
775 if ( $type eq 'opac' && !C4::Context->preference("OpacPublic") ) {
776 my @allowed_scripts_for_private_opac = qw(
778 opac-registration-email-sent.tt
779 opac-registration-confirmation.tt
780 opac-memberentry-update-submitted.tt
781 opac-password-recovery.tt
782 opac-reset-password.tt
784 $authnotrequired = 0 unless grep { $_ eq $template_name }
785 @allowed_scripts_for_private_opac;
788 my $timeout = _timeout_syspref();
790 my $cookie_mgr = Koha::CookieManager->new;
792 _version_check( $type, $query );
796 my $auth_state = 'failed';
798 my ( $userid, $cookie, $sessionID, $flags );
800 my $logout = $query->param('logout.x');
802 my $anon_search_history;
804 # This parameter is the name of the CAS server we want to authenticate against,
805 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
806 my $casparam = $query->param('cas');
807 my $q_userid = $query->param('userid') // '';
810 my $invalid_otp_token;
811 my $require_2FA = ( C4::Context->preference('TwoFactorAuthentication') && $type ne "opac" ) ? 1 : 0;
813 # Basic authentication is incompatible with the use of Shibboleth,
814 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
815 # and it may not be the attribute we want to use to match the koha login.
817 # Also, do not consider an empty REMOTE_USER.
819 # Finally, after those tests, we can assume (although if it would be better with
820 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
821 # and we can affect it to $userid.
822 if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
824 # Using Basic Authentication, no cookies required
825 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
826 -name => 'CGISESSID',
829 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
834 elsif ( $emailaddress) {
835 # the Google OpenID Connect passes an email address
837 elsif ( $sessionID = $query->cookie("CGISESSID") ) { # assignment, not comparison
838 my ( $return, $more_info );
839 # NOTE: $flags in the following call is still undefined !
840 ( $return, $session, $more_info ) = check_cookie_auth( $sessionID, $flags,
841 { remote_addr => $ENV{REMOTE_ADDR}, skip_version_check => 1 }
844 if ( $return eq 'ok' || $return eq 'additional-auth-needed' ) {
845 $userid = $session->param('id');
849 $return eq 'ok' ? 'completed'
850 : $return eq 'additional-auth-needed' ? 'additional-auth-needed'
853 # We are at the second screen if the waiting-for-2FA is set in session
854 # and otp_token param has been passed
856 && $auth_state eq 'additional-auth-needed'
857 && ( my $otp_token = $query->param('otp_token') ) )
859 my $patron = Koha::Patrons->find( { userid => $userid } );
860 my $auth = Koha::Auth::TwoFactorAuth->new( { patron => $patron } );
861 my $verified = $auth->verify($otp_token, 1);
864 # The token is correct, the user is fully logged in!
865 $auth_state = 'completed';
866 $session->param( 'waiting-for-2FA', 0 );
868 # This is an ugly trick to pass the test
869 # $query->param('koha_login_context') && ( $q_userid ne $userid )
874 $invalid_otp_token = 1;
878 if ( $auth_state eq 'completed' ) {
879 Koha::Logger->get->debug(sprintf "AUTH_SESSION: (%s)\t%s %s - %s", map { $session->param($_) || q{} } qw(cardnumber firstname surname branch));
881 if ( ( $query->param('koha_login_context') && ( $q_userid ne $userid ) )
882 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
883 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
886 #if a user enters an id ne to the id in the current session, we need to log them in...
887 #first we need to clear the anonymous session...
888 $anon_search_history = $session->param('search_history');
891 $cookie = $cookie_mgr->clear_unless( $query->cookie, @$cookie );
892 C4::Context::_unset_userenv($sessionID);
896 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
897 -name => 'CGISESSID',
898 -value => $session->id,
900 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
904 $flags = haspermission( $userid, $flagsrequired );
906 $auth_state = 'failed';
907 $info{'nopermission'} = 1;
910 } elsif ( !$logout ) {
911 if ( $return eq 'expired' ) {
912 $info{timed_out} = 1;
913 } elsif ( $return eq 'restricted' ) {
914 $info{oldip} = $more_info->{old_ip};
915 $info{newip} = $more_info->{new_ip};
916 $info{different_ip} = 1;
917 } elsif ( $return eq 'password_expired' ) {
918 $info{password_has_expired} = 1;
923 if ( $auth_state eq 'failed' || $logout ) {
930 # voluntary logout the user
931 # check wether the user was using their shibboleth session or a local one
932 my $shibSuccess = C4::Context->userenv ? C4::Context->userenv->{'shibboleth'} : undef;
937 C4::Context::_unset_userenv($sessionID);
938 $cookie = $cookie_mgr->clear_unless( $query->cookie, @$cookie );
940 if ($cas and $caslogout) {
941 logout_cas($query, $type);
944 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
945 if ( $shib and $shib_login and $shibSuccess) {
950 $auth_state = 'logout';
954 #we initiate a session prior to checking for a username to allow for anonymous sessions...
955 if( !$session or !$sessionID ) { # if we cleared sessionID, we need a new session
956 $session = get_session() or die "Auth ERROR: Cannot get_session()";
959 # Save anonymous search history in new session so it can be retrieved
960 # by get_template_and_user to store it in user's search history after
961 # a successful login.
962 if ($anon_search_history) {
963 $session->param( 'search_history', $anon_search_history );
966 $sessionID = $session->id;
967 C4::Context->_new_userenv($sessionID);
968 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
969 -name => 'CGISESSID',
970 -value => $sessionID,
972 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
975 my $pki_field = C4::Context->preference('AllowPKIAuth');
976 if ( !defined($pki_field) ) {
977 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
980 if ( ( $cas && $query->param('ticket') )
982 || ( $shib && $shib_login )
983 || $pki_field ne 'None'
986 my $password = $query->param('password');
988 my ( $return, $cardnumber );
990 # If shib is enabled and we have a shib login, does the login match a valid koha user
991 if ( $shib && $shib_login ) {
994 # Do not pass password here, else shib will not be checked in checkpw.
995 ( $return, $cardnumber, $retuserid ) = checkpw( $q_userid, undef, $query );
996 $userid = $retuserid;
997 $shibSuccess = $return;
998 $info{'invalidShibLogin'} = 1 unless ($return);
1001 # If shib login and match were successful, skip further login methods
1002 unless ($shibSuccess) {
1003 if ( $cas && $query->param('ticket') ) {
1005 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1006 checkpw( $userid, $password, $query, $type );
1007 $userid = $retuserid;
1008 $info{'invalidCasLogin'} = 1 unless ($return);
1011 elsif ( $emailaddress ) {
1012 my $value = $emailaddress;
1014 # If we're looking up the email, there's a chance that the person
1015 # doesn't have a userid. So if there is none, we pass along the
1016 # borrower number, and the bits of code that need to know the user
1017 # ID will have to be smart enough to handle that.
1018 my $patrons = Koha::Patrons->search({ email => $value });
1019 if ($patrons->count) {
1021 # First the userid, then the borrowernum
1022 my $patron = $patrons->next;
1023 $value = $patron->userid || $patron->borrowernumber;
1027 $return = $value ? 1 : 0;
1032 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1033 || ( $pki_field eq 'emailAddress'
1034 && $ENV{'SSL_CLIENT_S_DN_Email'} )
1038 if ( $pki_field eq 'Common Name' ) {
1039 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1041 elsif ( $pki_field eq 'emailAddress' ) {
1042 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1044 # If we're looking up the email, there's a chance that the person
1045 # doesn't have a userid. So if there is none, we pass along the
1046 # borrower number, and the bits of code that need to know the user
1047 # ID will have to be smart enough to handle that.
1048 my $patrons = Koha::Patrons->search({ email => $value });
1049 if ($patrons->count) {
1051 # First the userid, then the borrowernum
1052 my $patron = $patrons->next;
1053 $value = $patron->userid || $patron->borrowernumber;
1059 $return = $value ? 1 : 0;
1065 my $request_method = $query->request_method();
1068 $request_method eq 'POST'
1069 || ( C4::Context->preference('AutoSelfCheckID')
1070 && $q_userid eq C4::Context->preference('AutoSelfCheckID') )
1074 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1075 checkpw( $q_userid, $password, $query, $type );
1076 $userid = $retuserid if ($retuserid);
1077 $info{'invalid_username_or_password'} = 1 unless ($return);
1082 # If shib configured and shibOnly enabled, we should ignore anything other than a shibboleth type login.
1089 && C4::Context->preference('OPACShibOnly')
1091 || ( ( $type ne 'opac' )
1092 && C4::Context->preference('staffShibOnly') )
1099 # $return: 1 = valid user
1102 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1103 $auth_state = "logged_in";
1106 $info{'nopermission'} = 1;
1107 C4::Context::_unset_userenv($sessionID);
1109 my ( $borrowernumber, $firstname, $surname, $userflags,
1110 $branchcode, $branchname, $emailaddress, $desk_id,
1111 $desk_name, $register_id, $register_name );
1113 if ( $return == 1 ) {
1115 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1116 branches.branchname as branchname, email
1118 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1120 my $dbh = C4::Context->dbh;
1121 my $sth = $dbh->prepare("$select where userid=?");
1122 $sth->execute($userid);
1123 unless ( $sth->rows ) {
1124 $sth = $dbh->prepare("$select where cardnumber=?");
1125 $sth->execute($cardnumber);
1127 unless ( $sth->rows ) {
1128 $sth->execute($userid);
1132 ( $borrowernumber, $firstname, $surname, $userflags,
1133 $branchcode, $branchname, $emailaddress ) = $sth->fetchrow;
1136 # launch a sequence to check if we have a ip for the branch, i
1137 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1139 my $ip = $ENV{'REMOTE_ADDR'};
1141 # if they specify at login, use that
1142 if ( $query->param('branch') ) {
1143 $branchcode = $query->param('branch');
1144 my $library = Koha::Libraries->find($branchcode);
1145 $branchname = $library? $library->branchname: '';
1147 if ( $query->param('desk_id') ) {
1148 $desk_id = $query->param('desk_id');
1149 my $desk = Koha::Desks->find($desk_id);
1150 $desk_name = $desk ? $desk->desk_name : '';
1152 if ( C4::Context->preference('UseCashRegisters') ) {
1154 $query->param('register_id')
1155 ? Koha::Cash::Registers->find($query->param('register_id'))
1156 : Koha::Cash::Registers->search(
1157 { branch => $branchcode, branch_default => 1 },
1158 { rows => 1 } )->single;
1159 $register_id = $register->id if ($register);
1160 $register_name = $register->name if ($register);
1162 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search->as_list };
1163 if ( $type ne 'opac' and C4::Context->preference('AutoLocation') ) {
1165 # we have to check they are coming from the right ip range
1166 my $domain = $branches->{$branchcode}->{'branchip'};
1167 $domain =~ s|\.\*||g;
1168 if ( $ip !~ /^$domain/ ) {
1170 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
1171 -name => 'CGISESSID',
1174 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1177 $info{'wrongip'} = 1;
1181 foreach my $br ( keys %$branches ) {
1183 # now we work with the treatment of ip
1184 my $domain = $branches->{$br}->{'branchip'};
1185 if ( $domain && $ip =~ /^$domain/ ) {
1186 $branchcode = $branches->{$br}->{'branchcode'};
1188 # new op dev : add the branchname to the cookie
1189 $branchname = $branches->{$br}->{'branchname'};
1193 my $is_sco_user = 0;
1194 if ( $query->param('sco_user_login') && ( $query->param('sco_user_login') eq '1' ) ){
1198 $session->param( 'number', $borrowernumber );
1199 $session->param( 'id', $userid );
1200 $session->param( 'cardnumber', $cardnumber );
1201 $session->param( 'firstname', $firstname );
1202 $session->param( 'surname', $surname );
1203 $session->param( 'branch', $branchcode );
1204 $session->param( 'branchname', $branchname );
1205 $session->param( 'desk_id', $desk_id);
1206 $session->param( 'desk_name', $desk_name);
1207 $session->param( 'flags', $userflags );
1208 $session->param( 'emailaddress', $emailaddress );
1209 $session->param( 'ip', $session->remote_addr() );
1210 $session->param( 'lasttime', time() );
1211 $session->param( 'interface', $type);
1212 $session->param( 'shibboleth', $shibSuccess );
1213 $session->param( 'register_id', $register_id );
1214 $session->param( 'register_name', $register_name );
1215 $session->param( 'sco_user', $is_sco_user );
1217 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1218 C4::Context->set_userenv(
1219 $session->param('number'), $session->param('id'),
1220 $session->param('cardnumber'), $session->param('firstname'),
1221 $session->param('surname'), $session->param('branch'),
1222 $session->param('branchname'), $session->param('flags'),
1223 $session->param('emailaddress'), $session->param('shibboleth'),
1224 $session->param('desk_id'), $session->param('desk_name'),
1225 $session->param('register_id'), $session->param('register_name')
1229 # $return: 0 = invalid user
1230 # reset to anonymous session
1233 $info{'invalid_username_or_password'} = 1;
1234 C4::Context::_unset_userenv($sessionID);
1236 $session->param( 'lasttime', time() );
1237 $session->param( 'ip', $session->remote_addr() );
1238 $session->param( 'sessiontype', 'anon' );
1239 $session->param( 'interface', $type);
1241 } # END if ( $q_userid
1242 elsif ( $type eq "opac" ) {
1244 # anonymous sessions are created only for the OPAC
1246 # setting a couple of other session vars...
1247 $session->param( 'ip', $session->remote_addr() );
1248 $session->param( 'lasttime', time() );
1249 $session->param( 'sessiontype', 'anon' );
1250 $session->param( 'interface', $type);
1253 } # END unless ($userid)
1256 if ( $auth_state eq 'logged_in' ) {
1257 $auth_state = 'completed';
1259 # Auth is completed unless an additional auth is needed
1260 if ( $require_2FA ) {
1261 my $patron = Koha::Patrons->find({userid => $userid});
1262 if ( $patron->auth_method eq 'two-factor' ) {
1263 # Ask for the OTP token
1264 $auth_state = 'additional-auth-needed';
1265 $session->param('waiting-for-2FA', 1);
1266 %info = ();# We remove the warnings/errors we may have set incorrectly before
1271 # finished authentification, now respond
1272 if ( $auth_state eq 'completed' || $authnotrequired ) {
1275 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
1276 -name => 'CGISESSID',
1279 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1284 track_login_daily( $userid );
1286 # In case, that this request was a login attempt, we want to prevent that users can repost the opac login
1287 # request. We therefore redirect the user to the requested page again without the login parameters.
1288 # See Post/Redirect/Get (PRG) design pattern: https://en.wikipedia.org/wiki/Post/Redirect/Get
1289 if ( $type eq "opac" && $query->param('koha_login_context') && $query->param('koha_login_context') ne 'sco' && $query->param('password') && $query->param('userid') ) {
1290 my $uri = URI->new($query->url(-relative=>1, -query_string=>1));
1291 $uri->query_param_delete('userid');
1292 $uri->query_param_delete('password');
1293 $uri->query_param_delete('koha_login_context');
1294 print $query->redirect(-uri => $uri->as_string, -cookie => $cookie, -status=>'303 See other');
1298 return ( $userid, $cookie, $sessionID, $flags );
1303 # AUTH rejected, show the login/password template, after checking the DB.
1307 my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1309 # get the inputs from the incoming query
1311 my @inputs_to_clean = qw( userid password ticket logout.x otp_token );
1312 foreach my $name ( param $query) {
1313 next if grep { $name eq $_ } @inputs_to_clean;
1314 my @value = $query->multi_param($name);
1315 push @inputs, { name => $name, value => $_ } for @value;
1318 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1319 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1320 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1322 my $auth_template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1323 my $template = C4::Templates::gettemplate( $auth_template_name, $type, $query );
1327 script_name => get_script_name(),
1328 casAuthentication => C4::Context->preference("casAuthentication"),
1329 shibbolethAuthentication => $shib,
1330 suggestion => C4::Context->preference("suggestion"),
1331 virtualshelves => C4::Context->preference("virtualshelves"),
1332 LibraryName => "" . C4::Context->preference("LibraryName"),
1333 LibraryNameTitle => "" . $LibraryNameTitle,
1334 opacuserlogin => C4::Context->preference("opacuserlogin"),
1335 OpacFavicon => C4::Context->preference("OpacFavicon"),
1336 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1337 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1338 OPACUserJS => C4::Context->preference("OPACUserJS"),
1339 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1340 OpacCloud => C4::Context->preference("OpacCloud"),
1341 OpacTopissue => C4::Context->preference("OpacTopissue"),
1342 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1343 OpacBrowser => C4::Context->preference("OpacBrowser"),
1344 TagsEnabled => C4::Context->preference("TagsEnabled"),
1345 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1346 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1347 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1348 IntranetNav => C4::Context->preference("IntranetNav"),
1349 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1350 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
1351 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1352 IndependentBranches => C4::Context->preference("IndependentBranches"),
1353 AutoLocation => C4::Context->preference("AutoLocation"),
1354 wrongip => $info{'wrongip'},
1355 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1356 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1357 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1358 too_many_login_attempts => ( $patron and $patron->account_locked ),
1359 password_has_expired => ( $patron and $patron->password_expired ),
1362 $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1363 $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1364 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1365 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1366 if ( $auth_state eq 'additional-auth-needed' ) {
1367 my $patron = Koha::Patrons->find( { userid => $userid } );
1370 invalid_otp_token => $invalid_otp_token,
1371 notice_email_address => $patron->notice_email_address, # We could also pass logged_in_user if necessary
1375 if ( $type eq 'opac' ) {
1376 require Koha::Virtualshelves;
1377 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1383 some_public_shelves => $some_public_shelves,
1389 # Is authentication against multiple CAS servers enabled?
1390 require C4::Auth_with_cas;
1391 if ( multipleAuth() && !$casparam ) {
1392 my $casservers = getMultipleAuth();
1394 foreach my $key ( keys %$casservers ) {
1395 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1398 casServersLoop => \@tmplservers
1402 casServerUrl => login_cas_url($query, undef, $type),
1407 invalidCasLogin => $info{'invalidCasLogin'}
1412 #If shibOnly is enabled just go ahead and redirect directly
1413 if ( (($type eq 'opac') && C4::Context->preference('OPACShibOnly')) || (($type ne 'opac') && C4::Context->preference('staffShibOnly')) ) {
1414 my $redirect_url = login_shib_url( $query );
1415 print $query->redirect( -uri => "$redirect_url", -status => 303 );
1420 shibbolethAuthentication => $shib,
1421 shibbolethLoginUrl => login_shib_url($query),
1425 if (C4::Context->preference('GoogleOpenIDConnect')) {
1426 if ($query->param("OpenIDConnectFailed")) {
1427 my $reason = $query->param('OpenIDConnectFailed');
1428 $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1433 LibraryName => C4::Context->preference("LibraryName"),
1435 $template->param(%info);
1437 # $cookie = $query->cookie(CGISESSID => $session->id
1439 print $query->header(
1440 { type => 'text/html',
1443 'X-Frame-Options' => 'SAMEORIGIN',
1451 =head2 check_api_auth
1453 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1455 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1456 cookie, determine if the user has the privileges specified by C<$userflags>.
1458 C<check_api_auth> is is meant for authenticating users of web services, and
1459 consequently will always return and will not attempt to redirect the user
1462 If a valid session cookie is already present, check_api_auth will return a status
1463 of "ok", the cookie, and the Koha session ID.
1465 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1466 parameters and create a session cookie and Koha session if the supplied credentials
1469 Possible return values in C<$status> are:
1473 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1475 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1477 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1479 =item "expired -- session cookie has expired; API user should resubmit userid and password
1481 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1483 =item "additional-auth-needed -- User is in an authentication process that is not finished
1489 sub check_api_auth {
1492 my $flagsrequired = shift;
1493 my $timeout = _timeout_syspref();
1495 unless ( C4::Context->preference('Version') ) {
1497 # database has not been installed yet
1498 return ( "maintenance", undef, undef );
1500 my $kohaversion = Koha::version();
1501 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1502 if ( C4::Context->preference('Version') < $kohaversion ) {
1504 # database in need of version update; assume that
1505 # no API should be called while databsae is in
1507 return ( "maintenance", undef, undef );
1510 my ( $sessionID, $session );
1511 unless ( $query->param('userid') ) {
1512 $sessionID = $query->cookie("CGISESSID");
1514 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1517 ( $return, $session, undef ) = check_cookie_auth(
1518 $sessionID, $flagsrequired, { remote_addr => $ENV{REMOTE_ADDR} } );
1520 return ( $return, undef, undef ) # Cookie auth failed
1523 my $cookie = $query->cookie(
1524 -name => 'CGISESSID',
1525 -value => $session->id,
1527 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1530 return ( $return, $cookie, $session ); # return == 'ok' here
1535 my $userid = $query->param('userid');
1536 my $password = $query->param('password');
1537 my ( $return, $cardnumber, $cas_ticket );
1540 if ( $cas && $query->param('PT') ) {
1543 # In case of a CAS authentication, we use the ticket instead of the password
1544 my $PT = $query->param('PT');
1545 ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $PT, $query ); # EXTERNAL AUTH
1548 # User / password auth
1549 unless ( $userid and $password ) {
1551 # caller did something wrong, fail the authenticateion
1552 return ( "failed", undef, undef );
1555 ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $userid, $password, $query );
1558 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1559 my $session = get_session("");
1560 return ( "failed", undef, undef ) unless $session;
1562 my $sessionID = $session->id;
1563 C4::Context->_new_userenv($sessionID);
1564 my $cookie = $query->cookie(
1565 -name => 'CGISESSID',
1566 -value => $sessionID,
1568 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1571 if ( $return == 1 ) {
1573 $borrowernumber, $firstname, $surname,
1574 $userflags, $branchcode, $branchname,
1577 my $dbh = C4::Context->dbh;
1580 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1582 $sth->execute($userid);
1584 $borrowernumber, $firstname, $surname,
1585 $userflags, $branchcode, $branchname,
1587 ) = $sth->fetchrow if ( $sth->rows );
1589 unless ( $sth->rows ) {
1590 my $sth = $dbh->prepare(
1591 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1593 $sth->execute($cardnumber);
1595 $borrowernumber, $firstname, $surname,
1596 $userflags, $branchcode, $branchname,
1598 ) = $sth->fetchrow if ( $sth->rows );
1600 unless ( $sth->rows ) {
1601 $sth->execute($userid);
1603 $borrowernumber, $firstname, $surname, $userflags,
1604 $branchcode, $branchname, $emailaddress
1605 ) = $sth->fetchrow if ( $sth->rows );
1609 my $ip = $ENV{'REMOTE_ADDR'};
1611 # if they specify at login, use that
1612 if ( $query->param('branch') ) {
1613 $branchcode = $query->param('branch');
1614 my $library = Koha::Libraries->find($branchcode);
1615 $branchname = $library? $library->branchname: '';
1617 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search->as_list };
1618 foreach my $br ( keys %$branches ) {
1620 # now we work with the treatment of ip
1621 my $domain = $branches->{$br}->{'branchip'};
1622 if ( $domain && $ip =~ /^$domain/ ) {
1623 $branchcode = $branches->{$br}->{'branchcode'};
1625 # new op dev : add the branchname to the cookie
1626 $branchname = $branches->{$br}->{'branchname'};
1629 $session->param( 'number', $borrowernumber );
1630 $session->param( 'id', $userid );
1631 $session->param( 'cardnumber', $cardnumber );
1632 $session->param( 'firstname', $firstname );
1633 $session->param( 'surname', $surname );
1634 $session->param( 'branch', $branchcode );
1635 $session->param( 'branchname', $branchname );
1636 $session->param( 'flags', $userflags );
1637 $session->param( 'emailaddress', $emailaddress );
1638 $session->param( 'ip', $session->remote_addr() );
1639 $session->param( 'lasttime', time() );
1640 $session->param( 'interface', 'api' );
1642 $session->param( 'cas_ticket', $cas_ticket);
1643 C4::Context->set_userenv(
1644 $session->param('number'), $session->param('id'),
1645 $session->param('cardnumber'), $session->param('firstname'),
1646 $session->param('surname'), $session->param('branch'),
1647 $session->param('branchname'), $session->param('flags'),
1648 $session->param('emailaddress'), $session->param('shibboleth'),
1649 $session->param('desk_id'), $session->param('desk_name'),
1650 $session->param('register_id'), $session->param('register_name')
1652 return ( "ok", $cookie, $sessionID );
1654 return ( "failed", undef, undef );
1659 =head2 check_cookie_auth
1661 ($status, $sessionId) = check_cookie_auth($cookie, $userflags);
1663 Given a CGISESSID cookie set during a previous login to Koha, determine
1664 if the user has the privileges specified by C<$userflags>. C<$userflags>
1665 is passed unaltered into C<haspermission> and as such accepts all options
1666 avaiable to that routine with the one caveat that C<check_api_auth> will
1667 also allow 'undef' to be passed and in such a case the permissions check
1668 will be skipped altogether.
1670 C<check_cookie_auth> is meant for authenticating special services
1671 such as tools/upload-file.pl that are invoked by other pages that
1672 have been authenticated in the usual way.
1674 Possible return values in C<$status> are:
1678 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1680 =item "anon" -- user not authenticated but valid for anonymous session.
1682 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1684 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1686 =item "expired -- session cookie has expired; API user should resubmit userid and password
1688 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1694 sub check_cookie_auth {
1695 my $sessionID = shift;
1696 my $flagsrequired = shift;
1699 my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1701 my $skip_version_check = $params->{skip_version_check}; # Only for checkauth
1703 unless ( $skip_version_check ) {
1704 unless ( C4::Context->preference('Version') ) {
1706 # database has not been installed yet
1707 return ( "maintenance", undef );
1709 my $kohaversion = Koha::version();
1710 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1711 if ( C4::Context->preference('Version') < $kohaversion ) {
1713 # database in need of version update; assume that
1714 # no API should be called while databsae is in
1716 return ( "maintenance", undef );
1720 # see if we have a valid session cookie already
1721 # however, if a userid parameter is present (i.e., from
1722 # a form submission, assume that any current cookie
1724 unless ( $sessionID ) {
1725 return ( "failed", undef );
1727 C4::Context::_unset_userenv($sessionID); # remove old userenv first
1728 my $session = get_session($sessionID);
1730 my $userid = $session->param('id');
1731 my $ip = $session->param('ip');
1732 my $lasttime = $session->param('lasttime');
1733 my $timeout = _timeout_syspref();
1735 if ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
1739 return ("expired", undef);
1741 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1742 # IP address changed
1745 return ( "restricted", undef, { old_ip => $ip, new_ip => $remote_addr});
1747 } elsif ( $userid ) {
1748 $session->param( 'lasttime', time() );
1749 my $patron = Koha::Patrons->find({ userid => $userid });
1750 $patron = Koha::Patron->find({ cardnumber => $userid }) unless $patron;
1751 return ("password_expired", undef ) if $patron->password_expired;
1752 my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1754 C4::Context->_new_userenv($sessionID);
1755 C4::Context->interface($session->param('interface'));
1756 C4::Context->set_userenv(
1757 $session->param('number'), $session->param('id') // '',
1758 $session->param('cardnumber'), $session->param('firstname'),
1759 $session->param('surname'), $session->param('branch'),
1760 $session->param('branchname'), $session->param('flags'),
1761 $session->param('emailaddress'), $session->param('shibboleth'),
1762 $session->param('desk_id'), $session->param('desk_name'),
1763 $session->param('register_id'), $session->param('register_name')
1765 return ( "additional-auth-needed", $session )
1766 if $session->param('waiting-for-2FA');
1768 return ( "ok", $session );
1772 return ( "failed", undef );
1776 C4::Context->_new_userenv($sessionID);
1777 C4::Context->interface($session->param('interface'));
1778 C4::Context->set_userenv( undef, q{} );
1779 return ( "anon", $session );
1782 return ( "expired", undef );
1789 my $session = get_session($sessionID);
1791 Given a session ID, retrieve the CGI::Session object used to store
1792 the session's state. The session object can be used to store
1793 data that needs to be accessed by different scripts during a
1796 If the C<$sessionID> parameter is an empty string, a new session
1801 sub _get_session_params {
1802 my $storage_method = C4::Context->preference('SessionStorage');
1803 if ( $storage_method eq 'mysql' ) {
1804 my $dbh = C4::Context->dbh;
1805 return { dsn => "serializer:yamlxs;driver:MySQL;id:md5", dsn_args => { Handle => $dbh } };
1807 elsif ( $storage_method eq 'Pg' ) {
1808 my $dbh = C4::Context->dbh;
1809 return { dsn => "serializer:yamlxs;driver:PostgreSQL;id:md5", dsn_args => { Handle => $dbh } };
1811 elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1812 my $memcached = Koha::Caches->get_instance()->memcached_cache;
1813 return { dsn => "serializer:yamlxs;driver:memcached;id:md5", dsn_args => { Memcached => $memcached } };
1816 # catch all defaults to tmp should work on all systems
1817 my $dir = C4::Context::temporary_directory;
1818 my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1819 return { dsn => "serializer:yamlxs;driver:File;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1824 my $sessionID = shift;
1825 my $params = _get_session_params();
1827 if( $sessionID ) { # find existing
1828 CGI::Session::ErrorHandler->set_error( q{} ); # clear error, cpan issue #111463
1829 $session = CGI::Session->load( $params->{dsn}, $sessionID, $params->{dsn_args} );
1831 $session = CGI::Session->new( $params->{dsn}, $sessionID, $params->{dsn_args} );
1832 # no need to flush here
1838 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1839 # (or something similar)
1840 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1841 # not having a userenv defined could cause a crash.
1843 my ( $userid, $password, $query, $type, $no_set_userenv ) = @_;
1844 $type = 'opac' unless $type;
1846 # Get shibboleth login attribute
1847 my $shib = C4::Context->config('useshibboleth') && shib_ok();
1848 my $shib_login = $shib ? get_login_shib() : undef;
1852 if ( defined $userid ){
1853 $patron = Koha::Patrons->find({ userid => $userid });
1854 $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1856 my $check_internal_as_fallback = 0;
1858 # Note: checkpw_* routines returns:
1861 # -1 if user bind failed (LDAP only)
1863 if ( $patron and ( $patron->account_locked ) ) {
1864 # Nothing to check, account is locked
1865 } elsif ($ldap && defined($password)) {
1866 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
1867 if ( $retval == 1 ) {
1868 @return = ( $retval, $retcard, $retuserid );
1871 $check_internal_as_fallback = 1 if $retval == 0;
1873 } elsif ( $cas && $query && $query->param('ticket') ) {
1875 # In case of a CAS authentication, we use the ticket instead of the password
1876 my $ticket = $query->param('ticket');
1877 $query->delete('ticket'); # remove ticket to come back to original URL
1878 my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $ticket, $query, $type ); # EXTERNAL AUTH
1880 @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1884 $passwd_ok = $retval;
1887 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1888 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1890 elsif ( $shib && $shib_login && !$password ) {
1892 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1893 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1894 # shibboleth-authenticated user
1896 # Then, we check if it matches a valid koha user
1898 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
1900 @return = ( $retval, $retcard, $retuserid );
1902 $passwd_ok = $retval;
1905 $check_internal_as_fallback = 1;
1909 if ( $check_internal_as_fallback ) {
1910 @return = checkpw_internal( $userid, $password, $no_set_userenv);
1911 $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1916 $patron->update({ login_attempts => 0 });
1917 if( $patron->password_expired ){
1920 } elsif( !$patron->account_locked ) {
1921 $patron->update({ login_attempts => $patron->login_attempts + 1 });
1925 # Optionally log success or failure
1926 if( $patron && $passwd_ok && C4::Context->preference('AuthSuccessLog') ) {
1927 logaction( 'AUTH', 'SUCCESS', $patron->id, "Valid password for $userid", $type );
1928 } elsif( !$passwd_ok && C4::Context->preference('AuthFailureLog') ) {
1929 logaction( 'AUTH', 'FAILURE', $patron ? $patron->id : 0, "Wrong password for $userid", $type );
1935 sub checkpw_internal {
1936 my ( $userid, $password, $no_set_userenv ) = @_;
1938 $password = Encode::encode( 'UTF-8', $password )
1939 if Encode::is_utf8($password);
1941 my $dbh = C4::Context->dbh;
1944 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1946 $sth->execute($userid);
1948 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1949 $surname, $branchcode, $branchname, $flags )
1952 if ( checkpw_hash( $password, $stored_hash ) ) {
1954 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1955 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1956 return 1, $cardnumber, $userid;
1961 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1963 $sth->execute($userid);
1965 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1966 $surname, $branchcode, $branchname, $flags )
1969 if ( checkpw_hash( $password, $stored_hash ) ) {
1971 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1972 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1973 return 1, $cardnumber, $userid;
1980 my ( $password, $stored_hash ) = @_;
1982 return if $stored_hash eq '!';
1984 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1986 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1987 $hash = hash_password( $password, $stored_hash );
1989 $hash = md5_base64($password);
1991 return $hash eq $stored_hash;
1996 my $authflags = getuserflags($flags, $userid, [$dbh]);
1998 Translates integer flags into permissions strings hash.
2000 C<$flags> is the integer userflags value ( borrowers.userflags )
2001 C<$userid> is the members.userid, used for building subpermissions
2002 C<$authflags> is a hashref of permissions
2009 my $dbh = @_ ? shift : C4::Context->dbh;
2012 # I don't want to do this, but if someone logs in as the database
2013 # user, it would be preferable not to spam them to death with
2014 # numeric warnings. So, we make $flags numeric.
2015 no warnings 'numeric';
2018 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
2021 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
2022 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
2023 $userflags->{$flag} = 1;
2026 $userflags->{$flag} = 0;
2030 # get subpermissions and merge with top-level permissions
2031 my $user_subperms = get_user_subpermissions($userid);
2032 foreach my $module ( keys %$user_subperms ) {
2033 next if $userflags->{$module} == 1; # user already has permission for everything in this module
2034 $userflags->{$module} = $user_subperms->{$module};
2040 =head2 get_user_subpermissions
2042 $user_perm_hashref = get_user_subpermissions($userid);
2044 Given the userid (note, not the borrowernumber) of a staff user,
2045 return a hashref of hashrefs of the specific subpermissions
2046 accorded to the user. An example return is
2050 export_catalog => 1,
2051 import_patrons => 1,
2055 The top-level hash-key is a module or function code from
2056 userflags.flag, while the second-level key is a code
2059 The results of this function do not give a complete picture
2060 of the functions that a staff user can access; it is also
2061 necessary to check borrowers.flags.
2065 sub get_user_subpermissions {
2068 my $dbh = C4::Context->dbh;
2069 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2070 FROM user_permissions
2071 JOIN permissions USING (module_bit, code)
2072 JOIN userflags ON (module_bit = bit)
2073 JOIN borrowers USING (borrowernumber)
2074 WHERE userid = ?" );
2075 $sth->execute($userid);
2077 my $user_perms = {};
2078 while ( my $perm = $sth->fetchrow_hashref ) {
2079 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2084 =head2 get_all_subpermissions
2086 my $perm_hashref = get_all_subpermissions();
2088 Returns a hashref of hashrefs defining all specific
2089 permissions currently defined. The return value
2090 has the same structure as that of C<get_user_subpermissions>,
2091 except that the innermost hash value is the description
2092 of the subpermission.
2096 sub get_all_subpermissions {
2097 my $dbh = C4::Context->dbh;
2098 my $sth = $dbh->prepare( "SELECT flag, code
2100 JOIN userflags ON (module_bit = bit)" );
2104 while ( my $perm = $sth->fetchrow_hashref ) {
2105 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2110 =head2 haspermission
2112 $flagsrequired = '*'; # Any permission at all
2113 $flagsrequired = 'a_flag'; # a_flag must be satisfied (all subpermissions)
2114 $flagsrequired = [ 'a_flag', 'b_flag' ]; # a_flag OR b_flag must be satisfied
2115 $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 }; # a_flag AND b_flag must be satisfied
2116 $flagsrequired = { 'a_flag' => 'sub_a' }; # sub_a of a_flag must be satisfied
2117 $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2119 $flags = ($userid, $flagsrequired);
2121 C<$userid> the userid of the member
2122 C<$flags> is a query structure similar to that used by SQL::Abstract that
2123 denotes the combination of flags required. It is a required parameter.
2125 The main logic of this method is that things in arrays are OR'ed, and things
2126 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2128 Returns member's flags or 0 if a permission is not met.
2133 my ($required, $flags) = @_;
2135 my $ref = ref($required);
2137 if ($required eq '*') {
2138 return 0 unless ( $flags or ref( $flags ) );
2140 return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2142 } elsif ($ref eq 'HASH') {
2143 foreach my $key (keys %{$required}) {
2144 next if $flags == 1;
2145 my $require = $required->{$key};
2146 my $rflags = $flags->{$key};
2147 return 0 unless _dispatch($require, $rflags);
2149 } elsif ($ref eq 'ARRAY') {
2151 foreach my $require ( @{$required} ) {
2153 ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2154 ? $flags->{$require}
2156 $satisfied++ if _dispatch( $require, $rflags );
2158 return 0 unless $satisfied;
2160 croak "Unexpected structure found: $ref";
2167 my ( $userid, $flagsrequired ) = @_;
2169 #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2170 # unless defined($flagsrequired);
2172 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2173 $sth->execute($userid);
2174 my $row = $sth->fetchrow();
2175 my $flags = getuserflags( $row, $userid );
2177 return $flags unless defined($flagsrequired);
2178 return $flags if $flags->{superlibrarian};
2179 return _dispatch($flagsrequired, $flags);
2181 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2186 $flags = ($iprange);
2188 C<$iprange> A space separated string describing an IP range. Can include single IPs or ranges
2190 Returns 1 if the remote address is in the provided iprange, or 0 otherwise.
2197 my @allowedipranges = $iprange ? split(' ', $iprange) : ();
2198 if (scalar @allowedipranges > 0) {
2200 eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2201 eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || Koha::Logger->get->warn('cidrlookup failed for ' . join(' ',@rangelist) );
2203 return $result ? 1 : 0;
2206 sub getborrowernumber {
2208 my $userenv = C4::Context->userenv;
2209 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2210 return $userenv->{number};
2212 my $dbh = C4::Context->dbh;
2213 for my $field ( 'userid', 'cardnumber' ) {
2215 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2216 $sth->execute($userid);
2218 my ($bnumber) = $sth->fetchrow;
2225 =head2 track_login_daily
2227 track_login_daily( $userid );
2229 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2233 sub track_login_daily {
2235 return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2237 my $cache = Koha::Caches->get_instance();
2238 my $cache_key = "track_login_" . $userid;
2239 my $cached = $cache->get_from_cache($cache_key);
2240 my $today = dt_from_string()->ymd;
2241 return if $cached && $cached eq $today;
2243 my $patron = Koha::Patrons->find({ userid => $userid });
2244 return unless $patron;
2245 $patron->track_login;
2246 $cache->set_in_cache( $cache_key, $today );
2249 END { } # module clean-up code here (global destructor)
2259 Crypt::Eksblowfish::Bcrypt(3)