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