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