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->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 );
879 # This is an ugly trick to pass the test
880 # $query->param('koha_login_context') && ( $q_userid ne $userid )
885 $invalid_otp_token = 1;
889 if ( $auth_state eq 'completed' ) {
890 Koha::Logger->get->debug(sprintf "AUTH_SESSION: (%s)\t%s %s - %s", map { $session->param($_) || q{} } qw(cardnumber firstname surname branch));
892 if ( ( $query->param('koha_login_context') && ( $q_userid ne $userid ) )
893 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
894 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
897 #if a user enters an id ne to the id in the current session, we need to log them in...
898 #first we need to clear the anonymous session...
899 $anon_search_history = $session->param('search_history');
902 $cookie = $cookie_mgr->clear_unless( $query->cookie, @$cookie );
903 C4::Context::_unset_userenv($sessionID);
907 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
908 -name => 'CGISESSID',
909 -value => $session->id,
911 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
915 $flags = haspermission( $userid, $flagsrequired );
917 $auth_state = 'failed';
918 $info{'nopermission'} = 1;
921 } elsif ( !$logout ) {
922 if ( $return eq 'expired' ) {
923 $info{timed_out} = 1;
924 } elsif ( $return eq 'restricted' ) {
925 $info{oldip} = $more_info->{old_ip};
926 $info{newip} = $more_info->{new_ip};
927 $info{different_ip} = 1;
928 } elsif ( $return eq 'password_expired' ) {
929 $info{password_has_expired} = 1;
934 if ( $auth_state eq 'failed' || $logout ) {
941 # voluntary logout the user
942 # check wether the user was using their shibboleth session or a local one
943 my $shibSuccess = C4::Context->userenv ? C4::Context->userenv->{'shibboleth'} : undef;
948 C4::Context::_unset_userenv($sessionID);
949 $cookie = $cookie_mgr->clear_unless( $query->cookie, @$cookie );
951 if ($cas and $caslogout) {
952 logout_cas($query, $type);
955 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
956 if ( $shib and $shib_login and $shibSuccess) {
961 $auth_state = 'logout';
965 #we initiate a session prior to checking for a username to allow for anonymous sessions...
966 if( !$session or !$sessionID ) { # if we cleared sessionID, we need a new session
967 $session = get_session() or die "Auth ERROR: Cannot get_session()";
970 # Save anonymous search history in new session so it can be retrieved
971 # by get_template_and_user to store it in user's search history after
972 # a successful login.
973 if ($anon_search_history) {
974 $session->param( 'search_history', $anon_search_history );
977 $sessionID = $session->id;
978 C4::Context->_new_userenv($sessionID);
979 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
980 -name => 'CGISESSID',
981 -value => $sessionID,
983 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
986 my $pki_field = C4::Context->preference('AllowPKIAuth');
987 if ( !defined($pki_field) ) {
988 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
991 if ( ( $cas && $query->param('ticket') )
993 || ( $shib && $shib_login )
994 || $pki_field ne 'None'
997 my $password = $query->param('password');
999 my ( $return, $cardnumber );
1001 # If shib is enabled and we have a shib login, does the login match a valid koha user
1002 if ( $shib && $shib_login ) {
1005 # Do not pass password here, else shib will not be checked in checkpw.
1006 ( $return, $cardnumber, $retuserid ) = checkpw( $q_userid, undef, $query );
1007 $userid = $retuserid;
1008 $shibSuccess = $return;
1009 $info{'invalidShibLogin'} = 1 unless ($return);
1012 # If shib login and match were successful, skip further login methods
1013 unless ($shibSuccess) {
1014 if ( $cas && $query->param('ticket') ) {
1016 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1017 checkpw( $userid, $password, $query, $type );
1018 $userid = $retuserid;
1019 $info{'invalidCasLogin'} = 1 unless ($return);
1022 elsif ( $emailaddress ) {
1023 my $value = $emailaddress;
1025 # If we're looking up the email, there's a chance that the person
1026 # doesn't have a userid. So if there is none, we pass along the
1027 # borrower number, and the bits of code that need to know the user
1028 # ID will have to be smart enough to handle that.
1029 my $patrons = Koha::Patrons->search({ email => $value });
1030 if ($patrons->count) {
1032 # First the userid, then the borrowernum
1033 my $patron = $patrons->next;
1034 $value = $patron->userid || $patron->borrowernumber;
1038 $return = $value ? 1 : 0;
1043 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1044 || ( $pki_field eq 'emailAddress'
1045 && $ENV{'SSL_CLIENT_S_DN_Email'} )
1049 if ( $pki_field eq 'Common Name' ) {
1050 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1052 elsif ( $pki_field eq 'emailAddress' ) {
1053 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1055 # If we're looking up the email, there's a chance that the person
1056 # doesn't have a userid. So if there is none, we pass along the
1057 # borrower number, and the bits of code that need to know the user
1058 # ID will have to be smart enough to handle that.
1059 my $patrons = Koha::Patrons->search({ email => $value });
1060 if ($patrons->count) {
1062 # First the userid, then the borrowernum
1063 my $patron = $patrons->next;
1064 $value = $patron->userid || $patron->borrowernumber;
1070 $return = $value ? 1 : 0;
1076 my $request_method = $query->request_method // q{};
1079 $request_method eq 'POST'
1080 || ( C4::Context->preference('AutoSelfCheckID')
1081 && $q_userid eq C4::Context->preference('AutoSelfCheckID') )
1085 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1086 checkpw( $q_userid, $password, $query, $type );
1087 $userid = $retuserid if ($retuserid);
1088 $info{'invalid_username_or_password'} = 1 unless ($return);
1093 # If shib configured and shibOnly enabled, we should ignore anything other than a shibboleth type login.
1100 && C4::Context->preference('OPACShibOnly')
1102 || ( ( $type ne 'opac' )
1103 && C4::Context->preference('staffShibOnly') )
1110 # $return: 1 = valid user
1111 if( $return && $return > 0 ) {
1113 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1114 $auth_state = "logged_in";
1117 $info{'nopermission'} = 1;
1118 C4::Context::_unset_userenv($sessionID);
1120 my ( $borrowernumber, $firstname, $surname, $userflags,
1121 $branchcode, $branchname, $emailaddress, $desk_id,
1122 $desk_name, $register_id, $register_name );
1124 if ( $return == 1 ) {
1126 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1127 branches.branchname as branchname, email
1129 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1131 my $dbh = C4::Context->dbh;
1132 my $sth = $dbh->prepare("$select where userid=?");
1133 $sth->execute($userid);
1134 unless ( $sth->rows ) {
1135 $sth = $dbh->prepare("$select where cardnumber=?");
1136 $sth->execute($cardnumber);
1138 unless ( $sth->rows ) {
1139 $sth->execute($userid);
1143 ( $borrowernumber, $firstname, $surname, $userflags,
1144 $branchcode, $branchname, $emailaddress ) = $sth->fetchrow;
1147 # launch a sequence to check if we have a ip for the branch, i
1148 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1150 my $ip = $ENV{'REMOTE_ADDR'};
1152 # if they specify at login, use that
1153 if ( $query->param('branch') ) {
1154 $branchcode = $query->param('branch');
1155 my $library = Koha::Libraries->find($branchcode);
1156 $branchname = $library? $library->branchname: '';
1158 if ( $query->param('desk_id') ) {
1159 $desk_id = $query->param('desk_id');
1160 my $desk = Koha::Desks->find($desk_id);
1161 $desk_name = $desk ? $desk->desk_name : '';
1163 if ( C4::Context->preference('UseCashRegisters') ) {
1165 $query->param('register_id')
1166 ? Koha::Cash::Registers->find($query->param('register_id'))
1167 : Koha::Cash::Registers->search(
1168 { branch => $branchcode, branch_default => 1 },
1169 { rows => 1 } )->single;
1170 $register_id = $register->id if ($register);
1171 $register_name = $register->name if ($register);
1173 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search->as_list };
1174 if ( $type ne 'opac' and C4::Context->preference('AutoLocation') ) {
1176 # we have to check they are coming from the right ip range
1177 my $domain = $branches->{$branchcode}->{'branchip'};
1178 $domain =~ s|\.\*||g;
1179 if ( $ip !~ /^$domain/ ) {
1181 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
1182 -name => 'CGISESSID',
1185 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1188 $info{'wrongip'} = 1;
1192 foreach my $br ( keys %$branches ) {
1194 # now we work with the treatment of ip
1195 my $domain = $branches->{$br}->{'branchip'};
1196 if ( $domain && $ip =~ /^$domain/ ) {
1197 $branchcode = $branches->{$br}->{'branchcode'};
1199 # new op dev : add the branchname to the cookie
1200 $branchname = $branches->{$br}->{'branchname'};
1204 my $is_sco_user = 0;
1205 if ( $query->param('sco_user_login') && ( $query->param('sco_user_login') eq '1' ) ){
1209 $session->param( 'number', $borrowernumber );
1210 $session->param( 'id', $userid );
1211 $session->param( 'cardnumber', $cardnumber );
1212 $session->param( 'firstname', $firstname );
1213 $session->param( 'surname', $surname );
1214 $session->param( 'branch', $branchcode );
1215 $session->param( 'branchname', $branchname );
1216 $session->param( 'desk_id', $desk_id);
1217 $session->param( 'desk_name', $desk_name);
1218 $session->param( 'flags', $userflags );
1219 $session->param( 'emailaddress', $emailaddress );
1220 $session->param( 'ip', $session->remote_addr() );
1221 $session->param( 'lasttime', time() );
1222 $session->param( 'interface', $type);
1223 $session->param( 'shibboleth', $shibSuccess );
1224 $session->param( 'register_id', $register_id );
1225 $session->param( 'register_name', $register_name );
1226 $session->param( 'sco_user', $is_sco_user );
1228 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1229 C4::Context->set_userenv(
1230 $session->param('number'), $session->param('id'),
1231 $session->param('cardnumber'), $session->param('firstname'),
1232 $session->param('surname'), $session->param('branch'),
1233 $session->param('branchname'), $session->param('flags'),
1234 $session->param('emailaddress'), $session->param('shibboleth'),
1235 $session->param('desk_id'), $session->param('desk_name'),
1236 $session->param('register_id'), $session->param('register_name')
1240 # $return: 0 = invalid user
1241 # reset to anonymous session
1244 $info{'invalid_username_or_password'} = 1;
1245 C4::Context::_unset_userenv($sessionID);
1247 $session->param( 'lasttime', time() );
1248 $session->param( 'ip', $session->remote_addr() );
1249 $session->param( 'sessiontype', 'anon' );
1250 $session->param( 'interface', $type);
1252 } # END if ( $q_userid
1253 elsif ( $type eq "opac" ) {
1255 # anonymous sessions are created only for the OPAC
1257 # setting a couple of other session vars...
1258 $session->param( 'ip', $session->remote_addr() );
1259 $session->param( 'lasttime', time() );
1260 $session->param( 'sessiontype', 'anon' );
1261 $session->param( 'interface', $type);
1264 } # END unless ($userid)
1267 if ( $auth_state eq 'logged_in' ) {
1268 $auth_state = 'completed';
1270 # Auth is completed unless an additional auth is needed
1271 if ( $require_2FA ) {
1272 my $patron = Koha::Patrons->find({userid => $userid});
1273 if ( C4::Context->preference('TwoFactorAuthentication') eq "enforced" && $patron->auth_method eq 'password' ) {
1274 $auth_state = 'setup-additional-auth-needed';
1275 $session->param('waiting-for-2FA-setup', 1);
1276 %info = ();# We remove the warnings/errors we may have set incorrectly before
1277 } elsif ( $patron->auth_method eq 'two-factor' ) {
1278 # Ask for the OTP token
1279 $auth_state = 'additional-auth-needed';
1280 $session->param('waiting-for-2FA', 1);
1281 %info = ();# We remove the warnings/errors we may have set incorrectly before
1286 # finished authentification, now respond
1287 if ( $auth_state eq 'completed' || $authnotrequired ) {
1290 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
1291 -name => 'CGISESSID',
1294 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1299 track_login_daily( $userid );
1301 # In case, that this request was a login attempt, we want to prevent that users can repost the opac login
1302 # request. We therefore redirect the user to the requested page again without the login parameters.
1303 # See Post/Redirect/Get (PRG) design pattern: https://en.wikipedia.org/wiki/Post/Redirect/Get
1304 if ( $type eq "opac" && $query->param('koha_login_context') && $query->param('koha_login_context') ne 'sco' && $query->param('password') && $query->param('userid') ) {
1305 my $uri = URI->new($query->url(-relative=>1, -query_string=>1));
1306 $uri->query_param_delete('userid');
1307 $uri->query_param_delete('password');
1308 $uri->query_param_delete('koha_login_context');
1309 print $query->redirect(-uri => $uri->as_string, -cookie => $cookie, -status=>'303 See other');
1313 return ( $userid, $cookie, $sessionID, $flags );
1318 # AUTH rejected, show the login/password template, after checking the DB.
1322 my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1324 # get the inputs from the incoming query
1326 my @inputs_to_clean = qw( userid password ticket logout.x otp_token );
1327 foreach my $name ( param $query) {
1328 next if grep { $name eq $_ } @inputs_to_clean;
1329 my @value = $query->multi_param($name);
1330 push @inputs, { name => $name, value => $_ } for @value;
1333 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1334 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1335 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1337 my $auth_template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1338 my $template = C4::Templates::gettemplate( $auth_template_name, $type, $query );
1342 script_name => get_script_name(),
1343 casAuthentication => C4::Context->preference("casAuthentication"),
1344 shibbolethAuthentication => $shib,
1345 suggestion => C4::Context->preference("suggestion"),
1346 virtualshelves => C4::Context->preference("virtualshelves"),
1347 LibraryName => "" . C4::Context->preference("LibraryName"),
1348 LibraryNameTitle => "" . $LibraryNameTitle,
1349 opacuserlogin => C4::Context->preference("opacuserlogin"),
1350 OpacFavicon => C4::Context->preference("OpacFavicon"),
1351 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1352 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1353 OPACUserJS => C4::Context->preference("OPACUserJS"),
1354 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1355 OpacCloud => C4::Context->preference("OpacCloud"),
1356 OpacTopissue => C4::Context->preference("OpacTopissue"),
1357 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1358 OpacBrowser => C4::Context->preference("OpacBrowser"),
1359 TagsEnabled => C4::Context->preference("TagsEnabled"),
1360 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1361 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1362 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1363 IntranetNav => C4::Context->preference("IntranetNav"),
1364 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1365 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
1366 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1367 IndependentBranches => C4::Context->preference("IndependentBranches"),
1368 AutoLocation => C4::Context->preference("AutoLocation"),
1369 wrongip => $info{'wrongip'},
1370 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1371 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1372 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1373 too_many_login_attempts => ( $patron and $patron->account_locked ),
1374 password_has_expired => ( $patron and $patron->password_expired ),
1377 $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1378 $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1379 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1380 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1381 if ( $auth_state eq 'additional-auth-needed' ) {
1382 my $patron = Koha::Patrons->find( { userid => $userid } );
1385 invalid_otp_token => $invalid_otp_token,
1386 notice_email_address => $patron->notice_email_address, # We could also pass logged_in_user if necessary
1390 if ( $auth_state eq 'setup-additional-auth-needed' ) {
1396 if ( $type eq 'opac' ) {
1397 require Koha::Virtualshelves;
1398 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1404 some_public_shelves => $some_public_shelves,
1410 # Is authentication against multiple CAS servers enabled?
1411 require C4::Auth_with_cas;
1412 if ( multipleAuth() && !$casparam ) {
1413 my $casservers = getMultipleAuth();
1415 foreach my $key ( keys %$casservers ) {
1416 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1419 casServersLoop => \@tmplservers
1423 casServerUrl => login_cas_url($query, undef, $type),
1428 invalidCasLogin => $info{'invalidCasLogin'}
1433 #If shibOnly is enabled just go ahead and redirect directly
1434 if ( (($type eq 'opac') && C4::Context->preference('OPACShibOnly')) || (($type ne 'opac') && C4::Context->preference('staffShibOnly')) ) {
1435 my $redirect_url = login_shib_url( $query );
1436 print $query->redirect( -uri => "$redirect_url", -status => 303 );
1441 shibbolethAuthentication => $shib,
1442 shibbolethLoginUrl => login_shib_url($query),
1446 if (C4::Context->preference('GoogleOpenIDConnect')) {
1447 if ($query->param("OpenIDConnectFailed")) {
1448 my $reason = $query->param('OpenIDConnectFailed');
1449 $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1454 LibraryName => C4::Context->preference("LibraryName"),
1456 $template->param(%info);
1458 # $cookie = $query->cookie(CGISESSID => $session->id
1460 print $query->header(
1461 { type => 'text/html',
1464 'X-Frame-Options' => 'SAMEORIGIN',
1472 =head2 check_api_auth
1474 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1476 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1477 cookie, determine if the user has the privileges specified by C<$userflags>.
1479 C<check_api_auth> is is meant for authenticating users of web services, and
1480 consequently will always return and will not attempt to redirect the user
1483 If a valid session cookie is already present, check_api_auth will return a status
1484 of "ok", the cookie, and the Koha session ID.
1486 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1487 parameters and create a session cookie and Koha session if the supplied credentials
1490 Possible return values in C<$status> are:
1494 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1496 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1498 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1500 =item "expired -- session cookie has expired; API user should resubmit userid and password
1502 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1504 =item "additional-auth-needed -- User is in an authentication process that is not finished
1510 sub check_api_auth {
1513 my $flagsrequired = shift;
1514 my $timeout = _timeout_syspref();
1516 unless ( C4::Context->preference('Version') ) {
1518 # database has not been installed yet
1519 return ( "maintenance", undef, undef );
1521 my $kohaversion = Koha::version();
1522 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1523 if ( C4::Context->preference('Version') < $kohaversion ) {
1525 # database in need of version update; assume that
1526 # no API should be called while databsae is in
1528 return ( "maintenance", undef, undef );
1531 my ( $sessionID, $session );
1532 unless ( $query->param('userid') ) {
1533 $sessionID = $query->cookie("CGISESSID");
1535 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1538 ( $return, $session, undef ) = check_cookie_auth(
1539 $sessionID, $flagsrequired, { remote_addr => $ENV{REMOTE_ADDR} } );
1541 return ( $return, undef, undef ) # Cookie auth failed
1544 my $cookie = $query->cookie(
1545 -name => 'CGISESSID',
1546 -value => $session->id,
1548 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1551 return ( $return, $cookie, $session ); # return == 'ok' here
1556 my $userid = $query->param('userid');
1557 my $password = $query->param('password');
1558 my ( $return, $cardnumber, $cas_ticket );
1561 if ( $cas && $query->param('PT') ) {
1564 # In case of a CAS authentication, we use the ticket instead of the password
1565 my $PT = $query->param('PT');
1566 ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $PT, $query ); # EXTERNAL AUTH
1569 # User / password auth
1570 unless ( $userid and $password ) {
1572 # caller did something wrong, fail the authenticateion
1573 return ( "failed", undef, undef );
1576 ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $userid, $password, $query );
1579 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1580 my $session = get_session("");
1581 return ( "failed", undef, undef ) unless $session;
1583 my $sessionID = $session->id;
1584 C4::Context->_new_userenv($sessionID);
1585 my $cookie = $query->cookie(
1586 -name => 'CGISESSID',
1587 -value => $sessionID,
1589 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1592 if ( $return == 1 ) {
1594 $borrowernumber, $firstname, $surname,
1595 $userflags, $branchcode, $branchname,
1598 my $dbh = C4::Context->dbh;
1601 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1603 $sth->execute($userid);
1605 $borrowernumber, $firstname, $surname,
1606 $userflags, $branchcode, $branchname,
1608 ) = $sth->fetchrow if ( $sth->rows );
1610 unless ( $sth->rows ) {
1611 my $sth = $dbh->prepare(
1612 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1614 $sth->execute($cardnumber);
1616 $borrowernumber, $firstname, $surname,
1617 $userflags, $branchcode, $branchname,
1619 ) = $sth->fetchrow if ( $sth->rows );
1621 unless ( $sth->rows ) {
1622 $sth->execute($userid);
1624 $borrowernumber, $firstname, $surname, $userflags,
1625 $branchcode, $branchname, $emailaddress
1626 ) = $sth->fetchrow if ( $sth->rows );
1630 my $ip = $ENV{'REMOTE_ADDR'};
1632 # if they specify at login, use that
1633 if ( $query->param('branch') ) {
1634 $branchcode = $query->param('branch');
1635 my $library = Koha::Libraries->find($branchcode);
1636 $branchname = $library? $library->branchname: '';
1638 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search->as_list };
1639 foreach my $br ( keys %$branches ) {
1641 # now we work with the treatment of ip
1642 my $domain = $branches->{$br}->{'branchip'};
1643 if ( $domain && $ip =~ /^$domain/ ) {
1644 $branchcode = $branches->{$br}->{'branchcode'};
1646 # new op dev : add the branchname to the cookie
1647 $branchname = $branches->{$br}->{'branchname'};
1650 $session->param( 'number', $borrowernumber );
1651 $session->param( 'id', $userid );
1652 $session->param( 'cardnumber', $cardnumber );
1653 $session->param( 'firstname', $firstname );
1654 $session->param( 'surname', $surname );
1655 $session->param( 'branch', $branchcode );
1656 $session->param( 'branchname', $branchname );
1657 $session->param( 'flags', $userflags );
1658 $session->param( 'emailaddress', $emailaddress );
1659 $session->param( 'ip', $session->remote_addr() );
1660 $session->param( 'lasttime', time() );
1661 $session->param( 'interface', 'api' );
1663 $session->param( 'cas_ticket', $cas_ticket);
1664 C4::Context->set_userenv(
1665 $session->param('number'), $session->param('id'),
1666 $session->param('cardnumber'), $session->param('firstname'),
1667 $session->param('surname'), $session->param('branch'),
1668 $session->param('branchname'), $session->param('flags'),
1669 $session->param('emailaddress'), $session->param('shibboleth'),
1670 $session->param('desk_id'), $session->param('desk_name'),
1671 $session->param('register_id'), $session->param('register_name')
1673 return ( "ok", $cookie, $sessionID );
1675 return ( "failed", undef, undef );
1680 =head2 check_cookie_auth
1682 ($status, $sessionId) = check_cookie_auth($cookie, $userflags);
1684 Given a CGISESSID cookie set during a previous login to Koha, determine
1685 if the user has the privileges specified by C<$userflags>. C<$userflags>
1686 is passed unaltered into C<haspermission> and as such accepts all options
1687 avaiable to that routine with the one caveat that C<check_api_auth> will
1688 also allow 'undef' to be passed and in such a case the permissions check
1689 will be skipped altogether.
1691 C<check_cookie_auth> is meant for authenticating special services
1692 such as tools/upload-file.pl that are invoked by other pages that
1693 have been authenticated in the usual way.
1695 Possible return values in C<$status> are:
1699 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1701 =item "anon" -- user not authenticated but valid for anonymous session.
1703 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1705 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1707 =item "expired -- session cookie has expired; API user should resubmit userid and password
1709 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1715 sub check_cookie_auth {
1716 my $sessionID = shift;
1717 my $flagsrequired = shift;
1720 my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1722 my $skip_version_check = $params->{skip_version_check}; # Only for checkauth
1724 unless ( $skip_version_check ) {
1725 unless ( C4::Context->preference('Version') ) {
1727 # database has not been installed yet
1728 return ( "maintenance", undef );
1730 my $kohaversion = Koha::version();
1731 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1732 if ( C4::Context->preference('Version') < $kohaversion ) {
1734 # database in need of version update; assume that
1735 # no API should be called while databsae is in
1737 return ( "maintenance", undef );
1741 # see if we have a valid session cookie already
1742 # however, if a userid parameter is present (i.e., from
1743 # a form submission, assume that any current cookie
1745 unless ( $sessionID ) {
1746 return ( "failed", undef );
1748 C4::Context::_unset_userenv($sessionID); # remove old userenv first
1749 my $session = get_session($sessionID);
1751 my $userid = $session->param('id');
1752 my $ip = $session->param('ip');
1753 my $lasttime = $session->param('lasttime');
1754 my $timeout = _timeout_syspref();
1756 if ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
1760 return ("expired", undef);
1762 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1763 # IP address changed
1766 return ( "restricted", undef, { old_ip => $ip, new_ip => $remote_addr});
1768 } elsif ( $userid ) {
1769 $session->param( 'lasttime', time() );
1770 my $patron = Koha::Patrons->find({ userid => $userid });
1771 $patron = Koha::Patron->find({ cardnumber => $userid }) unless $patron;
1772 return ("password_expired", undef ) if $patron->password_expired;
1773 my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1775 C4::Context->_new_userenv($sessionID);
1776 C4::Context->interface($session->param('interface'));
1777 C4::Context->set_userenv(
1778 $session->param('number'), $session->param('id') // '',
1779 $session->param('cardnumber'), $session->param('firstname'),
1780 $session->param('surname'), $session->param('branch'),
1781 $session->param('branchname'), $session->param('flags'),
1782 $session->param('emailaddress'), $session->param('shibboleth'),
1783 $session->param('desk_id'), $session->param('desk_name'),
1784 $session->param('register_id'), $session->param('register_name')
1786 return ( "additional-auth-needed", $session )
1787 if $session->param('waiting-for-2FA');
1789 return ( "setup-additional-auth-needed", $session )
1790 if $session->param('waiting-for-2FA-setup');
1792 return ( "ok", $session );
1796 return ( "failed", undef );
1800 C4::Context->_new_userenv($sessionID);
1801 C4::Context->interface($session->param('interface'));
1802 C4::Context->set_userenv( undef, q{} );
1803 return ( "anon", $session );
1806 return ( "expired", undef );
1813 my $session = get_session($sessionID);
1815 Given a session ID, retrieve the CGI::Session object used to store
1816 the session's state. The session object can be used to store
1817 data that needs to be accessed by different scripts during a
1820 If the C<$sessionID> parameter is an empty string, a new session
1825 sub _get_session_params {
1826 my $storage_method = C4::Context->preference('SessionStorage');
1827 if ( $storage_method eq 'mysql' ) {
1828 my $dbh = C4::Context->dbh;
1829 return { dsn => "serializer:yamlxs;driver:MySQL;id:md5", dsn_args => { Handle => $dbh } };
1831 elsif ( $storage_method eq 'Pg' ) {
1832 my $dbh = C4::Context->dbh;
1833 return { dsn => "serializer:yamlxs;driver:PostgreSQL;id:md5", dsn_args => { Handle => $dbh } };
1835 elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1836 my $memcached = Koha::Caches->get_instance()->memcached_cache;
1837 return { dsn => "serializer:yamlxs;driver:memcached;id:md5", dsn_args => { Memcached => $memcached } };
1840 # catch all defaults to tmp should work on all systems
1841 my $dir = C4::Context::temporary_directory;
1842 my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1843 return { dsn => "serializer:yamlxs;driver:File;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1848 my $sessionID = shift;
1849 my $params = _get_session_params();
1851 if( $sessionID ) { # find existing
1852 CGI::Session::ErrorHandler->set_error( q{} ); # clear error, cpan issue #111463
1853 $session = CGI::Session->load( $params->{dsn}, $sessionID, $params->{dsn_args} );
1855 $session = CGI::Session->new( $params->{dsn}, $sessionID, $params->{dsn_args} );
1856 # no need to flush here
1862 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1863 # (or something similar)
1864 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1865 # not having a userenv defined could cause a crash.
1867 my ( $userid, $password, $query, $type, $no_set_userenv ) = @_;
1868 $type = 'opac' unless $type;
1870 # Get shibboleth login attribute
1871 my $shib = C4::Context->config('useshibboleth') && shib_ok();
1872 my $shib_login = $shib ? get_login_shib() : undef;
1876 if ( defined $userid ){
1877 $patron = Koha::Patrons->find({ userid => $userid });
1878 $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1880 my $check_internal_as_fallback = 0;
1882 # Note: checkpw_* routines returns:
1885 # -1 if user bind failed (LDAP only)
1887 if ( $patron and ( $patron->account_locked ) ) {
1888 # Nothing to check, account is locked
1889 } elsif ($ldap && defined($password)) {
1890 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
1891 if ( $retval == 1 ) {
1892 @return = ( $retval, $retcard, $retuserid );
1895 $check_internal_as_fallback = 1 if $retval == 0;
1897 } elsif ( $cas && $query && $query->param('ticket') ) {
1899 # In case of a CAS authentication, we use the ticket instead of the password
1900 my $ticket = $query->param('ticket');
1901 $query->delete('ticket'); # remove ticket to come back to original URL
1902 my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $ticket, $query, $type ); # EXTERNAL AUTH
1904 @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1908 $passwd_ok = $retval;
1911 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1912 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1914 elsif ( $shib && $shib_login && !$password ) {
1916 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1917 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1918 # shibboleth-authenticated user
1920 # Then, we check if it matches a valid koha user
1922 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
1924 @return = ( $retval, $retcard, $retuserid );
1926 $passwd_ok = $retval;
1929 $check_internal_as_fallback = 1;
1933 if ( $check_internal_as_fallback ) {
1934 @return = checkpw_internal( $userid, $password, $no_set_userenv);
1935 $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1940 $patron->update({ login_attempts => 0 });
1941 if( $patron->password_expired ){
1944 } elsif( !$patron->account_locked ) {
1945 $patron->update({ login_attempts => $patron->login_attempts + 1 });
1949 # Optionally log success or failure
1950 if( $patron && $passwd_ok && C4::Context->preference('AuthSuccessLog') ) {
1951 logaction( 'AUTH', 'SUCCESS', $patron->id, "Valid password for $userid", $type );
1952 } elsif( !$passwd_ok && C4::Context->preference('AuthFailureLog') ) {
1953 logaction( 'AUTH', 'FAILURE', $patron ? $patron->id : 0, "Wrong password for $userid", $type );
1959 sub checkpw_internal {
1960 my ( $userid, $password, $no_set_userenv ) = @_;
1962 $password = Encode::encode( 'UTF-8', $password )
1963 if Encode::is_utf8($password);
1965 my $dbh = C4::Context->dbh;
1968 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1970 $sth->execute($userid);
1972 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1973 $surname, $branchcode, $branchname, $flags )
1976 if ( checkpw_hash( $password, $stored_hash ) ) {
1978 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1979 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1980 return 1, $cardnumber, $userid;
1985 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1987 $sth->execute($userid);
1989 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1990 $surname, $branchcode, $branchname, $flags )
1993 if ( checkpw_hash( $password, $stored_hash ) ) {
1995 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1996 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1997 return 1, $cardnumber, $userid;
2004 my ( $password, $stored_hash ) = @_;
2006 return if $stored_hash eq '!';
2008 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
2010 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
2011 $hash = hash_password( $password, $stored_hash );
2013 $hash = md5_base64($password);
2015 return $hash eq $stored_hash;
2020 my $authflags = getuserflags($flags, $userid, [$dbh]);
2022 Translates integer flags into permissions strings hash.
2024 C<$flags> is the integer userflags value ( borrowers.userflags )
2025 C<$userid> is the members.userid, used for building subpermissions
2026 C<$authflags> is a hashref of permissions
2033 my $dbh = @_ ? shift : C4::Context->dbh;
2036 # I don't want to do this, but if someone logs in as the database
2037 # user, it would be preferable not to spam them to death with
2038 # numeric warnings. So, we make $flags numeric.
2039 no warnings 'numeric';
2042 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
2045 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
2046 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
2047 $userflags->{$flag} = 1;
2050 $userflags->{$flag} = 0;
2054 # get subpermissions and merge with top-level permissions
2055 my $user_subperms = get_user_subpermissions($userid);
2056 foreach my $module ( keys %$user_subperms ) {
2057 next if $userflags->{$module} == 1; # user already has permission for everything in this module
2058 $userflags->{$module} = $user_subperms->{$module};
2064 =head2 get_user_subpermissions
2066 $user_perm_hashref = get_user_subpermissions($userid);
2068 Given the userid (note, not the borrowernumber) of a staff user,
2069 return a hashref of hashrefs of the specific subpermissions
2070 accorded to the user. An example return is
2074 export_catalog => 1,
2075 import_patrons => 1,
2079 The top-level hash-key is a module or function code from
2080 userflags.flag, while the second-level key is a code
2083 The results of this function do not give a complete picture
2084 of the functions that a staff user can access; it is also
2085 necessary to check borrowers.flags.
2089 sub get_user_subpermissions {
2092 my $dbh = C4::Context->dbh;
2093 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2094 FROM user_permissions
2095 JOIN permissions USING (module_bit, code)
2096 JOIN userflags ON (module_bit = bit)
2097 JOIN borrowers USING (borrowernumber)
2098 WHERE userid = ?" );
2099 $sth->execute($userid);
2101 my $user_perms = {};
2102 while ( my $perm = $sth->fetchrow_hashref ) {
2103 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2108 =head2 get_all_subpermissions
2110 my $perm_hashref = get_all_subpermissions();
2112 Returns a hashref of hashrefs defining all specific
2113 permissions currently defined. The return value
2114 has the same structure as that of C<get_user_subpermissions>,
2115 except that the innermost hash value is the description
2116 of the subpermission.
2120 sub get_all_subpermissions {
2121 my $dbh = C4::Context->dbh;
2122 my $sth = $dbh->prepare( "SELECT flag, code
2124 JOIN userflags ON (module_bit = bit)" );
2128 while ( my $perm = $sth->fetchrow_hashref ) {
2129 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2134 =head2 haspermission
2136 $flagsrequired = '*'; # Any permission at all
2137 $flagsrequired = 'a_flag'; # a_flag must be satisfied (all subpermissions)
2138 $flagsrequired = [ 'a_flag', 'b_flag' ]; # a_flag OR b_flag must be satisfied
2139 $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 }; # a_flag AND b_flag must be satisfied
2140 $flagsrequired = { 'a_flag' => 'sub_a' }; # sub_a of a_flag must be satisfied
2141 $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2143 $flags = ($userid, $flagsrequired);
2145 C<$userid> the userid of the member
2146 C<$flags> is a query structure similar to that used by SQL::Abstract that
2147 denotes the combination of flags required. It is a required parameter.
2149 The main logic of this method is that things in arrays are OR'ed, and things
2150 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2152 Returns member's flags or 0 if a permission is not met.
2157 my ($required, $flags) = @_;
2159 my $ref = ref($required);
2161 if ($required eq '*') {
2162 return 0 unless ( $flags or ref( $flags ) );
2164 return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2166 } elsif ($ref eq 'HASH') {
2167 foreach my $key (keys %{$required}) {
2168 next if $flags == 1;
2169 my $require = $required->{$key};
2170 my $rflags = $flags->{$key};
2171 return 0 unless _dispatch($require, $rflags);
2173 } elsif ($ref eq 'ARRAY') {
2175 foreach my $require ( @{$required} ) {
2177 ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2178 ? $flags->{$require}
2180 $satisfied++ if _dispatch( $require, $rflags );
2182 return 0 unless $satisfied;
2184 croak "Unexpected structure found: $ref";
2191 my ( $userid, $flagsrequired ) = @_;
2193 #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2194 # unless defined($flagsrequired);
2196 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2197 $sth->execute($userid);
2198 my $row = $sth->fetchrow();
2199 my $flags = getuserflags( $row, $userid );
2201 return $flags unless defined($flagsrequired);
2202 return $flags if $flags->{superlibrarian};
2203 return _dispatch($flagsrequired, $flags);
2205 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2210 $flags = ($iprange);
2212 C<$iprange> A space separated string describing an IP range. Can include single IPs or ranges
2214 Returns 1 if the remote address is in the provided iprange, or 0 otherwise.
2221 my @allowedipranges = $iprange ? split(' ', $iprange) : ();
2222 if (scalar @allowedipranges > 0) {
2224 eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2225 eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || Koha::Logger->get->warn('cidrlookup failed for ' . join(' ',@rangelist) );
2227 return $result ? 1 : 0;
2230 sub getborrowernumber {
2232 my $userenv = C4::Context->userenv;
2233 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2234 return $userenv->{number};
2236 my $dbh = C4::Context->dbh;
2237 for my $field ( 'userid', 'cardnumber' ) {
2239 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2240 $sth->execute($userid);
2242 my ($bnumber) = $sth->fetchrow;
2249 =head2 track_login_daily
2251 track_login_daily( $userid );
2253 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2257 sub track_login_daily {
2259 return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2261 my $cache = Koha::Caches->get_instance();
2262 my $cache_key = "track_login_" . $userid;
2263 my $cached = $cache->get_from_cache($cache_key);
2264 my $today = dt_from_string()->ymd;
2265 return if $cached && $cached eq $today;
2267 my $patron = Koha::Patrons->find({ userid => $userid });
2268 return unless $patron;
2269 $patron->track_login;
2270 $cache->set_in_cache( $cache_key, $today );
2273 END { } # module clean-up code here (global destructor)
2283 Crypt::Eksblowfish::Bcrypt(3)