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