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         # NOTE: $flags in the following call is still undefined !
 883         ( $return, $session, $more_info ) = check_cookie_auth( $sessionID, $flags,
 884             { remote_addr => $ENV{REMOTE_ADDR}, skip_version_check => 1 }
 885         );
 886
 887         if ( $return eq 'ok' ) {
 888             Koha::Logger->get->debug(sprintf "AUTH_SESSION: (%s)\t%s %s - %s", map { $session->param($_) || q{} } qw(cardnumber firstname surname branch));
 889
 890             my $s_userid = $session->param('id');
 891             $userid      = $s_userid;
 892
 893             if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
 894                 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
 895                 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
 896             ) {
 897
 898                 #if a user enters an id ne to the id in the current session, we need to log them in...
 899                 #first we need to clear the anonymous session...
 900                 $anon_search_history = $session->param('search_history');
 901                 $session->delete();
 902                 $session->flush;
 903                 C4::Context::_unset_userenv($sessionID);
 904                 $sessionID = undef;
 905             }
 906             elsif ($logout) {
 907
 908                 # voluntary logout the user
 909                 # check wether the user was using their shibboleth session or a local one
 910                 my $shibSuccess = C4::Context->userenv->{'shibboleth'};
 911                 $session->delete();
 912                 $session->flush;
 913                 C4::Context::_unset_userenv($sessionID);
 914                 $sessionID = undef;
 915
 916                 if ($cas and $caslogout) {
 917                     logout_cas($query, $type);
 918                 }
 919
 920                 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
 921                 if ( $shib and $shib_login and $shibSuccess) {
 922                     logout_shib($query);
 923                 }
 924             } else {
 925
 926                 $cookie = $query->cookie(
 927                     -name     => 'CGISESSID',
 928                     -value    => $session->id,
 929                     -HttpOnly => 1,
 930                     -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
 931                 );
 932
 933                 $flags = haspermission( $userid, $flagsrequired );
 934                 if ($flags) {
 935                     $loggedin = 1;
 936                 } else {
 937                     $info{'nopermission'} = 1;
 938                 }
 939             }
 940         } elsif ( !$logout ) {
 941             if ( $return eq 'expired' ) {
 942                 $info{timed_out} = 1;
 943             } elsif ( $return eq 'restricted' ) {
 944                 $info{oldip}        = $more_info->{old_ip};
 945                 $info{newip}        = $more_info->{new_ip};
 946                 $info{different_ip} = 1;
 947             }
 948         }
 949     }
 950
 951     unless ( $loggedin ) {
 952         $userid    = undef;
 953     }
 954
 955     unless ( $userid ) {
 956         #we initiate a session prior to checking for a username to allow for anonymous sessions...
 957         $session ||= get_session("") or die "Auth ERROR: Cannot get_session()";
 958
 959         # Save anonymous search history in new session so it can be retrieved
 960         # by get_template_and_user to store it in user's search history after
 961         # a successful login.
 962         if ($anon_search_history) {
 963             $session->param( 'search_history', $anon_search_history );
 964         }
 965
 966         $sessionID = $session->id;
 967         C4::Context->_new_userenv($sessionID);
 968         $cookie = $query->cookie(
 969             -name     => 'CGISESSID',
 970             -value    => $sessionID,
 971             -HttpOnly => 1,
 972             -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
 973         );
 974         my $pki_field = C4::Context->preference('AllowPKIAuth');
 975         if ( !defined($pki_field) ) {
 976             print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
 977             $pki_field = 'None';
 978         }
 979         if ( ( $cas && $query->param('ticket') )
 980             || $q_userid
 981             || ( $shib && $shib_login )
 982             || $pki_field ne 'None'
 983             || $emailaddress )
 984         {
 985             my $password    = $query->param('password');
 986             my $shibSuccess = 0;
 987             my ( $return, $cardnumber );
 988
 989             # If shib is enabled and we have a shib login, does the login match a valid koha user
 990             if ( $shib && $shib_login ) {
 991                 my $retuserid;
 992
 993                 # Do not pass password here, else shib will not be checked in checkpw.
 994                 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $q_userid, undef, $query );
 995                 $userid      = $retuserid;
 996                 $shibSuccess = $return;
 997                 $info{'invalidShibLogin'} = 1 unless ($return);
 998             }
 999
1000             # If shib login and match were successful, skip further login methods
1001             unless ($shibSuccess) {
1002                 if ( $cas && $query->param('ticket') ) {
1003                     my $retuserid;
1004                     ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1005                       checkpw( $dbh, $userid, $password, $query, $type );
1006                     $userid = $retuserid;
1007                     $info{'invalidCasLogin'} = 1 unless ($return);
1008                 }
1009
1010                 elsif ( $emailaddress ) {
1011                     my $value = $emailaddress;
1012
1013                     # If we're looking up the email, there's a chance that the person
1014                     # doesn't have a userid. So if there is none, we pass along the
1015                     # borrower number, and the bits of code that need to know the user
1016                     # ID will have to be smart enough to handle that.
1017                     my $patrons = Koha::Patrons->search({ email => $value });
1018                     if ($patrons->count) {
1019
1020                         # First the userid, then the borrowernum
1021                         my $patron = $patrons->next;
1022                         $value = $patron->userid || $patron->borrowernumber;
1023                     } else {
1024                         undef $value;
1025                     }
1026                     $return = $value ? 1 : 0;
1027                     $userid = $value;
1028                 }
1029
1030                 elsif (
1031                     ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1032                     || ( $pki_field eq 'emailAddress'
1033                         && $ENV{'SSL_CLIENT_S_DN_Email'} )
1034                   )
1035                 {
1036                     my $value;
1037                     if ( $pki_field eq 'Common Name' ) {
1038                         $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1039                     }
1040                     elsif ( $pki_field eq 'emailAddress' ) {
1041                         $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1042
1043                         # If we're looking up the email, there's a chance that the person
1044                         # doesn't have a userid. So if there is none, we pass along the
1045                         # borrower number, and the bits of code that need to know the user
1046                         # ID will have to be smart enough to handle that.
1047                         my $patrons = Koha::Patrons->search({ email => $value });
1048                         if ($patrons->count) {
1049
1050                             # First the userid, then the borrowernum
1051                             my $patron = $patrons->next;
1052                             $value = $patron->userid || $patron->borrowernumber;
1053                         } else {
1054                             undef $value;
1055                         }
1056                     }
1057
1058                     $return = $value ? 1 : 0;
1059                     $userid = $value;
1060
1061                 }
1062                 else {
1063                     my $retuserid;
1064                     my $request_method = $query->request_method();
1065
1066                     if (
1067                         $request_method eq 'POST'
1068                         || ( C4::Context->preference('AutoSelfCheckID')
1069                             && $q_userid eq C4::Context->preference('AutoSelfCheckID') )
1070                       )
1071                     {
1072
1073                         ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1074                           checkpw( $dbh, $q_userid, $password, $query, $type );
1075                         $userid = $retuserid if ($retuserid);
1076                         $info{'invalid_username_or_password'} = 1 unless ($return);
1077                     }
1078                 }
1079             }
1080
1081             # If shib configured and shibOnly enabled, we should ignore anything other than a shibboleth type login.
1082             if (
1083                    $shib
1084                 && !$shibSuccess
1085                 && (
1086                     (
1087                         ( $type eq 'opac' )
1088                         && C4::Context->preference('OPACShibOnly')
1089                     )
1090                     || ( ( $type ne 'opac' )
1091                         && C4::Context->preference('staffShibOnly') )
1092                 )
1093               )
1094             {
1095                 $return = 0;
1096             }
1097
1098             # $return: 1 = valid user
1099             if ($return) {
1100
1101                 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1102                     $loggedin = 1;
1103                 }
1104                 else {
1105                     $info{'nopermission'} = 1;
1106                     C4::Context::_unset_userenv($sessionID);
1107                 }
1108                 my ( $borrowernumber, $firstname, $surname, $userflags,
1109                     $branchcode, $branchname, $emailaddress, $desk_id,
1110                     $desk_name, $register_id, $register_name );
1111
1112                 if ( $return == 1 ) {
1113                     my $select = "
1114                     SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1115                     branches.branchname    as branchname, email
1116                     FROM borrowers
1117                     LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1118                     ";
1119                     my $sth = $dbh->prepare("$select where userid=?");
1120                     $sth->execute($userid);
1121                     unless ( $sth->rows ) {
1122                         $sth = $dbh->prepare("$select where cardnumber=?");
1123                         $sth->execute($cardnumber);
1124
1125                         unless ( $sth->rows ) {
1126                             $sth->execute($userid);
1127                         }
1128                     }
1129                     if ( $sth->rows ) {
1130                         ( $borrowernumber, $firstname, $surname, $userflags,
1131                             $branchcode, $branchname, $emailaddress ) = $sth->fetchrow;
1132                     }
1133
1134                     # launch a sequence to check if we have a ip for the branch, i
1135                     # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1136
1137                     my $ip = $ENV{'REMOTE_ADDR'};
1138
1139                     # if they specify at login, use that
1140                     if ( $query->param('branch') ) {
1141                         $branchcode = $query->param('branch');
1142                         my $library = Koha::Libraries->find($branchcode);
1143                         $branchname = $library? $library->branchname: '';
1144                     }
1145                     if ( $query->param('desk_id') ) {
1146                         $desk_id = $query->param('desk_id');
1147                         my $desk = Koha::Desks->find($desk_id);
1148                         $desk_name = $desk ? $desk->desk_name : '';
1149                     }
1150                     if ( C4::Context->preference('UseCashRegisters') ) {
1151                         my $register =
1152                           $query->param('register_id')
1153                           ? Koha::Cash::Registers->find($query->param('register_id'))
1154                           : Koha::Cash::Registers->search(
1155                             { branch => $branchcode, branch_default => 1 },
1156                             { rows   => 1 } )->single;
1157                         $register_id   = $register->id   if ($register);
1158                         $register_name = $register->name if ($register);
1159                     }
1160                     my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1161                     if ( $type ne 'opac' and C4::Context->preference('AutoLocation') ) {
1162
1163                         # we have to check they are coming from the right ip range
1164                         my $domain = $branches->{$branchcode}->{'branchip'};
1165                         $domain =~ s|\.\*||g;
1166                         if ( $ip !~ /^$domain/ ) {
1167                             $loggedin = 0;
1168                             $cookie = $query->cookie(
1169                                 -name     => 'CGISESSID',
1170                                 -value    => '',
1171                                 -HttpOnly => 1,
1172                                 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1173                             );
1174                             $info{'wrongip'} = 1;
1175                         }
1176                     }
1177
1178                     foreach my $br ( keys %$branches ) {
1179
1180                         #     now we work with the treatment of ip
1181                         my $domain = $branches->{$br}->{'branchip'};
1182                         if ( $domain && $ip =~ /^$domain/ ) {
1183                             $branchcode = $branches->{$br}->{'branchcode'};
1184
1185                             # new op dev : add the branchname to the cookie
1186                             $branchname    = $branches->{$br}->{'branchname'};
1187                         }
1188                     }
1189
1190                     my $is_sco_user = 0;
1191                     if ( $query->param('sco_user_login') && ( $query->param('sco_user_login') eq '1' ) ){
1192                         $is_sco_user = 1;
1193                     }
1194
1195                     $session->param( 'number',       $borrowernumber );
1196                     $session->param( 'id',           $userid );
1197                     $session->param( 'cardnumber',   $cardnumber );
1198                     $session->param( 'firstname',    $firstname );
1199                     $session->param( 'surname',      $surname );
1200                     $session->param( 'branch',       $branchcode );
1201                     $session->param( 'branchname',   $branchname );
1202                     $session->param( 'desk_id',      $desk_id);
1203                     $session->param( 'desk_name',     $desk_name);
1204                     $session->param( 'flags',        $userflags );
1205                     $session->param( 'emailaddress', $emailaddress );
1206                     $session->param( 'ip',           $session->remote_addr() );
1207                     $session->param( 'lasttime',     time() );
1208                     $session->param( 'interface',    $type);
1209                     $session->param( 'shibboleth',   $shibSuccess );
1210                     $session->param( 'register_id',  $register_id );
1211                     $session->param( 'register_name',  $register_name );
1212                     $session->param( 'sco_user', $is_sco_user );
1213                 }
1214                 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1215                 C4::Context->set_userenv(
1216                     $session->param('number'),       $session->param('id'),
1217                     $session->param('cardnumber'),   $session->param('firstname'),
1218                     $session->param('surname'),      $session->param('branch'),
1219                     $session->param('branchname'),   $session->param('flags'),
1220                     $session->param('emailaddress'), $session->param('shibboleth'),
1221                     $session->param('desk_id'),      $session->param('desk_name'),
1222                     $session->param('register_id'),  $session->param('register_name')
1223                 );
1224
1225             }
1226             # $return: 0 = invalid user
1227             # reset to anonymous session
1228             else {
1229                 if ($userid) {
1230                     $info{'invalid_username_or_password'} = 1;
1231                     C4::Context::_unset_userenv($sessionID);
1232                 }
1233                 $session->param( 'lasttime', time() );
1234                 $session->param( 'ip',       $session->remote_addr() );
1235                 $session->param( 'sessiontype', 'anon' );
1236                 $session->param( 'interface', $type);
1237             }
1238         }    # END if ( $q_userid
1239         elsif ( $type eq "opac" ) {
1240
1241             # anonymous sessions are created only for the OPAC
1242
1243             # setting a couple of other session vars...
1244             $session->param( 'ip',          $session->remote_addr() );
1245             $session->param( 'lasttime',    time() );
1246             $session->param( 'sessiontype', 'anon' );
1247             $session->param( 'interface', $type);
1248         }
1249         $session->flush;
1250     }    # END unless ($userid)
1251
1252     # finished authentification, now respond
1253     if ( $loggedin || $authnotrequired )
1254     {
1255         # successful login
1256         unless ($cookie) {
1257             $cookie = $query->cookie(
1258                 -name     => 'CGISESSID',
1259                 -value    => '',
1260                 -HttpOnly => 1,
1261                 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1262             );
1263         }
1264
1265         track_login_daily( $userid );
1266
1267         # In case, that this request was a login attempt, we want to prevent that users can repost the opac login
1268         # request. We therefore redirect the user to the requested page again without the login parameters.
1269         # See Post/Redirect/Get (PRG) design pattern: https://en.wikipedia.org/wiki/Post/Redirect/Get
1270         if ( $type eq "opac" && $query->param('koha_login_context') && $query->param('koha_login_context') ne 'sco' && $query->param('password') && $query->param('userid') ) {
1271             my $uri = URI->new($query->url(-relative=>1, -query_string=>1));
1272             $uri->query_param_delete('userid');
1273             $uri->query_param_delete('password');
1274             $uri->query_param_delete('koha_login_context');
1275             print $query->redirect(-uri => $uri->as_string, -cookie => $cookie, -status=>'303 See other');
1276             exit;
1277         }
1278
1279         return ( $userid, $cookie, $sessionID, $flags );
1280     }
1281
1282     #
1283     #
1284     # AUTH rejected, show the login/password template, after checking the DB.
1285     #
1286     #
1287
1288     # get the inputs from the incoming query
1289     my @inputs = ();
1290     foreach my $name ( param $query) {
1291         (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1292         my @value = $query->multi_param($name);
1293         push @inputs, { name => $name, value => $_ } for @value;
1294     }
1295
1296     my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1297
1298     my $LibraryNameTitle = C4::Context->preference("LibraryName");
1299     $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1300     $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1301
1302     my $auth_template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1303     my $template = C4::Templates::gettemplate( $auth_template_name, $type, $query );
1304     $template->param(
1305         login                                 => 1,
1306         INPUTS                                => \@inputs,
1307         script_name                           => get_script_name(),
1308         casAuthentication                     => C4::Context->preference("casAuthentication"),
1309         shibbolethAuthentication              => $shib,
1310         suggestion                            => C4::Context->preference("suggestion"),
1311         virtualshelves                        => C4::Context->preference("virtualshelves"),
1312         LibraryName                           => "" . C4::Context->preference("LibraryName"),
1313         LibraryNameTitle                      => "" . $LibraryNameTitle,
1314         opacuserlogin                         => C4::Context->preference("opacuserlogin"),
1315         OpacFavicon                           => C4::Context->preference("OpacFavicon"),
1316         opacreadinghistory                    => C4::Context->preference("opacreadinghistory"),
1317         opaclanguagesdisplay                  => C4::Context->preference("opaclanguagesdisplay"),
1318         OPACUserJS                            => C4::Context->preference("OPACUserJS"),
1319         opacbookbag                           => "" . C4::Context->preference("opacbookbag"),
1320         OpacCloud                             => C4::Context->preference("OpacCloud"),
1321         OpacTopissue                          => C4::Context->preference("OpacTopissue"),
1322         OpacAuthorities                       => C4::Context->preference("OpacAuthorities"),
1323         OpacBrowser                           => C4::Context->preference("OpacBrowser"),
1324         TagsEnabled                           => C4::Context->preference("TagsEnabled"),
1325         OPACUserCSS                           => C4::Context->preference("OPACUserCSS"),
1326         intranetcolorstylesheet               => C4::Context->preference("intranetcolorstylesheet"),
1327         intranetstylesheet                    => C4::Context->preference("intranetstylesheet"),
1328         IntranetNav                           => C4::Context->preference("IntranetNav"),
1329         IntranetFavicon                       => C4::Context->preference("IntranetFavicon"),
1330         IntranetUserCSS                       => C4::Context->preference("IntranetUserCSS"),
1331         IntranetUserJS                        => C4::Context->preference("IntranetUserJS"),
1332         IndependentBranches                   => C4::Context->preference("IndependentBranches"),
1333         AutoLocation                          => C4::Context->preference("AutoLocation"),
1334         wrongip                               => $info{'wrongip'},
1335         PatronSelfRegistration                => C4::Context->preference("PatronSelfRegistration"),
1336         PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1337         opac_css_override                     => $ENV{'OPAC_CSS_OVERRIDE'},
1338         too_many_login_attempts               => ( $patron and $patron->account_locked )
1339     );
1340
1341     $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1342     $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1343     $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1344     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1345
1346     if ( $type eq 'opac' ) {
1347         require Koha::Virtualshelves;
1348         my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1349             {
1350                 public => 1,
1351             }
1352         );
1353         $template->param(
1354             some_public_shelves  => $some_public_shelves,
1355         );
1356     }
1357
1358     if ($cas) {
1359
1360         # Is authentication against multiple CAS servers enabled?
1361         require C4::Auth_with_cas;
1362         if ( multipleAuth() && !$casparam ) {
1363             my $casservers = getMultipleAuth();
1364             my @tmplservers;
1365             foreach my $key ( keys %$casservers ) {
1366                 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1367             }
1368             $template->param(
1369                 casServersLoop => \@tmplservers
1370             );
1371         } else {
1372             $template->param(
1373                 casServerUrl => login_cas_url($query, undef, $type),
1374             );
1375         }
1376
1377         $template->param(
1378             invalidCasLogin => $info{'invalidCasLogin'}
1379         );
1380     }
1381
1382     if ($shib) {
1383         #If shibOnly is enabled just go ahead and redirect directly
1384         if ( (($type eq 'opac') && C4::Context->preference('OPACShibOnly')) || (($type ne 'opac') && C4::Context->preference('staffShibOnly')) ) {
1385             my $redirect_url = login_shib_url( $query );
1386             print $query->redirect( -uri => "$redirect_url", -status => 303 );
1387             safe_exit;
1388         }
1389
1390         $template->param(
1391             shibbolethAuthentication => $shib,
1392             shibbolethLoginUrl       => login_shib_url($query),
1393         );
1394     }
1395
1396     if (C4::Context->preference('GoogleOpenIDConnect')) {
1397         if ($query->param("OpenIDConnectFailed")) {
1398             my $reason = $query->param('OpenIDConnectFailed');
1399             $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1400         }
1401     }
1402
1403     $template->param(
1404         LibraryName => C4::Context->preference("LibraryName"),
1405     );
1406     $template->param(%info);
1407
1408     #    $cookie = $query->cookie(CGISESSID => $session->id
1409     #   );
1410     print $query->header(
1411         {   type              => 'text/html',
1412             charset           => 'utf-8',
1413             cookie            => $cookie,
1414             'X-Frame-Options' => 'SAMEORIGIN'
1415         }
1416       ),
1417       $template->output;
1418     safe_exit;
1419 }
1420
1421 =head2 check_api_auth
1422
1423   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1424
1425 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1426 cookie, determine if the user has the privileges specified by C<$userflags>.
1427
1428 C<check_api_auth> is is meant for authenticating users of web services, and
1429 consequently will always return and will not attempt to redirect the user
1430 agent.
1431
1432 If a valid session cookie is already present, check_api_auth will return a status
1433 of "ok", the cookie, and the Koha session ID.
1434
1435 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1436 parameters and create a session cookie and Koha session if the supplied credentials
1437 are OK.
1438
1439 Possible return values in C<$status> are:
1440
1441 =over
1442
1443 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1444
1445 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1446
1447 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1448
1449 =item "expired -- session cookie has expired; API user should resubmit userid and password
1450
1451 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1452
1453 =back
1454
1455 =cut
1456
1457 sub check_api_auth {
1458
1459     my $query         = shift;
1460     my $flagsrequired = shift;
1461     my $dbh     = C4::Context->dbh;
1462     my $timeout = _timeout_syspref();
1463
1464     unless ( C4::Context->preference('Version') ) {
1465
1466         # database has not been installed yet
1467         return ( "maintenance", undef, undef );
1468     }
1469     my $kohaversion = Koha::version();
1470     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1471     if ( C4::Context->preference('Version') < $kohaversion ) {
1472
1473         # database in need of version update; assume that
1474         # no API should be called while databsae is in
1475         # this condition.
1476         return ( "maintenance", undef, undef );
1477     }
1478
1479     my ( $sessionID, $session );
1480     unless ( $query->param('userid') ) {
1481         $sessionID = $query->cookie("CGISESSID");
1482     }
1483     if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1484
1485         my $return;
1486         ( $return, $session, undef ) = check_cookie_auth(
1487             $sessionID, $flagsrequired, { remote_addr => $ENV{REMOTE_ADDR} } );
1488
1489         return ( $return, undef, undef ) # Cookie auth failed
1490             if $return ne "ok";
1491
1492         my $cookie = $query->cookie(
1493             -name     => 'CGISESSID',
1494             -value    => $session->id,
1495             -HttpOnly => 1,
1496             -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1497         );
1498         return ( $return, undef, $session );
1499
1500     } else {
1501
1502         # new login
1503         my $userid   = $query->param('userid');
1504         my $password = $query->param('password');
1505         my ( $return, $cardnumber, $cas_ticket );
1506
1507         # Proxy CAS auth
1508         if ( $cas && $query->param('PT') ) {
1509             my $retuserid;
1510
1511             # In case of a CAS authentication, we use the ticket instead of the password
1512             my $PT = $query->param('PT');
1513             ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $dbh, $PT, $query );    # EXTERNAL AUTH
1514         } else {
1515
1516             # User / password auth
1517             unless ( $userid and $password ) {
1518
1519                 # caller did something wrong, fail the authenticateion
1520                 return ( "failed", undef, undef );
1521             }
1522             my $newuserid;
1523             ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $dbh, $userid, $password, $query );
1524         }
1525
1526         if ( $return and haspermission( $userid, $flagsrequired ) ) {
1527             my $session = get_session("");
1528             return ( "failed", undef, undef ) unless $session;
1529
1530             my $sessionID = $session->id;
1531             C4::Context->_new_userenv($sessionID);
1532             my $cookie = $query->cookie(
1533                 -name     => 'CGISESSID',
1534                 -value    => $sessionID,
1535                 -HttpOnly => 1,
1536                 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1537             );
1538             if ( $return == 1 ) {
1539                 my (
1540                     $borrowernumber, $firstname,  $surname,
1541                     $userflags,      $branchcode, $branchname,
1542                     $emailaddress
1543                 );
1544                 my $sth =
1545                   $dbh->prepare(
1546 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1547                   );
1548                 $sth->execute($userid);
1549                 (
1550                     $borrowernumber, $firstname,  $surname,
1551                     $userflags,      $branchcode, $branchname,
1552                     $emailaddress
1553                 ) = $sth->fetchrow if ( $sth->rows );
1554
1555                 unless ( $sth->rows ) {
1556                     my $sth = $dbh->prepare(
1557 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1558                     );
1559                     $sth->execute($cardnumber);
1560                     (
1561                         $borrowernumber, $firstname,  $surname,
1562                         $userflags,      $branchcode, $branchname,
1563                         $emailaddress
1564                     ) = $sth->fetchrow if ( $sth->rows );
1565
1566                     unless ( $sth->rows ) {
1567                         $sth->execute($userid);
1568                         (
1569                             $borrowernumber, $firstname,  $surname,       $userflags,
1570                             $branchcode,     $branchname, $emailaddress
1571                         ) = $sth->fetchrow if ( $sth->rows );
1572                     }
1573                 }
1574
1575                 my $ip = $ENV{'REMOTE_ADDR'};
1576
1577                 # if they specify at login, use that
1578                 if ( $query->param('branch') ) {
1579                     $branchcode = $query->param('branch');
1580                     my $library = Koha::Libraries->find($branchcode);
1581                     $branchname = $library? $library->branchname: '';
1582                 }
1583                 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1584                 foreach my $br ( keys %$branches ) {
1585
1586                     #     now we work with the treatment of ip
1587                     my $domain = $branches->{$br}->{'branchip'};
1588                     if ( $domain && $ip =~ /^$domain/ ) {
1589                         $branchcode = $branches->{$br}->{'branchcode'};
1590
1591                         # new op dev : add the branchname to the cookie
1592                         $branchname    = $branches->{$br}->{'branchname'};
1593                     }
1594                 }
1595                 $session->param( 'number',       $borrowernumber );
1596                 $session->param( 'id',           $userid );
1597                 $session->param( 'cardnumber',   $cardnumber );
1598                 $session->param( 'firstname',    $firstname );
1599                 $session->param( 'surname',      $surname );
1600                 $session->param( 'branch',       $branchcode );
1601                 $session->param( 'branchname',   $branchname );
1602                 $session->param( 'flags',        $userflags );
1603                 $session->param( 'emailaddress', $emailaddress );
1604                 $session->param( 'ip',           $session->remote_addr() );
1605                 $session->param( 'lasttime',     time() );
1606                 $session->param( 'interface',    'api'  );
1607             }
1608             $session->param( 'cas_ticket', $cas_ticket);
1609             C4::Context->set_userenv(
1610                 $session->param('number'),       $session->param('id'),
1611                 $session->param('cardnumber'),   $session->param('firstname'),
1612                 $session->param('surname'),      $session->param('branch'),
1613                 $session->param('branchname'),   $session->param('flags'),
1614                 $session->param('emailaddress'), $session->param('shibboleth'),
1615                 $session->param('desk_id'),      $session->param('desk_name'),
1616                 $session->param('register_id'),  $session->param('register_name')
1617             );
1618             return ( "ok", $cookie, $sessionID );
1619         } else {
1620             return ( "failed", undef, undef );
1621         }
1622     }
1623 }
1624
1625 =head2 check_cookie_auth
1626
1627   ($status, $sessionId) = check_cookie_auth($cookie, $userflags);
1628
1629 Given a CGISESSID cookie set during a previous login to Koha, determine
1630 if the user has the privileges specified by C<$userflags>. C<$userflags>
1631 is passed unaltered into C<haspermission> and as such accepts all options
1632 avaiable to that routine with the one caveat that C<check_api_auth> will
1633 also allow 'undef' to be passed and in such a case the permissions check
1634 will be skipped altogether.
1635
1636 C<check_cookie_auth> is meant for authenticating special services
1637 such as tools/upload-file.pl that are invoked by other pages that
1638 have been authenticated in the usual way.
1639
1640 Possible return values in C<$status> are:
1641
1642 =over
1643
1644 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1645
1646 =item "anon" -- user not authenticated but valid for anonymous session.
1647
1648 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1649
1650 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1651
1652 =item "expired -- session cookie has expired; API user should resubmit userid and password
1653
1654 =item "restricted" -- The IP has changed (if SessionRestrictionByIP)
1655
1656 =back
1657
1658 =cut
1659
1660 sub check_cookie_auth {
1661     my $sessionID     = shift;
1662     my $flagsrequired = shift;
1663     my $params        = shift;
1664
1665     my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1666
1667     my $skip_version_check = $params->{skip_version_check}; # Only for checkauth
1668
1669     unless ( $skip_version_check ) {
1670         unless ( C4::Context->preference('Version') ) {
1671
1672             # database has not been installed yet
1673             return ( "maintenance", undef );
1674         }
1675         my $kohaversion = Koha::version();
1676         $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1677         if ( C4::Context->preference('Version') < $kohaversion ) {
1678
1679             # database in need of version update; assume that
1680             # no API should be called while databsae is in
1681             # this condition.
1682             return ( "maintenance", undef );
1683         }
1684     }
1685
1686     # see if we have a valid session cookie already
1687     # however, if a userid parameter is present (i.e., from
1688     # a form submission, assume that any current cookie
1689     # is to be ignored
1690     unless ( $sessionID ) {
1691         return ( "failed", undef );
1692     }
1693     C4::Context::_unset_userenv($sessionID); # remove old userenv first
1694     my $session   = get_session($sessionID);
1695     if ($session) {
1696         my $userid   = $session->param('id');
1697         my $ip       = $session->param('ip');
1698         my $lasttime = $session->param('lasttime');
1699         my $timeout = _timeout_syspref();
1700
1701         if ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
1702             # time out
1703             $session->delete();
1704             $session->flush;
1705             return ("expired", undef);
1706
1707         } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1708             # IP address changed
1709             $session->delete();
1710             $session->flush;
1711             return ( "restricted", undef, { old_ip => $ip, new_ip => $remote_addr});
1712
1713         } elsif ( $userid ) {
1714             $session->param( 'lasttime', time() );
1715             my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1716             if ($flags) {
1717                 C4::Context->_new_userenv($sessionID);
1718                 C4::Context->interface($session->param('interface'));
1719                 C4::Context->set_userenv(
1720                     $session->param('number'),       $session->param('id') // '',
1721                     $session->param('cardnumber'),   $session->param('firstname'),
1722                     $session->param('surname'),      $session->param('branch'),
1723                     $session->param('branchname'),   $session->param('flags'),
1724                     $session->param('emailaddress'), $session->param('shibboleth'),
1725                     $session->param('desk_id'),      $session->param('desk_name'),
1726                     $session->param('register_id'),  $session->param('register_name')
1727                 );
1728                 return ( "ok", $session );
1729             } else {
1730                 $session->delete();
1731                 $session->flush;
1732                 return ( "failed", undef );
1733             }
1734
1735         } else {
1736             C4::Context->_new_userenv($sessionID);
1737             C4::Context->interface($session->param('interface'));
1738             C4::Context->set_userenv( undef, q{} );
1739             return ( "anon", $session );
1740         }
1741     } else {
1742         return ( "expired", undef );
1743     }
1744 }
1745
1746 =head2 get_session
1747
1748   use CGI::Session;
1749   my $session = get_session($sessionID);
1750
1751 Given a session ID, retrieve the CGI::Session object used to store
1752 the session's state.  The session object can be used to store
1753 data that needs to be accessed by different scripts during a
1754 user's session.
1755
1756 If the C<$sessionID> parameter is an empty string, a new session
1757 will be created.
1758
1759 =cut
1760
1761 sub _get_session_params {
1762     my $storage_method = C4::Context->preference('SessionStorage');
1763     if ( $storage_method eq 'mysql' ) {
1764         my $dbh = C4::Context->dbh;
1765         return { dsn => "serializer:yamlxs;driver:MySQL;id:md5", dsn_args => { Handle => $dbh } };
1766     }
1767     elsif ( $storage_method eq 'Pg' ) {
1768         my $dbh = C4::Context->dbh;
1769         return { dsn => "serializer:yamlxs;driver:PostgreSQL;id:md5", dsn_args => { Handle => $dbh } };
1770     }
1771     elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1772         my $memcached = Koha::Caches->get_instance()->memcached_cache;
1773         return { dsn => "serializer:yamlxs;driver:memcached;id:md5", dsn_args => { Memcached => $memcached } };
1774     }
1775     else {
1776         # catch all defaults to tmp should work on all systems
1777         my $dir = C4::Context::temporary_directory;
1778         my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1779         return { dsn => "serializer:yamlxs;driver:File;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1780     }
1781 }
1782
1783 sub get_session {
1784     my $sessionID      = shift;
1785     my $params = _get_session_params();
1786     my $session;
1787     if( $sessionID ) { # find existing
1788         CGI::Session::ErrorHandler->set_error( q{} ); # clear error, cpan issue #111463
1789         $session = CGI::Session->load( $params->{dsn}, $sessionID, $params->{dsn_args} );
1790     } else {
1791         $session = CGI::Session->new( $params->{dsn}, $sessionID, $params->{dsn_args} );
1792         # $session->flush;
1793     }
1794     return $session;
1795 }
1796
1797
1798 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1799 # (or something similar)
1800 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1801 # not having a userenv defined could cause a crash.
1802 sub checkpw {
1803     my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1804     $type = 'opac' unless $type;
1805
1806     # Get shibboleth login attribute
1807     my $shib = C4::Context->config('useshibboleth') && shib_ok();
1808     my $shib_login = $shib ? get_login_shib() : undef;
1809
1810     my @return;
1811     my $patron;
1812     if ( defined $userid ){
1813         $patron = Koha::Patrons->find({ userid => $userid });
1814         $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1815     }
1816     my $check_internal_as_fallback = 0;
1817     my $passwd_ok = 0;
1818     # Note: checkpw_* routines returns:
1819     # 1 if auth is ok
1820     # 0 if auth is nok
1821     # -1 if user bind failed (LDAP only)
1822
1823     if ( $patron and $patron->account_locked ) {
1824         # Nothing to check, account is locked
1825     } elsif ($ldap && defined($password)) {
1826         my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_);    # EXTERNAL AUTH
1827         if ( $retval == 1 ) {
1828             @return = ( $retval, $retcard, $retuserid );
1829             $passwd_ok = 1;
1830         }
1831         $check_internal_as_fallback = 1 if $retval == 0;
1832
1833     } elsif ( $cas && $query && $query->param('ticket') ) {
1834
1835         # In case of a CAS authentication, we use the ticket instead of the password
1836         my $ticket = $query->param('ticket');
1837         $query->delete('ticket');                                   # remove ticket to come back to original URL
1838         my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $dbh, $ticket, $query, $type );    # EXTERNAL AUTH
1839         if ( $retval ) {
1840             @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1841         } else {
1842             @return = (0);
1843         }
1844         $passwd_ok = $retval;
1845     }
1846
1847     # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1848     # Check for password to asertain whether we want to be testing against shibboleth or another method this
1849     # time around.
1850     elsif ( $shib && $shib_login && !$password ) {
1851
1852         # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1853         # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1854         # shibboleth-authenticated user
1855
1856         # Then, we check if it matches a valid koha user
1857         if ($shib_login) {
1858             my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login);    # EXTERNAL AUTH
1859             if ( $retval ) {
1860                 @return = ( $retval, $retcard, $retuserid );
1861             }
1862             $passwd_ok = $retval;
1863         }
1864     } else {
1865         $check_internal_as_fallback = 1;
1866     }
1867
1868     # INTERNAL AUTH
1869     if ( $check_internal_as_fallback ) {
1870         @return = checkpw_internal( $dbh, $userid, $password, $no_set_userenv);
1871         $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1872     }
1873
1874     if( $patron ) {
1875         if ( $passwd_ok ) {
1876             $patron->update({ login_attempts => 0 });
1877         } elsif( !$patron->account_locked ) {
1878             $patron->update({ login_attempts => $patron->login_attempts + 1 });
1879         }
1880     }
1881
1882     # Optionally log success or failure
1883     if( $patron && $passwd_ok && C4::Context->preference('AuthSuccessLog') ) {
1884         logaction( 'AUTH', 'SUCCESS', $patron->id, "Valid password for $userid", $type );
1885     } elsif( !$passwd_ok && C4::Context->preference('AuthFailureLog') ) {
1886         logaction( 'AUTH', 'FAILURE', $patron ? $patron->id : 0, "Wrong password for $userid", $type );
1887     }
1888
1889     return @return;
1890 }
1891
1892 sub checkpw_internal {
1893     my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
1894
1895     $password = Encode::encode( 'UTF-8', $password )
1896       if Encode::is_utf8($password);
1897
1898     my $sth =
1899       $dbh->prepare(
1900         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1901       );
1902     $sth->execute($userid);
1903     if ( $sth->rows ) {
1904         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1905             $surname, $branchcode, $branchname, $flags )
1906           = $sth->fetchrow;
1907
1908         if ( checkpw_hash( $password, $stored_hash ) ) {
1909
1910             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1911                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1912             return 1, $cardnumber, $userid;
1913         }
1914     }
1915     $sth =
1916       $dbh->prepare(
1917         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1918       );
1919     $sth->execute($userid);
1920     if ( $sth->rows ) {
1921         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1922             $surname, $branchcode, $branchname, $flags )
1923           = $sth->fetchrow;
1924
1925         if ( checkpw_hash( $password, $stored_hash ) ) {
1926
1927             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1928                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1929             return 1, $cardnumber, $userid;
1930         }
1931     }
1932     return 0;
1933 }
1934
1935 sub checkpw_hash {
1936     my ( $password, $stored_hash ) = @_;
1937
1938     return if $stored_hash eq '!';
1939
1940     # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1941     my $hash;
1942     if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1943         $hash = hash_password( $password, $stored_hash );
1944     } else {
1945         $hash = md5_base64($password);
1946     }
1947     return $hash eq $stored_hash;
1948 }
1949
1950 =head2 getuserflags
1951
1952     my $authflags = getuserflags($flags, $userid, [$dbh]);
1953
1954 Translates integer flags into permissions strings hash.
1955
1956 C<$flags> is the integer userflags value ( borrowers.userflags )
1957 C<$userid> is the members.userid, used for building subpermissions
1958 C<$authflags> is a hashref of permissions
1959
1960 =cut
1961
1962 sub getuserflags {
1963     my $flags  = shift;
1964     my $userid = shift;
1965     my $dbh    = @_ ? shift : C4::Context->dbh;
1966     my $userflags;
1967     {
1968         # I don't want to do this, but if someone logs in as the database
1969         # user, it would be preferable not to spam them to death with
1970         # numeric warnings. So, we make $flags numeric.
1971         no warnings 'numeric';
1972         $flags += 0;
1973     }
1974     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1975     $sth->execute;
1976
1977     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1978         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1979             $userflags->{$flag} = 1;
1980         }
1981         else {
1982             $userflags->{$flag} = 0;
1983         }
1984     }
1985
1986     # get subpermissions and merge with top-level permissions
1987     my $user_subperms = get_user_subpermissions($userid);
1988     foreach my $module ( keys %$user_subperms ) {
1989         next if $userflags->{$module} == 1;    # user already has permission for everything in this module
1990         $userflags->{$module} = $user_subperms->{$module};
1991     }
1992
1993     return $userflags;
1994 }
1995
1996 =head2 get_user_subpermissions
1997
1998   $user_perm_hashref = get_user_subpermissions($userid);
1999
2000 Given the userid (note, not the borrowernumber) of a staff user,
2001 return a hashref of hashrefs of the specific subpermissions
2002 accorded to the user.  An example return is
2003
2004  {
2005     tools => {
2006         export_catalog => 1,
2007         import_patrons => 1,
2008     }
2009  }
2010
2011 The top-level hash-key is a module or function code from
2012 userflags.flag, while the second-level key is a code
2013 from permissions.
2014
2015 The results of this function do not give a complete picture
2016 of the functions that a staff user can access; it is also
2017 necessary to check borrowers.flags.
2018
2019 =cut
2020
2021 sub get_user_subpermissions {
2022     my $userid = shift;
2023
2024     my $dbh = C4::Context->dbh;
2025     my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2026                              FROM user_permissions
2027                              JOIN permissions USING (module_bit, code)
2028                              JOIN userflags ON (module_bit = bit)
2029                              JOIN borrowers USING (borrowernumber)
2030                              WHERE userid = ?" );
2031     $sth->execute($userid);
2032
2033     my $user_perms = {};
2034     while ( my $perm = $sth->fetchrow_hashref ) {
2035         $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2036     }
2037     return $user_perms;
2038 }
2039
2040 =head2 get_all_subpermissions
2041
2042   my $perm_hashref = get_all_subpermissions();
2043
2044 Returns a hashref of hashrefs defining all specific
2045 permissions currently defined.  The return value
2046 has the same structure as that of C<get_user_subpermissions>,
2047 except that the innermost hash value is the description
2048 of the subpermission.
2049
2050 =cut
2051
2052 sub get_all_subpermissions {
2053     my $dbh = C4::Context->dbh;
2054     my $sth = $dbh->prepare( "SELECT flag, code
2055                              FROM permissions
2056                              JOIN userflags ON (module_bit = bit)" );
2057     $sth->execute();
2058
2059     my $all_perms = {};
2060     while ( my $perm = $sth->fetchrow_hashref ) {
2061         $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2062     }
2063     return $all_perms;
2064 }
2065
2066 =head2 haspermission
2067
2068   $flagsrequired = '*';                                 # Any permission at all
2069   $flagsrequired = 'a_flag';                            # a_flag must be satisfied (all subpermissions)
2070   $flagsrequired = [ 'a_flag', 'b_flag' ];              # a_flag OR b_flag must be satisfied
2071   $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 };     # a_flag AND b_flag must be satisfied
2072   $flagsrequired = { 'a_flag' => 'sub_a' };             # sub_a of a_flag must be satisfied
2073   $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2074
2075   $flags = ($userid, $flagsrequired);
2076
2077 C<$userid> the userid of the member
2078 C<$flags> is a query structure similar to that used by SQL::Abstract that
2079 denotes the combination of flags required. It is a required parameter.
2080
2081 The main logic of this method is that things in arrays are OR'ed, and things
2082 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2083
2084 Returns member's flags or 0 if a permission is not met.
2085
2086 =cut
2087
2088 sub _dispatch {
2089     my ($required, $flags) = @_;
2090
2091     my $ref = ref($required);
2092     if ($ref eq '') {
2093         if ($required eq '*') {
2094             return 0 unless ( $flags or ref( $flags ) );
2095         } else {
2096             return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2097         }
2098     } elsif ($ref eq 'HASH') {
2099         foreach my $key (keys %{$required}) {
2100             next if $flags == 1;
2101             my $require = $required->{$key};
2102             my $rflags  = $flags->{$key};
2103             return 0 unless _dispatch($require, $rflags);
2104         }
2105     } elsif ($ref eq 'ARRAY') {
2106         my $satisfied = 0;
2107         foreach my $require ( @{$required} ) {
2108             my $rflags =
2109               ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2110               ? $flags->{$require}
2111               : $flags;
2112             $satisfied++ if _dispatch( $require, $rflags );
2113         }
2114         return 0 unless $satisfied;
2115     } else {
2116         croak "Unexpected structure found: $ref";
2117     }
2118
2119     return $flags;
2120 };
2121
2122 sub haspermission {
2123     my ( $userid, $flagsrequired ) = @_;
2124
2125     #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2126     #  unless defined($flagsrequired);
2127
2128     my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2129     $sth->execute($userid);
2130     my $row = $sth->fetchrow();
2131     my $flags = getuserflags( $row, $userid );
2132
2133     return $flags unless defined($flagsrequired);
2134     return $flags if $flags->{superlibrarian};
2135     return _dispatch($flagsrequired, $flags);
2136
2137     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2138 }
2139
2140 =head2 in_iprange
2141
2142   $flags = ($iprange);
2143
2144 C<$iprange> A space separated string describing an IP range. Can include single IPs or ranges
2145
2146 Returns 1 if the remote address is in the provided iprange, or 0 otherwise.
2147
2148 =cut
2149
2150 sub in_iprange {
2151     my ($iprange) = @_;
2152     my $result = 1;
2153     my @allowedipranges = $iprange ? split(' ', $iprange) : ();
2154     if (scalar @allowedipranges > 0) {
2155         my @rangelist;
2156         eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2157         eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || Koha::Logger->get->warn('cidrlookup failed for ' . join(' ',@rangelist) );
2158      }
2159      return $result ? 1 : 0;
2160 }
2161
2162 sub getborrowernumber {
2163     my ($userid) = @_;
2164     my $userenv = C4::Context->userenv;
2165     if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2166         return $userenv->{number};
2167     }
2168     my $dbh = C4::Context->dbh;
2169     for my $field ( 'userid', 'cardnumber' ) {
2170         my $sth =
2171           $dbh->prepare("select borrowernumber from borrowers where $field=?");
2172         $sth->execute($userid);
2173         if ( $sth->rows ) {
2174             my ($bnumber) = $sth->fetchrow;
2175             return $bnumber;
2176         }
2177     }
2178     return 0;
2179 }
2180
2181 =head2 track_login_daily
2182
2183     track_login_daily( $userid );
2184
2185 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2186
2187 =cut
2188
2189 sub track_login_daily {
2190     my $userid = shift;
2191     return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2192
2193     my $cache     = Koha::Caches->get_instance();
2194     my $cache_key = "track_login_" . $userid;
2195     my $cached    = $cache->get_from_cache($cache_key);
2196     my $today = dt_from_string()->ymd;
2197     return if $cached && $cached eq $today;
2198
2199     my $patron = Koha::Patrons->find({ userid => $userid });
2200     return unless $patron;
2201     $patron->track_login;
2202     $cache->set_in_cache( $cache_key, $today );
2203 }
2204
2205 END { }    # module clean-up code here (global destructor)
2206 1;
2207 __END__
2208
2209 =head1 SEE ALSO
2210
2211 CGI(3)
2212
2213 C4::Output(3)
2214
2215 Crypt::Eksblowfish::Bcrypt(3)
2216
2217 Digest::MD5(3)
2218
2219 =cut