koha-dev.rot13.org Git - srvgit/blob - C4/Auth.pm

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