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