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