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             AuthorisedValueImages                 => C4::Context->preference("AuthorisedValueImages"),
 513             BranchesLoop                          => GetBranchesLoop($opac_name),
 514             BranchCategoriesLoop                  => $library_categories,
 515             opac_name                             => $opac_name,
 516             LibraryName                           => "" . C4::Context->preference("LibraryName"),
 517             LibraryNameTitle                      => "" . $LibraryNameTitle,
 518             LoginBranchname                       => C4::Context->userenv ? C4::Context->userenv->{"branchname"} : "",
 519             OPACAmazonCoverImages                 => C4::Context->preference("OPACAmazonCoverImages"),
 520             OPACFRBRizeEditions                   => C4::Context->preference("OPACFRBRizeEditions"),
 521             OpacHighlightedWords                  => C4::Context->preference("OpacHighlightedWords"),
 522             OPACShelfBrowser                      => "" . C4::Context->preference("OPACShelfBrowser"),
 523             OPACURLOpenInNewWindow                => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
 524             OPACUserCSS                           => "" . C4::Context->preference("OPACUserCSS"),
 525             OpacAuthorities                       => C4::Context->preference("OpacAuthorities"),
 526             opac_css_override                     => $ENV{'OPAC_CSS_OVERRIDE'},
 527             opac_search_limit                     => $opac_search_limit,
 528             opac_limit_override                   => $opac_limit_override,
 529             OpacBrowser                           => C4::Context->preference("OpacBrowser"),
 530             OpacCloud                             => C4::Context->preference("OpacCloud"),
 531             OpacKohaUrl                           => C4::Context->preference("OpacKohaUrl"),
 532             OpacMainUserBlock                     => "" . C4::Context->preference("OpacMainUserBlock"),
 533             OpacNav                               => "" . C4::Context->preference("OpacNav"),
 534             OpacNavRight                          => "" . C4::Context->preference("OpacNavRight"),
 535             OpacNavBottom                         => "" . C4::Context->preference("OpacNavBottom"),
 536             OpacPasswordChange                    => C4::Context->preference("OpacPasswordChange"),
 537             OPACPatronDetails                     => C4::Context->preference("OPACPatronDetails"),
 538             OPACPrivacy                           => C4::Context->preference("OPACPrivacy"),
 539             OPACFinesTab                          => C4::Context->preference("OPACFinesTab"),
 540             OpacTopissue                          => C4::Context->preference("OpacTopissue"),
 541             RequestOnOpac                         => C4::Context->preference("RequestOnOpac"),
 542             'Version'                             => C4::Context->preference('Version'),
 543             hidelostitems                         => C4::Context->preference("hidelostitems"),
 544             mylibraryfirst                        => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
 545             opaclayoutstylesheet                  => "" . C4::Context->preference("opaclayoutstylesheet"),
 546             opacbookbag                           => "" . C4::Context->preference("opacbookbag"),
 547             opaccredits                           => "" . C4::Context->preference("opaccredits"),
 548             OpacFavicon                           => C4::Context->preference("OpacFavicon"),
 549             opacheader                            => "" . C4::Context->preference("opacheader"),
 550             opaclanguagesdisplay                  => "" . C4::Context->preference("opaclanguagesdisplay"),
 551             opacreadinghistory                    => C4::Context->preference("opacreadinghistory"),
 552             OPACUserJS                            => C4::Context->preference("OPACUserJS"),
 553             opacuserlogin                         => "" . C4::Context->preference("opacuserlogin"),
 554             OpenLibrarySearch                     => C4::Context->preference("OpenLibrarySearch"),
 555             ShowReviewer                          => C4::Context->preference("ShowReviewer"),
 556             ShowReviewerPhoto                     => C4::Context->preference("ShowReviewerPhoto"),
 557             suggestion                            => "" . C4::Context->preference("suggestion"),
 558             virtualshelves                        => "" . C4::Context->preference("virtualshelves"),
 559             OPACSerialIssueDisplayCount           => C4::Context->preference("OPACSerialIssueDisplayCount"),
 560             OPACXSLTDetailsDisplay                => C4::Context->preference("OPACXSLTDetailsDisplay"),
 561             OPACXSLTResultsDisplay                => C4::Context->preference("OPACXSLTResultsDisplay"),
 562             SyndeticsClientCode                   => C4::Context->preference("SyndeticsClientCode"),
 563             SyndeticsEnabled                      => C4::Context->preference("SyndeticsEnabled"),
 564             SyndeticsCoverImages                  => C4::Context->preference("SyndeticsCoverImages"),
 565             SyndeticsTOC                          => C4::Context->preference("SyndeticsTOC"),
 566             SyndeticsSummary                      => C4::Context->preference("SyndeticsSummary"),
 567             SyndeticsEditions                     => C4::Context->preference("SyndeticsEditions"),
 568             SyndeticsExcerpt                      => C4::Context->preference("SyndeticsExcerpt"),
 569             SyndeticsReviews                      => C4::Context->preference("SyndeticsReviews"),
 570             SyndeticsAuthorNotes                  => C4::Context->preference("SyndeticsAuthorNotes"),
 571             SyndeticsAwards                       => C4::Context->preference("SyndeticsAwards"),
 572             SyndeticsSeries                       => C4::Context->preference("SyndeticsSeries"),
 573             SyndeticsCoverImageSize               => C4::Context->preference("SyndeticsCoverImageSize"),
 574             OPACLocalCoverImages                  => C4::Context->preference("OPACLocalCoverImages"),
 575             PatronSelfRegistration                => C4::Context->preference("PatronSelfRegistration"),
 576             PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
 577             useDischarge                 => C4::Context->preference('useDischarge'),
 578         );
 579
 580         $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
 581     }
 582
 583     # Check if we were asked using parameters to force a specific language
 584     if ( defined $in->{'query'}->param('language') ) {
 585
 586         # Extract the language, let C4::Languages::getlanguage choose
 587         # what to do
 588         my $language = C4::Languages::getlanguage( $in->{'query'} );
 589         my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
 590         if ( ref $cookie eq 'ARRAY' ) {
 591             push @{$cookie}, $languagecookie;
 592         } else {
 593             $cookie = [ $cookie, $languagecookie ];
 594         }
 595     }
 596
 597     return ( $template, $borrowernumber, $cookie, $flags );
 598 }
 599
 600 =head2 checkauth
 601
 602   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 603
 604 Verifies that the user is authorized to run this script.  If
 605 the user is authorized, a (userid, cookie, session-id, flags)
 606 quadruple is returned.  If the user is not authorized but does
 607 not have the required privilege (see $flagsrequired below), it
 608 displays an error page and exits.  Otherwise, it displays the
 609 login page and exits.
 610
 611 Note that C<&checkauth> will return if and only if the user
 612 is authorized, so it should be called early on, before any
 613 unfinished operations (e.g., if you've opened a file, then
 614 C<&checkauth> won't close it for you).
 615
 616 C<$query> is the CGI object for the script calling C<&checkauth>.
 617
 618 The C<$noauth> argument is optional. If it is set, then no
 619 authorization is required for the script.
 620
 621 C<&checkauth> fetches user and session information from C<$query> and
 622 ensures that the user is authorized to run scripts that require
 623 authorization.
 624
 625 The C<$flagsrequired> argument specifies the required privileges
 626 the user must have if the username and password are correct.
 627 It should be specified as a reference-to-hash; keys in the hash
 628 should be the "flags" for the user, as specified in the Members
 629 intranet module. Any key specified must correspond to a "flag"
 630 in the userflags table. E.g., { circulate => 1 } would specify
 631 that the user must have the "circulate" privilege in order to
 632 proceed. To make sure that access control is correct, the
 633 C<$flagsrequired> parameter must be specified correctly.
 634
 635 Koha also has a concept of sub-permissions, also known as
 636 granular permissions.  This makes the value of each key
 637 in the C<flagsrequired> hash take on an additional
 638 meaning, i.e.,
 639
 640  1
 641
 642 The user must have access to all subfunctions of the module
 643 specified by the hash key.
 644
 645  *
 646
 647 The user must have access to at least one subfunction of the module
 648 specified by the hash key.
 649
 650  specific permission, e.g., 'export_catalog'
 651
 652 The user must have access to the specific subfunction list, which
 653 must correspond to a row in the permissions table.
 654
 655 The C<$type> argument specifies whether the template should be
 656 retrieved from the opac or intranet directory tree.  "opac" is
 657 assumed if it is not specified; however, if C<$type> is specified,
 658 "intranet" is assumed if it is not "opac".
 659
 660 If C<$query> does not have a valid session ID associated with it
 661 (i.e., the user has not logged in) or if the session has expired,
 662 C<&checkauth> presents the user with a login page (from the point of
 663 view of the original script, C<&checkauth> does not return). Once the
 664 user has authenticated, C<&checkauth> restarts the original script
 665 (this time, C<&checkauth> returns).
 666
 667 The login page is provided using a HTML::Template, which is set in the
 668 systempreferences table or at the top of this file. The variable C<$type>
 669 selects which template to use, either the opac or the intranet
 670 authentification template.
 671
 672 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 673 cookie should be sent back to the browser; it verifies that the user
 674 has authenticated.
 675
 676 =cut
 677
 678 sub _version_check {
 679     my $type  = shift;
 680     my $query = shift;
 681     my $version;
 682
 683     # If version syspref is unavailable, it means Koha is being installed,
 684     # and so we must redirect to OPAC maintenance page or to the WebInstaller
 685     # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
 686     if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
 687         warn "OPAC Install required, redirecting to maintenance";
 688         print $query->redirect("/cgi-bin/koha/maintenance.pl");
 689         safe_exit;
 690     }
 691     unless ( $version = C4::Context->preference('Version') ) {    # assignment, not comparison
 692         if ( $type ne 'opac' ) {
 693             warn "Install required, redirecting to Installer";
 694             print $query->redirect("/cgi-bin/koha/installer/install.pl");
 695         } else {
 696             warn "OPAC Install required, redirecting to maintenance";
 697             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 698         }
 699         safe_exit;
 700     }
 701
 702     # check that database and koha version are the same
 703     # there is no DB version, it's a fresh install,
 704     # go to web installer
 705     # there is a DB version, compare it to the code version
 706     my $kohaversion = Koha::version();
 707
 708     # remove the 3 last . to have a Perl number
 709     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 710     $debug and print STDERR "kohaversion : $kohaversion\n";
 711     if ( $version < $kohaversion ) {
 712         my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
 713         if ( $type ne 'opac' ) {
 714             warn sprintf( $warning, 'Installer' );
 715             print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
 716         } else {
 717             warn sprintf( "OPAC: " . $warning, 'maintenance' );
 718             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 719         }
 720         safe_exit;
 721     }
 722 }
 723
 724 sub _session_log {
 725     (@_) or return 0;
 726     open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
 727     printf $fh join( "\n", @_ );
 728     close $fh;
 729 }
 730
 731 sub _timeout_syspref {
 732     my $timeout = C4::Context->preference('timeout') || 600;
 733
 734     # value in days, convert in seconds
 735     if ( $timeout =~ /(\d+)[dD]/ ) {
 736         $timeout = $1 * 86400;
 737     }
 738     return $timeout;
 739 }
 740
 741 sub checkauth {
 742     my $query = shift;
 743     $debug and warn "Checking Auth";
 744
 745     # $authnotrequired will be set for scripts which will run without authentication
 746     my $authnotrequired = shift;
 747     my $flagsrequired   = shift;
 748     my $type            = shift;
 749     my $persona         = shift;
 750     $type = 'opac' unless $type;
 751
 752     my $dbh     = C4::Context->dbh;
 753     my $timeout = _timeout_syspref();
 754
 755     _version_check( $type, $query );
 756
 757     # state variables
 758     my $loggedin = 0;
 759     my %info;
 760     my ( $userid, $cookie, $sessionID, $flags );
 761     my $logout = $query->param('logout.x');
 762
 763     my $anon_search_history;
 764
 765     # This parameter is the name of the CAS server we want to authenticate against,
 766     # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
 767     my $casparam = $query->param('cas');
 768     my $q_userid = $query->param('userid') // '';
 769
 770     # Basic authentication is incompatible with the use of Shibboleth,
 771     # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
 772     # and it may not be the attribute we want to use to match the koha login.
 773     #
 774     # Also, do not consider an empty REMOTE_USER.
 775     #
 776     # Finally, after those tests, we can assume (although if it would be better with
 777     # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
 778     # and we can affect it to $userid.
 779     if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
 780
 781         # Using Basic Authentication, no cookies required
 782         $cookie = $query->cookie(
 783             -name     => 'CGISESSID',
 784             -value    => '',
 785             -expires  => '',
 786             -HttpOnly => 1,
 787         );
 788         $loggedin = 1;
 789     }
 790     elsif ($persona) {
 791
 792         # we don't want to set a session because we are being called by a persona callback
 793     }
 794     elsif ( $sessionID = $query->cookie("CGISESSID") )
 795     {    # assignment, not comparison
 796         my $session = get_session($sessionID);
 797         C4::Context->_new_userenv($sessionID);
 798         my ( $ip, $lasttime, $sessiontype );
 799         my $s_userid = '';
 800         if ($session) {
 801             $s_userid = $session->param('id') // '';
 802             C4::Context->set_userenv(
 803                 $session->param('number'),       $s_userid,
 804                 $session->param('cardnumber'),   $session->param('firstname'),
 805                 $session->param('surname'),      $session->param('branch'),
 806                 $session->param('branchname'),   $session->param('flags'),
 807                 $session->param('emailaddress'), $session->param('branchprinter'),
 808                 $session->param('persona'),      $session->param('shibboleth')
 809             );
 810             C4::Context::set_shelves_userenv( 'bar', $session->param('barshelves') );
 811             C4::Context::set_shelves_userenv( 'pub', $session->param('pubshelves') );
 812             C4::Context::set_shelves_userenv( 'tot', $session->param('totshelves') );
 813             $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
 814             $ip          = $session->param('ip');
 815             $lasttime    = $session->param('lasttime');
 816             $userid      = $s_userid;
 817             $sessiontype = $session->param('sessiontype') || '';
 818         }
 819         if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
 820             || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
 821             || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
 822         ) {
 823
 824             #if a user enters an id ne to the id in the current session, we need to log them in...
 825             #first we need to clear the anonymous session...
 826             $debug and warn "query id = $q_userid but session id = $s_userid";
 827             $anon_search_history = $session->param('search_history');
 828             $session->delete();
 829             $session->flush;
 830             C4::Context->_unset_userenv($sessionID);
 831             $sessionID = undef;
 832             $userid    = undef;
 833         }
 834         elsif ($logout) {
 835
 836             # voluntary logout the user
 837             # check wether the user was using their shibboleth session or a local one
 838             my $shibSuccess = C4::Context->userenv->{'shibboleth'};
 839             $session->delete();
 840             $session->flush;
 841             C4::Context->_unset_userenv($sessionID);
 842
 843             #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
 844             $sessionID = undef;
 845             $userid    = undef;
 846
 847             if ($cas and $caslogout) {
 848                 logout_cas($query, $type);
 849             }
 850
 851             # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
 852             if ( $shib and $shib_login and $shibSuccess and $type eq 'opac' ) {
 853
 854                 # (Note: $type eq 'opac' condition should be removed when shibboleth authentication for intranet will be implemented)
 855                 logout_shib($query);
 856             }
 857         }
 858         elsif ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
 859
 860             # timed logout
 861             $info{'timed_out'} = 1;
 862             if ($session) {
 863                 $session->delete();
 864                 $session->flush;
 865             }
 866             C4::Context->_unset_userenv($sessionID);
 867
 868             #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
 869             $userid    = undef;
 870             $sessionID = undef;
 871         }
 872         elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
 873
 874             # Different ip than originally logged in from
 875             $info{'oldip'}        = $ip;
 876             $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 877             $info{'different_ip'} = 1;
 878             $session->delete();
 879             $session->flush;
 880             C4::Context->_unset_userenv($sessionID);
 881
 882             #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
 883             $sessionID = undef;
 884             $userid    = undef;
 885         }
 886         else {
 887             $cookie = $query->cookie(
 888                 -name     => 'CGISESSID',
 889                 -value    => $session->id,
 890                 -HttpOnly => 1
 891             );
 892             $session->param( 'lasttime', time() );
 893             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...
 894                 $flags = haspermission( $userid, $flagsrequired );
 895                 if ($flags) {
 896                     $loggedin = 1;
 897                 } else {
 898                     $info{'nopermission'} = 1;
 899                 }
 900             }
 901         }
 902     }
 903     unless ( $userid || $sessionID ) {
 904
 905         #we initiate a session prior to checking for a username to allow for anonymous sessions...
 906         my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
 907
 908         # Save anonymous search history in new session so it can be retrieved
 909         # by get_template_and_user to store it in user's search history after
 910         # a successful login.
 911         if ($anon_search_history) {
 912             $session->param( 'search_history', $anon_search_history );
 913         }
 914
 915         my $sessionID = $session->id;
 916         C4::Context->_new_userenv($sessionID);
 917         $cookie = $query->cookie(
 918             -name     => 'CGISESSID',
 919             -value    => $session->id,
 920             -HttpOnly => 1
 921         );
 922         $userid = $q_userid;
 923         my $pki_field = C4::Context->preference('AllowPKIAuth');
 924         if ( !defined($pki_field) ) {
 925             print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
 926             $pki_field = 'None';
 927         }
 928         if ( ( $cas && $query->param('ticket') )
 929             || $userid
 930             || ( $shib && $shib_login )
 931             || $pki_field ne 'None'
 932             || $persona )
 933         {
 934             my $password    = $query->param('password');
 935             my $shibSuccess = 0;
 936
 937             my ( $return, $cardnumber );
 938
 939             # If shib is enabled and we have a shib login, does the login match a valid koha user
 940             if ( $shib && $shib_login && $type eq 'opac' ) {
 941                 my $retuserid;
 942
 943                 # Do not pass password here, else shib will not be checked in checkpw.
 944                 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $userid, undef, $query );
 945                 $userid      = $retuserid;
 946                 $shibSuccess = $return;
 947                 $info{'invalidShibLogin'} = 1 unless ($return);
 948             }
 949
 950             # If shib login and match were successful, skip further login methods
 951             unless ($shibSuccess) {
 952                 if ( $cas && $query->param('ticket') ) {
 953                     my $retuserid;
 954                     ( $return, $cardnumber, $retuserid ) =
 955                       checkpw( $dbh, $userid, $password, $query, $type );
 956                     $userid = $retuserid;
 957                     $info{'invalidCasLogin'} = 1 unless ($return);
 958                 }
 959
 960                 elsif ($persona) {
 961                     my $value = $persona;
 962
 963                     # If we're looking up the email, there's a chance that the person
 964                     # doesn't have a userid. So if there is none, we pass along the
 965                     # borrower number, and the bits of code that need to know the user
 966                     # ID will have to be smart enough to handle that.
 967                     require C4::Members;
 968                     my @users_info = C4::Members::GetBorrowersWithEmail($value);
 969                     if (@users_info) {
 970
 971                         # First the userid, then the borrowernum
 972                         $value = $users_info[0][1] || $users_info[0][0];
 973                     }
 974                     else {
 975                         undef $value;
 976                     }
 977                     $return = $value ? 1 : 0;
 978                     $userid = $value;
 979                 }
 980
 981                 elsif (
 982                     ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
 983                     || ( $pki_field eq 'emailAddress'
 984                         && $ENV{'SSL_CLIENT_S_DN_Email'} )
 985                   )
 986                 {
 987                     my $value;
 988                     if ( $pki_field eq 'Common Name' ) {
 989                         $value = $ENV{'SSL_CLIENT_S_DN_CN'};
 990                     }
 991                     elsif ( $pki_field eq 'emailAddress' ) {
 992                         $value = $ENV{'SSL_CLIENT_S_DN_Email'};
 993
 994                         # If we're looking up the email, there's a chance that the person
 995                         # doesn't have a userid. So if there is none, we pass along the
 996                         # borrower number, and the bits of code that need to know the user
 997                         # ID will have to be smart enough to handle that.
 998                         require C4::Members;
 999                         my @users_info = C4::Members::GetBorrowersWithEmail($value);
1000                         if (@users_info) {
1001
1002                             # First the userid, then the borrowernum
1003                             $value = $users_info[0][1] || $users_info[0][0];
1004                         } else {
1005                             undef $value;
1006                         }
1007                     }
1008
1009                     $return = $value ? 1 : 0;
1010                     $userid = $value;
1011
1012                 }
1013                 else {
1014                     my $retuserid;
1015                     ( $return, $cardnumber, $retuserid ) =
1016                       checkpw( $dbh, $userid, $password, $query, $type );
1017                     $userid = $retuserid if ($retuserid);
1018                     $info{'invalid_username_or_password'} = 1 unless ($return);
1019                 }
1020             }
1021
1022             # $return: 1 = valid user, 2 = superlibrarian
1023             if ($return) {
1024
1025                 #_session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
1026                 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1027                     $loggedin = 1;
1028                 }
1029                 else {
1030                     $info{'nopermission'} = 1;
1031                     C4::Context->_unset_userenv($sessionID);
1032                 }
1033                 my ( $borrowernumber, $firstname, $surname, $userflags,
1034                     $branchcode, $branchname, $branchprinter, $emailaddress );
1035
1036                 if ( $return == 1 ) {
1037                     my $select = "
1038                     SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1039                     branches.branchname    as branchname,
1040                     branches.branchprinter as branchprinter,
1041                     email
1042                     FROM borrowers
1043                     LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1044                     ";
1045                     my $sth = $dbh->prepare("$select where userid=?");
1046                     $sth->execute($userid);
1047                     unless ( $sth->rows ) {
1048                         $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
1049                         $sth = $dbh->prepare("$select where cardnumber=?");
1050                         $sth->execute($cardnumber);
1051
1052                         unless ( $sth->rows ) {
1053                             $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1054                             $sth->execute($userid);
1055                             unless ( $sth->rows ) {
1056                                 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1057                             }
1058                         }
1059                     }
1060                     if ( $sth->rows ) {
1061                         ( $borrowernumber, $firstname, $surname, $userflags,
1062                             $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow;
1063                         $debug and print STDERR "AUTH_3 results: " .
1064                           "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1065                     } else {
1066                         print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1067                     }
1068
1069                     # launch a sequence to check if we have a ip for the branch, i
1070                     # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1071
1072                     my $ip = $ENV{'REMOTE_ADDR'};
1073
1074                     # if they specify at login, use that
1075                     if ( $query->param('branch') ) {
1076                         $branchcode = $query->param('branch');
1077                         $branchname = GetBranchName($branchcode);
1078                     }
1079                     my $branches = GetBranches();
1080                     if ( C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation') ) {
1081
1082                         # we have to check they are coming from the right ip range
1083                         my $domain = $branches->{$branchcode}->{'branchip'};
1084                         if ( $ip !~ /^$domain/ ) {
1085                             $loggedin = 0;
1086                             $info{'wrongip'} = 1;
1087                         }
1088                     }
1089
1090                     my @branchesloop;
1091                     foreach my $br ( keys %$branches ) {
1092
1093                         #     now we work with the treatment of ip
1094                         my $domain = $branches->{$br}->{'branchip'};
1095                         if ( $domain && $ip =~ /^$domain/ ) {
1096                             $branchcode = $branches->{$br}->{'branchcode'};
1097
1098                             # new op dev : add the branchprinter and branchname in the cookie
1099                             $branchprinter = $branches->{$br}->{'branchprinter'};
1100                             $branchname    = $branches->{$br}->{'branchname'};
1101                         }
1102                     }
1103                     $session->param( 'number',       $borrowernumber );
1104                     $session->param( 'id',           $userid );
1105                     $session->param( 'cardnumber',   $cardnumber );
1106                     $session->param( 'firstname',    $firstname );
1107                     $session->param( 'surname',      $surname );
1108                     $session->param( 'branch',       $branchcode );
1109                     $session->param( 'branchname',   $branchname );
1110                     $session->param( 'flags',        $userflags );
1111                     $session->param( 'emailaddress', $emailaddress );
1112                     $session->param( 'ip',           $session->remote_addr() );
1113                     $session->param( 'lasttime',     time() );
1114                     $session->param( 'shibboleth',   $shibSuccess );
1115                     $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1116                 }
1117                 elsif ( $return == 2 ) {
1118
1119                     #We suppose the user is the superlibrarian
1120                     $borrowernumber = 0;
1121                     $session->param( 'number',       0 );
1122                     $session->param( 'id',           C4::Context->config('user') );
1123                     $session->param( 'cardnumber',   C4::Context->config('user') );
1124                     $session->param( 'firstname',    C4::Context->config('user') );
1125                     $session->param( 'surname',      C4::Context->config('user') );
1126                     $session->param( 'branch',       'NO_LIBRARY_SET' );
1127                     $session->param( 'branchname',   'NO_LIBRARY_SET' );
1128                     $session->param( 'flags',        1 );
1129                     $session->param( 'emailaddress', C4::Context->preference('KohaAdminEmailAddress') );
1130                     $session->param( 'ip',           $session->remote_addr() );
1131                     $session->param( 'lasttime',     time() );
1132                 }
1133                 if ($persona) {
1134                     $session->param( 'persona', 1 );
1135                 }
1136                 C4::Context->set_userenv(
1137                     $session->param('number'),       $session->param('id'),
1138                     $session->param('cardnumber'),   $session->param('firstname'),
1139                     $session->param('surname'),      $session->param('branch'),
1140                     $session->param('branchname'),   $session->param('flags'),
1141                     $session->param('emailaddress'), $session->param('branchprinter'),
1142                     $session->param('persona'),      $session->param('shibboleth')
1143                 );
1144
1145             }
1146             # $return: 0 = invalid user
1147             # reset to anonymous session
1148             else {
1149                 $debug and warn "Login failed, resetting anonymous session...";
1150                 if ($userid) {
1151                     $info{'invalid_username_or_password'} = 1;
1152                     C4::Context->_unset_userenv($sessionID);
1153                 }
1154                 $session->param( 'lasttime', time() );
1155                 $session->param( 'ip',       $session->remote_addr() );
1156                 $session->param( 'sessiontype', 'anon' );
1157             }
1158         }    # END if ( $userid    = $query->param('userid') )
1159         elsif ( $type eq "opac" ) {
1160
1161             # if we are here this is an anonymous session; add public lists to it and a few other items...
1162             # anonymous sessions are created only for the OPAC
1163             $debug and warn "Initiating an anonymous session...";
1164
1165             # setting a couple of other session vars...
1166             $session->param( 'ip',          $session->remote_addr() );
1167             $session->param( 'lasttime',    time() );
1168             $session->param( 'sessiontype', 'anon' );
1169         }
1170     }    # END unless ($userid)
1171
1172     # finished authentification, now respond
1173     if ( $loggedin || $authnotrequired )
1174     {
1175         # successful login
1176         unless ($cookie) {
1177             $cookie = $query->cookie(
1178                 -name     => 'CGISESSID',
1179                 -value    => '',
1180                 -HttpOnly => 1
1181             );
1182         }
1183         return ( $userid, $cookie, $sessionID, $flags );
1184     }
1185
1186     #
1187     #
1188     # AUTH rejected, show the login/password template, after checking the DB.
1189     #
1190     #
1191
1192     # get the inputs from the incoming query
1193     my @inputs = ();
1194     foreach my $name ( param $query) {
1195         (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1196         my $value = $query->param($name);
1197         push @inputs, { name => $name, value => $value };
1198     }
1199
1200     my $LibraryNameTitle = C4::Context->preference("LibraryName");
1201     $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1202     $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1203
1204     my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1205     my $template = C4::Templates::gettemplate( $template_name, $type, $query );
1206     $template->param(
1207         branchloop                            => GetBranchesLoop(),
1208         OpacAdditionalStylesheet                   => C4::Context->preference("OpacAdditionalStylesheet"),
1209         opaclayoutstylesheet                  => C4::Context->preference("opaclayoutstylesheet"),
1210         login                                 => 1,
1211         INPUTS                                => \@inputs,
1212         casAuthentication                     => C4::Context->preference("casAuthentication"),
1213         shibbolethAuthentication              => $shib,
1214         SessionRestrictionByIP                => C4::Context->preference("SessionRestrictionByIP"),
1215         suggestion                            => C4::Context->preference("suggestion"),
1216         virtualshelves                        => C4::Context->preference("virtualshelves"),
1217         LibraryName                           => "" . C4::Context->preference("LibraryName"),
1218         LibraryNameTitle                      => "" . $LibraryNameTitle,
1219         opacuserlogin                         => C4::Context->preference("opacuserlogin"),
1220         OpacNav                               => C4::Context->preference("OpacNav"),
1221         OpacNavRight                          => C4::Context->preference("OpacNavRight"),
1222         OpacNavBottom                         => C4::Context->preference("OpacNavBottom"),
1223         opaccredits                           => C4::Context->preference("opaccredits"),
1224         OpacFavicon                           => C4::Context->preference("OpacFavicon"),
1225         opacreadinghistory                    => C4::Context->preference("opacreadinghistory"),
1226         opaclanguagesdisplay                  => C4::Context->preference("opaclanguagesdisplay"),
1227         OPACUserJS                            => C4::Context->preference("OPACUserJS"),
1228         opacbookbag                           => "" . C4::Context->preference("opacbookbag"),
1229         OpacCloud                             => C4::Context->preference("OpacCloud"),
1230         OpacTopissue                          => C4::Context->preference("OpacTopissue"),
1231         OpacAuthorities                       => C4::Context->preference("OpacAuthorities"),
1232         OpacBrowser                           => C4::Context->preference("OpacBrowser"),
1233         opacheader                            => C4::Context->preference("opacheader"),
1234         TagsEnabled                           => C4::Context->preference("TagsEnabled"),
1235         OPACUserCSS                           => C4::Context->preference("OPACUserCSS"),
1236         intranetcolorstylesheet               => C4::Context->preference("intranetcolorstylesheet"),
1237         intranetstylesheet                    => C4::Context->preference("intranetstylesheet"),
1238         intranetbookbag                       => C4::Context->preference("intranetbookbag"),
1239         IntranetNav                           => C4::Context->preference("IntranetNav"),
1240         IntranetFavicon                       => C4::Context->preference("IntranetFavicon"),
1241         IntranetUserCSS                       => C4::Context->preference("IntranetUserCSS"),
1242         IntranetUserJS                        => C4::Context->preference("IntranetUserJS"),
1243         IndependentBranches                   => C4::Context->preference("IndependentBranches"),
1244         AutoLocation                          => C4::Context->preference("AutoLocation"),
1245         wrongip                               => $info{'wrongip'},
1246         PatronSelfRegistration                => C4::Context->preference("PatronSelfRegistration"),
1247         PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1248         persona                               => C4::Context->preference("Persona"),
1249         opac_css_override                     => $ENV{'OPAC_CSS_OVERRIDE'},
1250     );
1251
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