C4/Auth.pm

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