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-page|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->preference('Suggestion') && C4::Context->preference('AnonSuggestions') ) {
453 $can_make_suggestions = 1;
454 } elsif ( C4::Context->userenv && C4::Context->userenv->{'number'} ) {
455 $can_make_suggestions = Koha::Patrons->find(C4::Context->userenv->{'number'})->category->can_make_suggestions;
458 my $minPasswordLength = C4::Context->preference('minPasswordLength');
459 $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
461 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
462 GoogleJackets => C4::Context->preference("GoogleJackets"),
463 OpenLibraryCovers => C4::Context->preference("OpenLibraryCovers"),
464 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
465 LoginFirstname => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
466 LoginSurname => C4::Context->userenv ? C4::Context->userenv->{"surname"} : "Inconnu",
467 emailaddress => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
468 TagsEnabled => C4::Context->preference("TagsEnabled"),
469 hide_marc => C4::Context->preference("hide_marc"),
470 item_level_itypes => C4::Context->preference('item-level_itypes'),
471 patronimages => C4::Context->preference("patronimages"),
472 singleBranchMode => ( Koha::Libraries->search->count == 1 ),
473 noItemTypeImages => C4::Context->preference("noItemTypeImages"),
474 marcflavour => C4::Context->preference("marcflavour"),
475 OPACBaseURL => C4::Context->preference('OPACBaseURL'),
476 minPasswordLength => $minPasswordLength,
478 if ( $in->{'type'} eq "intranet" ) {
480 AmazonCoverImages => C4::Context->preference("AmazonCoverImages"),
481 AutoLocation => C4::Context->preference("AutoLocation"),
482 PatronAutoComplete => C4::Context->preference("PatronAutoComplete"),
483 FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
484 IndependentBranches => C4::Context->preference("IndependentBranches"),
485 IntranetNav => C4::Context->preference("IntranetNav"),
486 IntranetmainUserblock => C4::Context->preference("IntranetmainUserblock"),
487 LibraryName => C4::Context->preference("LibraryName"),
488 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
489 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
490 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
491 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
492 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
493 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
494 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
495 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
496 suggestion => $can_make_suggestions,
497 virtualshelves => C4::Context->preference("virtualshelves"),
498 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
499 EasyAnalyticalRecords => C4::Context->preference('EasyAnalyticalRecords'),
500 LocalCoverImages => C4::Context->preference('LocalCoverImages'),
501 OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'),
502 AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'),
503 EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'),
504 UseCourseReserves => C4::Context->preference("UseCourseReserves"),
505 useDischarge => C4::Context->preference('useDischarge'),
506 pending_checkout_notes => Koha::Checkouts->search({ noteseen => 0 }),
507 plugins_enabled => C4::Context->config("enable_plugins"),
511 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
513 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
514 my $LibraryNameTitle = C4::Context->preference("LibraryName");
515 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
516 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
518 # clean up the busc param in the session
519 # if the page is not opac-detail and not the "add to list" page
520 # and not the "edit comments" page
521 if ( C4::Context->preference("OpacBrowseResults")
522 && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
524 unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
525 or $pagename =~ /^showmarc$/
526 or $pagename =~ /^addbybiblionumber$/
527 or $pagename =~ /^review$/ )
529 my $sessionSearch = get_session( $sessionID );
530 $sessionSearch->clear( ["busc"] ) if $sessionSearch;
534 # variables passed from CGI: opac_css_override and opac_search_limits.
535 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
536 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
539 ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:([\w-]+)/ ) ||
540 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:([\w-]+)/ ) ||
541 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /multibranchlimit:(\w+)/ )
543 $opac_name = $1; # opac_search_limit is a branch, so we use it.
544 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
545 $opac_name = $in->{'query'}->param('multibranchlimit');
546 } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
547 $opac_name = C4::Context->userenv->{'branch'};
550 my @search_groups = Koha::Library::Groups->get_search_groups({ interface => 'opac' })->as_list;
552 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
553 LibrarySearchGroups => \@search_groups,
554 opac_name => $opac_name,
555 LibraryName => "" . C4::Context->preference("LibraryName"),
556 LibraryNameTitle => "" . $LibraryNameTitle,
557 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
558 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
559 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
560 OPACShelfBrowser => "" . C4::Context->preference("OPACShelfBrowser"),
561 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
562 OPACUserCSS => "" . C4::Context->preference("OPACUserCSS"),
563 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
564 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
565 opac_search_limit => $opac_search_limit,
566 opac_limit_override => $opac_limit_override,
567 OpacBrowser => C4::Context->preference("OpacBrowser"),
568 OpacCloud => C4::Context->preference("OpacCloud"),
569 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
570 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
571 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
572 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
573 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
574 OpacTopissue => C4::Context->preference("OpacTopissue"),
575 'Version' => C4::Context->preference('Version'),
576 hidelostitems => C4::Context->preference("hidelostitems"),
577 mylibraryfirst => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
578 opacbookbag => "" . C4::Context->preference("opacbookbag"),
579 OpacFavicon => C4::Context->preference("OpacFavicon"),
580 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
581 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
582 OPACUserJS => C4::Context->preference("OPACUserJS"),
583 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
584 OpenLibrarySearch => C4::Context->preference("OpenLibrarySearch"),
585 ShowReviewer => C4::Context->preference("ShowReviewer"),
586 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
587 suggestion => $can_make_suggestions,
588 virtualshelves => "" . C4::Context->preference("virtualshelves"),
589 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
590 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
591 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
592 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
593 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
594 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
595 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
596 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
597 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
598 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
599 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
600 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
601 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
602 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
603 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
604 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
605 useDischarge => C4::Context->preference('useDischarge'),
608 $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
611 # Check if we were asked using parameters to force a specific language
612 if ( defined $in->{'query'}->param('language') ) {
614 # Extract the language, let C4::Languages::getlanguage choose
616 my $language = C4::Languages::getlanguage( $in->{'query'} );
617 my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
618 $cookie = $cookie_mgr->replace_in_list( $cookie, $languagecookie );
621 return ( $template, $borrowernumber, $cookie, $flags );
626 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
628 Verifies that the user is authorized to run this script. If
629 the user is authorized, a (userid, cookie, session-id, flags)
630 quadruple is returned. If the user is not authorized but does
631 not have the required privilege (see $flagsrequired below), it
632 displays an error page and exits. Otherwise, it displays the
633 login page and exits.
635 Note that C<&checkauth> will return if and only if the user
636 is authorized, so it should be called early on, before any
637 unfinished operations (e.g., if you've opened a file, then
638 C<&checkauth> won't close it for you).
640 C<$query> is the CGI object for the script calling C<&checkauth>.
642 The C<$noauth> argument is optional. If it is set, then no
643 authorization is required for the script.
645 C<&checkauth> fetches user and session information from C<$query> and
646 ensures that the user is authorized to run scripts that require
649 The C<$flagsrequired> argument specifies the required privileges
650 the user must have if the username and password are correct.
651 It should be specified as a reference-to-hash; keys in the hash
652 should be the "flags" for the user, as specified in the Members
653 intranet module. Any key specified must correspond to a "flag"
654 in the userflags table. E.g., { circulate => 1 } would specify
655 that the user must have the "circulate" privilege in order to
656 proceed. To make sure that access control is correct, the
657 C<$flagsrequired> parameter must be specified correctly.
659 Koha also has a concept of sub-permissions, also known as
660 granular permissions. This makes the value of each key
661 in the C<flagsrequired> hash take on an additional
666 The user must have access to all subfunctions of the module
667 specified by the hash key.
671 The user must have access to at least one subfunction of the module
672 specified by the hash key.
674 specific permission, e.g., 'export_catalog'
676 The user must have access to the specific subfunction list, which
677 must correspond to a row in the permissions table.
679 The C<$type> argument specifies whether the template should be
680 retrieved from the opac or intranet directory tree. "opac" is
681 assumed if it is not specified; however, if C<$type> is specified,
682 "intranet" is assumed if it is not "opac".
684 If C<$query> does not have a valid session ID associated with it
685 (i.e., the user has not logged in) or if the session has expired,
686 C<&checkauth> presents the user with a login page (from the point of
687 view of the original script, C<&checkauth> does not return). Once the
688 user has authenticated, C<&checkauth> restarts the original script
689 (this time, C<&checkauth> returns).
691 The login page is provided using a HTML::Template, which is set in the
692 systempreferences table or at the top of this file. The variable C<$type>
693 selects which template to use, either the opac or the intranet
694 authentification template.
696 C<&checkauth> returns a user ID, a cookie, and a session ID. The
697 cookie should be sent back to the browser; it verifies that the user
707 # If version syspref is unavailable, it means Koha is being installed,
708 # and so we must redirect to OPAC maintenance page or to the WebInstaller
709 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
710 if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
711 warn "OPAC Install required, redirecting to maintenance";
712 print $query->redirect("/cgi-bin/koha/maintenance.pl");
715 unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
716 if ( $type ne 'opac' ) {
717 warn "Install required, redirecting to Installer";
718 print $query->redirect("/cgi-bin/koha/installer/install.pl");
720 warn "OPAC Install required, redirecting to maintenance";
721 print $query->redirect("/cgi-bin/koha/maintenance.pl");
726 # check that database and koha version are the same
727 # there is no DB version, it's a fresh install,
728 # go to web installer
729 # there is a DB version, compare it to the code version
730 my $kohaversion = Koha::version();
732 # remove the 3 last . to have a Perl number
733 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
734 Koha::Logger->get->debug("kohaversion : $kohaversion");
735 if ( $version < $kohaversion ) {
736 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
737 if ( $type ne 'opac' ) {
738 warn sprintf( $warning, 'Installer' );
739 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
741 warn sprintf( "OPAC: " . $warning, 'maintenance' );
742 print $query->redirect("/cgi-bin/koha/maintenance.pl");
748 sub _timeout_syspref {
749 my $default_timeout = 600;
750 my $timeout = C4::Context->preference('timeout') || $default_timeout;
752 # value in days, convert in seconds
753 if ( $timeout =~ /^(\d+)[dD]$/ ) {
754 $timeout = $1 * 86400;
756 # value in hours, convert in seconds
757 elsif ( $timeout =~ /^(\d+)[hH]$/ ) {
758 $timeout = $1 * 3600;
760 elsif ( $timeout !~ m/^\d+$/ ) {
761 warn "The value of the system preference 'timeout' is not correct, defaulting to $default_timeout";
762 $timeout = $default_timeout;
771 # Get shibboleth login attribute
772 my $shib = C4::Context->config('useshibboleth') && shib_ok();
773 my $shib_login = $shib ? get_login_shib() : undef;
775 # $authnotrequired will be set for scripts which will run without authentication
776 my $authnotrequired = shift;
777 my $flagsrequired = shift;
779 my $emailaddress = shift;
780 my $template_name = shift;
781 $type = 'opac' unless $type;
783 if ( $type eq 'opac' && !C4::Context->preference("OpacPublic") ) {
784 my @allowed_scripts_for_private_opac = qw(
786 opac-registration-email-sent.tt
787 opac-registration-confirmation.tt
788 opac-memberentry-update-submitted.tt
789 opac-password-recovery.tt
790 opac-reset-password.tt
792 $authnotrequired = 0 unless grep { $_ eq $template_name }
793 @allowed_scripts_for_private_opac;
796 my $timeout = _timeout_syspref();
798 my $cookie_mgr = Koha::CookieManager->new;
800 _version_check( $type, $query );
804 my $auth_state = 'failed';
806 my ( $userid, $cookie, $sessionID, $flags );
808 my $logout = $query->param('logout.x');
810 my $anon_search_history;
812 # This parameter is the name of the CAS server we want to authenticate against,
813 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
814 my $casparam = $query->param('cas');
815 my $q_userid = $query->param('userid') // '';
818 my $invalid_otp_token;
820 ( $type ne "opac" # Only available for the staff interface
821 && C4::Context->preference('TwoFactorAuthentication') ne "disabled" ) # If "enabled" or "enforced"
824 # Basic authentication is incompatible with the use of Shibboleth,
825 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
826 # and it may not be the attribute we want to use to match the koha login.
828 # Also, do not consider an empty REMOTE_USER.
830 # Finally, after those tests, we can assume (although if it would be better with
831 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
832 # and we can affect it to $userid.
833 if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
835 # Using Basic Authentication, no cookies required
836 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
837 -name => 'CGISESSID',
840 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
845 elsif ( $emailaddress) {
846 # the Google OpenID Connect passes an email address
848 elsif ( $sessionID = $query->cookie("CGISESSID") ) { # assignment, not comparison
849 my ( $return, $more_info );
850 # NOTE: $flags in the following call is still undefined !
851 ( $return, $session, $more_info ) = check_cookie_auth( $sessionID, $flags,
852 { remote_addr => $ENV{REMOTE_ADDR}, skip_version_check => 1 }
855 if ( $return eq 'ok' || $return eq 'additional-auth-needed' ) {
856 $userid = $session->param('id');
860 $return eq 'ok' ? 'completed'
861 : $return eq 'additional-auth-needed' ? 'additional-auth-needed'
864 # We are at the second screen if the waiting-for-2FA is set in session
865 # and otp_token param has been passed
867 && $auth_state eq 'additional-auth-needed'
868 && ( my $otp_token = $query->param('otp_token') ) )
870 my $patron = Koha::Patrons->find( { userid => $userid } );
871 my $auth = Koha::Auth::TwoFactorAuth->new( { patron => $patron } );
872 my $verified = $auth->verify($otp_token, 1);
875 # The token is correct, the user is fully logged in!
876 $auth_state = 'completed';
877 $session->param( 'waiting-for-2FA', 0 );
878 $session->param( 'waiting-for-2FA-setup', 0 );
880 # This is an ugly trick to pass the test
881 # $query->param('koha_login_context') && ( $q_userid ne $userid )
886 $invalid_otp_token = 1;
890 if ( $auth_state eq 'completed' ) {
891 Koha::Logger->get->debug(sprintf "AUTH_SESSION: (%s)\t%s %s - %s", map { $session->param($_) || q{} } qw(cardnumber firstname surname branch));
893 if ( ( $query->param('koha_login_context') && ( $q_userid ne $userid ) )
894 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
895 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
898 #if a user enters an id ne to the id in the current session, we need to log them in...
899 #first we need to clear the anonymous session...
900 $anon_search_history = $session->param('search_history');
903 $cookie = $cookie_mgr->clear_unless( $query->cookie, @$cookie );
904 C4::Context::_unset_userenv($sessionID);
908 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
909 -name => 'CGISESSID',
910 -value => $session->id,
912 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
916 $flags = haspermission( $userid, $flagsrequired );
918 $auth_state = 'failed';
919 $info{'nopermission'} = 1;
922 } elsif ( !$logout ) {
923 if ( $return eq 'expired' ) {
924 $info{timed_out} = 1;
925 } elsif ( $return eq 'restricted' ) {
926 $info{oldip} = $more_info->{old_ip};
927 $info{newip} = $more_info->{new_ip};
928 $info{different_ip} = 1;
929 } elsif ( $return eq 'password_expired' ) {
930 $info{password_has_expired} = 1;
935 if ( $auth_state eq 'failed' || $logout ) {
942 # voluntary logout the user
943 # check wether the user was using their shibboleth session or a local one
944 my $shibSuccess = C4::Context->userenv ? C4::Context->userenv->{'shibboleth'} : undef;
949 C4::Context::_unset_userenv($sessionID);
950 $cookie = $cookie_mgr->clear_unless( $query->cookie, @$cookie );
952 if ($cas and $caslogout) {
953 logout_cas($query, $type);
956 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
957 if ( $shib and $shib_login and $shibSuccess) {
962 $auth_state = 'logout';
966 #we initiate a session prior to checking for a username to allow for anonymous sessions...
967 if( !$session or !$sessionID ) { # if we cleared sessionID, we need a new session
968 $session = get_session() or die "Auth ERROR: Cannot get_session()";
971 # Save anonymous search history in new session so it can be retrieved
972 # by get_template_and_user to store it in user's search history after
973 # a successful login.
974 if ($anon_search_history) {
975 $session->param( 'search_history', $anon_search_history );
978 $sessionID = $session->id;
979 C4::Context->_new_userenv($sessionID);
980 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
981 -name => 'CGISESSID',
982 -value => $sessionID,
984 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
987 my $pki_field = C4::Context->preference('AllowPKIAuth');
988 if ( !defined($pki_field) ) {
989 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
992 if ( ( $cas && $query->param('ticket') )
994 || ( $shib && $shib_login )
995 || $pki_field ne 'None'
998 my $password = $query->param('password');
1000 my ( $return, $cardnumber );
1002 # If shib is enabled and we have a shib login, does the login match a valid koha user
1003 if ( $shib && $shib_login ) {
1006 # Do not pass password here, else shib will not be checked in checkpw.
1007 ( $return, $cardnumber, $retuserid ) = checkpw( $q_userid, undef, $query );
1008 $userid = $retuserid;
1009 $shibSuccess = $return;
1010 $info{'invalidShibLogin'} = 1 unless ($return);
1013 # If shib login and match were successful, skip further login methods
1014 unless ($shibSuccess) {
1015 if ( $cas && $query->param('ticket') ) {
1017 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1018 checkpw( $userid, $password, $query, $type );
1019 $userid = $retuserid;
1020 $info{'invalidCasLogin'} = 1 unless ($return);
1023 elsif ( $emailaddress ) {
1024 my $value = $emailaddress;
1026 # If we're looking up the email, there's a chance that the person
1027 # doesn't have a userid. So if there is none, we pass along the
1028 # borrower number, and the bits of code that need to know the user
1029 # ID will have to be smart enough to handle that.
1030 my $patrons = Koha::Patrons->search({ email => $value });
1031 if ($patrons->count) {
1033 # First the userid, then the borrowernum
1034 my $patron = $patrons->next;
1035 $value = $patron->userid || $patron->borrowernumber;
1039 $return = $value ? 1 : 0;
1044 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1045 || ( $pki_field eq 'emailAddress'
1046 && $ENV{'SSL_CLIENT_S_DN_Email'} )
1050 if ( $pki_field eq 'Common Name' ) {
1051 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1053 elsif ( $pki_field eq 'emailAddress' ) {
1054 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1056 # If we're looking up the email, there's a chance that the person
1057 # doesn't have a userid. So if there is none, we pass along the
1058 # borrower number, and the bits of code that need to know the user
1059 # ID will have to be smart enough to handle that.
1060 my $patrons = Koha::Patrons->search({ email => $value });
1061 if ($patrons->count) {
1063 # First the userid, then the borrowernum
1064 my $patron = $patrons->next;
1065 $value = $patron->userid || $patron->borrowernumber;
1071 $return = $value ? 1 : 0;
1077 my $request_method = $query->request_method // q{};
1080 $request_method eq 'POST'
1081 || ( C4::Context->preference('AutoSelfCheckID')
1082 && $q_userid eq C4::Context->preference('AutoSelfCheckID') )
1086 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1087 checkpw( $q_userid, $password, $query, $type );
1088 $userid = $retuserid if ($retuserid);
1089 $info{'invalid_username_or_password'} = 1 unless ($return);
1094 # If shib configured and shibOnly enabled, we should ignore anything other than a shibboleth type login.
1101 && C4::Context->preference('OPACShibOnly')
1103 || ( ( $type ne 'opac' )
1104 && C4::Context->preference('staffShibOnly') )
1111 # $return: 1 = valid user
1112 if( $return && $return > 0 ) {
1114 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1115 $auth_state = "logged_in";
1118 $info{'nopermission'} = 1;
1119 C4::Context::_unset_userenv($sessionID);
1121 my ( $borrowernumber, $firstname, $surname, $userflags,
1122 $branchcode, $branchname, $emailaddress, $desk_id,
1123 $desk_name, $register_id, $register_name );
1125 if ( $return == 1 ) {
1127 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1128 branches.branchname as branchname, email
1130 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1132 my $dbh = C4::Context->dbh;
1133 my $sth = $dbh->prepare("$select where userid=?");
1134 $sth->execute($userid);
1135 unless ( $sth->rows ) {
1136 $sth = $dbh->prepare("$select where cardnumber=?");
1137 $sth->execute($cardnumber);
1139 unless ( $sth->rows ) {
1140 $sth->execute($userid);
1144 ( $borrowernumber, $firstname, $surname, $userflags,
1145 $branchcode, $branchname, $emailaddress ) = $sth->fetchrow;
1148 # launch a sequence to check if we have a ip for the branch, i
1149 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1151 my $ip = $ENV{'REMOTE_ADDR'};
1153 # if they specify at login, use that
1154 if ( $query->param('branch') ) {
1155 $branchcode = $query->param('branch');
1156 my $library = Koha::Libraries->find($branchcode);
1157 $branchname = $library? $library->branchname: '';
1159 if ( $query->param('desk_id') ) {
1160 $desk_id = $query->param('desk_id');
1161 my $desk = Koha::Desks->find($desk_id);
1162 $desk_name = $desk ? $desk->desk_name : '';
1164 if ( C4::Context->preference('UseCashRegisters') ) {
1166 $query->param('register_id')
1167 ? Koha::Cash::Registers->find($query->param('register_id'))
1168 : Koha::Cash::Registers->search(
1169 { branch => $branchcode, branch_default => 1 },
1170 { rows => 1 } )->single;
1171 $register_id = $register->id if ($register);
1172 $register_name = $register->name if ($register);
1174 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search->as_list };
1175 if ( $type ne 'opac' and C4::Context->preference('AutoLocation') ) {
1177 # we have to check they are coming from the right ip range
1178 my $domain = $branches->{$branchcode}->{'branchip'};
1179 $domain =~ s|\.\*||g;
1180 if ( $ip !~ /^$domain/ ) {
1182 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
1183 -name => 'CGISESSID',
1186 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1189 $info{'wrongip'} = 1;
1193 foreach my $br ( keys %$branches ) {
1195 # now we work with the treatment of ip
1196 my $domain = $branches->{$br}->{'branchip'};
1197 if ( $domain && $ip =~ /^$domain/ ) {
1198 $branchcode = $branches->{$br}->{'branchcode'};
1200 # new op dev : add the branchname to the cookie
1201 $branchname = $branches->{$br}->{'branchname'};
1205 my $is_sco_user = 0;
1206 if ( $query->param('sco_user_login') && ( $query->param('sco_user_login') eq '1' ) ){
1210 $session->param( 'number', $borrowernumber );
1211 $session->param( 'id', $userid );
1212 $session->param( 'cardnumber', $cardnumber );
1213 $session->param( 'firstname', $firstname );
1214 $session->param( 'surname', $surname );
1215 $session->param( 'branch', $branchcode );
1216 $session->param( 'branchname', $branchname );
1217 $session->param( 'desk_id', $desk_id);
1218 $session->param( 'desk_name', $desk_name);
1219 $session->param( 'flags', $userflags );
1220 $session->param( 'emailaddress', $emailaddress );
1221 $session->param( 'ip', $session->remote_addr() );
1222 $session->param( 'lasttime', time() );
1223 $session->param( 'interface', $type);
1224 $session->param( 'shibboleth', $shibSuccess );
1225 $session->param( 'register_id', $register_id );
1226 $session->param( 'register_name', $register_name );
1227 $session->param( 'sco_user', $is_sco_user );
1229 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1230 C4::Context->set_userenv(
1231 $session->param('number'), $session->param('id'),
1232 $session->param('cardnumber'), $session->param('firstname'),
1233 $session->param('surname'), $session->param('branch'),
1234 $session->param('branchname'), $session->param('flags'),
1235 $session->param('emailaddress'), $session->param('shibboleth'),
1236 $session->param('desk_id'), $session->param('desk_name'),
1237 $session->param('register_id'), $session->param('register_name')
1241 # $return: 0 = invalid user
1242 # reset to anonymous session
1245 $info{'invalid_username_or_password'} = 1;
1246 C4::Context::_unset_userenv($sessionID);
1248 $session->param( 'lasttime', time() );
1249 $session->param( 'ip', $session->remote_addr() );
1250 $session->param( 'sessiontype', 'anon' );
1251 $session->param( 'interface', $type);
1253 } # END if ( $q_userid
1254 elsif ( $type eq "opac" ) {
1256 # anonymous sessions are created only for the OPAC
1258 # setting a couple of other session vars...
1259 $session->param( 'ip', $session->remote_addr() );
1260 $session->param( 'lasttime', time() );
1261 $session->param( 'sessiontype', 'anon' );
1262 $session->param( 'interface', $type);
1265 } # END unless ($userid)
1268 if ( $auth_state eq 'logged_in' ) {
1269 $auth_state = 'completed';
1271 # Auth is completed unless an additional auth is needed
1272 if ( $require_2FA ) {
1273 my $patron = Koha::Patrons->find({userid => $userid});
1274 if ( C4::Context->preference('TwoFactorAuthentication') eq "enforced" && $patron->auth_method eq 'password' ) {
1275 $auth_state = 'setup-additional-auth-needed';
1276 $session->param('waiting-for-2FA-setup', 1);
1277 %info = ();# We remove the warnings/errors we may have set incorrectly before
1278 } elsif ( $patron->auth_method eq 'two-factor' ) {
1279 # Ask for the OTP token
1280 $auth_state = 'additional-auth-needed';
1281 $session->param('waiting-for-2FA', 1);
1282 %info = ();# We remove the warnings/errors we may have set incorrectly before
1287 # finished authentification, now respond
1288 if ( $auth_state eq 'completed' || $authnotrequired ) {
1291 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
1292 -name => 'CGISESSID',
1295 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1300 track_login_daily( $userid );
1302 # In case, that this request was a login attempt, we want to prevent that users can repost the opac login
1303 # request. We therefore redirect the user to the requested page again without the login parameters.
1304 # See Post/Redirect/Get (PRG) design pattern: https://en.wikipedia.org/wiki/Post/Redirect/Get
1305 if ( $type eq "opac" && $query->param('koha_login_context') && $query->param('koha_login_context') ne 'sco' && $query->param('password') && $query->param('userid') ) {
1306 my $uri = URI->new($query->url(-relative=>1, -query_string=>1));
1307 $uri->query_param_delete('userid');
1308 $uri->query_param_delete('password');
1309 $uri->query_param_delete('koha_login_context');
1310 print $query->redirect(-uri => $uri->as_string, -cookie => $cookie, -status=>'303 See other');
1314 return ( $userid, $cookie, $sessionID, $flags );
1319 # AUTH rejected, show the login/password template, after checking the DB.
1323 my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1325 # get the inputs from the incoming query
1327 my @inputs_to_clean = qw( userid password ticket logout.x otp_token );
1328 foreach my $name ( param $query) {
1329 next if grep { $name eq $_ } @inputs_to_clean;
1330 my @value = $query->multi_param($name);
1331 push @inputs, { name => $name, value => $_ } for @value;
1334 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1335 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1336 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1338 my $auth_template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1339 my $template = C4::Templates::gettemplate( $auth_template_name, $type, $query );
1343 script_name => get_script_name(),
1344 casAuthentication => C4::Context->preference("casAuthentication"),
1345 shibbolethAuthentication => $shib,
1346 suggestion => C4::Context->preference("suggestion"),
1347 virtualshelves => C4::Context->preference("virtualshelves"),
1348 LibraryName => "" . C4::Context->preference("LibraryName"),
1349 LibraryNameTitle => "" . $LibraryNameTitle,
1350 opacuserlogin => C4::Context->preference("opacuserlogin"),
1351 OpacFavicon => C4::Context->preference("OpacFavicon"),
1352 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1353 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1354 OPACUserJS => C4::Context->preference("OPACUserJS"),
1355 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1356 OpacCloud => C4::Context->preference("OpacCloud"),
1357 OpacTopissue => C4::Context->preference("OpacTopissue"),
1358 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1359 OpacBrowser => C4::Context->preference("OpacBrowser"),
1360 TagsEnabled => C4::Context->preference("TagsEnabled"),
1361 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1362 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1363 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1364 IntranetNav => C4::Context->preference("IntranetNav"),
1365 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1366 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
1367 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1368 IndependentBranches => C4::Context->preference("IndependentBranches"),
1369 AutoLocation => C4::Context->preference("AutoLocation"),
1370 wrongip => $info{'wrongip'},
1371 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1372 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1373 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1374 too_many_login_attempts => ( $patron and $patron->account_locked ),
1375 password_has_expired => ( $patron and $patron->password_expired ),
1378 $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1379 $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1380 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1381 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1382 if ( $auth_state eq 'additional-auth-needed' ) {
1383 my $patron = Koha::Patrons->find( { userid => $userid } );
1386 invalid_otp_token => $invalid_otp_token,
1387 notice_email_address => $patron->notice_email_address, # We could also pass logged_in_user if necessary
1391 if ( $auth_state eq 'setup-additional-auth-needed' ) {
1397 if ( $type eq 'opac' ) {
1398 require Koha::Virtualshelves;
1399 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1405 some_public_shelves => $some_public_shelves,
1411 # Is authentication against multiple CAS servers enabled?
1412 require C4::Auth_with_cas;
1413 if ( multipleAuth() && !$casparam ) {
1414 my $casservers = getMultipleAuth();
1416 foreach my $key ( keys %$casservers ) {
1417 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1420 casServersLoop => \@tmplservers
1424 casServerUrl => login_cas_url($query, undef, $type),
1429 invalidCasLogin => $info{'invalidCasLogin'}
1434 #If shibOnly is enabled just go ahead and redirect directly
1435 if ( (($type eq 'opac') && C4::Context->preference('OPACShibOnly')) || (($type ne 'opac') && C4::Context->preference('staffShibOnly')) ) {
1436 my $redirect_url = login_shib_url( $query );
1437 print $query->redirect( -uri => "$redirect_url", -status => 303 );
1442 shibbolethAuthentication => $shib,
1443 shibbolethLoginUrl => login_shib_url($query),
1447 if (C4::Context->preference('GoogleOpenIDConnect')) {
1448 if ($query->param("OpenIDConnectFailed")) {
1449 my $reason = $query->param('OpenIDConnectFailed');
1450 $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1455 LibraryName => C4::Context->preference("LibraryName"),
1457 $template->param(%info);
1459 # $cookie = $query->cookie(CGISESSID => $session->id
1461 print $query->header(
1462 { type => 'text/html',
1465 'X-Frame-Options' => 'SAMEORIGIN',
1473 =head2 check_api_auth
1475 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1477 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1478 cookie, determine if the user has the privileges specified by C<$userflags>.
1480 C<check_api_auth> is is meant for authenticating users of web services, and
1481 consequently will always return and will not attempt to redirect the user
1484 If a valid session cookie is already present, check_api_auth will return a status
1485 of "ok", the cookie, and the Koha session ID.
1487 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1488 parameters and create a session cookie and Koha session if the supplied credentials
1491 Possible return values in C<$status> are:
1495 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1497 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1499 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1501 =item "expired -- session cookie has expired; API user should resubmit userid and password
1503 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1505 =item "additional-auth-needed -- User is in an authentication process that is not finished
1511 sub check_api_auth {
1514 my $flagsrequired = shift;
1515 my $timeout = _timeout_syspref();
1517 unless ( C4::Context->preference('Version') ) {
1519 # database has not been installed yet
1520 return ( "maintenance", undef, undef );
1522 my $kohaversion = Koha::version();
1523 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1524 if ( C4::Context->preference('Version') < $kohaversion ) {
1526 # database in need of version update; assume that
1527 # no API should be called while databsae is in
1529 return ( "maintenance", undef, undef );
1532 my ( $sessionID, $session );
1533 unless ( $query->param('userid') ) {
1534 $sessionID = $query->cookie("CGISESSID");
1536 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1539 ( $return, $session, undef ) = check_cookie_auth(
1540 $sessionID, $flagsrequired, { remote_addr => $ENV{REMOTE_ADDR} } );
1542 return ( $return, undef, undef ) # Cookie auth failed
1545 my $cookie = $query->cookie(
1546 -name => 'CGISESSID',
1547 -value => $session->id,
1549 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1552 return ( $return, $cookie, $session ); # return == 'ok' here
1557 my $userid = $query->param('userid');
1558 my $password = $query->param('password');
1559 my ( $return, $cardnumber, $cas_ticket );
1562 if ( $cas && $query->param('PT') ) {
1565 # In case of a CAS authentication, we use the ticket instead of the password
1566 my $PT = $query->param('PT');
1567 ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $PT, $query ); # EXTERNAL AUTH
1570 # User / password auth
1571 unless ( $userid and $password ) {
1573 # caller did something wrong, fail the authenticateion
1574 return ( "failed", undef, undef );
1577 ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $userid, $password, $query );
1580 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1581 my $session = get_session("");
1582 return ( "failed", undef, undef ) unless $session;
1584 my $sessionID = $session->id;
1585 C4::Context->_new_userenv($sessionID);
1586 my $cookie = $query->cookie(
1587 -name => 'CGISESSID',
1588 -value => $sessionID,
1590 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1593 if ( $return == 1 ) {
1595 $borrowernumber, $firstname, $surname,
1596 $userflags, $branchcode, $branchname,
1599 my $dbh = C4::Context->dbh;
1602 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1604 $sth->execute($userid);
1606 $borrowernumber, $firstname, $surname,
1607 $userflags, $branchcode, $branchname,
1609 ) = $sth->fetchrow if ( $sth->rows );
1611 unless ( $sth->rows ) {
1612 my $sth = $dbh->prepare(
1613 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1615 $sth->execute($cardnumber);
1617 $borrowernumber, $firstname, $surname,
1618 $userflags, $branchcode, $branchname,
1620 ) = $sth->fetchrow if ( $sth->rows );
1622 unless ( $sth->rows ) {
1623 $sth->execute($userid);
1625 $borrowernumber, $firstname, $surname, $userflags,
1626 $branchcode, $branchname, $emailaddress
1627 ) = $sth->fetchrow if ( $sth->rows );
1631 my $ip = $ENV{'REMOTE_ADDR'};
1633 # if they specify at login, use that
1634 if ( $query->param('branch') ) {
1635 $branchcode = $query->param('branch');
1636 my $library = Koha::Libraries->find($branchcode);
1637 $branchname = $library? $library->branchname: '';
1639 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search->as_list };
1640 foreach my $br ( keys %$branches ) {
1642 # now we work with the treatment of ip
1643 my $domain = $branches->{$br}->{'branchip'};
1644 if ( $domain && $ip =~ /^$domain/ ) {
1645 $branchcode = $branches->{$br}->{'branchcode'};
1647 # new op dev : add the branchname to the cookie
1648 $branchname = $branches->{$br}->{'branchname'};
1651 $session->param( 'number', $borrowernumber );
1652 $session->param( 'id', $userid );
1653 $session->param( 'cardnumber', $cardnumber );
1654 $session->param( 'firstname', $firstname );
1655 $session->param( 'surname', $surname );
1656 $session->param( 'branch', $branchcode );
1657 $session->param( 'branchname', $branchname );
1658 $session->param( 'flags', $userflags );
1659 $session->param( 'emailaddress', $emailaddress );
1660 $session->param( 'ip', $session->remote_addr() );
1661 $session->param( 'lasttime', time() );
1662 $session->param( 'interface', 'api' );
1664 $session->param( 'cas_ticket', $cas_ticket);
1665 C4::Context->set_userenv(
1666 $session->param('number'), $session->param('id'),
1667 $session->param('cardnumber'), $session->param('firstname'),
1668 $session->param('surname'), $session->param('branch'),
1669 $session->param('branchname'), $session->param('flags'),
1670 $session->param('emailaddress'), $session->param('shibboleth'),
1671 $session->param('desk_id'), $session->param('desk_name'),
1672 $session->param('register_id'), $session->param('register_name')
1674 return ( "ok", $cookie, $sessionID );
1676 return ( "failed", undef, undef );
1681 =head2 check_cookie_auth
1683 ($status, $sessionId) = check_cookie_auth($cookie, $userflags);
1685 Given a CGISESSID cookie set during a previous login to Koha, determine
1686 if the user has the privileges specified by C<$userflags>. C<$userflags>
1687 is passed unaltered into C<haspermission> and as such accepts all options
1688 avaiable to that routine with the one caveat that C<check_api_auth> will
1689 also allow 'undef' to be passed and in such a case the permissions check
1690 will be skipped altogether.
1692 C<check_cookie_auth> is meant for authenticating special services
1693 such as tools/upload-file.pl that are invoked by other pages that
1694 have been authenticated in the usual way.
1696 Possible return values in C<$status> are:
1700 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1702 =item "anon" -- user not authenticated but valid for anonymous session.
1704 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1706 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1708 =item "expired -- session cookie has expired; API user should resubmit userid and password
1710 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1716 sub check_cookie_auth {
1717 my $sessionID = shift;
1718 my $flagsrequired = shift;
1721 my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1723 my $skip_version_check = $params->{skip_version_check}; # Only for checkauth
1725 unless ( $skip_version_check ) {
1726 unless ( C4::Context->preference('Version') ) {
1728 # database has not been installed yet
1729 return ( "maintenance", undef );
1731 my $kohaversion = Koha::version();
1732 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1733 if ( C4::Context->preference('Version') < $kohaversion ) {
1735 # database in need of version update; assume that
1736 # no API should be called while databsae is in
1738 return ( "maintenance", undef );
1742 # see if we have a valid session cookie already
1743 # however, if a userid parameter is present (i.e., from
1744 # a form submission, assume that any current cookie
1746 unless ( $sessionID ) {
1747 return ( "failed", undef );
1749 C4::Context::_unset_userenv($sessionID); # remove old userenv first
1750 my $session = get_session($sessionID);
1752 my $userid = $session->param('id');
1753 my $ip = $session->param('ip');
1754 my $lasttime = $session->param('lasttime');
1755 my $timeout = _timeout_syspref();
1757 if ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
1761 return ("expired", undef);
1763 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1764 # IP address changed
1767 return ( "restricted", undef, { old_ip => $ip, new_ip => $remote_addr});
1769 } elsif ( $userid ) {
1770 $session->param( 'lasttime', time() );
1771 my $patron = Koha::Patrons->find({ userid => $userid });
1772 $patron = Koha::Patron->find({ cardnumber => $userid }) unless $patron;
1773 return ("password_expired", undef ) if $patron->password_expired;
1774 my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1776 C4::Context->_new_userenv($sessionID);
1777 C4::Context->interface($session->param('interface'));
1778 C4::Context->set_userenv(
1779 $session->param('number'), $session->param('id') // '',
1780 $session->param('cardnumber'), $session->param('firstname'),
1781 $session->param('surname'), $session->param('branch'),
1782 $session->param('branchname'), $session->param('flags'),
1783 $session->param('emailaddress'), $session->param('shibboleth'),
1784 $session->param('desk_id'), $session->param('desk_name'),
1785 $session->param('register_id'), $session->param('register_name')
1787 if ( C4::Context->preference('TwoFactorAuthentication') ne 'disabled' ) {
1788 return ( "additional-auth-needed", $session )
1789 if $session->param('waiting-for-2FA');
1791 return ( "setup-additional-auth-needed", $session )
1792 if $session->param('waiting-for-2FA-setup');
1795 return ( "ok", $session );
1799 return ( "failed", undef );
1803 C4::Context->_new_userenv($sessionID);
1804 C4::Context->interface($session->param('interface'));
1805 C4::Context->set_userenv( undef, q{} );
1806 return ( "anon", $session );
1809 return ( "expired", undef );
1816 my $session = get_session($sessionID);
1818 Given a session ID, retrieve the CGI::Session object used to store
1819 the session's state. The session object can be used to store
1820 data that needs to be accessed by different scripts during a
1823 If the C<$sessionID> parameter is an empty string, a new session
1828 sub _get_session_params {
1829 my $storage_method = C4::Context->preference('SessionStorage');
1830 if ( $storage_method eq 'mysql' ) {
1831 my $dbh = C4::Context->dbh;
1832 return { dsn => "serializer:yamlxs;driver:MySQL;id:md5", dsn_args => { Handle => $dbh } };
1834 elsif ( $storage_method eq 'Pg' ) {
1835 my $dbh = C4::Context->dbh;
1836 return { dsn => "serializer:yamlxs;driver:PostgreSQL;id:md5", dsn_args => { Handle => $dbh } };
1838 elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1839 my $memcached = Koha::Caches->get_instance()->memcached_cache;
1840 return { dsn => "serializer:yamlxs;driver:memcached;id:md5", dsn_args => { Memcached => $memcached } };
1843 # catch all defaults to tmp should work on all systems
1844 my $dir = C4::Context::temporary_directory;
1845 my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1846 return { dsn => "serializer:yamlxs;driver:File;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1851 my $sessionID = shift;
1852 my $params = _get_session_params();
1854 if( $sessionID ) { # find existing
1855 CGI::Session::ErrorHandler->set_error( q{} ); # clear error, cpan issue #111463
1856 $session = CGI::Session->load( $params->{dsn}, $sessionID, $params->{dsn_args} );
1858 $session = CGI::Session->new( $params->{dsn}, $sessionID, $params->{dsn_args} );
1859 # no need to flush here
1865 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1866 # (or something similar)
1867 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1868 # not having a userenv defined could cause a crash.
1870 my ( $userid, $password, $query, $type, $no_set_userenv ) = @_;
1871 $type = 'opac' unless $type;
1873 # Get shibboleth login attribute
1874 my $shib = C4::Context->config('useshibboleth') && shib_ok();
1875 my $shib_login = $shib ? get_login_shib() : undef;
1879 if ( defined $userid ){
1880 $patron = Koha::Patrons->find({ userid => $userid });
1881 $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1883 my $check_internal_as_fallback = 0;
1885 # Note: checkpw_* routines returns:
1888 # -1 if user bind failed (LDAP only)
1890 if ( $patron and ( $patron->account_locked ) ) {
1891 # Nothing to check, account is locked
1892 } elsif ($ldap && defined($password)) {
1893 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
1894 if ( $retval == 1 ) {
1895 @return = ( $retval, $retcard, $retuserid );
1898 $check_internal_as_fallback = 1 if $retval == 0;
1900 } elsif ( $cas && $query && $query->param('ticket') ) {
1902 # In case of a CAS authentication, we use the ticket instead of the password
1903 my $ticket = $query->param('ticket');
1904 $query->delete('ticket'); # remove ticket to come back to original URL
1905 my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $ticket, $query, $type ); # EXTERNAL AUTH
1907 @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1911 $passwd_ok = $retval;
1914 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1915 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1917 elsif ( $shib && $shib_login && !$password ) {
1919 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1920 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1921 # shibboleth-authenticated user
1923 # Then, we check if it matches a valid koha user
1925 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
1927 @return = ( $retval, $retcard, $retuserid );
1929 $passwd_ok = $retval;
1932 $check_internal_as_fallback = 1;
1936 if ( $check_internal_as_fallback ) {
1937 @return = checkpw_internal( $userid, $password, $no_set_userenv);
1938 $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1943 $patron->update({ login_attempts => 0 });
1944 if( $patron->password_expired ){
1947 } elsif( !$patron->account_locked ) {
1948 $patron->update({ login_attempts => $patron->login_attempts + 1 });
1952 # Optionally log success or failure
1953 if( $patron && $passwd_ok && C4::Context->preference('AuthSuccessLog') ) {
1954 logaction( 'AUTH', 'SUCCESS', $patron->id, "Valid password for $userid", $type );
1955 } elsif( !$passwd_ok && C4::Context->preference('AuthFailureLog') ) {
1956 logaction( 'AUTH', 'FAILURE', $patron ? $patron->id : 0, "Wrong password for $userid", $type );
1962 sub checkpw_internal {
1963 my ( $userid, $password, $no_set_userenv ) = @_;
1965 $password = Encode::encode( 'UTF-8', $password )
1966 if Encode::is_utf8($password);
1968 my $dbh = C4::Context->dbh;
1971 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1973 $sth->execute($userid);
1975 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1976 $surname, $branchcode, $branchname, $flags )
1979 if ( checkpw_hash( $password, $stored_hash ) ) {
1981 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1982 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1983 return 1, $cardnumber, $userid;
1988 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1990 $sth->execute($userid);
1992 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1993 $surname, $branchcode, $branchname, $flags )
1996 if ( checkpw_hash( $password, $stored_hash ) ) {
1998 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1999 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
2000 return 1, $cardnumber, $userid;
2007 my ( $password, $stored_hash ) = @_;
2009 return if $stored_hash eq '!';
2011 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
2013 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
2014 $hash = hash_password( $password, $stored_hash );
2016 $hash = md5_base64($password);
2018 return $hash eq $stored_hash;
2023 my $authflags = getuserflags($flags, $userid, [$dbh]);
2025 Translates integer flags into permissions strings hash.
2027 C<$flags> is the integer userflags value ( borrowers.userflags )
2028 C<$userid> is the members.userid, used for building subpermissions
2029 C<$authflags> is a hashref of permissions
2036 my $dbh = @_ ? shift : C4::Context->dbh;
2039 # I don't want to do this, but if someone logs in as the database
2040 # user, it would be preferable not to spam them to death with
2041 # numeric warnings. So, we make $flags numeric.
2042 no warnings 'numeric';
2045 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
2048 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
2049 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
2050 $userflags->{$flag} = 1;
2053 $userflags->{$flag} = 0;
2057 # get subpermissions and merge with top-level permissions
2058 my $user_subperms = get_user_subpermissions($userid);
2059 foreach my $module ( keys %$user_subperms ) {
2060 next if $userflags->{$module} == 1; # user already has permission for everything in this module
2061 $userflags->{$module} = $user_subperms->{$module};
2067 =head2 get_user_subpermissions
2069 $user_perm_hashref = get_user_subpermissions($userid);
2071 Given the userid (note, not the borrowernumber) of a staff user,
2072 return a hashref of hashrefs of the specific subpermissions
2073 accorded to the user. An example return is
2077 export_catalog => 1,
2078 import_patrons => 1,
2082 The top-level hash-key is a module or function code from
2083 userflags.flag, while the second-level key is a code
2086 The results of this function do not give a complete picture
2087 of the functions that a staff user can access; it is also
2088 necessary to check borrowers.flags.
2092 sub get_user_subpermissions {
2095 my $dbh = C4::Context->dbh;
2096 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2097 FROM user_permissions
2098 JOIN permissions USING (module_bit, code)
2099 JOIN userflags ON (module_bit = bit)
2100 JOIN borrowers USING (borrowernumber)
2101 WHERE userid = ?" );
2102 $sth->execute($userid);
2104 my $user_perms = {};
2105 while ( my $perm = $sth->fetchrow_hashref ) {
2106 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2111 =head2 get_all_subpermissions
2113 my $perm_hashref = get_all_subpermissions();
2115 Returns a hashref of hashrefs defining all specific
2116 permissions currently defined. The return value
2117 has the same structure as that of C<get_user_subpermissions>,
2118 except that the innermost hash value is the description
2119 of the subpermission.
2123 sub get_all_subpermissions {
2124 my $dbh = C4::Context->dbh;
2125 my $sth = $dbh->prepare( "SELECT flag, code
2127 JOIN userflags ON (module_bit = bit)" );
2131 while ( my $perm = $sth->fetchrow_hashref ) {
2132 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2137 =head2 haspermission
2139 $flagsrequired = '*'; # Any permission at all
2140 $flagsrequired = 'a_flag'; # a_flag must be satisfied (all subpermissions)
2141 $flagsrequired = [ 'a_flag', 'b_flag' ]; # a_flag OR b_flag must be satisfied
2142 $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 }; # a_flag AND b_flag must be satisfied
2143 $flagsrequired = { 'a_flag' => 'sub_a' }; # sub_a of a_flag must be satisfied
2144 $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2146 $flags = ($userid, $flagsrequired);
2148 C<$userid> the userid of the member
2149 C<$flags> is a query structure similar to that used by SQL::Abstract that
2150 denotes the combination of flags required. It is a required parameter.
2152 The main logic of this method is that things in arrays are OR'ed, and things
2153 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2155 Returns member's flags or 0 if a permission is not met.
2160 my ($required, $flags) = @_;
2162 my $ref = ref($required);
2164 if ($required eq '*') {
2165 return 0 unless ( $flags or ref( $flags ) );
2167 return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2169 } elsif ($ref eq 'HASH') {
2170 foreach my $key (keys %{$required}) {
2171 next if $flags == 1;
2172 my $require = $required->{$key};
2173 my $rflags = $flags->{$key};
2174 return 0 unless _dispatch($require, $rflags);
2176 } elsif ($ref eq 'ARRAY') {
2178 foreach my $require ( @{$required} ) {
2180 ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2181 ? $flags->{$require}
2183 $satisfied++ if _dispatch( $require, $rflags );
2185 return 0 unless $satisfied;
2187 croak "Unexpected structure found: $ref";
2194 my ( $userid, $flagsrequired ) = @_;
2196 #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2197 # unless defined($flagsrequired);
2199 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2200 $sth->execute($userid);
2201 my $row = $sth->fetchrow();
2202 my $flags = getuserflags( $row, $userid );
2204 return $flags unless defined($flagsrequired);
2205 return $flags if $flags->{superlibrarian};
2206 return _dispatch($flagsrequired, $flags);
2208 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2213 $flags = ($iprange);
2215 C<$iprange> A space separated string describing an IP range. Can include single IPs or ranges
2217 Returns 1 if the remote address is in the provided iprange, or 0 otherwise.
2224 my @allowedipranges = $iprange ? split(' ', $iprange) : ();
2225 if (scalar @allowedipranges > 0) {
2227 eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2228 eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || Koha::Logger->get->warn('cidrlookup failed for ' . join(' ',@rangelist) );
2230 return $result ? 1 : 0;
2233 sub getborrowernumber {
2235 my $userenv = C4::Context->userenv;
2236 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2237 return $userenv->{number};
2239 my $dbh = C4::Context->dbh;
2240 for my $field ( 'userid', 'cardnumber' ) {
2242 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2243 $sth->execute($userid);
2245 my ($bnumber) = $sth->fetchrow;
2252 =head2 track_login_daily
2254 track_login_daily( $userid );
2256 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2260 sub track_login_daily {
2262 return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2264 my $cache = Koha::Caches->get_instance();
2265 my $cache_key = "track_login_" . $userid;
2266 my $cached = $cache->get_from_cache($cache_key);
2267 my $today = dt_from_string()->ymd;
2268 return if $cached && $cached eq $today;
2270 my $patron = Koha::Patrons->find({ userid => $userid });
2271 return unless $patron;
2272 $patron->track_login;
2273 $cache->set_in_cache( $cache_key, $today );
2276 END { } # module clean-up code here (global destructor)
2286 Crypt::Eksblowfish::Bcrypt(3)