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