C4/Auth.pm

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