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