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