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 );
30 use C4::Templates; # to get the template
32 use C4::Search::History;
36 use Koha::AuthUtils qw( get_script_name hash_password );
38 use Koha::DateUtils qw( dt_from_string );
39 use Koha::Library::Groups;
41 use Koha::Cash::Registers;
44 use Koha::Patron::Consents;
45 use List::MoreUtils qw( any );
47 use C4::Auth_with_shibboleth qw( shib_ok get_login_shib login_shib_url logout_shib checkpw_shib );
49 use C4::Log qw( logaction );
53 use vars qw($ldap $cas $caslogout);
54 our (@ISA, @EXPORT_OK);
56 sub psgi_env { any { /^psgi\./ } keys %ENV }
59 if (psgi_env) { die 'psgi:exit' }
63 C4::Context->set_remote_address;
69 checkauth check_api_auth get_session check_cookie_auth checkpw checkpw_internal checkpw_hash
70 get_all_subpermissions get_user_subpermissions track_login_daily in_iprange
71 get_template_and_user haspermission
74 $ldap = C4::Context->config('useldapserver') || 0;
75 $cas = C4::Context->preference('casAuthentication');
76 $caslogout = C4::Context->preference('casLogout');
79 require C4::Auth_with_ldap;
80 import C4::Auth_with_ldap qw(checkpw_ldap);
83 require C4::Auth_with_cas; # no import
84 import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url logout_if_required multipleAuth getMultipleAuth);
91 C4::Auth - Authenticates Koha users
101 my ($template, $borrowernumber, $cookie)
102 = get_template_and_user(
104 template_name => "opac-main.tt",
107 authnotrequired => 0,
108 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
112 output_html_with_http_headers $query, $cookie, $template->output;
116 The main function of this module is to provide
117 authentification. However the get_template_and_user function has
118 been provided so that a users login information is passed along
119 automatically. This gets loaded into the template.
123 =head2 get_template_and_user
125 my ($template, $borrowernumber, $cookie)
126 = get_template_and_user(
128 template_name => "opac-main.tt",
131 authnotrequired => 0,
132 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
136 This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
137 to C<&checkauth> (in this module) to perform authentification.
138 See C<&checkauth> for an explanation of these parameters.
140 The C<template_name> is then used to find the correct template for
141 the page. The authenticated users details are loaded onto the
142 template in the logged_in_user variable (which is a Koha::Patron object). Also the
143 C<sessionID> is passed to the template. This can be used in templates
144 if cookies are disabled. It needs to be put as and input to every
147 More information on the C<gettemplate> sub can be found in the
152 sub get_template_and_user {
155 my ( $user, $cookie, $sessionID, $flags );
157 # Get shibboleth login attribute
158 my $shib = C4::Context->config('useshibboleth') && shib_ok();
159 my $shib_login = $shib ? get_login_shib() : undef;
161 C4::Context->interface( $in->{type} );
163 $in->{'authnotrequired'} ||= 0;
165 # the following call includes a bad template check; might croak
166 my $template = C4::Templates::gettemplate(
167 $in->{'template_name'},
172 if ( $in->{'template_name'} !~ m/maintenance/ ) {
173 ( $user, $cookie, $sessionID, $flags ) = checkauth(
175 $in->{'authnotrequired'},
176 $in->{'flagsrequired'},
179 $in->{template_name},
183 # If we enforce GDPR and the user did not consent, redirect
184 # Exceptions for consent page itself and SCI/SCO system
185 if( $in->{type} eq 'opac' && $user &&
186 $in->{'template_name'} !~ /^(opac-patron-consent|sc[io]\/)/ &&
187 C4::Context->preference('GDPR_Policy') eq 'Enforced' )
189 my $consent = Koha::Patron::Consents->search({
190 borrowernumber => getborrowernumber($user),
191 type => 'GDPR_PROCESSING',
192 given_on => { '!=', undef },
195 print $in->{query}->redirect(-uri => '/cgi-bin/koha/opac-patron-consent.pl', -cookie => $cookie);
200 if ( $in->{type} eq 'opac' && $user ) {
203 my $session = get_session($sessionID);
205 $is_sco_user = $session->param('sco_user');
211 # If the user logged in is the SCO user and they try to go out of the SCO module,
212 # log the user out removing the CGISESSID cookie
213 $in->{template_name} !~ m|sco/| && $in->{template_name} !~ m|errors/errorpage.tt|
217 C4::Context->preference('AutoSelfCheckID')
218 && $user eq C4::Context->preference('AutoSelfCheckID')
226 # If the user logged in is the SCI user and they try to go out of the SCI module,
227 # kick them out unless it is SCO with a valid permission
228 # or they are a superlibrarian
229 $in->{template_name} !~ m|sci/|
230 && haspermission( $user, { self_check => 'self_checkin_module' } )
232 $in->{template_name} =~ m|sco/| && haspermission(
233 $user, { self_check => 'self_checkout_module' }
236 && $flags && $flags->{superlibrarian} != 1
243 $template = C4::Templates::gettemplate( 'opac-auth.tt', 'opac',
245 $cookie = $in->{query}->cookie(
246 -name => 'CGISESSID',
250 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
255 script_name => get_script_name(),
258 print $in->{query}->header(
263 'X-Frame-Options' => 'SAMEORIGIN'
274 # It's possible for $user to be the borrowernumber if they don't have a
275 # userid defined (and are logging in through some other method, such
276 # as SSL certs against an email address)
278 $borrowernumber = getborrowernumber($user) if defined($user);
279 if ( !defined($borrowernumber) && defined($user) ) {
280 $patron = Koha::Patrons->find( $user );
282 $borrowernumber = $user;
284 # A bit of a hack, but I don't know there's a nicer way
286 $user = $patron->firstname . ' ' . $patron->surname;
289 $patron = Koha::Patrons->find( $borrowernumber );
290 # FIXME What to do if $patron does not exist?
294 $template->param( loggedinusername => $user ); # OBSOLETE - Do not reuse this in template, use logged_in_user.userid instead
295 $template->param( loggedinusernumber => $borrowernumber ); # FIXME Should be replaced with logged_in_user.borrowernumber
296 $template->param( logged_in_user => $patron );
297 $template->param( sessionID => $sessionID );
299 if ( $in->{'type'} eq 'opac' ) {
300 require Koha::Virtualshelves;
301 my $some_private_shelves = Koha::Virtualshelves->get_some_shelves(
303 borrowernumber => $borrowernumber,
307 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
313 some_private_shelves => $some_private_shelves,
314 some_public_shelves => $some_public_shelves,
318 my $all_perms = get_all_subpermissions();
320 my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
321 editcatalogue updatecharges tools editauthorities serials reports acquisition clubs problem_reports);
323 # We are going to use the $flags returned by checkauth
324 # to create the template's parameters that will indicate
325 # which menus the user can access.
326 if ( $flags && $flags->{superlibrarian} == 1 ) {
327 $template->param( CAN_user_circulate => 1 );
328 $template->param( CAN_user_catalogue => 1 );
329 $template->param( CAN_user_parameters => 1 );
330 $template->param( CAN_user_borrowers => 1 );
331 $template->param( CAN_user_permissions => 1 );
332 $template->param( CAN_user_reserveforothers => 1 );
333 $template->param( CAN_user_editcatalogue => 1 );
334 $template->param( CAN_user_updatecharges => 1 );
335 $template->param( CAN_user_acquisition => 1 );
336 $template->param( CAN_user_suggestions => 1 );
337 $template->param( CAN_user_tools => 1 );
338 $template->param( CAN_user_editauthorities => 1 );
339 $template->param( CAN_user_serials => 1 );
340 $template->param( CAN_user_reports => 1 );
341 $template->param( CAN_user_staffaccess => 1 );
342 $template->param( CAN_user_coursereserves => 1 );
343 $template->param( CAN_user_plugins => 1 );
344 $template->param( CAN_user_lists => 1 );
345 $template->param( CAN_user_clubs => 1 );
346 $template->param( CAN_user_ill => 1 );
347 $template->param( CAN_user_stockrotation => 1 );
348 $template->param( CAN_user_cash_management => 1 );
349 $template->param( CAN_user_problem_reports => 1 );
351 foreach my $module ( keys %$all_perms ) {
352 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
353 $template->param( "CAN_user_${module}_${subperm}" => 1 );
359 foreach my $module ( keys %$all_perms ) {
360 if ( defined($flags->{$module}) && $flags->{$module} == 1 ) {
361 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
362 $template->param( "CAN_user_${module}_${subperm}" => 1 );
364 } elsif ( ref( $flags->{$module} ) ) {
365 foreach my $subperm ( keys %{ $flags->{$module} } ) {
366 $template->param( "CAN_user_${module}_${subperm}" => 1 );
373 foreach my $module ( keys %$flags ) {
374 if ( $flags->{$module} == 1 or ref( $flags->{$module} ) ) {
375 $template->param( "CAN_user_$module" => 1 );
380 # Logged-in opac search history
381 # If the requested template is an opac one and opac search history is enabled
382 if ( $in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory') ) {
383 my $dbh = C4::Context->dbh;
384 my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
385 my $sth = $dbh->prepare($query);
386 $sth->execute($borrowernumber);
388 # If at least one search has already been performed
389 if ( $sth->fetchrow_array > 0 ) {
391 # We show the link in opac
392 $template->param( EnableOpacSearchHistory => 1 );
394 if (C4::Context->preference('LoadSearchHistoryToTheFirstLoggedUser'))
396 # And if there are searches performed when the user was not logged in,
397 # we add them to the logged-in search history
398 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
399 if (@recentSearches) {
400 my $dbh = C4::Context->dbh;
402 INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, type, total, time )
403 VALUES (?, ?, ?, ?, ?, ?, ?)
405 my $sth = $dbh->prepare($query);
406 $sth->execute( $borrowernumber,
407 $in->{query}->cookie("CGISESSID"),
410 $_->{type} || 'biblio',
413 ) foreach @recentSearches;
415 # clear out the search history from the session now that
416 # we've saved it to the database
419 C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } );
421 } elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) {
422 $template->param( EnableSearchHistory => 1 );
425 else { # if this is an anonymous session, setup to display public lists...
427 # If shibboleth is enabled, and we're in an anonymous session, we should allow
428 # the user to attempt login via shibboleth.
430 $template->param( shibbolethAuthentication => $shib,
431 shibbolethLoginUrl => login_shib_url( $in->{'query'} ),
434 # If shibboleth is enabled and we have a shibboleth login attribute,
435 # but we are in an anonymous session, then we clearly have an invalid
436 # shibboleth koha account.
438 $template->param( invalidShibLogin => '1' );
442 $template->param( sessionID => $sessionID );
444 if ( $in->{'type'} eq 'opac' ){
445 require Koha::Virtualshelves;
446 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
452 some_public_shelves => $some_public_shelves,
457 # Sysprefs disabled via URL param
458 # Note that value must be defined in order to override via ENV
459 foreach my $syspref (
465 OpacAdditionalStylesheet
467 intranetcolorstylesheet
472 $ENV{"OVERRIDE_SYSPREF_$syspref"} = q{}
473 if $in->{'query'}->param("DISABLE_SYSPREF_$syspref");
476 # Anonymous opac search history
477 # If opac search history is enabled and at least one search has already been performed
478 if ( C4::Context->preference('EnableOpacSearchHistory') ) {
479 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
480 if (@recentSearches) {
481 $template->param( EnableOpacSearchHistory => 1 );
485 if ( C4::Context->preference('dateformat') ) {
486 $template->param( dateformat => C4::Context->preference('dateformat') );
489 $template->param(auth_forwarded_hash => scalar $in->{'query'}->param('auth_forwarded_hash'));
491 # these template parameters are set the same regardless of $in->{'type'}
493 my $minPasswordLength = C4::Context->preference('minPasswordLength');
494 $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
496 "BiblioDefaultView" . C4::Context->preference("BiblioDefaultView") => 1,
497 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
498 GoogleJackets => C4::Context->preference("GoogleJackets"),
499 OpenLibraryCovers => C4::Context->preference("OpenLibraryCovers"),
500 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
501 LoginFirstname => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
502 LoginSurname => C4::Context->userenv ? C4::Context->userenv->{"surname"} : "Inconnu",
503 emailaddress => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
504 TagsEnabled => C4::Context->preference("TagsEnabled"),
505 hide_marc => C4::Context->preference("hide_marc"),
506 item_level_itypes => C4::Context->preference('item-level_itypes'),
507 patronimages => C4::Context->preference("patronimages"),
508 singleBranchMode => ( Koha::Libraries->search->count == 1 ),
509 noItemTypeImages => C4::Context->preference("noItemTypeImages"),
510 marcflavour => C4::Context->preference("marcflavour"),
511 OPACBaseURL => C4::Context->preference('OPACBaseURL'),
512 minPasswordLength => $minPasswordLength,
514 if ( $in->{'type'} eq "intranet" ) {
516 AmazonCoverImages => C4::Context->preference("AmazonCoverImages"),
517 AutoLocation => C4::Context->preference("AutoLocation"),
518 "BiblioDefaultView" . C4::Context->preference("IntranetBiblioDefaultView") => 1,
519 PatronAutoComplete => C4::Context->preference("PatronAutoComplete"),
520 FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
521 IndependentBranches => C4::Context->preference("IndependentBranches"),
522 IntranetNav => C4::Context->preference("IntranetNav"),
523 IntranetmainUserblock => C4::Context->preference("IntranetmainUserblock"),
524 LibraryName => C4::Context->preference("LibraryName"),
525 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
526 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
527 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
528 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
529 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
530 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
531 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
532 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
533 suggestion => C4::Context->preference("suggestion"),
534 virtualshelves => C4::Context->preference("virtualshelves"),
535 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
536 EasyAnalyticalRecords => C4::Context->preference('EasyAnalyticalRecords'),
537 LocalCoverImages => C4::Context->preference('LocalCoverImages'),
538 OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'),
539 AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'),
540 EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'),
541 UseCourseReserves => C4::Context->preference("UseCourseReserves"),
542 useDischarge => C4::Context->preference('useDischarge'),
543 pending_checkout_notes => Koha::Checkouts->search({ noteseen => 0 }),
547 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
549 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
550 my $LibraryNameTitle = C4::Context->preference("LibraryName");
551 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
552 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
554 # clean up the busc param in the session
555 # if the page is not opac-detail and not the "add to list" page
556 # and not the "edit comments" page
557 if ( C4::Context->preference("OpacBrowseResults")
558 && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
560 unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
561 or $pagename =~ /^showmarc$/
562 or $pagename =~ /^addbybiblionumber$/
563 or $pagename =~ /^review$/ ) {
564 my $sessionSearch = get_session( $sessionID || $in->{'query'}->cookie("CGISESSID") );
565 $sessionSearch->clear( ["busc"] ) if ( $sessionSearch->param("busc") );
569 # variables passed from CGI: opac_css_override and opac_search_limits.
570 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
571 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
574 ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:([\w-]+)/ ) ||
575 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:([\w-]+)/ ) ||
576 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /multibranchlimit:(\w+)/ )
578 $opac_name = $1; # opac_search_limit is a branch, so we use it.
579 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
580 $opac_name = $in->{'query'}->param('multibranchlimit');
581 } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
582 $opac_name = C4::Context->userenv->{'branch'};
585 my @search_groups = Koha::Library::Groups->get_search_groups({ interface => 'opac' })->as_list;
587 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
588 LibrarySearchGroups => \@search_groups,
589 opac_name => $opac_name,
590 LibraryName => "" . C4::Context->preference("LibraryName"),
591 LibraryNameTitle => "" . $LibraryNameTitle,
592 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
593 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
594 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
595 OPACShelfBrowser => "" . C4::Context->preference("OPACShelfBrowser"),
596 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
597 OPACUserCSS => "" . C4::Context->preference("OPACUserCSS"),
598 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
599 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
600 opac_search_limit => $opac_search_limit,
601 opac_limit_override => $opac_limit_override,
602 OpacBrowser => C4::Context->preference("OpacBrowser"),
603 OpacCloud => C4::Context->preference("OpacCloud"),
604 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
605 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
606 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
607 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
608 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
609 OpacTopissue => C4::Context->preference("OpacTopissue"),
610 'Version' => C4::Context->preference('Version'),
611 hidelostitems => C4::Context->preference("hidelostitems"),
612 mylibraryfirst => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
613 opacbookbag => "" . C4::Context->preference("opacbookbag"),
614 OpacFavicon => C4::Context->preference("OpacFavicon"),
615 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
616 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
617 OPACUserJS => C4::Context->preference("OPACUserJS"),
618 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
619 OpenLibrarySearch => C4::Context->preference("OpenLibrarySearch"),
620 ShowReviewer => C4::Context->preference("ShowReviewer"),
621 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
622 suggestion => "" . C4::Context->preference("suggestion"),
623 virtualshelves => "" . C4::Context->preference("virtualshelves"),
624 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
625 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
626 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
627 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
628 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
629 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
630 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
631 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
632 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
633 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
634 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
635 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
636 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
637 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
638 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
639 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
640 useDischarge => C4::Context->preference('useDischarge'),
643 $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
646 # Check if we were asked using parameters to force a specific language
647 if ( defined $in->{'query'}->param('language') ) {
649 # Extract the language, let C4::Languages::getlanguage choose
651 my $language = C4::Languages::getlanguage( $in->{'query'} );
652 my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
653 if ( ref $cookie eq 'ARRAY' ) {
654 push @{$cookie}, $languagecookie;
656 $cookie = [ $cookie, $languagecookie ];
660 return ( $template, $borrowernumber, $cookie, $flags );
665 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
667 Verifies that the user is authorized to run this script. If
668 the user is authorized, a (userid, cookie, session-id, flags)
669 quadruple is returned. If the user is not authorized but does
670 not have the required privilege (see $flagsrequired below), it
671 displays an error page and exits. Otherwise, it displays the
672 login page and exits.
674 Note that C<&checkauth> will return if and only if the user
675 is authorized, so it should be called early on, before any
676 unfinished operations (e.g., if you've opened a file, then
677 C<&checkauth> won't close it for you).
679 C<$query> is the CGI object for the script calling C<&checkauth>.
681 The C<$noauth> argument is optional. If it is set, then no
682 authorization is required for the script.
684 C<&checkauth> fetches user and session information from C<$query> and
685 ensures that the user is authorized to run scripts that require
688 The C<$flagsrequired> argument specifies the required privileges
689 the user must have if the username and password are correct.
690 It should be specified as a reference-to-hash; keys in the hash
691 should be the "flags" for the user, as specified in the Members
692 intranet module. Any key specified must correspond to a "flag"
693 in the userflags table. E.g., { circulate => 1 } would specify
694 that the user must have the "circulate" privilege in order to
695 proceed. To make sure that access control is correct, the
696 C<$flagsrequired> parameter must be specified correctly.
698 Koha also has a concept of sub-permissions, also known as
699 granular permissions. This makes the value of each key
700 in the C<flagsrequired> hash take on an additional
705 The user must have access to all subfunctions of the module
706 specified by the hash key.
710 The user must have access to at least one subfunction of the module
711 specified by the hash key.
713 specific permission, e.g., 'export_catalog'
715 The user must have access to the specific subfunction list, which
716 must correspond to a row in the permissions table.
718 The C<$type> argument specifies whether the template should be
719 retrieved from the opac or intranet directory tree. "opac" is
720 assumed if it is not specified; however, if C<$type> is specified,
721 "intranet" is assumed if it is not "opac".
723 If C<$query> does not have a valid session ID associated with it
724 (i.e., the user has not logged in) or if the session has expired,
725 C<&checkauth> presents the user with a login page (from the point of
726 view of the original script, C<&checkauth> does not return). Once the
727 user has authenticated, C<&checkauth> restarts the original script
728 (this time, C<&checkauth> returns).
730 The login page is provided using a HTML::Template, which is set in the
731 systempreferences table or at the top of this file. The variable C<$type>
732 selects which template to use, either the opac or the intranet
733 authentification template.
735 C<&checkauth> returns a user ID, a cookie, and a session ID. The
736 cookie should be sent back to the browser; it verifies that the user
746 # If version syspref is unavailable, it means Koha is being installed,
747 # and so we must redirect to OPAC maintenance page or to the WebInstaller
748 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
749 if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
750 warn "OPAC Install required, redirecting to maintenance";
751 print $query->redirect("/cgi-bin/koha/maintenance.pl");
754 unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
755 if ( $type ne 'opac' ) {
756 warn "Install required, redirecting to Installer";
757 print $query->redirect("/cgi-bin/koha/installer/install.pl");
759 warn "OPAC Install required, redirecting to maintenance";
760 print $query->redirect("/cgi-bin/koha/maintenance.pl");
765 # check that database and koha version are the same
766 # there is no DB version, it's a fresh install,
767 # go to web installer
768 # there is a DB version, compare it to the code version
769 my $kohaversion = Koha::version();
771 # remove the 3 last . to have a Perl number
772 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
773 Koha::Logger->get->debug("kohaversion : $kohaversion");
774 if ( $version < $kohaversion ) {
775 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
776 if ( $type ne 'opac' ) {
777 warn sprintf( $warning, 'Installer' );
778 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
780 warn sprintf( "OPAC: " . $warning, 'maintenance' );
781 print $query->redirect("/cgi-bin/koha/maintenance.pl");
787 sub _timeout_syspref {
788 my $default_timeout = 600;
789 my $timeout = C4::Context->preference('timeout') || $default_timeout;
791 # value in days, convert in seconds
792 if ( $timeout =~ /^(\d+)[dD]$/ ) {
793 $timeout = $1 * 86400;
795 # value in hours, convert in seconds
796 elsif ( $timeout =~ /^(\d+)[hH]$/ ) {
797 $timeout = $1 * 3600;
799 elsif ( $timeout !~ m/^\d+$/ ) {
800 warn "The value of the system preference 'timeout' is not correct, defaulting to $default_timeout";
801 $timeout = $default_timeout;
810 # Get shibboleth login attribute
811 my $shib = C4::Context->config('useshibboleth') && shib_ok();
812 my $shib_login = $shib ? get_login_shib() : undef;
814 # $authnotrequired will be set for scripts which will run without authentication
815 my $authnotrequired = shift;
816 my $flagsrequired = shift;
818 my $emailaddress = shift;
819 my $template_name = shift;
820 $type = 'opac' unless $type;
822 unless ( C4::Context->preference("OpacPublic") ) {
823 my @allowed_scripts_for_private_opac = qw(
825 opac-registration-email-sent.tt
826 opac-registration-confirmation.tt
827 opac-memberentry-update-submitted.tt
828 opac-password-recovery.tt
830 $authnotrequired = 0 unless grep { $_ eq $template_name }
831 @allowed_scripts_for_private_opac;
834 my $dbh = C4::Context->dbh;
835 my $timeout = _timeout_syspref();
837 _version_check( $type, $query );
842 my ( $userid, $cookie, $sessionID, $flags );
843 my $logout = $query->param('logout.x');
845 my $anon_search_history;
847 # This parameter is the name of the CAS server we want to authenticate against,
848 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
849 my $casparam = $query->param('cas');
850 my $q_userid = $query->param('userid') // '';
854 # Basic authentication is incompatible with the use of Shibboleth,
855 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
856 # and it may not be the attribute we want to use to match the koha login.
858 # Also, do not consider an empty REMOTE_USER.
860 # Finally, after those tests, we can assume (although if it would be better with
861 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
862 # and we can affect it to $userid.
863 if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
865 # Using Basic Authentication, no cookies required
866 $cookie = $query->cookie(
867 -name => 'CGISESSID',
871 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
875 elsif ( $emailaddress) {
876 # the Google OpenID Connect passes an email address
878 elsif ( $sessionID = $query->cookie("CGISESSID") ) { # assignment, not comparison
879 my ( $return, $more_info );
880 ( $return, $session, $more_info ) = check_cookie_auth( $sessionID, $flags,
881 { remote_addr => $ENV{REMOTE_ADDR}, skip_version_check => 1 }
884 if ( $return eq 'ok' ) {
885 Koha::Logger->get->debug(sprintf "AUTH_SESSION: (%s)\t%s %s - %s", map { $session->param($_) || q{} } qw(cardnumber firstname surname branch));
887 my $s_userid = $session->param('id');
890 if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
891 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
892 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
895 #if a user enters an id ne to the id in the current session, we need to log them in...
896 #first we need to clear the anonymous session...
897 $anon_search_history = $session->param('search_history');
900 C4::Context->_unset_userenv($sessionID);
904 # voluntary logout the user
905 # check wether the user was using their shibboleth session or a local one
906 my $shibSuccess = C4::Context->userenv->{'shibboleth'};
909 C4::Context->_unset_userenv($sessionID);
911 if ($cas and $caslogout) {
912 logout_cas($query, $type);
915 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
916 if ( $shib and $shib_login and $shibSuccess) {
921 $cookie = $query->cookie(
922 -name => 'CGISESSID',
923 -value => $session->id,
925 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
928 my $sessiontype = $session->param('sessiontype') || '';
929 unless ( $sessiontype && $sessiontype eq 'anon' ) { #if this is an anonymous session, we want to update the session, but not behave as if they are logged in...
930 $flags = haspermission( $userid, $flagsrequired );
934 $info{'nopermission'} = 1;
938 } elsif ( !$logout ) {
939 if ( $return eq 'expired' ) {
940 $info{timed_out} = 1;
941 } elsif ( $return eq 'restricted' ) {
942 $info{oldip} = $more_info->{old_ip};
943 $info{newip} = $more_info->{new_ip};
944 $info{different_ip} = 1;
949 unless ( $loggedin ) {
955 #we initiate a session prior to checking for a username to allow for anonymous sessions...
956 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
958 # Save anonymous search history in new session so it can be retrieved
959 # by get_template_and_user to store it in user's search history after
960 # a successful login.
961 if ($anon_search_history) {
962 $session->param( 'search_history', $anon_search_history );
965 $sessionID = $session->id;
966 C4::Context->_new_userenv($sessionID);
967 $cookie = $query->cookie(
968 -name => 'CGISESSID',
969 -value => $sessionID,
971 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
973 my $pki_field = C4::Context->preference('AllowPKIAuth');
974 if ( !defined($pki_field) ) {
975 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
978 if ( ( $cas && $query->param('ticket') )
980 || ( $shib && $shib_login )
981 || $pki_field ne 'None'
984 my $password = $query->param('password');
986 my ( $return, $cardnumber );
988 # If shib is enabled and we have a shib login, does the login match a valid koha user
989 if ( $shib && $shib_login ) {
992 # Do not pass password here, else shib will not be checked in checkpw.
993 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $q_userid, undef, $query );
994 $userid = $retuserid;
995 $shibSuccess = $return;
996 $info{'invalidShibLogin'} = 1 unless ($return);
999 # If shib login and match were successful, skip further login methods
1000 unless ($shibSuccess) {
1001 if ( $cas && $query->param('ticket') ) {
1003 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1004 checkpw( $dbh, $userid, $password, $query, $type );
1005 $userid = $retuserid;
1006 $info{'invalidCasLogin'} = 1 unless ($return);
1009 elsif ( $emailaddress ) {
1010 my $value = $emailaddress;
1012 # If we're looking up the email, there's a chance that the person
1013 # doesn't have a userid. So if there is none, we pass along the
1014 # borrower number, and the bits of code that need to know the user
1015 # ID will have to be smart enough to handle that.
1016 my $patrons = Koha::Patrons->search({ email => $value });
1017 if ($patrons->count) {
1019 # First the userid, then the borrowernum
1020 my $patron = $patrons->next;
1021 $value = $patron->userid || $patron->borrowernumber;
1025 $return = $value ? 1 : 0;
1030 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1031 || ( $pki_field eq 'emailAddress'
1032 && $ENV{'SSL_CLIENT_S_DN_Email'} )
1036 if ( $pki_field eq 'Common Name' ) {
1037 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1039 elsif ( $pki_field eq 'emailAddress' ) {
1040 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1042 # If we're looking up the email, there's a chance that the person
1043 # doesn't have a userid. So if there is none, we pass along the
1044 # borrower number, and the bits of code that need to know the user
1045 # ID will have to be smart enough to handle that.
1046 my $patrons = Koha::Patrons->search({ email => $value });
1047 if ($patrons->count) {
1049 # First the userid, then the borrowernum
1050 my $patron = $patrons->next;
1051 $value = $patron->userid || $patron->borrowernumber;
1057 $return = $value ? 1 : 0;
1063 my $request_method = $query->request_method();
1066 $request_method eq 'POST'
1067 || ( C4::Context->preference('AutoSelfCheckID')
1068 && $q_userid eq C4::Context->preference('AutoSelfCheckID') )
1072 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1073 checkpw( $dbh, $q_userid, $password, $query, $type );
1074 $userid = $retuserid if ($retuserid);
1075 $info{'invalid_username_or_password'} = 1 unless ($return);
1080 # If shib configured and shibOnly enabled, we should ignore anything other than a shibboleth type login.
1087 && C4::Context->preference('OPACShibOnly')
1089 || ( ( $type ne 'opac' )
1090 && C4::Context->preference('staffShibOnly') )
1097 # $return: 1 = valid user
1100 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1104 $info{'nopermission'} = 1;
1105 C4::Context->_unset_userenv($sessionID);
1107 my ( $borrowernumber, $firstname, $surname, $userflags,
1108 $branchcode, $branchname, $emailaddress, $desk_id,
1109 $desk_name, $register_id, $register_name );
1111 if ( $return == 1 ) {
1113 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1114 branches.branchname as branchname, email
1116 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1118 my $sth = $dbh->prepare("$select where userid=?");
1119 $sth->execute($userid);
1120 unless ( $sth->rows ) {
1121 $sth = $dbh->prepare("$select where cardnumber=?");
1122 $sth->execute($cardnumber);
1124 unless ( $sth->rows ) {
1125 $sth->execute($userid);
1129 ( $borrowernumber, $firstname, $surname, $userflags,
1130 $branchcode, $branchname, $emailaddress ) = $sth->fetchrow;
1133 # launch a sequence to check if we have a ip for the branch, i
1134 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1136 my $ip = $ENV{'REMOTE_ADDR'};
1138 # if they specify at login, use that
1139 if ( $query->param('branch') ) {
1140 $branchcode = $query->param('branch');
1141 my $library = Koha::Libraries->find($branchcode);
1142 $branchname = $library? $library->branchname: '';
1144 if ( $query->param('desk_id') ) {
1145 $desk_id = $query->param('desk_id');
1146 my $desk = Koha::Desks->find($desk_id);
1147 $desk_name = $desk ? $desk->desk_name : '';
1149 if ( C4::Context->preference('UseCashRegisters') ) {
1151 $query->param('register_id')
1152 ? Koha::Cash::Registers->find($query->param('register_id'))
1153 : Koha::Cash::Registers->search(
1154 { branch => $branchcode, branch_default => 1 },
1155 { rows => 1 } )->single;
1156 $register_id = $register->id if ($register);
1157 $register_name = $register->name if ($register);
1159 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search->as_list };
1160 if ( $type ne 'opac' and C4::Context->preference('AutoLocation') ) {
1162 # we have to check they are coming from the right ip range
1163 my $domain = $branches->{$branchcode}->{'branchip'};
1164 $domain =~ s|\.\*||g;
1165 if ( $ip !~ /^$domain/ ) {
1167 $cookie = $query->cookie(
1168 -name => 'CGISESSID',
1171 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1173 $info{'wrongip'} = 1;
1177 foreach my $br ( keys %$branches ) {
1179 # now we work with the treatment of ip
1180 my $domain = $branches->{$br}->{'branchip'};
1181 if ( $domain && $ip =~ /^$domain/ ) {
1182 $branchcode = $branches->{$br}->{'branchcode'};
1184 # new op dev : add the branchname to the cookie
1185 $branchname = $branches->{$br}->{'branchname'};
1189 my $is_sco_user = 0;
1190 if ( $query->param('sco_user_login') && ( $query->param('sco_user_login') eq '1' ) ){
1194 $session->param( 'number', $borrowernumber );
1195 $session->param( 'id', $userid );
1196 $session->param( 'cardnumber', $cardnumber );
1197 $session->param( 'firstname', $firstname );
1198 $session->param( 'surname', $surname );
1199 $session->param( 'branch', $branchcode );
1200 $session->param( 'branchname', $branchname );
1201 $session->param( 'desk_id', $desk_id);
1202 $session->param( 'desk_name', $desk_name);
1203 $session->param( 'flags', $userflags );
1204 $session->param( 'emailaddress', $emailaddress );
1205 $session->param( 'ip', $session->remote_addr() );
1206 $session->param( 'lasttime', time() );
1207 $session->param( 'interface', $type);
1208 $session->param( 'shibboleth', $shibSuccess );
1209 $session->param( 'register_id', $register_id );
1210 $session->param( 'register_name', $register_name );
1211 $session->param( 'sco_user', $is_sco_user );
1213 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1214 C4::Context->set_userenv(
1215 $session->param('number'), $session->param('id'),
1216 $session->param('cardnumber'), $session->param('firstname'),
1217 $session->param('surname'), $session->param('branch'),
1218 $session->param('branchname'), $session->param('flags'),
1219 $session->param('emailaddress'), $session->param('shibboleth'),
1220 $session->param('desk_id'), $session->param('desk_name'),
1221 $session->param('register_id'), $session->param('register_name')
1225 # $return: 0 = invalid user
1226 # reset to anonymous session
1229 $info{'invalid_username_or_password'} = 1;
1230 C4::Context->_unset_userenv($sessionID);
1232 $session->param( 'lasttime', time() );
1233 $session->param( 'ip', $session->remote_addr() );
1234 $session->param( 'sessiontype', 'anon' );
1235 $session->param( 'interface', $type);
1237 } # END if ( $q_userid
1238 elsif ( $type eq "opac" ) {
1240 # anonymous sessions are created only for the OPAC
1242 # setting a couple of other session vars...
1243 $session->param( 'ip', $session->remote_addr() );
1244 $session->param( 'lasttime', time() );
1245 $session->param( 'sessiontype', 'anon' );
1246 $session->param( 'interface', $type);
1248 } # END unless ($userid)
1250 # finished authentification, now respond
1251 if ( $loggedin || $authnotrequired )
1255 $cookie = $query->cookie(
1256 -name => 'CGISESSID',
1259 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1263 track_login_daily( $userid );
1265 # In case, that this request was a login attempt, we want to prevent that users can repost the opac login
1266 # request. We therefore redirect the user to the requested page again without the login parameters.
1267 # See Post/Redirect/Get (PRG) design pattern: https://en.wikipedia.org/wiki/Post/Redirect/Get
1268 if ( $type eq "opac" && $query->param('koha_login_context') && $query->param('koha_login_context') ne 'sco' && $query->param('password') && $query->param('userid') ) {
1269 my $uri = URI->new($query->url(-relative=>1, -query_string=>1));
1270 $uri->query_param_delete('userid');
1271 $uri->query_param_delete('password');
1272 $uri->query_param_delete('koha_login_context');
1273 print $query->redirect(-uri => $uri->as_string, -cookie => $cookie, -status=>'303 See other');
1277 return ( $userid, $cookie, $sessionID, $flags );
1282 # AUTH rejected, show the login/password template, after checking the DB.
1286 # get the inputs from the incoming query
1288 foreach my $name ( param $query) {
1289 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1290 my @value = $query->multi_param($name);
1291 push @inputs, { name => $name, value => $_ } for @value;
1294 my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1296 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1297 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1298 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1300 my $auth_template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1301 my $template = C4::Templates::gettemplate( $auth_template_name, $type, $query );
1305 script_name => get_script_name(),
1306 casAuthentication => C4::Context->preference("casAuthentication"),
1307 shibbolethAuthentication => $shib,
1308 suggestion => C4::Context->preference("suggestion"),
1309 virtualshelves => C4::Context->preference("virtualshelves"),
1310 LibraryName => "" . C4::Context->preference("LibraryName"),
1311 LibraryNameTitle => "" . $LibraryNameTitle,
1312 opacuserlogin => C4::Context->preference("opacuserlogin"),
1313 OpacFavicon => C4::Context->preference("OpacFavicon"),
1314 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1315 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1316 OPACUserJS => C4::Context->preference("OPACUserJS"),
1317 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1318 OpacCloud => C4::Context->preference("OpacCloud"),
1319 OpacTopissue => C4::Context->preference("OpacTopissue"),
1320 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1321 OpacBrowser => C4::Context->preference("OpacBrowser"),
1322 TagsEnabled => C4::Context->preference("TagsEnabled"),
1323 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1324 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1325 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1326 IntranetNav => C4::Context->preference("IntranetNav"),
1327 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1328 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
1329 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1330 IndependentBranches => C4::Context->preference("IndependentBranches"),
1331 AutoLocation => C4::Context->preference("AutoLocation"),
1332 wrongip => $info{'wrongip'},
1333 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1334 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1335 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1336 too_many_login_attempts => ( $patron and $patron->account_locked )
1339 $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1340 $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1341 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1342 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1344 if ( $type eq 'opac' ) {
1345 require Koha::Virtualshelves;
1346 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1352 some_public_shelves => $some_public_shelves,
1358 # Is authentication against multiple CAS servers enabled?
1359 require C4::Auth_with_cas;
1360 if ( multipleAuth() && !$casparam ) {
1361 my $casservers = getMultipleAuth();
1363 foreach my $key ( keys %$casservers ) {
1364 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1367 casServersLoop => \@tmplservers
1371 casServerUrl => login_cas_url($query, undef, $type),
1376 invalidCasLogin => $info{'invalidCasLogin'}
1381 #If shibOnly is enabled just go ahead and redirect directly
1382 if ( (($type eq 'opac') && C4::Context->preference('OPACShibOnly')) || (($type ne 'opac') && C4::Context->preference('staffShibOnly')) ) {
1383 my $redirect_url = login_shib_url( $query );
1384 print $query->redirect( -uri => "$redirect_url", -status => 303 );
1389 shibbolethAuthentication => $shib,
1390 shibbolethLoginUrl => login_shib_url($query),
1394 if (C4::Context->preference('GoogleOpenIDConnect')) {
1395 if ($query->param("OpenIDConnectFailed")) {
1396 my $reason = $query->param('OpenIDConnectFailed');
1397 $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1402 LibraryName => C4::Context->preference("LibraryName"),
1404 $template->param(%info);
1406 # $cookie = $query->cookie(CGISESSID => $session->id
1408 print $query->header(
1409 { type => 'text/html',
1412 'X-Frame-Options' => 'SAMEORIGIN'
1419 =head2 check_api_auth
1421 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1423 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1424 cookie, determine if the user has the privileges specified by C<$userflags>.
1426 C<check_api_auth> is is meant for authenticating users of web services, and
1427 consequently will always return and will not attempt to redirect the user
1430 If a valid session cookie is already present, check_api_auth will return a status
1431 of "ok", the cookie, and the Koha session ID.
1433 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1434 parameters and create a session cookie and Koha session if the supplied credentials
1437 Possible return values in C<$status> are:
1441 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1443 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1445 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1447 =item "expired -- session cookie has expired; API user should resubmit userid and password
1449 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1455 sub check_api_auth {
1458 my $flagsrequired = shift;
1459 my $dbh = C4::Context->dbh;
1460 my $timeout = _timeout_syspref();
1462 unless ( C4::Context->preference('Version') ) {
1464 # database has not been installed yet
1465 return ( "maintenance", undef, undef );
1467 my $kohaversion = Koha::version();
1468 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1469 if ( C4::Context->preference('Version') < $kohaversion ) {
1471 # database in need of version update; assume that
1472 # no API should be called while databsae is in
1474 return ( "maintenance", undef, undef );
1477 my ( $sessionID, $session );
1478 unless ( $query->param('userid') ) {
1479 $sessionID = $query->cookie("CGISESSID");
1481 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1484 ( $return, $session, undef ) = check_cookie_auth(
1485 $sessionID, $flagsrequired, { remote_addr => $ENV{REMOTE_ADDR} } );
1487 return ( $return, undef, undef ) # Cookie auth failed
1490 my $cookie = $query->cookie(
1491 -name => 'CGISESSID',
1492 -value => $session->id,
1494 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1496 return ( $return, undef, $session );
1501 my $userid = $query->param('userid');
1502 my $password = $query->param('password');
1503 my ( $return, $cardnumber, $cas_ticket );
1506 if ( $cas && $query->param('PT') ) {
1509 # In case of a CAS authentication, we use the ticket instead of the password
1510 my $PT = $query->param('PT');
1511 ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $dbh, $PT, $query ); # EXTERNAL AUTH
1514 # User / password auth
1515 unless ( $userid and $password ) {
1517 # caller did something wrong, fail the authenticateion
1518 return ( "failed", undef, undef );
1521 ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $dbh, $userid, $password, $query );
1524 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1525 my $session = get_session("");
1526 return ( "failed", undef, undef ) unless $session;
1528 my $sessionID = $session->id;
1529 C4::Context->_new_userenv($sessionID);
1530 my $cookie = $query->cookie(
1531 -name => 'CGISESSID',
1532 -value => $sessionID,
1534 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1536 if ( $return == 1 ) {
1538 $borrowernumber, $firstname, $surname,
1539 $userflags, $branchcode, $branchname,
1544 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1546 $sth->execute($userid);
1548 $borrowernumber, $firstname, $surname,
1549 $userflags, $branchcode, $branchname,
1551 ) = $sth->fetchrow if ( $sth->rows );
1553 unless ( $sth->rows ) {
1554 my $sth = $dbh->prepare(
1555 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1557 $sth->execute($cardnumber);
1559 $borrowernumber, $firstname, $surname,
1560 $userflags, $branchcode, $branchname,
1562 ) = $sth->fetchrow if ( $sth->rows );
1564 unless ( $sth->rows ) {
1565 $sth->execute($userid);
1567 $borrowernumber, $firstname, $surname, $userflags,
1568 $branchcode, $branchname, $emailaddress
1569 ) = $sth->fetchrow if ( $sth->rows );
1573 my $ip = $ENV{'REMOTE_ADDR'};
1575 # if they specify at login, use that
1576 if ( $query->param('branch') ) {
1577 $branchcode = $query->param('branch');
1578 my $library = Koha::Libraries->find($branchcode);
1579 $branchname = $library? $library->branchname: '';
1581 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search->as_list };
1582 foreach my $br ( keys %$branches ) {
1584 # now we work with the treatment of ip
1585 my $domain = $branches->{$br}->{'branchip'};
1586 if ( $domain && $ip =~ /^$domain/ ) {
1587 $branchcode = $branches->{$br}->{'branchcode'};
1589 # new op dev : add the branchname to the cookie
1590 $branchname = $branches->{$br}->{'branchname'};
1593 $session->param( 'number', $borrowernumber );
1594 $session->param( 'id', $userid );
1595 $session->param( 'cardnumber', $cardnumber );
1596 $session->param( 'firstname', $firstname );
1597 $session->param( 'surname', $surname );
1598 $session->param( 'branch', $branchcode );
1599 $session->param( 'branchname', $branchname );
1600 $session->param( 'flags', $userflags );
1601 $session->param( 'emailaddress', $emailaddress );
1602 $session->param( 'ip', $session->remote_addr() );
1603 $session->param( 'lasttime', time() );
1604 $session->param( 'interface', 'api' );
1606 $session->param( 'cas_ticket', $cas_ticket);
1607 C4::Context->set_userenv(
1608 $session->param('number'), $session->param('id'),
1609 $session->param('cardnumber'), $session->param('firstname'),
1610 $session->param('surname'), $session->param('branch'),
1611 $session->param('branchname'), $session->param('flags'),
1612 $session->param('emailaddress'), $session->param('shibboleth'),
1613 $session->param('desk_id'), $session->param('desk_name'),
1614 $session->param('register_id'), $session->param('register_name')
1616 return ( "ok", $cookie, $sessionID );
1618 return ( "failed", undef, undef );
1623 =head2 check_cookie_auth
1625 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1627 Given a CGISESSID cookie set during a previous login to Koha, determine
1628 if the user has the privileges specified by C<$userflags>. C<$userflags>
1629 is passed unaltered into C<haspermission> and as such accepts all options
1630 avaiable to that routine with the one caveat that C<check_api_auth> will
1631 also allow 'undef' to be passed and in such a case the permissions check
1632 will be skipped altogether.
1634 C<check_cookie_auth> is meant for authenticating special services
1635 such as tools/upload-file.pl that are invoked by other pages that
1636 have been authenticated in the usual way.
1638 Possible return values in C<$status> are:
1642 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1644 =item "anon" -- user not authenticated but valid for anonymous session.
1646 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1648 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1650 =item "expired -- session cookie has expired; API user should resubmit userid and password
1652 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1658 sub check_cookie_auth {
1659 my $sessionID = shift;
1660 my $flagsrequired = shift;
1663 my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1665 my $skip_version_check = $params->{skip_version_check}; # Only for checkauth
1667 unless ( $skip_version_check ) {
1668 unless ( C4::Context->preference('Version') ) {
1670 # database has not been installed yet
1671 return ( "maintenance", undef );
1673 my $kohaversion = Koha::version();
1674 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1675 if ( C4::Context->preference('Version') < $kohaversion ) {
1677 # database in need of version update; assume that
1678 # no API should be called while databsae is in
1680 return ( "maintenance", undef );
1684 # see if we have a valid session cookie already
1685 # however, if a userid parameter is present (i.e., from
1686 # a form submission, assume that any current cookie
1688 unless ( defined $sessionID and $sessionID ) {
1689 return ( "failed", undef );
1691 my $session = get_session($sessionID);
1692 C4::Context->_new_userenv($sessionID);
1694 C4::Context->interface($session->param('interface'));
1695 C4::Context->set_userenv(
1696 $session->param('number'), $session->param('id') // '',
1697 $session->param('cardnumber'), $session->param('firstname'),
1698 $session->param('surname'), $session->param('branch'),
1699 $session->param('branchname'), $session->param('flags'),
1700 $session->param('emailaddress'), $session->param('shibboleth'),
1701 $session->param('desk_id'), $session->param('desk_name'),
1702 $session->param('register_id'), $session->param('register_name')
1705 my $userid = $session->param('id');
1706 my $ip = $session->param('ip');
1707 my $lasttime = $session->param('lasttime');
1708 my $timeout = _timeout_syspref();
1710 if ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
1715 C4::Context->_unset_userenv($sessionID);
1716 return ("expired", undef);
1717 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1719 # IP address changed
1722 C4::Context->_unset_userenv($sessionID);
1723 return ( "restricted", undef, { old_ip => $ip, new_ip => $remote_addr});
1724 } elsif ( $userid ) {
1725 $session->param( 'lasttime', time() );
1726 my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1728 return ( "ok", $session );
1731 return ( "anon", $session );
1733 # If here user was logged in, but doesn't have correct permissions
1734 # could be an 'else' at `if($flags) return "ok"` , but left here to catch any errors
1737 C4::Context->_unset_userenv($sessionID);
1738 return ( "failed", undef );
1740 return ( "expired", undef );
1747 my $session = get_session($sessionID);
1749 Given a session ID, retrieve the CGI::Session object used to store
1750 the session's state. The session object can be used to store
1751 data that needs to be accessed by different scripts during a
1754 If the C<$sessionID> parameter is an empty string, a new session
1759 sub _get_session_params {
1760 my $storage_method = C4::Context->preference('SessionStorage');
1761 if ( $storage_method eq 'mysql' ) {
1762 my $dbh = C4::Context->dbh;
1763 return { dsn => "serializer:yamlxs;driver:MySQL;id:md5", dsn_args => { Handle => $dbh } };
1765 elsif ( $storage_method eq 'Pg' ) {
1766 my $dbh = C4::Context->dbh;
1767 return { dsn => "serializer:yamlxs;driver:PostgreSQL;id:md5", dsn_args => { Handle => $dbh } };
1769 elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1770 my $memcached = Koha::Caches->get_instance()->memcached_cache;
1771 return { dsn => "serializer:yamlxs;driver:memcached;id:md5", dsn_args => { Memcached => $memcached } };
1774 # catch all defaults to tmp should work on all systems
1775 my $dir = C4::Context::temporary_directory;
1776 my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1777 return { dsn => "serializer:yamlxs;driver:File;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1782 my $sessionID = shift;
1783 my $params = _get_session_params();
1784 my $session = CGI::Session->new( $params->{dsn}, $sessionID, $params->{dsn_args} );
1786 die CGI::Session->errstr();
1792 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1793 # (or something similar)
1794 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1795 # not having a userenv defined could cause a crash.
1797 my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1798 $type = 'opac' unless $type;
1800 # Get shibboleth login attribute
1801 my $shib = C4::Context->config('useshibboleth') && shib_ok();
1802 my $shib_login = $shib ? get_login_shib() : undef;
1806 if ( defined $userid ){
1807 $patron = Koha::Patrons->find({ userid => $userid });
1808 $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1810 my $check_internal_as_fallback = 0;
1812 # Note: checkpw_* routines returns:
1815 # -1 if user bind failed (LDAP only)
1817 if ( $patron and $patron->account_locked ) {
1818 # Nothing to check, account is locked
1819 } elsif ($ldap && defined($password)) {
1820 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
1821 if ( $retval == 1 ) {
1822 @return = ( $retval, $retcard, $retuserid );
1825 $check_internal_as_fallback = 1 if $retval == 0;
1827 } elsif ( $cas && $query && $query->param('ticket') ) {
1829 # In case of a CAS authentication, we use the ticket instead of the password
1830 my $ticket = $query->param('ticket');
1831 $query->delete('ticket'); # remove ticket to come back to original URL
1832 my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $dbh, $ticket, $query, $type ); # EXTERNAL AUTH
1834 @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1838 $passwd_ok = $retval;
1841 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1842 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1844 elsif ( $shib && $shib_login && !$password ) {
1846 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1847 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1848 # shibboleth-authenticated user
1850 # Then, we check if it matches a valid koha user
1852 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
1854 @return = ( $retval, $retcard, $retuserid );
1856 $passwd_ok = $retval;
1859 $check_internal_as_fallback = 1;
1863 if ( $check_internal_as_fallback ) {
1864 @return = checkpw_internal( $dbh, $userid, $password, $no_set_userenv);
1865 $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1870 $patron->update({ login_attempts => 0 });
1871 } elsif( !$patron->account_locked ) {
1872 $patron->update({ login_attempts => $patron->login_attempts + 1 });
1876 # Optionally log success or failure
1877 if( $patron && $passwd_ok && C4::Context->preference('AuthSuccessLog') ) {
1878 logaction( 'AUTH', 'SUCCESS', $patron->id, "Valid password for $userid", $type );
1879 } elsif( !$passwd_ok && C4::Context->preference('AuthFailureLog') ) {
1880 logaction( 'AUTH', 'FAILURE', $patron ? $patron->id : 0, "Wrong password for $userid", $type );
1886 sub checkpw_internal {
1887 my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
1889 $password = Encode::encode( 'UTF-8', $password )
1890 if Encode::is_utf8($password);
1894 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1896 $sth->execute($userid);
1898 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1899 $surname, $branchcode, $branchname, $flags )
1902 if ( checkpw_hash( $password, $stored_hash ) ) {
1904 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1905 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1906 return 1, $cardnumber, $userid;
1911 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1913 $sth->execute($userid);
1915 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1916 $surname, $branchcode, $branchname, $flags )
1919 if ( checkpw_hash( $password, $stored_hash ) ) {
1921 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1922 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1923 return 1, $cardnumber, $userid;
1930 my ( $password, $stored_hash ) = @_;
1932 return if $stored_hash eq '!';
1934 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1936 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1937 $hash = hash_password( $password, $stored_hash );
1939 $hash = md5_base64($password);
1941 return $hash eq $stored_hash;
1946 my $authflags = getuserflags($flags, $userid, [$dbh]);
1948 Translates integer flags into permissions strings hash.
1950 C<$flags> is the integer userflags value ( borrowers.userflags )
1951 C<$userid> is the members.userid, used for building subpermissions
1952 C<$authflags> is a hashref of permissions
1959 my $dbh = @_ ? shift : C4::Context->dbh;
1962 # I don't want to do this, but if someone logs in as the database
1963 # user, it would be preferable not to spam them to death with
1964 # numeric warnings. So, we make $flags numeric.
1965 no warnings 'numeric';
1968 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1971 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1972 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1973 $userflags->{$flag} = 1;
1976 $userflags->{$flag} = 0;
1980 # get subpermissions and merge with top-level permissions
1981 my $user_subperms = get_user_subpermissions($userid);
1982 foreach my $module ( keys %$user_subperms ) {
1983 next if $userflags->{$module} == 1; # user already has permission for everything in this module
1984 $userflags->{$module} = $user_subperms->{$module};
1990 =head2 get_user_subpermissions
1992 $user_perm_hashref = get_user_subpermissions($userid);
1994 Given the userid (note, not the borrowernumber) of a staff user,
1995 return a hashref of hashrefs of the specific subpermissions
1996 accorded to the user. An example return is
2000 export_catalog => 1,
2001 import_patrons => 1,
2005 The top-level hash-key is a module or function code from
2006 userflags.flag, while the second-level key is a code
2009 The results of this function do not give a complete picture
2010 of the functions that a staff user can access; it is also
2011 necessary to check borrowers.flags.
2015 sub get_user_subpermissions {
2018 my $dbh = C4::Context->dbh;
2019 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2020 FROM user_permissions
2021 JOIN permissions USING (module_bit, code)
2022 JOIN userflags ON (module_bit = bit)
2023 JOIN borrowers USING (borrowernumber)
2024 WHERE userid = ?" );
2025 $sth->execute($userid);
2027 my $user_perms = {};
2028 while ( my $perm = $sth->fetchrow_hashref ) {
2029 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2034 =head2 get_all_subpermissions
2036 my $perm_hashref = get_all_subpermissions();
2038 Returns a hashref of hashrefs defining all specific
2039 permissions currently defined. The return value
2040 has the same structure as that of C<get_user_subpermissions>,
2041 except that the innermost hash value is the description
2042 of the subpermission.
2046 sub get_all_subpermissions {
2047 my $dbh = C4::Context->dbh;
2048 my $sth = $dbh->prepare( "SELECT flag, code
2050 JOIN userflags ON (module_bit = bit)" );
2054 while ( my $perm = $sth->fetchrow_hashref ) {
2055 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2060 =head2 haspermission
2062 $flagsrequired = '*'; # Any permission at all
2063 $flagsrequired = 'a_flag'; # a_flag must be satisfied (all subpermissions)
2064 $flagsrequired = [ 'a_flag', 'b_flag' ]; # a_flag OR b_flag must be satisfied
2065 $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 }; # a_flag AND b_flag must be satisfied
2066 $flagsrequired = { 'a_flag' => 'sub_a' }; # sub_a of a_flag must be satisfied
2067 $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2069 $flags = ($userid, $flagsrequired);
2071 C<$userid> the userid of the member
2072 C<$flags> is a query structure similar to that used by SQL::Abstract that
2073 denotes the combination of flags required. It is a required parameter.
2075 The main logic of this method is that things in arrays are OR'ed, and things
2076 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2078 Returns member's flags or 0 if a permission is not met.
2083 my ($required, $flags) = @_;
2085 my $ref = ref($required);
2087 if ($required eq '*') {
2088 return 0 unless ( $flags or ref( $flags ) );
2090 return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2092 } elsif ($ref eq 'HASH') {
2093 foreach my $key (keys %{$required}) {
2094 next if $flags == 1;
2095 my $require = $required->{$key};
2096 my $rflags = $flags->{$key};
2097 return 0 unless _dispatch($require, $rflags);
2099 } elsif ($ref eq 'ARRAY') {
2101 foreach my $require ( @{$required} ) {
2103 ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2104 ? $flags->{$require}
2106 $satisfied++ if _dispatch( $require, $rflags );
2108 return 0 unless $satisfied;
2110 croak "Unexpected structure found: $ref";
2117 my ( $userid, $flagsrequired ) = @_;
2119 #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2120 # unless defined($flagsrequired);
2122 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2123 $sth->execute($userid);
2124 my $row = $sth->fetchrow();
2125 my $flags = getuserflags( $row, $userid );
2127 return $flags unless defined($flagsrequired);
2128 return $flags if $flags->{superlibrarian};
2129 return _dispatch($flagsrequired, $flags);
2131 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2136 $flags = ($iprange);
2138 C<$iprange> A space separated string describing an IP range. Can include single IPs or ranges
2140 Returns 1 if the remote address is in the provided iprange, or 0 otherwise.
2147 my @allowedipranges = $iprange ? split(' ', $iprange) : ();
2148 if (scalar @allowedipranges > 0) {
2150 eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2151 eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || Koha::Logger->get->warn('cidrlookup failed for ' . join(' ',@rangelist) );
2153 return $result ? 1 : 0;
2156 sub getborrowernumber {
2158 my $userenv = C4::Context->userenv;
2159 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2160 return $userenv->{number};
2162 my $dbh = C4::Context->dbh;
2163 for my $field ( 'userid', 'cardnumber' ) {
2165 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2166 $sth->execute($userid);
2168 my ($bnumber) = $sth->fetchrow;
2175 =head2 track_login_daily
2177 track_login_daily( $userid );
2179 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2183 sub track_login_daily {
2185 return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2187 my $cache = Koha::Caches->get_instance();
2188 my $cache_key = "track_login_" . $userid;
2189 my $cached = $cache->get_from_cache($cache_key);
2190 my $today = dt_from_string()->ymd;
2191 return if $cached && $cached eq $today;
2193 my $patron = Koha::Patrons->find({ userid => $userid });
2194 return unless $patron;
2195 $patron->track_login;
2196 $cache->set_in_cache( $cache_key, $today );
2199 END { } # module clean-up code here (global destructor)
2209 Crypt::Eksblowfish::Bcrypt(3)