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