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