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