C4/Auth.pm

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