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