C4/Auth.pm

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