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) {
 902                 logout_shib($query);
 903             }
 904         }
 905         elsif ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
 906
 907             # timed logout
 908             $info{'timed_out'} = 1;
 909             if ($session) {
 910                 $session->delete();
 911                 $session->flush;
 912             }
 913             C4::Context->_unset_userenv($sessionID);
 914
 915             #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
 916             $userid    = undef;
 917             $sessionID = undef;
 918         }
 919         elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
 920
 921             # Different ip than originally logged in from
 922             $info{'oldip'}        = $ip;
 923             $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 924             $info{'different_ip'} = 1;
 925             $session->delete();
 926             $session->flush;
 927             C4::Context->_unset_userenv($sessionID);
 928
 929             #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
 930             $sessionID = undef;
 931             $userid    = undef;
 932         }
 933         else {
 934             $cookie = $query->cookie(
 935                 -name     => 'CGISESSID',
 936                 -value    => $session->id,
 937                 -HttpOnly => 1
 938             );
 939             $session->param( 'lasttime', time() );
 940             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...
 941                 $flags = haspermission( $userid, $flagsrequired );
 942                 if ($flags) {
 943                     $loggedin = 1;
 944                 } else {
 945                     $info{'nopermission'} = 1;
 946                 }
 947             }
 948         }
 949     }
 950     unless ( $userid || $sessionID ) {
 951         #we initiate a session prior to checking for a username to allow for anonymous sessions...
 952         my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
 953
 954         # Save anonymous search history in new session so it can be retrieved
 955         # by get_template_and_user to store it in user's search history after
 956         # a successful login.
 957         if ($anon_search_history) {
 958             $session->param( 'search_history', $anon_search_history );
 959         }
 960
 961         $sessionID = $session->id;
 962         C4::Context->_new_userenv($sessionID);
 963         $cookie = $query->cookie(
 964             -name     => 'CGISESSID',
 965             -value    => $session->id,
 966             -HttpOnly => 1
 967         );
 968         my $pki_field = C4::Context->preference('AllowPKIAuth');
 969         if ( !defined($pki_field) ) {
 970             print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
 971             $pki_field = 'None';
 972         }
 973         if ( ( $cas && $query->param('ticket') )
 974             || $q_userid
 975             || ( $shib && $shib_login )
 976             || $pki_field ne 'None'
 977             || $emailaddress )
 978         {
 979             my $password    = $query->param('password');
 980             my $shibSuccess = 0;
 981             my ( $return, $cardnumber );
 982
 983             # If shib is enabled and we have a shib login, does the login match a valid koha user
 984             if ( $shib && $shib_login ) {
 985                 my $retuserid;
 986
 987                 # Do not pass password here, else shib will not be checked in checkpw.
 988                 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $q_userid, undef, $query );
 989                 $userid      = $retuserid;
 990                 $shibSuccess = $return;
 991                 $info{'invalidShibLogin'} = 1 unless ($return);
 992             }
 993
 994             # If shib login and match were successful, skip further login methods
 995             unless ($shibSuccess) {
 996                 if ( $cas && $query->param('ticket') ) {
 997                     my $retuserid;
 998                     ( $return, $cardnumber, $retuserid, $cas_ticket ) =
 999                       checkpw( $dbh, $userid, $password, $query, $type );
1000                     $userid = $retuserid;
1001                     $info{'invalidCasLogin'} = 1 unless ($return);
1002                 }
1003
1004                 elsif ( $emailaddress ) {
1005                     my $value = $emailaddress;
1006
1007                     # If we're looking up the email, there's a chance that the person
1008                     # doesn't have a userid. So if there is none, we pass along the
1009                     # borrower number, and the bits of code that need to know the user
1010                     # ID will have to be smart enough to handle that.
1011                     my $patrons = Koha::Patrons->search({ email => $value });
1012                     if ($patrons->count) {
1013
1014                         # First the userid, then the borrowernum
1015                         my $patron = $patrons->next;
1016                         $value = $patron->userid || $patron->borrowernumber;
1017                     } else {
1018                         undef $value;
1019                     }
1020                     $return = $value ? 1 : 0;
1021                     $userid = $value;
1022                 }
1023
1024                 elsif (
1025                     ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1026                     || ( $pki_field eq 'emailAddress'
1027                         && $ENV{'SSL_CLIENT_S_DN_Email'} )
1028                   )
1029                 {
1030                     my $value;
1031                     if ( $pki_field eq 'Common Name' ) {
1032                         $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1033                     }
1034                     elsif ( $pki_field eq 'emailAddress' ) {
1035                         $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1036
1037                         # If we're looking up the email, there's a chance that the person
1038                         # doesn't have a userid. So if there is none, we pass along the
1039                         # borrower number, and the bits of code that need to know the user
1040                         # ID will have to be smart enough to handle that.
1041                         my $patrons = Koha::Patrons->search({ email => $value });
1042                         if ($patrons->count) {
1043
1044                             # First the userid, then the borrowernum
1045                             my $patron = $patrons->next;
1046                             $value = $patron->userid || $patron->borrowernumber;
1047                         } else {
1048                             undef $value;
1049                         }
1050                     }
1051
1052                     $return = $value ? 1 : 0;
1053                     $userid = $value;
1054
1055                 }
1056                 else {
1057                     my $retuserid;
1058                     ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1059                       checkpw( $dbh, $q_userid, $password, $query, $type );
1060                     $userid = $retuserid if ($retuserid);
1061                     $info{'invalid_username_or_password'} = 1 unless ($return);
1062                 }
1063             }
1064
1065             # $return: 1 = valid user
1066             if ($return) {
1067
1068                 #_session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
1069                 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1070                     $loggedin = 1;
1071                 }
1072                 else {
1073                     $info{'nopermission'} = 1;
1074                     C4::Context->_unset_userenv($sessionID);
1075                 }
1076                 my ( $borrowernumber, $firstname, $surname, $userflags,
1077                     $branchcode, $branchname, $branchprinter, $emailaddress );
1078
1079                 if ( $return == 1 ) {
1080                     my $select = "
1081                     SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1082                     branches.branchname    as branchname,
1083                     branches.branchprinter as branchprinter,
1084                     email
1085                     FROM borrowers
1086                     LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1087                     ";
1088                     my $sth = $dbh->prepare("$select where userid=?");
1089                     $sth->execute($userid);
1090                     unless ( $sth->rows ) {
1091                         $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
1092                         $sth = $dbh->prepare("$select where cardnumber=?");
1093                         $sth->execute($cardnumber);
1094
1095                         unless ( $sth->rows ) {
1096                             $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1097                             $sth->execute($userid);
1098                             unless ( $sth->rows ) {
1099                                 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1100                             }
1101                         }
1102                     }
1103                     if ( $sth->rows ) {
1104                         ( $borrowernumber, $firstname, $surname, $userflags,
1105                             $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow;
1106                         $debug and print STDERR "AUTH_3 results: " .
1107                           "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1108                     } else {
1109                         print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1110                     }
1111
1112                     # launch a sequence to check if we have a ip for the branch, i
1113                     # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1114
1115                     my $ip = $ENV{'REMOTE_ADDR'};
1116
1117                     # if they specify at login, use that
1118                     if ( $query->param('branch') ) {
1119                         $branchcode = $query->param('branch');
1120                         my $library = Koha::Libraries->find($branchcode);
1121                         $branchname = $library? $library->branchname: '';
1122                     }
1123                     my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1124                     if ( $type ne 'opac' and C4::Context->boolean_preference('AutoLocation') ) {
1125
1126                         # we have to check they are coming from the right ip range
1127                         my $domain = $branches->{$branchcode}->{'branchip'};
1128                         $domain =~ s|\.\*||g;
1129                         if ( $ip !~ /^$domain/ ) {
1130                             $loggedin = 0;
1131                             $cookie = $query->cookie(
1132                                 -name     => 'CGISESSID',
1133                                 -value    => '',
1134                                 -HttpOnly => 1
1135                             );
1136                             $info{'wrongip'} = 1;
1137                         }
1138                     }
1139
1140                     foreach my $br ( keys %$branches ) {
1141
1142                         #     now we work with the treatment of ip
1143                         my $domain = $branches->{$br}->{'branchip'};
1144                         if ( $domain && $ip =~ /^$domain/ ) {
1145                             $branchcode = $branches->{$br}->{'branchcode'};
1146
1147                             # new op dev : add the branchprinter and branchname in the cookie
1148                             $branchprinter = $branches->{$br}->{'branchprinter'};
1149                             $branchname    = $branches->{$br}->{'branchname'};
1150                         }
1151                     }
1152                     $session->param( 'number',       $borrowernumber );
1153                     $session->param( 'id',           $userid );
1154                     $session->param( 'cardnumber',   $cardnumber );
1155                     $session->param( 'firstname',    $firstname );
1156                     $session->param( 'surname',      $surname );
1157                     $session->param( 'branch',       $branchcode );
1158                     $session->param( 'branchname',   $branchname );
1159                     $session->param( 'flags',        $userflags );
1160                     $session->param( 'emailaddress', $emailaddress );
1161                     $session->param( 'ip',           $session->remote_addr() );
1162                     $session->param( 'lasttime',     time() );
1163                     $session->param( 'shibboleth',   $shibSuccess );
1164                     $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1165                 }
1166                 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1167                 C4::Context->set_userenv(
1168                     $session->param('number'),       $session->param('id'),
1169                     $session->param('cardnumber'),   $session->param('firstname'),
1170                     $session->param('surname'),      $session->param('branch'),
1171                     $session->param('branchname'),   $session->param('flags'),
1172                     $session->param('emailaddress'), $session->param('branchprinter'),
1173                     $session->param('shibboleth')
1174                 );
1175
1176             }
1177             # $return: 0 = invalid user
1178             # reset to anonymous session
1179             else {
1180                 $debug and warn "Login failed, resetting anonymous session...";
1181                 if ($userid) {
1182                     $info{'invalid_username_or_password'} = 1;
1183                     C4::Context->_unset_userenv($sessionID);
1184                 }
1185                 $session->param( 'lasttime', time() );
1186                 $session->param( 'ip',       $session->remote_addr() );
1187                 $session->param( 'sessiontype', 'anon' );
1188             }
1189         }    # END if ( $q_userid
1190         elsif ( $type eq "opac" ) {
1191
1192             # if we are here this is an anonymous session; add public lists to it and a few other items...
1193             # anonymous sessions are created only for the OPAC
1194             $debug and warn "Initiating an anonymous session...";
1195
1196             # setting a couple of other session vars...
1197             $session->param( 'ip',          $session->remote_addr() );
1198             $session->param( 'lasttime',    time() );
1199             $session->param( 'sessiontype', 'anon' );
1200         }
1201     }    # END unless ($userid)
1202
1203     # finished authentification, now respond
1204     if ( $loggedin || $authnotrequired )
1205     {
1206         # successful login
1207         unless ($cookie) {
1208             $cookie = $query->cookie(
1209                 -name     => 'CGISESSID',
1210                 -value    => '',
1211                 -HttpOnly => 1
1212             );
1213         }
1214
1215         track_login_daily( $userid );
1216
1217         return ( $userid, $cookie, $sessionID, $flags );
1218     }
1219
1220     #
1221     #
1222     # AUTH rejected, show the login/password template, after checking the DB.
1223     #
1224     #
1225
1226     # get the inputs from the incoming query
1227     my @inputs = ();
1228     foreach my $name ( param $query) {
1229         (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1230         my @value = $query->multi_param($name);
1231         push @inputs, { name => $name, value => $_ } for @value;
1232     }
1233
1234     my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1235
1236     my $LibraryNameTitle = C4::Context->preference("LibraryName");
1237     $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1238     $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1239
1240     my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1241     my $template = C4::Templates::gettemplate( $template_name, $type, $query );
1242     $template->param(
1243         OpacAdditionalStylesheet                   => C4::Context->preference("OpacAdditionalStylesheet"),
1244         opaclayoutstylesheet                  => C4::Context->preference("opaclayoutstylesheet"),
1245         login                                 => 1,
1246         INPUTS                                => \@inputs,
1247         script_name                           => get_script_name(),
1248         casAuthentication                     => C4::Context->preference("casAuthentication"),
1249         shibbolethAuthentication              => $shib,
1250         SessionRestrictionByIP                => C4::Context->preference("SessionRestrictionByIP"),
1251         suggestion                            => C4::Context->preference("suggestion"),
1252         virtualshelves                        => C4::Context->preference("virtualshelves"),
1253         LibraryName                           => "" . C4::Context->preference("LibraryName"),
1254         LibraryNameTitle                      => "" . $LibraryNameTitle,
1255         opacuserlogin                         => C4::Context->preference("opacuserlogin"),
1256         OpacNav                               => C4::Context->preference("OpacNav"),
1257         OpacNavRight                          => C4::Context->preference("OpacNavRight"),
1258         OpacNavBottom                         => C4::Context->preference("OpacNavBottom"),
1259         opaccredits                           => C4::Context->preference("opaccredits"),
1260         OpacFavicon                           => C4::Context->preference("OpacFavicon"),
1261         opacreadinghistory                    => C4::Context->preference("opacreadinghistory"),
1262         opaclanguagesdisplay                  => C4::Context->preference("opaclanguagesdisplay"),
1263         OPACUserJS                            => C4::Context->preference("OPACUserJS"),
1264         opacbookbag                           => "" . C4::Context->preference("opacbookbag"),
1265         OpacCloud                             => C4::Context->preference("OpacCloud"),
1266         OpacTopissue                          => C4::Context->preference("OpacTopissue"),
1267         OpacAuthorities                       => C4::Context->preference("OpacAuthorities"),
1268         OpacBrowser                           => C4::Context->preference("OpacBrowser"),
1269         opacheader                            => C4::Context->preference("opacheader"),
1270         TagsEnabled                           => C4::Context->preference("TagsEnabled"),
1271         OPACUserCSS                           => C4::Context->preference("OPACUserCSS"),
1272         intranetcolorstylesheet               => C4::Context->preference("intranetcolorstylesheet"),
1273         intranetstylesheet                    => C4::Context->preference("intranetstylesheet"),
1274         intranetbookbag                       => C4::Context->preference("intranetbookbag"),
1275         IntranetNav                           => C4::Context->preference("IntranetNav"),
1276         IntranetFavicon                       => C4::Context->preference("IntranetFavicon"),
1277         IntranetUserCSS                       => C4::Context->preference("IntranetUserCSS"),
1278         IntranetUserJS                        => C4::Context->preference("IntranetUserJS"),
1279         IndependentBranches                   => C4::Context->preference("IndependentBranches"),
1280         AutoLocation                          => C4::Context->preference("AutoLocation"),
1281         wrongip                               => $info{'wrongip'},
1282         PatronSelfRegistration                => C4::Context->preference("PatronSelfRegistration"),
1283         PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1284         opac_css_override                     => $ENV{'OPAC_CSS_OVERRIDE'},
1285         too_many_login_attempts               => ( $patron and $patron->account_locked )
1286     );
1287
1288     $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1289     $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1290     $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1291     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1292
1293     if ( $type eq 'opac' ) {
1294         require Koha::Virtualshelves;
1295         my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1296             {
1297                 category       => 2,
1298             }
1299         );
1300         $template->param(
1301             some_public_shelves  => $some_public_shelves,
1302         );
1303     }
1304
1305     if ($cas) {
1306
1307         # Is authentication against multiple CAS servers enabled?
1308         if ( C4::Auth_with_cas::multipleAuth && !$casparam ) {
1309             my $casservers = C4::Auth_with_cas::getMultipleAuth();
1310             my @tmplservers;
1311             foreach my $key ( keys %$casservers ) {
1312                 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1313             }
1314             $template->param(
1315                 casServersLoop => \@tmplservers
1316             );
1317         } else {
1318             $template->param(
1319                 casServerUrl => login_cas_url($query, undef, $type),
1320             );
1321         }
1322
1323         $template->param(
1324             invalidCasLogin => $info{'invalidCasLogin'}
1325         );
1326     }
1327
1328     if ($shib) {
1329         $template->param(
1330             shibbolethAuthentication => $shib,
1331             shibbolethLoginUrl       => login_shib_url($query),
1332         );
1333     }
1334
1335     if (C4::Context->preference('GoogleOpenIDConnect')) {
1336         if ($query->param("OpenIDConnectFailed")) {
1337             my $reason = $query->param('OpenIDConnectFailed');
1338             $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1339         }
1340     }
1341
1342     $template->param(
1343         LibraryName => C4::Context->preference("LibraryName"),
1344     );
1345     $template->param(%info);
1346
1347     #    $cookie = $query->cookie(CGISESSID => $session->id
1348     #   );
1349     print $query->header(
1350         {   type              => 'text/html',
1351             charset           => 'utf-8',
1352             cookie            => $cookie,
1353             'X-Frame-Options' => 'SAMEORIGIN'
1354         }
1355       ),
1356       $template->output;
1357     safe_exit;
1358 }
1359
1360 =head2 check_api_auth
1361
1362   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1363
1364 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1365 cookie, determine if the user has the privileges specified by C<$userflags>.
1366
1367 C<check_api_auth> is is meant for authenticating users of web services, and
1368 consequently will always return and will not attempt to redirect the user
1369 agent.
1370
1371 If a valid session cookie is already present, check_api_auth will return a status
1372 of "ok", the cookie, and the Koha session ID.
1373
1374 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1375 parameters and create a session cookie and Koha session if the supplied credentials
1376 are OK.
1377
1378 Possible return values in C<$status> are:
1379
1380 =over
1381
1382 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1383
1384 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1385
1386 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1387
1388 =item "expired -- session cookie has expired; API user should resubmit userid and password
1389
1390 =back
1391
1392 =cut
1393
1394 sub check_api_auth {
1395
1396     my $query         = shift;
1397     my $flagsrequired = shift;
1398     my $dbh     = C4::Context->dbh;
1399     my $timeout = _timeout_syspref();
1400
1401     unless ( C4::Context->preference('Version') ) {
1402
1403         # database has not been installed yet
1404         return ( "maintenance", undef, undef );
1405     }
1406     my $kohaversion = Koha::version();
1407     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1408     if ( C4::Context->preference('Version') < $kohaversion ) {
1409
1410         # database in need of version update; assume that
1411         # no API should be called while databsae is in
1412         # this condition.
1413         return ( "maintenance", undef, undef );
1414     }
1415
1416     # FIXME -- most of what follows is a copy-and-paste
1417     # of code from checkauth.  There is an obvious need
1418     # for refactoring to separate the various parts of
1419     # the authentication code, but as of 2007-11-19 this
1420     # is deferred so as to not introduce bugs into the
1421     # regular authentication code for Koha 3.0.
1422
1423     # see if we have a valid session cookie already
1424     # however, if a userid parameter is present (i.e., from
1425     # a form submission, assume that any current cookie
1426     # is to be ignored
1427     my $sessionID = undef;
1428     unless ( $query->param('userid') ) {
1429         $sessionID = $query->cookie("CGISESSID");
1430     }
1431     if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1432         my $session = get_session($sessionID);
1433         C4::Context->_new_userenv($sessionID);
1434         if ($session) {
1435             C4::Context->set_userenv(
1436                 $session->param('number'),       $session->param('id'),
1437                 $session->param('cardnumber'),   $session->param('firstname'),
1438                 $session->param('surname'),      $session->param('branch'),
1439                 $session->param('branchname'),   $session->param('flags'),
1440                 $session->param('emailaddress'), $session->param('branchprinter')
1441             );
1442
1443             my $ip       = $session->param('ip');
1444             my $lasttime = $session->param('lasttime');
1445             my $userid   = $session->param('id');
1446             if ( $lasttime < time() - $timeout ) {
1447
1448                 # time out
1449                 $session->delete();
1450                 $session->flush;
1451                 C4::Context->_unset_userenv($sessionID);
1452                 $userid    = undef;
1453                 $sessionID = undef;
1454                 return ( "expired", undef, undef );
1455             } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1456
1457                 # IP address changed
1458                 $session->delete();
1459                 $session->flush;
1460                 C4::Context->_unset_userenv($sessionID);
1461                 $userid    = undef;
1462                 $sessionID = undef;
1463                 return ( "expired", undef, undef );
1464             } else {
1465                 my $cookie = $query->cookie(
1466                     -name     => 'CGISESSID',
1467                     -value    => $session->id,
1468                     -HttpOnly => 1,
1469                 );
1470                 $session->param( 'lasttime', time() );
1471                 my $flags = haspermission( $userid, $flagsrequired );
1472                 if ($flags) {
1473                     return ( "ok", $cookie, $sessionID );
1474                 } else {
1475                     $session->delete();
1476                     $session->flush;
1477                     C4::Context->_unset_userenv($sessionID);
1478                     $userid    = undef;
1479                     $sessionID = undef;
1480                     return ( "failed", undef, undef );
1481                 }
1482             }
1483         } else {
1484             return ( "expired", undef, undef );
1485         }
1486     } else {
1487
1488         # new login
1489         my $userid   = $query->param('userid');
1490         my $password = $query->param('password');
1491         my ( $return, $cardnumber, $cas_ticket );
1492
1493         # Proxy CAS auth
1494         if ( $cas && $query->param('PT') ) {
1495             my $retuserid;
1496             $debug and print STDERR "## check_api_auth - checking CAS\n";
1497
1498             # In case of a CAS authentication, we use the ticket instead of the password
1499             my $PT = $query->param('PT');
1500             ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $dbh, $PT, $query );    # EXTERNAL AUTH
1501         } else {
1502
1503             # User / password auth
1504             unless ( $userid and $password ) {
1505
1506                 # caller did something wrong, fail the authenticateion
1507                 return ( "failed", undef, undef );
1508             }
1509             my $newuserid;
1510             ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $dbh, $userid, $password, $query );
1511         }
1512
1513         if ( $return and haspermission( $userid, $flagsrequired ) ) {
1514             my $session = get_session("");
1515             return ( "failed", undef, undef ) unless $session;
1516
1517             my $sessionID = $session->id;
1518             C4::Context->_new_userenv($sessionID);
1519             my $cookie = $query->cookie(
1520                 -name     => 'CGISESSID',
1521                 -value    => $sessionID,
1522                 -HttpOnly => 1,
1523             );
1524             if ( $return == 1 ) {
1525                 my (
1526                     $borrowernumber, $firstname,  $surname,
1527                     $userflags,      $branchcode, $branchname,
1528                     $branchprinter,  $emailaddress
1529                 );
1530                 my $sth =
1531                   $dbh->prepare(
1532 "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=?"
1533                   );
1534                 $sth->execute($userid);
1535                 (
1536                     $borrowernumber, $firstname,  $surname,
1537                     $userflags,      $branchcode, $branchname,
1538                     $branchprinter,  $emailaddress
1539                 ) = $sth->fetchrow if ( $sth->rows );
1540
1541                 unless ( $sth->rows ) {
1542                     my $sth = $dbh->prepare(
1543 "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=?"
1544                     );
1545                     $sth->execute($cardnumber);
1546                     (
1547                         $borrowernumber, $firstname,  $surname,
1548                         $userflags,      $branchcode, $branchname,
1549                         $branchprinter,  $emailaddress
1550                     ) = $sth->fetchrow if ( $sth->rows );
1551
1552                     unless ( $sth->rows ) {
1553                         $sth->execute($userid);
1554                         (
1555                             $borrowernumber, $firstname,  $surname,       $userflags,
1556                             $branchcode,     $branchname, $branchprinter, $emailaddress
1557                         ) = $sth->fetchrow if ( $sth->rows );
1558                     }
1559                 }
1560
1561                 my $ip = $ENV{'REMOTE_ADDR'};
1562
1563                 # if they specify at login, use that
1564                 if ( $query->param('branch') ) {
1565                     $branchcode = $query->param('branch');
1566                     my $library = Koha::Libraries->find($branchcode);
1567                     $branchname = $library? $library->branchname: '';
1568                 }
1569                 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1570                 foreach my $br ( keys %$branches ) {
1571
1572                     #     now we work with the treatment of ip
1573                     my $domain = $branches->{$br}->{'branchip'};
1574                     if ( $domain && $ip =~ /^$domain/ ) {
1575                         $branchcode = $branches->{$br}->{'branchcode'};
1576
1577                         # new op dev : add the branchprinter and branchname in the cookie
1578                         $branchprinter = $branches->{$br}->{'branchprinter'};
1579                         $branchname    = $branches->{$br}->{'branchname'};
1580                     }
1581                 }
1582                 $session->param( 'number',       $borrowernumber );
1583                 $session->param( 'id',           $userid );
1584                 $session->param( 'cardnumber',   $cardnumber );
1585                 $session->param( 'firstname',    $firstname );
1586                 $session->param( 'surname',      $surname );
1587                 $session->param( 'branch',       $branchcode );
1588                 $session->param( 'branchname',   $branchname );
1589                 $session->param( 'flags',        $userflags );
1590                 $session->param( 'emailaddress', $emailaddress );
1591                 $session->param( 'ip',           $session->remote_addr() );
1592                 $session->param( 'lasttime',     time() );
1593             }
1594             $session->param( 'cas_ticket', $cas_ticket);
1595             C4::Context->set_userenv(
1596                 $session->param('number'),       $session->param('id'),
1597                 $session->param('cardnumber'),   $session->param('firstname'),
1598                 $session->param('surname'),      $session->param('branch'),
1599                 $session->param('branchname'),   $session->param('flags'),
1600                 $session->param('emailaddress'), $session->param('branchprinter')
1601             );
1602             return ( "ok", $cookie, $sessionID );
1603         } else {
1604             return ( "failed", undef, undef );
1605         }
1606     }
1607 }
1608
1609 =head2 check_cookie_auth
1610
1611   ($status, $sessionId) = check_api_auth($cookie, $userflags);
1612
1613 Given a CGISESSID cookie set during a previous login to Koha, determine
1614 if the user has the privileges specified by C<$userflags>.
1615
1616 C<check_cookie_auth> is meant for authenticating special services
1617 such as tools/upload-file.pl that are invoked by other pages that
1618 have been authenticated in the usual way.
1619
1620 Possible return values in C<$status> are:
1621
1622 =over
1623
1624 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1625
1626 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1627
1628 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1629
1630 =item "expired -- session cookie has expired; API user should resubmit userid and password
1631
1632 =back
1633
1634 =cut
1635
1636 sub check_cookie_auth {
1637     my $cookie        = shift;
1638     my $flagsrequired = shift;
1639     my $params        = shift;
1640
1641     my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1642     my $dbh     = C4::Context->dbh;
1643     my $timeout = _timeout_syspref();
1644
1645     unless ( C4::Context->preference('Version') ) {
1646
1647         # database has not been installed yet
1648         return ( "maintenance", undef );
1649     }
1650     my $kohaversion = Koha::version();
1651     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1652     if ( C4::Context->preference('Version') < $kohaversion ) {
1653
1654         # database in need of version update; assume that
1655         # no API should be called while databsae is in
1656         # this condition.
1657         return ( "maintenance", undef );
1658     }
1659
1660     # FIXME -- most of what follows is a copy-and-paste
1661     # of code from checkauth.  There is an obvious need
1662     # for refactoring to separate the various parts of
1663     # the authentication code, but as of 2007-11-23 this
1664     # is deferred so as to not introduce bugs into the
1665     # regular authentication code for Koha 3.0.
1666
1667     # see if we have a valid session cookie already
1668     # however, if a userid parameter is present (i.e., from
1669     # a form submission, assume that any current cookie
1670     # is to be ignored
1671     unless ( defined $cookie and $cookie ) {
1672         return ( "failed", undef );
1673     }
1674     my $sessionID = $cookie;
1675     my $session   = get_session($sessionID);
1676     C4::Context->_new_userenv($sessionID);
1677     if ($session) {
1678         C4::Context->set_userenv(
1679             $session->param('number'),       $session->param('id'),
1680             $session->param('cardnumber'),   $session->param('firstname'),
1681             $session->param('surname'),      $session->param('branch'),
1682             $session->param('branchname'),   $session->param('flags'),
1683             $session->param('emailaddress'), $session->param('branchprinter')
1684         );
1685
1686         my $ip       = $session->param('ip');
1687         my $lasttime = $session->param('lasttime');
1688         my $userid   = $session->param('id');
1689         if ( $lasttime < time() - $timeout ) {
1690
1691             # time out
1692             $session->delete();
1693             $session->flush;
1694             C4::Context->_unset_userenv($sessionID);
1695             $userid    = undef;
1696             $sessionID = undef;
1697             return ("expired", undef);
1698         } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1699
1700             # IP address changed
1701             $session->delete();
1702             $session->flush;
1703             C4::Context->_unset_userenv($sessionID);
1704             $userid    = undef;
1705             $sessionID = undef;
1706             return ( "expired", undef );
1707         } else {
1708             $session->param( 'lasttime', time() );
1709             my $flags = haspermission( $userid, $flagsrequired );
1710             if ($flags) {
1711                 return ( "ok", $sessionID );
1712             } else {
1713                 $session->delete();
1714                 $session->flush;
1715                 C4::Context->_unset_userenv($sessionID);
1716                 $userid    = undef;
1717                 $sessionID = undef;
1718                 return ( "failed", undef );
1719             }
1720         }
1721     } else {
1722         return ( "expired", undef );
1723     }
1724 }
1725
1726 =head2 get_session
1727
1728   use CGI::Session;
1729   my $session = get_session($sessionID);
1730
1731 Given a session ID, retrieve the CGI::Session object used to store
1732 the session's state.  The session object can be used to store
1733 data that needs to be accessed by different scripts during a
1734 user's session.
1735
1736 If the C<$sessionID> parameter is an empty string, a new session
1737 will be created.
1738
1739 =cut
1740
1741 sub _get_session_params {
1742     my $storage_method = C4::Context->preference('SessionStorage');
1743     if ( $storage_method eq 'mysql' ) {
1744         my $dbh = C4::Context->dbh;
1745         return { dsn => "driver:MySQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1746     }
1747     elsif ( $storage_method eq 'Pg' ) {
1748         my $dbh = C4::Context->dbh;
1749         return { dsn => "driver:PostgreSQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1750     }
1751     elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1752         my $memcached = Koha::Caches->get_instance()->memcached_cache;
1753         return { dsn => "driver:memcached;serializer:yaml;id:md5", dsn_args => { Memcached => $memcached } };
1754     }
1755     else {
1756         # catch all defaults to tmp should work on all systems
1757         my $dir = C4::Context::temporary_directory;
1758         my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1759         return { dsn => "driver:File;serializer:yaml;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1760     }
1761 }
1762
1763 sub get_session {
1764     my $sessionID      = shift;
1765     my $params = _get_session_params();
1766     return new CGI::Session( $params->{dsn}, $sessionID, $params->{dsn_args} );
1767 }
1768
1769
1770 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1771 # (or something similar)
1772 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1773 # not having a userenv defined could cause a crash.
1774 sub checkpw {
1775     my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1776     $type = 'opac' unless $type;
1777
1778     my @return;
1779     my $patron = Koha::Patrons->find({ userid => $userid });
1780     my $check_internal_as_fallback = 0;
1781     my $passwd_ok = 0;
1782     # Note: checkpw_* routines returns:
1783     # 1 if auth is ok
1784     # 0 if auth is nok
1785     # -1 if user bind failed (LDAP only)
1786
1787     if ( $patron and $patron->account_locked ) {
1788         # Nothing to check, account is locked
1789     } elsif ($ldap && defined($password)) {
1790         $debug and print STDERR "## checkpw - checking LDAP\n";
1791         my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_);    # EXTERNAL AUTH
1792         if ( $retval == 1 ) {
1793             @return = ( $retval, $retcard, $retuserid );
1794             $passwd_ok = 1;
1795         }
1796         $check_internal_as_fallback = 1 if $retval == 0;
1797
1798     } elsif ( $cas && $query && $query->param('ticket') ) {
1799         $debug and print STDERR "## checkpw - checking CAS\n";
1800
1801         # In case of a CAS authentication, we use the ticket instead of the password
1802         my $ticket = $query->param('ticket');
1803         $query->delete('ticket');                                   # remove ticket to come back to original URL
1804         my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $dbh, $ticket, $query, $type );    # EXTERNAL AUTH
1805         if ( $retval ) {
1806             @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1807         } else {
1808             @return = (0);
1809         }
1810         $passwd_ok = $retval;
1811     }
1812
1813     # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1814     # Check for password to asertain whether we want to be testing against shibboleth or another method this
1815     # time around.
1816     elsif ( $shib && $shib_login && !$password ) {
1817
1818         $debug and print STDERR "## checkpw - checking Shibboleth\n";
1819
1820         # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1821         # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1822         # shibboleth-authenticated user
1823
1824         # Then, we check if it matches a valid koha user
1825         if ($shib_login) {
1826             my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login);    # EXTERNAL AUTH
1827             if ( $retval ) {
1828                 @return = ( $retval, $retcard, $retuserid );
1829             }
1830             $passwd_ok = $retval;
1831         }
1832     } else {
1833         $check_internal_as_fallback = 1;
1834     }
1835
1836     # INTERNAL AUTH
1837     if ( $check_internal_as_fallback ) {
1838         @return = checkpw_internal( $dbh, $userid, $password, $no_set_userenv);
1839         $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1840     }
1841
1842     if( $patron ) {
1843         if ( $passwd_ok ) {
1844             $patron->update({ login_attempts => 0 });
1845         } else {
1846             $patron->update({ login_attempts => $patron->login_attempts + 1 });
1847         }
1848     }
1849     return @return;
1850 }
1851
1852 sub checkpw_internal {
1853     my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
1854
1855     $password = Encode::encode( 'UTF-8', $password )
1856       if Encode::is_utf8($password);
1857
1858     my $sth =
1859       $dbh->prepare(
1860         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1861       );
1862     $sth->execute($userid);
1863     if ( $sth->rows ) {
1864         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1865             $surname, $branchcode, $branchname, $flags )
1866           = $sth->fetchrow;
1867
1868         if ( checkpw_hash( $password, $stored_hash ) ) {
1869
1870             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1871                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1872             return 1, $cardnumber, $userid;
1873         }
1874     }
1875     $sth =
1876       $dbh->prepare(
1877         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1878       );
1879     $sth->execute($userid);
1880     if ( $sth->rows ) {
1881         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1882             $surname, $branchcode, $branchname, $flags )
1883           = $sth->fetchrow;
1884
1885         if ( checkpw_hash( $password, $stored_hash ) ) {
1886
1887             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1888                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1889             return 1, $cardnumber, $userid;
1890         }
1891     }
1892     return 0;
1893 }
1894
1895 sub checkpw_hash {
1896     my ( $password, $stored_hash ) = @_;
1897
1898     return if $stored_hash eq '!';
1899
1900     # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1901     my $hash;
1902     if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1903         $hash = hash_password( $password, $stored_hash );
1904     } else {
1905         $hash = md5_base64($password);
1906     }
1907     return $hash eq $stored_hash;
1908 }
1909
1910 =head2 getuserflags
1911
1912     my $authflags = getuserflags($flags, $userid, [$dbh]);
1913
1914 Translates integer flags into permissions strings hash.
1915
1916 C<$flags> is the integer userflags value ( borrowers.userflags )
1917 C<$userid> is the members.userid, used for building subpermissions
1918 C<$authflags> is a hashref of permissions
1919
1920 =cut
1921
1922 sub getuserflags {
1923     my $flags  = shift;
1924     my $userid = shift;
1925     my $dbh    = @_ ? shift : C4::Context->dbh;
1926     my $userflags;
1927     {
1928         # I don't want to do this, but if someone logs in as the database
1929         # user, it would be preferable not to spam them to death with
1930         # numeric warnings. So, we make $flags numeric.
1931         no warnings 'numeric';
1932         $flags += 0;
1933     }
1934     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1935     $sth->execute;
1936
1937     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1938         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1939             $userflags->{$flag} = 1;
1940         }
1941         else {
1942             $userflags->{$flag} = 0;
1943         }
1944     }
1945
1946     # get subpermissions and merge with top-level permissions
1947     my $user_subperms = get_user_subpermissions($userid);
1948     foreach my $module ( keys %$user_subperms ) {
1949         next if $userflags->{$module} == 1;    # user already has permission for everything in this module
1950         $userflags->{$module} = $user_subperms->{$module};
1951     }
1952
1953     return $userflags;
1954 }
1955
1956 =head2 get_user_subpermissions
1957
1958   $user_perm_hashref = get_user_subpermissions($userid);
1959
1960 Given the userid (note, not the borrowernumber) of a staff user,
1961 return a hashref of hashrefs of the specific subpermissions
1962 accorded to the user.  An example return is
1963
1964  {
1965     tools => {
1966         export_catalog => 1,
1967         import_patrons => 1,
1968     }
1969  }
1970
1971 The top-level hash-key is a module or function code from
1972 userflags.flag, while the second-level key is a code
1973 from permissions.
1974
1975 The results of this function do not give a complete picture
1976 of the functions that a staff user can access; it is also
1977 necessary to check borrowers.flags.
1978
1979 =cut
1980
1981 sub get_user_subpermissions {
1982     my $userid = shift;
1983
1984     my $dbh = C4::Context->dbh;
1985     my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
1986                              FROM user_permissions
1987                              JOIN permissions USING (module_bit, code)
1988                              JOIN userflags ON (module_bit = bit)
1989                              JOIN borrowers USING (borrowernumber)
1990                              WHERE userid = ?" );
1991     $sth->execute($userid);
1992
1993     my $user_perms = {};
1994     while ( my $perm = $sth->fetchrow_hashref ) {
1995         $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1996     }
1997     return $user_perms;
1998 }
1999
2000 =head2 get_all_subpermissions
2001
2002   my $perm_hashref = get_all_subpermissions();
2003
2004 Returns a hashref of hashrefs defining all specific
2005 permissions currently defined.  The return value
2006 has the same structure as that of C<get_user_subpermissions>,
2007 except that the innermost hash value is the description
2008 of the subpermission.
2009
2010 =cut
2011
2012 sub get_all_subpermissions {
2013     my $dbh = C4::Context->dbh;
2014     my $sth = $dbh->prepare( "SELECT flag, code
2015                              FROM permissions
2016                              JOIN userflags ON (module_bit = bit)" );
2017     $sth->execute();
2018
2019     my $all_perms = {};
2020     while ( my $perm = $sth->fetchrow_hashref ) {
2021         $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2022     }
2023     return $all_perms;
2024 }
2025
2026 =head2 haspermission
2027
2028   $flags = ($userid, $flagsrequired);
2029
2030 C<$userid> the userid of the member
2031 C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
2032
2033 Returns member's flags or 0 if a permission is not met.
2034
2035 =cut
2036
2037 sub haspermission {
2038     my ( $userid, $flagsrequired ) = @_;
2039     my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2040     $sth->execute($userid);
2041     my $row = $sth->fetchrow();
2042     my $flags = getuserflags( $row, $userid );
2043
2044     return $flags if $flags->{superlibrarian};
2045
2046     foreach my $module ( keys %$flagsrequired ) {
2047         my $subperm = $flagsrequired->{$module};
2048         if ( $subperm eq '*' ) {
2049             return 0 unless ( $flags->{$module} == 1 or ref( $flags->{$module} ) );
2050         } else {
2051             return 0 unless (
2052                 ( defined $flags->{$module} and
2053                     $flags->{$module} == 1 )
2054                 or
2055                 ( ref( $flags->{$module} ) and
2056                     exists $flags->{$module}->{$subperm} and
2057                     $flags->{$module}->{$subperm} == 1 )
2058             );
2059         }
2060     }
2061     return $flags;
2062
2063     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2064 }
2065
2066 sub getborrowernumber {
2067     my ($userid) = @_;
2068     my $userenv = C4::Context->userenv;
2069     if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2070         return $userenv->{number};
2071     }
2072     my $dbh = C4::Context->dbh;
2073     for my $field ( 'userid', 'cardnumber' ) {
2074         my $sth =
2075           $dbh->prepare("select borrowernumber from borrowers where $field=?");
2076         $sth->execute($userid);
2077         if ( $sth->rows ) {
2078             my ($bnumber) = $sth->fetchrow;
2079             return $bnumber;
2080         }
2081     }
2082     return 0;
2083 }
2084
2085 =head2 track_login_daily
2086
2087     track_login_daily( $userid );
2088
2089 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2090
2091 =cut
2092
2093 sub track_login_daily {
2094     my $userid = shift;
2095     return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2096
2097     my $cache     = Koha::Caches->get_instance();
2098     my $cache_key = "track_login_" . $userid;
2099     my $cached    = $cache->get_from_cache($cache_key);
2100     my $today = dt_from_string()->ymd;
2101     return if $cached && $cached eq $today;
2102
2103     my $patron = Koha::Patrons->find({ userid => $userid });
2104     return unless $patron;
2105     $patron->track_login;
2106     $cache->set_in_cache( $cache_key, $today );
2107 }
2108
2109 END { }    # module clean-up code here (global destructor)
2110 1;
2111 __END__
2112
2113 =head1 SEE ALSO
2114
2115 CGI(3)
2116
2117 C4::Output(3)
2118
2119 Crypt::Eksblowfish::Bcrypt(3)
2120
2121 Digest::MD5(3)
2122
2123 =cut