C4/Auth.pm

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