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 # Decide if the patron can make suggestions in the OPAC
451 my $can_make_suggestions;
452 if ( C4::Context->userenv && C4::Context->userenv->{'number'} ) {
453 $can_make_suggestions = Koha::Patrons->find(C4::Context->userenv->{'number'})->category->can_make_suggestions;
456 my $minPasswordLength = C4::Context->preference('minPasswordLength');
457 $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
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 LoginFirstname => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
464 LoginSurname => C4::Context->userenv ? C4::Context->userenv->{"surname"} : "Inconnu",
465 emailaddress => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
466 TagsEnabled => C4::Context->preference("TagsEnabled"),
467 hide_marc => C4::Context->preference("hide_marc"),
468 item_level_itypes => C4::Context->preference('item-level_itypes'),
469 patronimages => C4::Context->preference("patronimages"),
470 singleBranchMode => ( Koha::Libraries->search->count == 1 ),
471 noItemTypeImages => C4::Context->preference("noItemTypeImages"),
472 marcflavour => C4::Context->preference("marcflavour"),
473 OPACBaseURL => C4::Context->preference('OPACBaseURL'),
474 minPasswordLength => $minPasswordLength,
476 if ( $in->{'type'} eq "intranet" ) {
478 AmazonCoverImages => C4::Context->preference("AmazonCoverImages"),
479 AutoLocation => C4::Context->preference("AutoLocation"),
480 PatronAutoComplete => C4::Context->preference("PatronAutoComplete"),
481 FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
482 IndependentBranches => C4::Context->preference("IndependentBranches"),
483 IntranetNav => C4::Context->preference("IntranetNav"),
484 IntranetmainUserblock => C4::Context->preference("IntranetmainUserblock"),
485 LibraryName => C4::Context->preference("LibraryName"),
486 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
487 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
488 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
489 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
490 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
491 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
492 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
493 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
494 suggestion => $can_make_suggestions,
495 virtualshelves => C4::Context->preference("virtualshelves"),
496 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
497 EasyAnalyticalRecords => C4::Context->preference('EasyAnalyticalRecords'),
498 LocalCoverImages => C4::Context->preference('LocalCoverImages'),
499 OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'),
500 AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'),
501 EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'),
502 UseCourseReserves => C4::Context->preference("UseCourseReserves"),
503 useDischarge => C4::Context->preference('useDischarge'),
504 pending_checkout_notes => Koha::Checkouts->search({ noteseen => 0 }),
505 plugins_enabled => C4::Context->config("enable_plugins"),
509 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
511 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
512 my $LibraryNameTitle = C4::Context->preference("LibraryName");
513 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
514 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
516 # clean up the busc param in the session
517 # if the page is not opac-detail and not the "add to list" page
518 # and not the "edit comments" page
519 if ( C4::Context->preference("OpacBrowseResults")
520 && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
522 unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
523 or $pagename =~ /^showmarc$/
524 or $pagename =~ /^addbybiblionumber$/
525 or $pagename =~ /^review$/ )
527 my $sessionSearch = get_session( $sessionID );
528 $sessionSearch->clear( ["busc"] ) if $sessionSearch;
532 # variables passed from CGI: opac_css_override and opac_search_limits.
533 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
534 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
537 ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:([\w-]+)/ ) ||
538 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:([\w-]+)/ ) ||
539 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /multibranchlimit:(\w+)/ )
541 $opac_name = $1; # opac_search_limit is a branch, so we use it.
542 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
543 $opac_name = $in->{'query'}->param('multibranchlimit');
544 } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
545 $opac_name = C4::Context->userenv->{'branch'};
548 my @search_groups = Koha::Library::Groups->get_search_groups({ interface => 'opac' })->as_list;
550 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
551 LibrarySearchGroups => \@search_groups,
552 opac_name => $opac_name,
553 LibraryName => "" . C4::Context->preference("LibraryName"),
554 LibraryNameTitle => "" . $LibraryNameTitle,
555 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
556 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
557 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
558 OPACShelfBrowser => "" . C4::Context->preference("OPACShelfBrowser"),
559 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
560 OPACUserCSS => "" . C4::Context->preference("OPACUserCSS"),
561 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
562 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
563 opac_search_limit => $opac_search_limit,
564 opac_limit_override => $opac_limit_override,
565 OpacBrowser => C4::Context->preference("OpacBrowser"),
566 OpacCloud => C4::Context->preference("OpacCloud"),
567 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
568 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
569 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
570 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
571 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
572 OpacTopissue => C4::Context->preference("OpacTopissue"),
573 'Version' => C4::Context->preference('Version'),
574 hidelostitems => C4::Context->preference("hidelostitems"),
575 mylibraryfirst => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
576 opacbookbag => "" . C4::Context->preference("opacbookbag"),
577 OpacFavicon => C4::Context->preference("OpacFavicon"),
578 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
579 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
580 OPACUserJS => C4::Context->preference("OPACUserJS"),
581 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
582 OpenLibrarySearch => C4::Context->preference("OpenLibrarySearch"),
583 ShowReviewer => C4::Context->preference("ShowReviewer"),
584 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
585 suggestion => $can_make_suggestions,
586 virtualshelves => "" . C4::Context->preference("virtualshelves"),
587 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
588 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
589 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
590 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
591 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
592 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
593 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
594 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
595 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
596 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
597 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
598 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
599 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
600 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
601 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
602 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
603 useDischarge => C4::Context->preference('useDischarge'),
606 $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
609 # Check if we were asked using parameters to force a specific language
610 if ( defined $in->{'query'}->param('language') ) {
612 # Extract the language, let C4::Languages::getlanguage choose
614 my $language = C4::Languages::getlanguage( $in->{'query'} );
615 my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
616 $cookie = $cookie_mgr->replace_in_list( $cookie, $languagecookie );
619 return ( $template, $borrowernumber, $cookie, $flags );
624 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
626 Verifies that the user is authorized to run this script. If
627 the user is authorized, a (userid, cookie, session-id, flags)
628 quadruple is returned. If the user is not authorized but does
629 not have the required privilege (see $flagsrequired below), it
630 displays an error page and exits. Otherwise, it displays the
631 login page and exits.
633 Note that C<&checkauth> will return if and only if the user
634 is authorized, so it should be called early on, before any
635 unfinished operations (e.g., if you've opened a file, then
636 C<&checkauth> won't close it for you).
638 C<$query> is the CGI object for the script calling C<&checkauth>.
640 The C<$noauth> argument is optional. If it is set, then no
641 authorization is required for the script.
643 C<&checkauth> fetches user and session information from C<$query> and
644 ensures that the user is authorized to run scripts that require
647 The C<$flagsrequired> argument specifies the required privileges
648 the user must have if the username and password are correct.
649 It should be specified as a reference-to-hash; keys in the hash
650 should be the "flags" for the user, as specified in the Members
651 intranet module. Any key specified must correspond to a "flag"
652 in the userflags table. E.g., { circulate => 1 } would specify
653 that the user must have the "circulate" privilege in order to
654 proceed. To make sure that access control is correct, the
655 C<$flagsrequired> parameter must be specified correctly.
657 Koha also has a concept of sub-permissions, also known as
658 granular permissions. This makes the value of each key
659 in the C<flagsrequired> hash take on an additional
664 The user must have access to all subfunctions of the module
665 specified by the hash key.
669 The user must have access to at least one subfunction of the module
670 specified by the hash key.
672 specific permission, e.g., 'export_catalog'
674 The user must have access to the specific subfunction list, which
675 must correspond to a row in the permissions table.
677 The C<$type> argument specifies whether the template should be
678 retrieved from the opac or intranet directory tree. "opac" is
679 assumed if it is not specified; however, if C<$type> is specified,
680 "intranet" is assumed if it is not "opac".
682 If C<$query> does not have a valid session ID associated with it
683 (i.e., the user has not logged in) or if the session has expired,
684 C<&checkauth> presents the user with a login page (from the point of
685 view of the original script, C<&checkauth> does not return). Once the
686 user has authenticated, C<&checkauth> restarts the original script
687 (this time, C<&checkauth> returns).
689 The login page is provided using a HTML::Template, which is set in the
690 systempreferences table or at the top of this file. The variable C<$type>
691 selects which template to use, either the opac or the intranet
692 authentification template.
694 C<&checkauth> returns a user ID, a cookie, and a session ID. The
695 cookie should be sent back to the browser; it verifies that the user
705 # If version syspref is unavailable, it means Koha is being installed,
706 # and so we must redirect to OPAC maintenance page or to the WebInstaller
707 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
708 if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
709 warn "OPAC Install required, redirecting to maintenance";
710 print $query->redirect("/cgi-bin/koha/maintenance.pl");
713 unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
714 if ( $type ne 'opac' ) {
715 warn "Install required, redirecting to Installer";
716 print $query->redirect("/cgi-bin/koha/installer/install.pl");
718 warn "OPAC Install required, redirecting to maintenance";
719 print $query->redirect("/cgi-bin/koha/maintenance.pl");
724 # check that database and koha version are the same
725 # there is no DB version, it's a fresh install,
726 # go to web installer
727 # there is a DB version, compare it to the code version
728 my $kohaversion = Koha::version();
730 # remove the 3 last . to have a Perl number
731 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
732 Koha::Logger->get->debug("kohaversion : $kohaversion");
733 if ( $version < $kohaversion ) {
734 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
735 if ( $type ne 'opac' ) {
736 warn sprintf( $warning, 'Installer' );
737 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
739 warn sprintf( "OPAC: " . $warning, 'maintenance' );
740 print $query->redirect("/cgi-bin/koha/maintenance.pl");
746 sub _timeout_syspref {
747 my $default_timeout = 600;
748 my $timeout = C4::Context->preference('timeout') || $default_timeout;
750 # value in days, convert in seconds
751 if ( $timeout =~ /^(\d+)[dD]$/ ) {
752 $timeout = $1 * 86400;
754 # value in hours, convert in seconds
755 elsif ( $timeout =~ /^(\d+)[hH]$/ ) {
756 $timeout = $1 * 3600;
758 elsif ( $timeout !~ m/^\d+$/ ) {
759 warn "The value of the system preference 'timeout' is not correct, defaulting to $default_timeout";
760 $timeout = $default_timeout;
769 # Get shibboleth login attribute
770 my $shib = C4::Context->config('useshibboleth') && shib_ok();
771 my $shib_login = $shib ? get_login_shib() : undef;
773 # $authnotrequired will be set for scripts which will run without authentication
774 my $authnotrequired = shift;
775 my $flagsrequired = shift;
777 my $emailaddress = shift;
778 my $template_name = shift;
779 $type = 'opac' unless $type;
781 if ( $type eq 'opac' && !C4::Context->preference("OpacPublic") ) {
782 my @allowed_scripts_for_private_opac = qw(
784 opac-registration-email-sent.tt
785 opac-registration-confirmation.tt
786 opac-memberentry-update-submitted.tt
787 opac-password-recovery.tt
788 opac-reset-password.tt
790 $authnotrequired = 0 unless grep { $_ eq $template_name }
791 @allowed_scripts_for_private_opac;
794 my $timeout = _timeout_syspref();
796 my $cookie_mgr = Koha::CookieManager->new;
798 _version_check( $type, $query );
802 my $auth_state = 'failed';
804 my ( $userid, $cookie, $sessionID, $flags );
806 my $logout = $query->param('logout.x');
808 my $anon_search_history;
810 # This parameter is the name of the CAS server we want to authenticate against,
811 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
812 my $casparam = $query->param('cas');
813 my $q_userid = $query->param('userid') // '';
816 my $invalid_otp_token;
817 my $require_2FA = ( C4::Context->preference('TwoFactorAuthentication') && $type ne "opac" ) ? 1 : 0;
819 # Basic authentication is incompatible with the use of Shibboleth,
820 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
821 # and it may not be the attribute we want to use to match the koha login.
823 # Also, do not consider an empty REMOTE_USER.
825 # Finally, after those tests, we can assume (although if it would be better with
826 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
827 # and we can affect it to $userid.
828 if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
830 # Using Basic Authentication, no cookies required
831 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
832 -name => 'CGISESSID',
835 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
840 elsif ( $emailaddress) {
841 # the Google OpenID Connect passes an email address
843 elsif ( $sessionID = $query->cookie("CGISESSID") ) { # assignment, not comparison
844 my ( $return, $more_info );
845 # NOTE: $flags in the following call is still undefined !
846 ( $return, $session, $more_info ) = check_cookie_auth( $sessionID, $flags,
847 { remote_addr => $ENV{REMOTE_ADDR}, skip_version_check => 1 }
850 if ( $return eq 'ok' || $return eq 'additional-auth-needed' ) {
851 $userid = $session->param('id');
855 $return eq 'ok' ? 'completed'
856 : $return eq 'additional-auth-needed' ? 'additional-auth-needed'
859 # We are at the second screen if the waiting-for-2FA is set in session
860 # and otp_token param has been passed
862 && $auth_state eq 'additional-auth-needed'
863 && ( my $otp_token = $query->param('otp_token') ) )
865 my $patron = Koha::Patrons->find( { userid => $userid } );
866 my $auth = Koha::Auth::TwoFactorAuth->new( { patron => $patron } );
867 my $verified = $auth->verify($otp_token, 1);
870 # The token is correct, the user is fully logged in!
871 $auth_state = 'completed';
872 $session->param( 'waiting-for-2FA', 0 );
874 # This is an ugly trick to pass the test
875 # $query->param('koha_login_context') && ( $q_userid ne $userid )
880 $invalid_otp_token = 1;
884 if ( $auth_state eq 'completed' ) {
885 Koha::Logger->get->debug(sprintf "AUTH_SESSION: (%s)\t%s %s - %s", map { $session->param($_) || q{} } qw(cardnumber firstname surname branch));
887 if ( ( $query->param('koha_login_context') && ( $q_userid ne $userid ) )
888 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
889 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
892 #if a user enters an id ne to the id in the current session, we need to log them in...
893 #first we need to clear the anonymous session...
894 $anon_search_history = $session->param('search_history');
897 $cookie = $cookie_mgr->clear_unless( $query->cookie, @$cookie );
898 C4::Context::_unset_userenv($sessionID);
902 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
903 -name => 'CGISESSID',
904 -value => $session->id,
906 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
910 $flags = haspermission( $userid, $flagsrequired );
912 $auth_state = 'failed';
913 $info{'nopermission'} = 1;
916 } elsif ( !$logout ) {
917 if ( $return eq 'expired' ) {
918 $info{timed_out} = 1;
919 } elsif ( $return eq 'restricted' ) {
920 $info{oldip} = $more_info->{old_ip};
921 $info{newip} = $more_info->{new_ip};
922 $info{different_ip} = 1;
923 } elsif ( $return eq 'password_expired' ) {
924 $info{password_has_expired} = 1;
929 if ( $auth_state eq 'failed' || $logout ) {
936 # voluntary logout the user
937 # check wether the user was using their shibboleth session or a local one
938 my $shibSuccess = C4::Context->userenv ? C4::Context->userenv->{'shibboleth'} : undef;
943 C4::Context::_unset_userenv($sessionID);
944 $cookie = $cookie_mgr->clear_unless( $query->cookie, @$cookie );
946 if ($cas and $caslogout) {
947 logout_cas($query, $type);
950 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
951 if ( $shib and $shib_login and $shibSuccess) {
956 $auth_state = 'logout';
960 #we initiate a session prior to checking for a username to allow for anonymous sessions...
961 if( !$session or !$sessionID ) { # if we cleared sessionID, we need a new session
962 $session = get_session() or die "Auth ERROR: Cannot get_session()";
965 # Save anonymous search history in new session so it can be retrieved
966 # by get_template_and_user to store it in user's search history after
967 # a successful login.
968 if ($anon_search_history) {
969 $session->param( 'search_history', $anon_search_history );
972 $sessionID = $session->id;
973 C4::Context->_new_userenv($sessionID);
974 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
975 -name => 'CGISESSID',
976 -value => $sessionID,
978 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
981 my $pki_field = C4::Context->preference('AllowPKIAuth');
982 if ( !defined($pki_field) ) {
983 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
986 if ( ( $cas && $query->param('ticket') )
988 || ( $shib && $shib_login )
989 || $pki_field ne 'None'
992 my $password = $query->param('password');
994 my ( $return, $cardnumber );
996 # If shib is enabled and we have a shib login, does the login match a valid koha user
997 if ( $shib && $shib_login ) {
1000 # Do not pass password here, else shib will not be checked in checkpw.
1001 ( $return, $cardnumber, $retuserid ) = checkpw( $q_userid, undef, $query );
1002 $userid = $retuserid;
1003 $shibSuccess = $return;
1004 $info{'invalidShibLogin'} = 1 unless ($return);
1007 # If shib login and match were successful, skip further login methods
1008 unless ($shibSuccess) {
1009 if ( $cas && $query->param('ticket') ) {
1011 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1012 checkpw( $userid, $password, $query, $type );
1013 $userid = $retuserid;
1014 $info{'invalidCasLogin'} = 1 unless ($return);
1017 elsif ( $emailaddress ) {
1018 my $value = $emailaddress;
1020 # If we're looking up the email, there's a chance that the person
1021 # doesn't have a userid. So if there is none, we pass along the
1022 # borrower number, and the bits of code that need to know the user
1023 # ID will have to be smart enough to handle that.
1024 my $patrons = Koha::Patrons->search({ email => $value });
1025 if ($patrons->count) {
1027 # First the userid, then the borrowernum
1028 my $patron = $patrons->next;
1029 $value = $patron->userid || $patron->borrowernumber;
1033 $return = $value ? 1 : 0;
1038 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1039 || ( $pki_field eq 'emailAddress'
1040 && $ENV{'SSL_CLIENT_S_DN_Email'} )
1044 if ( $pki_field eq 'Common Name' ) {
1045 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1047 elsif ( $pki_field eq 'emailAddress' ) {
1048 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1050 # If we're looking up the email, there's a chance that the person
1051 # doesn't have a userid. So if there is none, we pass along the
1052 # borrower number, and the bits of code that need to know the user
1053 # ID will have to be smart enough to handle that.
1054 my $patrons = Koha::Patrons->search({ email => $value });
1055 if ($patrons->count) {
1057 # First the userid, then the borrowernum
1058 my $patron = $patrons->next;
1059 $value = $patron->userid || $patron->borrowernumber;
1065 $return = $value ? 1 : 0;
1071 my $request_method = $query->request_method();
1074 $request_method eq 'POST'
1075 || ( C4::Context->preference('AutoSelfCheckID')
1076 && $q_userid eq C4::Context->preference('AutoSelfCheckID') )
1080 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1081 checkpw( $q_userid, $password, $query, $type );
1082 $userid = $retuserid if ($retuserid);
1083 $info{'invalid_username_or_password'} = 1 unless ($return);
1088 # If shib configured and shibOnly enabled, we should ignore anything other than a shibboleth type login.
1095 && C4::Context->preference('OPACShibOnly')
1097 || ( ( $type ne 'opac' )
1098 && C4::Context->preference('staffShibOnly') )
1105 # $return: 1 = valid user
1108 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1109 $auth_state = "logged_in";
1112 $info{'nopermission'} = 1;
1113 C4::Context::_unset_userenv($sessionID);
1115 my ( $borrowernumber, $firstname, $surname, $userflags,
1116 $branchcode, $branchname, $emailaddress, $desk_id,
1117 $desk_name, $register_id, $register_name );
1119 if ( $return == 1 ) {
1121 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1122 branches.branchname as branchname, email
1124 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1126 my $dbh = C4::Context->dbh;
1127 my $sth = $dbh->prepare("$select where userid=?");
1128 $sth->execute($userid);
1129 unless ( $sth->rows ) {
1130 $sth = $dbh->prepare("$select where cardnumber=?");
1131 $sth->execute($cardnumber);
1133 unless ( $sth->rows ) {
1134 $sth->execute($userid);
1138 ( $borrowernumber, $firstname, $surname, $userflags,
1139 $branchcode, $branchname, $emailaddress ) = $sth->fetchrow;
1142 # launch a sequence to check if we have a ip for the branch, i
1143 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1145 my $ip = $ENV{'REMOTE_ADDR'};
1147 # if they specify at login, use that
1148 if ( $query->param('branch') ) {
1149 $branchcode = $query->param('branch');
1150 my $library = Koha::Libraries->find($branchcode);
1151 $branchname = $library? $library->branchname: '';
1153 if ( $query->param('desk_id') ) {
1154 $desk_id = $query->param('desk_id');
1155 my $desk = Koha::Desks->find($desk_id);
1156 $desk_name = $desk ? $desk->desk_name : '';
1158 if ( C4::Context->preference('UseCashRegisters') ) {
1160 $query->param('register_id')
1161 ? Koha::Cash::Registers->find($query->param('register_id'))
1162 : Koha::Cash::Registers->search(
1163 { branch => $branchcode, branch_default => 1 },
1164 { rows => 1 } )->single;
1165 $register_id = $register->id if ($register);
1166 $register_name = $register->name if ($register);
1168 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search->as_list };
1169 if ( $type ne 'opac' and C4::Context->preference('AutoLocation') ) {
1171 # we have to check they are coming from the right ip range
1172 my $domain = $branches->{$branchcode}->{'branchip'};
1173 $domain =~ s|\.\*||g;
1174 if ( $ip !~ /^$domain/ ) {
1176 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
1177 -name => 'CGISESSID',
1180 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1183 $info{'wrongip'} = 1;
1187 foreach my $br ( keys %$branches ) {
1189 # now we work with the treatment of ip
1190 my $domain = $branches->{$br}->{'branchip'};
1191 if ( $domain && $ip =~ /^$domain/ ) {
1192 $branchcode = $branches->{$br}->{'branchcode'};
1194 # new op dev : add the branchname to the cookie
1195 $branchname = $branches->{$br}->{'branchname'};
1199 my $is_sco_user = 0;
1200 if ( $query->param('sco_user_login') && ( $query->param('sco_user_login') eq '1' ) ){
1204 $session->param( 'number', $borrowernumber );
1205 $session->param( 'id', $userid );
1206 $session->param( 'cardnumber', $cardnumber );
1207 $session->param( 'firstname', $firstname );
1208 $session->param( 'surname', $surname );
1209 $session->param( 'branch', $branchcode );
1210 $session->param( 'branchname', $branchname );
1211 $session->param( 'desk_id', $desk_id);
1212 $session->param( 'desk_name', $desk_name);
1213 $session->param( 'flags', $userflags );
1214 $session->param( 'emailaddress', $emailaddress );
1215 $session->param( 'ip', $session->remote_addr() );
1216 $session->param( 'lasttime', time() );
1217 $session->param( 'interface', $type);
1218 $session->param( 'shibboleth', $shibSuccess );
1219 $session->param( 'register_id', $register_id );
1220 $session->param( 'register_name', $register_name );
1221 $session->param( 'sco_user', $is_sco_user );
1223 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1224 C4::Context->set_userenv(
1225 $session->param('number'), $session->param('id'),
1226 $session->param('cardnumber'), $session->param('firstname'),
1227 $session->param('surname'), $session->param('branch'),
1228 $session->param('branchname'), $session->param('flags'),
1229 $session->param('emailaddress'), $session->param('shibboleth'),
1230 $session->param('desk_id'), $session->param('desk_name'),
1231 $session->param('register_id'), $session->param('register_name')
1235 # $return: 0 = invalid user
1236 # reset to anonymous session
1239 $info{'invalid_username_or_password'} = 1;
1240 C4::Context::_unset_userenv($sessionID);
1242 $session->param( 'lasttime', time() );
1243 $session->param( 'ip', $session->remote_addr() );
1244 $session->param( 'sessiontype', 'anon' );
1245 $session->param( 'interface', $type);
1247 } # END if ( $q_userid
1248 elsif ( $type eq "opac" ) {
1250 # anonymous sessions are created only for the OPAC
1252 # setting a couple of other session vars...
1253 $session->param( 'ip', $session->remote_addr() );
1254 $session->param( 'lasttime', time() );
1255 $session->param( 'sessiontype', 'anon' );
1256 $session->param( 'interface', $type);
1259 } # END unless ($userid)
1262 if ( $auth_state eq 'logged_in' ) {
1263 $auth_state = 'completed';
1265 # Auth is completed unless an additional auth is needed
1266 if ( $require_2FA ) {
1267 my $patron = Koha::Patrons->find({userid => $userid});
1268 if ( $patron->auth_method eq 'two-factor' ) {
1269 # Ask for the OTP token
1270 $auth_state = 'additional-auth-needed';
1271 $session->param('waiting-for-2FA', 1);
1272 %info = ();# We remove the warnings/errors we may have set incorrectly before
1277 # finished authentification, now respond
1278 if ( $auth_state eq 'completed' || $authnotrequired ) {
1281 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
1282 -name => 'CGISESSID',
1285 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1290 track_login_daily( $userid );
1292 # In case, that this request was a login attempt, we want to prevent that users can repost the opac login
1293 # request. We therefore redirect the user to the requested page again without the login parameters.
1294 # See Post/Redirect/Get (PRG) design pattern: https://en.wikipedia.org/wiki/Post/Redirect/Get
1295 if ( $type eq "opac" && $query->param('koha_login_context') && $query->param('koha_login_context') ne 'sco' && $query->param('password') && $query->param('userid') ) {
1296 my $uri = URI->new($query->url(-relative=>1, -query_string=>1));
1297 $uri->query_param_delete('userid');
1298 $uri->query_param_delete('password');
1299 $uri->query_param_delete('koha_login_context');
1300 print $query->redirect(-uri => $uri->as_string, -cookie => $cookie, -status=>'303 See other');
1304 return ( $userid, $cookie, $sessionID, $flags );
1309 # AUTH rejected, show the login/password template, after checking the DB.
1313 my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1315 # get the inputs from the incoming query
1317 my @inputs_to_clean = qw( userid password ticket logout.x otp_token );
1318 foreach my $name ( param $query) {
1319 next if grep { $name eq $_ } @inputs_to_clean;
1320 my @value = $query->multi_param($name);
1321 push @inputs, { name => $name, value => $_ } for @value;
1324 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1325 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1326 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1328 my $auth_template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1329 my $template = C4::Templates::gettemplate( $auth_template_name, $type, $query );
1333 script_name => get_script_name(),
1334 casAuthentication => C4::Context->preference("casAuthentication"),
1335 shibbolethAuthentication => $shib,
1336 suggestion => C4::Context->preference("suggestion"),
1337 virtualshelves => C4::Context->preference("virtualshelves"),
1338 LibraryName => "" . C4::Context->preference("LibraryName"),
1339 LibraryNameTitle => "" . $LibraryNameTitle,
1340 opacuserlogin => C4::Context->preference("opacuserlogin"),
1341 OpacFavicon => C4::Context->preference("OpacFavicon"),
1342 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1343 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1344 OPACUserJS => C4::Context->preference("OPACUserJS"),
1345 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1346 OpacCloud => C4::Context->preference("OpacCloud"),
1347 OpacTopissue => C4::Context->preference("OpacTopissue"),
1348 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1349 OpacBrowser => C4::Context->preference("OpacBrowser"),
1350 TagsEnabled => C4::Context->preference("TagsEnabled"),
1351 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1352 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1353 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1354 IntranetNav => C4::Context->preference("IntranetNav"),
1355 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1356 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
1357 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1358 IndependentBranches => C4::Context->preference("IndependentBranches"),
1359 AutoLocation => C4::Context->preference("AutoLocation"),
1360 wrongip => $info{'wrongip'},
1361 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1362 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1363 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1364 too_many_login_attempts => ( $patron and $patron->account_locked ),
1365 password_has_expired => ( $patron and $patron->password_expired ),
1368 $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1369 $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1370 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1371 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1372 if ( $auth_state eq 'additional-auth-needed' ) {
1373 my $patron = Koha::Patrons->find( { userid => $userid } );
1376 invalid_otp_token => $invalid_otp_token,
1377 notice_email_address => $patron->notice_email_address, # We could also pass logged_in_user if necessary
1381 if ( $type eq 'opac' ) {
1382 require Koha::Virtualshelves;
1383 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1389 some_public_shelves => $some_public_shelves,
1395 # Is authentication against multiple CAS servers enabled?
1396 require C4::Auth_with_cas;
1397 if ( multipleAuth() && !$casparam ) {
1398 my $casservers = getMultipleAuth();
1400 foreach my $key ( keys %$casservers ) {
1401 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1404 casServersLoop => \@tmplservers
1408 casServerUrl => login_cas_url($query, undef, $type),
1413 invalidCasLogin => $info{'invalidCasLogin'}
1418 #If shibOnly is enabled just go ahead and redirect directly
1419 if ( (($type eq 'opac') && C4::Context->preference('OPACShibOnly')) || (($type ne 'opac') && C4::Context->preference('staffShibOnly')) ) {
1420 my $redirect_url = login_shib_url( $query );
1421 print $query->redirect( -uri => "$redirect_url", -status => 303 );
1426 shibbolethAuthentication => $shib,
1427 shibbolethLoginUrl => login_shib_url($query),
1431 if (C4::Context->preference('GoogleOpenIDConnect')) {
1432 if ($query->param("OpenIDConnectFailed")) {
1433 my $reason = $query->param('OpenIDConnectFailed');
1434 $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1439 LibraryName => C4::Context->preference("LibraryName"),
1441 $template->param(%info);
1443 # $cookie = $query->cookie(CGISESSID => $session->id
1445 print $query->header(
1446 { type => 'text/html',
1449 'X-Frame-Options' => 'SAMEORIGIN',
1457 =head2 check_api_auth
1459 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1461 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1462 cookie, determine if the user has the privileges specified by C<$userflags>.
1464 C<check_api_auth> is is meant for authenticating users of web services, and
1465 consequently will always return and will not attempt to redirect the user
1468 If a valid session cookie is already present, check_api_auth will return a status
1469 of "ok", the cookie, and the Koha session ID.
1471 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1472 parameters and create a session cookie and Koha session if the supplied credentials
1475 Possible return values in C<$status> are:
1479 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1481 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1483 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1485 =item "expired -- session cookie has expired; API user should resubmit userid and password
1487 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1489 =item "additional-auth-needed -- User is in an authentication process that is not finished
1495 sub check_api_auth {
1498 my $flagsrequired = shift;
1499 my $timeout = _timeout_syspref();
1501 unless ( C4::Context->preference('Version') ) {
1503 # database has not been installed yet
1504 return ( "maintenance", undef, undef );
1506 my $kohaversion = Koha::version();
1507 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1508 if ( C4::Context->preference('Version') < $kohaversion ) {
1510 # database in need of version update; assume that
1511 # no API should be called while databsae is in
1513 return ( "maintenance", undef, undef );
1516 my ( $sessionID, $session );
1517 unless ( $query->param('userid') ) {
1518 $sessionID = $query->cookie("CGISESSID");
1520 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1523 ( $return, $session, undef ) = check_cookie_auth(
1524 $sessionID, $flagsrequired, { remote_addr => $ENV{REMOTE_ADDR} } );
1526 return ( $return, undef, undef ) # Cookie auth failed
1529 my $cookie = $query->cookie(
1530 -name => 'CGISESSID',
1531 -value => $session->id,
1533 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1536 return ( $return, $cookie, $session ); # return == 'ok' here
1541 my $userid = $query->param('userid');
1542 my $password = $query->param('password');
1543 my ( $return, $cardnumber, $cas_ticket );
1546 if ( $cas && $query->param('PT') ) {
1549 # In case of a CAS authentication, we use the ticket instead of the password
1550 my $PT = $query->param('PT');
1551 ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $PT, $query ); # EXTERNAL AUTH
1554 # User / password auth
1555 unless ( $userid and $password ) {
1557 # caller did something wrong, fail the authenticateion
1558 return ( "failed", undef, undef );
1561 ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $userid, $password, $query );
1564 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1565 my $session = get_session("");
1566 return ( "failed", undef, undef ) unless $session;
1568 my $sessionID = $session->id;
1569 C4::Context->_new_userenv($sessionID);
1570 my $cookie = $query->cookie(
1571 -name => 'CGISESSID',
1572 -value => $sessionID,
1574 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1577 if ( $return == 1 ) {
1579 $borrowernumber, $firstname, $surname,
1580 $userflags, $branchcode, $branchname,
1583 my $dbh = C4::Context->dbh;
1586 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1588 $sth->execute($userid);
1590 $borrowernumber, $firstname, $surname,
1591 $userflags, $branchcode, $branchname,
1593 ) = $sth->fetchrow if ( $sth->rows );
1595 unless ( $sth->rows ) {
1596 my $sth = $dbh->prepare(
1597 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1599 $sth->execute($cardnumber);
1601 $borrowernumber, $firstname, $surname,
1602 $userflags, $branchcode, $branchname,
1604 ) = $sth->fetchrow if ( $sth->rows );
1606 unless ( $sth->rows ) {
1607 $sth->execute($userid);
1609 $borrowernumber, $firstname, $surname, $userflags,
1610 $branchcode, $branchname, $emailaddress
1611 ) = $sth->fetchrow if ( $sth->rows );
1615 my $ip = $ENV{'REMOTE_ADDR'};
1617 # if they specify at login, use that
1618 if ( $query->param('branch') ) {
1619 $branchcode = $query->param('branch');
1620 my $library = Koha::Libraries->find($branchcode);
1621 $branchname = $library? $library->branchname: '';
1623 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search->as_list };
1624 foreach my $br ( keys %$branches ) {
1626 # now we work with the treatment of ip
1627 my $domain = $branches->{$br}->{'branchip'};
1628 if ( $domain && $ip =~ /^$domain/ ) {
1629 $branchcode = $branches->{$br}->{'branchcode'};
1631 # new op dev : add the branchname to the cookie
1632 $branchname = $branches->{$br}->{'branchname'};
1635 $session->param( 'number', $borrowernumber );
1636 $session->param( 'id', $userid );
1637 $session->param( 'cardnumber', $cardnumber );
1638 $session->param( 'firstname', $firstname );
1639 $session->param( 'surname', $surname );
1640 $session->param( 'branch', $branchcode );
1641 $session->param( 'branchname', $branchname );
1642 $session->param( 'flags', $userflags );
1643 $session->param( 'emailaddress', $emailaddress );
1644 $session->param( 'ip', $session->remote_addr() );
1645 $session->param( 'lasttime', time() );
1646 $session->param( 'interface', 'api' );
1648 $session->param( 'cas_ticket', $cas_ticket);
1649 C4::Context->set_userenv(
1650 $session->param('number'), $session->param('id'),
1651 $session->param('cardnumber'), $session->param('firstname'),
1652 $session->param('surname'), $session->param('branch'),
1653 $session->param('branchname'), $session->param('flags'),
1654 $session->param('emailaddress'), $session->param('shibboleth'),
1655 $session->param('desk_id'), $session->param('desk_name'),
1656 $session->param('register_id'), $session->param('register_name')
1658 return ( "ok", $cookie, $sessionID );
1660 return ( "failed", undef, undef );
1665 =head2 check_cookie_auth
1667 ($status, $sessionId) = check_cookie_auth($cookie, $userflags);
1669 Given a CGISESSID cookie set during a previous login to Koha, determine
1670 if the user has the privileges specified by C<$userflags>. C<$userflags>
1671 is passed unaltered into C<haspermission> and as such accepts all options
1672 avaiable to that routine with the one caveat that C<check_api_auth> will
1673 also allow 'undef' to be passed and in such a case the permissions check
1674 will be skipped altogether.
1676 C<check_cookie_auth> is meant for authenticating special services
1677 such as tools/upload-file.pl that are invoked by other pages that
1678 have been authenticated in the usual way.
1680 Possible return values in C<$status> are:
1684 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1686 =item "anon" -- user not authenticated but valid for anonymous session.
1688 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1690 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1692 =item "expired -- session cookie has expired; API user should resubmit userid and password
1694 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1700 sub check_cookie_auth {
1701 my $sessionID = shift;
1702 my $flagsrequired = shift;
1705 my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1707 my $skip_version_check = $params->{skip_version_check}; # Only for checkauth
1709 unless ( $skip_version_check ) {
1710 unless ( C4::Context->preference('Version') ) {
1712 # database has not been installed yet
1713 return ( "maintenance", undef );
1715 my $kohaversion = Koha::version();
1716 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1717 if ( C4::Context->preference('Version') < $kohaversion ) {
1719 # database in need of version update; assume that
1720 # no API should be called while databsae is in
1722 return ( "maintenance", undef );
1726 # see if we have a valid session cookie already
1727 # however, if a userid parameter is present (i.e., from
1728 # a form submission, assume that any current cookie
1730 unless ( $sessionID ) {
1731 return ( "failed", undef );
1733 C4::Context::_unset_userenv($sessionID); # remove old userenv first
1734 my $session = get_session($sessionID);
1736 my $userid = $session->param('id');
1737 my $ip = $session->param('ip');
1738 my $lasttime = $session->param('lasttime');
1739 my $timeout = _timeout_syspref();
1741 if ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
1745 return ("expired", undef);
1747 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1748 # IP address changed
1751 return ( "restricted", undef, { old_ip => $ip, new_ip => $remote_addr});
1753 } elsif ( $userid ) {
1754 $session->param( 'lasttime', time() );
1755 my $patron = Koha::Patrons->find({ userid => $userid });
1756 $patron = Koha::Patron->find({ cardnumber => $userid }) unless $patron;
1757 return ("password_expired", undef ) if $patron->password_expired;
1758 my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1760 C4::Context->_new_userenv($sessionID);
1761 C4::Context->interface($session->param('interface'));
1762 C4::Context->set_userenv(
1763 $session->param('number'), $session->param('id') // '',
1764 $session->param('cardnumber'), $session->param('firstname'),
1765 $session->param('surname'), $session->param('branch'),
1766 $session->param('branchname'), $session->param('flags'),
1767 $session->param('emailaddress'), $session->param('shibboleth'),
1768 $session->param('desk_id'), $session->param('desk_name'),
1769 $session->param('register_id'), $session->param('register_name')
1771 return ( "additional-auth-needed", $session )
1772 if $session->param('waiting-for-2FA');
1774 return ( "ok", $session );
1778 return ( "failed", undef );
1782 C4::Context->_new_userenv($sessionID);
1783 C4::Context->interface($session->param('interface'));
1784 C4::Context->set_userenv( undef, q{} );
1785 return ( "anon", $session );
1788 return ( "expired", undef );
1795 my $session = get_session($sessionID);
1797 Given a session ID, retrieve the CGI::Session object used to store
1798 the session's state. The session object can be used to store
1799 data that needs to be accessed by different scripts during a
1802 If the C<$sessionID> parameter is an empty string, a new session
1807 sub _get_session_params {
1808 my $storage_method = C4::Context->preference('SessionStorage');
1809 if ( $storage_method eq 'mysql' ) {
1810 my $dbh = C4::Context->dbh;
1811 return { dsn => "serializer:yamlxs;driver:MySQL;id:md5", dsn_args => { Handle => $dbh } };
1813 elsif ( $storage_method eq 'Pg' ) {
1814 my $dbh = C4::Context->dbh;
1815 return { dsn => "serializer:yamlxs;driver:PostgreSQL;id:md5", dsn_args => { Handle => $dbh } };
1817 elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1818 my $memcached = Koha::Caches->get_instance()->memcached_cache;
1819 return { dsn => "serializer:yamlxs;driver:memcached;id:md5", dsn_args => { Memcached => $memcached } };
1822 # catch all defaults to tmp should work on all systems
1823 my $dir = C4::Context::temporary_directory;
1824 my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1825 return { dsn => "serializer:yamlxs;driver:File;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1830 my $sessionID = shift;
1831 my $params = _get_session_params();
1833 if( $sessionID ) { # find existing
1834 CGI::Session::ErrorHandler->set_error( q{} ); # clear error, cpan issue #111463
1835 $session = CGI::Session->load( $params->{dsn}, $sessionID, $params->{dsn_args} );
1837 $session = CGI::Session->new( $params->{dsn}, $sessionID, $params->{dsn_args} );
1838 # no need to flush here
1844 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1845 # (or something similar)
1846 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1847 # not having a userenv defined could cause a crash.
1849 my ( $userid, $password, $query, $type, $no_set_userenv ) = @_;
1850 $type = 'opac' unless $type;
1852 # Get shibboleth login attribute
1853 my $shib = C4::Context->config('useshibboleth') && shib_ok();
1854 my $shib_login = $shib ? get_login_shib() : undef;
1858 if ( defined $userid ){
1859 $patron = Koha::Patrons->find({ userid => $userid });
1860 $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1862 my $check_internal_as_fallback = 0;
1864 # Note: checkpw_* routines returns:
1867 # -1 if user bind failed (LDAP only)
1869 if ( $patron and ( $patron->account_locked ) ) {
1870 # Nothing to check, account is locked
1871 } elsif ($ldap && defined($password)) {
1872 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
1873 if ( $retval == 1 ) {
1874 @return = ( $retval, $retcard, $retuserid );
1877 $check_internal_as_fallback = 1 if $retval == 0;
1879 } elsif ( $cas && $query && $query->param('ticket') ) {
1881 # In case of a CAS authentication, we use the ticket instead of the password
1882 my $ticket = $query->param('ticket');
1883 $query->delete('ticket'); # remove ticket to come back to original URL
1884 my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $ticket, $query, $type ); # EXTERNAL AUTH
1886 @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1890 $passwd_ok = $retval;
1893 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1894 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1896 elsif ( $shib && $shib_login && !$password ) {
1898 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1899 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1900 # shibboleth-authenticated user
1902 # Then, we check if it matches a valid koha user
1904 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
1906 @return = ( $retval, $retcard, $retuserid );
1908 $passwd_ok = $retval;
1911 $check_internal_as_fallback = 1;
1915 if ( $check_internal_as_fallback ) {
1916 @return = checkpw_internal( $userid, $password, $no_set_userenv);
1917 $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1922 $patron->update({ login_attempts => 0 });
1923 if( $patron->password_expired ){
1926 } elsif( !$patron->account_locked ) {
1927 $patron->update({ login_attempts => $patron->login_attempts + 1 });
1931 # Optionally log success or failure
1932 if( $patron && $passwd_ok && C4::Context->preference('AuthSuccessLog') ) {
1933 logaction( 'AUTH', 'SUCCESS', $patron->id, "Valid password for $userid", $type );
1934 } elsif( !$passwd_ok && C4::Context->preference('AuthFailureLog') ) {
1935 logaction( 'AUTH', 'FAILURE', $patron ? $patron->id : 0, "Wrong password for $userid", $type );
1941 sub checkpw_internal {
1942 my ( $userid, $password, $no_set_userenv ) = @_;
1944 $password = Encode::encode( 'UTF-8', $password )
1945 if Encode::is_utf8($password);
1947 my $dbh = C4::Context->dbh;
1950 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1952 $sth->execute($userid);
1954 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1955 $surname, $branchcode, $branchname, $flags )
1958 if ( checkpw_hash( $password, $stored_hash ) ) {
1960 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1961 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1962 return 1, $cardnumber, $userid;
1967 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1969 $sth->execute($userid);
1971 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1972 $surname, $branchcode, $branchname, $flags )
1975 if ( checkpw_hash( $password, $stored_hash ) ) {
1977 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1978 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1979 return 1, $cardnumber, $userid;
1986 my ( $password, $stored_hash ) = @_;
1988 return if $stored_hash eq '!';
1990 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1992 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1993 $hash = hash_password( $password, $stored_hash );
1995 $hash = md5_base64($password);
1997 return $hash eq $stored_hash;
2002 my $authflags = getuserflags($flags, $userid, [$dbh]);
2004 Translates integer flags into permissions strings hash.
2006 C<$flags> is the integer userflags value ( borrowers.userflags )
2007 C<$userid> is the members.userid, used for building subpermissions
2008 C<$authflags> is a hashref of permissions
2015 my $dbh = @_ ? shift : C4::Context->dbh;
2018 # I don't want to do this, but if someone logs in as the database
2019 # user, it would be preferable not to spam them to death with
2020 # numeric warnings. So, we make $flags numeric.
2021 no warnings 'numeric';
2024 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
2027 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
2028 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
2029 $userflags->{$flag} = 1;
2032 $userflags->{$flag} = 0;
2036 # get subpermissions and merge with top-level permissions
2037 my $user_subperms = get_user_subpermissions($userid);
2038 foreach my $module ( keys %$user_subperms ) {
2039 next if $userflags->{$module} == 1; # user already has permission for everything in this module
2040 $userflags->{$module} = $user_subperms->{$module};
2046 =head2 get_user_subpermissions
2048 $user_perm_hashref = get_user_subpermissions($userid);
2050 Given the userid (note, not the borrowernumber) of a staff user,
2051 return a hashref of hashrefs of the specific subpermissions
2052 accorded to the user. An example return is
2056 export_catalog => 1,
2057 import_patrons => 1,
2061 The top-level hash-key is a module or function code from
2062 userflags.flag, while the second-level key is a code
2065 The results of this function do not give a complete picture
2066 of the functions that a staff user can access; it is also
2067 necessary to check borrowers.flags.
2071 sub get_user_subpermissions {
2074 my $dbh = C4::Context->dbh;
2075 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2076 FROM user_permissions
2077 JOIN permissions USING (module_bit, code)
2078 JOIN userflags ON (module_bit = bit)
2079 JOIN borrowers USING (borrowernumber)
2080 WHERE userid = ?" );
2081 $sth->execute($userid);
2083 my $user_perms = {};
2084 while ( my $perm = $sth->fetchrow_hashref ) {
2085 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2090 =head2 get_all_subpermissions
2092 my $perm_hashref = get_all_subpermissions();
2094 Returns a hashref of hashrefs defining all specific
2095 permissions currently defined. The return value
2096 has the same structure as that of C<get_user_subpermissions>,
2097 except that the innermost hash value is the description
2098 of the subpermission.
2102 sub get_all_subpermissions {
2103 my $dbh = C4::Context->dbh;
2104 my $sth = $dbh->prepare( "SELECT flag, code
2106 JOIN userflags ON (module_bit = bit)" );
2110 while ( my $perm = $sth->fetchrow_hashref ) {
2111 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2116 =head2 haspermission
2118 $flagsrequired = '*'; # Any permission at all
2119 $flagsrequired = 'a_flag'; # a_flag must be satisfied (all subpermissions)
2120 $flagsrequired = [ 'a_flag', 'b_flag' ]; # a_flag OR b_flag must be satisfied
2121 $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 }; # a_flag AND b_flag must be satisfied
2122 $flagsrequired = { 'a_flag' => 'sub_a' }; # sub_a of a_flag must be satisfied
2123 $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2125 $flags = ($userid, $flagsrequired);
2127 C<$userid> the userid of the member
2128 C<$flags> is a query structure similar to that used by SQL::Abstract that
2129 denotes the combination of flags required. It is a required parameter.
2131 The main logic of this method is that things in arrays are OR'ed, and things
2132 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2134 Returns member's flags or 0 if a permission is not met.
2139 my ($required, $flags) = @_;
2141 my $ref = ref($required);
2143 if ($required eq '*') {
2144 return 0 unless ( $flags or ref( $flags ) );
2146 return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2148 } elsif ($ref eq 'HASH') {
2149 foreach my $key (keys %{$required}) {
2150 next if $flags == 1;
2151 my $require = $required->{$key};
2152 my $rflags = $flags->{$key};
2153 return 0 unless _dispatch($require, $rflags);
2155 } elsif ($ref eq 'ARRAY') {
2157 foreach my $require ( @{$required} ) {
2159 ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2160 ? $flags->{$require}
2162 $satisfied++ if _dispatch( $require, $rflags );
2164 return 0 unless $satisfied;
2166 croak "Unexpected structure found: $ref";
2173 my ( $userid, $flagsrequired ) = @_;
2175 #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2176 # unless defined($flagsrequired);
2178 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2179 $sth->execute($userid);
2180 my $row = $sth->fetchrow();
2181 my $flags = getuserflags( $row, $userid );
2183 return $flags unless defined($flagsrequired);
2184 return $flags if $flags->{superlibrarian};
2185 return _dispatch($flagsrequired, $flags);
2187 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2192 $flags = ($iprange);
2194 C<$iprange> A space separated string describing an IP range. Can include single IPs or ranges
2196 Returns 1 if the remote address is in the provided iprange, or 0 otherwise.
2203 my @allowedipranges = $iprange ? split(' ', $iprange) : ();
2204 if (scalar @allowedipranges > 0) {
2206 eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2207 eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || Koha::Logger->get->warn('cidrlookup failed for ' . join(' ',@rangelist) );
2209 return $result ? 1 : 0;
2212 sub getborrowernumber {
2214 my $userenv = C4::Context->userenv;
2215 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2216 return $userenv->{number};
2218 my $dbh = C4::Context->dbh;
2219 for my $field ( 'userid', 'cardnumber' ) {
2221 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2222 $sth->execute($userid);
2224 my ($bnumber) = $sth->fetchrow;
2231 =head2 track_login_daily
2233 track_login_daily( $userid );
2235 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2239 sub track_login_daily {
2241 return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2243 my $cache = Koha::Caches->get_instance();
2244 my $cache_key = "track_login_" . $userid;
2245 my $cached = $cache->get_from_cache($cache_key);
2246 my $today = dt_from_string()->ymd;
2247 return if $cached && $cached eq $today;
2249 my $patron = Koha::Patrons->find({ userid => $userid });
2250 return unless $patron;
2251 $patron->track_login;
2252 $cache->set_in_cache( $cache_key, $today );
2255 END { } # module clean-up code here (global destructor)
2265 Crypt::Eksblowfish::Bcrypt(3)