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,
455 # Set default branch if one has been passed by the environment.
456 $template->param( default_branch => $ENV{OPAC_BRANCH_DEFAULT} ) if $ENV{OPAC_BRANCH_DEFAULT};
460 # Sysprefs disabled via URL param
461 # Note that value must be defined in order to override via ENV
462 foreach my $syspref (
468 OpacAdditionalStylesheet
470 intranetcolorstylesheet
475 $ENV{"OVERRIDE_SYSPREF_$syspref"} = q{}
476 if $in->{'query'}->param("DISABLE_SYSPREF_$syspref");
479 # Anonymous opac search history
480 # If opac search history is enabled and at least one search has already been performed
481 if ( C4::Context->preference('EnableOpacSearchHistory') ) {
482 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
483 if (@recentSearches) {
484 $template->param( EnableOpacSearchHistory => 1 );
488 if ( C4::Context->preference('dateformat') ) {
489 $template->param( dateformat => C4::Context->preference('dateformat') );
492 $template->param(auth_forwarded_hash => scalar $in->{'query'}->param('auth_forwarded_hash'));
494 # these template parameters are set the same regardless of $in->{'type'}
496 my $minPasswordLength = C4::Context->preference('minPasswordLength');
497 $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
499 "BiblioDefaultView" . C4::Context->preference("BiblioDefaultView") => 1,
500 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
501 GoogleJackets => C4::Context->preference("GoogleJackets"),
502 OpenLibraryCovers => C4::Context->preference("OpenLibraryCovers"),
503 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
504 LoginFirstname => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
505 LoginSurname => C4::Context->userenv ? C4::Context->userenv->{"surname"} : "Inconnu",
506 emailaddress => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
507 TagsEnabled => C4::Context->preference("TagsEnabled"),
508 hide_marc => C4::Context->preference("hide_marc"),
509 item_level_itypes => C4::Context->preference('item-level_itypes'),
510 patronimages => C4::Context->preference("patronimages"),
511 singleBranchMode => ( Koha::Libraries->search->count == 1 ),
512 noItemTypeImages => C4::Context->preference("noItemTypeImages"),
513 marcflavour => C4::Context->preference("marcflavour"),
514 OPACBaseURL => C4::Context->preference('OPACBaseURL'),
515 minPasswordLength => $minPasswordLength,
517 if ( $in->{'type'} eq "intranet" ) {
519 AmazonCoverImages => C4::Context->preference("AmazonCoverImages"),
520 AutoLocation => C4::Context->preference("AutoLocation"),
521 "BiblioDefaultView" . C4::Context->preference("IntranetBiblioDefaultView") => 1,
522 PatronAutoComplete => C4::Context->preference("PatronAutoComplete"),
523 FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
524 IndependentBranches => C4::Context->preference("IndependentBranches"),
525 IntranetNav => C4::Context->preference("IntranetNav"),
526 IntranetmainUserblock => C4::Context->preference("IntranetmainUserblock"),
527 LibraryName => C4::Context->preference("LibraryName"),
528 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
529 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
530 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
531 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
532 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
533 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
534 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
535 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
536 suggestion => C4::Context->preference("suggestion"),
537 virtualshelves => C4::Context->preference("virtualshelves"),
538 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
539 EasyAnalyticalRecords => C4::Context->preference('EasyAnalyticalRecords'),
540 LocalCoverImages => C4::Context->preference('LocalCoverImages'),
541 OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'),
542 AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'),
543 EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'),
544 UseCourseReserves => C4::Context->preference("UseCourseReserves"),
545 useDischarge => C4::Context->preference('useDischarge'),
546 pending_checkout_notes => Koha::Checkouts->search({ noteseen => 0 }),
550 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
552 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
553 my $LibraryNameTitle = C4::Context->preference("LibraryName");
554 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
555 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
557 # clean up the busc param in the session
558 # if the page is not opac-detail and not the "add to list" page
559 # and not the "edit comments" page
560 if ( C4::Context->preference("OpacBrowseResults")
561 && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
563 unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
564 or $pagename =~ /^showmarc$/
565 or $pagename =~ /^addbybiblionumber$/
566 or $pagename =~ /^review$/ ) {
567 my $sessionSearch = get_session( $sessionID || $in->{'query'}->cookie("CGISESSID") );
568 $sessionSearch->clear( ["busc"] ) if ( $sessionSearch->param("busc") );
572 # variables passed from CGI: opac_css_override and opac_search_limits.
573 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
574 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
577 ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:([\w-]+)/ ) ||
578 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:([\w-]+)/ ) ||
579 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /multibranchlimit:(\w+)/ )
581 $opac_name = $1; # opac_search_limit is a branch, so we use it.
582 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
583 $opac_name = $in->{'query'}->param('multibranchlimit');
584 } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
585 $opac_name = C4::Context->userenv->{'branch'};
588 my @search_groups = Koha::Library::Groups->get_search_groups({ interface => 'opac' })->as_list;
590 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
591 LibrarySearchGroups => \@search_groups,
592 opac_name => $opac_name,
593 LibraryName => "" . C4::Context->preference("LibraryName"),
594 LibraryNameTitle => "" . $LibraryNameTitle,
595 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
596 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
597 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
598 OPACShelfBrowser => "" . C4::Context->preference("OPACShelfBrowser"),
599 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
600 OPACUserCSS => "" . C4::Context->preference("OPACUserCSS"),
601 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
602 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
603 opac_search_limit => $opac_search_limit,
604 opac_limit_override => $opac_limit_override,
605 OpacBrowser => C4::Context->preference("OpacBrowser"),
606 OpacCloud => C4::Context->preference("OpacCloud"),
607 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
608 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
609 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
610 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
611 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
612 OpacTopissue => C4::Context->preference("OpacTopissue"),
613 'Version' => C4::Context->preference('Version'),
614 hidelostitems => C4::Context->preference("hidelostitems"),
615 mylibraryfirst => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
616 opacbookbag => "" . C4::Context->preference("opacbookbag"),
617 OpacFavicon => C4::Context->preference("OpacFavicon"),
618 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
619 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
620 OPACUserJS => C4::Context->preference("OPACUserJS"),
621 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
622 OpenLibrarySearch => C4::Context->preference("OpenLibrarySearch"),
623 ShowReviewer => C4::Context->preference("ShowReviewer"),
624 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
625 suggestion => "" . C4::Context->preference("suggestion"),
626 virtualshelves => "" . C4::Context->preference("virtualshelves"),
627 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
628 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
629 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
630 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
631 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
632 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
633 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
634 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
635 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
636 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
637 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
638 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
639 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
640 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
641 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
642 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
643 useDischarge => C4::Context->preference('useDischarge'),
646 $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
649 # Check if we were asked using parameters to force a specific language
650 if ( defined $in->{'query'}->param('language') ) {
652 # Extract the language, let C4::Languages::getlanguage choose
654 my $language = C4::Languages::getlanguage( $in->{'query'} );
655 my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
656 if ( ref $cookie eq 'ARRAY' ) {
657 push @{$cookie}, $languagecookie;
659 $cookie = [ $cookie, $languagecookie ];
663 return ( $template, $borrowernumber, $cookie, $flags );
668 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
670 Verifies that the user is authorized to run this script. If
671 the user is authorized, a (userid, cookie, session-id, flags)
672 quadruple is returned. If the user is not authorized but does
673 not have the required privilege (see $flagsrequired below), it
674 displays an error page and exits. Otherwise, it displays the
675 login page and exits.
677 Note that C<&checkauth> will return if and only if the user
678 is authorized, so it should be called early on, before any
679 unfinished operations (e.g., if you've opened a file, then
680 C<&checkauth> won't close it for you).
682 C<$query> is the CGI object for the script calling C<&checkauth>.
684 The C<$noauth> argument is optional. If it is set, then no
685 authorization is required for the script.
687 C<&checkauth> fetches user and session information from C<$query> and
688 ensures that the user is authorized to run scripts that require
691 The C<$flagsrequired> argument specifies the required privileges
692 the user must have if the username and password are correct.
693 It should be specified as a reference-to-hash; keys in the hash
694 should be the "flags" for the user, as specified in the Members
695 intranet module. Any key specified must correspond to a "flag"
696 in the userflags table. E.g., { circulate => 1 } would specify
697 that the user must have the "circulate" privilege in order to
698 proceed. To make sure that access control is correct, the
699 C<$flagsrequired> parameter must be specified correctly.
701 Koha also has a concept of sub-permissions, also known as
702 granular permissions. This makes the value of each key
703 in the C<flagsrequired> hash take on an additional
708 The user must have access to all subfunctions of the module
709 specified by the hash key.
713 The user must have access to at least one subfunction of the module
714 specified by the hash key.
716 specific permission, e.g., 'export_catalog'
718 The user must have access to the specific subfunction list, which
719 must correspond to a row in the permissions table.
721 The C<$type> argument specifies whether the template should be
722 retrieved from the opac or intranet directory tree. "opac" is
723 assumed if it is not specified; however, if C<$type> is specified,
724 "intranet" is assumed if it is not "opac".
726 If C<$query> does not have a valid session ID associated with it
727 (i.e., the user has not logged in) or if the session has expired,
728 C<&checkauth> presents the user with a login page (from the point of
729 view of the original script, C<&checkauth> does not return). Once the
730 user has authenticated, C<&checkauth> restarts the original script
731 (this time, C<&checkauth> returns).
733 The login page is provided using a HTML::Template, which is set in the
734 systempreferences table or at the top of this file. The variable C<$type>
735 selects which template to use, either the opac or the intranet
736 authentification template.
738 C<&checkauth> returns a user ID, a cookie, and a session ID. The
739 cookie should be sent back to the browser; it verifies that the user
749 # If version syspref is unavailable, it means Koha is being installed,
750 # and so we must redirect to OPAC maintenance page or to the WebInstaller
751 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
752 if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
753 warn "OPAC Install required, redirecting to maintenance";
754 print $query->redirect("/cgi-bin/koha/maintenance.pl");
757 unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
758 if ( $type ne 'opac' ) {
759 warn "Install required, redirecting to Installer";
760 print $query->redirect("/cgi-bin/koha/installer/install.pl");
762 warn "OPAC Install required, redirecting to maintenance";
763 print $query->redirect("/cgi-bin/koha/maintenance.pl");
768 # check that database and koha version are the same
769 # there is no DB version, it's a fresh install,
770 # go to web installer
771 # there is a DB version, compare it to the code version
772 my $kohaversion = Koha::version();
774 # remove the 3 last . to have a Perl number
775 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
776 Koha::Logger->get->debug("kohaversion : $kohaversion");
777 if ( $version < $kohaversion ) {
778 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
779 if ( $type ne 'opac' ) {
780 warn sprintf( $warning, 'Installer' );
781 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
783 warn sprintf( "OPAC: " . $warning, 'maintenance' );
784 print $query->redirect("/cgi-bin/koha/maintenance.pl");
790 sub _timeout_syspref {
791 my $default_timeout = 600;
792 my $timeout = C4::Context->preference('timeout') || $default_timeout;
794 # value in days, convert in seconds
795 if ( $timeout =~ /^(\d+)[dD]$/ ) {
796 $timeout = $1 * 86400;
798 # value in hours, convert in seconds
799 elsif ( $timeout =~ /^(\d+)[hH]$/ ) {
800 $timeout = $1 * 3600;
802 elsif ( $timeout !~ m/^\d+$/ ) {
803 warn "The value of the system preference 'timeout' is not correct, defaulting to $default_timeout";
804 $timeout = $default_timeout;
813 # Get shibboleth login attribute
814 my $shib = C4::Context->config('useshibboleth') && shib_ok();
815 my $shib_login = $shib ? get_login_shib() : undef;
817 # $authnotrequired will be set for scripts which will run without authentication
818 my $authnotrequired = shift;
819 my $flagsrequired = shift;
821 my $emailaddress = shift;
822 my $template_name = shift;
823 $type = 'opac' unless $type;
825 unless ( C4::Context->preference("OpacPublic") ) {
826 my @allowed_scripts_for_private_opac = qw(
828 opac-registration-email-sent.tt
829 opac-registration-confirmation.tt
830 opac-memberentry-update-submitted.tt
831 opac-password-recovery.tt
833 $authnotrequired = 0 unless grep { $_ eq $template_name }
834 @allowed_scripts_for_private_opac;
837 my $dbh = C4::Context->dbh;
838 my $timeout = _timeout_syspref();
840 _version_check( $type, $query );
845 my ( $userid, $cookie, $sessionID, $flags );
846 my $logout = $query->param('logout.x');
848 my $anon_search_history;
850 # This parameter is the name of the CAS server we want to authenticate against,
851 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
852 my $casparam = $query->param('cas');
853 my $q_userid = $query->param('userid') // '';
857 # Basic authentication is incompatible with the use of Shibboleth,
858 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
859 # and it may not be the attribute we want to use to match the koha login.
861 # Also, do not consider an empty REMOTE_USER.
863 # Finally, after those tests, we can assume (although if it would be better with
864 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
865 # and we can affect it to $userid.
866 if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
868 # Using Basic Authentication, no cookies required
869 $cookie = $query->cookie(
870 -name => 'CGISESSID',
874 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
878 elsif ( $emailaddress) {
879 # the Google OpenID Connect passes an email address
881 elsif ( $sessionID = $query->cookie("CGISESSID") ) { # assignment, not comparison
882 my ( $return, $more_info );
883 ( $return, $session, $more_info ) = check_cookie_auth( $sessionID, $flags,
884 { remote_addr => $ENV{REMOTE_ADDR}, skip_version_check => 1 }
887 if ( $return eq 'ok' ) {
888 Koha::Logger->get->debug(sprintf "AUTH_SESSION: (%s)\t%s %s - %s", map { $session->param($_) || q{} } qw(cardnumber firstname surname branch));
890 my $s_userid = $session->param('id');
893 if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
894 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
895 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
898 #if a user enters an id ne to the id in the current session, we need to log them in...
899 #first we need to clear the anonymous session...
900 $anon_search_history = $session->param('search_history');
903 C4::Context->_unset_userenv($sessionID);
907 # voluntary logout the user
908 # check wether the user was using their shibboleth session or a local one
909 my $shibSuccess = C4::Context->userenv->{'shibboleth'};
912 C4::Context->_unset_userenv($sessionID);
914 if ($cas and $caslogout) {
915 logout_cas($query, $type);
918 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
919 if ( $shib and $shib_login and $shibSuccess) {
924 $cookie = $query->cookie(
925 -name => 'CGISESSID',
926 -value => $session->id,
928 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
931 my $sessiontype = $session->param('sessiontype') || '';
932 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...
933 $flags = haspermission( $userid, $flagsrequired );
937 $info{'nopermission'} = 1;
941 } elsif ( !$logout ) {
942 if ( $return eq 'expired' ) {
943 $info{timed_out} = 1;
944 } elsif ( $return eq 'restricted' ) {
945 $info{oldip} = $more_info->{old_ip};
946 $info{newip} = $more_info->{new_ip};
947 $info{different_ip} = 1;
952 unless ( $loggedin ) {
958 #we initiate a session prior to checking for a username to allow for anonymous sessions...
959 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
961 # Save anonymous search history in new session so it can be retrieved
962 # by get_template_and_user to store it in user's search history after
963 # a successful login.
964 if ($anon_search_history) {
965 $session->param( 'search_history', $anon_search_history );
968 $sessionID = $session->id;
969 C4::Context->_new_userenv($sessionID);
970 $cookie = $query->cookie(
971 -name => 'CGISESSID',
972 -value => $sessionID,
974 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
976 my $pki_field = C4::Context->preference('AllowPKIAuth');
977 if ( !defined($pki_field) ) {
978 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
981 if ( ( $cas && $query->param('ticket') )
983 || ( $shib && $shib_login )
984 || $pki_field ne 'None'
987 my $password = $query->param('password');
989 my ( $return, $cardnumber );
991 # If shib is enabled and we have a shib login, does the login match a valid koha user
992 if ( $shib && $shib_login ) {
995 # Do not pass password here, else shib will not be checked in checkpw.
996 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $q_userid, undef, $query );
997 $userid = $retuserid;
998 $shibSuccess = $return;
999 $info{'invalidShibLogin'} = 1 unless ($return);
1002 # If shib login and match were successful, skip further login methods
1003 unless ($shibSuccess) {
1004 if ( $cas && $query->param('ticket') ) {
1006 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1007 checkpw( $dbh, $userid, $password, $query, $type );
1008 $userid = $retuserid;
1009 $info{'invalidCasLogin'} = 1 unless ($return);
1012 elsif ( $emailaddress ) {
1013 my $value = $emailaddress;
1015 # If we're looking up the email, there's a chance that the person
1016 # doesn't have a userid. So if there is none, we pass along the
1017 # borrower number, and the bits of code that need to know the user
1018 # ID will have to be smart enough to handle that.
1019 my $patrons = Koha::Patrons->search({ email => $value });
1020 if ($patrons->count) {
1022 # First the userid, then the borrowernum
1023 my $patron = $patrons->next;
1024 $value = $patron->userid || $patron->borrowernumber;
1028 $return = $value ? 1 : 0;
1033 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1034 || ( $pki_field eq 'emailAddress'
1035 && $ENV{'SSL_CLIENT_S_DN_Email'} )
1039 if ( $pki_field eq 'Common Name' ) {
1040 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1042 elsif ( $pki_field eq 'emailAddress' ) {
1043 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1045 # If we're looking up the email, there's a chance that the person
1046 # doesn't have a userid. So if there is none, we pass along the
1047 # borrower number, and the bits of code that need to know the user
1048 # ID will have to be smart enough to handle that.
1049 my $patrons = Koha::Patrons->search({ email => $value });
1050 if ($patrons->count) {
1052 # First the userid, then the borrowernum
1053 my $patron = $patrons->next;
1054 $value = $patron->userid || $patron->borrowernumber;
1060 $return = $value ? 1 : 0;
1066 my $request_method = $query->request_method();
1069 $request_method eq 'POST'
1070 || ( C4::Context->preference('AutoSelfCheckID')
1071 && $q_userid eq C4::Context->preference('AutoSelfCheckID') )
1075 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1076 checkpw( $dbh, $q_userid, $password, $query, $type );
1077 $userid = $retuserid if ($retuserid);
1078 $info{'invalid_username_or_password'} = 1 unless ($return);
1083 # If shib configured and shibOnly enabled, we should ignore anything other than a shibboleth type login.
1090 && C4::Context->preference('OPACShibOnly')
1092 || ( ( $type ne 'opac' )
1093 && C4::Context->preference('staffShibOnly') )
1100 # $return: 1 = valid user
1103 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1107 $info{'nopermission'} = 1;
1108 C4::Context->_unset_userenv($sessionID);
1110 my ( $borrowernumber, $firstname, $surname, $userflags,
1111 $branchcode, $branchname, $emailaddress, $desk_id,
1112 $desk_name, $register_id, $register_name );
1114 if ( $return == 1 ) {
1116 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1117 branches.branchname as branchname, email
1119 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1121 my $sth = $dbh->prepare("$select where userid=?");
1122 $sth->execute($userid);
1123 unless ( $sth->rows ) {
1124 $sth = $dbh->prepare("$select where cardnumber=?");
1125 $sth->execute($cardnumber);
1127 unless ( $sth->rows ) {
1128 $sth->execute($userid);
1132 ( $borrowernumber, $firstname, $surname, $userflags,
1133 $branchcode, $branchname, $emailaddress ) = $sth->fetchrow;
1136 # launch a sequence to check if we have a ip for the branch, i
1137 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1139 my $ip = $ENV{'REMOTE_ADDR'};
1141 # if they specify at login, use that
1142 if ( $query->param('branch') ) {
1143 $branchcode = $query->param('branch');
1144 my $library = Koha::Libraries->find($branchcode);
1145 $branchname = $library? $library->branchname: '';
1147 if ( $query->param('desk_id') ) {
1148 $desk_id = $query->param('desk_id');
1149 my $desk = Koha::Desks->find($desk_id);
1150 $desk_name = $desk ? $desk->desk_name : '';
1152 if ( C4::Context->preference('UseCashRegisters') ) {
1154 $query->param('register_id')
1155 ? Koha::Cash::Registers->find($query->param('register_id'))
1156 : Koha::Cash::Registers->search(
1157 { branch => $branchcode, branch_default => 1 },
1158 { rows => 1 } )->single;
1159 $register_id = $register->id if ($register);
1160 $register_name = $register->name if ($register);
1162 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search->as_list };
1163 if ( $type ne 'opac' and C4::Context->preference('AutoLocation') ) {
1165 # we have to check they are coming from the right ip range
1166 my $domain = $branches->{$branchcode}->{'branchip'};
1167 $domain =~ s|\.\*||g;
1168 if ( $ip !~ /^$domain/ ) {
1170 $cookie = $query->cookie(
1171 -name => 'CGISESSID',
1174 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1176 $info{'wrongip'} = 1;
1180 foreach my $br ( keys %$branches ) {
1182 # now we work with the treatment of ip
1183 my $domain = $branches->{$br}->{'branchip'};
1184 if ( $domain && $ip =~ /^$domain/ ) {
1185 $branchcode = $branches->{$br}->{'branchcode'};
1187 # new op dev : add the branchname to the cookie
1188 $branchname = $branches->{$br}->{'branchname'};
1192 my $is_sco_user = 0;
1193 if ( $query->param('sco_user_login') && ( $query->param('sco_user_login') eq '1' ) ){
1197 $session->param( 'number', $borrowernumber );
1198 $session->param( 'id', $userid );
1199 $session->param( 'cardnumber', $cardnumber );
1200 $session->param( 'firstname', $firstname );
1201 $session->param( 'surname', $surname );
1202 $session->param( 'branch', $branchcode );
1203 $session->param( 'branchname', $branchname );
1204 $session->param( 'desk_id', $desk_id);
1205 $session->param( 'desk_name', $desk_name);
1206 $session->param( 'flags', $userflags );
1207 $session->param( 'emailaddress', $emailaddress );
1208 $session->param( 'ip', $session->remote_addr() );
1209 $session->param( 'lasttime', time() );
1210 $session->param( 'interface', $type);
1211 $session->param( 'shibboleth', $shibSuccess );
1212 $session->param( 'register_id', $register_id );
1213 $session->param( 'register_name', $register_name );
1214 $session->param( 'sco_user', $is_sco_user );
1216 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1217 C4::Context->set_userenv(
1218 $session->param('number'), $session->param('id'),
1219 $session->param('cardnumber'), $session->param('firstname'),
1220 $session->param('surname'), $session->param('branch'),
1221 $session->param('branchname'), $session->param('flags'),
1222 $session->param('emailaddress'), $session->param('shibboleth'),
1223 $session->param('desk_id'), $session->param('desk_name'),
1224 $session->param('register_id'), $session->param('register_name')
1228 # $return: 0 = invalid user
1229 # reset to anonymous session
1232 $info{'invalid_username_or_password'} = 1;
1233 C4::Context->_unset_userenv($sessionID);
1235 $session->param( 'lasttime', time() );
1236 $session->param( 'ip', $session->remote_addr() );
1237 $session->param( 'sessiontype', 'anon' );
1238 $session->param( 'interface', $type);
1240 } # END if ( $q_userid
1241 elsif ( $type eq "opac" ) {
1243 # anonymous sessions are created only for the OPAC
1245 # setting a couple of other session vars...
1246 $session->param( 'ip', $session->remote_addr() );
1247 $session->param( 'lasttime', time() );
1248 $session->param( 'sessiontype', 'anon' );
1249 $session->param( 'interface', $type);
1251 } # END unless ($userid)
1253 # finished authentification, now respond
1254 if ( $loggedin || $authnotrequired )
1258 $cookie = $query->cookie(
1259 -name => 'CGISESSID',
1262 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1266 track_login_daily( $userid );
1268 # In case, that this request was a login attempt, we want to prevent that users can repost the opac login
1269 # request. We therefore redirect the user to the requested page again without the login parameters.
1270 # See Post/Redirect/Get (PRG) design pattern: https://en.wikipedia.org/wiki/Post/Redirect/Get
1271 if ( $type eq "opac" && $query->param('koha_login_context') && $query->param('koha_login_context') ne 'sco' && $query->param('password') && $query->param('userid') ) {
1272 my $uri = URI->new($query->url(-relative=>1, -query_string=>1));
1273 $uri->query_param_delete('userid');
1274 $uri->query_param_delete('password');
1275 $uri->query_param_delete('koha_login_context');
1276 print $query->redirect(-uri => $uri->as_string, -cookie => $cookie, -status=>'303 See other');
1280 return ( $userid, $cookie, $sessionID, $flags );
1285 # AUTH rejected, show the login/password template, after checking the DB.
1289 # get the inputs from the incoming query
1291 foreach my $name ( param $query) {
1292 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1293 my @value = $query->multi_param($name);
1294 push @inputs, { name => $name, value => $_ } for @value;
1297 my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1299 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1300 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1301 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1303 my $auth_template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1304 my $template = C4::Templates::gettemplate( $auth_template_name, $type, $query );
1308 script_name => get_script_name(),
1309 casAuthentication => C4::Context->preference("casAuthentication"),
1310 shibbolethAuthentication => $shib,
1311 suggestion => C4::Context->preference("suggestion"),
1312 virtualshelves => C4::Context->preference("virtualshelves"),
1313 LibraryName => "" . C4::Context->preference("LibraryName"),
1314 LibraryNameTitle => "" . $LibraryNameTitle,
1315 opacuserlogin => C4::Context->preference("opacuserlogin"),
1316 OpacFavicon => C4::Context->preference("OpacFavicon"),
1317 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1318 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1319 OPACUserJS => C4::Context->preference("OPACUserJS"),
1320 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1321 OpacCloud => C4::Context->preference("OpacCloud"),
1322 OpacTopissue => C4::Context->preference("OpacTopissue"),
1323 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1324 OpacBrowser => C4::Context->preference("OpacBrowser"),
1325 TagsEnabled => C4::Context->preference("TagsEnabled"),
1326 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1327 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1328 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1329 IntranetNav => C4::Context->preference("IntranetNav"),
1330 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1331 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
1332 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1333 IndependentBranches => C4::Context->preference("IndependentBranches"),
1334 AutoLocation => C4::Context->preference("AutoLocation"),
1335 wrongip => $info{'wrongip'},
1336 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1337 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1338 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1339 too_many_login_attempts => ( $patron and $patron->account_locked )
1342 $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1343 $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1344 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1345 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1347 if ( $type eq 'opac' ) {
1348 require Koha::Virtualshelves;
1349 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1355 some_public_shelves => $some_public_shelves,
1361 # Is authentication against multiple CAS servers enabled?
1362 require C4::Auth_with_cas;
1363 if ( multipleAuth() && !$casparam ) {
1364 my $casservers = getMultipleAuth();
1366 foreach my $key ( keys %$casservers ) {
1367 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1370 casServersLoop => \@tmplservers
1374 casServerUrl => login_cas_url($query, undef, $type),
1379 invalidCasLogin => $info{'invalidCasLogin'}
1384 #If shibOnly is enabled just go ahead and redirect directly
1385 if ( (($type eq 'opac') && C4::Context->preference('OPACShibOnly')) || (($type ne 'opac') && C4::Context->preference('staffShibOnly')) ) {
1386 my $redirect_url = login_shib_url( $query );
1387 print $query->redirect( -uri => "$redirect_url", -status => 303 );
1392 shibbolethAuthentication => $shib,
1393 shibbolethLoginUrl => login_shib_url($query),
1397 if (C4::Context->preference('GoogleOpenIDConnect')) {
1398 if ($query->param("OpenIDConnectFailed")) {
1399 my $reason = $query->param('OpenIDConnectFailed');
1400 $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1405 LibraryName => C4::Context->preference("LibraryName"),
1407 $template->param(%info);
1409 # $cookie = $query->cookie(CGISESSID => $session->id
1411 print $query->header(
1412 { type => 'text/html',
1415 'X-Frame-Options' => 'SAMEORIGIN'
1422 =head2 check_api_auth
1424 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1426 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1427 cookie, determine if the user has the privileges specified by C<$userflags>.
1429 C<check_api_auth> is is meant for authenticating users of web services, and
1430 consequently will always return and will not attempt to redirect the user
1433 If a valid session cookie is already present, check_api_auth will return a status
1434 of "ok", the cookie, and the Koha session ID.
1436 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1437 parameters and create a session cookie and Koha session if the supplied credentials
1440 Possible return values in C<$status> are:
1444 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1446 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1448 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1450 =item "expired -- session cookie has expired; API user should resubmit userid and password
1452 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1458 sub check_api_auth {
1461 my $flagsrequired = shift;
1462 my $dbh = C4::Context->dbh;
1463 my $timeout = _timeout_syspref();
1465 unless ( C4::Context->preference('Version') ) {
1467 # database has not been installed yet
1468 return ( "maintenance", undef, undef );
1470 my $kohaversion = Koha::version();
1471 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1472 if ( C4::Context->preference('Version') < $kohaversion ) {
1474 # database in need of version update; assume that
1475 # no API should be called while databsae is in
1477 return ( "maintenance", undef, undef );
1480 my ( $sessionID, $session );
1481 unless ( $query->param('userid') ) {
1482 $sessionID = $query->cookie("CGISESSID");
1484 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1487 ( $return, $session, undef ) = check_cookie_auth(
1488 $sessionID, $flagsrequired, { remote_addr => $ENV{REMOTE_ADDR} } );
1490 return ( $return, undef, undef ) # Cookie auth failed
1493 my $cookie = $query->cookie(
1494 -name => 'CGISESSID',
1495 -value => $session->id,
1497 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1499 return ( $return, undef, $session );
1504 my $userid = $query->param('userid');
1505 my $password = $query->param('password');
1506 my ( $return, $cardnumber, $cas_ticket );
1509 if ( $cas && $query->param('PT') ) {
1512 # In case of a CAS authentication, we use the ticket instead of the password
1513 my $PT = $query->param('PT');
1514 ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $dbh, $PT, $query ); # EXTERNAL AUTH
1517 # User / password auth
1518 unless ( $userid and $password ) {
1520 # caller did something wrong, fail the authenticateion
1521 return ( "failed", undef, undef );
1524 ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $dbh, $userid, $password, $query );
1527 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1528 my $session = get_session("");
1529 return ( "failed", undef, undef ) unless $session;
1531 my $sessionID = $session->id;
1532 C4::Context->_new_userenv($sessionID);
1533 my $cookie = $query->cookie(
1534 -name => 'CGISESSID',
1535 -value => $sessionID,
1537 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1539 if ( $return == 1 ) {
1541 $borrowernumber, $firstname, $surname,
1542 $userflags, $branchcode, $branchname,
1547 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1549 $sth->execute($userid);
1551 $borrowernumber, $firstname, $surname,
1552 $userflags, $branchcode, $branchname,
1554 ) = $sth->fetchrow if ( $sth->rows );
1556 unless ( $sth->rows ) {
1557 my $sth = $dbh->prepare(
1558 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1560 $sth->execute($cardnumber);
1562 $borrowernumber, $firstname, $surname,
1563 $userflags, $branchcode, $branchname,
1565 ) = $sth->fetchrow if ( $sth->rows );
1567 unless ( $sth->rows ) {
1568 $sth->execute($userid);
1570 $borrowernumber, $firstname, $surname, $userflags,
1571 $branchcode, $branchname, $emailaddress
1572 ) = $sth->fetchrow if ( $sth->rows );
1576 my $ip = $ENV{'REMOTE_ADDR'};
1578 # if they specify at login, use that
1579 if ( $query->param('branch') ) {
1580 $branchcode = $query->param('branch');
1581 my $library = Koha::Libraries->find($branchcode);
1582 $branchname = $library? $library->branchname: '';
1584 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search->as_list };
1585 foreach my $br ( keys %$branches ) {
1587 # now we work with the treatment of ip
1588 my $domain = $branches->{$br}->{'branchip'};
1589 if ( $domain && $ip =~ /^$domain/ ) {
1590 $branchcode = $branches->{$br}->{'branchcode'};
1592 # new op dev : add the branchname to the cookie
1593 $branchname = $branches->{$br}->{'branchname'};
1596 $session->param( 'number', $borrowernumber );
1597 $session->param( 'id', $userid );
1598 $session->param( 'cardnumber', $cardnumber );
1599 $session->param( 'firstname', $firstname );
1600 $session->param( 'surname', $surname );
1601 $session->param( 'branch', $branchcode );
1602 $session->param( 'branchname', $branchname );
1603 $session->param( 'flags', $userflags );
1604 $session->param( 'emailaddress', $emailaddress );
1605 $session->param( 'ip', $session->remote_addr() );
1606 $session->param( 'lasttime', time() );
1607 $session->param( 'interface', 'api' );
1609 $session->param( 'cas_ticket', $cas_ticket);
1610 C4::Context->set_userenv(
1611 $session->param('number'), $session->param('id'),
1612 $session->param('cardnumber'), $session->param('firstname'),
1613 $session->param('surname'), $session->param('branch'),
1614 $session->param('branchname'), $session->param('flags'),
1615 $session->param('emailaddress'), $session->param('shibboleth'),
1616 $session->param('desk_id'), $session->param('desk_name'),
1617 $session->param('register_id'), $session->param('register_name')
1619 return ( "ok", $cookie, $sessionID );
1621 return ( "failed", undef, undef );
1626 =head2 check_cookie_auth
1628 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1630 Given a CGISESSID cookie set during a previous login to Koha, determine
1631 if the user has the privileges specified by C<$userflags>. C<$userflags>
1632 is passed unaltered into C<haspermission> and as such accepts all options
1633 avaiable to that routine with the one caveat that C<check_api_auth> will
1634 also allow 'undef' to be passed and in such a case the permissions check
1635 will be skipped altogether.
1637 C<check_cookie_auth> is meant for authenticating special services
1638 such as tools/upload-file.pl that are invoked by other pages that
1639 have been authenticated in the usual way.
1641 Possible return values in C<$status> are:
1645 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1647 =item "anon" -- user not authenticated but valid for anonymous session.
1649 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1651 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1653 =item "expired -- session cookie has expired; API user should resubmit userid and password
1655 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1661 sub check_cookie_auth {
1662 my $sessionID = shift;
1663 my $flagsrequired = shift;
1666 my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1668 my $skip_version_check = $params->{skip_version_check}; # Only for checkauth
1670 unless ( $skip_version_check ) {
1671 unless ( C4::Context->preference('Version') ) {
1673 # database has not been installed yet
1674 return ( "maintenance", undef );
1676 my $kohaversion = Koha::version();
1677 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1678 if ( C4::Context->preference('Version') < $kohaversion ) {
1680 # database in need of version update; assume that
1681 # no API should be called while databsae is in
1683 return ( "maintenance", undef );
1687 # see if we have a valid session cookie already
1688 # however, if a userid parameter is present (i.e., from
1689 # a form submission, assume that any current cookie
1691 unless ( defined $sessionID and $sessionID ) {
1692 return ( "failed", undef );
1694 my $session = get_session($sessionID);
1695 C4::Context->_new_userenv($sessionID);
1697 C4::Context->interface($session->param('interface'));
1698 C4::Context->set_userenv(
1699 $session->param('number'), $session->param('id') // '',
1700 $session->param('cardnumber'), $session->param('firstname'),
1701 $session->param('surname'), $session->param('branch'),
1702 $session->param('branchname'), $session->param('flags'),
1703 $session->param('emailaddress'), $session->param('shibboleth'),
1704 $session->param('desk_id'), $session->param('desk_name'),
1705 $session->param('register_id'), $session->param('register_name')
1708 my $userid = $session->param('id');
1709 my $ip = $session->param('ip');
1710 my $lasttime = $session->param('lasttime');
1711 my $timeout = _timeout_syspref();
1713 if ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
1718 C4::Context->_unset_userenv($sessionID);
1719 return ("expired", undef);
1720 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1722 # IP address changed
1725 C4::Context->_unset_userenv($sessionID);
1726 return ( "restricted", undef, { old_ip => $ip, new_ip => $remote_addr});
1727 } elsif ( $userid ) {
1728 $session->param( 'lasttime', time() );
1729 my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1731 return ( "ok", $session );
1734 return ( "anon", $session );
1736 # If here user was logged in, but doesn't have correct permissions
1737 # could be an 'else' at `if($flags) return "ok"` , but left here to catch any errors
1740 C4::Context->_unset_userenv($sessionID);
1741 return ( "failed", undef );
1743 return ( "expired", undef );
1750 my $session = get_session($sessionID);
1752 Given a session ID, retrieve the CGI::Session object used to store
1753 the session's state. The session object can be used to store
1754 data that needs to be accessed by different scripts during a
1757 If the C<$sessionID> parameter is an empty string, a new session
1762 sub _get_session_params {
1763 my $storage_method = C4::Context->preference('SessionStorage');
1764 if ( $storage_method eq 'mysql' ) {
1765 my $dbh = C4::Context->dbh;
1766 return { dsn => "serializer:yamlxs;driver:MySQL;id:md5", dsn_args => { Handle => $dbh } };
1768 elsif ( $storage_method eq 'Pg' ) {
1769 my $dbh = C4::Context->dbh;
1770 return { dsn => "serializer:yamlxs;driver:PostgreSQL;id:md5", dsn_args => { Handle => $dbh } };
1772 elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1773 my $memcached = Koha::Caches->get_instance()->memcached_cache;
1774 return { dsn => "serializer:yamlxs;driver:memcached;id:md5", dsn_args => { Memcached => $memcached } };
1777 # catch all defaults to tmp should work on all systems
1778 my $dir = C4::Context::temporary_directory;
1779 my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1780 return { dsn => "serializer:yamlxs;driver:File;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1785 my $sessionID = shift;
1786 my $params = _get_session_params();
1787 my $session = CGI::Session->new( $params->{dsn}, $sessionID, $params->{dsn_args} );
1789 die CGI::Session->errstr();
1795 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1796 # (or something similar)
1797 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1798 # not having a userenv defined could cause a crash.
1800 my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1801 $type = 'opac' unless $type;
1803 # Get shibboleth login attribute
1804 my $shib = C4::Context->config('useshibboleth') && shib_ok();
1805 my $shib_login = $shib ? get_login_shib() : undef;
1809 if ( defined $userid ){
1810 $patron = Koha::Patrons->find({ userid => $userid });
1811 $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1813 my $check_internal_as_fallback = 0;
1815 # Note: checkpw_* routines returns:
1818 # -1 if user bind failed (LDAP only)
1820 if ( $patron and $patron->account_locked ) {
1821 # Nothing to check, account is locked
1822 } elsif ($ldap && defined($password)) {
1823 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
1824 if ( $retval == 1 ) {
1825 @return = ( $retval, $retcard, $retuserid );
1828 $check_internal_as_fallback = 1 if $retval == 0;
1830 } elsif ( $cas && $query && $query->param('ticket') ) {
1832 # In case of a CAS authentication, we use the ticket instead of the password
1833 my $ticket = $query->param('ticket');
1834 $query->delete('ticket'); # remove ticket to come back to original URL
1835 my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $dbh, $ticket, $query, $type ); # EXTERNAL AUTH
1837 @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1841 $passwd_ok = $retval;
1844 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1845 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1847 elsif ( $shib && $shib_login && !$password ) {
1849 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1850 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1851 # shibboleth-authenticated user
1853 # Then, we check if it matches a valid koha user
1855 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
1857 @return = ( $retval, $retcard, $retuserid );
1859 $passwd_ok = $retval;
1862 $check_internal_as_fallback = 1;
1866 if ( $check_internal_as_fallback ) {
1867 @return = checkpw_internal( $dbh, $userid, $password, $no_set_userenv);
1868 $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1873 $patron->update({ login_attempts => 0 });
1874 } elsif( !$patron->account_locked ) {
1875 $patron->update({ login_attempts => $patron->login_attempts + 1 });
1879 # Optionally log success or failure
1880 if( $patron && $passwd_ok && C4::Context->preference('AuthSuccessLog') ) {
1881 logaction( 'AUTH', 'SUCCESS', $patron->id, "Valid password for $userid", $type );
1882 } elsif( !$passwd_ok && C4::Context->preference('AuthFailureLog') ) {
1883 logaction( 'AUTH', 'FAILURE', $patron ? $patron->id : 0, "Wrong password for $userid", $type );
1889 sub checkpw_internal {
1890 my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
1892 $password = Encode::encode( 'UTF-8', $password )
1893 if Encode::is_utf8($password);
1897 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1899 $sth->execute($userid);
1901 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1902 $surname, $branchcode, $branchname, $flags )
1905 if ( checkpw_hash( $password, $stored_hash ) ) {
1907 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1908 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1909 return 1, $cardnumber, $userid;
1914 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1916 $sth->execute($userid);
1918 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1919 $surname, $branchcode, $branchname, $flags )
1922 if ( checkpw_hash( $password, $stored_hash ) ) {
1924 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1925 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1926 return 1, $cardnumber, $userid;
1933 my ( $password, $stored_hash ) = @_;
1935 return if $stored_hash eq '!';
1937 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1939 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1940 $hash = hash_password( $password, $stored_hash );
1942 $hash = md5_base64($password);
1944 return $hash eq $stored_hash;
1949 my $authflags = getuserflags($flags, $userid, [$dbh]);
1951 Translates integer flags into permissions strings hash.
1953 C<$flags> is the integer userflags value ( borrowers.userflags )
1954 C<$userid> is the members.userid, used for building subpermissions
1955 C<$authflags> is a hashref of permissions
1962 my $dbh = @_ ? shift : C4::Context->dbh;
1965 # I don't want to do this, but if someone logs in as the database
1966 # user, it would be preferable not to spam them to death with
1967 # numeric warnings. So, we make $flags numeric.
1968 no warnings 'numeric';
1971 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1974 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1975 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1976 $userflags->{$flag} = 1;
1979 $userflags->{$flag} = 0;
1983 # get subpermissions and merge with top-level permissions
1984 my $user_subperms = get_user_subpermissions($userid);
1985 foreach my $module ( keys %$user_subperms ) {
1986 next if $userflags->{$module} == 1; # user already has permission for everything in this module
1987 $userflags->{$module} = $user_subperms->{$module};
1993 =head2 get_user_subpermissions
1995 $user_perm_hashref = get_user_subpermissions($userid);
1997 Given the userid (note, not the borrowernumber) of a staff user,
1998 return a hashref of hashrefs of the specific subpermissions
1999 accorded to the user. An example return is
2003 export_catalog => 1,
2004 import_patrons => 1,
2008 The top-level hash-key is a module or function code from
2009 userflags.flag, while the second-level key is a code
2012 The results of this function do not give a complete picture
2013 of the functions that a staff user can access; it is also
2014 necessary to check borrowers.flags.
2018 sub get_user_subpermissions {
2021 my $dbh = C4::Context->dbh;
2022 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2023 FROM user_permissions
2024 JOIN permissions USING (module_bit, code)
2025 JOIN userflags ON (module_bit = bit)
2026 JOIN borrowers USING (borrowernumber)
2027 WHERE userid = ?" );
2028 $sth->execute($userid);
2030 my $user_perms = {};
2031 while ( my $perm = $sth->fetchrow_hashref ) {
2032 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2037 =head2 get_all_subpermissions
2039 my $perm_hashref = get_all_subpermissions();
2041 Returns a hashref of hashrefs defining all specific
2042 permissions currently defined. The return value
2043 has the same structure as that of C<get_user_subpermissions>,
2044 except that the innermost hash value is the description
2045 of the subpermission.
2049 sub get_all_subpermissions {
2050 my $dbh = C4::Context->dbh;
2051 my $sth = $dbh->prepare( "SELECT flag, code
2053 JOIN userflags ON (module_bit = bit)" );
2057 while ( my $perm = $sth->fetchrow_hashref ) {
2058 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2063 =head2 haspermission
2065 $flagsrequired = '*'; # Any permission at all
2066 $flagsrequired = 'a_flag'; # a_flag must be satisfied (all subpermissions)
2067 $flagsrequired = [ 'a_flag', 'b_flag' ]; # a_flag OR b_flag must be satisfied
2068 $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 }; # a_flag AND b_flag must be satisfied
2069 $flagsrequired = { 'a_flag' => 'sub_a' }; # sub_a of a_flag must be satisfied
2070 $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2072 $flags = ($userid, $flagsrequired);
2074 C<$userid> the userid of the member
2075 C<$flags> is a query structure similar to that used by SQL::Abstract that
2076 denotes the combination of flags required. It is a required parameter.
2078 The main logic of this method is that things in arrays are OR'ed, and things
2079 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2081 Returns member's flags or 0 if a permission is not met.
2086 my ($required, $flags) = @_;
2088 my $ref = ref($required);
2090 if ($required eq '*') {
2091 return 0 unless ( $flags or ref( $flags ) );
2093 return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2095 } elsif ($ref eq 'HASH') {
2096 foreach my $key (keys %{$required}) {
2097 next if $flags == 1;
2098 my $require = $required->{$key};
2099 my $rflags = $flags->{$key};
2100 return 0 unless _dispatch($require, $rflags);
2102 } elsif ($ref eq 'ARRAY') {
2104 foreach my $require ( @{$required} ) {
2106 ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2107 ? $flags->{$require}
2109 $satisfied++ if _dispatch( $require, $rflags );
2111 return 0 unless $satisfied;
2113 croak "Unexpected structure found: $ref";
2120 my ( $userid, $flagsrequired ) = @_;
2122 #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2123 # unless defined($flagsrequired);
2125 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2126 $sth->execute($userid);
2127 my $row = $sth->fetchrow();
2128 my $flags = getuserflags( $row, $userid );
2130 return $flags unless defined($flagsrequired);
2131 return $flags if $flags->{superlibrarian};
2132 return _dispatch($flagsrequired, $flags);
2134 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2139 $flags = ($iprange);
2141 C<$iprange> A space separated string describing an IP range. Can include single IPs or ranges
2143 Returns 1 if the remote address is in the provided iprange, or 0 otherwise.
2150 my @allowedipranges = $iprange ? split(' ', $iprange) : ();
2151 if (scalar @allowedipranges > 0) {
2153 eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2154 eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || Koha::Logger->get->warn('cidrlookup failed for ' . join(' ',@rangelist) );
2156 return $result ? 1 : 0;
2159 sub getborrowernumber {
2161 my $userenv = C4::Context->userenv;
2162 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2163 return $userenv->{number};
2165 my $dbh = C4::Context->dbh;
2166 for my $field ( 'userid', 'cardnumber' ) {
2168 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2169 $sth->execute($userid);
2171 my ($bnumber) = $sth->fetchrow;
2178 =head2 track_login_daily
2180 track_login_daily( $userid );
2182 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2186 sub track_login_daily {
2188 return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2190 my $cache = Koha::Caches->get_instance();
2191 my $cache_key = "track_login_" . $userid;
2192 my $cached = $cache->get_from_cache($cache_key);
2193 my $today = dt_from_string()->ymd;
2194 return if $cached && $cached eq $today;
2196 my $patron = Koha::Patrons->find({ userid => $userid });
2197 return unless $patron;
2198 $patron->track_login;
2199 $cache->set_in_cache( $cache_key, $today );
2202 END { } # module clean-up code here (global destructor)
2212 Crypt::Eksblowfish::Bcrypt(3)