C4/Auth.pm

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