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