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