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