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(get_script_name 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
1731 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1732 # (or something similar)
1733 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1734 # not having a userenv defined could cause a crash.
1735 sub checkpw {
1736     my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1737     $type = 'opac' unless $type;
1738     if ($ldap) {
1739         $debug and print STDERR "## checkpw - checking LDAP\n";
1740         my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_);    # EXTERNAL AUTH
1741         return 0 if $retval == -1;                                  # Incorrect password for LDAP login attempt
1742         ($retval) and return ( $retval, $retcard, $retuserid );
1743     }
1744
1745     if ( $cas && $query && $query->param('ticket') ) {
1746         $debug and print STDERR "## checkpw - checking CAS\n";
1747
1748         # In case of a CAS authentication, we use the ticket instead of the password
1749         my $ticket = $query->param('ticket');
1750         $query->delete('ticket');                                   # remove ticket to come back to original URL
1751         my ( $retval, $retcard, $retuserid ) = checkpw_cas( $dbh, $ticket, $query, $type );    # EXTERNAL AUTH
1752         ($retval) and return ( $retval, $retcard, $retuserid );
1753         return 0;
1754     }
1755
1756     # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1757     # Check for password to asertain whether we want to be testing against shibboleth or another method this
1758     # time around.
1759     if ( $shib && $shib_login && !$password ) {
1760
1761         $debug and print STDERR "## checkpw - checking Shibboleth\n";
1762
1763         # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1764         # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1765         # shibboleth-authenticated user
1766
1767         # Then, we check if it matches a valid koha user
1768         if ($shib_login) {
1769             my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login);    # EXTERNAL AUTH
1770             ($retval) and return ( $retval, $retcard, $retuserid );
1771             return 0;
1772         }
1773     }
1774
1775     # INTERNAL AUTH
1776     return checkpw_internal( $dbh, $userid, $password, $no_set_userenv);
1777 }
1778
1779 sub checkpw_internal {
1780     my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
1781
1782     $password = Encode::encode( 'UTF-8', $password )
1783       if Encode::is_utf8($password);
1784
1785     if ( $userid && $userid eq C4::Context->config('user') ) {
1786         if ( $password && $password eq C4::Context->config('pass') ) {
1787
1788             # Koha superuser account
1789             #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1790             return 2;
1791         }
1792         else {
1793             return 0;
1794         }
1795     }
1796
1797     my $sth =
1798       $dbh->prepare(
1799         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1800       );
1801     $sth->execute($userid);
1802     if ( $sth->rows ) {
1803         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1804             $surname, $branchcode, $branchname, $flags )
1805           = $sth->fetchrow;
1806
1807         if ( checkpw_hash( $password, $stored_hash ) ) {
1808
1809             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1810                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1811             return 1, $cardnumber, $userid;
1812         }
1813     }
1814     $sth =
1815       $dbh->prepare(
1816         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1817       );
1818     $sth->execute($userid);
1819     if ( $sth->rows ) {
1820         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1821             $surname, $branchcode, $branchname, $flags )
1822           = $sth->fetchrow;
1823
1824         if ( checkpw_hash( $password, $stored_hash ) ) {
1825
1826             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1827                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1828             return 1, $cardnumber, $userid;
1829         }
1830     }
1831     if ( $userid && $userid eq 'demo'
1832         && "$password" eq 'demo'
1833         && C4::Context->config('demo') )
1834     {
1835
1836         # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1837         # some features won't be effective : modify systempref, modify MARC structure,
1838         return 2;
1839     }
1840     return 0;
1841 }
1842
1843 sub checkpw_hash {
1844     my ( $password, $stored_hash ) = @_;
1845
1846     return if $stored_hash eq '!';
1847
1848     # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1849     my $hash;
1850     if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1851         $hash = hash_password( $password, $stored_hash );
1852     } else {
1853         $hash = md5_base64($password);
1854     }
1855     return $hash eq $stored_hash;
1856 }
1857
1858 =head2 getuserflags
1859
1860     my $authflags = getuserflags($flags, $userid, [$dbh]);
1861
1862 Translates integer flags into permissions strings hash.
1863
1864 C<$flags> is the integer userflags value ( borrowers.userflags )
1865 C<$userid> is the members.userid, used for building subpermissions
1866 C<$authflags> is a hashref of permissions
1867
1868 =cut
1869
1870 sub getuserflags {
1871     my $flags  = shift;
1872     my $userid = shift;
1873     my $dbh    = @_ ? shift : C4::Context->dbh;
1874     my $userflags;
1875     {
1876         # I don't want to do this, but if someone logs in as the database
1877         # user, it would be preferable not to spam them to death with
1878         # numeric warnings. So, we make $flags numeric.
1879         no warnings 'numeric';
1880         $flags += 0;
1881     }
1882     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1883     $sth->execute;
1884
1885     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1886         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1887             $userflags->{$flag} = 1;
1888         }
1889         else {
1890             $userflags->{$flag} = 0;
1891         }
1892     }
1893
1894     # get subpermissions and merge with top-level permissions
1895     my $user_subperms = get_user_subpermissions($userid);
1896     foreach my $module ( keys %$user_subperms ) {
1897         next if $userflags->{$module} == 1;    # user already has permission for everything in this module
1898         $userflags->{$module} = $user_subperms->{$module};
1899     }
1900
1901     return $userflags;
1902 }
1903
1904 =head2 get_user_subpermissions
1905
1906   $user_perm_hashref = get_user_subpermissions($userid);
1907
1908 Given the userid (note, not the borrowernumber) of a staff user,
1909 return a hashref of hashrefs of the specific subpermissions
1910 accorded to the user.  An example return is
1911
1912  {
1913     tools => {
1914         export_catalog => 1,
1915         import_patrons => 1,
1916     }
1917  }
1918
1919 The top-level hash-key is a module or function code from
1920 userflags.flag, while the second-level key is a code
1921 from permissions.
1922
1923 The results of this function do not give a complete picture
1924 of the functions that a staff user can access; it is also
1925 necessary to check borrowers.flags.
1926
1927 =cut
1928
1929 sub get_user_subpermissions {
1930     my $userid = shift;
1931
1932     my $dbh = C4::Context->dbh;
1933     my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
1934                              FROM user_permissions
1935                              JOIN permissions USING (module_bit, code)
1936                              JOIN userflags ON (module_bit = bit)
1937                              JOIN borrowers USING (borrowernumber)
1938                              WHERE userid = ?" );
1939     $sth->execute($userid);
1940
1941     my $user_perms = {};
1942     while ( my $perm = $sth->fetchrow_hashref ) {
1943         $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1944     }
1945     return $user_perms;
1946 }
1947
1948 =head2 get_all_subpermissions
1949
1950   my $perm_hashref = get_all_subpermissions();
1951
1952 Returns a hashref of hashrefs defining all specific
1953 permissions currently defined.  The return value
1954 has the same structure as that of C<get_user_subpermissions>,
1955 except that the innermost hash value is the description
1956 of the subpermission.
1957
1958 =cut
1959
1960 sub get_all_subpermissions {
1961     my $dbh = C4::Context->dbh;
1962     my $sth = $dbh->prepare( "SELECT flag, code
1963                              FROM permissions
1964                              JOIN userflags ON (module_bit = bit)" );
1965     $sth->execute();
1966
1967     my $all_perms = {};
1968     while ( my $perm = $sth->fetchrow_hashref ) {
1969         $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1970     }
1971     return $all_perms;
1972 }
1973
1974 =head2 haspermission
1975
1976   $flags = ($userid, $flagsrequired);
1977
1978 C<$userid> the userid of the member
1979 C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
1980
1981 Returns member's flags or 0 if a permission is not met.
1982
1983 =cut
1984
1985 sub haspermission {
1986     my ( $userid, $flagsrequired ) = @_;
1987     my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1988     $sth->execute($userid);
1989     my $row = $sth->fetchrow();
1990     my $flags = getuserflags( $row, $userid );
1991     if ( $userid eq C4::Context->config('user') ) {
1992
1993         # Super User Account from /etc/koha.conf
1994         $flags->{'superlibrarian'} = 1;
1995     }
1996     elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
1997
1998         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1999         $flags->{'superlibrarian'} = 1;
2000     }
2001
2002     return $flags if $flags->{superlibrarian};
2003
2004     foreach my $module ( keys %$flagsrequired ) {
2005         my $subperm = $flagsrequired->{$module};
2006         if ( $subperm eq '*' ) {
2007             return 0 unless ( $flags->{$module} == 1 or ref( $flags->{$module} ) );
2008         } else {
2009             return 0 unless (
2010                 ( defined $flags->{$module} and
2011                     $flags->{$module} == 1 )
2012                 or
2013                 ( ref( $flags->{$module} ) and
2014                     exists $flags->{$module}->{$subperm} and
2015                     $flags->{$module}->{$subperm} == 1 )
2016             );
2017         }
2018     }
2019     return $flags;
2020
2021     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2022 }
2023
2024 sub getborrowernumber {
2025     my ($userid) = @_;
2026     my $userenv = C4::Context->userenv;
2027     if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2028         return $userenv->{number};
2029     }
2030     my $dbh = C4::Context->dbh;
2031     for my $field ( 'userid', 'cardnumber' ) {
2032         my $sth =
2033           $dbh->prepare("select borrowernumber from borrowers where $field=?");
2034         $sth->execute($userid);
2035         if ( $sth->rows ) {
2036             my ($bnumber) = $sth->fetchrow;
2037             return $bnumber;
2038         }
2039     }
2040     return 0;
2041 }
2042
2043 END { }    # module clean-up code here (global destructor)
2044 1;
2045 __END__
2046
2047 =head1 SEE ALSO
2048
2049 CGI(3)
2050
2051 C4::Output(3)
2052
2053 Crypt::Eksblowfish::Bcrypt(3)
2054
2055 Digest::MD5(3)
2056
2057 =cut