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" && $patron->auth_method eq 'password' ) {
1274                 $auth_state = 'setup-additional-auth-needed';
1275                 $session->param('waiting-for-2FA-setup', 1);
1276                 %info = ();# We remove the warnings/errors we may have set incorrectly before
1277             } elsif ( $patron->auth_method eq 'two-factor' ) {
1278                 # Ask for the OTP token
1279                 $auth_state = 'additional-auth-needed';
1280                 $session->param('waiting-for-2FA', 1);
1281                 %info = ();# We remove the warnings/errors we may have set incorrectly before
1282             }
1283         }
1284     }
1285
1286     # finished authentification, now respond
1287     if ( $auth_state eq 'completed' || $authnotrequired ) {
1288         # successful login
1289         unless (@$cookie) {
1290             $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
1291                 -name     => 'CGISESSID',
1292                 -value    => '',
1293                 -HttpOnly => 1,
1294                 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1295                 -sameSite => 'Lax',
1296             ));
1297         }
1298
1299         track_login_daily( $userid );
1300
1301         # In case, that this request was a login attempt, we want to prevent that users can repost the opac login
1302         # request. We therefore redirect the user to the requested page again without the login parameters.
1303         # See Post/Redirect/Get (PRG) design pattern: https://en.wikipedia.org/wiki/Post/Redirect/Get
1304         if ( $type eq "opac" && $query->param('koha_login_context') && $query->param('koha_login_context') ne 'sco' && $query->param('password') && $query->param('userid') ) {
1305             my $uri = URI->new($query->url(-relative=>1, -query_string=>1));
1306             $uri->query_param_delete('userid');
1307             $uri->query_param_delete('password');
1308             $uri->query_param_delete('koha_login_context');
1309             print $query->redirect(-uri => $uri->as_string, -cookie => $cookie, -status=>'303 See other');
1310             exit;
1311         }
1312
1313         return ( $userid, $cookie, $sessionID, $flags );
1314     }
1315
1316     #
1317     #
1318     # AUTH rejected, show the login/password template, after checking the DB.
1319     #
1320     #
1321
1322     my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1323
1324     # get the inputs from the incoming query
1325     my @inputs = ();
1326     my @inputs_to_clean = qw( userid password ticket logout.x otp_token );
1327     foreach my $name ( param $query) {
1328         next if grep { $name eq $_ } @inputs_to_clean;
1329         my @value = $query->multi_param($name);
1330         push @inputs, { name => $name, value => $_ } for @value;
1331     }
1332
1333     my $LibraryNameTitle = C4::Context->preference("LibraryName");
1334     $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1335     $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1336
1337     my $auth_template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1338     my $template = C4::Templates::gettemplate( $auth_template_name, $type, $query );
1339     $template->param(
1340         login                                 => 1,
1341         INPUTS                                => \@inputs,
1342         script_name                           => get_script_name(),
1343         casAuthentication                     => C4::Context->preference("casAuthentication"),
1344         shibbolethAuthentication              => $shib,
1345         suggestion                            => C4::Context->preference("suggestion"),
1346         virtualshelves                        => C4::Context->preference("virtualshelves"),
1347         LibraryName                           => "" . C4::Context->preference("LibraryName"),
1348         LibraryNameTitle                      => "" . $LibraryNameTitle,
1349         opacuserlogin                         => C4::Context->preference("opacuserlogin"),
1350         OpacFavicon                           => C4::Context->preference("OpacFavicon"),
1351         opacreadinghistory                    => C4::Context->preference("opacreadinghistory"),
1352         opaclanguagesdisplay                  => C4::Context->preference("opaclanguagesdisplay"),
1353         OPACUserJS                            => C4::Context->preference("OPACUserJS"),
1354         opacbookbag                           => "" . C4::Context->preference("opacbookbag"),
1355         OpacCloud                             => C4::Context->preference("OpacCloud"),
1356         OpacTopissue                          => C4::Context->preference("OpacTopissue"),
1357         OpacAuthorities                       => C4::Context->preference("OpacAuthorities"),
1358         OpacBrowser                           => C4::Context->preference("OpacBrowser"),
1359         TagsEnabled                           => C4::Context->preference("TagsEnabled"),
1360         OPACUserCSS                           => C4::Context->preference("OPACUserCSS"),
1361         intranetcolorstylesheet               => C4::Context->preference("intranetcolorstylesheet"),
1362         intranetstylesheet                    => C4::Context->preference("intranetstylesheet"),
1363         IntranetNav                           => C4::Context->preference("IntranetNav"),
1364         IntranetFavicon                       => C4::Context->preference("IntranetFavicon"),
1365         IntranetUserCSS                       => C4::Context->preference("IntranetUserCSS"),
1366         IntranetUserJS                        => C4::Context->preference("IntranetUserJS"),
1367         IndependentBranches                   => C4::Context->preference("IndependentBranches"),
1368         AutoLocation                          => C4::Context->preference("AutoLocation"),
1369         wrongip                               => $info{'wrongip'},
1370         PatronSelfRegistration                => C4::Context->preference("PatronSelfRegistration"),
1371         PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1372         opac_css_override                     => $ENV{'OPAC_CSS_OVERRIDE'},
1373         too_many_login_attempts               => ( $patron and $patron->account_locked ),
1374         password_has_expired                  => ( $patron and $patron->password_expired ),
1375     );
1376
1377     $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1378     $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1379     $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1380     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1381     if ( $auth_state eq 'additional-auth-needed' ) {
1382         my $patron = Koha::Patrons->find( { userid => $userid } );
1383         $template->param(
1384             TwoFA_prompt => 1,
1385             invalid_otp_token => $invalid_otp_token,
1386             notice_email_address => $patron->notice_email_address, # We could also pass logged_in_user if necessary
1387         );
1388     }
1389
1390     if ( $auth_state eq 'setup-additional-auth-needed' ) {
1391         $template->param(
1392             TwoFA_setup => 1,
1393         );
1394     }
1395
1396     if ( $type eq 'opac' ) {
1397         require Koha::Virtualshelves;
1398         my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1399             {
1400                 public => 1,
1401             }
1402         );
1403         $template->param(
1404             some_public_shelves  => $some_public_shelves,
1405         );
1406     }
1407
1408     if ($cas) {
1409
1410         # Is authentication against multiple CAS servers enabled?
1411         require C4::Auth_with_cas;
1412         if ( multipleAuth() && !$casparam ) {
1413             my $casservers = getMultipleAuth();
1414             my @tmplservers;
1415             foreach my $key ( keys %$casservers ) {
1416                 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1417             }
1418             $template->param(
1419                 casServersLoop => \@tmplservers
1420             );
1421         } else {
1422             $template->param(
1423                 casServerUrl => login_cas_url($query, undef, $type),
1424             );
1425         }
1426
1427         $template->param(
1428             invalidCasLogin => $info{'invalidCasLogin'}
1429         );
1430     }
1431
1432     if ($shib) {
1433         #If shibOnly is enabled just go ahead and redirect directly
1434         if ( (($type eq 'opac') && C4::Context->preference('OPACShibOnly')) || (($type ne 'opac') && C4::Context->preference('staffShibOnly')) ) {
1435             my $redirect_url = login_shib_url( $query );
1436             print $query->redirect( -uri => "$redirect_url", -status => 303 );
1437             safe_exit;
1438         }
1439
1440         $template->param(
1441             shibbolethAuthentication => $shib,
1442             shibbolethLoginUrl       => login_shib_url($query),
1443         );
1444     }
1445
1446     if (C4::Context->preference('GoogleOpenIDConnect')) {
1447         if ($query->param("OpenIDConnectFailed")) {
1448             my $reason = $query->param('OpenIDConnectFailed');
1449             $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1450         }
1451     }
1452
1453     $template->param(
1454         LibraryName => C4::Context->preference("LibraryName"),
1455     );
1456     $template->param(%info);
1457
1458     #    $cookie = $query->cookie(CGISESSID => $session->id
1459     #   );
1460     print $query->header(
1461         {   type              => 'text/html',
1462             charset           => 'utf-8',
1463             cookie            => $cookie,
1464             'X-Frame-Options' => 'SAMEORIGIN',
1465             -sameSite => 'Lax'
1466         }
1467       ),
1468       $template->output;
1469     safe_exit;
1470 }
1471
1472 =head2 check_api_auth
1473
1474   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1475
1476 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1477 cookie, determine if the user has the privileges specified by C<$userflags>.
1478
1479 C<check_api_auth> is is meant for authenticating users of web services, and
1480 consequently will always return and will not attempt to redirect the user
1481 agent.
1482
1483 If a valid session cookie is already present, check_api_auth will return a status
1484 of "ok", the cookie, and the Koha session ID.
1485
1486 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1487 parameters and create a session cookie and Koha session if the supplied credentials
1488 are OK.
1489
1490 Possible return values in C<$status> are:
1491
1492 =over
1493
1494 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1495
1496 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1497
1498 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1499
1500 =item "expired -- session cookie has expired; API user should resubmit userid and password
1501
1502 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1503
1504 =item "additional-auth-needed -- User is in an authentication process that is not finished
1505
1506 =back
1507
1508 =cut
1509
1510 sub check_api_auth {
1511
1512     my $query         = shift;
1513     my $flagsrequired = shift;
1514     my $timeout = _timeout_syspref();
1515
1516     unless ( C4::Context->preference('Version') ) {
1517
1518         # database has not been installed yet
1519         return ( "maintenance", undef, undef );
1520     }
1521     my $kohaversion = Koha::version();
1522     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1523     if ( C4::Context->preference('Version') < $kohaversion ) {
1524
1525         # database in need of version update; assume that
1526         # no API should be called while databsae is in
1527         # this condition.
1528         return ( "maintenance", undef, undef );
1529     }
1530
1531     my ( $sessionID, $session );
1532     unless ( $query->param('userid') ) {
1533         $sessionID = $query->cookie("CGISESSID");
1534     }
1535     if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1536
1537         my $return;
1538         ( $return, $session, undef ) = check_cookie_auth(
1539             $sessionID, $flagsrequired, { remote_addr => $ENV{REMOTE_ADDR} } );
1540
1541         return ( $return, undef, undef ) # Cookie auth failed
1542             if $return ne "ok";
1543
1544         my $cookie = $query->cookie(
1545             -name     => 'CGISESSID',
1546             -value    => $session->id,
1547             -HttpOnly => 1,
1548             -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1549             -sameSite => 'Lax'
1550         );
1551         return ( $return, $cookie, $session ); # return == 'ok' here
1552
1553     } else {
1554
1555         # new login
1556         my $userid   = $query->param('userid');
1557         my $password = $query->param('password');
1558         my ( $return, $cardnumber, $cas_ticket );
1559
1560         # Proxy CAS auth
1561         if ( $cas && $query->param('PT') ) {
1562             my $retuserid;
1563
1564             # In case of a CAS authentication, we use the ticket instead of the password
1565             my $PT = $query->param('PT');
1566             ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $PT, $query );    # EXTERNAL AUTH
1567         } else {
1568
1569             # User / password auth
1570             unless ( $userid and $password ) {
1571
1572                 # caller did something wrong, fail the authenticateion
1573                 return ( "failed", undef, undef );
1574             }
1575             my $newuserid;
1576             ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $userid, $password, $query );
1577         }
1578
1579         if ( $return and haspermission( $userid, $flagsrequired ) ) {
1580             my $session = get_session("");
1581             return ( "failed", undef, undef ) unless $session;
1582
1583             my $sessionID = $session->id;
1584             C4::Context->_new_userenv($sessionID);
1585             my $cookie = $query->cookie(
1586                 -name     => 'CGISESSID',
1587                 -value    => $sessionID,
1588                 -HttpOnly => 1,
1589                 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1590                 -sameSite => 'Lax'
1591             );
1592             if ( $return == 1 ) {
1593                 my (
1594                     $borrowernumber, $firstname,  $surname,
1595                     $userflags,      $branchcode, $branchname,
1596                     $emailaddress
1597                 );
1598                 my $dbh = C4::Context->dbh;
1599                 my $sth =
1600                   $dbh->prepare(
1601 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1602                   );
1603                 $sth->execute($userid);
1604                 (
1605                     $borrowernumber, $firstname,  $surname,
1606                     $userflags,      $branchcode, $branchname,
1607                     $emailaddress
1608                 ) = $sth->fetchrow if ( $sth->rows );
1609
1610                 unless ( $sth->rows ) {
1611                     my $sth = $dbh->prepare(
1612 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1613                     );
1614                     $sth->execute($cardnumber);
1615                     (
1616                         $borrowernumber, $firstname,  $surname,
1617                         $userflags,      $branchcode, $branchname,
1618                         $emailaddress
1619                     ) = $sth->fetchrow if ( $sth->rows );
1620
1621                     unless ( $sth->rows ) {
1622                         $sth->execute($userid);
1623                         (
1624                             $borrowernumber, $firstname,  $surname,       $userflags,
1625                             $branchcode,     $branchname, $emailaddress
1626                         ) = $sth->fetchrow if ( $sth->rows );
1627                     }
1628                 }
1629
1630                 my $ip = $ENV{'REMOTE_ADDR'};
1631
1632                 # if they specify at login, use that
1633                 if ( $query->param('branch') ) {
1634                     $branchcode = $query->param('branch');
1635                     my $library = Koha::Libraries->find($branchcode);
1636                     $branchname = $library? $library->branchname: '';
1637                 }
1638                 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search->as_list };
1639                 foreach my $br ( keys %$branches ) {
1640
1641                     #     now we work with the treatment of ip
1642                     my $domain = $branches->{$br}->{'branchip'};
1643                     if ( $domain && $ip =~ /^$domain/ ) {
1644                         $branchcode = $branches->{$br}->{'branchcode'};
1645
1646                         # new op dev : add the branchname to the cookie
1647                         $branchname    = $branches->{$br}->{'branchname'};
1648                     }
1649                 }
1650                 $session->param( 'number',       $borrowernumber );
1651                 $session->param( 'id',           $userid );
1652                 $session->param( 'cardnumber',   $cardnumber );
1653                 $session->param( 'firstname',    $firstname );
1654                 $session->param( 'surname',      $surname );
1655                 $session->param( 'branch',       $branchcode );
1656                 $session->param( 'branchname',   $branchname );
1657                 $session->param( 'flags',        $userflags );
1658                 $session->param( 'emailaddress', $emailaddress );
1659                 $session->param( 'ip',           $session->remote_addr() );
1660                 $session->param( 'lasttime',     time() );
1661                 $session->param( 'interface',    'api'  );
1662             }
1663             $session->param( 'cas_ticket', $cas_ticket);
1664             C4::Context->set_userenv(
1665                 $session->param('number'),       $session->param('id'),
1666                 $session->param('cardnumber'),   $session->param('firstname'),
1667                 $session->param('surname'),      $session->param('branch'),
1668                 $session->param('branchname'),   $session->param('flags'),
1669                 $session->param('emailaddress'), $session->param('shibboleth'),
1670                 $session->param('desk_id'),      $session->param('desk_name'),
1671                 $session->param('register_id'),  $session->param('register_name')
1672             );
1673             return ( "ok", $cookie, $sessionID );
1674         } else {
1675             return ( "failed", undef, undef );
1676         }
1677     }
1678 }
1679
1680 =head2 check_cookie_auth
1681
1682   ($status, $sessionId) = check_cookie_auth($cookie, $userflags);
1683
1684 Given a CGISESSID cookie set during a previous login to Koha, determine
1685 if the user has the privileges specified by C<$userflags>. C<$userflags>
1686 is passed unaltered into C<haspermission> and as such accepts all options
1687 avaiable to that routine with the one caveat that C<check_api_auth> will
1688 also allow 'undef' to be passed and in such a case the permissions check
1689 will be skipped altogether.
1690
1691 C<check_cookie_auth> is meant for authenticating special services
1692 such as tools/upload-file.pl that are invoked by other pages that
1693 have been authenticated in the usual way.
1694
1695 Possible return values in C<$status> are:
1696
1697 =over
1698
1699 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1700
1701 =item "anon" -- user not authenticated but valid for anonymous session.
1702
1703 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1704
1705 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1706
1707 =item "expired -- session cookie has expired; API user should resubmit userid and password
1708
1709 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1710
1711 =back
1712
1713 =cut
1714
1715 sub check_cookie_auth {
1716     my $sessionID     = shift;
1717     my $flagsrequired = shift;
1718     my $params        = shift;
1719
1720     my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1721
1722     my $skip_version_check = $params->{skip_version_check}; # Only for checkauth
1723
1724     unless ( $skip_version_check ) {
1725         unless ( C4::Context->preference('Version') ) {
1726
1727             # database has not been installed yet
1728             return ( "maintenance", undef );
1729         }
1730         my $kohaversion = Koha::version();
1731         $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1732         if ( C4::Context->preference('Version') < $kohaversion ) {
1733
1734             # database in need of version update; assume that
1735             # no API should be called while databsae is in
1736             # this condition.
1737             return ( "maintenance", undef );
1738         }
1739     }
1740
1741     # see if we have a valid session cookie already
1742     # however, if a userid parameter is present (i.e., from
1743     # a form submission, assume that any current cookie
1744     # is to be ignored
1745     unless ( $sessionID ) {
1746         return ( "failed", undef );
1747     }
1748     C4::Context::_unset_userenv($sessionID); # remove old userenv first
1749     my $session   = get_session($sessionID);
1750     if ($session) {
1751         my $userid   = $session->param('id');
1752         my $ip       = $session->param('ip');
1753         my $lasttime = $session->param('lasttime');
1754         my $timeout = _timeout_syspref();
1755
1756         if ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
1757             # time out
1758             $session->delete();
1759             $session->flush;
1760             return ("expired", undef);
1761
1762         } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1763             # IP address changed
1764             $session->delete();
1765             $session->flush;
1766             return ( "restricted", undef, { old_ip => $ip, new_ip => $remote_addr});
1767
1768         } elsif ( $userid ) {
1769             $session->param( 'lasttime', time() );
1770             my $patron = Koha::Patrons->find({ userid => $userid });
1771             $patron = Koha::Patron->find({ cardnumber => $userid }) unless $patron;
1772             return ("password_expired", undef ) if $patron->password_expired;
1773             my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1774             if ($flags) {
1775                 C4::Context->_new_userenv($sessionID);
1776                 C4::Context->interface($session->param('interface'));
1777                 C4::Context->set_userenv(
1778                     $session->param('number'),       $session->param('id') // '',
1779                     $session->param('cardnumber'),   $session->param('firstname'),
1780                     $session->param('surname'),      $session->param('branch'),
1781                     $session->param('branchname'),   $session->param('flags'),
1782                     $session->param('emailaddress'), $session->param('shibboleth'),
1783                     $session->param('desk_id'),      $session->param('desk_name'),
1784                     $session->param('register_id'),  $session->param('register_name')
1785                 );
1786                 return ( "additional-auth-needed", $session )
1787                     if $session->param('waiting-for-2FA');
1788
1789                 return ( "setup-additional-auth-needed", $session )
1790                     if $session->param('waiting-for-2FA-setup');
1791
1792                 return ( "ok", $session );
1793             } else {
1794                 $session->delete();
1795                 $session->flush;
1796                 return ( "failed", undef );
1797             }
1798
1799         } else {
1800             C4::Context->_new_userenv($sessionID);
1801             C4::Context->interface($session->param('interface'));
1802             C4::Context->set_userenv( undef, q{} );
1803             return ( "anon", $session );
1804         }
1805     } else {
1806         return ( "expired", undef );
1807     }
1808 }
1809
1810 =head2 get_session
1811
1812   use CGI::Session;
1813   my $session = get_session($sessionID);
1814
1815 Given a session ID, retrieve the CGI::Session object used to store
1816 the session's state.  The session object can be used to store
1817 data that needs to be accessed by different scripts during a
1818 user's session.
1819
1820 If the C<$sessionID> parameter is an empty string, a new session
1821 will be created.
1822
1823 =cut
1824
1825 sub _get_session_params {
1826     my $storage_method = C4::Context->preference('SessionStorage');
1827     if ( $storage_method eq 'mysql' ) {
1828         my $dbh = C4::Context->dbh;
1829         return { dsn => "serializer:yamlxs;driver:MySQL;id:md5", dsn_args => { Handle => $dbh } };
1830     }
1831     elsif ( $storage_method eq 'Pg' ) {
1832         my $dbh = C4::Context->dbh;
1833         return { dsn => "serializer:yamlxs;driver:PostgreSQL;id:md5", dsn_args => { Handle => $dbh } };
1834     }
1835     elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1836         my $memcached = Koha::Caches->get_instance()->memcached_cache;
1837         return { dsn => "serializer:yamlxs;driver:memcached;id:md5", dsn_args => { Memcached => $memcached } };
1838     }
1839     else {
1840         # catch all defaults to tmp should work on all systems
1841         my $dir = C4::Context::temporary_directory;
1842         my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1843         return { dsn => "serializer:yamlxs;driver:File;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1844     }
1845 }
1846
1847 sub get_session {
1848     my $sessionID      = shift;
1849     my $params = _get_session_params();
1850     my $session;
1851     if( $sessionID ) { # find existing
1852         CGI::Session::ErrorHandler->set_error( q{} ); # clear error, cpan issue #111463
1853         $session = CGI::Session->load( $params->{dsn}, $sessionID, $params->{dsn_args} );
1854     } else {
1855         $session = CGI::Session->new( $params->{dsn}, $sessionID, $params->{dsn_args} );
1856         # no need to flush here
1857     }
1858     return $session;
1859 }
1860
1861
1862 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1863 # (or something similar)
1864 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1865 # not having a userenv defined could cause a crash.
1866 sub checkpw {
1867     my ( $userid, $password, $query, $type, $no_set_userenv ) = @_;
1868     $type = 'opac' unless $type;
1869
1870     # Get shibboleth login attribute
1871     my $shib = C4::Context->config('useshibboleth') && shib_ok();
1872     my $shib_login = $shib ? get_login_shib() : undef;
1873
1874     my @return;
1875     my $patron;
1876     if ( defined $userid ){
1877         $patron = Koha::Patrons->find({ userid => $userid });
1878         $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1879     }
1880     my $check_internal_as_fallback = 0;
1881     my $passwd_ok = 0;
1882     # Note: checkpw_* routines returns:
1883     # 1 if auth is ok
1884     # 0 if auth is nok
1885     # -1 if user bind failed (LDAP only)
1886
1887     if ( $patron and ( $patron->account_locked )  ) {
1888         # Nothing to check, account is locked
1889     } elsif ($ldap && defined($password)) {
1890         my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_);    # EXTERNAL AUTH
1891         if ( $retval == 1 ) {
1892             @return = ( $retval, $retcard, $retuserid );
1893             $passwd_ok = 1;
1894         }
1895         $check_internal_as_fallback = 1 if $retval == 0;
1896
1897     } elsif ( $cas && $query && $query->param('ticket') ) {
1898
1899         # In case of a CAS authentication, we use the ticket instead of the password
1900         my $ticket = $query->param('ticket');
1901         $query->delete('ticket');                                   # remove ticket to come back to original URL
1902         my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $ticket, $query, $type );    # EXTERNAL AUTH
1903         if ( $retval ) {
1904             @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1905         } else {
1906             @return = (0);
1907         }
1908         $passwd_ok = $retval;
1909     }
1910
1911     # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1912     # Check for password to asertain whether we want to be testing against shibboleth or another method this
1913     # time around.
1914     elsif ( $shib && $shib_login && !$password ) {
1915
1916         # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1917         # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1918         # shibboleth-authenticated user
1919
1920         # Then, we check if it matches a valid koha user
1921         if ($shib_login) {
1922             my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login);    # EXTERNAL AUTH
1923             if ( $retval ) {
1924                 @return = ( $retval, $retcard, $retuserid );
1925             }
1926             $passwd_ok = $retval;
1927         }
1928     } else {
1929         $check_internal_as_fallback = 1;
1930     }
1931
1932     # INTERNAL AUTH
1933     if ( $check_internal_as_fallback ) {
1934         @return = checkpw_internal( $userid, $password, $no_set_userenv);
1935         $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1936     }
1937
1938     if( $patron ) {
1939         if ( $passwd_ok ) {
1940             $patron->update({ login_attempts => 0 });
1941             if( $patron->password_expired ){
1942                 @return = (-2);
1943             }
1944         } elsif( !$patron->account_locked ) {
1945             $patron->update({ login_attempts => $patron->login_attempts + 1 });
1946         }
1947     }
1948
1949     # Optionally log success or failure
1950     if( $patron && $passwd_ok && C4::Context->preference('AuthSuccessLog') ) {
1951         logaction( 'AUTH', 'SUCCESS', $patron->id, "Valid password for $userid", $type );
1952     } elsif( !$passwd_ok && C4::Context->preference('AuthFailureLog') ) {
1953         logaction( 'AUTH', 'FAILURE', $patron ? $patron->id : 0, "Wrong password for $userid", $type );
1954     }
1955
1956     return @return;
1957 }
1958
1959 sub checkpw_internal {
1960     my ( $userid, $password, $no_set_userenv ) = @_;
1961
1962     $password = Encode::encode( 'UTF-8', $password )
1963       if Encode::is_utf8($password);
1964
1965     my $dbh = C4::Context->dbh;
1966     my $sth =
1967       $dbh->prepare(
1968         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1969       );
1970     $sth->execute($userid);
1971     if ( $sth->rows ) {
1972         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1973             $surname, $branchcode, $branchname, $flags )
1974           = $sth->fetchrow;
1975
1976         if ( checkpw_hash( $password, $stored_hash ) ) {
1977
1978             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1979                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1980             return 1, $cardnumber, $userid;
1981         }
1982     }
1983     $sth =
1984       $dbh->prepare(
1985         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1986       );
1987     $sth->execute($userid);
1988     if ( $sth->rows ) {
1989         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1990             $surname, $branchcode, $branchname, $flags )
1991           = $sth->fetchrow;
1992
1993         if ( checkpw_hash( $password, $stored_hash ) ) {
1994
1995             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1996                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1997             return 1, $cardnumber, $userid;
1998         }
1999     }
2000     return 0;
2001 }
2002
2003 sub checkpw_hash {
2004     my ( $password, $stored_hash ) = @_;
2005
2006     return if $stored_hash eq '!';
2007
2008     # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
2009     my $hash;
2010     if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
2011         $hash = hash_password( $password, $stored_hash );
2012     } else {
2013         $hash = md5_base64($password);
2014     }
2015     return $hash eq $stored_hash;
2016 }
2017
2018 =head2 getuserflags
2019
2020     my $authflags = getuserflags($flags, $userid, [$dbh]);
2021
2022 Translates integer flags into permissions strings hash.
2023
2024 C<$flags> is the integer userflags value ( borrowers.userflags )
2025 C<$userid> is the members.userid, used for building subpermissions
2026 C<$authflags> is a hashref of permissions
2027
2028 =cut
2029
2030 sub getuserflags {
2031     my $flags  = shift;
2032     my $userid = shift;
2033     my $dbh    = @_ ? shift : C4::Context->dbh;
2034     my $userflags;
2035     {
2036         # I don't want to do this, but if someone logs in as the database
2037         # user, it would be preferable not to spam them to death with
2038         # numeric warnings. So, we make $flags numeric.
2039         no warnings 'numeric';
2040         $flags += 0;
2041     }
2042     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
2043     $sth->execute;
2044
2045     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
2046         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
2047             $userflags->{$flag} = 1;
2048         }
2049         else {
2050             $userflags->{$flag} = 0;
2051         }
2052     }
2053
2054     # get subpermissions and merge with top-level permissions
2055     my $user_subperms = get_user_subpermissions($userid);
2056     foreach my $module ( keys %$user_subperms ) {
2057         next if $userflags->{$module} == 1;    # user already has permission for everything in this module
2058         $userflags->{$module} = $user_subperms->{$module};
2059     }
2060
2061     return $userflags;
2062 }
2063
2064 =head2 get_user_subpermissions
2065
2066   $user_perm_hashref = get_user_subpermissions($userid);
2067
2068 Given the userid (note, not the borrowernumber) of a staff user,
2069 return a hashref of hashrefs of the specific subpermissions
2070 accorded to the user.  An example return is
2071
2072  {
2073     tools => {
2074         export_catalog => 1,
2075         import_patrons => 1,
2076     }
2077  }
2078
2079 The top-level hash-key is a module or function code from
2080 userflags.flag, while the second-level key is a code
2081 from permissions.
2082
2083 The results of this function do not give a complete picture
2084 of the functions that a staff user can access; it is also
2085 necessary to check borrowers.flags.
2086
2087 =cut
2088
2089 sub get_user_subpermissions {
2090     my $userid = shift;
2091
2092     my $dbh = C4::Context->dbh;
2093     my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2094                              FROM user_permissions
2095                              JOIN permissions USING (module_bit, code)
2096                              JOIN userflags ON (module_bit = bit)
2097                              JOIN borrowers USING (borrowernumber)
2098                              WHERE userid = ?" );
2099     $sth->execute($userid);
2100
2101     my $user_perms = {};
2102     while ( my $perm = $sth->fetchrow_hashref ) {
2103         $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2104     }
2105     return $user_perms;
2106 }
2107
2108 =head2 get_all_subpermissions
2109
2110   my $perm_hashref = get_all_subpermissions();
2111
2112 Returns a hashref of hashrefs defining all specific
2113 permissions currently defined.  The return value
2114 has the same structure as that of C<get_user_subpermissions>,
2115 except that the innermost hash value is the description
2116 of the subpermission.
2117
2118 =cut
2119
2120 sub get_all_subpermissions {
2121     my $dbh = C4::Context->dbh;
2122     my $sth = $dbh->prepare( "SELECT flag, code
2123                              FROM permissions
2124                              JOIN userflags ON (module_bit = bit)" );
2125     $sth->execute();
2126
2127     my $all_perms = {};
2128     while ( my $perm = $sth->fetchrow_hashref ) {
2129         $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2130     }
2131     return $all_perms;
2132 }
2133
2134 =head2 haspermission
2135
2136   $flagsrequired = '*';                                 # Any permission at all
2137   $flagsrequired = 'a_flag';                            # a_flag must be satisfied (all subpermissions)
2138   $flagsrequired = [ 'a_flag', 'b_flag' ];              # a_flag OR b_flag must be satisfied
2139   $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 };     # a_flag AND b_flag must be satisfied
2140   $flagsrequired = { 'a_flag' => 'sub_a' };             # sub_a of a_flag must be satisfied
2141   $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2142
2143   $flags = ($userid, $flagsrequired);
2144
2145 C<$userid> the userid of the member
2146 C<$flags> is a query structure similar to that used by SQL::Abstract that
2147 denotes the combination of flags required. It is a required parameter.
2148
2149 The main logic of this method is that things in arrays are OR'ed, and things
2150 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2151
2152 Returns member's flags or 0 if a permission is not met.
2153
2154 =cut
2155
2156 sub _dispatch {
2157     my ($required, $flags) = @_;
2158
2159     my $ref = ref($required);
2160     if ($ref eq '') {
2161         if ($required eq '*') {
2162             return 0 unless ( $flags or ref( $flags ) );
2163         } else {
2164             return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2165         }
2166     } elsif ($ref eq 'HASH') {
2167         foreach my $key (keys %{$required}) {
2168             next if $flags == 1;
2169             my $require = $required->{$key};
2170             my $rflags  = $flags->{$key};
2171             return 0 unless _dispatch($require, $rflags);
2172         }
2173     } elsif ($ref eq 'ARRAY') {
2174         my $satisfied = 0;
2175         foreach my $require ( @{$required} ) {
2176             my $rflags =
2177               ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2178               ? $flags->{$require}
2179               : $flags;
2180             $satisfied++ if _dispatch( $require, $rflags );
2181         }
2182         return 0 unless $satisfied;
2183     } else {
2184         croak "Unexpected structure found: $ref";
2185     }
2186
2187     return $flags;
2188 };
2189
2190 sub haspermission {
2191     my ( $userid, $flagsrequired ) = @_;
2192
2193     #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2194     #  unless defined($flagsrequired);
2195
2196     my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2197     $sth->execute($userid);
2198     my $row = $sth->fetchrow();
2199     my $flags = getuserflags( $row, $userid );
2200
2201     return $flags unless defined($flagsrequired);
2202     return $flags if $flags->{superlibrarian};
2203     return _dispatch($flagsrequired, $flags);
2204
2205     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2206 }
2207
2208 =head2 in_iprange
2209
2210   $flags = ($iprange);
2211
2212 C<$iprange> A space separated string describing an IP range. Can include single IPs or ranges
2213
2214 Returns 1 if the remote address is in the provided iprange, or 0 otherwise.
2215
2216 =cut
2217
2218 sub in_iprange {
2219     my ($iprange) = @_;
2220     my $result = 1;
2221     my @allowedipranges = $iprange ? split(' ', $iprange) : ();
2222     if (scalar @allowedipranges > 0) {
2223         my @rangelist;
2224         eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2225         eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || Koha::Logger->get->warn('cidrlookup failed for ' . join(' ',@rangelist) );
2226      }
2227      return $result ? 1 : 0;
2228 }
2229
2230 sub getborrowernumber {
2231     my ($userid) = @_;
2232     my $userenv = C4::Context->userenv;
2233     if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2234         return $userenv->{number};
2235     }
2236     my $dbh = C4::Context->dbh;
2237     for my $field ( 'userid', 'cardnumber' ) {
2238         my $sth =
2239           $dbh->prepare("select borrowernumber from borrowers where $field=?");
2240         $sth->execute($userid);
2241         if ( $sth->rows ) {
2242             my ($bnumber) = $sth->fetchrow;
2243             return $bnumber;
2244         }
2245     }
2246     return 0;
2247 }
2248
2249 =head2 track_login_daily
2250
2251     track_login_daily( $userid );
2252
2253 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2254
2255 =cut
2256
2257 sub track_login_daily {
2258     my $userid = shift;
2259     return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2260
2261     my $cache     = Koha::Caches->get_instance();
2262     my $cache_key = "track_login_" . $userid;
2263     my $cached    = $cache->get_from_cache($cache_key);
2264     my $today = dt_from_string()->ymd;
2265     return if $cached && $cached eq $today;
2266
2267     my $patron = Koha::Patrons->find({ userid => $userid });
2268     return unless $patron;
2269     $patron->track_login;
2270     $cache->set_in_cache( $cache_key, $today );
2271 }
2272
2273 END { }    # module clean-up code here (global destructor)
2274 1;
2275 __END__
2276
2277 =head1 SEE ALSO
2278
2279 CGI(3)
2280
2281 C4::Output(3)
2282
2283 Crypt::Eksblowfish::Bcrypt(3)
2284
2285 Digest::MD5(3)
2286
2287 =cut