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