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