C4/Auth.pm

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