C4/Auth.pm

   1 package C4::Auth;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   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.
  11 #
  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.
  16 #
  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>.
  19
  20 use strict;
  21 use warnings;
  22 use Carp qw( croak );
  23
  24 use Digest::MD5 qw( md5_base64 );
  25 use CGI::Session;
  26 use CGI::Session::ErrorHandler;
  27 use URI;
  28 use URI::QueryParam;
  29
  30 use C4::Context;
  31 use C4::Templates;    # to get the template
  32 use C4::Languages;
  33 use C4::Search::History;
  34 use Koha;
  35 use Koha::Logger;
  36 use Koha::Caches;
  37 use Koha::AuthUtils qw( get_script_name hash_password );
  38 use Koha::Auth::TwoFactorAuth;
  39 use Koha::Checkouts;
  40 use Koha::DateUtils qw( dt_from_string );
  41 use Koha::Library::Groups;
  42 use Koha::Libraries;
  43 use Koha::Cash::Registers;
  44 use Koha::Desks;
  45 use Koha::Patrons;
  46 use Koha::Patron::Consents;
  47 use List::MoreUtils qw( any );
  48 use Encode;
  49 use C4::Auth_with_shibboleth qw( shib_ok get_login_shib login_shib_url logout_shib checkpw_shib );
  50 use Net::CIDR;
  51 use C4::Log qw( logaction );
  52 use Koha::CookieManager;
  53 use Koha::Auth::Permissions;
  54
  55 # use utf8;
  56
  57 use vars qw($ldap $cas $caslogout);
  58 our (@ISA, @EXPORT_OK);
  59
  60 #NOTE: The utility of keeping the safe_exit function is that it can be easily re-defined in unit tests and plugins
  61 sub safe_exit {
  62     # It's fine for us to "exit" because CGI::Compile (used in Plack::App::WrapCGI) redefines "exit" for us automatically.
  63     # Since we only seem to use C4::Auth::safe_exit in a CGI context, we don't actually need PSGI detection at all here.
  64     exit;
  65 }
  66
  67
  68 BEGIN {
  69     C4::Context->set_remote_address;
  70
  71     require Exporter;
  72     @ISA = qw(Exporter);
  73
  74     @EXPORT_OK = qw(
  75       checkauth check_api_auth get_session check_cookie_auth checkpw checkpw_internal checkpw_hash
  76       get_all_subpermissions get_user_subpermissions track_login_daily in_iprange
  77       get_template_and_user haspermission create_basic_session
  78     );
  79
  80     $ldap      = C4::Context->config('useldapserver') || 0;
  81     $cas       = C4::Context->preference('casAuthentication');
  82     $caslogout = C4::Context->preference('casLogout');
  83
  84     if ($ldap) {
  85         require C4::Auth_with_ldap;
  86         import C4::Auth_with_ldap qw(checkpw_ldap);
  87     }
  88     if ($cas) {
  89         require C4::Auth_with_cas;    # no import
  90         import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url logout_if_required multipleAuth getMultipleAuth);
  91     }
  92
  93 }
  94
  95 =head1 NAME
  96
  97 C4::Auth - Authenticates Koha users
  98
  99 =head1 SYNOPSIS
 100
 101   use CGI qw ( -utf8 );
 102   use C4::Auth;
 103   use C4::Output;
 104
 105   my $query = CGI->new;
 106
 107   my ($template, $borrowernumber, $cookie)
 108     = get_template_and_user(
 109         {
 110             template_name   => "opac-main.tt",
 111             query           => $query,
 112       type            => "opac",
 113       authnotrequired => 0,
 114       flagsrequired   => { catalogue => '*', tools => 'import_patrons' },
 115   }
 116     );
 117
 118   output_html_with_http_headers $query, $cookie, $template->output;
 119
 120 =head1 DESCRIPTION
 121
 122 The main function of this module is to provide
 123 authentification. However the get_template_and_user function has
 124 been provided so that a users login information is passed along
 125 automatically. This gets loaded into the template.
 126
 127 =head1 FUNCTIONS
 128
 129 =head2 get_template_and_user
 130
 131  my ($template, $borrowernumber, $cookie)
 132      = get_template_and_user(
 133        {
 134          template_name   => "opac-main.tt",
 135          query           => $query,
 136          type            => "opac",
 137          authnotrequired => 0,
 138          flagsrequired   => { catalogue => '*', tools => 'import_patrons' },
 139        }
 140      );
 141
 142 This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
 143 to C<&checkauth> (in this module) to perform authentification.
 144 See C<&checkauth> for an explanation of these parameters.
 145
 146 The C<template_name> is then used to find the correct template for
 147 the page. The authenticated users details are loaded onto the
 148 template in the logged_in_user variable (which is a Koha::Patron object). Also the
 149 C<sessionID> is passed to the template. This can be used in templates
 150 if cookies are disabled. It needs to be put as and input to every
 151 authenticated page.
 152
 153 More information on the C<gettemplate> sub can be found in the
 154 Output.pm module.
 155
 156 =cut
 157
 158 sub get_template_and_user {
 159
 160     my $in = shift;
 161     my ( $user, $cookie, $sessionID, $flags );
 162     $cookie = [];
 163
 164     my $cookie_mgr = Koha::CookieManager->new;
 165
 166     # Get shibboleth login attribute
 167     my $shib = C4::Context->config('useshibboleth') && shib_ok();
 168     my $shib_login = $shib ? get_login_shib() : undef;
 169
 170     C4::Context->interface( $in->{type} );
 171
 172     $in->{'authnotrequired'} ||= 0;
 173
 174     # the following call includes a bad template check; might croak
 175     my $template = C4::Templates::gettemplate(
 176         $in->{'template_name'},
 177         $in->{'type'},
 178         $in->{'query'},
 179     );
 180
 181     if ( $in->{'template_name'} !~ m/maintenance/ ) {
 182         ( $user, $cookie, $sessionID, $flags ) = checkauth(
 183             $in->{'query'},
 184             $in->{'authnotrequired'},
 185             $in->{'flagsrequired'},
 186             $in->{'type'},
 187             undef,
 188             $in->{template_name},
 189         );
 190     }
 191
 192     # If we enforce GDPR and the user did not consent, redirect
 193     # Exceptions for consent page itself and SCI/SCO system
 194     if( $in->{type} eq 'opac' && $user &&
 195         $in->{'template_name'} !~ /^(opac-page|opac-patron-consent|sc[io]\/)/ &&
 196         C4::Context->preference('GDPR_Policy') eq 'Enforced' )
 197     {
 198         my $consent = Koha::Patron::Consents->search({
 199             borrowernumber => getborrowernumber($user),
 200             type => 'GDPR_PROCESSING',
 201             given_on => { '!=', undef },
 202         })->next;
 203         if( !$consent ) {
 204             print $in->{query}->redirect(-uri => '/cgi-bin/koha/opac-patron-consent.pl', -cookie => $cookie);
 205             safe_exit;
 206         }
 207     }
 208
 209     if ( $in->{type} eq 'opac' && $user ) {
 210         my $is_sco_user;
 211         if ($sessionID){
 212             my $session = get_session($sessionID);
 213             if ($session){
 214                 $is_sco_user = $session->param('sco_user');
 215             }
 216         }
 217         my $kick_out;
 218
 219         if (
 220 # If the user logged in is the SCO user and they try to go out of the SCO module,
 221 # log the user out removing the CGISESSID cookie
 222             $in->{template_name} !~ m|sco/| && $in->{template_name} !~ m|errors/errorpage.tt|
 223             && (
 224                 $is_sco_user ||
 225                 (
 226                     C4::Context->preference('AutoSelfCheckID')
 227                     && $user eq C4::Context->preference('AutoSelfCheckID')
 228                 )
 229             )
 230           )
 231         {
 232             $kick_out = 1;
 233         }
 234         elsif (
 235 # If the user logged in is the SCI user and they try to go out of the SCI module,
 236 # kick them out unless it is SCO with a valid permission
 237 # or they are a superlibrarian
 238                $in->{template_name} !~ m|sci/|
 239             && haspermission( $user, { self_check => 'self_checkin_module' } )
 240             && !(
 241                 $in->{template_name} =~ m|sco/| && haspermission(
 242                     $user, { self_check => 'self_checkout_module' }
 243                 )
 244             )
 245             && $flags && $flags->{superlibrarian} != 1
 246           )
 247         {
 248             $kick_out = 1;
 249         }
 250
 251         if ($kick_out) {
 252             $template = C4::Templates::gettemplate( 'opac-auth.tt', 'opac',
 253                 $in->{query} );
 254             $cookie = $cookie_mgr->replace_in_list( $cookie, $in->{query}->cookie(
 255                 -name     => 'CGISESSID',
 256                 -value    => '',
 257                 -HttpOnly => 1,
 258                 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
 259                 -sameSite => 'Lax',
 260             ));
 261
 262             my $auth_error = $in->{query}->param('auth_error');
 263
 264             $template->param(
 265                 loginprompt => 1,
 266                 script_name => get_script_name(),
 267                 auth_error  => $auth_error,
 268             );
 269
 270             print $in->{query}->header(
 271                 {
 272                     type              => 'text/html',
 273                     charset           => 'utf-8',
 274                     cookie            => $cookie,
 275                     'X-Frame-Options' => 'SAMEORIGIN'
 276                 }
 277               ),
 278               $template->output;
 279             safe_exit;
 280         }
 281     }
 282
 283     my $borrowernumber;
 284     if ($user) {
 285
 286         # It's possible for $user to be the borrowernumber if they don't have a
 287         # userid defined (and are logging in through some other method, such
 288         # as SSL certs against an email address)
 289         my $patron;
 290         $borrowernumber = getborrowernumber($user) if defined($user);
 291         if ( !defined($borrowernumber) && defined($user) ) {
 292             $patron = Koha::Patrons->find( $user );
 293             if ($patron) {
 294                 $borrowernumber = $user;
 295
 296                 # A bit of a hack, but I don't know there's a nicer way
 297                 # to do it.
 298                 $user = $patron->firstname . ' ' . $patron->surname;
 299             }
 300         } else {
 301             $patron = Koha::Patrons->find( $borrowernumber );
 302             # FIXME What to do if $patron does not exist?
 303         }
 304
 305         # user info
 306         $template->param( loggedinusername   => $user ); # OBSOLETE - Do not reuse this in template, use logged_in_user.userid instead
 307         $template->param( loggedinusernumber => $borrowernumber ); # FIXME Should be replaced with logged_in_user.borrowernumber
 308         $template->param( logged_in_user     => $patron );
 309         $template->param( sessionID          => $sessionID );
 310
 311         if ( $in->{'type'} eq 'opac' ) {
 312             require Koha::Virtualshelves;
 313             my $some_private_shelves = Koha::Virtualshelves->get_some_shelves(
 314                 {
 315                     borrowernumber => $borrowernumber,
 316                     public         => 0,
 317                 }
 318             );
 319             my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
 320                 {
 321                     public => 1,
 322                 }
 323             );
 324             $template->param(
 325                 some_private_shelves => $some_private_shelves,
 326                 some_public_shelves  => $some_public_shelves,
 327             );
 328         }
 329
 330         # We are going to use the $flags returned by checkauth
 331         # to create the template's parameters that will indicate
 332         # which menus the user can access.
 333         my $authz = Koha::Auth::Permissions->get_authz_from_flags({ flags => $flags });
 334         foreach my $permission ( keys %{ $authz } ){
 335             $template->param( $permission => $authz->{$permission} );
 336         }
 337
 338         # Logged-in opac search history
 339         # If the requested template is an opac one and opac search history is enabled
 340         if ( $in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory') ) {
 341             my $dbh   = C4::Context->dbh;
 342             my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
 343             my $sth   = $dbh->prepare($query);
 344             $sth->execute($borrowernumber);
 345
 346             # If at least one search has already been performed
 347             if ( $sth->fetchrow_array > 0 ) {
 348
 349                 # We show the link in opac
 350                 $template->param( EnableOpacSearchHistory => 1 );
 351             }
 352             if (C4::Context->preference('LoadSearchHistoryToTheFirstLoggedUser'))
 353             {
 354                 # And if there are searches performed when the user was not logged in,
 355                 # we add them to the logged-in search history
 356                 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
 357                 if (@recentSearches) {
 358                     my $query = q{
 359                         INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, type,  total, time )
 360                         VALUES (?, ?, ?, ?, ?, ?, ?)
 361                     };
 362                     my $sth = $dbh->prepare($query);
 363                     $sth->execute( $borrowernumber,
 364                         $in->{query}->cookie("CGISESSID"),
 365                         $_->{query_desc},
 366                         $_->{query_cgi},
 367                         $_->{type} || 'biblio',
 368                         $_->{total},
 369                         $_->{time},
 370                     ) foreach @recentSearches;
 371
 372                     # clear out the search history from the session now that
 373                     # we've saved it to the database
 374                  }
 375               }
 376               C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } );
 377
 378         } elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) {
 379             $template->param( EnableSearchHistory => 1 );
 380         }
 381     }
 382     else {    # if this is an anonymous session, setup to display public lists...
 383
 384         # If shibboleth is enabled, and we're in an anonymous session, we should allow
 385         # the user to attempt login via shibboleth.
 386         if ($shib) {
 387             $template->param( shibbolethAuthentication => $shib,
 388                 shibbolethLoginUrl => login_shib_url( $in->{'query'} ),
 389             );
 390
 391             # If shibboleth is enabled and we have a shibboleth login attribute,
 392             # but we are in an anonymous session, then we clearly have an invalid
 393             # shibboleth koha account.
 394             if ($shib_login) {
 395                 $template->param( invalidShibLogin => '1' );
 396             }
 397         }
 398
 399         $template->param( sessionID => $sessionID );
 400
 401         if ( $in->{'type'} eq 'opac' ){
 402             require Koha::Virtualshelves;
 403             my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
 404                 {
 405                     public => 1,
 406                 }
 407             );
 408             $template->param(
 409                 some_public_shelves  => $some_public_shelves,
 410             );
 411
 412             # Set default branch if one has been passed by the environment.
 413             $template->param( default_branch => $ENV{OPAC_BRANCH_DEFAULT} ) if $ENV{OPAC_BRANCH_DEFAULT};
 414         }
 415     }
 416
 417     # Sysprefs disabled via URL param
 418     # Note that value must be defined in order to override via ENV
 419     foreach my $syspref (
 420         qw(
 421             OPACUserCSS
 422             OPACUserJS
 423             IntranetUserCSS
 424             IntranetUserJS
 425             OpacAdditionalStylesheet
 426             opaclayoutstylesheet
 427             intranetcolorstylesheet
 428             intranetstylesheet
 429         )
 430       )
 431     {
 432         $ENV{"OVERRIDE_SYSPREF_$syspref"} = q{}
 433           if $in->{'query'}->param("DISABLE_SYSPREF_$syspref");
 434     }
 435
 436     # Anonymous opac search history
 437     # If opac search history is enabled and at least one search has already been performed
 438     if ( C4::Context->preference('EnableOpacSearchHistory') ) {
 439         my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
 440         if (@recentSearches) {
 441             $template->param( EnableOpacSearchHistory => 1 );
 442         }
 443     }
 444
 445     if ( C4::Context->preference('dateformat') ) {
 446         $template->param( dateformat => C4::Context->preference('dateformat') );
 447     }
 448
 449     $template->param(auth_forwarded_hash => scalar $in->{'query'}->param('auth_forwarded_hash'));
 450
 451     # these template parameters are set the same regardless of $in->{'type'}
 452
 453     # Decide if the patron can make suggestions in the OPAC
 454     my $can_make_suggestions;
 455     if ( C4::Context->preference('Suggestion') && C4::Context->preference('AnonSuggestions') ) {
 456         $can_make_suggestions = 1;
 457     } elsif ( C4::Context->userenv && C4::Context->userenv->{'number'} ) {
 458         $can_make_suggestions = Koha::Patrons->find(C4::Context->userenv->{'number'})->category->can_make_suggestions;
 459     }
 460
 461     my $minPasswordLength = C4::Context->preference('minPasswordLength');
 462     $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
 463     $template->param(
 464         EnhancedMessagingPreferences                                       => C4::Context->preference('EnhancedMessagingPreferences'),
 465         GoogleJackets                                                      => C4::Context->preference("GoogleJackets"),
 466         OpenLibraryCovers                                                  => C4::Context->preference("OpenLibraryCovers"),
 467         KohaAdminEmailAddress                                              => "" . C4::Context->preference("KohaAdminEmailAddress"),
 468         LoginFirstname  => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
 469         LoginSurname    => C4::Context->userenv ? C4::Context->userenv->{"surname"}      : "Inconnu",
 470         emailaddress    => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
 471         TagsEnabled     => C4::Context->preference("TagsEnabled"),
 472         hide_marc       => C4::Context->preference("hide_marc"),
 473         item_level_itypes  => C4::Context->preference('item-level_itypes'),
 474         patronimages       => C4::Context->preference("patronimages"),
 475         singleBranchMode   => ( Koha::Libraries->search->count == 1 ),
 476         noItemTypeImages   => C4::Context->preference("noItemTypeImages"),
 477         marcflavour        => C4::Context->preference("marcflavour"),
 478         OPACBaseURL        => C4::Context->preference('OPACBaseURL'),
 479         minPasswordLength  => $minPasswordLength,
 480     );
 481     if ( $in->{'type'} eq "intranet" ) {
 482         $template->param(
 483             AmazonCoverImages                                                          => C4::Context->preference("AmazonCoverImages"),
 484             AutoLocation                                                               => C4::Context->preference("AutoLocation"),
 485             PatronAutoComplete                                                         => C4::Context->preference("PatronAutoComplete"),
 486             FRBRizeEditions                                                            => C4::Context->preference("FRBRizeEditions"),
 487             IndependentBranches                                                        => C4::Context->preference("IndependentBranches"),
 488             IntranetNav                                                                => C4::Context->preference("IntranetNav"),
 489             IntranetmainUserblock                                                      => C4::Context->preference("IntranetmainUserblock"),
 490             LibraryName                                                                => C4::Context->preference("LibraryName"),
 491             advancedMARCEditor                                                         => C4::Context->preference("advancedMARCEditor"),
 492             canreservefromotherbranches                                                => C4::Context->preference('canreservefromotherbranches'),
 493             intranetcolorstylesheet                                                    => C4::Context->preference("intranetcolorstylesheet"),
 494             IntranetFavicon                                                            => C4::Context->preference("IntranetFavicon"),
 495             intranetreadinghistory                                                     => C4::Context->preference("intranetreadinghistory"),
 496             intranetstylesheet                                                         => C4::Context->preference("intranetstylesheet"),
 497             IntranetUserCSS                                                            => C4::Context->preference("IntranetUserCSS"),
 498             IntranetUserJS                                                             => C4::Context->preference("IntranetUserJS"),
 499             suggestion                                                                 => $can_make_suggestions,
 500             virtualshelves                                                             => C4::Context->preference("virtualshelves"),
 501             StaffSerialIssueDisplayCount                                               => C4::Context->preference("StaffSerialIssueDisplayCount"),
 502             EasyAnalyticalRecords                                                      => C4::Context->preference('EasyAnalyticalRecords'),
 503             LocalCoverImages                                                           => C4::Context->preference('LocalCoverImages'),
 504             OPACLocalCoverImages                                                       => C4::Context->preference('OPACLocalCoverImages'),
 505             AllowMultipleCovers                                                        => C4::Context->preference('AllowMultipleCovers'),
 506             EnableBorrowerFiles                                                        => C4::Context->preference('EnableBorrowerFiles'),
 507             UseCourseReserves                                                          => C4::Context->preference("UseCourseReserves"),
 508             useDischarge                                                               => C4::Context->preference('useDischarge'),
 509             pending_checkout_notes                                                     => Koha::Checkouts->search({ noteseen => 0 }),
 510             plugins_enabled                                                            => C4::Context->config("enable_plugins"),
 511         );
 512     }
 513     else {
 514         warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
 515
 516         #TODO : replace LibraryName syspref with 'system name', and remove this html processing
 517         my $LibraryNameTitle = C4::Context->preference("LibraryName");
 518         $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
 519         $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
 520
 521         # clean up the busc param in the session
 522         # if the page is not opac-detail and not the "add to list" page
 523         # and not the "edit comments" page
 524         if ( C4::Context->preference("OpacBrowseResults")
 525             && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
 526             my $pagename = $1;
 527             unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
 528                 or $pagename =~ /^showmarc$/
 529                 or $pagename =~ /^addbybiblionumber$/
 530                 or $pagename =~ /^review$/ )
 531             {
 532                 my $sessionSearch = get_session( $sessionID );
 533                 $sessionSearch->clear( ["busc"] ) if $sessionSearch;
 534             }
 535         }
 536
 537         # variables passed from CGI: opac_css_override and opac_search_limits.
 538         my $opac_search_limit   = $ENV{'OPAC_SEARCH_LIMIT'};
 539         my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
 540         my $opac_name           = '';
 541         if (
 542             ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:([\w-]+)/ ) ||
 543             ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:([\w-]+)/ ) ||
 544             ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /multibranchlimit:(\w+)/ )
 545           ) {
 546             $opac_name = $1;    # opac_search_limit is a branch, so we use it.
 547         } elsif ( $in->{'query'}->param('multibranchlimit') ) {
 548             $opac_name = $in->{'query'}->param('multibranchlimit');
 549         } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
 550             $opac_name = C4::Context->userenv->{'branch'};
 551         }
 552
 553         my @search_groups = Koha::Library::Groups->get_search_groups({ interface => 'opac' })->as_list;
 554         $template->param(
 555             AnonSuggestions                       => "" . C4::Context->preference("AnonSuggestions"),
 556             LibrarySearchGroups                   => \@search_groups,
 557             opac_name                             => $opac_name,
 558             LibraryName                           => "" . C4::Context->preference("LibraryName"),
 559             LibraryNameTitle                      => "" . $LibraryNameTitle,
 560             OPACAmazonCoverImages                 => C4::Context->preference("OPACAmazonCoverImages"),
 561             OPACFRBRizeEditions                   => C4::Context->preference("OPACFRBRizeEditions"),
 562             OpacHighlightedWords                  => C4::Context->preference("OpacHighlightedWords"),
 563             OPACShelfBrowser                      => "" . C4::Context->preference("OPACShelfBrowser"),
 564             OPACURLOpenInNewWindow                => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
 565             OPACUserCSS                           => "" . C4::Context->preference("OPACUserCSS"),
 566             OpacAuthorities                       => C4::Context->preference("OpacAuthorities"),
 567             opac_css_override                     => $ENV{'OPAC_CSS_OVERRIDE'},
 568             opac_search_limit                     => $opac_search_limit,
 569             opac_limit_override                   => $opac_limit_override,
 570             OpacBrowser                           => C4::Context->preference("OpacBrowser"),
 571             OpacCloud                             => C4::Context->preference("OpacCloud"),
 572             OpacKohaUrl                           => C4::Context->preference("OpacKohaUrl"),
 573             OpacPasswordChange                    => C4::Context->preference("OpacPasswordChange"),
 574             OPACPatronDetails                     => C4::Context->preference("OPACPatronDetails"),
 575             OPACPrivacy                           => C4::Context->preference("OPACPrivacy"),
 576             OPACFinesTab                          => C4::Context->preference("OPACFinesTab"),
 577             OpacTopissue                          => C4::Context->preference("OpacTopissue"),
 578             'Version'                             => C4::Context->preference('Version'),
 579             hidelostitems                         => C4::Context->preference("hidelostitems"),
 580             mylibraryfirst                        => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
 581             opacbookbag                           => "" . C4::Context->preference("opacbookbag"),
 582             OpacFavicon                           => C4::Context->preference("OpacFavicon"),
 583             opaclanguagesdisplay                  => "" . C4::Context->preference("opaclanguagesdisplay"),
 584             opacreadinghistory                    => C4::Context->preference("opacreadinghistory"),
 585             OPACUserJS                            => C4::Context->preference("OPACUserJS"),
 586             opacuserlogin                         => "" . C4::Context->preference("opacuserlogin"),
 587             OpenLibrarySearch                     => C4::Context->preference("OpenLibrarySearch"),
 588             ShowReviewer                          => C4::Context->preference("ShowReviewer"),
 589             ShowReviewerPhoto                     => C4::Context->preference("ShowReviewerPhoto"),
 590             suggestion                            => $can_make_suggestions,
 591             virtualshelves                        => "" . C4::Context->preference("virtualshelves"),
 592             OPACSerialIssueDisplayCount           => C4::Context->preference("OPACSerialIssueDisplayCount"),
 593             SyndeticsClientCode                   => C4::Context->preference("SyndeticsClientCode"),
 594             SyndeticsEnabled                      => C4::Context->preference("SyndeticsEnabled"),
 595             SyndeticsCoverImages                  => C4::Context->preference("SyndeticsCoverImages"),
 596             SyndeticsTOC                          => C4::Context->preference("SyndeticsTOC"),
 597             SyndeticsSummary                      => C4::Context->preference("SyndeticsSummary"),
 598             SyndeticsEditions                     => C4::Context->preference("SyndeticsEditions"),
 599             SyndeticsExcerpt                      => C4::Context->preference("SyndeticsExcerpt"),
 600             SyndeticsReviews                      => C4::Context->preference("SyndeticsReviews"),
 601             SyndeticsAuthorNotes                  => C4::Context->preference("SyndeticsAuthorNotes"),
 602             SyndeticsAwards                       => C4::Context->preference("SyndeticsAwards"),
 603             SyndeticsSeries                       => C4::Context->preference("SyndeticsSeries"),
 604             SyndeticsCoverImageSize               => C4::Context->preference("SyndeticsCoverImageSize"),
 605             OPACLocalCoverImages                  => C4::Context->preference("OPACLocalCoverImages"),
 606             PatronSelfRegistration                => C4::Context->preference("PatronSelfRegistration"),
 607             PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
 608             useDischarge                 => C4::Context->preference('useDischarge'),
 609         );
 610
 611         $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
 612     }
 613
 614     # Check if we were asked using parameters to force a specific language
 615     if ( defined $in->{'query'}->param('language') ) {
 616
 617         # Extract the language, let C4::Languages::getlanguage choose
 618         # what to do
 619         my $language = C4::Languages::getlanguage( $in->{'query'} );
 620         my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
 621         $cookie = $cookie_mgr->replace_in_list( $cookie, $languagecookie );
 622     }
 623
 624     return ( $template, $borrowernumber, $cookie, $flags );
 625 }
 626
 627 =head2 checkauth
 628
 629   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 630
 631 Verifies that the user is authorized to run this script.  If
 632 the user is authorized, a (userid, cookie, session-id, flags)
 633 quadruple is returned.  If the user is not authorized but does
 634 not have the required privilege (see $flagsrequired below), it
 635 displays an error page and exits.  Otherwise, it displays the
 636 login page and exits.
 637
 638 Note that C<&checkauth> will return if and only if the user
 639 is authorized, so it should be called early on, before any
 640 unfinished operations (e.g., if you've opened a file, then
 641 C<&checkauth> won't close it for you).
 642
 643 C<$query> is the CGI object for the script calling C<&checkauth>.
 644
 645 The C<$noauth> argument is optional. If it is set, then no
 646 authorization is required for the script.
 647
 648 C<&checkauth> fetches user and session information from C<$query> and
 649 ensures that the user is authorized to run scripts that require
 650 authorization.
 651
 652 The C<$flagsrequired> argument specifies the required privileges
 653 the user must have if the username and password are correct.
 654 It should be specified as a reference-to-hash; keys in the hash
 655 should be the "flags" for the user, as specified in the Members
 656 intranet module. Any key specified must correspond to a "flag"
 657 in the userflags table. E.g., { circulate => 1 } would specify
 658 that the user must have the "circulate" privilege in order to
 659 proceed. To make sure that access control is correct, the
 660 C<$flagsrequired> parameter must be specified correctly.
 661
 662 Koha also has a concept of sub-permissions, also known as
 663 granular permissions.  This makes the value of each key
 664 in the C<flagsrequired> hash take on an additional
 665 meaning, i.e.,
 666
 667  1
 668
 669 The user must have access to all subfunctions of the module
 670 specified by the hash key.
 671
 672  *
 673
 674 The user must have access to at least one subfunction of the module
 675 specified by the hash key.
 676
 677  specific permission, e.g., 'export_catalog'
 678
 679 The user must have access to the specific subfunction list, which
 680 must correspond to a row in the permissions table.
 681
 682 The C<$type> argument specifies whether the template should be
 683 retrieved from the opac or intranet directory tree.  "opac" is
 684 assumed if it is not specified; however, if C<$type> is specified,
 685 "intranet" is assumed if it is not "opac".
 686
 687 If C<$query> does not have a valid session ID associated with it
 688 (i.e., the user has not logged in) or if the session has expired,
 689 C<&checkauth> presents the user with a login page (from the point of
 690 view of the original script, C<&checkauth> does not return). Once the
 691 user has authenticated, C<&checkauth> restarts the original script
 692 (this time, C<&checkauth> returns).
 693
 694 The login page is provided using a HTML::Template, which is set in the
 695 systempreferences table or at the top of this file. The variable C<$type>
 696 selects which template to use, either the opac or the intranet
 697 authentification template.
 698
 699 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 700 cookie should be sent back to the browser; it verifies that the user
 701 has authenticated.
 702
 703 =cut
 704
 705 sub _version_check {
 706     my $type  = shift;
 707     my $query = shift;
 708     my $version;
 709
 710     # If version syspref is unavailable, it means Koha is being installed,
 711     # and so we must redirect to OPAC maintenance page or to the WebInstaller
 712     # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
 713     if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
 714         warn "OPAC Install required, redirecting to maintenance";
 715         print $query->redirect("/cgi-bin/koha/maintenance.pl");
 716         safe_exit;
 717     }
 718     unless ( $version = C4::Context->preference('Version') ) {    # assignment, not comparison
 719         if ( $type ne 'opac' ) {
 720             warn "Install required, redirecting to Installer";
 721             print $query->redirect("/cgi-bin/koha/installer/install.pl");
 722         } else {
 723             warn "OPAC Install required, redirecting to maintenance";
 724             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 725         }
 726         safe_exit;
 727     }
 728
 729     # check that database and koha version are the same
 730     # there is no DB version, it's a fresh install,
 731     # go to web installer
 732     # there is a DB version, compare it to the code version
 733     my $kohaversion = Koha::version();
 734
 735     # remove the 3 last . to have a Perl number
 736     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 737     Koha::Logger->get->debug("kohaversion : $kohaversion");
 738     if ( $version < $kohaversion ) {
 739         my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
 740         if ( $type ne 'opac' ) {
 741             warn sprintf( $warning, 'Installer' );
 742             print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
 743         } else {
 744             warn sprintf( "OPAC: " . $warning, 'maintenance' );
 745             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 746         }
 747         safe_exit;
 748     }
 749 }
 750
 751 sub _timeout_syspref {
 752     my $default_timeout = 600;
 753     my $timeout = C4::Context->preference('timeout') || $default_timeout;
 754
 755     # value in days, convert in seconds
 756     if ( $timeout =~ /^(\d+)[dD]$/ ) {
 757         $timeout = $1 * 86400;
 758     }
 759     # value in hours, convert in seconds
 760     elsif ( $timeout =~ /^(\d+)[hH]$/ ) {
 761         $timeout = $1 * 3600;
 762     }
 763     elsif ( $timeout !~ m/^\d+$/ ) {
 764         warn "The value of the system preference 'timeout' is not correct, defaulting to $default_timeout";
 765         $timeout = $default_timeout;
 766     }
 767
 768     return $timeout;
 769 }
 770
 771 sub checkauth {
 772     my $query = shift;
 773
 774     # Get shibboleth login attribute
 775     my $shib = C4::Context->config('useshibboleth') && shib_ok();
 776     my $shib_login = $shib ? get_login_shib() : undef;
 777
 778     # $authnotrequired will be set for scripts which will run without authentication
 779     my $authnotrequired = shift;
 780     my $flagsrequired   = shift;
 781     my $type            = shift;
 782     my $emailaddress    = shift;
 783     my $template_name   = shift;
 784     $type = 'opac' unless $type;
 785
 786     if ( $type eq 'opac' && !C4::Context->preference("OpacPublic") ) {
 787         my @allowed_scripts_for_private_opac = qw(
 788           opac-memberentry.tt
 789           opac-registration-email-sent.tt
 790           opac-registration-confirmation.tt
 791           opac-memberentry-update-submitted.tt
 792           opac-password-recovery.tt
 793           opac-reset-password.tt
 794         );
 795         $authnotrequired = 0 unless grep { $_ eq $template_name }
 796           @allowed_scripts_for_private_opac;
 797     }
 798
 799     my $timeout = _timeout_syspref();
 800
 801     my $cookie_mgr = Koha::CookieManager->new;
 802
 803     _version_check( $type, $query );
 804
 805     # state variables
 806     my $loggedin = 0;
 807     my $auth_state = 'failed';
 808     my %info;
 809     my ( $userid, $cookie, $sessionID, $flags );
 810     $cookie = [];
 811     my $logout = $query->param('logout.x');
 812
 813     my $anon_search_history;
 814     my $cas_ticket = '';
 815     # This parameter is the name of the CAS server we want to authenticate against,
 816     # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
 817     my $casparam = $query->param('cas');
 818     my $q_userid = $query->param('userid') // '';
 819
 820     my $session;
 821     my $invalid_otp_token;
 822     my $require_2FA =
 823       ( $type ne "opac" # Only available for the staff interface
 824           && C4::Context->preference('TwoFactorAuthentication') ne "disabled" ) # If "enabled" or "enforced"
 825       ? 1 : 0;
 826
 827     # Basic authentication is incompatible with the use of Shibboleth,
 828     # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
 829     # and it may not be the attribute we want to use to match the koha login.
 830     #
 831     # Also, do not consider an empty REMOTE_USER.
 832     #
 833     # Finally, after those tests, we can assume (although if it would be better with
 834     # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
 835     # and we can affect it to $userid.
 836     if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
 837
 838         # Using Basic Authentication, no cookies required
 839         $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
 840             -name     => 'CGISESSID',
 841             -value    => '',
 842             -HttpOnly => 1,
 843             -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
 844             -sameSite => 'Lax',
 845         ));
 846         $loggedin = 1;
 847     }
 848     elsif ( $emailaddress) {
 849         # the Google OpenID Connect passes an email address
 850     }
 851     elsif ( $sessionID = $query->cookie("CGISESSID") ) {    # assignment, not comparison
 852         my ( $return, $more_info );
 853         # NOTE: $flags in the following call is still undefined !
 854         ( $return, $session, $more_info ) = check_cookie_auth( $sessionID, $flags,
 855             { remote_addr => $ENV{REMOTE_ADDR}, skip_version_check => 1 }
 856         );
 857
 858         if ( $return eq 'ok' || $return eq 'additional-auth-needed' ) {
 859             $userid = $session->param('id');
 860         }
 861
 862         $auth_state =
 863             $return eq 'ok'                     ? 'completed'
 864           : $return eq 'additional-auth-needed' ? 'additional-auth-needed'
 865           :                                       'failed';
 866
 867         # We are at the second screen if the waiting-for-2FA is set in session
 868         # and otp_token param has been passed
 869         if (   $require_2FA
 870             && $auth_state eq 'additional-auth-needed'
 871             && ( my $otp_token = $query->param('otp_token') ) )
 872         {
 873             my $patron    = Koha::Patrons->find( { userid => $userid } );
 874             my $auth      = Koha::Auth::TwoFactorAuth->new( { patron => $patron } );
 875             my $verified = $auth->verify($otp_token, 1);
 876             $auth->clear;
 877             if ( $verified ) {
 878                 # The token is correct, the user is fully logged in!
 879                 $auth_state = 'completed';
 880                 $session->param( 'waiting-for-2FA', 0 );
 881                 $session->param( 'waiting-for-2FA-setup', 0 );
 882
 883                # This is an ugly trick to pass the test
 884                # $query->param('koha_login_context') && ( $q_userid ne $userid )
 885                # few lines later
 886                 $q_userid = $userid;
 887             }
 888             else {
 889                 $invalid_otp_token = 1;
 890             }
 891         }
 892
 893         if ( $auth_state eq 'completed' ) {
 894             Koha::Logger->get->debug(sprintf "AUTH_SESSION: (%s)\t%s %s - %s", map { $session->param($_) || q{} } qw(cardnumber firstname surname branch));
 895
 896             if ( ( $query->param('koha_login_context') && ( $q_userid ne $userid ) )
 897                 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
 898                 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
 899             ) {
 900
 901                 #if a user enters an id ne to the id in the current session, we need to log them in...
 902                 #first we need to clear the anonymous session...
 903                 $anon_search_history = $session->param('search_history');
 904                 $session->delete();
 905                 $session->flush;
 906                 $cookie = $cookie_mgr->clear_unless( $query->cookie, @$cookie );
 907                 C4::Context::_unset_userenv($sessionID);
 908                 $sessionID = undef;
 909                 undef $userid; # IMPORTANT: this assures us a new session in code below
 910             } elsif (!$logout) {
 911
 912                 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
 913                     -name     => 'CGISESSID',
 914                     -value    => $session->id,
 915                     -HttpOnly => 1,
 916                     -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
 917                     -sameSite => 'Lax',
 918                 ));
 919
 920                 $flags = haspermission( $userid, $flagsrequired );
 921                 unless ( $flags ) {
 922                     $auth_state = 'failed';
 923                     $info{'nopermission'} = 1;
 924                 }
 925             }
 926         } elsif ( !$logout ) {
 927             if ( $return eq 'expired' ) {
 928                 $info{timed_out} = 1;
 929             } elsif ( $return eq 'restricted' ) {
 930                 $info{oldip}        = $more_info->{old_ip};
 931                 $info{newip}        = $more_info->{new_ip};
 932                 $info{different_ip} = 1;
 933             } elsif ( $return eq 'password_expired' ) {
 934                 $info{password_has_expired} = 1;
 935             }
 936         }
 937     }
 938
 939     if ( $auth_state eq 'failed' || $logout ) {
 940         $sessionID = undef;
 941         $userid    = undef;
 942     }
 943
 944     if ($logout) {
 945
 946         # voluntary logout the user
 947         # check wether the user was using their shibboleth session or a local one
 948         my $shibSuccess = C4::Context->userenv ? C4::Context->userenv->{'shibboleth'} : undef;
 949         if ( $session ) {
 950             $session->delete();
 951             $session->flush;
 952         }
 953         C4::Context::_unset_userenv($sessionID);
 954         $cookie = $cookie_mgr->clear_unless( $query->cookie, @$cookie );
 955
 956         if ($cas and $caslogout) {
 957             logout_cas($query, $type);
 958         }
 959
 960         # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
 961         if ( $shib and $shib_login and $shibSuccess) {
 962             logout_shib($query);
 963         }
 964
 965         $session   = undef;
 966         $auth_state = 'logout';
 967     }
 968
 969     unless ( $userid ) {
 970         #we initiate a session prior to checking for a username to allow for anonymous sessions...
 971         if( !$session or !$sessionID ) { # if we cleared sessionID, we need a new session
 972             $session = get_session() or die "Auth ERROR: Cannot get_session()";
 973         }
 974
 975         # Save anonymous search history in new session so it can be retrieved
 976         # by get_template_and_user to store it in user's search history after
 977         # a successful login.
 978         if ($anon_search_history) {
 979             $session->param( 'search_history', $anon_search_history );
 980         }
 981
 982         $sessionID = $session->id;
 983         C4::Context->_new_userenv($sessionID);
 984         $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
 985             -name     => 'CGISESSID',
 986             -value    => $sessionID,
 987             -HttpOnly => 1,
 988             -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
 989             -sameSite => 'Lax',
 990         ));
 991         my $pki_field = C4::Context->preference('AllowPKIAuth');
 992         if ( !defined($pki_field) ) {
 993             print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
 994             $pki_field = 'None';
 995         }
 996         if ( ( $cas && $query->param('ticket') )
 997             || $q_userid
 998             || ( $shib && $shib_login )
 999             || $pki_field ne 'None'
1000             || $emailaddress )
1001         {
1002             my $password    = $query->param('password');
1003             my $shibSuccess = 0;
1004             my ( $return, $cardnumber );
1005
1006             # If shib is enabled and we have a shib login, does the login match a valid koha user
1007             if ( $shib && $shib_login ) {
1008                 my $retuserid;
1009
1010                 # Do not pass password here, else shib will not be checked in checkpw.
1011                 ( $return, $cardnumber, $retuserid ) = checkpw( $q_userid, undef, $query );
1012                 $userid      = $retuserid;
1013                 $shibSuccess = $return;
1014                 $info{'invalidShibLogin'} = 1 unless ($return);
1015             }
1016
1017             # If shib login and match were successful, skip further login methods
1018             unless ($shibSuccess) {
1019                 if ( $cas && $query->param('ticket') ) {
1020                     my $retuserid;
1021                     ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1022                       checkpw( $userid, $password, $query, $type );
1023                     $userid = $retuserid;
1024                     $info{'invalidCasLogin'} = 1 unless ($return);
1025                 }
1026
1027                 elsif ( $emailaddress ) {
1028                     my $value = $emailaddress;
1029
1030                     # If we're looking up the email, there's a chance that the person
1031                     # doesn't have a userid. So if there is none, we pass along the
1032                     # borrower number, and the bits of code that need to know the user
1033                     # ID will have to be smart enough to handle that.
1034                     my $patrons = Koha::Patrons->search({ email => $value });
1035                     if ($patrons->count) {
1036
1037                         # First the userid, then the borrowernum
1038                         my $patron = $patrons->next;
1039                         $value = $patron->userid || $patron->borrowernumber;
1040                     } else {
1041                         undef $value;
1042                     }
1043                     $return = $value ? 1 : 0;
1044                     $userid = $value;
1045                 }
1046
1047                 elsif (
1048                     ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1049                     || ( $pki_field eq 'emailAddress'
1050                         && $ENV{'SSL_CLIENT_S_DN_Email'} )
1051                   )
1052                 {
1053                     my $value;
1054                     if ( $pki_field eq 'Common Name' ) {
1055                         $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1056                     }
1057                     elsif ( $pki_field eq 'emailAddress' ) {
1058                         $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1059
1060                         # If we're looking up the email, there's a chance that the person
1061                         # doesn't have a userid. So if there is none, we pass along the
1062                         # borrower number, and the bits of code that need to know the user
1063                         # ID will have to be smart enough to handle that.
1064                         my $patrons = Koha::Patrons->search({ email => $value });
1065                         if ($patrons->count) {
1066
1067                             # First the userid, then the borrowernum
1068                             my $patron = $patrons->next;
1069                             $value = $patron->userid || $patron->borrowernumber;
1070                         } else {
1071                             undef $value;
1072                         }
1073                     }
1074
1075                     $return = $value ? 1 : 0;
1076                     $userid = $value;
1077
1078                 }
1079                 else {
1080                     my $retuserid;
1081                     my $request_method = $query->request_method // q{};
1082
1083                     if (
1084                         $request_method eq 'POST'
1085                         || ( C4::Context->preference('AutoSelfCheckID')
1086                             && $q_userid eq C4::Context->preference('AutoSelfCheckID') )
1087                       )
1088                     {
1089
1090                         ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1091                           checkpw( $q_userid, $password, $query, $type );
1092                         $userid = $retuserid if ($retuserid);
1093                         $info{'invalid_username_or_password'} = 1 unless ($return);
1094                     }
1095                 }
1096             }
1097
1098             # If shib configured and shibOnly enabled, we should ignore anything other than a shibboleth type login.
1099             if (
1100                    $shib
1101                 && !$shibSuccess
1102                 && (
1103                     (
1104                         ( $type eq 'opac' )
1105                         && C4::Context->preference('OPACShibOnly')
1106                     )
1107                     || ( ( $type ne 'opac' )
1108                         && C4::Context->preference('staffShibOnly') )
1109                 )
1110               )
1111             {
1112                 $return = 0;
1113             }
1114
1115             # $return: 1 = valid user
1116             if( $return && $return > 0 ) {
1117
1118                 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1119                     $auth_state = "logged_in";
1120                 }
1121                 else {
1122                     $auth_state = 'failed';
1123                     # FIXME We could add $return = 0; or even delete the session?
1124                     # Currently return == 1 and we will fill session info later on,
1125                     # although we do present an authorization failure. (Yes, the
1126                     # authentication was actually correct.)
1127                     $info{'nopermission'} = 1;
1128                     C4::Context::_unset_userenv($sessionID);
1129                 }
1130                 my ( $borrowernumber, $firstname, $surname, $userflags,
1131                     $branchcode, $branchname, $emailaddress, $desk_id,
1132                     $desk_name, $register_id, $register_name );
1133
1134                 if ( $return == 1 ) {
1135                     my $select = "
1136                     SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1137                     branches.branchname    as branchname, email
1138                     FROM borrowers
1139                     LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1140                     ";
1141                     my $dbh = C4::Context->dbh;
1142                     my $sth = $dbh->prepare("$select where userid=?");
1143                     $sth->execute($userid);
1144                     unless ( $sth->rows ) {
1145                         $sth = $dbh->prepare("$select where cardnumber=?");
1146                         $sth->execute($cardnumber);
1147
1148                         unless ( $sth->rows ) {
1149                             $sth->execute($userid);
1150                         }
1151                     }
1152                     if ( $sth->rows ) {
1153                         ( $borrowernumber, $firstname, $surname, $userflags,
1154                             $branchcode, $branchname, $emailaddress ) = $sth->fetchrow;
1155                     }
1156
1157                     # launch a sequence to check if we have a ip for the branch, i
1158                     # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1159
1160                     my $ip = $ENV{'REMOTE_ADDR'};
1161
1162                     # if they specify at login, use that
1163                     my $patron = Koha::Patrons->find({userid => $userid});
1164                     if ( $query->param('branch')  && ( haspermission($userid, {  'loggedinlibrary'=> 1 }) || $patron->is_superlibrarian ) ) {
1165                         $branchcode = $query->param('branch');
1166                         my $library = Koha::Libraries->find($branchcode);
1167                         $branchname = $library? $library->branchname: '';
1168                     }
1169                     if ( $query->param('desk_id') ) {
1170                         $desk_id = $query->param('desk_id');
1171                         my $desk = Koha::Desks->find($desk_id);
1172                         $desk_name = $desk ? $desk->desk_name : '';
1173                     }
1174                     if ( C4::Context->preference('UseCashRegisters') ) {
1175                         my $register =
1176                           $query->param('register_id')
1177                           ? Koha::Cash::Registers->find($query->param('register_id'))
1178                           : Koha::Cash::Registers->search(
1179                             { branch => $branchcode, branch_default => 1 },
1180                             { rows   => 1 } )->single;
1181                         $register_id   = $register->id   if ($register);
1182                         $register_name = $register->name if ($register);
1183                     }
1184                     my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search->as_list };
1185                     if ( $type ne 'opac' and C4::Context->preference('AutoLocation') ) {
1186
1187                         # we have to check they are coming from the right ip range
1188                         my $domain = $branches->{$branchcode}->{'branchip'};
1189                         $domain =~ s|\.\*||g;
1190                         if ( $ip !~ /^$domain/ ) {
1191                             $loggedin = 0;
1192                             $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
1193                                 -name     => 'CGISESSID',
1194                                 -value    => '',
1195                                 -HttpOnly => 1,
1196                                 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1197                                 -sameSite => 'Lax',
1198                             ));
1199                             $info{'wrongip'} = 1;
1200                         }
1201                     }
1202
1203                     foreach my $br ( keys %$branches ) {
1204
1205                         #     now we work with the treatment of ip
1206                         my $domain = $branches->{$br}->{'branchip'};
1207                         if ( $domain && $ip =~ /^$domain/ ) {
1208                             $branchcode = $branches->{$br}->{'branchcode'};
1209
1210                             # new op dev : add the branchname to the cookie
1211                             $branchname    = $branches->{$br}->{'branchname'};
1212                         }
1213                     }
1214
1215                     my $is_sco_user = 0;
1216                     if ( $query->param('sco_user_login') && ( $query->param('sco_user_login') eq '1' ) ){
1217                         $is_sco_user = 1;
1218                     }
1219
1220                     $session->param( 'number',       $borrowernumber );
1221                     $session->param( 'id',           $userid );
1222                     $session->param( 'cardnumber',   $cardnumber );
1223                     $session->param( 'firstname',    $firstname );
1224                     $session->param( 'surname',      $surname );
1225                     $session->param( 'branch',       $branchcode );
1226                     $session->param( 'branchname',   $branchname );
1227                     $session->param( 'desk_id',      $desk_id);
1228                     $session->param( 'desk_name',     $desk_name);
1229                     $session->param( 'flags',        $userflags );
1230                     $session->param( 'emailaddress', $emailaddress );
1231                     $session->param( 'ip',           $session->remote_addr() );
1232                     $session->param( 'lasttime',     time() );
1233                     $session->param( 'interface',    $type);
1234                     $session->param( 'shibboleth',   $shibSuccess );
1235                     $session->param( 'register_id',  $register_id );
1236                     $session->param( 'register_name',  $register_name );
1237                     $session->param( 'sco_user', $is_sco_user );
1238                 }
1239                 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1240                 C4::Context->set_userenv(
1241                     $session->param('number'),       $session->param('id'),
1242                     $session->param('cardnumber'),   $session->param('firstname'),
1243                     $session->param('surname'),      $session->param('branch'),
1244                     $session->param('branchname'),   $session->param('flags'),
1245                     $session->param('emailaddress'), $session->param('shibboleth'),
1246                     $session->param('desk_id'),      $session->param('desk_name'),
1247                     $session->param('register_id'),  $session->param('register_name')
1248                 );
1249
1250             }
1251             # $return: 0 = invalid user
1252             # reset to anonymous session
1253             else {
1254                 if ($userid) {
1255                     $info{'invalid_username_or_password'} = 1;
1256                     C4::Context::_unset_userenv($sessionID);
1257                 }
1258                 $session->param( 'lasttime', time() );
1259                 $session->param( 'ip',       $session->remote_addr() );
1260                 $session->param( 'sessiontype', 'anon' );
1261                 $session->param( 'interface', $type);
1262             }
1263         }    # END if ( $q_userid
1264         elsif ( $type eq "opac" ) {
1265
1266             # anonymous sessions are created only for the OPAC
1267
1268             # setting a couple of other session vars...
1269             $session->param( 'ip',          $session->remote_addr() );
1270             $session->param( 'lasttime',    time() );
1271             $session->param( 'sessiontype', 'anon' );
1272             $session->param( 'interface', $type);
1273         }
1274         $session->flush;
1275     }    # END unless ($userid)
1276
1277
1278     if ( $auth_state eq 'logged_in' ) {
1279         $auth_state = 'completed';
1280
1281         # Auth is completed unless an additional auth is needed
1282         if ( $require_2FA ) {
1283             my $patron = Koha::Patrons->find({userid => $userid});
1284             if ( C4::Context->preference('TwoFactorAuthentication') eq "enforced" && $patron->auth_method eq 'password' ) {
1285                 $auth_state = 'setup-additional-auth-needed';
1286                 $session->param('waiting-for-2FA-setup', 1);
1287                 %info = ();# We remove the warnings/errors we may have set incorrectly before
1288             } elsif ( $patron->auth_method eq 'two-factor' ) {
1289                 # Ask for the OTP token
1290                 $auth_state = 'additional-auth-needed';
1291                 $session->param('waiting-for-2FA', 1);
1292                 %info = ();# We remove the warnings/errors we may have set incorrectly before
1293             }
1294         }
1295     }
1296
1297     # finished authentification, now respond
1298     if ( $auth_state eq 'completed' || $authnotrequired ) {
1299         # successful login
1300         unless (@$cookie) {
1301             $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
1302                 -name     => 'CGISESSID',
1303                 -value    => '',
1304                 -HttpOnly => 1,
1305                 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1306                 -sameSite => 'Lax',
1307             ));
1308         }
1309
1310         track_login_daily( $userid );
1311
1312         # In case, that this request was a login attempt, we want to prevent that users can repost the opac login
1313         # request. We therefore redirect the user to the requested page again without the login parameters.
1314         # See Post/Redirect/Get (PRG) design pattern: https://en.wikipedia.org/wiki/Post/Redirect/Get
1315         if ( $type eq "opac" && $query->param('koha_login_context') && $query->param('koha_login_context') ne 'sco' && $query->param('password') && $query->param('userid') ) {
1316             my $uri = URI->new($query->url(-relative=>1, -query_string=>1));
1317             $uri->query_param_delete('userid');
1318             $uri->query_param_delete('password');
1319             $uri->query_param_delete('koha_login_context');
1320             print $query->redirect(-uri => $uri->as_string, -cookie => $cookie, -status=>'303 See other');
1321             safe_exit;
1322         }
1323
1324         return ( $userid, $cookie, $sessionID, $flags );
1325     }
1326
1327     #
1328     #
1329     # AUTH rejected, show the login/password template, after checking the DB.
1330     #
1331     #
1332
1333     my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1334
1335     # get the inputs from the incoming query
1336     my @inputs = ();
1337     my @inputs_to_clean = qw( userid password ticket logout.x otp_token );
1338     foreach my $name ( param $query) {
1339         next if grep { $name eq $_ } @inputs_to_clean;
1340         my @value = $query->multi_param($name);
1341         push @inputs, { name => $name, value => $_ } for @value;
1342     }
1343
1344     my $LibraryNameTitle = C4::Context->preference("LibraryName");
1345     $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1346     $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1347
1348     my $auth_template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1349     my $auth_error = $query->param('auth_error');
1350     my $template = C4::Templates::gettemplate( $auth_template_name, $type, $query );
1351     $template->param(
1352         login                                 => 1,
1353         INPUTS                                => \@inputs,
1354         script_name                           => get_script_name(),
1355         casAuthentication                     => C4::Context->preference("casAuthentication"),
1356         shibbolethAuthentication              => $shib,
1357         suggestion                            => C4::Context->preference("suggestion"),
1358         virtualshelves                        => C4::Context->preference("virtualshelves"),
1359         LibraryName                           => "" . C4::Context->preference("LibraryName"),
1360         LibraryNameTitle                      => "" . $LibraryNameTitle,
1361         opacuserlogin                         => C4::Context->preference("opacuserlogin"),
1362         OpacFavicon                           => C4::Context->preference("OpacFavicon"),
1363         opacreadinghistory                    => C4::Context->preference("opacreadinghistory"),
1364         opaclanguagesdisplay                  => C4::Context->preference("opaclanguagesdisplay"),
1365         OPACUserJS                            => C4::Context->preference("OPACUserJS"),
1366         OPACUserCSS                           => C4::Context->preference("OPACUserCSS"),
1367         intranetcolorstylesheet               => C4::Context->preference("intranetcolorstylesheet"),
1368         intranetstylesheet                    => C4::Context->preference("intranetstylesheet"),
1369         IntranetNav                           => C4::Context->preference("IntranetNav"),
1370         IntranetFavicon                       => C4::Context->preference("IntranetFavicon"),
1371         IntranetUserCSS                       => C4::Context->preference("IntranetUserCSS"),
1372         IntranetUserJS                        => C4::Context->preference("IntranetUserJS"),
1373         IndependentBranches                   => C4::Context->preference("IndependentBranches"),
1374         AutoLocation                          => C4::Context->preference("AutoLocation"),
1375         wrongip                               => $info{'wrongip'},
1376         PatronSelfRegistration                => C4::Context->preference("PatronSelfRegistration"),
1377         PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1378         opac_css_override                     => $ENV{'OPAC_CSS_OVERRIDE'},
1379         too_many_login_attempts               => ( $patron and $patron->account_locked ),
1380         password_has_expired                  => ( $patron and $patron->password_expired ),
1381         auth_error                            => $auth_error,
1382     );
1383
1384     $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1385     $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1386     $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1387     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1388     if ( $auth_state eq 'additional-auth-needed' ) {
1389         my $patron = Koha::Patrons->find( { userid => $userid } );
1390         $template->param(
1391             TwoFA_prompt => 1,
1392             invalid_otp_token => $invalid_otp_token,
1393             notice_email_address => $patron->notice_email_address, # We could also pass logged_in_user if necessary
1394         );
1395     }
1396
1397     if ( $auth_state eq 'setup-additional-auth-needed' ) {
1398         $template->param(
1399             TwoFA_setup => 1,
1400         );
1401     }
1402
1403     if ( $type eq 'opac' ) {
1404         require Koha::Virtualshelves;
1405         my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1406             {
1407                 public => 1,
1408             }
1409         );
1410         $template->param(
1411             some_public_shelves  => $some_public_shelves,
1412         );
1413     }
1414
1415     if ($cas) {
1416
1417         # Is authentication against multiple CAS servers enabled?
1418         require C4::Auth_with_cas;
1419         if ( multipleAuth() && !$casparam ) {
1420             my $casservers = getMultipleAuth();
1421             my @tmplservers;
1422             foreach my $key ( keys %$casservers ) {
1423                 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1424             }
1425             $template->param(
1426                 casServersLoop => \@tmplservers
1427             );
1428         } else {
1429             $template->param(
1430                 casServerUrl => login_cas_url($query, undef, $type),
1431             );
1432         }
1433
1434         $template->param(
1435             invalidCasLogin => $info{'invalidCasLogin'}
1436         );
1437     }
1438
1439     if ($shib) {
1440         #If shibOnly is enabled just go ahead and redirect directly
1441         if ( (($type eq 'opac') && C4::Context->preference('OPACShibOnly')) || (($type ne 'opac') && C4::Context->preference('staffShibOnly')) ) {
1442             my $redirect_url = login_shib_url( $query );
1443             print $query->redirect( -uri => "$redirect_url", -status => 303 );
1444             safe_exit;
1445         }
1446
1447         $template->param(
1448             shibbolethAuthentication => $shib,
1449             shibbolethLoginUrl       => login_shib_url($query),
1450         );
1451     }
1452
1453     if (C4::Context->preference('GoogleOpenIDConnect')) {
1454         if ($query->param("OpenIDConnectFailed")) {
1455             my $reason = $query->param('OpenIDConnectFailed');
1456             $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1457         }
1458     }
1459
1460     $template->param(
1461         LibraryName => C4::Context->preference("LibraryName"),
1462     );
1463     $template->param(%info);
1464
1465     #    $cookie = $query->cookie(CGISESSID => $session->id
1466     #   );
1467     print $query->header(
1468         {   type              => 'text/html',
1469             charset           => 'utf-8',
1470             cookie            => $cookie,
1471             'X-Frame-Options' => 'SAMEORIGIN',
1472             -sameSite => 'Lax'
1473         }
1474       ),
1475       $template->output;
1476     safe_exit;
1477 }
1478
1479 =head2 check_api_auth
1480
1481   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1482
1483 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1484 cookie, determine if the user has the privileges specified by C<$userflags>.
1485
1486 C<check_api_auth> is is meant for authenticating users of web services, and
1487 consequently will always return and will not attempt to redirect the user
1488 agent.
1489
1490 If a valid session cookie is already present, check_api_auth will return a status
1491 of "ok", the cookie, and the Koha session ID.
1492
1493 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1494 parameters and create a session cookie and Koha session if the supplied credentials
1495 are OK.
1496
1497 Possible return values in C<$status> are:
1498
1499 =over
1500
1501 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1502
1503 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1504
1505 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1506
1507 =item "expired -- session cookie has expired; API user should resubmit userid and password
1508
1509 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1510
1511 =item "additional-auth-needed -- User is in an authentication process that is not finished
1512
1513 =back
1514
1515 =cut
1516
1517 sub check_api_auth {
1518
1519     my $query         = shift;
1520     my $flagsrequired = shift;
1521     my $timeout = _timeout_syspref();
1522
1523     unless ( C4::Context->preference('Version') ) {
1524
1525         # database has not been installed yet
1526         return ( "maintenance", undef, undef );
1527     }
1528     my $kohaversion = Koha::version();
1529     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1530     if ( C4::Context->preference('Version') < $kohaversion ) {
1531
1532         # database in need of version update; assume that
1533         # no API should be called while databsae is in
1534         # this condition.
1535         return ( "maintenance", undef, undef );
1536     }
1537
1538     my ( $sessionID, $session );
1539     unless ( $query->param('userid') ) {
1540         $sessionID = $query->cookie("CGISESSID");
1541     }
1542     if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1543
1544         my $return;
1545         ( $return, $session, undef ) = check_cookie_auth(
1546             $sessionID, $flagsrequired, { remote_addr => $ENV{REMOTE_ADDR} } );
1547
1548         return ( $return, undef, undef ) # Cookie auth failed
1549             if $return ne "ok";
1550
1551         my $cookie = $query->cookie(
1552             -name     => 'CGISESSID',
1553             -value    => $session->id,
1554             -HttpOnly => 1,
1555             -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1556             -sameSite => 'Lax'
1557         );
1558         return ( $return, $cookie, $session ); # return == 'ok' here
1559
1560     } else {
1561
1562         # new login
1563         my $userid   = $query->param('userid');
1564         my $password = $query->param('password');
1565         my ( $return, $cardnumber, $cas_ticket );
1566
1567         # Proxy CAS auth
1568         if ( $cas && $query->param('PT') ) {
1569             my $retuserid;
1570
1571             # In case of a CAS authentication, we use the ticket instead of the password
1572             my $PT = $query->param('PT');
1573             ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $PT, $query );    # EXTERNAL AUTH
1574         } else {
1575
1576             # User / password auth
1577             unless ( $userid and $password ) {
1578
1579                 # caller did something wrong, fail the authenticateion
1580                 return ( "failed", undef, undef );
1581             }
1582             my $newuserid;
1583             ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $userid, $password, $query );
1584         }
1585
1586         if ( $return and haspermission( $userid, $flagsrequired ) ) {
1587             my $session = get_session("");
1588             return ( "failed", undef, undef ) unless $session;
1589
1590             my $sessionID = $session->id;
1591             C4::Context->_new_userenv($sessionID);
1592             my $cookie = $query->cookie(
1593                 -name     => 'CGISESSID',
1594                 -value    => $sessionID,
1595                 -HttpOnly => 1,
1596                 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1597                 -sameSite => 'Lax'
1598             );
1599             if ( $return == 1 ) {
1600                 my (
1601                     $borrowernumber, $firstname,  $surname,
1602                     $userflags,      $branchcode, $branchname,
1603                     $emailaddress
1604                 );
1605                 my $dbh = C4::Context->dbh;
1606                 my $sth =
1607                   $dbh->prepare(
1608 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1609                   );
1610                 $sth->execute($userid);
1611                 (
1612                     $borrowernumber, $firstname,  $surname,
1613                     $userflags,      $branchcode, $branchname,
1614                     $emailaddress
1615                 ) = $sth->fetchrow if ( $sth->rows );
1616
1617                 unless ( $sth->rows ) {
1618                     my $sth = $dbh->prepare(
1619 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1620                     );
1621                     $sth->execute($cardnumber);
1622                     (
1623                         $borrowernumber, $firstname,  $surname,
1624                         $userflags,      $branchcode, $branchname,
1625                         $emailaddress
1626                     ) = $sth->fetchrow if ( $sth->rows );
1627
1628                     unless ( $sth->rows ) {
1629                         $sth->execute($userid);
1630                         (
1631                             $borrowernumber, $firstname,  $surname,       $userflags,
1632                             $branchcode,     $branchname, $emailaddress
1633                         ) = $sth->fetchrow if ( $sth->rows );
1634                     }
1635                 }
1636
1637                 my $ip = $ENV{'REMOTE_ADDR'};
1638
1639                 # if they specify at login, use that
1640                 if ( $query->param('branch') ) {
1641                     $branchcode = $query->param('branch');
1642                     my $library = Koha::Libraries->find($branchcode);
1643                     $branchname = $library? $library->branchname: '';
1644                 }
1645                 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search->as_list };
1646                 foreach my $br ( keys %$branches ) {
1647
1648                     #     now we work with the treatment of ip
1649                     my $domain = $branches->{$br}->{'branchip'};
1650                     if ( $domain && $ip =~ /^$domain/ ) {
1651                         $branchcode = $branches->{$br}->{'branchcode'};
1652
1653                         # new op dev : add the branchname to the cookie
1654                         $branchname    = $branches->{$br}->{'branchname'};
1655                     }
1656                 }
1657                 $session->param( 'number',       $borrowernumber );
1658                 $session->param( 'id',           $userid );
1659                 $session->param( 'cardnumber',   $cardnumber );
1660                 $session->param( 'firstname',    $firstname );
1661                 $session->param( 'surname',      $surname );
1662                 $session->param( 'branch',       $branchcode );
1663                 $session->param( 'branchname',   $branchname );
1664                 $session->param( 'flags',        $userflags );
1665                 $session->param( 'emailaddress', $emailaddress );
1666                 $session->param( 'ip',           $session->remote_addr() );
1667                 $session->param( 'lasttime',     time() );
1668                 $session->param( 'interface',    'api'  );
1669             }
1670             $session->param( 'cas_ticket', $cas_ticket);
1671             C4::Context->set_userenv(
1672                 $session->param('number'),       $session->param('id'),
1673                 $session->param('cardnumber'),   $session->param('firstname'),
1674                 $session->param('surname'),      $session->param('branch'),
1675                 $session->param('branchname'),   $session->param('flags'),
1676                 $session->param('emailaddress'), $session->param('shibboleth'),
1677                 $session->param('desk_id'),      $session->param('desk_name'),
1678                 $session->param('register_id'),  $session->param('register_name')
1679             );
1680             return ( "ok", $cookie, $sessionID );
1681         } else {
1682             return ( "failed", undef, undef );
1683         }
1684     }
1685 }
1686
1687 =head2 check_cookie_auth
1688
1689   ($status, $sessionId) = check_cookie_auth($cookie, $userflags);
1690
1691 Given a CGISESSID cookie set during a previous login to Koha, determine
1692 if the user has the privileges specified by C<$userflags>. C<$userflags>
1693 is passed unaltered into C<haspermission> and as such accepts all options
1694 avaiable to that routine with the one caveat that C<check_api_auth> will
1695 also allow 'undef' to be passed and in such a case the permissions check
1696 will be skipped altogether.
1697
1698 C<check_cookie_auth> is meant for authenticating special services
1699 such as tools/upload-file.pl that are invoked by other pages that
1700 have been authenticated in the usual way.
1701
1702 Possible return values in C<$status> are:
1703
1704 =over
1705
1706 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1707
1708 =item "anon" -- user not authenticated but valid for anonymous session.
1709
1710 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1711
1712 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1713
1714 =item "expired -- session cookie has expired; API user should resubmit userid and password
1715
1716 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1717
1718 =back
1719
1720 =cut
1721
1722 sub check_cookie_auth {
1723     my $sessionID     = shift;
1724     my $flagsrequired = shift;
1725     my $params        = shift;
1726
1727     my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1728
1729     my $skip_version_check = $params->{skip_version_check}; # Only for checkauth
1730
1731     unless ( $skip_version_check ) {
1732         unless ( C4::Context->preference('Version') ) {
1733
1734             # database has not been installed yet
1735             return ( "maintenance", undef );
1736         }
1737         my $kohaversion = Koha::version();
1738         $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1739         if ( C4::Context->preference('Version') < $kohaversion ) {
1740
1741             # database in need of version update; assume that
1742             # no API should be called while databsae is in
1743             # this condition.
1744             return ( "maintenance", undef );
1745         }
1746     }
1747
1748     # see if we have a valid session cookie already
1749     # however, if a userid parameter is present (i.e., from
1750     # a form submission, assume that any current cookie
1751     # is to be ignored
1752     unless ( $sessionID ) {
1753         return ( "failed", undef );
1754     }
1755     C4::Context::_unset_userenv($sessionID); # remove old userenv first
1756     my $session   = get_session($sessionID);
1757     if ($session) {
1758         my $userid   = $session->param('id');
1759         my $ip       = $session->param('ip');
1760         my $lasttime = $session->param('lasttime');
1761         my $timeout = _timeout_syspref();
1762
1763         if ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
1764             # time out
1765             $session->delete();
1766             $session->flush;
1767             return ("expired", undef);
1768
1769         } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1770             # IP address changed
1771             $session->delete();
1772             $session->flush;
1773             return ( "restricted", undef, { old_ip => $ip, new_ip => $remote_addr});
1774
1775         } elsif ( $userid ) {
1776             $session->param( 'lasttime', time() );
1777             my $patron = Koha::Patrons->find({ userid => $userid });
1778             $patron = Koha::Patrons->find({ cardnumber => $userid })
1779               unless $patron;
1780             return ("password_expired", undef ) if $patron->password_expired;
1781             my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1782             if ($flags) {
1783                 C4::Context->_new_userenv($sessionID);
1784                 C4::Context->interface($session->param('interface'));
1785                 C4::Context->set_userenv(
1786                     $session->param('number'),       $session->param('id') // '',
1787                     $session->param('cardnumber'),   $session->param('firstname'),
1788                     $session->param('surname'),      $session->param('branch'),
1789                     $session->param('branchname'),   $session->param('flags'),
1790                     $session->param('emailaddress'), $session->param('shibboleth'),
1791                     $session->param('desk_id'),      $session->param('desk_name'),
1792                     $session->param('register_id'),  $session->param('register_name')
1793                 );
1794                 if ( C4::Context->preference('TwoFactorAuthentication') ne 'disabled' ) {
1795                     return ( "additional-auth-needed", $session )
1796                         if $session->param('waiting-for-2FA');
1797
1798                     return ( "setup-additional-auth-needed", $session )
1799                         if $session->param('waiting-for-2FA-setup');
1800                 }
1801
1802                 return ( "ok", $session );
1803             } else {
1804                 $session->delete();
1805                 $session->flush;
1806                 return ( "failed", undef );
1807             }
1808
1809         } else {
1810             C4::Context->_new_userenv($sessionID);
1811             C4::Context->interface($session->param('interface'));
1812             C4::Context->set_userenv( undef, q{} );
1813             return ( "anon", $session );
1814         }
1815     } else {
1816         return ( "expired", undef );
1817     }
1818 }
1819
1820 =head2 get_session
1821
1822   use CGI::Session;
1823   my $session = get_session($sessionID);
1824
1825 Given a session ID, retrieve the CGI::Session object used to store
1826 the session's state.  The session object can be used to store
1827 data that needs to be accessed by different scripts during a
1828 user's session.
1829
1830 If the C<$sessionID> parameter is an empty string, a new session
1831 will be created.
1832
1833 =cut
1834
1835 sub _get_session_params {
1836     my $storage_method = C4::Context->preference('SessionStorage');
1837     if ( $storage_method eq 'mysql' ) {
1838         my $dbh = C4::Context->dbh;
1839         return { dsn => "serializer:yamlxs;driver:MySQL;id:md5", dsn_args => { Handle => $dbh } };
1840     }
1841     elsif ( $storage_method eq 'Pg' ) {
1842         my $dbh = C4::Context->dbh;
1843         return { dsn => "serializer:yamlxs;driver:PostgreSQL;id:md5", dsn_args => { Handle => $dbh } };
1844     }
1845     elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1846         my $memcached = Koha::Caches->get_instance()->memcached_cache;
1847         return { dsn => "serializer:yamlxs;driver:memcached;id:md5", dsn_args => { Memcached => $memcached } };
1848     }
1849     else {
1850         # catch all defaults to tmp should work on all systems
1851         my $dir = C4::Context::temporary_directory;
1852         my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1853         return { dsn => "serializer:yamlxs;driver:File;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1854     }
1855 }
1856
1857 sub get_session {
1858     my $sessionID      = shift;
1859     my $params = _get_session_params();
1860     my $session;
1861     if( $sessionID ) { # find existing
1862         CGI::Session::ErrorHandler->set_error( q{} ); # clear error, cpan issue #111463
1863         $session = CGI::Session->load( $params->{dsn}, $sessionID, $params->{dsn_args} );
1864     } else {
1865         $session = CGI::Session->new( $params->{dsn}, $sessionID, $params->{dsn_args} );
1866         # no need to flush here
1867     }
1868     return $session;
1869 }
1870
1871 =head2 create_basic_session
1872
1873 my $session = create_basic_session({ patron => $patron, interface => $interface });
1874
1875 Creates a session and adds all basic parameters for a session to work
1876
1877 =cut
1878
1879 sub create_basic_session {
1880     my $params    = shift;
1881     my $patron    = $params->{patron};
1882     my $interface = $params->{interface};
1883
1884     $interface = 'intranet' if $interface eq 'staff';
1885
1886     my $session = get_session("");
1887
1888     $session->param( 'number',       $patron->borrowernumber );
1889     $session->param( 'id',           $patron->userid );
1890     $session->param( 'cardnumber',   $patron->cardnumber );
1891     $session->param( 'firstname',    $patron->firstname );
1892     $session->param( 'surname',      $patron->surname );
1893     $session->param( 'branch',       $patron->branchcode );
1894     $session->param( 'branchname',   $patron->library->branchname );
1895     $session->param( 'flags',        $patron->flags );
1896     $session->param( 'emailaddress', $patron->email );
1897     $session->param( 'ip',           $session->remote_addr() );
1898     $session->param( 'lasttime',     time() );
1899     $session->param( 'interface',    $interface);
1900
1901     return $session;
1902 }
1903
1904
1905 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1906 # (or something similar)
1907 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1908 # not having a userenv defined could cause a crash.
1909 sub checkpw {
1910     my ( $userid, $password, $query, $type, $no_set_userenv ) = @_;
1911     $type = 'opac' unless $type;
1912
1913     # Get shibboleth login attribute
1914     my $shib = C4::Context->config('useshibboleth') && shib_ok();
1915     my $shib_login = $shib ? get_login_shib() : undef;
1916
1917     my @return;
1918     my $patron;
1919     if ( defined $userid ){
1920         $patron = Koha::Patrons->find({ userid => $userid });
1921         $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1922     }
1923     my $check_internal_as_fallback = 0;
1924     my $passwd_ok = 0;
1925     # Note: checkpw_* routines returns:
1926     # 1 if auth is ok
1927     # 0 if auth is nok
1928     # -1 if user bind failed (LDAP only)
1929
1930     if ( $patron and ( $patron->account_locked )  ) {
1931         # Nothing to check, account is locked
1932     } elsif ($ldap && defined($password)) {
1933         my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_);    # EXTERNAL AUTH
1934         if ( $retval == 1 ) {
1935             @return = ( $retval, $retcard, $retuserid );
1936             $passwd_ok = 1;
1937         }
1938         $check_internal_as_fallback = 1 if $retval == 0;
1939
1940     } elsif ( $cas && $query && $query->param('ticket') ) {
1941
1942         # In case of a CAS authentication, we use the ticket instead of the password
1943         my $ticket = $query->param('ticket');
1944         $query->delete('ticket');                                   # remove ticket to come back to original URL
1945         my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $ticket, $query, $type );    # EXTERNAL AUTH
1946         if ( $retval ) {
1947             @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1948         } else {
1949             @return = (0);
1950         }
1951         $passwd_ok = $retval;
1952     }
1953
1954     # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1955     # Check for password to asertain whether we want to be testing against shibboleth or another method this
1956     # time around.
1957     elsif ( $shib && $shib_login && !$password ) {
1958
1959         # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1960         # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1961         # shibboleth-authenticated user
1962
1963         # Then, we check if it matches a valid koha user
1964         if ($shib_login) {
1965             my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login);    # EXTERNAL AUTH
1966             if ( $retval ) {
1967                 @return = ( $retval, $retcard, $retuserid );
1968             }
1969             $passwd_ok = $retval;
1970         }
1971     } else {
1972         $check_internal_as_fallback = 1;
1973     }
1974
1975     # INTERNAL AUTH
1976     if ( $check_internal_as_fallback ) {
1977         @return = checkpw_internal( $userid, $password, $no_set_userenv);
1978         $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1979     }
1980
1981     if( $patron ) {
1982         if ( $passwd_ok ) {
1983             $patron->update({ login_attempts => 0 });
1984             if( $patron->password_expired ){
1985                 @return = (-2);
1986             }
1987         } elsif( !$patron->account_locked ) {
1988             $patron->update({ login_attempts => $patron->login_attempts + 1 });
1989         }
1990     }
1991
1992     # Optionally log success or failure
1993     if( $patron && $passwd_ok && C4::Context->preference('AuthSuccessLog') ) {
1994         logaction( 'AUTH', 'SUCCESS', $patron->id, "Valid password for $userid", $type );
1995     } elsif( !$passwd_ok && C4::Context->preference('AuthFailureLog') ) {
1996         logaction( 'AUTH', 'FAILURE', $patron ? $patron->id : 0, "Wrong password for $userid", $type );
1997     }
1998
1999     return @return;
2000 }
2001
2002 sub checkpw_internal {
2003     my ( $userid, $password, $no_set_userenv ) = @_;
2004
2005     $password = Encode::encode( 'UTF-8', $password )
2006       if Encode::is_utf8($password);
2007
2008     my $dbh = C4::Context->dbh;
2009     my $sth =
2010       $dbh->prepare(
2011         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
2012       );
2013     $sth->execute($userid);
2014     if ( $sth->rows ) {
2015         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
2016             $surname, $branchcode, $branchname, $flags )
2017           = $sth->fetchrow;
2018
2019         if ( checkpw_hash( $password, $stored_hash ) ) {
2020
2021             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
2022                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
2023             return 1, $cardnumber, $userid;
2024         }
2025     }
2026     $sth =
2027       $dbh->prepare(
2028         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
2029       );
2030     $sth->execute($userid);
2031     if ( $sth->rows ) {
2032         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
2033             $surname, $branchcode, $branchname, $flags )
2034           = $sth->fetchrow;
2035
2036         if ( checkpw_hash( $password, $stored_hash ) ) {
2037
2038             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
2039                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
2040             return 1, $cardnumber, $userid;
2041         }
2042     }
2043     return 0;
2044 }
2045
2046 sub checkpw_hash {
2047     my ( $password, $stored_hash ) = @_;
2048
2049     return if $stored_hash eq '!';
2050
2051     # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
2052     my $hash;
2053     if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
2054         $hash = hash_password( $password, $stored_hash );
2055     } else {
2056         $hash = md5_base64($password);
2057     }
2058     return $hash eq $stored_hash;
2059 }
2060
2061 =head2 getuserflags
2062
2063     my $authflags = getuserflags($flags, $userid, [$dbh]);
2064
2065 Translates integer flags into permissions strings hash.
2066
2067 C<$flags> is the integer userflags value ( borrowers.userflags )
2068 C<$userid> is the members.userid, used for building subpermissions
2069 C<$authflags> is a hashref of permissions
2070
2071 =cut
2072
2073 sub getuserflags {
2074     my $flags  = shift;
2075     my $userid = shift;
2076     my $dbh    = @_ ? shift : C4::Context->dbh;
2077     my $userflags;
2078     {
2079         # I don't want to do this, but if someone logs in as the database
2080         # user, it would be preferable not to spam them to death with
2081         # numeric warnings. So, we make $flags numeric.
2082         no warnings 'numeric';
2083         $flags += 0;
2084     }
2085     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
2086     $sth->execute;
2087
2088     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
2089         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
2090             $userflags->{$flag} = 1;
2091         }
2092         else {
2093             $userflags->{$flag} = 0;
2094         }
2095     }
2096
2097     # get subpermissions and merge with top-level permissions
2098     my $user_subperms = get_user_subpermissions($userid);
2099     foreach my $module ( keys %$user_subperms ) {
2100         next if $userflags->{$module} == 1;    # user already has permission for everything in this module
2101         $userflags->{$module} = $user_subperms->{$module};
2102     }
2103
2104     return $userflags;
2105 }
2106
2107 =head2 get_user_subpermissions
2108
2109   $user_perm_hashref = get_user_subpermissions($userid);
2110
2111 Given the userid (note, not the borrowernumber) of a staff user,
2112 return a hashref of hashrefs of the specific subpermissions
2113 accorded to the user.  An example return is
2114
2115  {
2116     tools => {
2117         export_catalog => 1,
2118         import_patrons => 1,
2119     }
2120  }
2121
2122 The top-level hash-key is a module or function code from
2123 userflags.flag, while the second-level key is a code
2124 from permissions.
2125
2126 The results of this function do not give a complete picture
2127 of the functions that a staff user can access; it is also
2128 necessary to check borrowers.flags.
2129
2130 =cut
2131
2132 sub get_user_subpermissions {
2133     my $userid = shift;
2134
2135     my $dbh = C4::Context->dbh;
2136     my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2137                              FROM user_permissions
2138                              JOIN permissions USING (module_bit, code)
2139                              JOIN userflags ON (module_bit = bit)
2140                              JOIN borrowers USING (borrowernumber)
2141                              WHERE userid = ?" );
2142     $sth->execute($userid);
2143
2144     my $user_perms = {};
2145     while ( my $perm = $sth->fetchrow_hashref ) {
2146         $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2147     }
2148     return $user_perms;
2149 }
2150
2151 =head2 get_all_subpermissions
2152
2153   my $perm_hashref = get_all_subpermissions();
2154
2155 Returns a hashref of hashrefs defining all specific
2156 permissions currently defined.  The return value
2157 has the same structure as that of C<get_user_subpermissions>,
2158 except that the innermost hash value is the description
2159 of the subpermission.
2160
2161 =cut
2162
2163 sub get_all_subpermissions {
2164     my $dbh = C4::Context->dbh;
2165     my $sth = $dbh->prepare( "SELECT flag, code
2166                              FROM permissions
2167                              JOIN userflags ON (module_bit = bit)" );
2168     $sth->execute();
2169
2170     my $all_perms = {};
2171     while ( my $perm = $sth->fetchrow_hashref ) {
2172         $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2173     }
2174     return $all_perms;
2175 }
2176
2177 =head2 haspermission
2178
2179   $flagsrequired = '*';                                 # Any permission at all
2180   $flagsrequired = 'a_flag';                            # a_flag must be satisfied (all subpermissions)
2181   $flagsrequired = [ 'a_flag', 'b_flag' ];              # a_flag OR b_flag must be satisfied
2182   $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 };     # a_flag AND b_flag must be satisfied
2183   $flagsrequired = { 'a_flag' => 'sub_a' };             # sub_a of a_flag must be satisfied
2184   $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2185
2186   $flags = ($userid, $flagsrequired);
2187
2188 C<$userid> the userid of the member
2189 C<$flags> is a query structure similar to that used by SQL::Abstract that
2190 denotes the combination of flags required. It is a required parameter.
2191
2192 The main logic of this method is that things in arrays are OR'ed, and things
2193 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2194
2195 Returns member's flags or 0 if a permission is not met.
2196
2197 =cut
2198
2199 sub _dispatch {
2200     my ($required, $flags) = @_;
2201
2202     my $ref = ref($required);
2203     if ($ref eq '') {
2204         if ($required eq '*') {
2205             return 0 unless ( $flags or ref( $flags ) );
2206         } else {
2207             return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2208         }
2209     } elsif ($ref eq 'HASH') {
2210         foreach my $key (keys %{$required}) {
2211             next if $flags == 1;
2212             my $require = $required->{$key};
2213             my $rflags  = $flags->{$key};
2214             return 0 unless _dispatch($require, $rflags);
2215         }
2216     } elsif ($ref eq 'ARRAY') {
2217         my $satisfied = 0;
2218         foreach my $require ( @{$required} ) {
2219             my $rflags =
2220               ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2221               ? $flags->{$require}
2222               : $flags;
2223             $satisfied++ if _dispatch( $require, $rflags );
2224         }
2225         return 0 unless $satisfied;
2226     } else {
2227         croak "Unexpected structure found: $ref";
2228     }
2229
2230     return $flags;
2231 };
2232
2233 sub haspermission {
2234     my ( $userid, $flagsrequired ) = @_;
2235
2236     #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2237     #  unless defined($flagsrequired);
2238
2239     my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2240     $sth->execute($userid);
2241     my $row = $sth->fetchrow();
2242     my $flags = getuserflags( $row, $userid );
2243
2244     return $flags unless defined($flagsrequired);
2245     return $flags if $flags->{superlibrarian};
2246     return _dispatch($flagsrequired, $flags);
2247
2248     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2249 }
2250
2251 =head2 in_iprange
2252
2253   $flags = ($iprange);
2254
2255 C<$iprange> A space separated string describing an IP range. Can include single IPs or ranges
2256
2257 Returns 1 if the remote address is in the provided iprange, or 0 otherwise.
2258
2259 =cut
2260
2261 sub in_iprange {
2262     my ($iprange) = @_;
2263     my $result = 1;
2264     my @allowedipranges = $iprange ? split(' ', $iprange) : ();
2265     if (scalar @allowedipranges > 0) {
2266         my @rangelist;
2267         eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2268         eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || Koha::Logger->get->warn('cidrlookup failed for ' . join(' ',@rangelist) );
2269      }
2270      return $result ? 1 : 0;
2271 }
2272
2273 sub getborrowernumber {
2274     my ($userid) = @_;
2275     my $userenv = C4::Context->userenv;
2276     if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2277         return $userenv->{number};
2278     }
2279     my $dbh = C4::Context->dbh;
2280     for my $field ( 'userid', 'cardnumber' ) {
2281         my $sth =
2282           $dbh->prepare("select borrowernumber from borrowers where $field=?");
2283         $sth->execute($userid);
2284         if ( $sth->rows ) {
2285             my ($bnumber) = $sth->fetchrow;
2286             return $bnumber;
2287         }
2288     }
2289     return 0;
2290 }
2291
2292 =head2 track_login_daily
2293
2294     track_login_daily( $userid );
2295
2296 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2297
2298 =cut
2299
2300 sub track_login_daily {
2301     my $userid = shift;
2302     return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2303
2304     my $cache     = Koha::Caches->get_instance();
2305     my $cache_key = "track_login_" . $userid;
2306     my $cached    = $cache->get_from_cache($cache_key);
2307     my $today = dt_from_string()->ymd;
2308     return if $cached && $cached eq $today;
2309
2310     my $patron = Koha::Patrons->find({ userid => $userid });
2311     return unless $patron;
2312     $patron->track_login;
2313     $cache->set_in_cache( $cache_key, $today );
2314 }
2315
2316 END { }    # module clean-up code here (global destructor)
2317 1;
2318 __END__
2319
2320 =head1 SEE ALSO
2321
2322 CGI(3)
2323
2324 C4::Output(3)
2325
2326 Crypt::Eksblowfish::Bcrypt(3)
2327
2328 Digest::MD5(3)
2329
2330 =cut