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