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