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