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