C4/Auth.pm

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