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 POSIX qw/strftime/;
  37 use List::MoreUtils qw/ any /;
  38 use Encode qw( encode is_utf8);
  39
  40 # use utf8;
  41 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout $shib $shib_login);
  42
  43 BEGIN {
  44     sub psgi_env { any { /^psgi\./ } keys %ENV }
  45
  46     sub safe_exit {
  47         if   (psgi_env) { die 'psgi:exit' }
  48         else            { exit }
  49     }
  50     $VERSION = 3.07.00.049;    # set version for version checking
  51
  52     $debug     = $ENV{DEBUG};
  53     @ISA       = qw(Exporter);
  54     @EXPORT    = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
  55     @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash
  56       &get_all_subpermissions &get_user_subpermissions
  57     );
  58     %EXPORT_TAGS = ( EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)] );
  59     $ldap      = C4::Context->config('useldapserver') || 0;
  60     $cas       = C4::Context->preference('casAuthentication');
  61     $shib      = C4::Context->config('useshibboleth') || 0;
  62     $caslogout = C4::Context->preference('casLogout');
  63     require C4::Auth_with_cas;    # no import
  64
  65     if ($ldap) {
  66         require C4::Auth_with_ldap;
  67         import C4::Auth_with_ldap qw(checkpw_ldap);
  68     }
  69     if ($shib) {
  70         require C4::Auth_with_shibboleth;
  71         import C4::Auth_with_shibboleth
  72           qw(shib_ok checkpw_shib logout_shib login_shib_url get_login_shib);
  73
  74         # Check for good config
  75         if ( shib_ok() ) {
  76
  77             # Get shibboleth login attribute
  78             $shib_login = get_login_shib();
  79         }
  80
  81         # Bad config, disable shibboleth
  82         else {
  83             $shib = 0;
  84         }
  85     }
  86     if ($cas) {
  87         import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url);
  88     }
  89
  90 }
  91
  92 =head1 NAME
  93
  94 C4::Auth - Authenticates Koha users
  95
  96 =head1 SYNOPSIS
  97
  98   use CGI qw ( -utf8 );
  99   use C4::Auth;
 100   use C4::Output;
 101
 102   my $query = new CGI;
 103
 104   my ($template, $borrowernumber, $cookie)
 105     = get_template_and_user(
 106         {
 107             template_name   => "opac-main.tt",
 108             query           => $query,
 109       type            => "opac",
 110       authnotrequired => 0,
 111       flagsrequired   => { catalogue => '*', tools => 'import_patrons' },
 112   }
 113     );
 114
 115   output_html_with_http_headers $query, $cookie, $template->output;
 116
 117 =head1 DESCRIPTION
 118
 119 The main function of this module is to provide
 120 authentification. However the get_template_and_user function has
 121 been provided so that a users login information is passed along
 122 automatically. This gets loaded into the template.
 123
 124 =head1 FUNCTIONS
 125
 126 =head2 get_template_and_user
 127
 128  my ($template, $borrowernumber, $cookie)
 129      = get_template_and_user(
 130        {
 131          template_name   => "opac-main.tt",
 132          query           => $query,
 133          type            => "opac",
 134          authnotrequired => 0,
 135          flagsrequired   => { catalogue => '*', tools => 'import_patrons' },
 136        }
 137      );
 138
 139 This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
 140 to C<&checkauth> (in this module) to perform authentification.
 141 See C<&checkauth> for an explanation of these parameters.
 142
 143 The C<template_name> is then used to find the correct template for
 144 the page. The authenticated users details are loaded onto the
 145 template in the HTML::Template LOOP variable C<USER_INFO>. Also the
 146 C<sessionID> is passed to the template. This can be used in templates
 147 if cookies are disabled. It needs to be put as and input to every
 148 authenticated page.
 149
 150 More information on the C<gettemplate> sub can be found in the
 151 Output.pm module.
 152
 153 =cut
 154
 155 sub get_template_and_user {
 156
 157     my $in = shift;
 158     my ( $user, $cookie, $sessionID, $flags );
 159
 160     C4::Context->interface( $in->{type} );
 161
 162     my $safe_chars = 'a-zA-Z0-9_\-\/';
 163     die "bad template path" unless $in->{'template_name'} =~ m/^[$safe_chars]+\.tt$/ig; #sanitize input
 164
 165     $in->{'authnotrequired'} ||= 0;
 166     my $template = C4::Templates::gettemplate(
 167         $in->{'template_name'},
 168         $in->{'type'},
 169         $in->{'query'},
 170         $in->{'is_plugin'}
 171     );
 172
 173     if ( $in->{'template_name'} !~ m/maintenance/ ) {
 174         ( $user, $cookie, $sessionID, $flags ) = checkauth(
 175             $in->{'query'},
 176             $in->{'authnotrequired'},
 177             $in->{'flagsrequired'},
 178             $in->{'type'}
 179         );
 180     }
 181
 182
 183     # 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
 184     if ( $in->{type} eq 'opac' and $in->{template_name} !~ m|sco/| ) {
 185         if (  C4::Context->preference('AutoSelfCheckID') && $user eq C4::Context->preference('AutoSelfCheckID') ) {
 186             $template = C4::Templates::gettemplate( 'opac-auth.tt', 'opac', $in->{query} );
 187             my $cookie = $in->{query}->cookie(
 188                 -name     => 'CGISESSID',
 189                 -value    => '',
 190                 -expires  => '',
 191                 -HttpOnly => 1,
 192             );
 193
 194             $template->param(
 195                 loginprompt => 1,
 196                 script_name => _get_script_name(),
 197             );
 198             print $in->{query}->header(
 199                 {   type              => 'text/html',
 200                     charset           => 'utf-8',
 201                     cookie            => $cookie,
 202                     'X-Frame-Options' => 'SAMEORIGIN'
 203                 }
 204               ),
 205             $template->output;
 206             safe_exit;
 207         }
 208     }
 209
 210     my $borrowernumber;
 211     if ($user) {
 212         require C4::Members;
 213
 214         # It's possible for $user to be the borrowernumber if they don't have a
 215         # userid defined (and are logging in through some other method, such
 216         # as SSL certs against an email address)
 217         my $borrower;
 218         $borrowernumber = getborrowernumber($user) if defined($user);
 219         if ( !defined($borrowernumber) && defined($user) ) {
 220             $borrower = C4::Members::GetMember( borrowernumber => $user );
 221             if ($borrower) {
 222                 $borrowernumber = $user;
 223
 224                 # A bit of a hack, but I don't know there's a nicer way
 225                 # to do it.
 226                 $user = $borrower->{firstname} . ' ' . $borrower->{surname};
 227             }
 228         } else {
 229             $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
 230         }
 231
 232         # user info
 233         $template->param( loggedinusername   => $user );
 234         $template->param( loggedinusernumber => $borrowernumber );
 235         $template->param( sessionID          => $sessionID );
 236
 237         if ( $in->{'type'} eq 'opac' ) {
 238             require Koha::Virtualshelves;
 239             my $some_private_shelves = Koha::Virtualshelves->get_some_shelves(
 240                 {
 241                     borrowernumber => $borrowernumber,
 242                     category       => 1,
 243                 }
 244             );
 245             my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
 246                 {
 247                     category       => 2,
 248                 }
 249             );
 250             $template->param(
 251                 some_private_shelves => $some_private_shelves,
 252                 some_public_shelves  => $some_public_shelves,
 253             );
 254         }
 255
 256         $template->param( "USER_INFO" => $borrower );
 257
 258         my $all_perms = get_all_subpermissions();
 259
 260         my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
 261           editcatalogue updatecharges management tools editauthorities serials reports acquisition);
 262
 263         # We are going to use the $flags returned by checkauth
 264         # to create the template's parameters that will indicate
 265         # which menus the user can access.
 266         if ( $flags && $flags->{superlibrarian} == 1 ) {
 267             $template->param( CAN_user_circulate        => 1 );
 268             $template->param( CAN_user_catalogue        => 1 );
 269             $template->param( CAN_user_parameters       => 1 );
 270             $template->param( CAN_user_borrowers        => 1 );
 271             $template->param( CAN_user_permissions      => 1 );
 272             $template->param( CAN_user_reserveforothers => 1 );
 273             $template->param( CAN_user_editcatalogue    => 1 );
 274             $template->param( CAN_user_updatecharges    => 1 );
 275             $template->param( CAN_user_acquisition      => 1 );
 276             $template->param( CAN_user_management       => 1 );
 277             $template->param( CAN_user_tools            => 1 );
 278             $template->param( CAN_user_editauthorities  => 1 );
 279             $template->param( CAN_user_serials          => 1 );
 280             $template->param( CAN_user_reports          => 1 );
 281             $template->param( CAN_user_staffaccess      => 1 );
 282             $template->param( CAN_user_plugins          => 1 );
 283             $template->param( CAN_user_coursereserves   => 1 );
 284             foreach my $module ( keys %$all_perms ) {
 285
 286                 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
 287                     $template->param( "CAN_user_${module}_${subperm}" => 1 );
 288                 }
 289             }
 290         }
 291
 292         if ($flags) {
 293             foreach my $module ( keys %$all_perms ) {
 294                 if ( defined($flags->{$module}) && $flags->{$module} == 1 ) {
 295                     foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
 296                         $template->param( "CAN_user_${module}_${subperm}" => 1 );
 297                     }
 298                 } elsif ( ref( $flags->{$module} ) ) {
 299                     foreach my $subperm ( keys %{ $flags->{$module} } ) {
 300                         $template->param( "CAN_user_${module}_${subperm}" => 1 );
 301                     }
 302                 }
 303             }
 304         }
 305
 306         if ($flags) {
 307             foreach my $module ( keys %$flags ) {
 308                 if ( $flags->{$module} == 1 or ref( $flags->{$module} ) ) {
 309                     $template->param( "CAN_user_$module" => 1 );
 310                     if ( $module eq "parameters" ) {
 311                         $template->param( CAN_user_management => 1 );
 312                     }
 313                 }
 314             }
 315         }
 316
 317         # Logged-in opac search history
 318         # If the requested template is an opac one and opac search history is enabled
 319         if ( $in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory') ) {
 320             my $dbh   = C4::Context->dbh;
 321             my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
 322             my $sth   = $dbh->prepare($query);
 323             $sth->execute($borrowernumber);
 324
 325             # If at least one search has already been performed
 326             if ( $sth->fetchrow_array > 0 ) {
 327
 328                 # We show the link in opac
 329                 $template->param( EnableOpacSearchHistory => 1 );
 330             }
 331
 332             # And if there are searches performed when the user was not logged in,
 333             # we add them to the logged-in search history
 334             my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
 335             if (@recentSearches) {
 336                 my $dbh   = C4::Context->dbh;
 337                 my $query = q{
 338                     INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, type,  total, time )
 339                     VALUES (?, ?, ?, ?, ?, ?, ?)
 340                 };
 341
 342                 my $sth = $dbh->prepare($query);
 343                 $sth->execute( $borrowernumber,
 344                     $in->{query}->cookie("CGISESSID"),
 345                     $_->{query_desc},
 346                     $_->{query_cgi},
 347                     $_->{type} || 'biblio',
 348                     $_->{total},
 349                     $_->{time},
 350                 ) foreach @recentSearches;
 351
 352                 # clear out the search history from the session now that
 353                 # we've saved it to the database
 354                 C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } );
 355             }
 356         } elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) {
 357             $template->param( EnableSearchHistory => 1 );
 358         }
 359     }
 360     else {    # if this is an anonymous session, setup to display public lists...
 361
 362         # If shibboleth is enabled, and we're in an anonymous session, we should allow
 363         # the user to attempt login via shibboleth.
 364         if ($shib) {
 365             $template->param( shibbolethAuthentication => $shib,
 366                 shibbolethLoginUrl => login_shib_url( $in->{'query'} ),
 367             );
 368
 369             # If shibboleth is enabled and we have a shibboleth login attribute,
 370             # but we are in an anonymous session, then we clearly have an invalid
 371             # shibboleth koha account.
 372             if ($shib_login) {
 373                 $template->param( invalidShibLogin => '1' );
 374             }
 375         }
 376
 377         $template->param( sessionID => $sessionID );
 378
 379         if ( $in->{'type'} eq 'opac' ){
 380             require Koha::Virtualshelves;
 381             my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
 382                 {
 383                     category       => 2,
 384                 }
 385             );
 386             $template->param(
 387                 some_public_shelves  => $some_public_shelves,
 388             );
 389         }
 390     }
 391
 392     # Anonymous opac search history
 393     # If opac search history is enabled and at least one search has already been performed
 394     if ( C4::Context->preference('EnableOpacSearchHistory') ) {
 395         my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
 396         if (@recentSearches) {
 397             $template->param( EnableOpacSearchHistory => 1 );
 398         }
 399     }
 400
 401     if ( C4::Context->preference('dateformat') ) {
 402         $template->param( dateformat => C4::Context->preference('dateformat') );
 403     }
 404
 405     $template->param(auth_forwarded_hash => scalar $in->{'query'}->param('auth_forwarded_hash'));
 406
 407     # these template parameters are set the same regardless of $in->{'type'}
 408
 409     # Set the using_https variable for templates
 410     # FIXME Under Plack the CGI->https method always returns 'OFF'
 411     my $https = $in->{query}->https();
 412     my $using_https = ( defined $https and $https ne 'OFF' ) ? 1 : 0;
 413
 414     $template->param(
 415         "BiblioDefaultView" . C4::Context->preference("BiblioDefaultView") => 1,
 416         EnhancedMessagingPreferences                                       => C4::Context->preference('EnhancedMessagingPreferences'),
 417         GoogleJackets                                                      => C4::Context->preference("GoogleJackets"),
 418         OpenLibraryCovers                                                  => C4::Context->preference("OpenLibraryCovers"),
 419         KohaAdminEmailAddress                                              => "" . C4::Context->preference("KohaAdminEmailAddress"),
 420         LoginBranchcode => ( C4::Context->userenv ? C4::Context->userenv->{"branch"}    : undef ),
 421         LoginFirstname  => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
 422         LoginSurname    => C4::Context->userenv ? C4::Context->userenv->{"surname"}      : "Inconnu",
 423         emailaddress    => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
 424         loggedinpersona => C4::Context->userenv ? C4::Context->userenv->{"persona"}      : undef,
 425         TagsEnabled     => C4::Context->preference("TagsEnabled"),
 426         hide_marc       => C4::Context->preference("hide_marc"),
 427         item_level_itypes  => C4::Context->preference('item-level_itypes'),
 428         patronimages       => C4::Context->preference("patronimages"),
 429         singleBranchMode   => C4::Context->preference("singleBranchMode"),
 430         XSLTDetailsDisplay => C4::Context->preference("XSLTDetailsDisplay"),
 431         XSLTResultsDisplay => C4::Context->preference("XSLTResultsDisplay"),
 432         using_https        => $using_https,
 433         noItemTypeImages   => C4::Context->preference("noItemTypeImages"),
 434         marcflavour        => C4::Context->preference("marcflavour"),
 435         persona            => C4::Context->preference("persona"),
 436         OPACBaseURL        => C4::Context->preference('OPACBaseURL'),
 437     );
 438     if ( $in->{'type'} eq "intranet" ) {
 439         $template->param(
 440             AmazonCoverImages                                                          => C4::Context->preference("AmazonCoverImages"),
 441             AutoLocation                                                               => C4::Context->preference("AutoLocation"),
 442             "BiblioDefaultView" . C4::Context->preference("IntranetBiblioDefaultView") => 1,
 443             CircAutocompl                                                              => C4::Context->preference("CircAutocompl"),
 444             FRBRizeEditions                                                            => C4::Context->preference("FRBRizeEditions"),
 445             IndependentBranches                                                        => C4::Context->preference("IndependentBranches"),
 446             IntranetNav                                                                => C4::Context->preference("IntranetNav"),
 447             IntranetmainUserblock                                                      => C4::Context->preference("IntranetmainUserblock"),
 448             LibraryName                                                                => C4::Context->preference("LibraryName"),
 449             LoginBranchname                                                            => ( C4::Context->userenv ? C4::Context->userenv->{"branchname"} : undef ),
 450             advancedMARCEditor                                                         => C4::Context->preference("advancedMARCEditor"),
 451             canreservefromotherbranches                                                => C4::Context->preference('canreservefromotherbranches'),
 452             intranetcolorstylesheet                                                    => C4::Context->preference("intranetcolorstylesheet"),
 453             IntranetFavicon                                                            => C4::Context->preference("IntranetFavicon"),
 454             intranetreadinghistory                                                     => C4::Context->preference("intranetreadinghistory"),
 455             intranetstylesheet                                                         => C4::Context->preference("intranetstylesheet"),
 456             IntranetUserCSS                                                            => C4::Context->preference("IntranetUserCSS"),
 457             IntranetUserJS                                                             => C4::Context->preference("IntranetUserJS"),
 458             intranetbookbag                                                            => C4::Context->preference("intranetbookbag"),
 459             suggestion                                                                 => C4::Context->preference("suggestion"),
 460             virtualshelves                                                             => C4::Context->preference("virtualshelves"),
 461             StaffSerialIssueDisplayCount                                               => C4::Context->preference("StaffSerialIssueDisplayCount"),
 462             EasyAnalyticalRecords                                                      => C4::Context->preference('EasyAnalyticalRecords'),
 463             LocalCoverImages                                                           => C4::Context->preference('LocalCoverImages'),
 464             OPACLocalCoverImages                                                       => C4::Context->preference('OPACLocalCoverImages'),
 465             AllowMultipleCovers                                                        => C4::Context->preference('AllowMultipleCovers'),
 466             EnableBorrowerFiles                                                        => C4::Context->preference('EnableBorrowerFiles'),
 467             UseKohaPlugins                                                             => C4::Context->preference('UseKohaPlugins'),
 468             UseCourseReserves                                                          => C4::Context->preference("UseCourseReserves"),
 469             useDischarge                                                               => C4::Context->preference('useDischarge'),
 470         );
 471     }
 472     else {
 473         warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
 474
 475         #TODO : replace LibraryName syspref with 'system name', and remove this html processing
 476         my $LibraryNameTitle = C4::Context->preference("LibraryName");
 477         $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
 478         $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
 479
 480         # clean up the busc param in the session
 481         # if the page is not opac-detail and not the "add to list" page
 482         # and not the "edit comments" page
 483         if ( C4::Context->preference("OpacBrowseResults")
 484             && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
 485             my $pagename = $1;
 486             unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
 487                 or $pagename =~ /^addbybiblionumber$/
 488                 or $pagename =~ /^review$/ ) {
 489                 my $sessionSearch = get_session( $sessionID || $in->{'query'}->cookie("CGISESSID") );
 490                 $sessionSearch->clear( ["busc"] ) if ( $sessionSearch->param("busc") );
 491             }
 492         }
 493
 494         # variables passed from CGI: opac_css_override and opac_search_limits.
 495         my $opac_search_limit   = $ENV{'OPAC_SEARCH_LIMIT'};
 496         my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
 497         my $opac_name           = '';
 498         if (
 499             ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:(\w+)/ ) ||
 500             ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:(\w+)/ ) ||
 501             ( $in->{'query'}->param('multibranchlimit') && $in->{'query'}->param('multibranchlimit') =~ /multibranchlimit-(\w+)/ )
 502           ) {
 503             $opac_name = $1;    # opac_search_limit is a branch, so we use it.
 504         } elsif ( $in->{'query'}->param('multibranchlimit') ) {
 505             $opac_name = $in->{'query'}->param('multibranchlimit');
 506         } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
 507             $opac_name = C4::Context->userenv->{'branch'};
 508         }
 509
 510         $template->param(
 511             OpacAdditionalStylesheet                   => C4::Context->preference("OpacAdditionalStylesheet"),
 512             AnonSuggestions                       => "" . C4::Context->preference("AnonSuggestions"),
 513             AuthorisedValueImages                 => C4::Context->preference("AuthorisedValueImages"),
 514             BranchesLoop                          => GetBranchesLoop($opac_name),
 515             BranchCategoriesLoop                  => GetBranchCategories( 'searchdomain', 1, $opac_name ),
 516             LibraryName                           => "" . C4::Context->preference("LibraryName"),
 517             LibraryNameTitle                      => "" . $LibraryNameTitle,
 518             LoginBranchname                       => C4::Context->userenv ? C4::Context->userenv->{"branchname"} : "",
 519             OPACAmazonCoverImages                 => C4::Context->preference("OPACAmazonCoverImages"),
 520             OPACFRBRizeEditions                   => C4::Context->preference("OPACFRBRizeEditions"),
 521             OpacHighlightedWords                  => C4::Context->preference("OpacHighlightedWords"),
 522             OPACShelfBrowser                      => "" . C4::Context->preference("OPACShelfBrowser"),
 523             OPACURLOpenInNewWindow                => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
 524             OPACUserCSS                           => "" . C4::Context->preference("OPACUserCSS"),
 525             OpacAuthorities                       => C4::Context->preference("OpacAuthorities"),
 526             opac_css_override                     => $ENV{'OPAC_CSS_OVERRIDE'},
 527             opac_search_limit                     => $opac_search_limit,
 528             opac_limit_override                   => $opac_limit_override,
 529             OpacBrowser                           => C4::Context->preference("OpacBrowser"),
 530             OpacCloud                             => C4::Context->preference("OpacCloud"),
 531             OpacKohaUrl                           => C4::Context->preference("OpacKohaUrl"),
 532             OpacMainUserBlock                     => "" . C4::Context->preference("OpacMainUserBlock"),
 533             OpacNav                               => "" . C4::Context->preference("OpacNav"),
 534             OpacNavRight                          => "" . C4::Context->preference("OpacNavRight"),
 535             OpacNavBottom                         => "" . C4::Context->preference("OpacNavBottom"),
 536             OpacPasswordChange                    => C4::Context->preference("OpacPasswordChange"),
 537             OPACPatronDetails                     => C4::Context->preference("OPACPatronDetails"),
 538             OPACPrivacy                           => C4::Context->preference("OPACPrivacy"),
 539             OPACFinesTab                          => C4::Context->preference("OPACFinesTab"),
 540             OpacTopissue                          => C4::Context->preference("OpacTopissue"),
 541             RequestOnOpac                         => C4::Context->preference("RequestOnOpac"),
 542             'Version'                             => C4::Context->preference('Version'),
 543             hidelostitems                         => C4::Context->preference("hidelostitems"),
 544             mylibraryfirst                        => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
 545             opaclayoutstylesheet                  => "" . C4::Context->preference("opaclayoutstylesheet"),
 546             opacbookbag                           => "" . C4::Context->preference("opacbookbag"),
 547             opaccredits                           => "" . C4::Context->preference("opaccredits"),
 548             OpacFavicon                           => C4::Context->preference("OpacFavicon"),
 549             opacheader                            => "" . C4::Context->preference("opacheader"),
 550             opaclanguagesdisplay                  => "" . C4::Context->preference("opaclanguagesdisplay"),
 551             opacreadinghistory                    => C4::Context->preference("opacreadinghistory"),
 552             OPACUserJS                            => C4::Context->preference("OPACUserJS"),
 553             opacuserlogin                         => "" . C4::Context->preference("opacuserlogin"),
 554             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         script_name                           => _get_script_name(),
1212         casAuthentication                     => C4::Context->preference("casAuthentication"),
1213         shibbolethAuthentication              => $shib,
1214         SessionRestrictionByIP                => C4::Context->preference("SessionRestrictionByIP"),
1215         suggestion                            => C4::Context->preference("suggestion"),
1216         virtualshelves                        => C4::Context->preference("virtualshelves"),
1217         LibraryName                           => "" . C4::Context->preference("LibraryName"),
1218         LibraryNameTitle                      => "" . $LibraryNameTitle,
1219         opacuserlogin                         => C4::Context->preference("opacuserlogin"),
1220         OpacNav                               => C4::Context->preference("OpacNav"),
1221         OpacNavRight                          => C4::Context->preference("OpacNavRight"),
1222         OpacNavBottom                         => C4::Context->preference("OpacNavBottom"),
1223         opaccredits                           => C4::Context->preference("opaccredits"),
1224         OpacFavicon                           => C4::Context->preference("OpacFavicon"),
1225         opacreadinghistory                    => C4::Context->preference("opacreadinghistory"),
1226         opaclanguagesdisplay                  => C4::Context->preference("opaclanguagesdisplay"),
1227         OPACUserJS                            => C4::Context->preference("OPACUserJS"),
1228         opacbookbag                           => "" . C4::Context->preference("opacbookbag"),
1229         OpacCloud                             => C4::Context->preference("OpacCloud"),
1230         OpacTopissue                          => C4::Context->preference("OpacTopissue"),
1231         OpacAuthorities                       => C4::Context->preference("OpacAuthorities"),
1232         OpacBrowser                           => C4::Context->preference("OpacBrowser"),
1233         opacheader                            => C4::Context->preference("opacheader"),
1234         TagsEnabled                           => C4::Context->preference("TagsEnabled"),
1235         OPACUserCSS                           => C4::Context->preference("OPACUserCSS"),
1236         intranetcolorstylesheet               => C4::Context->preference("intranetcolorstylesheet"),
1237         intranetstylesheet                    => C4::Context->preference("intranetstylesheet"),
1238         intranetbookbag                       => C4::Context->preference("intranetbookbag"),
1239         IntranetNav                           => C4::Context->preference("IntranetNav"),
1240         IntranetFavicon                       => C4::Context->preference("IntranetFavicon"),
1241         IntranetUserCSS                       => C4::Context->preference("IntranetUserCSS"),
1242         IntranetUserJS                        => C4::Context->preference("IntranetUserJS"),
1243         IndependentBranches                   => C4::Context->preference("IndependentBranches"),
1244         AutoLocation                          => C4::Context->preference("AutoLocation"),
1245         wrongip                               => $info{'wrongip'},
1246         PatronSelfRegistration                => C4::Context->preference("PatronSelfRegistration"),
1247         PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1248         persona                               => C4::Context->preference("Persona"),
1249         opac_css_override                     => $ENV{'OPAC_CSS_OVERRIDE'},
1250     );
1251
1252     $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1253     $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1254     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1255
1256     if ( $type eq 'opac' ) {
1257         require Koha::Virtualshelves;
1258         my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1259             {
1260                 category       => 2,
1261             }
1262         );
1263         $template->param(
1264             some_public_shelves  => $some_public_shelves,
1265         );
1266     }
1267
1268     if ($cas) {
1269
1270         # Is authentication against multiple CAS servers enabled?
1271         if ( C4::Auth_with_cas::multipleAuth && !$casparam ) {
1272             my $casservers = C4::Auth_with_cas::getMultipleAuth();
1273             my @tmplservers;
1274             foreach my $key ( keys %$casservers ) {
1275                 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1276             }
1277             $template->param(
1278                 casServersLoop => \@tmplservers
1279             );
1280         } else {
1281             $template->param(
1282                 casServerUrl => login_cas_url($query, undef, $type),
1283             );
1284         }
1285
1286         $template->param(
1287             invalidCasLogin => $info{'invalidCasLogin'}
1288         );
1289     }
1290
1291     if ($shib) {
1292         $template->param(
1293             shibbolethAuthentication => $shib,
1294             shibbolethLoginUrl       => login_shib_url($query),
1295         );
1296     }
1297
1298     $template->param(
1299         LibraryName => C4::Context->preference("LibraryName"),
1300     );
1301     $template->param(%info);
1302
1303     #    $cookie = $query->cookie(CGISESSID => $session->id
1304     #   );
1305     print $query->header(
1306         {   type              => 'text/html',
1307             charset           => 'utf-8',
1308             cookie            => $cookie,
1309             'X-Frame-Options' => 'SAMEORIGIN'
1310         }
1311       ),
1312       $template->output;
1313     safe_exit;
1314 }
1315
1316 =head2 check_api_auth
1317
1318   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1319
1320 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1321 cookie, determine if the user has the privileges specified by C<$userflags>.
1322
1323 C<check_api_auth> is is meant for authenticating users of web services, and
1324 consequently will always return and will not attempt to redirect the user
1325 agent.
1326
1327 If a valid session cookie is already present, check_api_auth will return a status
1328 of "ok", the cookie, and the Koha session ID.
1329
1330 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1331 parameters and create a session cookie and Koha session if the supplied credentials
1332 are OK.
1333
1334 Possible return values in C<$status> are:
1335
1336 =over
1337
1338 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1339
1340 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1341
1342 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1343
1344 =item "expired -- session cookie has expired; API user should resubmit userid and password
1345
1346 =back
1347
1348 =cut
1349
1350 sub check_api_auth {
1351     my $query         = shift;
1352     my $flagsrequired = shift;
1353
1354     my $dbh     = C4::Context->dbh;
1355     my $timeout = _timeout_syspref();
1356
1357     unless ( C4::Context->preference('Version') ) {
1358
1359         # database has not been installed yet
1360         return ( "maintenance", undef, undef );
1361     }
1362     my $kohaversion = Koha::version();
1363     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1364     if ( C4::Context->preference('Version') < $kohaversion ) {
1365
1366         # database in need of version update; assume that
1367         # no API should be called while databsae is in
1368         # this condition.
1369         return ( "maintenance", undef, undef );
1370     }
1371
1372     # FIXME -- most of what follows is a copy-and-paste
1373     # of code from checkauth.  There is an obvious need
1374     # for refactoring to separate the various parts of
1375     # the authentication code, but as of 2007-11-19 this
1376     # is deferred so as to not introduce bugs into the
1377     # regular authentication code for Koha 3.0.
1378
1379     # see if we have a valid session cookie already
1380     # however, if a userid parameter is present (i.e., from
1381     # a form submission, assume that any current cookie
1382     # is to be ignored
1383     my $sessionID = undef;
1384     unless ( $query->param('userid') ) {
1385         $sessionID = $query->cookie("CGISESSID");
1386     }
1387     if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1388         my $session = get_session($sessionID);
1389         C4::Context->_new_userenv($sessionID);
1390         if ($session) {
1391             C4::Context->set_userenv(
1392                 $session->param('number'),       $session->param('id'),
1393                 $session->param('cardnumber'),   $session->param('firstname'),
1394                 $session->param('surname'),      $session->param('branch'),
1395                 $session->param('branchname'),   $session->param('flags'),
1396                 $session->param('emailaddress'), $session->param('branchprinter')
1397             );
1398
1399             my $ip       = $session->param('ip');
1400             my $lasttime = $session->param('lasttime');
1401             my $userid   = $session->param('id');
1402             if ( $lasttime < time() - $timeout ) {
1403
1404                 # time out
1405                 $session->delete();
1406                 $session->flush;
1407                 C4::Context->_unset_userenv($sessionID);
1408                 $userid    = undef;
1409                 $sessionID = undef;
1410                 return ( "expired", undef, undef );
1411             } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1412
1413                 # IP address changed
1414                 $session->delete();
1415                 $session->flush;
1416                 C4::Context->_unset_userenv($sessionID);
1417                 $userid    = undef;
1418                 $sessionID = undef;
1419                 return ( "expired", undef, undef );
1420             } else {
1421                 my $cookie = $query->cookie(
1422                     -name     => 'CGISESSID',
1423                     -value    => $session->id,
1424                     -HttpOnly => 1,
1425                 );
1426                 $session->param( 'lasttime', time() );
1427                 my $flags = haspermission( $userid, $flagsrequired );
1428                 if ($flags) {
1429                     return ( "ok", $cookie, $sessionID );
1430                 } else {
1431                     $session->delete();
1432                     $session->flush;
1433                     C4::Context->_unset_userenv($sessionID);
1434                     $userid    = undef;
1435                     $sessionID = undef;
1436                     return ( "failed", undef, undef );
1437                 }
1438             }
1439         } else {
1440             return ( "expired", undef, undef );
1441         }
1442     } else {
1443
1444         # new login
1445         my $userid   = $query->param('userid');
1446         my $password = $query->param('password');
1447         my ( $return, $cardnumber );
1448
1449         # Proxy CAS auth
1450         if ( $cas && $query->param('PT') ) {
1451             my $retuserid;
1452             $debug and print STDERR "## check_api_auth - checking CAS\n";
1453
1454             # In case of a CAS authentication, we use the ticket instead of the password
1455             my $PT = $query->param('PT');
1456             ( $return, $cardnumber, $userid ) = check_api_auth_cas( $dbh, $PT, $query );    # EXTERNAL AUTH
1457         } else {
1458
1459             # User / password auth
1460             unless ( $userid and $password ) {
1461
1462                 # caller did something wrong, fail the authenticateion
1463                 return ( "failed", undef, undef );
1464             }
1465             ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password, $query );
1466         }
1467
1468         if ( $return and haspermission( $userid, $flagsrequired ) ) {
1469             my $session = get_session("");
1470             return ( "failed", undef, undef ) unless $session;
1471
1472             my $sessionID = $session->id;
1473             C4::Context->_new_userenv($sessionID);
1474             my $cookie = $query->cookie(
1475                 -name     => 'CGISESSID',
1476                 -value    => $sessionID,
1477                 -HttpOnly => 1,
1478             );
1479             if ( $return == 1 ) {
1480                 my (
1481                     $borrowernumber, $firstname,  $surname,
1482                     $userflags,      $branchcode, $branchname,
1483                     $branchprinter,  $emailaddress
1484                 );
1485                 my $sth =
1486                   $dbh->prepare(
1487 "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=?"
1488                   );
1489                 $sth->execute($userid);
1490                 (
1491                     $borrowernumber, $firstname,  $surname,
1492                     $userflags,      $branchcode, $branchname,
1493                     $branchprinter,  $emailaddress
1494                 ) = $sth->fetchrow if ( $sth->rows );
1495
1496                 unless ( $sth->rows ) {
1497                     my $sth = $dbh->prepare(
1498 "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=?"
1499                     );
1500                     $sth->execute($cardnumber);
1501                     (
1502                         $borrowernumber, $firstname,  $surname,
1503                         $userflags,      $branchcode, $branchname,
1504                         $branchprinter,  $emailaddress
1505                     ) = $sth->fetchrow if ( $sth->rows );
1506
1507                     unless ( $sth->rows ) {
1508                         $sth->execute($userid);
1509                         (
1510                             $borrowernumber, $firstname,  $surname,       $userflags,
1511                             $branchcode,     $branchname, $branchprinter, $emailaddress
1512                         ) = $sth->fetchrow if ( $sth->rows );
1513                     }
1514                 }
1515
1516                 my $ip = $ENV{'REMOTE_ADDR'};
1517
1518                 # if they specify at login, use that
1519                 if ( $query->param('branch') ) {
1520                     $branchcode = $query->param('branch');
1521                     $branchname = GetBranchName($branchcode);
1522                 }
1523                 my $branches = GetBranches();
1524                 my @branchesloop;
1525                 foreach my $br ( keys %$branches ) {
1526
1527                     #     now we work with the treatment of ip
1528                     my $domain = $branches->{$br}->{'branchip'};
1529                     if ( $domain && $ip =~ /^$domain/ ) {
1530                         $branchcode = $branches->{$br}->{'branchcode'};
1531
1532                         # new op dev : add the branchprinter and branchname in the cookie
1533                         $branchprinter = $branches->{$br}->{'branchprinter'};
1534                         $branchname    = $branches->{$br}->{'branchname'};
1535                     }
1536                 }
1537                 $session->param( 'number',       $borrowernumber );
1538                 $session->param( 'id',           $userid );
1539                 $session->param( 'cardnumber',   $cardnumber );
1540                 $session->param( 'firstname',    $firstname );
1541                 $session->param( 'surname',      $surname );
1542                 $session->param( 'branch',       $branchcode );
1543                 $session->param( 'branchname',   $branchname );
1544                 $session->param( 'flags',        $userflags );
1545                 $session->param( 'emailaddress', $emailaddress );
1546                 $session->param( 'ip',           $session->remote_addr() );
1547                 $session->param( 'lasttime',     time() );
1548             } elsif ( $return == 2 ) {
1549
1550                 #We suppose the user is the superlibrarian
1551                 $session->param( 'number',       0 );
1552                 $session->param( 'id',           C4::Context->config('user') );
1553                 $session->param( 'cardnumber',   C4::Context->config('user') );
1554                 $session->param( 'firstname',    C4::Context->config('user') );
1555                 $session->param( 'surname',      C4::Context->config('user') );
1556                 $session->param( 'branch',       'NO_LIBRARY_SET' );
1557                 $session->param( 'branchname',   'NO_LIBRARY_SET' );
1558                 $session->param( 'flags',        1 );
1559                 $session->param( 'emailaddress', C4::Context->preference('KohaAdminEmailAddress') );
1560                 $session->param( 'ip',           $session->remote_addr() );
1561                 $session->param( 'lasttime',     time() );
1562             }
1563             C4::Context->set_userenv(
1564                 $session->param('number'),       $session->param('id'),
1565                 $session->param('cardnumber'),   $session->param('firstname'),
1566                 $session->param('surname'),      $session->param('branch'),
1567                 $session->param('branchname'),   $session->param('flags'),
1568                 $session->param('emailaddress'), $session->param('branchprinter')
1569             );
1570             return ( "ok", $cookie, $sessionID );
1571         } else {
1572             return ( "failed", undef, undef );
1573         }
1574     }
1575 }
1576
1577 =head2 check_cookie_auth
1578
1579   ($status, $sessionId) = check_api_auth($cookie, $userflags);
1580
1581 Given a CGISESSID cookie set during a previous login to Koha, determine
1582 if the user has the privileges specified by C<$userflags>.
1583
1584 C<check_cookie_auth> is meant for authenticating special services
1585 such as tools/upload-file.pl that are invoked by other pages that
1586 have been authenticated in the usual way.
1587
1588 Possible return values in C<$status> are:
1589
1590 =over
1591
1592 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1593
1594 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1595
1596 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1597
1598 =item "expired -- session cookie has expired; API user should resubmit userid and password
1599
1600 =back
1601
1602 =cut
1603
1604 sub check_cookie_auth {
1605     my $cookie        = shift;
1606     my $flagsrequired = shift;
1607
1608     my $dbh     = C4::Context->dbh;
1609     my $timeout = _timeout_syspref();
1610
1611     unless ( C4::Context->preference('Version') ) {
1612
1613         # database has not been installed yet
1614         return ( "maintenance", undef );
1615     }
1616     my $kohaversion = Koha::version();
1617     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1618     if ( C4::Context->preference('Version') < $kohaversion ) {
1619
1620         # database in need of version update; assume that
1621         # no API should be called while databsae is in
1622         # this condition.
1623         return ( "maintenance", undef );
1624     }
1625
1626     # FIXME -- most of what follows is a copy-and-paste
1627     # of code from checkauth.  There is an obvious need
1628     # for refactoring to separate the various parts of
1629     # the authentication code, but as of 2007-11-23 this
1630     # is deferred so as to not introduce bugs into the
1631     # regular authentication code for Koha 3.0.
1632
1633     # see if we have a valid session cookie already
1634     # however, if a userid parameter is present (i.e., from
1635     # a form submission, assume that any current cookie
1636     # is to be ignored
1637     unless ( defined $cookie and $cookie ) {
1638         return ( "failed", undef );
1639     }
1640     my $sessionID = $cookie;
1641     my $session   = get_session($sessionID);
1642     C4::Context->_new_userenv($sessionID);
1643     if ($session) {
1644         C4::Context->set_userenv(
1645             $session->param('number'),       $session->param('id'),
1646             $session->param('cardnumber'),   $session->param('firstname'),
1647             $session->param('surname'),      $session->param('branch'),
1648             $session->param('branchname'),   $session->param('flags'),
1649             $session->param('emailaddress'), $session->param('branchprinter')
1650         );
1651
1652         my $ip       = $session->param('ip');
1653         my $lasttime = $session->param('lasttime');
1654         my $userid   = $session->param('id');
1655         if ( $lasttime < time() - $timeout ) {
1656
1657             # time out
1658             $session->delete();
1659             $session->flush;
1660             C4::Context->_unset_userenv($sessionID);
1661             $userid    = undef;
1662             $sessionID = undef;
1663             return ("expired", undef);
1664         } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1665
1666             # IP address changed
1667             $session->delete();
1668             $session->flush;
1669             C4::Context->_unset_userenv($sessionID);
1670             $userid    = undef;
1671             $sessionID = undef;
1672             return ( "expired", undef );
1673         } else {
1674             $session->param( 'lasttime', time() );
1675             my $flags = haspermission( $userid, $flagsrequired );
1676             if ($flags) {
1677                 return ( "ok", $sessionID );
1678             } else {
1679                 $session->delete();
1680                 $session->flush;
1681                 C4::Context->_unset_userenv($sessionID);
1682                 $userid    = undef;
1683                 $sessionID = undef;
1684                 return ( "failed", undef );
1685             }
1686         }
1687     } else {
1688         return ( "expired", undef );
1689     }
1690 }
1691
1692 =head2 get_session
1693
1694   use CGI::Session;
1695   my $session = get_session($sessionID);
1696
1697 Given a session ID, retrieve the CGI::Session object used to store
1698 the session's state.  The session object can be used to store
1699 data that needs to be accessed by different scripts during a
1700 user's session.
1701
1702 If the C<$sessionID> parameter is an empty string, a new session
1703 will be created.
1704
1705 =cut
1706
1707 sub get_session {
1708     my $sessionID      = shift;
1709     my $storage_method = C4::Context->preference('SessionStorage');
1710     my $dbh            = C4::Context->dbh;
1711     my $session;
1712     if ( $storage_method eq 'mysql' ) {
1713         $session = new CGI::Session( "driver:MySQL;serializer:yaml;id:md5", $sessionID, { Handle => $dbh } );
1714     }
1715     elsif ( $storage_method eq 'Pg' ) {
1716         $session = new CGI::Session( "driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, { Handle => $dbh } );
1717     }
1718     elsif ( $storage_method eq 'memcached' && C4::Context->ismemcached ) {
1719         $session = new CGI::Session( "driver:memcached;serializer:yaml;id:md5", $sessionID, { Memcached => C4::Context->memcached } );
1720     }
1721     else {
1722         # catch all defaults to tmp should work on all systems
1723         my $dir = File::Spec->tmpdir;
1724         my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1725         $session = new CGI::Session( "driver:File;serializer:yaml;id:md5", $sessionID, { Directory => "$dir/cgisess_$instance" } );
1726     }
1727     return $session;
1728 }
1729
1730 sub checkpw {
1731     my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1732     $type = 'opac' unless $type;
1733     if ($ldap) {
1734         $debug and print STDERR "## checkpw - checking LDAP\n";
1735         my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_);    # EXTERNAL AUTH
1736         return 0 if $retval == -1;                                  # Incorrect password for LDAP login attempt
1737         ($retval) and return ( $retval, $retcard, $retuserid );
1738     }
1739
1740     if ( $cas && $query && $query->param('ticket') ) {
1741         $debug and print STDERR "## checkpw - checking CAS\n";
1742
1743         # In case of a CAS authentication, we use the ticket instead of the password
1744         my $ticket = $query->param('ticket');
1745         $query->delete('ticket');                                   # remove ticket to come back to original URL
1746         my ( $retval, $retcard, $retuserid ) = checkpw_cas( $dbh, $ticket, $query, $type );    # EXTERNAL AUTH
1747         ($retval) and return ( $retval, $retcard, $retuserid );
1748         return 0;
1749     }
1750
1751     # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1752     # Check for password to asertain whether we want to be testing against shibboleth or another method this
1753     # time around.
1754     if ( $shib && $shib_login && !$password ) {
1755
1756         $debug and print STDERR "## checkpw - checking Shibboleth\n";
1757
1758         # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1759         # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1760         # shibboleth-authenticated user
1761
1762         # Then, we check if it matches a valid koha user
1763         if ($shib_login) {
1764             my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login);    # EXTERNAL AUTH
1765             ($retval) and return ( $retval, $retcard, $retuserid );
1766             return 0;
1767         }
1768     }
1769
1770     # INTERNAL AUTH
1771     return checkpw_internal( $dbh, $userid, $password, $no_set_userenv);
1772 }
1773
1774 sub checkpw_internal {
1775     my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
1776
1777     $password = Encode::encode( 'UTF-8', $password )
1778       if Encode::is_utf8($password);
1779
1780     if ( $userid && $userid eq C4::Context->config('user') ) {
1781         if ( $password && $password eq C4::Context->config('pass') ) {
1782
1783             # Koha superuser account
1784             #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1785             return 2;
1786         }
1787         else {
1788             return 0;
1789         }
1790     }
1791
1792     my $sth =
1793       $dbh->prepare(
1794         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1795       );
1796     $sth->execute($userid);
1797     if ( $sth->rows ) {
1798         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1799             $surname, $branchcode, $branchname, $flags )
1800           = $sth->fetchrow;
1801
1802         if ( checkpw_hash( $password, $stored_hash ) ) {
1803
1804             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1805                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1806             return 1, $cardnumber, $userid;
1807         }
1808     }
1809     $sth =
1810       $dbh->prepare(
1811         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1812       );
1813     $sth->execute($userid);
1814     if ( $sth->rows ) {
1815         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1816             $surname, $branchcode, $branchname, $flags )
1817           = $sth->fetchrow;
1818
1819         if ( checkpw_hash( $password, $stored_hash ) ) {
1820
1821             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1822                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1823             return 1, $cardnumber, $userid;
1824         }
1825     }
1826     if ( $userid && $userid eq 'demo'
1827         && "$password" eq 'demo'
1828         && C4::Context->config('demo') )
1829     {
1830
1831         # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1832         # some features won't be effective : modify systempref, modify MARC structure,
1833         return 2;
1834     }
1835     return 0;
1836 }
1837
1838 sub checkpw_hash {
1839     my ( $password, $stored_hash ) = @_;
1840
1841     return if $stored_hash eq '!';
1842
1843     # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1844     my $hash;
1845     if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1846         $hash = hash_password( $password, $stored_hash );
1847     } else {
1848         $hash = md5_base64($password);
1849     }
1850     return $hash eq $stored_hash;
1851 }
1852
1853 =head2 getuserflags
1854
1855     my $authflags = getuserflags($flags, $userid, [$dbh]);
1856
1857 Translates integer flags into permissions strings hash.
1858
1859 C<$flags> is the integer userflags value ( borrowers.userflags )
1860 C<$userid> is the members.userid, used for building subpermissions
1861 C<$authflags> is a hashref of permissions
1862
1863 =cut
1864
1865 sub getuserflags {
1866     my $flags  = shift;
1867     my $userid = shift;
1868     my $dbh    = @_ ? shift : C4::Context->dbh;
1869     my $userflags;
1870     {
1871         # I don't want to do this, but if someone logs in as the database
1872         # user, it would be preferable not to spam them to death with
1873         # numeric warnings. So, we make $flags numeric.
1874         no warnings 'numeric';
1875         $flags += 0;
1876     }
1877     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1878     $sth->execute;
1879
1880     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1881         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1882             $userflags->{$flag} = 1;
1883         }
1884         else {
1885             $userflags->{$flag} = 0;
1886         }
1887     }
1888
1889     # get subpermissions and merge with top-level permissions
1890     my $user_subperms = get_user_subpermissions($userid);
1891     foreach my $module ( keys %$user_subperms ) {
1892         next if $userflags->{$module} == 1;    # user already has permission for everything in this module
1893         $userflags->{$module} = $user_subperms->{$module};
1894     }
1895
1896     return $userflags;
1897 }
1898
1899 =head2 get_user_subpermissions
1900
1901   $user_perm_hashref = get_user_subpermissions($userid);
1902
1903 Given the userid (note, not the borrowernumber) of a staff user,
1904 return a hashref of hashrefs of the specific subpermissions
1905 accorded to the user.  An example return is
1906
1907  {
1908     tools => {
1909         export_catalog => 1,
1910         import_patrons => 1,
1911     }
1912  }
1913
1914 The top-level hash-key is a module or function code from
1915 userflags.flag, while the second-level key is a code
1916 from permissions.
1917
1918 The results of this function do not give a complete picture
1919 of the functions that a staff user can access; it is also
1920 necessary to check borrowers.flags.
1921
1922 =cut
1923
1924 sub get_user_subpermissions {
1925     my $userid = shift;
1926
1927     my $dbh = C4::Context->dbh;
1928     my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
1929                              FROM user_permissions
1930                              JOIN permissions USING (module_bit, code)
1931                              JOIN userflags ON (module_bit = bit)
1932                              JOIN borrowers USING (borrowernumber)
1933                              WHERE userid = ?" );
1934     $sth->execute($userid);
1935
1936     my $user_perms = {};
1937     while ( my $perm = $sth->fetchrow_hashref ) {
1938         $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1939     }
1940     return $user_perms;
1941 }
1942
1943 =head2 get_all_subpermissions
1944
1945   my $perm_hashref = get_all_subpermissions();
1946
1947 Returns a hashref of hashrefs defining all specific
1948 permissions currently defined.  The return value
1949 has the same structure as that of C<get_user_subpermissions>,
1950 except that the innermost hash value is the description
1951 of the subpermission.
1952
1953 =cut
1954
1955 sub get_all_subpermissions {
1956     my $dbh = C4::Context->dbh;
1957     my $sth = $dbh->prepare( "SELECT flag, code
1958                              FROM permissions
1959                              JOIN userflags ON (module_bit = bit)" );
1960     $sth->execute();
1961
1962     my $all_perms = {};
1963     while ( my $perm = $sth->fetchrow_hashref ) {
1964         $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1965     }
1966     return $all_perms;
1967 }
1968
1969 =head2 haspermission
1970
1971   $flags = ($userid, $flagsrequired);
1972
1973 C<$userid> the userid of the member
1974 C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
1975
1976 Returns member's flags or 0 if a permission is not met.
1977
1978 =cut
1979
1980 sub haspermission {
1981     my ( $userid, $flagsrequired ) = @_;
1982     my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1983     $sth->execute($userid);
1984     my $row = $sth->fetchrow();
1985     my $flags = getuserflags( $row, $userid );
1986     if ( $userid eq C4::Context->config('user') ) {
1987
1988         # Super User Account from /etc/koha.conf
1989         $flags->{'superlibrarian'} = 1;
1990     }
1991     elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
1992
1993         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1994         $flags->{'superlibrarian'} = 1;
1995     }
1996
1997     return $flags if $flags->{superlibrarian};
1998
1999     foreach my $module ( keys %$flagsrequired ) {
2000         my $subperm = $flagsrequired->{$module};
2001         if ( $subperm eq '*' ) {
2002             return 0 unless ( $flags->{$module} == 1 or ref( $flags->{$module} ) );
2003         } else {
2004             return 0 unless (
2005                 ( defined $flags->{$module} and
2006                     $flags->{$module} == 1 )
2007                 or
2008                 ( ref( $flags->{$module} ) and
2009                     exists $flags->{$module}->{$subperm} and
2010                     $flags->{$module}->{$subperm} == 1 )
2011             );
2012         }
2013     }
2014     return $flags;
2015
2016     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2017 }
2018
2019 sub getborrowernumber {
2020     my ($userid) = @_;
2021     my $userenv = C4::Context->userenv;
2022     if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2023         return $userenv->{number};
2024     }
2025     my $dbh = C4::Context->dbh;
2026     for my $field ( 'userid', 'cardnumber' ) {
2027         my $sth =
2028           $dbh->prepare("select borrowernumber from borrowers where $field=?");
2029         $sth->execute($userid);
2030         if ( $sth->rows ) {
2031             my ($bnumber) = $sth->fetchrow;
2032             return $bnumber;
2033         }
2034     }
2035     return 0;
2036 }
2037
2038 =head2 _get_script_name
2039
2040 This returns the correct script name, for use in redirecting back to the correct page after showing
2041 the login screen. It depends on details of the package Plack configuration, and should not be used
2042 outside this context.
2043
2044 =cut
2045
2046 sub _get_script_name {
2047     # This is the method about.pl uses to detect Plack; now that two places use it, it MUST be
2048     # right.
2049     if ( ( any { /(^psgi\.|^plack\.)/i } keys %ENV ) && $ENV{SCRIPT_NAME} =~ m,^/(intranet|opac)(.*), ) {
2050         return '/cgi-bin/koha' . $2;
2051     } else {
2052         return $ENV{SCRIPT_NAME};
2053     }
2054 }
2055
2056 END { }    # module clean-up code here (global destructor)
2057 1;
2058 __END__
2059
2060 =head1 SEE ALSO
2061
2062 CGI(3)
2063
2064 C4::Output(3)
2065
2066 Crypt::Eksblowfish::Bcrypt(3)
2067
2068 Digest::MD5(3)
2069
2070 =cut