C4/Auth.pm

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