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