C4/Auth.pm

   1 package C4::Auth;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use strict;
  21 use warnings;
  22 use Carp qw( croak );
  23
  24 use Digest::MD5 qw( md5_base64 );
  25 use CGI::Session;
  26 use CGI::Session::ErrorHandler;
  27 use URI;
  28 use URI::QueryParam;
  29
  30 use C4::Context;
  31 use C4::Templates;    # to get the template
  32 use C4::Languages;
  33 use C4::Search::History;
  34 use Koha;
  35 use Koha::Logger;
  36 use Koha::Caches;
  37 use Koha::AuthUtils qw( get_script_name hash_password );
  38 use Koha::Auth::TwoFactorAuth;
  39 use Koha::Checkouts;
  40 use Koha::DateUtils qw( dt_from_string );
  41 use Koha::Library::Groups;
  42 use Koha::Libraries;
  43 use Koha::Cash::Registers;
  44 use Koha::Desks;
  45 use Koha::Patrons;
  46 use Koha::Patron::Consents;
  47 use List::MoreUtils qw( any );
  48 use Encode;
  49 use C4::Auth_with_shibboleth qw( shib_ok get_login_shib login_shib_url logout_shib checkpw_shib );
  50 use Net::CIDR;
  51 use C4::Log qw( logaction );
  52 use Koha::CookieManager;
  53 use Koha::Auth::Permissions;
  54
  55 # use utf8;
  56
  57 use vars qw($ldap $cas $caslogout);
  58 our (@ISA, @EXPORT_OK);
  59
  60 #NOTE: The utility of keeping the safe_exit function is that it can be easily re-defined in unit tests and plugins
  61 sub safe_exit {
  62     # It's fine for us to "exit" because CGI::Compile (used in Plack::App::WrapCGI) redefines "exit" for us automatically.
  63     # Since we only seem to use C4::Auth::safe_exit in a CGI context, we don't actually need PSGI detection at all here.
  64     exit;
  65 }
  66
  67
  68 BEGIN {
  69     C4::Context->set_remote_address;
  70
  71     require Exporter;
  72     @ISA = qw(Exporter);
  73
  74     @EXPORT_OK = qw(
  75       checkauth check_api_auth get_session check_cookie_auth checkpw checkpw_internal checkpw_hash
  76       get_all_subpermissions get_user_subpermissions track_login_daily in_iprange
  77       get_template_and_user haspermission
  78     );
  79
  80     $ldap      = C4::Context->config('useldapserver') || 0;
  81     $cas       = C4::Context->preference('casAuthentication');
  82     $caslogout = C4::Context->preference('casLogout');
  83
  84     if ($ldap) {
  85         require C4::Auth_with_ldap;
  86         import C4::Auth_with_ldap qw(checkpw_ldap);
  87     }
  88     if ($cas) {
  89         require C4::Auth_with_cas;    # no import
  90         import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url logout_if_required multipleAuth getMultipleAuth);
  91     }
  92
  93 }
  94
  95 =head1 NAME
  96
  97 C4::Auth - Authenticates Koha users
  98
  99 =head1 SYNOPSIS
 100
 101   use CGI qw ( -utf8 );
 102   use C4::Auth;
 103   use C4::Output;
 104
 105   my $query = CGI->new;
 106
 107   my ($template, $borrowernumber, $cookie)
 108     = get_template_and_user(
 109         {
 110             template_name   => "opac-main.tt",
 111             query           => $query,
 112       type            => "opac",
 113       authnotrequired => 0,
 114       flagsrequired   => { catalogue => '*', tools => 'import_patrons' },
 115   }
 116     );
 117
 118   output_html_with_http_headers $query, $cookie, $template->output;
 119
 120 =head1 DESCRIPTION
 121
 122 The main function of this module is to provide
 123 authentification. However the get_template_and_user function has
 124 been provided so that a users login information is passed along
 125 automatically. This gets loaded into the template.
 126
 127 =head1 FUNCTIONS
 128
 129 =head2 get_template_and_user
 130
 131  my ($template, $borrowernumber, $cookie)
 132      = get_template_and_user(
 133        {
 134          template_name   => "opac-main.tt",
 135          query           => $query,
 136          type            => "opac",
 137          authnotrequired => 0,
 138          flagsrequired   => { catalogue => '*', tools => 'import_patrons' },
 139        }
 140      );
 141
 142 This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
 143 to C<&checkauth> (in this module) to perform authentification.
 144 See C<&checkauth> for an explanation of these parameters.
 145
 146 The C<template_name> is then used to find the correct template for
 147 the page. The authenticated users details are loaded onto the
 148 template in the logged_in_user variable (which is a Koha::Patron object). Also the
 149 C<sessionID> is passed to the template. This can be used in templates
 150 if cookies are disabled. It needs to be put as and input to every
 151 authenticated page.
 152
 153 More information on the C<gettemplate> sub can be found in the
 154 Output.pm module.
 155
 156 =cut
 157
 158 sub get_template_and_user {
 159
 160     my $in = shift;
 161     my ( $user, $cookie, $sessionID, $flags );
 162     $cookie = [];
 163
 164     my $cookie_mgr = Koha::CookieManager->new;
 165
 166     # Get shibboleth login attribute
 167     my $shib = C4::Context->config('useshibboleth') && shib_ok();
 168     my $shib_login = $shib ? get_login_shib() : undef;
 169
 170     C4::Context->interface( $in->{type} );
 171
 172     $in->{'authnotrequired'} ||= 0;
 173
 174     # the following call includes a bad template check; might croak
 175     my $template = C4::Templates::gettemplate(
 176         $in->{'template_name'},
 177         $in->{'type'},
 178         $in->{'query'},
 179     );
 180
 181     if ( $in->{'template_name'} !~ m/maintenance/ ) {
 182         ( $user, $cookie, $sessionID, $flags ) = checkauth(
 183             $in->{'query'},
 184             $in->{'authnotrequired'},
 185             $in->{'flagsrequired'},
 186             $in->{'type'},
 187             undef,
 188             $in->{template_name},
 189         );
 190     }
 191
 192     # If we enforce GDPR and the user did not consent, redirect
 193     # Exceptions for consent page itself and SCI/SCO system
 194     if( $in->{type} eq 'opac' && $user &&
 195         $in->{'template_name'} !~ /^(opac-page|opac-patron-consent|sc[io]\/)/ &&
 196         C4::Context->preference('GDPR_Policy') eq 'Enforced' )
 197     {
 198         my $consent = Koha::Patron::Consents->search({
 199             borrowernumber => getborrowernumber($user),
 200             type => 'GDPR_PROCESSING',
 201             given_on => { '!=', undef },
 202         })->next;
 203         if( !$consent ) {
 204             print $in->{query}->redirect(-uri => '/cgi-bin/koha/opac-patron-consent.pl', -cookie => $cookie);
 205             safe_exit;
 206         }
 207     }
 208
 209     if ( $in->{type} eq 'opac' && $user ) {
 210         my $is_sco_user;
 211         if ($sessionID){
 212             my $session = get_session($sessionID);
 213             if ($session){
 214                 $is_sco_user = $session->param('sco_user');
 215             }
 216         }
 217         my $kick_out;
 218
 219         if (
 220 # If the user logged in is the SCO user and they try to go out of the SCO module,
 221 # log the user out removing the CGISESSID cookie
 222             $in->{template_name} !~ m|sco/| && $in->{template_name} !~ m|errors/errorpage.tt|
 223             && (
 224                 $is_sco_user ||
 225                 (
 226                     C4::Context->preference('AutoSelfCheckID')
 227                     && $user eq C4::Context->preference('AutoSelfCheckID')
 228                 )
 229             )
 230           )
 231         {
 232             $kick_out = 1;
 233         }
 234         elsif (
 235 # If the user logged in is the SCI user and they try to go out of the SCI module,
 236 # kick them out unless it is SCO with a valid permission
 237 # or they are a superlibrarian
 238                $in->{template_name} !~ m|sci/|
 239             && haspermission( $user, { self_check => 'self_checkin_module' } )
 240             && !(
 241                 $in->{template_name} =~ m|sco/| && haspermission(
 242                     $user, { self_check => 'self_checkout_module' }
 243                 )
 244             )
 245             && $flags && $flags->{superlibrarian} != 1
 246           )
 247         {
 248             $kick_out = 1;
 249         }
 250
 251         if ($kick_out) {
 252             $template = C4::Templates::gettemplate( 'opac-auth.tt', 'opac',
 253                 $in->{query} );
 254             $cookie = $cookie_mgr->replace_in_list( $cookie, $in->{query}->cookie(
 255                 -name     => 'CGISESSID',
 256                 -value    => '',
 257                 -HttpOnly => 1,
 258                 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
 259                 -sameSite => 'Lax',
 260             ));
 261
 262             $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                 $session->param( 'waiting-for-2FA-setup', 0 );
 879
 880                # This is an ugly trick to pass the test
 881                # $query->param('koha_login_context') && ( $q_userid ne $userid )
 882                # few lines later
 883                 $q_userid = $userid;
 884             }
 885             else {
 886                 $invalid_otp_token = 1;
 887             }
 888         }
 889
 890         if ( $auth_state eq 'completed' ) {
 891             Koha::Logger->get->debug(sprintf "AUTH_SESSION: (%s)\t%s %s - %s", map { $session->param($_) || q{} } qw(cardnumber firstname surname branch));
 892
 893             if ( ( $query->param('koha_login_context') && ( $q_userid ne $userid ) )
 894                 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
 895                 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
 896             ) {
 897
 898                 #if a user enters an id ne to the id in the current session, we need to log them in...
 899                 #first we need to clear the anonymous session...
 900                 $anon_search_history = $session->param('search_history');
 901                 $session->delete();
 902                 $session->flush;
 903                 $cookie = $cookie_mgr->clear_unless( $query->cookie, @$cookie );
 904                 C4::Context::_unset_userenv($sessionID);
 905                 $sessionID = undef;
 906             } elsif (!$logout) {
 907
 908                 $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
 909                     -name     => 'CGISESSID',
 910                     -value    => $session->id,
 911                     -HttpOnly => 1,
 912                     -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
 913                     -sameSite => 'Lax',
 914                 ));
 915
 916                 $flags = haspermission( $userid, $flagsrequired );
 917                 unless ( $flags ) {
 918                     $auth_state = 'failed';
 919                     $info{'nopermission'} = 1;
 920                 }
 921             }
 922         } elsif ( !$logout ) {
 923             if ( $return eq 'expired' ) {
 924                 $info{timed_out} = 1;
 925             } elsif ( $return eq 'restricted' ) {
 926                 $info{oldip}        = $more_info->{old_ip};
 927                 $info{newip}        = $more_info->{new_ip};
 928                 $info{different_ip} = 1;
 929             } elsif ( $return eq 'password_expired' ) {
 930                 $info{password_has_expired} = 1;
 931             }
 932         }
 933     }
 934
 935     if ( $auth_state eq 'failed' || $logout ) {
 936         $sessionID = undef;
 937         $userid    = undef;
 938     }
 939
 940     if ($logout) {
 941
 942         # voluntary logout the user
 943         # check wether the user was using their shibboleth session or a local one
 944         my $shibSuccess = C4::Context->userenv ? C4::Context->userenv->{'shibboleth'} : undef;
 945         if ( $session ) {
 946             $session->delete();
 947             $session->flush;
 948         }
 949         C4::Context::_unset_userenv($sessionID);
 950         $cookie = $cookie_mgr->clear_unless( $query->cookie, @$cookie );
 951
 952         if ($cas and $caslogout) {
 953             logout_cas($query, $type);
 954         }
 955
 956         # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
 957         if ( $shib and $shib_login and $shibSuccess) {
 958             logout_shib($query);
 959         }
 960
 961         $session   = undef;
 962         $auth_state = 'logout';
 963     }
 964
 965     unless ( $userid ) {
 966         #we initiate a session prior to checking for a username to allow for anonymous sessions...
 967         if( !$session or !$sessionID ) { # if we cleared sessionID, we need a new session
 968             $session = get_session() or die "Auth ERROR: Cannot get_session()";
 969         }
 970
 971         # Save anonymous search history in new session so it can be retrieved
 972         # by get_template_and_user to store it in user's search history after
 973         # a successful login.
 974         if ($anon_search_history) {
 975             $session->param( 'search_history', $anon_search_history );
 976         }
 977
 978         $sessionID = $session->id;
 979         C4::Context->_new_userenv($sessionID);
 980         $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
 981             -name     => 'CGISESSID',
 982             -value    => $sessionID,
 983             -HttpOnly => 1,
 984             -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
 985             -sameSite => 'Lax',
 986         ));
 987         my $pki_field = C4::Context->preference('AllowPKIAuth');
 988         if ( !defined($pki_field) ) {
 989             print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
 990             $pki_field = 'None';
 991         }
 992         if ( ( $cas && $query->param('ticket') )
 993             || $q_userid
 994             || ( $shib && $shib_login )
 995             || $pki_field ne 'None'
 996             || $emailaddress )
 997         {
 998             my $password    = $query->param('password');
 999             my $shibSuccess = 0;
1000             my ( $return, $cardnumber );
1001
1002             # If shib is enabled and we have a shib login, does the login match a valid koha user
1003             if ( $shib && $shib_login ) {
1004                 my $retuserid;
1005
1006                 # Do not pass password here, else shib will not be checked in checkpw.
1007                 ( $return, $cardnumber, $retuserid ) = checkpw( $q_userid, undef, $query );
1008                 $userid      = $retuserid;
1009                 $shibSuccess = $return;
1010                 $info{'invalidShibLogin'} = 1 unless ($return);
1011             }
1012
1013             # If shib login and match were successful, skip further login methods
1014             unless ($shibSuccess) {
1015                 if ( $cas && $query->param('ticket') ) {
1016                     my $retuserid;
1017                     ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1018                       checkpw( $userid, $password, $query, $type );
1019                     $userid = $retuserid;
1020                     $info{'invalidCasLogin'} = 1 unless ($return);
1021                 }
1022
1023                 elsif ( $emailaddress ) {
1024                     my $value = $emailaddress;
1025
1026                     # If we're looking up the email, there's a chance that the person
1027                     # doesn't have a userid. So if there is none, we pass along the
1028                     # borrower number, and the bits of code that need to know the user
1029                     # ID will have to be smart enough to handle that.
1030                     my $patrons = Koha::Patrons->search({ email => $value });
1031                     if ($patrons->count) {
1032
1033                         # First the userid, then the borrowernum
1034                         my $patron = $patrons->next;
1035                         $value = $patron->userid || $patron->borrowernumber;
1036                     } else {
1037                         undef $value;
1038                     }
1039                     $return = $value ? 1 : 0;
1040                     $userid = $value;
1041                 }
1042
1043                 elsif (
1044                     ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1045                     || ( $pki_field eq 'emailAddress'
1046                         && $ENV{'SSL_CLIENT_S_DN_Email'} )
1047                   )
1048                 {
1049                     my $value;
1050                     if ( $pki_field eq 'Common Name' ) {
1051                         $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1052                     }
1053                     elsif ( $pki_field eq 'emailAddress' ) {
1054                         $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1055
1056                         # If we're looking up the email, there's a chance that the person
1057                         # doesn't have a userid. So if there is none, we pass along the
1058                         # borrower number, and the bits of code that need to know the user
1059                         # ID will have to be smart enough to handle that.
1060                         my $patrons = Koha::Patrons->search({ email => $value });
1061                         if ($patrons->count) {
1062
1063                             # First the userid, then the borrowernum
1064                             my $patron = $patrons->next;
1065                             $value = $patron->userid || $patron->borrowernumber;
1066                         } else {
1067                             undef $value;
1068                         }
1069                     }
1070
1071                     $return = $value ? 1 : 0;
1072                     $userid = $value;
1073
1074                 }
1075                 else {
1076                     my $retuserid;
1077                     my $request_method = $query->request_method // q{};
1078
1079                     if (
1080                         $request_method eq 'POST'
1081                         || ( C4::Context->preference('AutoSelfCheckID')
1082                             && $q_userid eq C4::Context->preference('AutoSelfCheckID') )
1083                       )
1084                     {
1085
1086                         ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1087                           checkpw( $q_userid, $password, $query, $type );
1088                         $userid = $retuserid if ($retuserid);
1089                         $info{'invalid_username_or_password'} = 1 unless ($return);
1090                     }
1091                 }
1092             }
1093
1094             # If shib configured and shibOnly enabled, we should ignore anything other than a shibboleth type login.
1095             if (
1096                    $shib
1097                 && !$shibSuccess
1098                 && (
1099                     (
1100                         ( $type eq 'opac' )
1101                         && C4::Context->preference('OPACShibOnly')
1102                     )
1103                     || ( ( $type ne 'opac' )
1104                         && C4::Context->preference('staffShibOnly') )
1105                 )
1106               )
1107             {
1108                 $return = 0;
1109             }
1110
1111             # $return: 1 = valid user
1112             if( $return && $return > 0 ) {
1113
1114                 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1115                     $auth_state = "logged_in";
1116                 }
1117                 else {
1118                     $info{'nopermission'} = 1;
1119                     C4::Context::_unset_userenv($sessionID);
1120                 }
1121                 my ( $borrowernumber, $firstname, $surname, $userflags,
1122                     $branchcode, $branchname, $emailaddress, $desk_id,
1123                     $desk_name, $register_id, $register_name );
1124
1125                 if ( $return == 1 ) {
1126                     my $select = "
1127                     SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1128                     branches.branchname    as branchname, email
1129                     FROM borrowers
1130                     LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1131                     ";
1132                     my $dbh = C4::Context->dbh;
1133                     my $sth = $dbh->prepare("$select where userid=?");
1134                     $sth->execute($userid);
1135                     unless ( $sth->rows ) {
1136                         $sth = $dbh->prepare("$select where cardnumber=?");
1137                         $sth->execute($cardnumber);
1138
1139                         unless ( $sth->rows ) {
1140                             $sth->execute($userid);
1141                         }
1142                     }
1143                     if ( $sth->rows ) {
1144                         ( $borrowernumber, $firstname, $surname, $userflags,
1145                             $branchcode, $branchname, $emailaddress ) = $sth->fetchrow;
1146                     }
1147
1148                     # launch a sequence to check if we have a ip for the branch, i
1149                     # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1150
1151                     my $ip = $ENV{'REMOTE_ADDR'};
1152
1153                     # if they specify at login, use that
1154                     if ( $query->param('branch') ) {
1155                         $branchcode = $query->param('branch');
1156                         my $library = Koha::Libraries->find($branchcode);
1157                         $branchname = $library? $library->branchname: '';
1158                     }
1159                     if ( $query->param('desk_id') ) {
1160                         $desk_id = $query->param('desk_id');
1161                         my $desk = Koha::Desks->find($desk_id);
1162                         $desk_name = $desk ? $desk->desk_name : '';
1163                     }
1164                     if ( C4::Context->preference('UseCashRegisters') ) {
1165                         my $register =
1166                           $query->param('register_id')
1167                           ? Koha::Cash::Registers->find($query->param('register_id'))
1168                           : Koha::Cash::Registers->search(
1169                             { branch => $branchcode, branch_default => 1 },
1170                             { rows   => 1 } )->single;
1171                         $register_id   = $register->id   if ($register);
1172                         $register_name = $register->name if ($register);
1173                     }
1174                     my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search->as_list };
1175                     if ( $type ne 'opac' and C4::Context->preference('AutoLocation') ) {
1176
1177                         # we have to check they are coming from the right ip range
1178                         my $domain = $branches->{$branchcode}->{'branchip'};
1179                         $domain =~ s|\.\*||g;
1180                         if ( $ip !~ /^$domain/ ) {
1181                             $loggedin = 0;
1182                             $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
1183                                 -name     => 'CGISESSID',
1184                                 -value    => '',
1185                                 -HttpOnly => 1,
1186                                 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1187                                 -sameSite => 'Lax',
1188                             ));
1189                             $info{'wrongip'} = 1;
1190                         }
1191                     }
1192
1193                     foreach my $br ( keys %$branches ) {
1194
1195                         #     now we work with the treatment of ip
1196                         my $domain = $branches->{$br}->{'branchip'};
1197                         if ( $domain && $ip =~ /^$domain/ ) {
1198                             $branchcode = $branches->{$br}->{'branchcode'};
1199
1200                             # new op dev : add the branchname to the cookie
1201                             $branchname    = $branches->{$br}->{'branchname'};
1202                         }
1203                     }
1204
1205                     my $is_sco_user = 0;
1206                     if ( $query->param('sco_user_login') && ( $query->param('sco_user_login') eq '1' ) ){
1207                         $is_sco_user = 1;
1208                     }
1209
1210                     $session->param( 'number',       $borrowernumber );
1211                     $session->param( 'id',           $userid );
1212                     $session->param( 'cardnumber',   $cardnumber );
1213                     $session->param( 'firstname',    $firstname );
1214                     $session->param( 'surname',      $surname );
1215                     $session->param( 'branch',       $branchcode );
1216                     $session->param( 'branchname',   $branchname );
1217                     $session->param( 'desk_id',      $desk_id);
1218                     $session->param( 'desk_name',     $desk_name);
1219                     $session->param( 'flags',        $userflags );
1220                     $session->param( 'emailaddress', $emailaddress );
1221                     $session->param( 'ip',           $session->remote_addr() );
1222                     $session->param( 'lasttime',     time() );
1223                     $session->param( 'interface',    $type);
1224                     $session->param( 'shibboleth',   $shibSuccess );
1225                     $session->param( 'register_id',  $register_id );
1226                     $session->param( 'register_name',  $register_name );
1227                     $session->param( 'sco_user', $is_sco_user );
1228                 }
1229                 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1230                 C4::Context->set_userenv(
1231                     $session->param('number'),       $session->param('id'),
1232                     $session->param('cardnumber'),   $session->param('firstname'),
1233                     $session->param('surname'),      $session->param('branch'),
1234                     $session->param('branchname'),   $session->param('flags'),
1235                     $session->param('emailaddress'), $session->param('shibboleth'),
1236                     $session->param('desk_id'),      $session->param('desk_name'),
1237                     $session->param('register_id'),  $session->param('register_name')
1238                 );
1239
1240             }
1241             # $return: 0 = invalid user
1242             # reset to anonymous session
1243             else {
1244                 if ($userid) {
1245                     $info{'invalid_username_or_password'} = 1;
1246                     C4::Context::_unset_userenv($sessionID);
1247                 }
1248                 $session->param( 'lasttime', time() );
1249                 $session->param( 'ip',       $session->remote_addr() );
1250                 $session->param( 'sessiontype', 'anon' );
1251                 $session->param( 'interface', $type);
1252             }
1253         }    # END if ( $q_userid
1254         elsif ( $type eq "opac" ) {
1255
1256             # anonymous sessions are created only for the OPAC
1257
1258             # setting a couple of other session vars...
1259             $session->param( 'ip',          $session->remote_addr() );
1260             $session->param( 'lasttime',    time() );
1261             $session->param( 'sessiontype', 'anon' );
1262             $session->param( 'interface', $type);
1263         }
1264         $session->flush;
1265     }    # END unless ($userid)
1266
1267
1268     if ( $auth_state eq 'logged_in' ) {
1269         $auth_state = 'completed';
1270
1271         # Auth is completed unless an additional auth is needed
1272         if ( $require_2FA ) {
1273             my $patron = Koha::Patrons->find({userid => $userid});
1274             if ( C4::Context->preference('TwoFactorAuthentication') eq "enforced" && $patron->auth_method eq 'password' ) {
1275                 $auth_state = 'setup-additional-auth-needed';
1276                 $session->param('waiting-for-2FA-setup', 1);
1277                 %info = ();# We remove the warnings/errors we may have set incorrectly before
1278             } elsif ( $patron->auth_method eq 'two-factor' ) {
1279                 # Ask for the OTP token
1280                 $auth_state = 'additional-auth-needed';
1281                 $session->param('waiting-for-2FA', 1);
1282                 %info = ();# We remove the warnings/errors we may have set incorrectly before
1283             }
1284         }
1285     }
1286
1287     # finished authentification, now respond
1288     if ( $auth_state eq 'completed' || $authnotrequired ) {
1289         # successful login
1290         unless (@$cookie) {
1291             $cookie = $cookie_mgr->replace_in_list( $cookie, $query->cookie(
1292                 -name     => 'CGISESSID',
1293                 -value    => '',
1294                 -HttpOnly => 1,
1295                 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1296                 -sameSite => 'Lax',
1297             ));
1298         }
1299
1300         track_login_daily( $userid );
1301
1302         # In case, that this request was a login attempt, we want to prevent that users can repost the opac login
1303         # request. We therefore redirect the user to the requested page again without the login parameters.
1304         # See Post/Redirect/Get (PRG) design pattern: https://en.wikipedia.org/wiki/Post/Redirect/Get
1305         if ( $type eq "opac" && $query->param('koha_login_context') && $query->param('koha_login_context') ne 'sco' && $query->param('password') && $query->param('userid') ) {
1306             my $uri = URI->new($query->url(-relative=>1, -query_string=>1));
1307             $uri->query_param_delete('userid');
1308             $uri->query_param_delete('password');
1309             $uri->query_param_delete('koha_login_context');
1310             print $query->redirect(-uri => $uri->as_string, -cookie => $cookie, -status=>'303 See other');
1311             exit;
1312         }
1313
1314         return ( $userid, $cookie, $sessionID, $flags );
1315     }
1316
1317     #
1318     #
1319     # AUTH rejected, show the login/password template, after checking the DB.
1320     #
1321     #
1322
1323     my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1324
1325     # get the inputs from the incoming query
1326     my @inputs = ();
1327     my @inputs_to_clean = qw( userid password ticket logout.x otp_token );
1328     foreach my $name ( param $query) {
1329         next if grep { $name eq $_ } @inputs_to_clean;
1330         my @value = $query->multi_param($name);
1331         push @inputs, { name => $name, value => $_ } for @value;
1332     }
1333
1334     my $LibraryNameTitle = C4::Context->preference("LibraryName");
1335     $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1336     $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1337
1338     my $auth_template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1339     my $template = C4::Templates::gettemplate( $auth_template_name, $type, $query );
1340     $template->param(
1341         login                                 => 1,
1342         INPUTS                                => \@inputs,
1343         script_name                           => get_script_name(),
1344         casAuthentication                     => C4::Context->preference("casAuthentication"),
1345         shibbolethAuthentication              => $shib,
1346         suggestion                            => C4::Context->preference("suggestion"),
1347         virtualshelves                        => C4::Context->preference("virtualshelves"),
1348         LibraryName                           => "" . C4::Context->preference("LibraryName"),
1349         LibraryNameTitle                      => "" . $LibraryNameTitle,
1350         opacuserlogin                         => C4::Context->preference("opacuserlogin"),
1351         OpacFavicon                           => C4::Context->preference("OpacFavicon"),
1352         opacreadinghistory                    => C4::Context->preference("opacreadinghistory"),
1353         opaclanguagesdisplay                  => C4::Context->preference("opaclanguagesdisplay"),
1354         OPACUserJS                            => C4::Context->preference("OPACUserJS"),
1355         opacbookbag                           => "" . C4::Context->preference("opacbookbag"),
1356         OpacCloud                             => C4::Context->preference("OpacCloud"),
1357         OpacTopissue                          => C4::Context->preference("OpacTopissue"),
1358         OpacAuthorities                       => C4::Context->preference("OpacAuthorities"),
1359         OpacBrowser                           => C4::Context->preference("OpacBrowser"),
1360         TagsEnabled                           => C4::Context->preference("TagsEnabled"),
1361         OPACUserCSS                           => C4::Context->preference("OPACUserCSS"),
1362         intranetcolorstylesheet               => C4::Context->preference("intranetcolorstylesheet"),
1363         intranetstylesheet                    => C4::Context->preference("intranetstylesheet"),
1364         IntranetNav                           => C4::Context->preference("IntranetNav"),
1365         IntranetFavicon                       => C4::Context->preference("IntranetFavicon"),
1366         IntranetUserCSS                       => C4::Context->preference("IntranetUserCSS"),
1367         IntranetUserJS                        => C4::Context->preference("IntranetUserJS"),
1368         IndependentBranches                   => C4::Context->preference("IndependentBranches"),
1369         AutoLocation                          => C4::Context->preference("AutoLocation"),
1370         wrongip                               => $info{'wrongip'},
1371         PatronSelfRegistration                => C4::Context->preference("PatronSelfRegistration"),
1372         PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1373         opac_css_override                     => $ENV{'OPAC_CSS_OVERRIDE'},
1374         too_many_login_attempts               => ( $patron and $patron->account_locked ),
1375         password_has_expired                  => ( $patron and $patron->password_expired ),
1376     );
1377
1378     $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1379     $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1380     $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1381     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1382     if ( $auth_state eq 'additional-auth-needed' ) {
1383         my $patron = Koha::Patrons->find( { userid => $userid } );
1384         $template->param(
1385             TwoFA_prompt => 1,
1386             invalid_otp_token => $invalid_otp_token,
1387             notice_email_address => $patron->notice_email_address, # We could also pass logged_in_user if necessary
1388         );
1389     }
1390
1391     if ( $auth_state eq 'setup-additional-auth-needed' ) {
1392         $template->param(
1393             TwoFA_setup => 1,
1394         );
1395     }
1396
1397     if ( $type eq 'opac' ) {
1398         require Koha::Virtualshelves;
1399         my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1400             {
1401                 public => 1,
1402             }
1403         );
1404         $template->param(
1405             some_public_shelves  => $some_public_shelves,
1406         );
1407     }
1408
1409     if ($cas) {
1410
1411         # Is authentication against multiple CAS servers enabled?
1412         require C4::Auth_with_cas;
1413         if ( multipleAuth() && !$casparam ) {
1414             my $casservers = getMultipleAuth();
1415             my @tmplservers;
1416             foreach my $key ( keys %$casservers ) {
1417                 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1418             }
1419             $template->param(
1420                 casServersLoop => \@tmplservers
1421             );
1422         } else {
1423             $template->param(
1424                 casServerUrl => login_cas_url($query, undef, $type),
1425             );
1426         }
1427
1428         $template->param(
1429             invalidCasLogin => $info{'invalidCasLogin'}
1430         );
1431     }
1432
1433     if ($shib) {
1434         #If shibOnly is enabled just go ahead and redirect directly
1435         if ( (($type eq 'opac') && C4::Context->preference('OPACShibOnly')) || (($type ne 'opac') && C4::Context->preference('staffShibOnly')) ) {
1436             my $redirect_url = login_shib_url( $query );
1437             print $query->redirect( -uri => "$redirect_url", -status => 303 );
1438             safe_exit;
1439         }
1440
1441         $template->param(
1442             shibbolethAuthentication => $shib,
1443             shibbolethLoginUrl       => login_shib_url($query),
1444         );
1445     }
1446
1447     if (C4::Context->preference('GoogleOpenIDConnect')) {
1448         if ($query->param("OpenIDConnectFailed")) {
1449             my $reason = $query->param('OpenIDConnectFailed');
1450             $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1451         }
1452     }
1453
1454     $template->param(
1455         LibraryName => C4::Context->preference("LibraryName"),
1456     );
1457     $template->param(%info);
1458
1459     #    $cookie = $query->cookie(CGISESSID => $session->id
1460     #   );
1461     print $query->header(
1462         {   type              => 'text/html',
1463             charset           => 'utf-8',
1464             cookie            => $cookie,
1465             'X-Frame-Options' => 'SAMEORIGIN',
1466             -sameSite => 'Lax'
1467         }
1468       ),
1469       $template->output;
1470     safe_exit;
1471 }
1472
1473 =head2 check_api_auth
1474
1475   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1476
1477 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1478 cookie, determine if the user has the privileges specified by C<$userflags>.
1479
1480 C<check_api_auth> is is meant for authenticating users of web services, and
1481 consequently will always return and will not attempt to redirect the user
1482 agent.
1483
1484 If a valid session cookie is already present, check_api_auth will return a status
1485 of "ok", the cookie, and the Koha session ID.
1486
1487 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1488 parameters and create a session cookie and Koha session if the supplied credentials
1489 are OK.
1490
1491 Possible return values in C<$status> are:
1492
1493 =over
1494
1495 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1496
1497 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1498
1499 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1500
1501 =item "expired -- session cookie has expired; API user should resubmit userid and password
1502
1503 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1504
1505 =item "additional-auth-needed -- User is in an authentication process that is not finished
1506
1507 =back
1508
1509 =cut
1510
1511 sub check_api_auth {
1512
1513     my $query         = shift;
1514     my $flagsrequired = shift;
1515     my $timeout = _timeout_syspref();
1516
1517     unless ( C4::Context->preference('Version') ) {
1518
1519         # database has not been installed yet
1520         return ( "maintenance", undef, undef );
1521     }
1522     my $kohaversion = Koha::version();
1523     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1524     if ( C4::Context->preference('Version') < $kohaversion ) {
1525
1526         # database in need of version update; assume that
1527         # no API should be called while databsae is in
1528         # this condition.
1529         return ( "maintenance", undef, undef );
1530     }
1531
1532     my ( $sessionID, $session );
1533     unless ( $query->param('userid') ) {
1534         $sessionID = $query->cookie("CGISESSID");
1535     }
1536     if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1537
1538         my $return;
1539         ( $return, $session, undef ) = check_cookie_auth(
1540             $sessionID, $flagsrequired, { remote_addr => $ENV{REMOTE_ADDR} } );
1541
1542         return ( $return, undef, undef ) # Cookie auth failed
1543             if $return ne "ok";
1544
1545         my $cookie = $query->cookie(
1546             -name     => 'CGISESSID',
1547             -value    => $session->id,
1548             -HttpOnly => 1,
1549             -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1550             -sameSite => 'Lax'
1551         );
1552         return ( $return, $cookie, $session ); # return == 'ok' here
1553
1554     } else {
1555
1556         # new login
1557         my $userid   = $query->param('userid');
1558         my $password = $query->param('password');
1559         my ( $return, $cardnumber, $cas_ticket );
1560
1561         # Proxy CAS auth
1562         if ( $cas && $query->param('PT') ) {
1563             my $retuserid;
1564
1565             # In case of a CAS authentication, we use the ticket instead of the password
1566             my $PT = $query->param('PT');
1567             ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $PT, $query );    # EXTERNAL AUTH
1568         } else {
1569
1570             # User / password auth
1571             unless ( $userid and $password ) {
1572
1573                 # caller did something wrong, fail the authenticateion
1574                 return ( "failed", undef, undef );
1575             }
1576             my $newuserid;
1577             ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $userid, $password, $query );
1578         }
1579
1580         if ( $return and haspermission( $userid, $flagsrequired ) ) {
1581             my $session = get_session("");
1582             return ( "failed", undef, undef ) unless $session;
1583
1584             my $sessionID = $session->id;
1585             C4::Context->_new_userenv($sessionID);
1586             my $cookie = $query->cookie(
1587                 -name     => 'CGISESSID',
1588                 -value    => $sessionID,
1589                 -HttpOnly => 1,
1590                 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1591                 -sameSite => 'Lax'
1592             );
1593             if ( $return == 1 ) {
1594                 my (
1595                     $borrowernumber, $firstname,  $surname,
1596                     $userflags,      $branchcode, $branchname,
1597                     $emailaddress
1598                 );
1599                 my $dbh = C4::Context->dbh;
1600                 my $sth =
1601                   $dbh->prepare(
1602 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1603                   );
1604                 $sth->execute($userid);
1605                 (
1606                     $borrowernumber, $firstname,  $surname,
1607                     $userflags,      $branchcode, $branchname,
1608                     $emailaddress
1609                 ) = $sth->fetchrow if ( $sth->rows );
1610
1611                 unless ( $sth->rows ) {
1612                     my $sth = $dbh->prepare(
1613 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1614                     );
1615                     $sth->execute($cardnumber);
1616                     (
1617                         $borrowernumber, $firstname,  $surname,
1618                         $userflags,      $branchcode, $branchname,
1619                         $emailaddress
1620                     ) = $sth->fetchrow if ( $sth->rows );
1621
1622                     unless ( $sth->rows ) {
1623                         $sth->execute($userid);
1624                         (
1625                             $borrowernumber, $firstname,  $surname,       $userflags,
1626                             $branchcode,     $branchname, $emailaddress
1627                         ) = $sth->fetchrow if ( $sth->rows );
1628                     }
1629                 }
1630
1631                 my $ip = $ENV{'REMOTE_ADDR'};
1632
1633                 # if they specify at login, use that
1634                 if ( $query->param('branch') ) {
1635                     $branchcode = $query->param('branch');
1636                     my $library = Koha::Libraries->find($branchcode);
1637                     $branchname = $library? $library->branchname: '';
1638                 }
1639                 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search->as_list };
1640                 foreach my $br ( keys %$branches ) {
1641
1642                     #     now we work with the treatment of ip
1643                     my $domain = $branches->{$br}->{'branchip'};
1644                     if ( $domain && $ip =~ /^$domain/ ) {
1645                         $branchcode = $branches->{$br}->{'branchcode'};
1646
1647                         # new op dev : add the branchname to the cookie
1648                         $branchname    = $branches->{$br}->{'branchname'};
1649                     }
1650                 }
1651                 $session->param( 'number',       $borrowernumber );
1652                 $session->param( 'id',           $userid );
1653                 $session->param( 'cardnumber',   $cardnumber );
1654                 $session->param( 'firstname',    $firstname );
1655                 $session->param( 'surname',      $surname );
1656                 $session->param( 'branch',       $branchcode );
1657                 $session->param( 'branchname',   $branchname );
1658                 $session->param( 'flags',        $userflags );
1659                 $session->param( 'emailaddress', $emailaddress );
1660                 $session->param( 'ip',           $session->remote_addr() );
1661                 $session->param( 'lasttime',     time() );
1662                 $session->param( 'interface',    'api'  );
1663             }
1664             $session->param( 'cas_ticket', $cas_ticket);
1665             C4::Context->set_userenv(
1666                 $session->param('number'),       $session->param('id'),
1667                 $session->param('cardnumber'),   $session->param('firstname'),
1668                 $session->param('surname'),      $session->param('branch'),
1669                 $session->param('branchname'),   $session->param('flags'),
1670                 $session->param('emailaddress'), $session->param('shibboleth'),
1671                 $session->param('desk_id'),      $session->param('desk_name'),
1672                 $session->param('register_id'),  $session->param('register_name')
1673             );
1674             return ( "ok", $cookie, $sessionID );
1675         } else {
1676             return ( "failed", undef, undef );
1677         }
1678     }
1679 }
1680
1681 =head2 check_cookie_auth
1682
1683   ($status, $sessionId) = check_cookie_auth($cookie, $userflags);
1684
1685 Given a CGISESSID cookie set during a previous login to Koha, determine
1686 if the user has the privileges specified by C<$userflags>. C<$userflags>
1687 is passed unaltered into C<haspermission> and as such accepts all options
1688 avaiable to that routine with the one caveat that C<check_api_auth> will
1689 also allow 'undef' to be passed and in such a case the permissions check
1690 will be skipped altogether.
1691
1692 C<check_cookie_auth> is meant for authenticating special services
1693 such as tools/upload-file.pl that are invoked by other pages that
1694 have been authenticated in the usual way.
1695
1696 Possible return values in C<$status> are:
1697
1698 =over
1699
1700 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1701
1702 =item "anon" -- user not authenticated but valid for anonymous session.
1703
1704 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1705
1706 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1707
1708 =item "expired -- session cookie has expired; API user should resubmit userid and password
1709
1710 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1711
1712 =back
1713
1714 =cut
1715
1716 sub check_cookie_auth {
1717     my $sessionID     = shift;
1718     my $flagsrequired = shift;
1719     my $params        = shift;
1720
1721     my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1722
1723     my $skip_version_check = $params->{skip_version_check}; # Only for checkauth
1724
1725     unless ( $skip_version_check ) {
1726         unless ( C4::Context->preference('Version') ) {
1727
1728             # database has not been installed yet
1729             return ( "maintenance", undef );
1730         }
1731         my $kohaversion = Koha::version();
1732         $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1733         if ( C4::Context->preference('Version') < $kohaversion ) {
1734
1735             # database in need of version update; assume that
1736             # no API should be called while databsae is in
1737             # this condition.
1738             return ( "maintenance", undef );
1739         }
1740     }
1741
1742     # see if we have a valid session cookie already
1743     # however, if a userid parameter is present (i.e., from
1744     # a form submission, assume that any current cookie
1745     # is to be ignored
1746     unless ( $sessionID ) {
1747         return ( "failed", undef );
1748     }
1749     C4::Context::_unset_userenv($sessionID); # remove old userenv first
1750     my $session   = get_session($sessionID);
1751     if ($session) {
1752         my $userid   = $session->param('id');
1753         my $ip       = $session->param('ip');
1754         my $lasttime = $session->param('lasttime');
1755         my $timeout = _timeout_syspref();
1756
1757         if ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
1758             # time out
1759             $session->delete();
1760             $session->flush;
1761             return ("expired", undef);
1762
1763         } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1764             # IP address changed
1765             $session->delete();
1766             $session->flush;
1767             return ( "restricted", undef, { old_ip => $ip, new_ip => $remote_addr});
1768
1769         } elsif ( $userid ) {
1770             $session->param( 'lasttime', time() );
1771             my $patron = Koha::Patrons->find({ userid => $userid });
1772             $patron = Koha::Patron->find({ cardnumber => $userid }) unless $patron;
1773             return ("password_expired", undef ) if $patron->password_expired;
1774             my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1775             if ($flags) {
1776                 C4::Context->_new_userenv($sessionID);
1777                 C4::Context->interface($session->param('interface'));
1778                 C4::Context->set_userenv(
1779                     $session->param('number'),       $session->param('id') // '',
1780                     $session->param('cardnumber'),   $session->param('firstname'),
1781                     $session->param('surname'),      $session->param('branch'),
1782                     $session->param('branchname'),   $session->param('flags'),
1783                     $session->param('emailaddress'), $session->param('shibboleth'),
1784                     $session->param('desk_id'),      $session->param('desk_name'),
1785                     $session->param('register_id'),  $session->param('register_name')
1786                 );
1787                 return ( "additional-auth-needed", $session )
1788                     if $session->param('waiting-for-2FA');
1789
1790                 return ( "setup-additional-auth-needed", $session )
1791                     if $session->param('waiting-for-2FA-setup');
1792
1793                 return ( "ok", $session );
1794             } else {
1795                 $session->delete();
1796                 $session->flush;
1797                 return ( "failed", undef );
1798             }
1799
1800         } else {
1801             C4::Context->_new_userenv($sessionID);
1802             C4::Context->interface($session->param('interface'));
1803             C4::Context->set_userenv( undef, q{} );
1804             return ( "anon", $session );
1805         }
1806     } else {
1807         return ( "expired", undef );
1808     }
1809 }
1810
1811 =head2 get_session
1812
1813   use CGI::Session;
1814   my $session = get_session($sessionID);
1815
1816 Given a session ID, retrieve the CGI::Session object used to store
1817 the session's state.  The session object can be used to store
1818 data that needs to be accessed by different scripts during a
1819 user's session.
1820
1821 If the C<$sessionID> parameter is an empty string, a new session
1822 will be created.
1823
1824 =cut
1825
1826 sub _get_session_params {
1827     my $storage_method = C4::Context->preference('SessionStorage');
1828     if ( $storage_method eq 'mysql' ) {
1829         my $dbh = C4::Context->dbh;
1830         return { dsn => "serializer:yamlxs;driver:MySQL;id:md5", dsn_args => { Handle => $dbh } };
1831     }
1832     elsif ( $storage_method eq 'Pg' ) {
1833         my $dbh = C4::Context->dbh;
1834         return { dsn => "serializer:yamlxs;driver:PostgreSQL;id:md5", dsn_args => { Handle => $dbh } };
1835     }
1836     elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1837         my $memcached = Koha::Caches->get_instance()->memcached_cache;
1838         return { dsn => "serializer:yamlxs;driver:memcached;id:md5", dsn_args => { Memcached => $memcached } };
1839     }
1840     else {
1841         # catch all defaults to tmp should work on all systems
1842         my $dir = C4::Context::temporary_directory;
1843         my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1844         return { dsn => "serializer:yamlxs;driver:File;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1845     }
1846 }
1847
1848 sub get_session {
1849     my $sessionID      = shift;
1850     my $params = _get_session_params();
1851     my $session;
1852     if( $sessionID ) { # find existing
1853         CGI::Session::ErrorHandler->set_error( q{} ); # clear error, cpan issue #111463
1854         $session = CGI::Session->load( $params->{dsn}, $sessionID, $params->{dsn_args} );
1855     } else {
1856         $session = CGI::Session->new( $params->{dsn}, $sessionID, $params->{dsn_args} );
1857         # no need to flush here
1858     }
1859     return $session;
1860 }
1861
1862
1863 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1864 # (or something similar)
1865 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1866 # not having a userenv defined could cause a crash.
1867 sub checkpw {
1868     my ( $userid, $password, $query, $type, $no_set_userenv ) = @_;
1869     $type = 'opac' unless $type;
1870
1871     # Get shibboleth login attribute
1872     my $shib = C4::Context->config('useshibboleth') && shib_ok();
1873     my $shib_login = $shib ? get_login_shib() : undef;
1874
1875     my @return;
1876     my $patron;
1877     if ( defined $userid ){
1878         $patron = Koha::Patrons->find({ userid => $userid });
1879         $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1880     }
1881     my $check_internal_as_fallback = 0;
1882     my $passwd_ok = 0;
1883     # Note: checkpw_* routines returns:
1884     # 1 if auth is ok
1885     # 0 if auth is nok
1886     # -1 if user bind failed (LDAP only)
1887
1888     if ( $patron and ( $patron->account_locked )  ) {
1889         # Nothing to check, account is locked
1890     } elsif ($ldap && defined($password)) {
1891         my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_);    # EXTERNAL AUTH
1892         if ( $retval == 1 ) {
1893             @return = ( $retval, $retcard, $retuserid );
1894             $passwd_ok = 1;
1895         }
1896         $check_internal_as_fallback = 1 if $retval == 0;
1897
1898     } elsif ( $cas && $query && $query->param('ticket') ) {
1899
1900         # In case of a CAS authentication, we use the ticket instead of the password
1901         my $ticket = $query->param('ticket');
1902         $query->delete('ticket');                                   # remove ticket to come back to original URL
1903         my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $ticket, $query, $type );    # EXTERNAL AUTH
1904         if ( $retval ) {
1905             @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1906         } else {
1907             @return = (0);
1908         }
1909         $passwd_ok = $retval;
1910     }
1911
1912     # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1913     # Check for password to asertain whether we want to be testing against shibboleth or another method this
1914     # time around.
1915     elsif ( $shib && $shib_login && !$password ) {
1916
1917         # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1918         # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1919         # shibboleth-authenticated user
1920
1921         # Then, we check if it matches a valid koha user
1922         if ($shib_login) {
1923             my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login);    # EXTERNAL AUTH
1924             if ( $retval ) {
1925                 @return = ( $retval, $retcard, $retuserid );
1926             }
1927             $passwd_ok = $retval;
1928         }
1929     } else {
1930         $check_internal_as_fallback = 1;
1931     }
1932
1933     # INTERNAL AUTH
1934     if ( $check_internal_as_fallback ) {
1935         @return = checkpw_internal( $userid, $password, $no_set_userenv);
1936         $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1937     }
1938
1939     if( $patron ) {
1940         if ( $passwd_ok ) {
1941             $patron->update({ login_attempts => 0 });
1942             if( $patron->password_expired ){
1943                 @return = (-2);
1944             }
1945         } elsif( !$patron->account_locked ) {
1946             $patron->update({ login_attempts => $patron->login_attempts + 1 });
1947         }
1948     }
1949
1950     # Optionally log success or failure
1951     if( $patron && $passwd_ok && C4::Context->preference('AuthSuccessLog') ) {
1952         logaction( 'AUTH', 'SUCCESS', $patron->id, "Valid password for $userid", $type );
1953     } elsif( !$passwd_ok && C4::Context->preference('AuthFailureLog') ) {
1954         logaction( 'AUTH', 'FAILURE', $patron ? $patron->id : 0, "Wrong password for $userid", $type );
1955     }
1956
1957     return @return;
1958 }
1959
1960 sub checkpw_internal {
1961     my ( $userid, $password, $no_set_userenv ) = @_;
1962
1963     $password = Encode::encode( 'UTF-8', $password )
1964       if Encode::is_utf8($password);
1965
1966     my $dbh = C4::Context->dbh;
1967     my $sth =
1968       $dbh->prepare(
1969         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1970       );
1971     $sth->execute($userid);
1972     if ( $sth->rows ) {
1973         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1974             $surname, $branchcode, $branchname, $flags )
1975           = $sth->fetchrow;
1976
1977         if ( checkpw_hash( $password, $stored_hash ) ) {
1978
1979             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1980                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1981             return 1, $cardnumber, $userid;
1982         }
1983     }
1984     $sth =
1985       $dbh->prepare(
1986         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1987       );
1988     $sth->execute($userid);
1989     if ( $sth->rows ) {
1990         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1991             $surname, $branchcode, $branchname, $flags )
1992           = $sth->fetchrow;
1993
1994         if ( checkpw_hash( $password, $stored_hash ) ) {
1995
1996             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1997                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1998             return 1, $cardnumber, $userid;
1999         }
2000     }
2001     return 0;
2002 }
2003
2004 sub checkpw_hash {
2005     my ( $password, $stored_hash ) = @_;
2006
2007     return if $stored_hash eq '!';
2008
2009     # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
2010     my $hash;
2011     if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
2012         $hash = hash_password( $password, $stored_hash );
2013     } else {
2014         $hash = md5_base64($password);
2015     }
2016     return $hash eq $stored_hash;
2017 }
2018
2019 =head2 getuserflags
2020
2021     my $authflags = getuserflags($flags, $userid, [$dbh]);
2022
2023 Translates integer flags into permissions strings hash.
2024
2025 C<$flags> is the integer userflags value ( borrowers.userflags )
2026 C<$userid> is the members.userid, used for building subpermissions
2027 C<$authflags> is a hashref of permissions
2028
2029 =cut
2030
2031 sub getuserflags {
2032     my $flags  = shift;
2033     my $userid = shift;
2034     my $dbh    = @_ ? shift : C4::Context->dbh;
2035     my $userflags;
2036     {
2037         # I don't want to do this, but if someone logs in as the database
2038         # user, it would be preferable not to spam them to death with
2039         # numeric warnings. So, we make $flags numeric.
2040         no warnings 'numeric';
2041         $flags += 0;
2042     }
2043     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
2044     $sth->execute;
2045
2046     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
2047         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
2048             $userflags->{$flag} = 1;
2049         }
2050         else {
2051             $userflags->{$flag} = 0;
2052         }
2053     }
2054
2055     # get subpermissions and merge with top-level permissions
2056     my $user_subperms = get_user_subpermissions($userid);
2057     foreach my $module ( keys %$user_subperms ) {
2058         next if $userflags->{$module} == 1;    # user already has permission for everything in this module
2059         $userflags->{$module} = $user_subperms->{$module};
2060     }
2061
2062     return $userflags;
2063 }
2064
2065 =head2 get_user_subpermissions
2066
2067   $user_perm_hashref = get_user_subpermissions($userid);
2068
2069 Given the userid (note, not the borrowernumber) of a staff user,
2070 return a hashref of hashrefs of the specific subpermissions
2071 accorded to the user.  An example return is
2072
2073  {
2074     tools => {
2075         export_catalog => 1,
2076         import_patrons => 1,
2077     }
2078  }
2079
2080 The top-level hash-key is a module or function code from
2081 userflags.flag, while the second-level key is a code
2082 from permissions.
2083
2084 The results of this function do not give a complete picture
2085 of the functions that a staff user can access; it is also
2086 necessary to check borrowers.flags.
2087
2088 =cut
2089
2090 sub get_user_subpermissions {
2091     my $userid = shift;
2092
2093     my $dbh = C4::Context->dbh;
2094     my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2095                              FROM user_permissions
2096                              JOIN permissions USING (module_bit, code)
2097                              JOIN userflags ON (module_bit = bit)
2098                              JOIN borrowers USING (borrowernumber)
2099                              WHERE userid = ?" );
2100     $sth->execute($userid);
2101
2102     my $user_perms = {};
2103     while ( my $perm = $sth->fetchrow_hashref ) {
2104         $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2105     }
2106     return $user_perms;
2107 }
2108
2109 =head2 get_all_subpermissions
2110
2111   my $perm_hashref = get_all_subpermissions();
2112
2113 Returns a hashref of hashrefs defining all specific
2114 permissions currently defined.  The return value
2115 has the same structure as that of C<get_user_subpermissions>,
2116 except that the innermost hash value is the description
2117 of the subpermission.
2118
2119 =cut
2120
2121 sub get_all_subpermissions {
2122     my $dbh = C4::Context->dbh;
2123     my $sth = $dbh->prepare( "SELECT flag, code
2124                              FROM permissions
2125                              JOIN userflags ON (module_bit = bit)" );
2126     $sth->execute();
2127
2128     my $all_perms = {};
2129     while ( my $perm = $sth->fetchrow_hashref ) {
2130         $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2131     }
2132     return $all_perms;
2133 }
2134
2135 =head2 haspermission
2136
2137   $flagsrequired = '*';                                 # Any permission at all
2138   $flagsrequired = 'a_flag';                            # a_flag must be satisfied (all subpermissions)
2139   $flagsrequired = [ 'a_flag', 'b_flag' ];              # a_flag OR b_flag must be satisfied
2140   $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 };     # a_flag AND b_flag must be satisfied
2141   $flagsrequired = { 'a_flag' => 'sub_a' };             # sub_a of a_flag must be satisfied
2142   $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2143
2144   $flags = ($userid, $flagsrequired);
2145
2146 C<$userid> the userid of the member
2147 C<$flags> is a query structure similar to that used by SQL::Abstract that
2148 denotes the combination of flags required. It is a required parameter.
2149
2150 The main logic of this method is that things in arrays are OR'ed, and things
2151 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2152
2153 Returns member's flags or 0 if a permission is not met.
2154
2155 =cut
2156
2157 sub _dispatch {
2158     my ($required, $flags) = @_;
2159
2160     my $ref = ref($required);
2161     if ($ref eq '') {
2162         if ($required eq '*') {
2163             return 0 unless ( $flags or ref( $flags ) );
2164         } else {
2165             return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2166         }
2167     } elsif ($ref eq 'HASH') {
2168         foreach my $key (keys %{$required}) {
2169             next if $flags == 1;
2170             my $require = $required->{$key};
2171             my $rflags  = $flags->{$key};
2172             return 0 unless _dispatch($require, $rflags);
2173         }
2174     } elsif ($ref eq 'ARRAY') {
2175         my $satisfied = 0;
2176         foreach my $require ( @{$required} ) {
2177             my $rflags =
2178               ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2179               ? $flags->{$require}
2180               : $flags;
2181             $satisfied++ if _dispatch( $require, $rflags );
2182         }
2183         return 0 unless $satisfied;
2184     } else {
2185         croak "Unexpected structure found: $ref";
2186     }
2187
2188     return $flags;
2189 };
2190
2191 sub haspermission {
2192     my ( $userid, $flagsrequired ) = @_;
2193
2194     #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2195     #  unless defined($flagsrequired);
2196
2197     my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2198     $sth->execute($userid);
2199     my $row = $sth->fetchrow();
2200     my $flags = getuserflags( $row, $userid );
2201
2202     return $flags unless defined($flagsrequired);
2203     return $flags if $flags->{superlibrarian};
2204     return _dispatch($flagsrequired, $flags);
2205
2206     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2207 }
2208
2209 =head2 in_iprange
2210
2211   $flags = ($iprange);
2212
2213 C<$iprange> A space separated string describing an IP range. Can include single IPs or ranges
2214
2215 Returns 1 if the remote address is in the provided iprange, or 0 otherwise.
2216
2217 =cut
2218
2219 sub in_iprange {
2220     my ($iprange) = @_;
2221     my $result = 1;
2222     my @allowedipranges = $iprange ? split(' ', $iprange) : ();
2223     if (scalar @allowedipranges > 0) {
2224         my @rangelist;
2225         eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2226         eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || Koha::Logger->get->warn('cidrlookup failed for ' . join(' ',@rangelist) );
2227      }
2228      return $result ? 1 : 0;
2229 }
2230
2231 sub getborrowernumber {
2232     my ($userid) = @_;
2233     my $userenv = C4::Context->userenv;
2234     if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2235         return $userenv->{number};
2236     }
2237     my $dbh = C4::Context->dbh;
2238     for my $field ( 'userid', 'cardnumber' ) {
2239         my $sth =
2240           $dbh->prepare("select borrowernumber from borrowers where $field=?");
2241         $sth->execute($userid);
2242         if ( $sth->rows ) {
2243             my ($bnumber) = $sth->fetchrow;
2244             return $bnumber;
2245         }
2246     }
2247     return 0;
2248 }
2249
2250 =head2 track_login_daily
2251
2252     track_login_daily( $userid );
2253
2254 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2255
2256 =cut
2257
2258 sub track_login_daily {
2259     my $userid = shift;
2260     return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2261
2262     my $cache     = Koha::Caches->get_instance();
2263     my $cache_key = "track_login_" . $userid;
2264     my $cached    = $cache->get_from_cache($cache_key);
2265     my $today = dt_from_string()->ymd;
2266     return if $cached && $cached eq $today;
2267
2268     my $patron = Koha::Patrons->find({ userid => $userid });
2269     return unless $patron;
2270     $patron->track_login;
2271     $cache->set_in_cache( $cache_key, $today );
2272 }
2273
2274 END { }    # module clean-up code here (global destructor)
2275 1;
2276 __END__
2277
2278 =head1 SEE ALSO
2279
2280 CGI(3)
2281
2282 C4::Output(3)
2283
2284 Crypt::Eksblowfish::Bcrypt(3)
2285
2286 Digest::MD5(3)
2287
2288 =cut