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