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