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