C4/Auth.pm

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