C4/Auth.pm

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