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 POSIX qw/strftime/;
  38 use List::MoreUtils qw/ any /;
  39 use Encode qw( encode is_utf8);
  40
  41 # use utf8;
  42 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout $shib $shib_login);
  43
  44 BEGIN {
  45     sub psgi_env { any { /^psgi\./ } keys %ENV }
  46
  47     sub safe_exit {
  48         if   (psgi_env) { die 'psgi:exit' }
  49         else            { exit }
  50     }
  51     $VERSION = 3.07.00.049;    # set version for version checking
  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 => $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   => C4::Context->preference("singleBranchMode"),
 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             ShowReviewer                          => C4::Context->preference("ShowReviewer"),
 553             ShowReviewerPhoto                     => C4::Context->preference("ShowReviewerPhoto"),
 554             suggestion                            => "" . C4::Context->preference("suggestion"),
 555             virtualshelves                        => "" . C4::Context->preference("virtualshelves"),
 556             OPACSerialIssueDisplayCount           => C4::Context->preference("OPACSerialIssueDisplayCount"),
 557             OPACXSLTDetailsDisplay                => C4::Context->preference("OPACXSLTDetailsDisplay"),
 558             OPACXSLTResultsDisplay                => C4::Context->preference("OPACXSLTResultsDisplay"),
 559             SyndeticsClientCode                   => C4::Context->preference("SyndeticsClientCode"),
 560             SyndeticsEnabled                      => C4::Context->preference("SyndeticsEnabled"),
 561             SyndeticsCoverImages                  => C4::Context->preference("SyndeticsCoverImages"),
 562             SyndeticsTOC                          => C4::Context->preference("SyndeticsTOC"),
 563             SyndeticsSummary                      => C4::Context->preference("SyndeticsSummary"),
 564             SyndeticsEditions                     => C4::Context->preference("SyndeticsEditions"),
 565             SyndeticsExcerpt                      => C4::Context->preference("SyndeticsExcerpt"),
 566             SyndeticsReviews                      => C4::Context->preference("SyndeticsReviews"),
 567             SyndeticsAuthorNotes                  => C4::Context->preference("SyndeticsAuthorNotes"),
 568             SyndeticsAwards                       => C4::Context->preference("SyndeticsAwards"),
 569             SyndeticsSeries                       => C4::Context->preference("SyndeticsSeries"),
 570             SyndeticsCoverImageSize               => C4::Context->preference("SyndeticsCoverImageSize"),
 571             OPACLocalCoverImages                  => C4::Context->preference("OPACLocalCoverImages"),
 572             PatronSelfRegistration                => C4::Context->preference("PatronSelfRegistration"),
 573             PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
 574             useDischarge                 => C4::Context->preference('useDischarge'),
 575         );
 576
 577         $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
 578     }
 579
 580     # Check if we were asked using parameters to force a specific language
 581     if ( defined $in->{'query'}->param('language') ) {
 582
 583         # Extract the language, let C4::Languages::getlanguage choose
 584         # what to do
 585         my $language = C4::Languages::getlanguage( $in->{'query'} );
 586         my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
 587         if ( ref $cookie eq 'ARRAY' ) {
 588             push @{$cookie}, $languagecookie;
 589         } else {
 590             $cookie = [ $cookie, $languagecookie ];
 591         }
 592     }
 593
 594     return ( $template, $borrowernumber, $cookie, $flags );
 595 }
 596
 597 =head2 checkauth
 598
 599   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 600
 601 Verifies that the user is authorized to run this script.  If
 602 the user is authorized, a (userid, cookie, session-id, flags)
 603 quadruple is returned.  If the user is not authorized but does
 604 not have the required privilege (see $flagsrequired below), it
 605 displays an error page and exits.  Otherwise, it displays the
 606 login page and exits.
 607
 608 Note that C<&checkauth> will return if and only if the user
 609 is authorized, so it should be called early on, before any
 610 unfinished operations (e.g., if you've opened a file, then
 611 C<&checkauth> won't close it for you).
 612
 613 C<$query> is the CGI object for the script calling C<&checkauth>.
 614
 615 The C<$noauth> argument is optional. If it is set, then no
 616 authorization is required for the script.
 617
 618 C<&checkauth> fetches user and session information from C<$query> and
 619 ensures that the user is authorized to run scripts that require
 620 authorization.
 621
 622 The C<$flagsrequired> argument specifies the required privileges
 623 the user must have if the username and password are correct.
 624 It should be specified as a reference-to-hash; keys in the hash
 625 should be the "flags" for the user, as specified in the Members
 626 intranet module. Any key specified must correspond to a "flag"
 627 in the userflags table. E.g., { circulate => 1 } would specify
 628 that the user must have the "circulate" privilege in order to
 629 proceed. To make sure that access control is correct, the
 630 C<$flagsrequired> parameter must be specified correctly.
 631
 632 Koha also has a concept of sub-permissions, also known as
 633 granular permissions.  This makes the value of each key
 634 in the C<flagsrequired> hash take on an additional
 635 meaning, i.e.,
 636
 637  1
 638
 639 The user must have access to all subfunctions of the module
 640 specified by the hash key.
 641
 642  *
 643
 644 The user must have access to at least one subfunction of the module
 645 specified by the hash key.
 646
 647  specific permission, e.g., 'export_catalog'
 648
 649 The user must have access to the specific subfunction list, which
 650 must correspond to a row in the permissions table.
 651
 652 The C<$type> argument specifies whether the template should be
 653 retrieved from the opac or intranet directory tree.  "opac" is
 654 assumed if it is not specified; however, if C<$type> is specified,
 655 "intranet" is assumed if it is not "opac".
 656
 657 If C<$query> does not have a valid session ID associated with it
 658 (i.e., the user has not logged in) or if the session has expired,
 659 C<&checkauth> presents the user with a login page (from the point of
 660 view of the original script, C<&checkauth> does not return). Once the
 661 user has authenticated, C<&checkauth> restarts the original script
 662 (this time, C<&checkauth> returns).
 663
 664 The login page is provided using a HTML::Template, which is set in the
 665 systempreferences table or at the top of this file. The variable C<$type>
 666 selects which template to use, either the opac or the intranet
 667 authentification template.
 668
 669 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 670 cookie should be sent back to the browser; it verifies that the user
 671 has authenticated.
 672
 673 =cut
 674
 675 sub _version_check {
 676     my $type  = shift;
 677     my $query = shift;
 678     my $version;
 679
 680     # If version syspref is unavailable, it means Koha is being installed,
 681     # and so we must redirect to OPAC maintenance page or to the WebInstaller
 682     # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
 683     if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
 684         warn "OPAC Install required, redirecting to maintenance";
 685         print $query->redirect("/cgi-bin/koha/maintenance.pl");
 686         safe_exit;
 687     }
 688     unless ( $version = C4::Context->preference('Version') ) {    # assignment, not comparison
 689         if ( $type ne 'opac' ) {
 690             warn "Install required, redirecting to Installer";
 691             print $query->redirect("/cgi-bin/koha/installer/install.pl");
 692         } else {
 693             warn "OPAC Install required, redirecting to maintenance";
 694             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 695         }
 696         safe_exit;
 697     }
 698
 699     # check that database and koha version are the same
 700     # there is no DB version, it's a fresh install,
 701     # go to web installer
 702     # there is a DB version, compare it to the code version
 703     my $kohaversion = Koha::version();
 704
 705     # remove the 3 last . to have a Perl number
 706     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 707     $debug and print STDERR "kohaversion : $kohaversion\n";
 708     if ( $version < $kohaversion ) {
 709         my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
 710         if ( $type ne 'opac' ) {
 711             warn sprintf( $warning, 'Installer' );
 712             print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
 713         } else {
 714             warn sprintf( "OPAC: " . $warning, 'maintenance' );
 715             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 716         }
 717         safe_exit;
 718     }
 719 }
 720
 721 sub _session_log {
 722     (@_) or return 0;
 723     open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
 724     printf $fh join( "\n", @_ );
 725     close $fh;
 726 }
 727
 728 sub _timeout_syspref {
 729     my $timeout = C4::Context->preference('timeout') || 600;
 730
 731     # value in days, convert in seconds
 732     if ( $timeout =~ /(\d+)[dD]/ ) {
 733         $timeout = $1 * 86400;
 734     }
 735     return $timeout;
 736 }
 737
 738 sub checkauth {
 739     my $query = shift;
 740     $debug and warn "Checking Auth";
 741
 742     # $authnotrequired will be set for scripts which will run without authentication
 743     my $authnotrequired = shift;
 744     my $flagsrequired   = shift;
 745     my $type            = shift;
 746     my $persona         = shift;
 747     $type = 'opac' unless $type;
 748
 749     my $dbh     = C4::Context->dbh;
 750     my $timeout = _timeout_syspref();
 751
 752     _version_check( $type, $query );
 753
 754     # state variables
 755     my $loggedin = 0;
 756     my %info;
 757     my ( $userid, $cookie, $sessionID, $flags );
 758     my $logout = $query->param('logout.x');
 759
 760     my $anon_search_history;
 761
 762     # This parameter is the name of the CAS server we want to authenticate against,
 763     # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
 764     my $casparam = $query->param('cas');
 765     my $q_userid = $query->param('userid') // '';
 766
 767     # Basic authentication is incompatible with the use of Shibboleth,
 768     # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
 769     # and it may not be the attribute we want to use to match the koha login.
 770     #
 771     # Also, do not consider an empty REMOTE_USER.
 772     #
 773     # Finally, after those tests, we can assume (although if it would be better with
 774     # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
 775     # and we can affect it to $userid.
 776     if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
 777
 778         # Using Basic Authentication, no cookies required
 779         $cookie = $query->cookie(
 780             -name     => 'CGISESSID',
 781             -value    => '',
 782             -expires  => '',
 783             -HttpOnly => 1,
 784         );
 785         $loggedin = 1;
 786     }
 787     elsif ($persona) {
 788
 789         # we don't want to set a session because we are being called by a persona callback
 790     }
 791     elsif ( $sessionID = $query->cookie("CGISESSID") )
 792     {    # assignment, not comparison
 793         my $session = get_session($sessionID);
 794         C4::Context->_new_userenv($sessionID);
 795         my ( $ip, $lasttime, $sessiontype );
 796         my $s_userid = '';
 797         if ($session) {
 798             $s_userid = $session->param('id') // '';
 799             C4::Context->set_userenv(
 800                 $session->param('number'),       $s_userid,
 801                 $session->param('cardnumber'),   $session->param('firstname'),
 802                 $session->param('surname'),      $session->param('branch'),
 803                 $session->param('branchname'),   $session->param('flags'),
 804                 $session->param('emailaddress'), $session->param('branchprinter'),
 805                 $session->param('persona'),      $session->param('shibboleth')
 806             );
 807             C4::Context::set_shelves_userenv( 'bar', $session->param('barshelves') );
 808             C4::Context::set_shelves_userenv( 'pub', $session->param('pubshelves') );
 809             C4::Context::set_shelves_userenv( 'tot', $session->param('totshelves') );
 810             $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
 811             $ip          = $session->param('ip');
 812             $lasttime    = $session->param('lasttime');
 813             $userid      = $s_userid;
 814             $sessiontype = $session->param('sessiontype') || '';
 815         }
 816         if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
 817             || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
 818             || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
 819         ) {
 820
 821             #if a user enters an id ne to the id in the current session, we need to log them in...
 822             #first we need to clear the anonymous session...
 823             $debug and warn "query id = $q_userid but session id = $s_userid";
 824             $anon_search_history = $session->param('search_history');
 825             $session->delete();
 826             $session->flush;
 827             C4::Context->_unset_userenv($sessionID);
 828             $sessionID = undef;
 829             $userid    = undef;
 830         }
 831         elsif ($logout) {
 832
 833             # voluntary logout the user
 834             # check wether the user was using their shibboleth session or a local one
 835             my $shibSuccess = C4::Context->userenv->{'shibboleth'};
 836             $session->delete();
 837             $session->flush;
 838             C4::Context->_unset_userenv($sessionID);
 839
 840             #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
 841             $sessionID = undef;
 842             $userid    = undef;
 843
 844             if ($cas and $caslogout) {
 845                 logout_cas($query, $type);
 846             }
 847
 848             # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
 849             if ( $shib and $shib_login and $shibSuccess and $type eq 'opac' ) {
 850
 851                 # (Note: $type eq 'opac' condition should be removed when shibboleth authentication for intranet will be implemented)
 852                 logout_shib($query);
 853             }
 854         }
 855         elsif ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
 856
 857             # timed logout
 858             $info{'timed_out'} = 1;
 859             if ($session) {
 860                 $session->delete();
 861                 $session->flush;
 862             }
 863             C4::Context->_unset_userenv($sessionID);
 864
 865             #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
 866             $userid    = undef;
 867             $sessionID = undef;
 868         }
 869         elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
 870
 871             # Different ip than originally logged in from
 872             $info{'oldip'}        = $ip;
 873             $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 874             $info{'different_ip'} = 1;
 875             $session->delete();
 876             $session->flush;
 877             C4::Context->_unset_userenv($sessionID);
 878
 879             #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
 880             $sessionID = undef;
 881             $userid    = undef;
 882         }
 883         else {
 884             $cookie = $query->cookie(
 885                 -name     => 'CGISESSID',
 886                 -value    => $session->id,
 887                 -HttpOnly => 1
 888             );
 889             $session->param( 'lasttime', time() );
 890             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...
 891                 $flags = haspermission( $userid, $flagsrequired );
 892                 if ($flags) {
 893                     $loggedin = 1;
 894                 } else {
 895                     $info{'nopermission'} = 1;
 896                 }
 897             }
 898         }
 899     }
 900     unless ( $userid || $sessionID ) {
 901
 902         #we initiate a session prior to checking for a username to allow for anonymous sessions...
 903         my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
 904
 905         # Save anonymous search history in new session so it can be retrieved
 906         # by get_template_and_user to store it in user's search history after
 907         # a successful login.
 908         if ($anon_search_history) {
 909             $session->param( 'search_history', $anon_search_history );
 910         }
 911
 912         my $sessionID = $session->id;
 913         C4::Context->_new_userenv($sessionID);
 914         $cookie = $query->cookie(
 915             -name     => 'CGISESSID',
 916             -value    => $session->id,
 917             -HttpOnly => 1
 918         );
 919         $userid = $q_userid;
 920         my $pki_field = C4::Context->preference('AllowPKIAuth');
 921         if ( !defined($pki_field) ) {
 922             print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
 923             $pki_field = 'None';
 924         }
 925         if ( ( $cas && $query->param('ticket') )
 926             || $userid
 927             || ( $shib && $shib_login )
 928             || $pki_field ne 'None'
 929             || $persona )
 930         {
 931             my $password    = $query->param('password');
 932             my $shibSuccess = 0;
 933
 934             my ( $return, $cardnumber );
 935
 936             # If shib is enabled and we have a shib login, does the login match a valid koha user
 937             if ( $shib && $shib_login && $type eq 'opac' ) {
 938                 my $retuserid;
 939
 940                 # Do not pass password here, else shib will not be checked in checkpw.
 941                 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $userid, undef, $query );
 942                 $userid      = $retuserid;
 943                 $shibSuccess = $return;
 944                 $info{'invalidShibLogin'} = 1 unless ($return);
 945             }
 946
 947             # If shib login and match were successful, skip further login methods
 948             unless ($shibSuccess) {
 949                 if ( $cas && $query->param('ticket') ) {
 950                     my $retuserid;
 951                     ( $return, $cardnumber, $retuserid ) =
 952                       checkpw( $dbh, $userid, $password, $query, $type );
 953                     $userid = $retuserid;
 954                     $info{'invalidCasLogin'} = 1 unless ($return);
 955                 }
 956
 957                 elsif ($persona) {
 958                     my $value = $persona;
 959
 960                     # If we're looking up the email, there's a chance that the person
 961                     # doesn't have a userid. So if there is none, we pass along the
 962                     # borrower number, and the bits of code that need to know the user
 963                     # ID will have to be smart enough to handle that.
 964                     require C4::Members;
 965                     my @users_info = C4::Members::GetBorrowersWithEmail($value);
 966                     if (@users_info) {
 967
 968                         # First the userid, then the borrowernum
 969                         $value = $users_info[0][1] || $users_info[0][0];
 970                     }
 971                     else {
 972                         undef $value;
 973                     }
 974                     $return = $value ? 1 : 0;
 975                     $userid = $value;
 976                 }
 977
 978                 elsif (
 979                     ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
 980                     || ( $pki_field eq 'emailAddress'
 981                         && $ENV{'SSL_CLIENT_S_DN_Email'} )
 982                   )
 983                 {
 984                     my $value;
 985                     if ( $pki_field eq 'Common Name' ) {
 986                         $value = $ENV{'SSL_CLIENT_S_DN_CN'};
 987                     }
 988                     elsif ( $pki_field eq 'emailAddress' ) {
 989                         $value = $ENV{'SSL_CLIENT_S_DN_Email'};
 990
 991                         # If we're looking up the email, there's a chance that the person
 992                         # doesn't have a userid. So if there is none, we pass along the
 993                         # borrower number, and the bits of code that need to know the user
 994                         # ID will have to be smart enough to handle that.
 995                         require C4::Members;
 996                         my @users_info = C4::Members::GetBorrowersWithEmail($value);
 997                         if (@users_info) {
 998
 999                             # First the userid, then the borrowernum
1000                             $value = $users_info[0][1] || $users_info[0][0];
1001                         } else {
1002                             undef $value;
1003                         }
1004                     }
1005
1006                     $return = $value ? 1 : 0;
1007                     $userid = $value;
1008
1009                 }
1010                 else {
1011                     my $retuserid;
1012                     ( $return, $cardnumber, $retuserid ) =
1013                       checkpw( $dbh, $userid, $password, $query, $type );
1014                     $userid = $retuserid if ($retuserid);
1015                     $info{'invalid_username_or_password'} = 1 unless ($return);
1016                 }
1017             }
1018
1019             # $return: 1 = valid user, 2 = superlibrarian
1020             if ($return) {
1021
1022                 #_session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
1023                 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1024                     $loggedin = 1;
1025                 }
1026                 else {
1027                     $info{'nopermission'} = 1;
1028                     C4::Context->_unset_userenv($sessionID);
1029                 }
1030                 my ( $borrowernumber, $firstname, $surname, $userflags,
1031                     $branchcode, $branchname, $branchprinter, $emailaddress );
1032
1033                 if ( $return == 1 ) {
1034                     my $select = "
1035                     SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1036                     branches.branchname    as branchname,
1037                     branches.branchprinter as branchprinter,
1038                     email
1039                     FROM borrowers
1040                     LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1041                     ";
1042                     my $sth = $dbh->prepare("$select where userid=?");
1043                     $sth->execute($userid);
1044                     unless ( $sth->rows ) {
1045                         $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
1046                         $sth = $dbh->prepare("$select where cardnumber=?");
1047                         $sth->execute($cardnumber);
1048
1049                         unless ( $sth->rows ) {
1050                             $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1051                             $sth->execute($userid);
1052                             unless ( $sth->rows ) {
1053                                 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1054                             }
1055                         }
1056                     }
1057                     if ( $sth->rows ) {
1058                         ( $borrowernumber, $firstname, $surname, $userflags,
1059                             $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow;
1060                         $debug and print STDERR "AUTH_3 results: " .
1061                           "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1062                     } else {
1063                         print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1064                     }
1065
1066                     # launch a sequence to check if we have a ip for the branch, i
1067                     # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1068
1069                     my $ip = $ENV{'REMOTE_ADDR'};
1070
1071                     # if they specify at login, use that
1072                     if ( $query->param('branch') ) {
1073                         $branchcode = $query->param('branch');
1074                         $branchname = GetBranchName($branchcode);
1075                     }
1076                     my $branches = GetBranches();
1077                     if ( C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation') ) {
1078
1079                         # we have to check they are coming from the right ip range
1080                         my $domain = $branches->{$branchcode}->{'branchip'};
1081                         if ( $ip !~ /^$domain/ ) {
1082                             $loggedin = 0;
1083                             $info{'wrongip'} = 1;
1084                         }
1085                     }
1086
1087                     my @branchesloop;
1088                     foreach my $br ( keys %$branches ) {
1089
1090                         #     now we work with the treatment of ip
1091                         my $domain = $branches->{$br}->{'branchip'};
1092                         if ( $domain && $ip =~ /^$domain/ ) {
1093                             $branchcode = $branches->{$br}->{'branchcode'};
1094
1095                             # new op dev : add the branchprinter and branchname in the cookie
1096                             $branchprinter = $branches->{$br}->{'branchprinter'};
1097                             $branchname    = $branches->{$br}->{'branchname'};
1098                         }
1099                     }
1100                     $session->param( 'number',       $borrowernumber );
1101                     $session->param( 'id',           $userid );
1102                     $session->param( 'cardnumber',   $cardnumber );
1103                     $session->param( 'firstname',    $firstname );
1104                     $session->param( 'surname',      $surname );
1105                     $session->param( 'branch',       $branchcode );
1106                     $session->param( 'branchname',   $branchname );
1107                     $session->param( 'flags',        $userflags );
1108                     $session->param( 'emailaddress', $emailaddress );
1109                     $session->param( 'ip',           $session->remote_addr() );
1110                     $session->param( 'lasttime',     time() );
1111                     $session->param( 'shibboleth',   $shibSuccess );
1112                     $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1113                 }
1114                 elsif ( $return == 2 ) {
1115
1116                     #We suppose the user is the superlibrarian
1117                     $borrowernumber = 0;
1118                     $session->param( 'number',       0 );
1119                     $session->param( 'id',           C4::Context->config('user') );
1120                     $session->param( 'cardnumber',   C4::Context->config('user') );
1121                     $session->param( 'firstname',    C4::Context->config('user') );
1122                     $session->param( 'surname',      C4::Context->config('user') );
1123                     $session->param( 'branch',       'NO_LIBRARY_SET' );
1124                     $session->param( 'branchname',   'NO_LIBRARY_SET' );
1125                     $session->param( 'flags',        1 );
1126                     $session->param( 'emailaddress', C4::Context->preference('KohaAdminEmailAddress') );
1127                     $session->param( 'ip',           $session->remote_addr() );
1128                     $session->param( 'lasttime',     time() );
1129                 }
1130                 if ($persona) {
1131                     $session->param( 'persona', 1 );
1132                 }
1133                 C4::Context->set_userenv(
1134                     $session->param('number'),       $session->param('id'),
1135                     $session->param('cardnumber'),   $session->param('firstname'),
1136                     $session->param('surname'),      $session->param('branch'),
1137                     $session->param('branchname'),   $session->param('flags'),
1138                     $session->param('emailaddress'), $session->param('branchprinter'),
1139                     $session->param('persona'),      $session->param('shibboleth')
1140                 );
1141
1142             }
1143             # $return: 0 = invalid user
1144             # reset to anonymous session
1145             else {
1146                 $debug and warn "Login failed, resetting anonymous session...";
1147                 if ($userid) {
1148                     $info{'invalid_username_or_password'} = 1;
1149                     C4::Context->_unset_userenv($sessionID);
1150                 }
1151                 $session->param( 'lasttime', time() );
1152                 $session->param( 'ip',       $session->remote_addr() );
1153                 $session->param( 'sessiontype', 'anon' );
1154             }
1155         }    # END if ( $userid    = $query->param('userid') )
1156         elsif ( $type eq "opac" ) {
1157
1158             # if we are here this is an anonymous session; add public lists to it and a few other items...
1159             # anonymous sessions are created only for the OPAC
1160             $debug and warn "Initiating an anonymous session...";
1161
1162             # setting a couple of other session vars...
1163             $session->param( 'ip',          $session->remote_addr() );
1164             $session->param( 'lasttime',    time() );
1165             $session->param( 'sessiontype', 'anon' );
1166         }
1167     }    # END unless ($userid)
1168
1169     # finished authentification, now respond
1170     if ( $loggedin || $authnotrequired )
1171     {
1172         # successful login
1173         unless ($cookie) {
1174             $cookie = $query->cookie(
1175                 -name     => 'CGISESSID',
1176                 -value    => '',
1177                 -HttpOnly => 1
1178             );
1179         }
1180         return ( $userid, $cookie, $sessionID, $flags );
1181     }
1182
1183     #
1184     #
1185     # AUTH rejected, show the login/password template, after checking the DB.
1186     #
1187     #
1188
1189     # get the inputs from the incoming query
1190     my @inputs = ();
1191     foreach my $name ( param $query) {
1192         (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1193         my $value = $query->param($name);
1194         push @inputs, { name => $name, value => $value };
1195     }
1196
1197     my $LibraryNameTitle = C4::Context->preference("LibraryName");
1198     $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1199     $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1200
1201     my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1202     my $template = C4::Templates::gettemplate( $template_name, $type, $query );
1203     $template->param(
1204         branchloop                            => GetBranchesLoop(),
1205         OpacAdditionalStylesheet                   => C4::Context->preference("OpacAdditionalStylesheet"),
1206         opaclayoutstylesheet                  => C4::Context->preference("opaclayoutstylesheet"),
1207         login                                 => 1,
1208         INPUTS                                => \@inputs,
1209         casAuthentication                     => C4::Context->preference("casAuthentication"),
1210         shibbolethAuthentication              => $shib,
1211         SessionRestrictionByIP                => C4::Context->preference("SessionRestrictionByIP"),
1212         suggestion                            => C4::Context->preference("suggestion"),
1213         virtualshelves                        => C4::Context->preference("virtualshelves"),
1214         LibraryName                           => "" . C4::Context->preference("LibraryName"),
1215         LibraryNameTitle                      => "" . $LibraryNameTitle,
1216         opacuserlogin                         => C4::Context->preference("opacuserlogin"),
1217         OpacNav                               => C4::Context->preference("OpacNav"),
1218         OpacNavRight                          => C4::Context->preference("OpacNavRight"),
1219         OpacNavBottom                         => C4::Context->preference("OpacNavBottom"),
1220         opaccredits                           => C4::Context->preference("opaccredits"),
1221         OpacFavicon                           => C4::Context->preference("OpacFavicon"),
1222         opacreadinghistory                    => C4::Context->preference("opacreadinghistory"),
1223         opaclanguagesdisplay                  => C4::Context->preference("opaclanguagesdisplay"),
1224         OPACUserJS                            => C4::Context->preference("OPACUserJS"),
1225         opacbookbag                           => "" . C4::Context->preference("opacbookbag"),
1226         OpacCloud                             => C4::Context->preference("OpacCloud"),
1227         OpacTopissue                          => C4::Context->preference("OpacTopissue"),
1228         OpacAuthorities                       => C4::Context->preference("OpacAuthorities"),
1229         OpacBrowser                           => C4::Context->preference("OpacBrowser"),
1230         opacheader                            => C4::Context->preference("opacheader"),
1231         TagsEnabled                           => C4::Context->preference("TagsEnabled"),
1232         OPACUserCSS                           => C4::Context->preference("OPACUserCSS"),
1233         intranetcolorstylesheet               => C4::Context->preference("intranetcolorstylesheet"),
1234         intranetstylesheet                    => C4::Context->preference("intranetstylesheet"),
1235         intranetbookbag                       => C4::Context->preference("intranetbookbag"),
1236         IntranetNav                           => C4::Context->preference("IntranetNav"),
1237         IntranetFavicon                       => C4::Context->preference("IntranetFavicon"),
1238         IntranetUserCSS                       => C4::Context->preference("IntranetUserCSS"),
1239         IntranetUserJS                        => C4::Context->preference("IntranetUserJS"),
1240         IndependentBranches                   => C4::Context->preference("IndependentBranches"),
1241         AutoLocation                          => C4::Context->preference("AutoLocation"),
1242         wrongip                               => $info{'wrongip'},
1243         PatronSelfRegistration                => C4::Context->preference("PatronSelfRegistration"),
1244         PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1245         persona                               => C4::Context->preference("Persona"),
1246         opac_css_override                     => $ENV{'OPAC_CSS_OVERRIDE'},
1247     );
1248
1249     $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1250     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1251
1252     if ( $type eq 'opac' ) {
1253         require Koha::Virtualshelves;
1254         my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1255             {
1256                 category       => 2,
1257             }
1258         );
1259         $template->param(
1260             some_public_shelves  => $some_public_shelves,
1261         );
1262     }
1263
1264     if ($cas) {
1265
1266         # Is authentication against multiple CAS servers enabled?
1267         if ( C4::Auth_with_cas::multipleAuth && !$casparam ) {
1268             my $casservers = C4::Auth_with_cas::getMultipleAuth();
1269             my @tmplservers;
1270             foreach my $key ( keys %$casservers ) {
1271                 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1272             }
1273             $template->param(
1274                 casServersLoop => \@tmplservers
1275             );
1276         } else {
1277             $template->param(
1278                 casServerUrl => login_cas_url($query, undef, $type),
1279             );
1280         }
1281
1282         $template->param(
1283             invalidCasLogin => $info{'invalidCasLogin'}
1284         );
1285     }
1286
1287     if ($shib) {
1288         $template->param(
1289             shibbolethAuthentication => $shib,
1290             shibbolethLoginUrl       => login_shib_url($query),
1291         );
1292     }
1293
1294     $template->param(
1295         LibraryName => C4::Context->preference("LibraryName"),
1296     );
1297     $template->param(%info);
1298
1299     #    $cookie = $query->cookie(CGISESSID => $session->id
1300     #   );
1301     print $query->header(
1302         -type    => 'text/html',
1303         -charset => 'utf-8',
1304         -cookie  => $cookie
1305       ),
1306       $template->output;
1307     safe_exit;
1308 }
1309
1310 =head2 check_api_auth
1311
1312   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1313
1314 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1315 cookie, determine if the user has the privileges specified by C<$userflags>.
1316
1317 C<check_api_auth> is is meant for authenticating users of web services, and
1318 consequently will always return and will not attempt to redirect the user
1319 agent.
1320
1321 If a valid session cookie is already present, check_api_auth will return a status
1322 of "ok", the cookie, and the Koha session ID.
1323
1324 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1325 parameters and create a session cookie and Koha session if the supplied credentials
1326 are OK.
1327
1328 Possible return values in C<$status> are:
1329
1330 =over
1331
1332 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1333
1334 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1335
1336 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1337
1338 =item "expired -- session cookie has expired; API user should resubmit userid and password
1339
1340 =back
1341
1342 =cut
1343
1344 sub check_api_auth {
1345     my $query         = shift;
1346     my $flagsrequired = shift;
1347
1348     my $dbh     = C4::Context->dbh;
1349     my $timeout = _timeout_syspref();
1350
1351     unless ( C4::Context->preference('Version') ) {
1352
1353         # database has not been installed yet
1354         return ( "maintenance", undef, undef );
1355     }
1356     my $kohaversion = Koha::version();
1357     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1358     if ( C4::Context->preference('Version') < $kohaversion ) {
1359
1360         # database in need of version update; assume that
1361         # no API should be called while databsae is in
1362         # this condition.
1363         return ( "maintenance", undef, undef );
1364     }
1365
1366     # FIXME -- most of what follows is a copy-and-paste
1367     # of code from checkauth.  There is an obvious need
1368     # for refactoring to separate the various parts of
1369     # the authentication code, but as of 2007-11-19 this
1370     # is deferred so as to not introduce bugs into the
1371     # regular authentication code for Koha 3.0.
1372
1373     # see if we have a valid session cookie already
1374     # however, if a userid parameter is present (i.e., from
1375     # a form submission, assume that any current cookie
1376     # is to be ignored
1377     my $sessionID = undef;
1378     unless ( $query->param('userid') ) {
1379         $sessionID = $query->cookie("CGISESSID");
1380     }
1381     if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1382         my $session = get_session($sessionID);
1383         C4::Context->_new_userenv($sessionID);
1384         if ($session) {
1385             C4::Context->set_userenv(
1386                 $session->param('number'),       $session->param('id'),
1387                 $session->param('cardnumber'),   $session->param('firstname'),
1388                 $session->param('surname'),      $session->param('branch'),
1389                 $session->param('branchname'),   $session->param('flags'),
1390                 $session->param('emailaddress'), $session->param('branchprinter')
1391             );
1392
1393             my $ip       = $session->param('ip');
1394             my $lasttime = $session->param('lasttime');
1395             my $userid   = $session->param('id');
1396             if ( $lasttime < time() - $timeout ) {
1397
1398                 # time out
1399                 $session->delete();
1400                 $session->flush;
1401                 C4::Context->_unset_userenv($sessionID);
1402                 $userid    = undef;
1403                 $sessionID = undef;
1404                 return ( "expired", undef, undef );
1405             } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1406
1407                 # IP address changed
1408                 $session->delete();
1409                 $session->flush;
1410                 C4::Context->_unset_userenv($sessionID);
1411                 $userid    = undef;
1412                 $sessionID = undef;
1413                 return ( "expired", undef, undef );
1414             } else {
1415                 my $cookie = $query->cookie(
1416                     -name     => 'CGISESSID',
1417                     -value    => $session->id,
1418                     -HttpOnly => 1,
1419                 );
1420                 $session->param( 'lasttime', time() );
1421                 my $flags = haspermission( $userid, $flagsrequired );
1422                 if ($flags) {
1423                     return ( "ok", $cookie, $sessionID );
1424                 } else {
1425                     $session->delete();
1426                     $session->flush;
1427                     C4::Context->_unset_userenv($sessionID);
1428                     $userid    = undef;
1429                     $sessionID = undef;
1430                     return ( "failed", undef, undef );
1431                 }
1432             }
1433         } else {
1434             return ( "expired", undef, undef );
1435         }
1436     } else {
1437
1438         # new login
1439         my $userid   = $query->param('userid');
1440         my $password = $query->param('password');
1441         my ( $return, $cardnumber );
1442
1443         # Proxy CAS auth
1444         if ( $cas && $query->param('PT') ) {
1445             my $retuserid;
1446             $debug and print STDERR "## check_api_auth - checking CAS\n";
1447
1448             # In case of a CAS authentication, we use the ticket instead of the password
1449             my $PT = $query->param('PT');
1450             ( $return, $cardnumber, $userid ) = check_api_auth_cas( $dbh, $PT, $query );    # EXTERNAL AUTH
1451         } else {
1452
1453             # User / password auth
1454             unless ( $userid and $password ) {
1455
1456                 # caller did something wrong, fail the authenticateion
1457                 return ( "failed", undef, undef );
1458             }
1459             ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password, $query );
1460         }
1461
1462         if ( $return and haspermission( $userid, $flagsrequired ) ) {
1463             my $session = get_session("");
1464             return ( "failed", undef, undef ) unless $session;
1465
1466             my $sessionID = $session->id;
1467             C4::Context->_new_userenv($sessionID);
1468             my $cookie = $query->cookie(
1469                 -name     => 'CGISESSID',
1470                 -value    => $sessionID,
1471                 -HttpOnly => 1,
1472             );
1473             if ( $return == 1 ) {
1474                 my (
1475                     $borrowernumber, $firstname,  $surname,
1476                     $userflags,      $branchcode, $branchname,
1477                     $branchprinter,  $emailaddress
1478                 );
1479                 my $sth =
1480                   $dbh->prepare(
1481 "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=?"
1482                   );
1483                 $sth->execute($userid);
1484                 (
1485                     $borrowernumber, $firstname,  $surname,
1486                     $userflags,      $branchcode, $branchname,
1487                     $branchprinter,  $emailaddress
1488                 ) = $sth->fetchrow if ( $sth->rows );
1489
1490                 unless ( $sth->rows ) {
1491                     my $sth = $dbh->prepare(
1492 "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=?"
1493                     );
1494                     $sth->execute($cardnumber);
1495                     (
1496                         $borrowernumber, $firstname,  $surname,
1497                         $userflags,      $branchcode, $branchname,
1498                         $branchprinter,  $emailaddress
1499                     ) = $sth->fetchrow if ( $sth->rows );
1500
1501                     unless ( $sth->rows ) {
1502                         $sth->execute($userid);
1503                         (
1504                             $borrowernumber, $firstname,  $surname,       $userflags,
1505                             $branchcode,     $branchname, $branchprinter, $emailaddress
1506                         ) = $sth->fetchrow if ( $sth->rows );
1507                     }
1508                 }
1509
1510                 my $ip = $ENV{'REMOTE_ADDR'};
1511
1512                 # if they specify at login, use that
1513                 if ( $query->param('branch') ) {
1514                     $branchcode = $query->param('branch');
1515                     $branchname = GetBranchName($branchcode);
1516                 }
1517                 my $branches = GetBranches();
1518                 my @branchesloop;
1519                 foreach my $br ( keys %$branches ) {
1520
1521                     #     now we work with the treatment of ip
1522                     my $domain = $branches->{$br}->{'branchip'};
1523                     if ( $domain && $ip =~ /^$domain/ ) {
1524                         $branchcode = $branches->{$br}->{'branchcode'};
1525
1526                         # new op dev : add the branchprinter and branchname in the cookie
1527                         $branchprinter = $branches->{$br}->{'branchprinter'};
1528                         $branchname    = $branches->{$br}->{'branchname'};
1529                     }
1530                 }
1531                 $session->param( 'number',       $borrowernumber );
1532                 $session->param( 'id',           $userid );
1533                 $session->param( 'cardnumber',   $cardnumber );
1534                 $session->param( 'firstname',    $firstname );
1535                 $session->param( 'surname',      $surname );
1536                 $session->param( 'branch',       $branchcode );
1537                 $session->param( 'branchname',   $branchname );
1538                 $session->param( 'flags',        $userflags );
1539                 $session->param( 'emailaddress', $emailaddress );
1540                 $session->param( 'ip',           $session->remote_addr() );
1541                 $session->param( 'lasttime',     time() );
1542             } elsif ( $return == 2 ) {
1543
1544                 #We suppose the user is the superlibrarian
1545                 $session->param( 'number',       0 );
1546                 $session->param( 'id',           C4::Context->config('user') );
1547                 $session->param( 'cardnumber',   C4::Context->config('user') );
1548                 $session->param( 'firstname',    C4::Context->config('user') );
1549                 $session->param( 'surname',      C4::Context->config('user') );
1550                 $session->param( 'branch',       'NO_LIBRARY_SET' );
1551                 $session->param( 'branchname',   'NO_LIBRARY_SET' );
1552                 $session->param( 'flags',        1 );
1553                 $session->param( 'emailaddress', C4::Context->preference('KohaAdminEmailAddress') );
1554                 $session->param( 'ip',           $session->remote_addr() );
1555                 $session->param( 'lasttime',     time() );
1556             }
1557             C4::Context->set_userenv(
1558                 $session->param('number'),       $session->param('id'),
1559                 $session->param('cardnumber'),   $session->param('firstname'),
1560                 $session->param('surname'),      $session->param('branch'),
1561                 $session->param('branchname'),   $session->param('flags'),
1562                 $session->param('emailaddress'), $session->param('branchprinter')
1563             );
1564             return ( "ok", $cookie, $sessionID );
1565         } else {
1566             return ( "failed", undef, undef );
1567         }
1568     }
1569 }
1570
1571 =head2 check_cookie_auth
1572
1573   ($status, $sessionId) = check_api_auth($cookie, $userflags);
1574
1575 Given a CGISESSID cookie set during a previous login to Koha, determine
1576 if the user has the privileges specified by C<$userflags>.
1577
1578 C<check_cookie_auth> is meant for authenticating special services
1579 such as tools/upload-file.pl that are invoked by other pages that
1580 have been authenticated in the usual way.
1581
1582 Possible return values in C<$status> are:
1583
1584 =over
1585
1586 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1587
1588 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1589
1590 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1591
1592 =item "expired -- session cookie has expired; API user should resubmit userid and password
1593
1594 =back
1595
1596 =cut
1597
1598 sub check_cookie_auth {
1599     my $cookie        = shift;
1600     my $flagsrequired = shift;
1601
1602     my $dbh     = C4::Context->dbh;
1603     my $timeout = _timeout_syspref();
1604
1605     unless ( C4::Context->preference('Version') ) {
1606
1607         # database has not been installed yet
1608         return ( "maintenance", undef );
1609     }
1610     my $kohaversion = Koha::version();
1611     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1612     if ( C4::Context->preference('Version') < $kohaversion ) {
1613
1614         # database in need of version update; assume that
1615         # no API should be called while databsae is in
1616         # this condition.
1617         return ( "maintenance", undef );
1618     }
1619
1620     # FIXME -- most of what follows is a copy-and-paste
1621     # of code from checkauth.  There is an obvious need
1622     # for refactoring to separate the various parts of
1623     # the authentication code, but as of 2007-11-23 this
1624     # is deferred so as to not introduce bugs into the
1625     # regular authentication code for Koha 3.0.
1626
1627     # see if we have a valid session cookie already
1628     # however, if a userid parameter is present (i.e., from
1629     # a form submission, assume that any current cookie
1630     # is to be ignored
1631     unless ( defined $cookie and $cookie ) {
1632         return ( "failed", undef );
1633     }
1634     my $sessionID = $cookie;
1635     my $session   = get_session($sessionID);
1636     C4::Context->_new_userenv($sessionID);
1637     if ($session) {
1638         C4::Context->set_userenv(
1639             $session->param('number'),       $session->param('id'),
1640             $session->param('cardnumber'),   $session->param('firstname'),
1641             $session->param('surname'),      $session->param('branch'),
1642             $session->param('branchname'),   $session->param('flags'),
1643             $session->param('emailaddress'), $session->param('branchprinter')
1644         );
1645
1646         my $ip       = $session->param('ip');
1647         my $lasttime = $session->param('lasttime');
1648         my $userid   = $session->param('id');
1649         if ( $lasttime < time() - $timeout ) {
1650
1651             # time out
1652             $session->delete();
1653             $session->flush;
1654             C4::Context->_unset_userenv($sessionID);
1655             $userid    = undef;
1656             $sessionID = undef;
1657             return ("expired", undef);
1658         } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1659
1660             # IP address changed
1661             $session->delete();
1662             $session->flush;
1663             C4::Context->_unset_userenv($sessionID);
1664             $userid    = undef;
1665             $sessionID = undef;
1666             return ( "expired", undef );
1667         } else {
1668             $session->param( 'lasttime', time() );
1669             my $flags = haspermission( $userid, $flagsrequired );
1670             if ($flags) {
1671                 return ( "ok", $sessionID );
1672             } else {
1673                 $session->delete();
1674                 $session->flush;
1675                 C4::Context->_unset_userenv($sessionID);
1676                 $userid    = undef;
1677                 $sessionID = undef;
1678                 return ( "failed", undef );
1679             }
1680         }
1681     } else {
1682         return ( "expired", undef );
1683     }
1684 }
1685
1686 =head2 get_session
1687
1688   use CGI::Session;
1689   my $session = get_session($sessionID);
1690
1691 Given a session ID, retrieve the CGI::Session object used to store
1692 the session's state.  The session object can be used to store
1693 data that needs to be accessed by different scripts during a
1694 user's session.
1695
1696 If the C<$sessionID> parameter is an empty string, a new session
1697 will be created.
1698
1699 =cut
1700
1701 sub get_session {
1702     my $sessionID      = shift;
1703     my $storage_method = C4::Context->preference('SessionStorage');
1704     my $dbh            = C4::Context->dbh;
1705     my $session;
1706     if ( $storage_method eq 'mysql' ) {
1707         $session = new CGI::Session( "driver:MySQL;serializer:yaml;id:md5", $sessionID, { Handle => $dbh } );
1708     }
1709     elsif ( $storage_method eq 'Pg' ) {
1710         $session = new CGI::Session( "driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, { Handle => $dbh } );
1711     }
1712     elsif ( $storage_method eq 'memcached' && C4::Context->ismemcached ) {
1713         $session = new CGI::Session( "driver:memcached;serializer:yaml;id:md5", $sessionID, { Memcached => C4::Context->memcached } );
1714     }
1715     else {
1716         # catch all defaults to tmp should work on all systems
1717         my $dir = File::Spec->tmpdir;
1718         my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1719         $session = new CGI::Session( "driver:File;serializer:yaml;id:md5", $sessionID, { Directory => "$dir/cgisess_$instance" } );
1720     }
1721     return $session;
1722 }
1723
1724 sub checkpw {
1725     my ( $dbh, $userid, $password, $query, $type ) = @_;
1726     $type = 'opac' unless $type;
1727     if ($ldap) {
1728         $debug and print STDERR "## checkpw - checking LDAP\n";
1729         my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_);    # EXTERNAL AUTH
1730         return 0 if $retval == -1;                                  # Incorrect password for LDAP login attempt
1731         ($retval) and return ( $retval, $retcard, $retuserid );
1732     }
1733
1734     if ( $cas && $query && $query->param('ticket') ) {
1735         $debug and print STDERR "## checkpw - checking CAS\n";
1736
1737         # In case of a CAS authentication, we use the ticket instead of the password
1738         my $ticket = $query->param('ticket');
1739         $query->delete('ticket');                                   # remove ticket to come back to original URL
1740         my ( $retval, $retcard, $retuserid ) = checkpw_cas( $dbh, $ticket, $query, $type );    # EXTERNAL AUTH
1741         ($retval) and return ( $retval, $retcard, $retuserid );
1742         return 0;
1743     }
1744
1745     # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1746     # Check for password to asertain whether we want to be testing against shibboleth or another method this
1747     # time around.
1748     if ( $shib && $shib_login && !$password ) {
1749
1750         $debug and print STDERR "## checkpw - checking Shibboleth\n";
1751
1752         # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1753         # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1754         # shibboleth-authenticated user
1755
1756         # Then, we check if it matches a valid koha user
1757         if ($shib_login) {
1758             my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login);    # EXTERNAL AUTH
1759             ($retval) and return ( $retval, $retcard, $retuserid );
1760             return 0;
1761         }
1762     }
1763
1764     # INTERNAL AUTH
1765     return checkpw_internal(@_)
1766 }
1767
1768 sub checkpw_internal {
1769     my ( $dbh, $userid, $password ) = @_;
1770
1771     $password = Encode::encode( 'UTF-8', $password )
1772       if Encode::is_utf8($password);
1773
1774     if ( $userid && $userid eq C4::Context->config('user') ) {
1775         if ( $password && $password eq C4::Context->config('pass') ) {
1776
1777             # Koha superuser account
1778             #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1779             return 2;
1780         }
1781         else {
1782             return 0;
1783         }
1784     }
1785
1786     my $sth =
1787       $dbh->prepare(
1788         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1789       );
1790     $sth->execute($userid);
1791     if ( $sth->rows ) {
1792         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1793             $surname, $branchcode, $branchname, $flags )
1794           = $sth->fetchrow;
1795
1796         if ( checkpw_hash( $password, $stored_hash ) ) {
1797
1798             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1799                 $firstname, $surname, $branchcode, $branchname, $flags );
1800             return 1, $cardnumber, $userid;
1801         }
1802     }
1803     $sth =
1804       $dbh->prepare(
1805         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1806       );
1807     $sth->execute($userid);
1808     if ( $sth->rows ) {
1809         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1810             $surname, $branchcode, $branchname, $flags )
1811           = $sth->fetchrow;
1812
1813         if ( checkpw_hash( $password, $stored_hash ) ) {
1814
1815             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1816                 $firstname, $surname, $branchcode, $branchname, $flags );
1817             return 1, $cardnumber, $userid;
1818         }
1819     }
1820     if ( $userid && $userid eq 'demo'
1821         && "$password" eq 'demo'
1822         && C4::Context->config('demo') )
1823     {
1824
1825         # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1826         # some features won't be effective : modify systempref, modify MARC structure,
1827         return 2;
1828     }
1829     return 0;
1830 }
1831
1832 sub checkpw_hash {
1833     my ( $password, $stored_hash ) = @_;
1834
1835     return if $stored_hash eq '!';
1836
1837     # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1838     my $hash;
1839     if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1840         $hash = hash_password( $password, $stored_hash );
1841     } else {
1842         $hash = md5_base64($password);
1843     }
1844     return $hash eq $stored_hash;
1845 }
1846
1847 =head2 getuserflags
1848
1849     my $authflags = getuserflags($flags, $userid, [$dbh]);
1850
1851 Translates integer flags into permissions strings hash.
1852
1853 C<$flags> is the integer userflags value ( borrowers.userflags )
1854 C<$userid> is the members.userid, used for building subpermissions
1855 C<$authflags> is a hashref of permissions
1856
1857 =cut
1858
1859 sub getuserflags {
1860     my $flags  = shift;
1861     my $userid = shift;
1862     my $dbh    = @_ ? shift : C4::Context->dbh;
1863     my $userflags;
1864     {
1865         # I don't want to do this, but if someone logs in as the database
1866         # user, it would be preferable not to spam them to death with
1867         # numeric warnings. So, we make $flags numeric.
1868         no warnings 'numeric';
1869         $flags += 0;
1870     }
1871     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1872     $sth->execute;
1873
1874     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1875         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1876             $userflags->{$flag} = 1;
1877         }
1878         else {
1879             $userflags->{$flag} = 0;
1880         }
1881     }
1882
1883     # get subpermissions and merge with top-level permissions
1884     my $user_subperms = get_user_subpermissions($userid);
1885     foreach my $module ( keys %$user_subperms ) {
1886         next if $userflags->{$module} == 1;    # user already has permission for everything in this module
1887         $userflags->{$module} = $user_subperms->{$module};
1888     }
1889
1890     return $userflags;
1891 }
1892
1893 =head2 get_user_subpermissions
1894
1895   $user_perm_hashref = get_user_subpermissions($userid);
1896
1897 Given the userid (note, not the borrowernumber) of a staff user,
1898 return a hashref of hashrefs of the specific subpermissions
1899 accorded to the user.  An example return is
1900
1901  {
1902     tools => {
1903         export_catalog => 1,
1904         import_patrons => 1,
1905     }
1906  }
1907
1908 The top-level hash-key is a module or function code from
1909 userflags.flag, while the second-level key is a code
1910 from permissions.
1911
1912 The results of this function do not give a complete picture
1913 of the functions that a staff user can access; it is also
1914 necessary to check borrowers.flags.
1915
1916 =cut
1917
1918 sub get_user_subpermissions {
1919     my $userid = shift;
1920
1921     my $dbh = C4::Context->dbh;
1922     my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
1923                              FROM user_permissions
1924                              JOIN permissions USING (module_bit, code)
1925                              JOIN userflags ON (module_bit = bit)
1926                              JOIN borrowers USING (borrowernumber)
1927                              WHERE userid = ?" );
1928     $sth->execute($userid);
1929
1930     my $user_perms = {};
1931     while ( my $perm = $sth->fetchrow_hashref ) {
1932         $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1933     }
1934     return $user_perms;
1935 }
1936
1937 =head2 get_all_subpermissions
1938
1939   my $perm_hashref = get_all_subpermissions();
1940
1941 Returns a hashref of hashrefs defining all specific
1942 permissions currently defined.  The return value
1943 has the same structure as that of C<get_user_subpermissions>,
1944 except that the innermost hash value is the description
1945 of the subpermission.
1946
1947 =cut
1948
1949 sub get_all_subpermissions {
1950     my $dbh = C4::Context->dbh;
1951     my $sth = $dbh->prepare( "SELECT flag, code
1952                              FROM permissions
1953                              JOIN userflags ON (module_bit = bit)" );
1954     $sth->execute();
1955
1956     my $all_perms = {};
1957     while ( my $perm = $sth->fetchrow_hashref ) {
1958         $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1959     }
1960     return $all_perms;
1961 }
1962
1963 =head2 haspermission
1964
1965   $flags = ($userid, $flagsrequired);
1966
1967 C<$userid> the userid of the member
1968 C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
1969
1970 Returns member's flags or 0 if a permission is not met.
1971
1972 =cut
1973
1974 sub haspermission {
1975     my ( $userid, $flagsrequired ) = @_;
1976     my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1977     $sth->execute($userid);
1978     my $row = $sth->fetchrow();
1979     my $flags = getuserflags( $row, $userid );
1980     if ( $userid eq C4::Context->config('user') ) {
1981
1982         # Super User Account from /etc/koha.conf
1983         $flags->{'superlibrarian'} = 1;
1984     }
1985     elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
1986
1987         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1988         $flags->{'superlibrarian'} = 1;
1989     }
1990
1991     return $flags if $flags->{superlibrarian};
1992
1993     foreach my $module ( keys %$flagsrequired ) {
1994         my $subperm = $flagsrequired->{$module};
1995         if ( $subperm eq '*' ) {
1996             return 0 unless ( $flags->{$module} == 1 or ref( $flags->{$module} ) );
1997         } else {
1998             return 0 unless (
1999                 ( defined $flags->{$module} and
2000                     $flags->{$module} == 1 )
2001                 or
2002                 ( ref( $flags->{$module} ) and
2003                     exists $flags->{$module}->{$subperm} and
2004                     $flags->{$module}->{$subperm} == 1 )
2005             );
2006         }
2007     }
2008     return $flags;
2009
2010     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2011 }
2012
2013 sub getborrowernumber {
2014     my ($userid) = @_;
2015     my $userenv = C4::Context->userenv;
2016     if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2017         return $userenv->{number};
2018     }
2019     my $dbh = C4::Context->dbh;
2020     for my $field ( 'userid', 'cardnumber' ) {
2021         my $sth =
2022           $dbh->prepare("select borrowernumber from borrowers where $field=?");
2023         $sth->execute($userid);
2024         if ( $sth->rows ) {
2025             my ($bnumber) = $sth->fetchrow;
2026             return $bnumber;
2027         }
2028     }
2029     return 0;
2030 }
2031
2032 END { }    # module clean-up code here (global destructor)
2033 1;
2034 __END__
2035
2036 =head1 SEE ALSO
2037
2038 CGI(3)
2039
2040 C4::Output(3)
2041
2042 Crypt::Eksblowfish::Bcrypt(3)
2043
2044 Digest::MD5(3)
2045
2046 =cut