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