C4/Auth.pm

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