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