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