C4/Auth.pm

   1 package C4::Auth;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use strict;
  21 use warnings;
  22 use Digest::MD5 qw(md5_base64);
  23 use File::Spec;
  24 use JSON qw/encode_json/;
  25 use URI::Escape;
  26 use CGI::Session;
  27
  28 require Exporter;
  29 use C4::Context;
  30 use C4::Templates;    # to get the template
  31 use C4::Languages;
  32 use C4::Branch;       # GetBranches
  33 use C4::Search::History;
  34 use Koha;
  35 use Koha::Caches;
  36 use Koha::AuthUtils qw(get_script_name hash_password);
  37 use Koha::Libraries;
  38 use Koha::LibraryCategories;
  39 use Koha::Libraries;
  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
  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 he tries to go out 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 (  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);
 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             foreach my $module ( keys %$all_perms ) {
 288
 289                 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
 290                     $template->param( "CAN_user_${module}_${subperm}" => 1 );
 291                 }
 292             }
 293         }
 294
 295         if ($flags) {
 296             foreach my $module ( keys %$all_perms ) {
 297                 if ( defined($flags->{$module}) && $flags->{$module} == 1 ) {
 298                     foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
 299                         $template->param( "CAN_user_${module}_${subperm}" => 1 );
 300                     }
 301                 } elsif ( ref( $flags->{$module} ) ) {
 302                     foreach my $subperm ( keys %{ $flags->{$module} } ) {
 303                         $template->param( "CAN_user_${module}_${subperm}" => 1 );
 304                     }
 305                 }
 306             }
 307         }
 308
 309         if ($flags) {
 310             foreach my $module ( keys %$flags ) {
 311                 if ( $flags->{$module} == 1 or ref( $flags->{$module} ) ) {
 312                     $template->param( "CAN_user_$module" => 1 );
 313                     if ( $module eq "parameters" ) {
 314                         $template->param( CAN_user_management => 1 );
 315                     }
 316                 }
 317             }
 318         }
 319
 320         # Logged-in opac search history
 321         # If the requested template is an opac one and opac search history is enabled
 322         if ( $in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory') ) {
 323             my $dbh   = C4::Context->dbh;
 324             my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
 325             my $sth   = $dbh->prepare($query);
 326             $sth->execute($borrowernumber);
 327
 328             # If at least one search has already been performed
 329             if ( $sth->fetchrow_array > 0 ) {
 330
 331                 # We show the link in opac
 332                 $template->param( EnableOpacSearchHistory => 1 );
 333             }
 334
 335             # And if there are searches performed when the user was not logged in,
 336             # we add them to the logged-in search history
 337             my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
 338             if (@recentSearches) {
 339                 my $dbh   = C4::Context->dbh;
 340                 my $query = q{
 341                     INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, type,  total, time )
 342                     VALUES (?, ?, ?, ?, ?, ?, ?)
 343                 };
 344
 345                 my $sth = $dbh->prepare($query);
 346                 $sth->execute( $borrowernumber,
 347                     $in->{query}->cookie("CGISESSID"),
 348                     $_->{query_desc},
 349                     $_->{query_cgi},
 350                     $_->{type} || 'biblio',
 351                     $_->{total},
 352                     $_->{time},
 353                 ) foreach @recentSearches;
 354
 355                 # clear out the search history from the session now that
 356                 # we've saved it to the database
 357                 C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } );
 358             }
 359         } elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) {
 360             $template->param( EnableSearchHistory => 1 );
 361         }
 362     }
 363     else {    # if this is an anonymous session, setup to display public lists...
 364
 365         # If shibboleth is enabled, and we're in an anonymous session, we should allow
 366         # the user to attempt login via shibboleth.
 367         if ($shib) {
 368             $template->param( shibbolethAuthentication => $shib,
 369                 shibbolethLoginUrl => login_shib_url( $in->{'query'} ),
 370             );
 371
 372             # If shibboleth is enabled and we have a shibboleth login attribute,
 373             # but we are in an anonymous session, then we clearly have an invalid
 374             # shibboleth koha account.
 375             if ($shib_login) {
 376                 $template->param( invalidShibLogin => '1' );
 377             }
 378         }
 379
 380         $template->param( sessionID => $sessionID );
 381
 382         if ( $in->{'type'} eq 'opac' ){
 383             require Koha::Virtualshelves;
 384             my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
 385                 {
 386                     category       => 2,
 387                 }
 388             );
 389             $template->param(
 390                 some_public_shelves  => $some_public_shelves,
 391             );
 392         }
 393     }
 394
 395     # Anonymous opac search history
 396     # If opac search history is enabled and at least one search has already been performed
 397     if ( C4::Context->preference('EnableOpacSearchHistory') ) {
 398         my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
 399         if (@recentSearches) {
 400             $template->param( EnableOpacSearchHistory => 1 );
 401         }
 402     }
 403
 404     if ( C4::Context->preference('dateformat') ) {
 405         $template->param( dateformat => C4::Context->preference('dateformat') );
 406     }
 407
 408     $template->param(auth_forwarded_hash => scalar $in->{'query'}->param('auth_forwarded_hash'));
 409
 410     # these template parameters are set the same regardless of $in->{'type'}
 411
 412     # Set the using_https variable for templates
 413     # FIXME Under Plack the CGI->https method always returns 'OFF'
 414     my $https = $in->{query}->https();
 415     my $using_https = ( defined $https and $https ne 'OFF' ) ? 1 : 0;
 416
 417     $template->param(
 418         "BiblioDefaultView" . C4::Context->preference("BiblioDefaultView") => 1,
 419         EnhancedMessagingPreferences                                       => C4::Context->preference('EnhancedMessagingPreferences'),
 420         GoogleJackets                                                      => C4::Context->preference("GoogleJackets"),
 421         OpenLibraryCovers                                                  => C4::Context->preference("OpenLibraryCovers"),
 422         KohaAdminEmailAddress                                              => "" . C4::Context->preference("KohaAdminEmailAddress"),
 423         LoginBranchcode => ( C4::Context->userenv ? C4::Context->userenv->{"branch"}    : undef ),
 424         LoginFirstname  => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
 425         LoginSurname    => C4::Context->userenv ? C4::Context->userenv->{"surname"}      : "Inconnu",
 426         emailaddress    => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
 427         loggedinpersona => C4::Context->userenv ? C4::Context->userenv->{"persona"}      : undef,
 428         TagsEnabled     => C4::Context->preference("TagsEnabled"),
 429         hide_marc       => C4::Context->preference("hide_marc"),
 430         item_level_itypes  => C4::Context->preference('item-level_itypes'),
 431         patronimages       => C4::Context->preference("patronimages"),
 432         singleBranchMode   => ( Koha::Libraries->search->count == 1 ),
 433         XSLTDetailsDisplay => C4::Context->preference("XSLTDetailsDisplay"),
 434         XSLTResultsDisplay => C4::Context->preference("XSLTResultsDisplay"),
 435         using_https        => $using_https,
 436         noItemTypeImages   => C4::Context->preference("noItemTypeImages"),
 437         marcflavour        => C4::Context->preference("marcflavour"),
 438         persona            => C4::Context->preference("persona"),
 439         OPACBaseURL        => C4::Context->preference('OPACBaseURL'),
 440     );
 441     if ( $in->{'type'} eq "intranet" ) {
 442         $template->param(
 443             AmazonCoverImages                                                          => C4::Context->preference("AmazonCoverImages"),
 444             AutoLocation                                                               => C4::Context->preference("AutoLocation"),
 445             "BiblioDefaultView" . C4::Context->preference("IntranetBiblioDefaultView") => 1,
 446             CircAutocompl                                                              => C4::Context->preference("CircAutocompl"),
 447             FRBRizeEditions                                                            => C4::Context->preference("FRBRizeEditions"),
 448             IndependentBranches                                                        => C4::Context->preference("IndependentBranches"),
 449             IntranetNav                                                                => C4::Context->preference("IntranetNav"),
 450             IntranetmainUserblock                                                      => C4::Context->preference("IntranetmainUserblock"),
 451             LibraryName                                                                => C4::Context->preference("LibraryName"),
 452             LoginBranchname                                                            => ( C4::Context->userenv ? C4::Context->userenv->{"branchname"} : undef ),
 453             advancedMARCEditor                                                         => C4::Context->preference("advancedMARCEditor"),
 454             canreservefromotherbranches                                                => C4::Context->preference('canreservefromotherbranches'),
 455             intranetcolorstylesheet                                                    => C4::Context->preference("intranetcolorstylesheet"),
 456             IntranetFavicon                                                            => C4::Context->preference("IntranetFavicon"),
 457             intranetreadinghistory                                                     => C4::Context->preference("intranetreadinghistory"),
 458             intranetstylesheet                                                         => C4::Context->preference("intranetstylesheet"),
 459             IntranetUserCSS                                                            => C4::Context->preference("IntranetUserCSS"),
 460             IntranetUserJS                                                             => C4::Context->preference("IntranetUserJS"),
 461             intranetbookbag                                                            => C4::Context->preference("intranetbookbag"),
 462             suggestion                                                                 => C4::Context->preference("suggestion"),
 463             virtualshelves                                                             => C4::Context->preference("virtualshelves"),
 464             StaffSerialIssueDisplayCount                                               => C4::Context->preference("StaffSerialIssueDisplayCount"),
 465             EasyAnalyticalRecords                                                      => C4::Context->preference('EasyAnalyticalRecords'),
 466             LocalCoverImages                                                           => C4::Context->preference('LocalCoverImages'),
 467             OPACLocalCoverImages                                                       => C4::Context->preference('OPACLocalCoverImages'),
 468             AllowMultipleCovers                                                        => C4::Context->preference('AllowMultipleCovers'),
 469             EnableBorrowerFiles                                                        => C4::Context->preference('EnableBorrowerFiles'),
 470             UseKohaPlugins                                                             => C4::Context->preference('UseKohaPlugins'),
 471             UseCourseReserves                                                          => C4::Context->preference("UseCourseReserves"),
 472             useDischarge                                                               => C4::Context->preference('useDischarge'),
 473         );
 474     }
 475     else {
 476         warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
 477
 478         #TODO : replace LibraryName syspref with 'system name', and remove this html processing
 479         my $LibraryNameTitle = C4::Context->preference("LibraryName");
 480         $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
 481         $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
 482
 483         # clean up the busc param in the session
 484         # if the page is not opac-detail and not the "add to list" page
 485         # and not the "edit comments" page
 486         if ( C4::Context->preference("OpacBrowseResults")
 487             && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
 488             my $pagename = $1;
 489             unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
 490                 or $pagename =~ /^addbybiblionumber$/
 491                 or $pagename =~ /^review$/ ) {
 492                 my $sessionSearch = get_session( $sessionID || $in->{'query'}->cookie("CGISESSID") );
 493                 $sessionSearch->clear( ["busc"] ) if ( $sessionSearch->param("busc") );
 494             }
 495         }
 496
 497         # variables passed from CGI: opac_css_override and opac_search_limits.
 498         my $opac_search_limit   = $ENV{'OPAC_SEARCH_LIMIT'};
 499         my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
 500         my $opac_name           = '';
 501         if (
 502             ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:(\w+)/ ) ||
 503             ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:(\w+)/ ) ||
 504             ( $in->{'query'}->param('multibranchlimit') && $in->{'query'}->param('multibranchlimit') =~ /multibranchlimit-(\w+)/ )
 505           ) {
 506             $opac_name = $1;    # opac_search_limit is a branch, so we use it.
 507         } elsif ( $in->{'query'}->param('multibranchlimit') ) {
 508             $opac_name = $in->{'query'}->param('multibranchlimit');
 509         } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
 510             $opac_name = C4::Context->userenv->{'branch'};
 511         }
 512
 513         my $library_categories = Koha::LibraryCategories->search({categorytype => 'searchdomain', show_in_pulldown => 1}, { order_by => ['categorytype', 'categorycode']});
 514         $template->param(
 515             OpacAdditionalStylesheet                   => C4::Context->preference("OpacAdditionalStylesheet"),
 516             AnonSuggestions                       => "" . C4::Context->preference("AnonSuggestions"),
 517             BranchesLoop                          => GetBranchesLoop($opac_name),
 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 $persona         = 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     # Basic authentication is incompatible with the use of Shibboleth,
 775     # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
 776     # and it may not be the attribute we want to use to match the koha login.
 777     #
 778     # Also, do not consider an empty REMOTE_USER.
 779     #
 780     # Finally, after those tests, we can assume (although if it would be better with
 781     # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
 782     # and we can affect it to $userid.
 783     if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
 784
 785         # Using Basic Authentication, no cookies required
 786         $cookie = $query->cookie(
 787             -name     => 'CGISESSID',
 788             -value    => '',
 789             -expires  => '',
 790             -HttpOnly => 1,
 791         );
 792         $loggedin = 1;
 793     }
 794     elsif ($persona) {
 795
 796         # we don't want to set a session because we are being called by a persona callback
 797     }
 798     elsif ( $sessionID = $query->cookie("CGISESSID") )
 799     {    # assignment, not comparison
 800         my $session = get_session($sessionID);
 801         C4::Context->_new_userenv($sessionID);
 802         my ( $ip, $lasttime, $sessiontype );
 803         my $s_userid = '';
 804         if ($session) {
 805             $s_userid = $session->param('id') // '';
 806             C4::Context->set_userenv(
 807                 $session->param('number'),       $s_userid,
 808                 $session->param('cardnumber'),   $session->param('firstname'),
 809                 $session->param('surname'),      $session->param('branch'),
 810                 $session->param('branchname'),   $session->param('flags'),
 811                 $session->param('emailaddress'), $session->param('branchprinter'),
 812                 $session->param('persona'),      $session->param('shibboleth')
 813             );
 814             C4::Context::set_shelves_userenv( 'bar', $session->param('barshelves') );
 815             C4::Context::set_shelves_userenv( 'pub', $session->param('pubshelves') );
 816             C4::Context::set_shelves_userenv( 'tot', $session->param('totshelves') );
 817             $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
 818             $ip          = $session->param('ip');
 819             $lasttime    = $session->param('lasttime');
 820             $userid      = $s_userid;
 821             $sessiontype = $session->param('sessiontype') || '';
 822         }
 823         if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
 824             || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
 825             || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
 826         ) {
 827
 828             #if a user enters an id ne to the id in the current session, we need to log them in...
 829             #first we need to clear the anonymous session...
 830             $debug and warn "query id = $q_userid but session id = $s_userid";
 831             $anon_search_history = $session->param('search_history');
 832             $session->delete();
 833             $session->flush;
 834             C4::Context->_unset_userenv($sessionID);
 835             $sessionID = undef;
 836             $userid    = undef;
 837         }
 838         elsif ($logout) {
 839
 840             # voluntary logout the user
 841             # check wether the user was using their shibboleth session or a local one
 842             my $shibSuccess = C4::Context->userenv->{'shibboleth'};
 843             $session->delete();
 844             $session->flush;
 845             C4::Context->_unset_userenv($sessionID);
 846
 847             #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
 848             $sessionID = undef;
 849             $userid    = undef;
 850
 851             if ($cas and $caslogout) {
 852                 logout_cas($query, $type);
 853             }
 854
 855             # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
 856             if ( $shib and $shib_login and $shibSuccess and $type eq 'opac' ) {
 857
 858                 # (Note: $type eq 'opac' condition should be removed when shibboleth authentication for intranet will be implemented)
 859                 logout_shib($query);
 860             }
 861         }
 862         elsif ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
 863
 864             # timed logout
 865             $info{'timed_out'} = 1;
 866             if ($session) {
 867                 $session->delete();
 868                 $session->flush;
 869             }
 870             C4::Context->_unset_userenv($sessionID);
 871
 872             #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
 873             $userid    = undef;
 874             $sessionID = undef;
 875         }
 876         elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
 877
 878             # Different ip than originally logged in from
 879             $info{'oldip'}        = $ip;
 880             $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 881             $info{'different_ip'} = 1;
 882             $session->delete();
 883             $session->flush;
 884             C4::Context->_unset_userenv($sessionID);
 885
 886             #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
 887             $sessionID = undef;
 888             $userid    = undef;
 889         }
 890         else {
 891             $cookie = $query->cookie(
 892                 -name     => 'CGISESSID',
 893                 -value    => $session->id,
 894                 -HttpOnly => 1
 895             );
 896             $session->param( 'lasttime', time() );
 897             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...
 898                 $flags = haspermission( $userid, $flagsrequired );
 899                 if ($flags) {
 900                     $loggedin = 1;
 901                 } else {
 902                     $info{'nopermission'} = 1;
 903                 }
 904             }
 905         }
 906     }
 907     unless ( $userid || $sessionID ) {
 908
 909         #we initiate a session prior to checking for a username to allow for anonymous sessions...
 910         my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
 911
 912         # Save anonymous search history in new session so it can be retrieved
 913         # by get_template_and_user to store it in user's search history after
 914         # a successful login.
 915         if ($anon_search_history) {
 916             $session->param( 'search_history', $anon_search_history );
 917         }
 918
 919         my $sessionID = $session->id;
 920         C4::Context->_new_userenv($sessionID);
 921         $cookie = $query->cookie(
 922             -name     => 'CGISESSID',
 923             -value    => $session->id,
 924             -HttpOnly => 1
 925         );
 926         $userid = $q_userid;
 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             || $userid
 934             || ( $shib && $shib_login )
 935             || $pki_field ne 'None'
 936             || $persona )
 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, $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 ($persona) {
 965                     my $value = $persona;
 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                     }
 978                     else {
 979                         undef $value;
 980                     }
 981                     $return = $value ? 1 : 0;
 982                     $userid = $value;
 983                 }
 984
 985                 elsif (
 986                     ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
 987                     || ( $pki_field eq 'emailAddress'
 988                         && $ENV{'SSL_CLIENT_S_DN_Email'} )
 989                   )
 990                 {
 991                     my $value;
 992                     if ( $pki_field eq 'Common Name' ) {
 993                         $value = $ENV{'SSL_CLIENT_S_DN_CN'};
 994                     }
 995                     elsif ( $pki_field eq 'emailAddress' ) {
 996                         $value = $ENV{'SSL_CLIENT_S_DN_Email'};
 997
 998                         # If we're looking up the email, there's a chance that the person
 999                         # doesn't have a userid. So if there is none, we pass along the
1000                         # borrower number, and the bits of code that need to know the user
1001                         # ID will have to be smart enough to handle that.
1002                         require C4::Members;
1003                         my @users_info = C4::Members::GetBorrowersWithEmail($value);
1004                         if (@users_info) {
1005
1006                             # First the userid, then the borrowernum
1007                             $value = $users_info[0][1] || $users_info[0][0];
1008                         } else {
1009                             undef $value;
1010                         }
1011                     }
1012
1013                     $return = $value ? 1 : 0;
1014                     $userid = $value;
1015
1016                 }
1017                 else {
1018                     my $retuserid;
1019                     ( $return, $cardnumber, $retuserid ) =
1020                       checkpw( $dbh, $userid, $password, $query, $type );
1021                     $userid = $retuserid if ($retuserid);
1022                     $info{'invalid_username_or_password'} = 1 unless ($return);
1023                 }
1024             }
1025
1026             # $return: 1 = valid user, 2 = superlibrarian
1027             if ($return) {
1028
1029                 #_session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
1030                 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1031                     $loggedin = 1;
1032                 }
1033                 else {
1034                     $info{'nopermission'} = 1;
1035                     C4::Context->_unset_userenv($sessionID);
1036                 }
1037                 my ( $borrowernumber, $firstname, $surname, $userflags,
1038                     $branchcode, $branchname, $branchprinter, $emailaddress );
1039
1040                 if ( $return == 1 ) {
1041                     my $select = "
1042                     SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1043                     branches.branchname    as branchname,
1044                     branches.branchprinter as branchprinter,
1045                     email
1046                     FROM borrowers
1047                     LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1048                     ";
1049                     my $sth = $dbh->prepare("$select where userid=?");
1050                     $sth->execute($userid);
1051                     unless ( $sth->rows ) {
1052                         $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
1053                         $sth = $dbh->prepare("$select where cardnumber=?");
1054                         $sth->execute($cardnumber);
1055
1056                         unless ( $sth->rows ) {
1057                             $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1058                             $sth->execute($userid);
1059                             unless ( $sth->rows ) {
1060                                 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1061                             }
1062                         }
1063                     }
1064                     if ( $sth->rows ) {
1065                         ( $borrowernumber, $firstname, $surname, $userflags,
1066                             $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow;
1067                         $debug and print STDERR "AUTH_3 results: " .
1068                           "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1069                     } else {
1070                         print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1071                     }
1072
1073                     # launch a sequence to check if we have a ip for the branch, i
1074                     # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1075
1076                     my $ip = $ENV{'REMOTE_ADDR'};
1077
1078                     # if they specify at login, use that
1079                     if ( $query->param('branch') ) {
1080                         $branchcode = $query->param('branch');
1081                         $branchname = Koha::Libraries->find($branchcode)->branchname;
1082                     }
1083                     my $branches = GetBranches();
1084                     if ( C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation') ) {
1085
1086                         # we have to check they are coming from the right ip range
1087                         my $domain = $branches->{$branchcode}->{'branchip'};
1088                         if ( $ip !~ /^$domain/ ) {
1089                             $loggedin = 0;
1090                             $info{'wrongip'} = 1;
1091                         }
1092                     }
1093
1094                     my @branchesloop;
1095                     foreach my $br ( keys %$branches ) {
1096
1097                         #     now we work with the treatment of ip
1098                         my $domain = $branches->{$br}->{'branchip'};
1099                         if ( $domain && $ip =~ /^$domain/ ) {
1100                             $branchcode = $branches->{$br}->{'branchcode'};
1101
1102                             # new op dev : add the branchprinter and branchname in the cookie
1103                             $branchprinter = $branches->{$br}->{'branchprinter'};
1104                             $branchname    = $branches->{$br}->{'branchname'};
1105                         }
1106                     }
1107                     $session->param( 'number',       $borrowernumber );
1108                     $session->param( 'id',           $userid );
1109                     $session->param( 'cardnumber',   $cardnumber );
1110                     $session->param( 'firstname',    $firstname );
1111                     $session->param( 'surname',      $surname );
1112                     $session->param( 'branch',       $branchcode );
1113                     $session->param( 'branchname',   $branchname );
1114                     $session->param( 'flags',        $userflags );
1115                     $session->param( 'emailaddress', $emailaddress );
1116                     $session->param( 'ip',           $session->remote_addr() );
1117                     $session->param( 'lasttime',     time() );
1118                     $session->param( 'shibboleth',   $shibSuccess );
1119                     $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1120                 }
1121                 elsif ( $return == 2 ) {
1122
1123                     #We suppose the user is the superlibrarian
1124                     $borrowernumber = 0;
1125                     $session->param( 'number',       0 );
1126                     $session->param( 'id',           C4::Context->config('user') );
1127                     $session->param( 'cardnumber',   C4::Context->config('user') );
1128                     $session->param( 'firstname',    C4::Context->config('user') );
1129                     $session->param( 'surname',      C4::Context->config('user') );
1130                     $session->param( 'branch',       'NO_LIBRARY_SET' );
1131                     $session->param( 'branchname',   'NO_LIBRARY_SET' );
1132                     $session->param( 'flags',        1 );
1133                     $session->param( 'emailaddress', C4::Context->preference('KohaAdminEmailAddress') );
1134                     $session->param( 'ip',           $session->remote_addr() );
1135                     $session->param( 'lasttime',     time() );
1136                 }
1137                 if ($persona) {
1138                     $session->param( 'persona', 1 );
1139                 }
1140                 C4::Context->set_userenv(
1141                     $session->param('number'),       $session->param('id'),
1142                     $session->param('cardnumber'),   $session->param('firstname'),
1143                     $session->param('surname'),      $session->param('branch'),
1144                     $session->param('branchname'),   $session->param('flags'),
1145                     $session->param('emailaddress'), $session->param('branchprinter'),
1146                     $session->param('persona'),      $session->param('shibboleth')
1147                 );
1148
1149             }
1150             # $return: 0 = invalid user
1151             # reset to anonymous session
1152             else {
1153                 $debug and warn "Login failed, resetting anonymous session...";
1154                 if ($userid) {
1155                     $info{'invalid_username_or_password'} = 1;
1156                     C4::Context->_unset_userenv($sessionID);
1157                 }
1158                 $session->param( 'lasttime', time() );
1159                 $session->param( 'ip',       $session->remote_addr() );
1160                 $session->param( 'sessiontype', 'anon' );
1161             }
1162         }    # END if ( $userid    = $query->param('userid') )
1163         elsif ( $type eq "opac" ) {
1164
1165             # if we are here this is an anonymous session; add public lists to it and a few other items...
1166             # anonymous sessions are created only for the OPAC
1167             $debug and warn "Initiating an anonymous session...";
1168
1169             # setting a couple of other session vars...
1170             $session->param( 'ip',          $session->remote_addr() );
1171             $session->param( 'lasttime',    time() );
1172             $session->param( 'sessiontype', 'anon' );
1173         }
1174     }    # END unless ($userid)
1175
1176     # finished authentification, now respond
1177     if ( $loggedin || $authnotrequired )
1178     {
1179         # successful login
1180         unless ($cookie) {
1181             $cookie = $query->cookie(
1182                 -name     => 'CGISESSID',
1183                 -value    => '',
1184                 -HttpOnly => 1
1185             );
1186         }
1187         return ( $userid, $cookie, $sessionID, $flags );
1188     }
1189
1190     #
1191     #
1192     # AUTH rejected, show the login/password template, after checking the DB.
1193     #
1194     #
1195
1196     # get the inputs from the incoming query
1197     my @inputs = ();
1198     foreach my $name ( param $query) {
1199         (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1200         my $value = $query->param($name);
1201         push @inputs, { name => $name, value => $value };
1202     }
1203
1204     my $LibraryNameTitle = C4::Context->preference("LibraryName");
1205     $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1206     $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1207
1208     my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1209     my $template = C4::Templates::gettemplate( $template_name, $type, $query );
1210     $template->param(
1211         branchloop                            => GetBranchesLoop(),
1212         OpacAdditionalStylesheet                   => C4::Context->preference("OpacAdditionalStylesheet"),
1213         opaclayoutstylesheet                  => C4::Context->preference("opaclayoutstylesheet"),
1214         login                                 => 1,
1215         INPUTS                                => \@inputs,
1216         script_name                           => get_script_name(),
1217         casAuthentication                     => C4::Context->preference("casAuthentication"),
1218         shibbolethAuthentication              => $shib,
1219         SessionRestrictionByIP                => C4::Context->preference("SessionRestrictionByIP"),
1220         suggestion                            => C4::Context->preference("suggestion"),
1221         virtualshelves                        => C4::Context->preference("virtualshelves"),
1222         LibraryName                           => "" . C4::Context->preference("LibraryName"),
1223         LibraryNameTitle                      => "" . $LibraryNameTitle,
1224         opacuserlogin                         => C4::Context->preference("opacuserlogin"),
1225         OpacNav                               => C4::Context->preference("OpacNav"),
1226         OpacNavRight                          => C4::Context->preference("OpacNavRight"),
1227         OpacNavBottom                         => C4::Context->preference("OpacNavBottom"),
1228         opaccredits                           => C4::Context->preference("opaccredits"),
1229         OpacFavicon                           => C4::Context->preference("OpacFavicon"),
1230         opacreadinghistory                    => C4::Context->preference("opacreadinghistory"),
1231         opaclanguagesdisplay                  => C4::Context->preference("opaclanguagesdisplay"),
1232         OPACUserJS                            => C4::Context->preference("OPACUserJS"),
1233         opacbookbag                           => "" . C4::Context->preference("opacbookbag"),
1234         OpacCloud                             => C4::Context->preference("OpacCloud"),
1235         OpacTopissue                          => C4::Context->preference("OpacTopissue"),
1236         OpacAuthorities                       => C4::Context->preference("OpacAuthorities"),
1237         OpacBrowser                           => C4::Context->preference("OpacBrowser"),
1238         opacheader                            => C4::Context->preference("opacheader"),
1239         TagsEnabled                           => C4::Context->preference("TagsEnabled"),
1240         OPACUserCSS                           => C4::Context->preference("OPACUserCSS"),
1241         intranetcolorstylesheet               => C4::Context->preference("intranetcolorstylesheet"),
1242         intranetstylesheet                    => C4::Context->preference("intranetstylesheet"),
1243         intranetbookbag                       => C4::Context->preference("intranetbookbag"),
1244         IntranetNav                           => C4::Context->preference("IntranetNav"),
1245         IntranetFavicon                       => C4::Context->preference("IntranetFavicon"),
1246         IntranetUserCSS                       => C4::Context->preference("IntranetUserCSS"),
1247         IntranetUserJS                        => C4::Context->preference("IntranetUserJS"),
1248         IndependentBranches                   => C4::Context->preference("IndependentBranches"),
1249         AutoLocation                          => C4::Context->preference("AutoLocation"),
1250         wrongip                               => $info{'wrongip'},
1251         PatronSelfRegistration                => C4::Context->preference("PatronSelfRegistration"),
1252         PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1253         persona                               => C4::Context->preference("Persona"),
1254         opac_css_override                     => $ENV{'OPAC_CSS_OVERRIDE'},
1255     );
1256
1257     $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1258     $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1259     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1260
1261     if ( $type eq 'opac' ) {
1262         require Koha::Virtualshelves;
1263         my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1264             {
1265                 category       => 2,
1266             }
1267         );
1268         $template->param(
1269             some_public_shelves  => $some_public_shelves,
1270         );
1271     }
1272
1273     if ($cas) {
1274
1275         # Is authentication against multiple CAS servers enabled?
1276         if ( C4::Auth_with_cas::multipleAuth && !$casparam ) {
1277             my $casservers = C4::Auth_with_cas::getMultipleAuth();
1278             my @tmplservers;
1279             foreach my $key ( keys %$casservers ) {
1280                 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1281             }
1282             $template->param(
1283                 casServersLoop => \@tmplservers
1284             );
1285         } else {
1286             $template->param(
1287                 casServerUrl => login_cas_url($query, undef, $type),
1288             );
1289         }
1290
1291         $template->param(
1292             invalidCasLogin => $info{'invalidCasLogin'}
1293         );
1294     }
1295
1296     if ($shib) {
1297         $template->param(
1298             shibbolethAuthentication => $shib,
1299             shibbolethLoginUrl       => login_shib_url($query),
1300         );
1301     }
1302
1303     if (C4::Context->preference('GoogleOpenIDConnect')) {
1304         if ($query->param("OpenIDConnectFailed")) {
1305             my $reason = $query->param('OpenIDConnectFailed');
1306             $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1307         }
1308     }
1309
1310     $template->param(
1311         LibraryName => C4::Context->preference("LibraryName"),
1312     );
1313     $template->param(%info);
1314
1315     #    $cookie = $query->cookie(CGISESSID => $session->id
1316     #   );
1317     print $query->header(
1318         {   type              => 'text/html',
1319             charset           => 'utf-8',
1320             cookie            => $cookie,
1321             'X-Frame-Options' => 'SAMEORIGIN'
1322         }
1323       ),
1324       $template->output;
1325     safe_exit;
1326 }
1327
1328 =head2 check_api_auth
1329
1330   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1331
1332 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1333 cookie, determine if the user has the privileges specified by C<$userflags>.
1334
1335 C<check_api_auth> is is meant for authenticating users of web services, and
1336 consequently will always return and will not attempt to redirect the user
1337 agent.
1338
1339 If a valid session cookie is already present, check_api_auth will return a status
1340 of "ok", the cookie, and the Koha session ID.
1341
1342 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1343 parameters and create a session cookie and Koha session if the supplied credentials
1344 are OK.
1345
1346 Possible return values in C<$status> are:
1347
1348 =over
1349
1350 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1351
1352 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1353
1354 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1355
1356 =item "expired -- session cookie has expired; API user should resubmit userid and password
1357
1358 =back
1359
1360 =cut
1361
1362 sub check_api_auth {
1363     my $query         = shift;
1364     my $flagsrequired = shift;
1365
1366     my $dbh     = C4::Context->dbh;
1367     my $timeout = _timeout_syspref();
1368
1369     unless ( C4::Context->preference('Version') ) {
1370
1371         # database has not been installed yet
1372         return ( "maintenance", undef, undef );
1373     }
1374     my $kohaversion = Koha::version();
1375     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1376     if ( C4::Context->preference('Version') < $kohaversion ) {
1377
1378         # database in need of version update; assume that
1379         # no API should be called while databsae is in
1380         # this condition.
1381         return ( "maintenance", undef, undef );
1382     }
1383
1384     # FIXME -- most of what follows is a copy-and-paste
1385     # of code from checkauth.  There is an obvious need
1386     # for refactoring to separate the various parts of
1387     # the authentication code, but as of 2007-11-19 this
1388     # is deferred so as to not introduce bugs into the
1389     # regular authentication code for Koha 3.0.
1390
1391     # see if we have a valid session cookie already
1392     # however, if a userid parameter is present (i.e., from
1393     # a form submission, assume that any current cookie
1394     # is to be ignored
1395     my $sessionID = undef;
1396     unless ( $query->param('userid') ) {
1397         $sessionID = $query->cookie("CGISESSID");
1398     }
1399     if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1400         my $session = get_session($sessionID);
1401         C4::Context->_new_userenv($sessionID);
1402         if ($session) {
1403             C4::Context->set_userenv(
1404                 $session->param('number'),       $session->param('id'),
1405                 $session->param('cardnumber'),   $session->param('firstname'),
1406                 $session->param('surname'),      $session->param('branch'),
1407                 $session->param('branchname'),   $session->param('flags'),
1408                 $session->param('emailaddress'), $session->param('branchprinter')
1409             );
1410
1411             my $ip       = $session->param('ip');
1412             my $lasttime = $session->param('lasttime');
1413             my $userid   = $session->param('id');
1414             if ( $lasttime < time() - $timeout ) {
1415
1416                 # time out
1417                 $session->delete();
1418                 $session->flush;
1419                 C4::Context->_unset_userenv($sessionID);
1420                 $userid    = undef;
1421                 $sessionID = undef;
1422                 return ( "expired", undef, undef );
1423             } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1424
1425                 # IP address changed
1426                 $session->delete();
1427                 $session->flush;
1428                 C4::Context->_unset_userenv($sessionID);
1429                 $userid    = undef;
1430                 $sessionID = undef;
1431                 return ( "expired", undef, undef );
1432             } else {
1433                 my $cookie = $query->cookie(
1434                     -name     => 'CGISESSID',
1435                     -value    => $session->id,
1436                     -HttpOnly => 1,
1437                 );
1438                 $session->param( 'lasttime', time() );
1439                 my $flags = haspermission( $userid, $flagsrequired );
1440                 if ($flags) {
1441                     return ( "ok", $cookie, $sessionID );
1442                 } else {
1443                     $session->delete();
1444                     $session->flush;
1445                     C4::Context->_unset_userenv($sessionID);
1446                     $userid    = undef;
1447                     $sessionID = undef;
1448                     return ( "failed", undef, undef );
1449                 }
1450             }
1451         } else {
1452             return ( "expired", undef, undef );
1453         }
1454     } else {
1455
1456         # new login
1457         my $userid   = $query->param('userid');
1458         my $password = $query->param('password');
1459         my ( $return, $cardnumber );
1460
1461         # Proxy CAS auth
1462         if ( $cas && $query->param('PT') ) {
1463             my $retuserid;
1464             $debug and print STDERR "## check_api_auth - checking CAS\n";
1465
1466             # In case of a CAS authentication, we use the ticket instead of the password
1467             my $PT = $query->param('PT');
1468             ( $return, $cardnumber, $userid ) = check_api_auth_cas( $dbh, $PT, $query );    # EXTERNAL AUTH
1469         } else {
1470
1471             # User / password auth
1472             unless ( $userid and $password ) {
1473
1474                 # caller did something wrong, fail the authenticateion
1475                 return ( "failed", undef, undef );
1476             }
1477             ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password, $query );
1478         }
1479
1480         if ( $return and haspermission( $userid, $flagsrequired ) ) {
1481             my $session = get_session("");
1482             return ( "failed", undef, undef ) unless $session;
1483
1484             my $sessionID = $session->id;
1485             C4::Context->_new_userenv($sessionID);
1486             my $cookie = $query->cookie(
1487                 -name     => 'CGISESSID',
1488                 -value    => $sessionID,
1489                 -HttpOnly => 1,
1490             );
1491             if ( $return == 1 ) {
1492                 my (
1493                     $borrowernumber, $firstname,  $surname,
1494                     $userflags,      $branchcode, $branchname,
1495                     $branchprinter,  $emailaddress
1496                 );
1497                 my $sth =
1498                   $dbh->prepare(
1499 "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=?"
1500                   );
1501                 $sth->execute($userid);
1502                 (
1503                     $borrowernumber, $firstname,  $surname,
1504                     $userflags,      $branchcode, $branchname,
1505                     $branchprinter,  $emailaddress
1506                 ) = $sth->fetchrow if ( $sth->rows );
1507
1508                 unless ( $sth->rows ) {
1509                     my $sth = $dbh->prepare(
1510 "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=?"
1511                     );
1512                     $sth->execute($cardnumber);
1513                     (
1514                         $borrowernumber, $firstname,  $surname,
1515                         $userflags,      $branchcode, $branchname,
1516                         $branchprinter,  $emailaddress
1517                     ) = $sth->fetchrow if ( $sth->rows );
1518
1519                     unless ( $sth->rows ) {
1520                         $sth->execute($userid);
1521                         (
1522                             $borrowernumber, $firstname,  $surname,       $userflags,
1523                             $branchcode,     $branchname, $branchprinter, $emailaddress
1524                         ) = $sth->fetchrow if ( $sth->rows );
1525                     }
1526                 }
1527
1528                 my $ip = $ENV{'REMOTE_ADDR'};
1529
1530                 # if they specify at login, use that
1531                 if ( $query->param('branch') ) {
1532                     $branchcode = $query->param('branch');
1533                     $branchname = Koha::Libraries->find($branchcode)->branchname;
1534                 }
1535                 my $branches = GetBranches();
1536                 my @branchesloop;
1537                 foreach my $br ( keys %$branches ) {
1538
1539                     #     now we work with the treatment of ip
1540                     my $domain = $branches->{$br}->{'branchip'};
1541                     if ( $domain && $ip =~ /^$domain/ ) {
1542                         $branchcode = $branches->{$br}->{'branchcode'};
1543
1544                         # new op dev : add the branchprinter and branchname in the cookie
1545                         $branchprinter = $branches->{$br}->{'branchprinter'};
1546                         $branchname    = $branches->{$br}->{'branchname'};
1547                     }
1548                 }
1549                 $session->param( 'number',       $borrowernumber );
1550                 $session->param( 'id',           $userid );
1551                 $session->param( 'cardnumber',   $cardnumber );
1552                 $session->param( 'firstname',    $firstname );
1553                 $session->param( 'surname',      $surname );
1554                 $session->param( 'branch',       $branchcode );
1555                 $session->param( 'branchname',   $branchname );
1556                 $session->param( 'flags',        $userflags );
1557                 $session->param( 'emailaddress', $emailaddress );
1558                 $session->param( 'ip',           $session->remote_addr() );
1559                 $session->param( 'lasttime',     time() );
1560             } elsif ( $return == 2 ) {
1561
1562                 #We suppose the user is the superlibrarian
1563                 $session->param( 'number',       0 );
1564                 $session->param( 'id',           C4::Context->config('user') );
1565                 $session->param( 'cardnumber',   C4::Context->config('user') );
1566                 $session->param( 'firstname',    C4::Context->config('user') );
1567                 $session->param( 'surname',      C4::Context->config('user') );
1568                 $session->param( 'branch',       'NO_LIBRARY_SET' );
1569                 $session->param( 'branchname',   'NO_LIBRARY_SET' );
1570                 $session->param( 'flags',        1 );
1571                 $session->param( 'emailaddress', C4::Context->preference('KohaAdminEmailAddress') );
1572                 $session->param( 'ip',           $session->remote_addr() );
1573                 $session->param( 'lasttime',     time() );
1574             }
1575             C4::Context->set_userenv(
1576                 $session->param('number'),       $session->param('id'),
1577                 $session->param('cardnumber'),   $session->param('firstname'),
1578                 $session->param('surname'),      $session->param('branch'),
1579                 $session->param('branchname'),   $session->param('flags'),
1580                 $session->param('emailaddress'), $session->param('branchprinter')
1581             );
1582             return ( "ok", $cookie, $sessionID );
1583         } else {
1584             return ( "failed", undef, undef );
1585         }
1586     }
1587 }
1588
1589 =head2 check_cookie_auth
1590
1591   ($status, $sessionId) = check_api_auth($cookie, $userflags);
1592
1593 Given a CGISESSID cookie set during a previous login to Koha, determine
1594 if the user has the privileges specified by C<$userflags>.
1595
1596 C<check_cookie_auth> is meant for authenticating special services
1597 such as tools/upload-file.pl that are invoked by other pages that
1598 have been authenticated in the usual way.
1599
1600 Possible return values in C<$status> are:
1601
1602 =over
1603
1604 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1605
1606 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1607
1608 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1609
1610 =item "expired -- session cookie has expired; API user should resubmit userid and password
1611
1612 =back
1613
1614 =cut
1615
1616 sub check_cookie_auth {
1617     my $cookie        = shift;
1618     my $flagsrequired = shift;
1619     my $params        = shift;
1620
1621     my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1622     my $dbh     = C4::Context->dbh;
1623     my $timeout = _timeout_syspref();
1624
1625     unless ( C4::Context->preference('Version') ) {
1626
1627         # database has not been installed yet
1628         return ( "maintenance", undef );
1629     }
1630     my $kohaversion = Koha::version();
1631     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1632     if ( C4::Context->preference('Version') < $kohaversion ) {
1633
1634         # database in need of version update; assume that
1635         # no API should be called while databsae is in
1636         # this condition.
1637         return ( "maintenance", undef );
1638     }
1639
1640     # FIXME -- most of what follows is a copy-and-paste
1641     # of code from checkauth.  There is an obvious need
1642     # for refactoring to separate the various parts of
1643     # the authentication code, but as of 2007-11-23 this
1644     # is deferred so as to not introduce bugs into the
1645     # regular authentication code for Koha 3.0.
1646
1647     # see if we have a valid session cookie already
1648     # however, if a userid parameter is present (i.e., from
1649     # a form submission, assume that any current cookie
1650     # is to be ignored
1651     unless ( defined $cookie and $cookie ) {
1652         return ( "failed", undef );
1653     }
1654     my $sessionID = $cookie;
1655     my $session   = get_session($sessionID);
1656     C4::Context->_new_userenv($sessionID);
1657     if ($session) {
1658         C4::Context->set_userenv(
1659             $session->param('number'),       $session->param('id'),
1660             $session->param('cardnumber'),   $session->param('firstname'),
1661             $session->param('surname'),      $session->param('branch'),
1662             $session->param('branchname'),   $session->param('flags'),
1663             $session->param('emailaddress'), $session->param('branchprinter')
1664         );
1665
1666         my $ip       = $session->param('ip');
1667         my $lasttime = $session->param('lasttime');
1668         my $userid   = $session->param('id');
1669         if ( $lasttime < time() - $timeout ) {
1670
1671             # time out
1672             $session->delete();
1673             $session->flush;
1674             C4::Context->_unset_userenv($sessionID);
1675             $userid    = undef;
1676             $sessionID = undef;
1677             return ("expired", undef);
1678         } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1679
1680             # IP address changed
1681             $session->delete();
1682             $session->flush;
1683             C4::Context->_unset_userenv($sessionID);
1684             $userid    = undef;
1685             $sessionID = undef;
1686             return ( "expired", undef );
1687         } else {
1688             $session->param( 'lasttime', time() );
1689             my $flags = haspermission( $userid, $flagsrequired );
1690             if ($flags) {
1691                 return ( "ok", $sessionID );
1692             } else {
1693                 $session->delete();
1694                 $session->flush;
1695                 C4::Context->_unset_userenv($sessionID);
1696                 $userid    = undef;
1697                 $sessionID = undef;
1698                 return ( "failed", undef );
1699             }
1700         }
1701     } else {
1702         return ( "expired", undef );
1703     }
1704 }
1705
1706 =head2 get_session
1707
1708   use CGI::Session;
1709   my $session = get_session($sessionID);
1710
1711 Given a session ID, retrieve the CGI::Session object used to store
1712 the session's state.  The session object can be used to store
1713 data that needs to be accessed by different scripts during a
1714 user's session.
1715
1716 If the C<$sessionID> parameter is an empty string, a new session
1717 will be created.
1718
1719 =cut
1720
1721 sub get_session {
1722     my $sessionID      = shift;
1723     my $storage_method = C4::Context->preference('SessionStorage');
1724     my $dbh            = C4::Context->dbh;
1725     my $session;
1726     if ( $storage_method eq 'mysql' ) {
1727         $session = new CGI::Session( "driver:MySQL;serializer:yaml;id:md5", $sessionID, { Handle => $dbh } );
1728     }
1729     elsif ( $storage_method eq 'Pg' ) {
1730         $session = new CGI::Session( "driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, { Handle => $dbh } );
1731     }
1732     elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1733         my $memcached = Koha::Caches->get_instance()->memcached_cache;
1734         $session = new CGI::Session( "driver:memcached;serializer:yaml;id:md5", $sessionID, { Memcached => $memcached } );
1735     }
1736     else {
1737         # catch all defaults to tmp should work on all systems
1738         my $dir = File::Spec->tmpdir;
1739         my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1740         $session = new CGI::Session( "driver:File;serializer:yaml;id:md5", $sessionID, { Directory => "$dir/cgisess_$instance" } );
1741     }
1742     return $session;
1743 }
1744
1745
1746 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1747 # (or something similar)
1748 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1749 # not having a userenv defined could cause a crash.
1750 sub checkpw {
1751     my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1752     $type = 'opac' unless $type;
1753     if ($ldap) {
1754         $debug and print STDERR "## checkpw - checking LDAP\n";
1755         my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_);    # EXTERNAL AUTH
1756         return 0 if $retval == -1;                                  # Incorrect password for LDAP login attempt
1757         ($retval) and return ( $retval, $retcard, $retuserid );
1758     }
1759
1760     if ( $cas && $query && $query->param('ticket') ) {
1761         $debug and print STDERR "## checkpw - checking CAS\n";
1762
1763         # In case of a CAS authentication, we use the ticket instead of the password
1764         my $ticket = $query->param('ticket');
1765         $query->delete('ticket');                                   # remove ticket to come back to original URL
1766         my ( $retval, $retcard, $retuserid ) = checkpw_cas( $dbh, $ticket, $query, $type );    # EXTERNAL AUTH
1767         ($retval) and return ( $retval, $retcard, $retuserid );
1768         return 0;
1769     }
1770
1771     # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1772     # Check for password to asertain whether we want to be testing against shibboleth or another method this
1773     # time around.
1774     if ( $shib && $shib_login && !$password ) {
1775
1776         $debug and print STDERR "## checkpw - checking Shibboleth\n";
1777
1778         # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1779         # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1780         # shibboleth-authenticated user
1781
1782         # Then, we check if it matches a valid koha user
1783         if ($shib_login) {
1784             my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login);    # EXTERNAL AUTH
1785             ($retval) and return ( $retval, $retcard, $retuserid );
1786             return 0;
1787         }
1788     }
1789
1790     # INTERNAL AUTH
1791     return checkpw_internal( $dbh, $userid, $password, $no_set_userenv);
1792 }
1793
1794 sub checkpw_internal {
1795     my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
1796
1797     $password = Encode::encode( 'UTF-8', $password )
1798       if Encode::is_utf8($password);
1799
1800     if ( $userid && $userid eq C4::Context->config('user') ) {
1801         if ( $password && $password eq C4::Context->config('pass') ) {
1802
1803             # Koha superuser account
1804             #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1805             return 2;
1806         }
1807         else {
1808             return 0;
1809         }
1810     }
1811
1812     my $sth =
1813       $dbh->prepare(
1814         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1815       );
1816     $sth->execute($userid);
1817     if ( $sth->rows ) {
1818         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1819             $surname, $branchcode, $branchname, $flags )
1820           = $sth->fetchrow;
1821
1822         if ( checkpw_hash( $password, $stored_hash ) ) {
1823
1824             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1825                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1826             return 1, $cardnumber, $userid;
1827         }
1828     }
1829     $sth =
1830       $dbh->prepare(
1831         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1832       );
1833     $sth->execute($userid);
1834     if ( $sth->rows ) {
1835         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1836             $surname, $branchcode, $branchname, $flags )
1837           = $sth->fetchrow;
1838
1839         if ( checkpw_hash( $password, $stored_hash ) ) {
1840
1841             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1842                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1843             return 1, $cardnumber, $userid;
1844         }
1845     }
1846     if ( $userid && $userid eq 'demo'
1847         && "$password" eq 'demo'
1848         && C4::Context->config('demo') )
1849     {
1850
1851         # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1852         # some features won't be effective : modify systempref, modify MARC structure,
1853         return 2;
1854     }
1855     return 0;
1856 }
1857
1858 sub checkpw_hash {
1859     my ( $password, $stored_hash ) = @_;
1860
1861     return if $stored_hash eq '!';
1862
1863     # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1864     my $hash;
1865     if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1866         $hash = hash_password( $password, $stored_hash );
1867     } else {
1868         $hash = md5_base64($password);
1869     }
1870     return $hash eq $stored_hash;
1871 }
1872
1873 =head2 getuserflags
1874
1875     my $authflags = getuserflags($flags, $userid, [$dbh]);
1876
1877 Translates integer flags into permissions strings hash.
1878
1879 C<$flags> is the integer userflags value ( borrowers.userflags )
1880 C<$userid> is the members.userid, used for building subpermissions
1881 C<$authflags> is a hashref of permissions
1882
1883 =cut
1884
1885 sub getuserflags {
1886     my $flags  = shift;
1887     my $userid = shift;
1888     my $dbh    = @_ ? shift : C4::Context->dbh;
1889     my $userflags;
1890     {
1891         # I don't want to do this, but if someone logs in as the database
1892         # user, it would be preferable not to spam them to death with
1893         # numeric warnings. So, we make $flags numeric.
1894         no warnings 'numeric';
1895         $flags += 0;
1896     }
1897     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1898     $sth->execute;
1899
1900     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1901         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1902             $userflags->{$flag} = 1;
1903         }
1904         else {
1905             $userflags->{$flag} = 0;
1906         }
1907     }
1908
1909     # get subpermissions and merge with top-level permissions
1910     my $user_subperms = get_user_subpermissions($userid);
1911     foreach my $module ( keys %$user_subperms ) {
1912         next if $userflags->{$module} == 1;    # user already has permission for everything in this module
1913         $userflags->{$module} = $user_subperms->{$module};
1914     }
1915
1916     return $userflags;
1917 }
1918
1919 =head2 get_user_subpermissions
1920
1921   $user_perm_hashref = get_user_subpermissions($userid);
1922
1923 Given the userid (note, not the borrowernumber) of a staff user,
1924 return a hashref of hashrefs of the specific subpermissions
1925 accorded to the user.  An example return is
1926
1927  {
1928     tools => {
1929         export_catalog => 1,
1930         import_patrons => 1,
1931     }
1932  }
1933
1934 The top-level hash-key is a module or function code from
1935 userflags.flag, while the second-level key is a code
1936 from permissions.
1937
1938 The results of this function do not give a complete picture
1939 of the functions that a staff user can access; it is also
1940 necessary to check borrowers.flags.
1941
1942 =cut
1943
1944 sub get_user_subpermissions {
1945     my $userid = shift;
1946
1947     my $dbh = C4::Context->dbh;
1948     my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
1949                              FROM user_permissions
1950                              JOIN permissions USING (module_bit, code)
1951                              JOIN userflags ON (module_bit = bit)
1952                              JOIN borrowers USING (borrowernumber)
1953                              WHERE userid = ?" );
1954     $sth->execute($userid);
1955
1956     my $user_perms = {};
1957     while ( my $perm = $sth->fetchrow_hashref ) {
1958         $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1959     }
1960     return $user_perms;
1961 }
1962
1963 =head2 get_all_subpermissions
1964
1965   my $perm_hashref = get_all_subpermissions();
1966
1967 Returns a hashref of hashrefs defining all specific
1968 permissions currently defined.  The return value
1969 has the same structure as that of C<get_user_subpermissions>,
1970 except that the innermost hash value is the description
1971 of the subpermission.
1972
1973 =cut
1974
1975 sub get_all_subpermissions {
1976     my $dbh = C4::Context->dbh;
1977     my $sth = $dbh->prepare( "SELECT flag, code
1978                              FROM permissions
1979                              JOIN userflags ON (module_bit = bit)" );
1980     $sth->execute();
1981
1982     my $all_perms = {};
1983     while ( my $perm = $sth->fetchrow_hashref ) {
1984         $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1985     }
1986     return $all_perms;
1987 }
1988
1989 =head2 haspermission
1990
1991   $flags = ($userid, $flagsrequired);
1992
1993 C<$userid> the userid of the member
1994 C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
1995
1996 Returns member's flags or 0 if a permission is not met.
1997
1998 =cut
1999
2000 sub haspermission {
2001     my ( $userid, $flagsrequired ) = @_;
2002     my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2003     $sth->execute($userid);
2004     my $row = $sth->fetchrow();
2005     my $flags = getuserflags( $row, $userid );
2006     if ( $userid eq C4::Context->config('user') ) {
2007
2008         # Super User Account from /etc/koha.conf
2009         $flags->{'superlibrarian'} = 1;
2010     }
2011     elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
2012
2013         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
2014         $flags->{'superlibrarian'} = 1;
2015     }
2016
2017     return $flags if $flags->{superlibrarian};
2018
2019     foreach my $module ( keys %$flagsrequired ) {
2020         my $subperm = $flagsrequired->{$module};
2021         if ( $subperm eq '*' ) {
2022             return 0 unless ( $flags->{$module} == 1 or ref( $flags->{$module} ) );
2023         } else {
2024             return 0 unless (
2025                 ( defined $flags->{$module} and
2026                     $flags->{$module} == 1 )
2027                 or
2028                 ( ref( $flags->{$module} ) and
2029                     exists $flags->{$module}->{$subperm} and
2030                     $flags->{$module}->{$subperm} == 1 )
2031             );
2032         }
2033     }
2034     return $flags;
2035
2036     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2037 }
2038
2039 sub getborrowernumber {
2040     my ($userid) = @_;
2041     my $userenv = C4::Context->userenv;
2042     if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2043         return $userenv->{number};
2044     }
2045     my $dbh = C4::Context->dbh;
2046     for my $field ( 'userid', 'cardnumber' ) {
2047         my $sth =
2048           $dbh->prepare("select borrowernumber from borrowers where $field=?");
2049         $sth->execute($userid);
2050         if ( $sth->rows ) {
2051             my ($bnumber) = $sth->fetchrow;
2052             return $bnumber;
2053         }
2054     }
2055     return 0;
2056 }
2057
2058 END { }    # module clean-up code here (global destructor)
2059 1;
2060 __END__
2061
2062 =head1 SEE ALSO
2063
2064 CGI(3)
2065
2066 C4::Output(3)
2067
2068 Crypt::Eksblowfish::Bcrypt(3)
2069
2070 Digest::MD5(3)
2071
2072 =cut