C4/Auth.pm

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