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