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