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         my $pki_field = C4::Context->preference('AllowPKIAuth');
 922         if ( !defined($pki_field) ) {
 923             print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
 924             $pki_field = 'None';
 925         }
 926         if ( ( $cas && $query->param('ticket') )
 927             || $q_userid
 928             || ( $shib && $shib_login )
 929             || $pki_field ne 'None'
 930             || $persona )
 931         {
 932             my $password    = $query->param('password');
 933             my $shibSuccess = 0;
 934
 935             my ( $return, $cardnumber );
 936
 937             # If shib is enabled and we have a shib login, does the login match a valid koha user
 938             if ( $shib && $shib_login && $type eq 'opac' ) {
 939                 my $retuserid;
 940
 941                 # Do not pass password here, else shib will not be checked in checkpw.
 942                 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $q_userid, undef, $query );
 943                 $userid      = $retuserid;
 944                 $shibSuccess = $return;
 945                 $info{'invalidShibLogin'} = 1 unless ($return);
 946             }
 947
 948             # If shib login and match were successful, skip further login methods
 949             unless ($shibSuccess) {
 950                 if ( $cas && $query->param('ticket') ) {
 951                     my $retuserid;
 952                     ( $return, $cardnumber, $retuserid ) =
 953                       checkpw( $dbh, $userid, $password, $query, $type );
 954                     $userid = $retuserid;
 955                     $info{'invalidCasLogin'} = 1 unless ($return);
 956                 }
 957
 958                 elsif ($persona) {
 959                     my $value = $persona;
 960
 961                     # If we're looking up the email, there's a chance that the person
 962                     # doesn't have a userid. So if there is none, we pass along the
 963                     # borrower number, and the bits of code that need to know the user
 964                     # ID will have to be smart enough to handle that.
 965                     require C4::Members;
 966                     my @users_info = C4::Members::GetBorrowersWithEmail($value);
 967                     if (@users_info) {
 968
 969                         # First the userid, then the borrowernum
 970                         $value = $users_info[0][1] || $users_info[0][0];
 971                     }
 972                     else {
 973                         undef $value;
 974                     }
 975                     $return = $value ? 1 : 0;
 976                     $userid = $value;
 977                 }
 978
 979                 elsif (
 980                     ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
 981                     || ( $pki_field eq 'emailAddress'
 982                         && $ENV{'SSL_CLIENT_S_DN_Email'} )
 983                   )
 984                 {
 985                     my $value;
 986                     if ( $pki_field eq 'Common Name' ) {
 987                         $value = $ENV{'SSL_CLIENT_S_DN_CN'};
 988                     }
 989                     elsif ( $pki_field eq 'emailAddress' ) {
 990                         $value = $ENV{'SSL_CLIENT_S_DN_Email'};
 991
 992                         # If we're looking up the email, there's a chance that the person
 993                         # doesn't have a userid. So if there is none, we pass along the
 994                         # borrower number, and the bits of code that need to know the user
 995                         # ID will have to be smart enough to handle that.
 996                         require C4::Members;
 997                         my @users_info = C4::Members::GetBorrowersWithEmail($value);
 998                         if (@users_info) {
 999
1000                             # First the userid, then the borrowernum
1001                             $value = $users_info[0][1] || $users_info[0][0];
1002                         } else {
1003                             undef $value;
1004                         }
1005                     }
1006
1007                     $return = $value ? 1 : 0;
1008                     $userid = $value;
1009
1010                 }
1011                 else {
1012                     my $retuserid;
1013                     ( $return, $cardnumber, $retuserid ) =
1014                       checkpw( $dbh, $q_userid, $password, $query, $type );
1015                     $userid = $retuserid if ($retuserid);
1016                     $info{'invalid_username_or_password'} = 1 unless ($return);
1017                 }
1018             }
1019
1020             # $return: 1 = valid user, 2 = superlibrarian
1021             if ($return) {
1022
1023                 #_session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
1024                 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1025                     $loggedin = 1;
1026                 }
1027                 else {
1028                     $info{'nopermission'} = 1;
1029                     C4::Context->_unset_userenv($sessionID);
1030                 }
1031                 my ( $borrowernumber, $firstname, $surname, $userflags,
1032                     $branchcode, $branchname, $branchprinter, $emailaddress );
1033
1034                 if ( $return == 1 ) {
1035                     my $select = "
1036                     SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1037                     branches.branchname    as branchname,
1038                     branches.branchprinter as branchprinter,
1039                     email
1040                     FROM borrowers
1041                     LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1042                     ";
1043                     my $sth = $dbh->prepare("$select where userid=?");
1044                     $sth->execute($userid);
1045                     unless ( $sth->rows ) {
1046                         $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
1047                         $sth = $dbh->prepare("$select where cardnumber=?");
1048                         $sth->execute($cardnumber);
1049
1050                         unless ( $sth->rows ) {
1051                             $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1052                             $sth->execute($userid);
1053                             unless ( $sth->rows ) {
1054                                 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1055                             }
1056                         }
1057                     }
1058                     if ( $sth->rows ) {
1059                         ( $borrowernumber, $firstname, $surname, $userflags,
1060                             $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow;
1061                         $debug and print STDERR "AUTH_3 results: " .
1062                           "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1063                     } else {
1064                         print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1065                     }
1066
1067                     # launch a sequence to check if we have a ip for the branch, i
1068                     # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1069
1070                     my $ip = $ENV{'REMOTE_ADDR'};
1071
1072                     # if they specify at login, use that
1073                     if ( $query->param('branch') ) {
1074                         $branchcode = $query->param('branch');
1075                         $branchname = GetBranchName($branchcode);
1076                     }
1077                     my $branches = GetBranches();
1078                     if ( $type ne 'opac' and C4::Context->boolean_preference('AutoLocation') ) {
1079
1080                         # we have to check they are coming from the right ip range
1081                         my $domain = $branches->{$branchcode}->{'branchip'};
1082                         $domain =~ s|\.\*||g;
1083                         if ( $ip !~ /^$domain/ ) {
1084                             $loggedin = 0;
1085                             $cookie = $query->cookie(
1086                                 -name     => 'CGISESSID',
1087                                 -value    => '',
1088                                 -HttpOnly => 1
1089                             );
1090                             $info{'wrongip'} = 1;
1091                         }
1092                     }
1093
1094                     my @branchesloop;
1095                     foreach my $br ( keys %$branches ) {
1096
1097                         #     now we work with the treatment of ip
1098                         my $domain = $branches->{$br}->{'branchip'};
1099                         if ( $domain && $ip =~ /^$domain/ ) {
1100                             $branchcode = $branches->{$br}->{'branchcode'};
1101
1102                             # new op dev : add the branchprinter and branchname in the cookie
1103                             $branchprinter = $branches->{$br}->{'branchprinter'};
1104                             $branchname    = $branches->{$br}->{'branchname'};
1105                         }
1106                     }
1107                     $session->param( 'number',       $borrowernumber );
1108                     $session->param( 'id',           $userid );
1109                     $session->param( 'cardnumber',   $cardnumber );
1110                     $session->param( 'firstname',    $firstname );
1111                     $session->param( 'surname',      $surname );
1112                     $session->param( 'branch',       $branchcode );
1113                     $session->param( 'branchname',   $branchname );
1114                     $session->param( 'flags',        $userflags );
1115                     $session->param( 'emailaddress', $emailaddress );
1116                     $session->param( 'ip',           $session->remote_addr() );
1117                     $session->param( 'lasttime',     time() );
1118                     $session->param( 'shibboleth',   $shibSuccess );
1119                     $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1120                 }
1121                 elsif ( $return == 2 ) {
1122
1123                     #We suppose the user is the superlibrarian
1124                     $borrowernumber = 0;
1125                     $session->param( 'number',       0 );
1126                     $session->param( 'id',           C4::Context->config('user') );
1127                     $session->param( 'cardnumber',   C4::Context->config('user') );
1128                     $session->param( 'firstname',    C4::Context->config('user') );
1129                     $session->param( 'surname',      C4::Context->config('user') );
1130                     $session->param( 'branch',       'NO_LIBRARY_SET' );
1131                     $session->param( 'branchname',   'NO_LIBRARY_SET' );
1132                     $session->param( 'flags',        1 );
1133                     $session->param( 'emailaddress', C4::Context->preference('KohaAdminEmailAddress') );
1134                     $session->param( 'ip',           $session->remote_addr() );
1135                     $session->param( 'lasttime',     time() );
1136                 }
1137                 if ($persona) {
1138                     $session->param( 'persona', 1 );
1139                 }
1140                 C4::Context->set_userenv(
1141                     $session->param('number'),       $session->param('id'),
1142                     $session->param('cardnumber'),   $session->param('firstname'),
1143                     $session->param('surname'),      $session->param('branch'),
1144                     $session->param('branchname'),   $session->param('flags'),
1145                     $session->param('emailaddress'), $session->param('branchprinter'),
1146                     $session->param('persona'),      $session->param('shibboleth')
1147                 );
1148
1149             }
1150             # $return: 0 = invalid user
1151             # reset to anonymous session
1152             else {
1153                 $debug and warn "Login failed, resetting anonymous session...";
1154                 if ($userid) {
1155                     $info{'invalid_username_or_password'} = 1;
1156                     C4::Context->_unset_userenv($sessionID);
1157                 }
1158                 $session->param( 'lasttime', time() );
1159                 $session->param( 'ip',       $session->remote_addr() );
1160                 $session->param( 'sessiontype', 'anon' );
1161             }
1162         }    # END if ( $q_userid
1163         elsif ( $type eq "opac" ) {
1164
1165             # if we are here this is an anonymous session; add public lists to it and a few other items...
1166             # anonymous sessions are created only for the OPAC
1167             $debug and warn "Initiating an anonymous session...";
1168
1169             # setting a couple of other session vars...
1170             $session->param( 'ip',          $session->remote_addr() );
1171             $session->param( 'lasttime',    time() );
1172             $session->param( 'sessiontype', 'anon' );
1173         }
1174     }    # END unless ($userid)
1175
1176     # finished authentification, now respond
1177     if ( $loggedin || $authnotrequired )
1178     {
1179         # successful login
1180         unless ($cookie) {
1181             $cookie = $query->cookie(
1182                 -name     => 'CGISESSID',
1183                 -value    => '',
1184                 -HttpOnly => 1
1185             );
1186         }
1187         return ( $userid, $cookie, $sessionID, $flags );
1188     }
1189
1190     #
1191     #
1192     # AUTH rejected, show the login/password template, after checking the DB.
1193     #
1194     #
1195
1196     # get the inputs from the incoming query
1197     my @inputs = ();
1198     foreach my $name ( param $query) {
1199         (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1200         my $value = $query->param($name);
1201         push @inputs, { name => $name, value => $value };
1202     }
1203
1204     my $LibraryNameTitle = C4::Context->preference("LibraryName");
1205     $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1206     $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1207
1208     my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1209     my $template = C4::Templates::gettemplate( $template_name, $type, $query );
1210     $template->param(
1211         branchloop                            => GetBranchesLoop(),
1212         OpacAdditionalStylesheet                   => C4::Context->preference("OpacAdditionalStylesheet"),
1213         opaclayoutstylesheet                  => C4::Context->preference("opaclayoutstylesheet"),
1214         login                                 => 1,
1215         INPUTS                                => \@inputs,
1216         script_name                           => get_script_name(),
1217         casAuthentication                     => C4::Context->preference("casAuthentication"),
1218         shibbolethAuthentication              => $shib,
1219         SessionRestrictionByIP                => C4::Context->preference("SessionRestrictionByIP"),
1220         suggestion                            => C4::Context->preference("suggestion"),
1221         virtualshelves                        => C4::Context->preference("virtualshelves"),
1222         LibraryName                           => "" . C4::Context->preference("LibraryName"),
1223         LibraryNameTitle                      => "" . $LibraryNameTitle,
1224         opacuserlogin                         => C4::Context->preference("opacuserlogin"),
1225         OpacNav                               => C4::Context->preference("OpacNav"),
1226         OpacNavRight                          => C4::Context->preference("OpacNavRight"),
1227         OpacNavBottom                         => C4::Context->preference("OpacNavBottom"),
1228         opaccredits                           => C4::Context->preference("opaccredits"),
1229         OpacFavicon                           => C4::Context->preference("OpacFavicon"),
1230         opacreadinghistory                    => C4::Context->preference("opacreadinghistory"),
1231         opaclanguagesdisplay                  => C4::Context->preference("opaclanguagesdisplay"),
1232         OPACUserJS                            => C4::Context->preference("OPACUserJS"),
1233         opacbookbag                           => "" . C4::Context->preference("opacbookbag"),
1234         OpacCloud                             => C4::Context->preference("OpacCloud"),
1235         OpacTopissue                          => C4::Context->preference("OpacTopissue"),
1236         OpacAuthorities                       => C4::Context->preference("OpacAuthorities"),
1237         OpacBrowser                           => C4::Context->preference("OpacBrowser"),
1238         opacheader                            => C4::Context->preference("opacheader"),
1239         TagsEnabled                           => C4::Context->preference("TagsEnabled"),
1240         OPACUserCSS                           => C4::Context->preference("OPACUserCSS"),
1241         intranetcolorstylesheet               => C4::Context->preference("intranetcolorstylesheet"),
1242         intranetstylesheet                    => C4::Context->preference("intranetstylesheet"),
1243         intranetbookbag                       => C4::Context->preference("intranetbookbag"),
1244         IntranetNav                           => C4::Context->preference("IntranetNav"),
1245         IntranetFavicon                       => C4::Context->preference("IntranetFavicon"),
1246         IntranetUserCSS                       => C4::Context->preference("IntranetUserCSS"),
1247         IntranetUserJS                        => C4::Context->preference("IntranetUserJS"),
1248         IndependentBranches                   => C4::Context->preference("IndependentBranches"),
1249         AutoLocation                          => C4::Context->preference("AutoLocation"),
1250         wrongip                               => $info{'wrongip'},
1251         PatronSelfRegistration                => C4::Context->preference("PatronSelfRegistration"),
1252         PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1253         persona                               => C4::Context->preference("Persona"),
1254         opac_css_override                     => $ENV{'OPAC_CSS_OVERRIDE'},
1255     );
1256
1257     $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1258     $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1259     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1260
1261     if ( $type eq 'opac' ) {
1262         require Koha::Virtualshelves;
1263         my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1264             {
1265                 category       => 2,
1266             }
1267         );
1268         $template->param(
1269             some_public_shelves  => $some_public_shelves,
1270         );
1271     }
1272
1273     if ($cas) {
1274
1275         # Is authentication against multiple CAS servers enabled?
1276         if ( C4::Auth_with_cas::multipleAuth && !$casparam ) {
1277             my $casservers = C4::Auth_with_cas::getMultipleAuth();
1278             my @tmplservers;
1279             foreach my $key ( keys %$casservers ) {
1280                 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1281             }
1282             $template->param(
1283                 casServersLoop => \@tmplservers
1284             );
1285         } else {
1286             $template->param(
1287                 casServerUrl => login_cas_url($query, undef, $type),
1288             );
1289         }
1290
1291         $template->param(
1292             invalidCasLogin => $info{'invalidCasLogin'}
1293         );
1294     }
1295
1296     if ($shib) {
1297         $template->param(
1298             shibbolethAuthentication => $shib,
1299             shibbolethLoginUrl       => login_shib_url($query),
1300         );
1301     }
1302
1303     $template->param(
1304         LibraryName => C4::Context->preference("LibraryName"),
1305     );
1306     $template->param(%info);
1307
1308     #    $cookie = $query->cookie(CGISESSID => $session->id
1309     #   );
1310     print $query->header(
1311         {   type              => 'text/html',
1312             charset           => 'utf-8',
1313             cookie            => $cookie,
1314             'X-Frame-Options' => 'SAMEORIGIN'
1315         }
1316       ),
1317       $template->output;
1318     safe_exit;
1319 }
1320
1321 =head2 check_api_auth
1322
1323   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1324
1325 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1326 cookie, determine if the user has the privileges specified by C<$userflags>.
1327
1328 C<check_api_auth> is is meant for authenticating users of web services, and
1329 consequently will always return and will not attempt to redirect the user
1330 agent.
1331
1332 If a valid session cookie is already present, check_api_auth will return a status
1333 of "ok", the cookie, and the Koha session ID.
1334
1335 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1336 parameters and create a session cookie and Koha session if the supplied credentials
1337 are OK.
1338
1339 Possible return values in C<$status> are:
1340
1341 =over
1342
1343 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1344
1345 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1346
1347 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1348
1349 =item "expired -- session cookie has expired; API user should resubmit userid and password
1350
1351 =back
1352
1353 =cut
1354
1355 sub check_api_auth {
1356     my $query         = shift;
1357     my $flagsrequired = shift;
1358
1359     my $dbh     = C4::Context->dbh;
1360     my $timeout = _timeout_syspref();
1361
1362     unless ( C4::Context->preference('Version') ) {
1363
1364         # database has not been installed yet
1365         return ( "maintenance", undef, undef );
1366     }
1367     my $kohaversion = Koha::version();
1368     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1369     if ( C4::Context->preference('Version') < $kohaversion ) {
1370
1371         # database in need of version update; assume that
1372         # no API should be called while databsae is in
1373         # this condition.
1374         return ( "maintenance", undef, undef );
1375     }
1376
1377     # FIXME -- most of what follows is a copy-and-paste
1378     # of code from checkauth.  There is an obvious need
1379     # for refactoring to separate the various parts of
1380     # the authentication code, but as of 2007-11-19 this
1381     # is deferred so as to not introduce bugs into the
1382     # regular authentication code for Koha 3.0.
1383
1384     # see if we have a valid session cookie already
1385     # however, if a userid parameter is present (i.e., from
1386     # a form submission, assume that any current cookie
1387     # is to be ignored
1388     my $sessionID = undef;
1389     unless ( $query->param('userid') ) {
1390         $sessionID = $query->cookie("CGISESSID");
1391     }
1392     if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1393         my $session = get_session($sessionID);
1394         C4::Context->_new_userenv($sessionID);
1395         if ($session) {
1396             C4::Context->set_userenv(
1397                 $session->param('number'),       $session->param('id'),
1398                 $session->param('cardnumber'),   $session->param('firstname'),
1399                 $session->param('surname'),      $session->param('branch'),
1400                 $session->param('branchname'),   $session->param('flags'),
1401                 $session->param('emailaddress'), $session->param('branchprinter')
1402             );
1403
1404             my $ip       = $session->param('ip');
1405             my $lasttime = $session->param('lasttime');
1406             my $userid   = $session->param('id');
1407             if ( $lasttime < time() - $timeout ) {
1408
1409                 # time out
1410                 $session->delete();
1411                 $session->flush;
1412                 C4::Context->_unset_userenv($sessionID);
1413                 $userid    = undef;
1414                 $sessionID = undef;
1415                 return ( "expired", undef, undef );
1416             } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1417
1418                 # IP address changed
1419                 $session->delete();
1420                 $session->flush;
1421                 C4::Context->_unset_userenv($sessionID);
1422                 $userid    = undef;
1423                 $sessionID = undef;
1424                 return ( "expired", undef, undef );
1425             } else {
1426                 my $cookie = $query->cookie(
1427                     -name     => 'CGISESSID',
1428                     -value    => $session->id,
1429                     -HttpOnly => 1,
1430                 );
1431                 $session->param( 'lasttime', time() );
1432                 my $flags = haspermission( $userid, $flagsrequired );
1433                 if ($flags) {
1434                     return ( "ok", $cookie, $sessionID );
1435                 } else {
1436                     $session->delete();
1437                     $session->flush;
1438                     C4::Context->_unset_userenv($sessionID);
1439                     $userid    = undef;
1440                     $sessionID = undef;
1441                     return ( "failed", undef, undef );
1442                 }
1443             }
1444         } else {
1445             return ( "expired", undef, undef );
1446         }
1447     } else {
1448
1449         # new login
1450         my $userid   = $query->param('userid');
1451         my $password = $query->param('password');
1452         my ( $return, $cardnumber );
1453
1454         # Proxy CAS auth
1455         if ( $cas && $query->param('PT') ) {
1456             my $retuserid;
1457             $debug and print STDERR "## check_api_auth - checking CAS\n";
1458
1459             # In case of a CAS authentication, we use the ticket instead of the password
1460             my $PT = $query->param('PT');
1461             ( $return, $cardnumber, $userid ) = check_api_auth_cas( $dbh, $PT, $query );    # EXTERNAL AUTH
1462         } else {
1463
1464             # User / password auth
1465             unless ( $userid and $password ) {
1466
1467                 # caller did something wrong, fail the authenticateion
1468                 return ( "failed", undef, undef );
1469             }
1470             ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password, $query );
1471         }
1472
1473         if ( $return and haspermission( $userid, $flagsrequired ) ) {
1474             my $session = get_session("");
1475             return ( "failed", undef, undef ) unless $session;
1476
1477             my $sessionID = $session->id;
1478             C4::Context->_new_userenv($sessionID);
1479             my $cookie = $query->cookie(
1480                 -name     => 'CGISESSID',
1481                 -value    => $sessionID,
1482                 -HttpOnly => 1,
1483             );
1484             if ( $return == 1 ) {
1485                 my (
1486                     $borrowernumber, $firstname,  $surname,
1487                     $userflags,      $branchcode, $branchname,
1488                     $branchprinter,  $emailaddress
1489                 );
1490                 my $sth =
1491                   $dbh->prepare(
1492 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname,branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1493                   );
1494                 $sth->execute($userid);
1495                 (
1496                     $borrowernumber, $firstname,  $surname,
1497                     $userflags,      $branchcode, $branchname,
1498                     $branchprinter,  $emailaddress
1499                 ) = $sth->fetchrow if ( $sth->rows );
1500
1501                 unless ( $sth->rows ) {
1502                     my $sth = $dbh->prepare(
1503 "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=?"
1504                     );
1505                     $sth->execute($cardnumber);
1506                     (
1507                         $borrowernumber, $firstname,  $surname,
1508                         $userflags,      $branchcode, $branchname,
1509                         $branchprinter,  $emailaddress
1510                     ) = $sth->fetchrow if ( $sth->rows );
1511
1512                     unless ( $sth->rows ) {
1513                         $sth->execute($userid);
1514                         (
1515                             $borrowernumber, $firstname,  $surname,       $userflags,
1516                             $branchcode,     $branchname, $branchprinter, $emailaddress
1517                         ) = $sth->fetchrow if ( $sth->rows );
1518                     }
1519                 }
1520
1521                 my $ip = $ENV{'REMOTE_ADDR'};
1522
1523                 # if they specify at login, use that
1524                 if ( $query->param('branch') ) {
1525                     $branchcode = $query->param('branch');
1526                     $branchname = GetBranchName($branchcode);
1527                 }
1528                 my $branches = GetBranches();
1529                 my @branchesloop;
1530                 foreach my $br ( keys %$branches ) {
1531
1532                     #     now we work with the treatment of ip
1533                     my $domain = $branches->{$br}->{'branchip'};
1534                     if ( $domain && $ip =~ /^$domain/ ) {
1535                         $branchcode = $branches->{$br}->{'branchcode'};
1536
1537                         # new op dev : add the branchprinter and branchname in the cookie
1538                         $branchprinter = $branches->{$br}->{'branchprinter'};
1539                         $branchname    = $branches->{$br}->{'branchname'};
1540                     }
1541                 }
1542                 $session->param( 'number',       $borrowernumber );
1543                 $session->param( 'id',           $userid );
1544                 $session->param( 'cardnumber',   $cardnumber );
1545                 $session->param( 'firstname',    $firstname );
1546                 $session->param( 'surname',      $surname );
1547                 $session->param( 'branch',       $branchcode );
1548                 $session->param( 'branchname',   $branchname );
1549                 $session->param( 'flags',        $userflags );
1550                 $session->param( 'emailaddress', $emailaddress );
1551                 $session->param( 'ip',           $session->remote_addr() );
1552                 $session->param( 'lasttime',     time() );
1553             } elsif ( $return == 2 ) {
1554
1555                 #We suppose the user is the superlibrarian
1556                 $session->param( 'number',       0 );
1557                 $session->param( 'id',           C4::Context->config('user') );
1558                 $session->param( 'cardnumber',   C4::Context->config('user') );
1559                 $session->param( 'firstname',    C4::Context->config('user') );
1560                 $session->param( 'surname',      C4::Context->config('user') );
1561                 $session->param( 'branch',       'NO_LIBRARY_SET' );
1562                 $session->param( 'branchname',   'NO_LIBRARY_SET' );
1563                 $session->param( 'flags',        1 );
1564                 $session->param( 'emailaddress', C4::Context->preference('KohaAdminEmailAddress') );
1565                 $session->param( 'ip',           $session->remote_addr() );
1566                 $session->param( 'lasttime',     time() );
1567             }
1568             C4::Context->set_userenv(
1569                 $session->param('number'),       $session->param('id'),
1570                 $session->param('cardnumber'),   $session->param('firstname'),
1571                 $session->param('surname'),      $session->param('branch'),
1572                 $session->param('branchname'),   $session->param('flags'),
1573                 $session->param('emailaddress'), $session->param('branchprinter')
1574             );
1575             return ( "ok", $cookie, $sessionID );
1576         } else {
1577             return ( "failed", undef, undef );
1578         }
1579     }
1580 }
1581
1582 =head2 check_cookie_auth
1583
1584   ($status, $sessionId) = check_api_auth($cookie, $userflags);
1585
1586 Given a CGISESSID cookie set during a previous login to Koha, determine
1587 if the user has the privileges specified by C<$userflags>.
1588
1589 C<check_cookie_auth> is meant for authenticating special services
1590 such as tools/upload-file.pl that are invoked by other pages that
1591 have been authenticated in the usual way.
1592
1593 Possible return values in C<$status> are:
1594
1595 =over
1596
1597 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1598
1599 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1600
1601 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1602
1603 =item "expired -- session cookie has expired; API user should resubmit userid and password
1604
1605 =back
1606
1607 =cut
1608
1609 sub check_cookie_auth {
1610     my $cookie        = shift;
1611     my $flagsrequired = shift;
1612
1613     my $dbh     = C4::Context->dbh;
1614     my $timeout = _timeout_syspref();
1615
1616     unless ( C4::Context->preference('Version') ) {
1617
1618         # database has not been installed yet
1619         return ( "maintenance", undef );
1620     }
1621     my $kohaversion = Koha::version();
1622     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1623     if ( C4::Context->preference('Version') < $kohaversion ) {
1624
1625         # database in need of version update; assume that
1626         # no API should be called while databsae is in
1627         # this condition.
1628         return ( "maintenance", undef );
1629     }
1630
1631     # FIXME -- most of what follows is a copy-and-paste
1632     # of code from checkauth.  There is an obvious need
1633     # for refactoring to separate the various parts of
1634     # the authentication code, but as of 2007-11-23 this
1635     # is deferred so as to not introduce bugs into the
1636     # regular authentication code for Koha 3.0.
1637
1638     # see if we have a valid session cookie already
1639     # however, if a userid parameter is present (i.e., from
1640     # a form submission, assume that any current cookie
1641     # is to be ignored
1642     unless ( defined $cookie and $cookie ) {
1643         return ( "failed", undef );
1644     }
1645     my $sessionID = $cookie;
1646     my $session   = get_session($sessionID);
1647     C4::Context->_new_userenv($sessionID);
1648     if ($session) {
1649         C4::Context->set_userenv(
1650             $session->param('number'),       $session->param('id'),
1651             $session->param('cardnumber'),   $session->param('firstname'),
1652             $session->param('surname'),      $session->param('branch'),
1653             $session->param('branchname'),   $session->param('flags'),
1654             $session->param('emailaddress'), $session->param('branchprinter')
1655         );
1656
1657         my $ip       = $session->param('ip');
1658         my $lasttime = $session->param('lasttime');
1659         my $userid   = $session->param('id');
1660         if ( $lasttime < time() - $timeout ) {
1661
1662             # time out
1663             $session->delete();
1664             $session->flush;
1665             C4::Context->_unset_userenv($sessionID);
1666             $userid    = undef;
1667             $sessionID = undef;
1668             return ("expired", undef);
1669         } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1670
1671             # IP address changed
1672             $session->delete();
1673             $session->flush;
1674             C4::Context->_unset_userenv($sessionID);
1675             $userid    = undef;
1676             $sessionID = undef;
1677             return ( "expired", undef );
1678         } else {
1679             $session->param( 'lasttime', time() );
1680             my $flags = haspermission( $userid, $flagsrequired );
1681             if ($flags) {
1682                 return ( "ok", $sessionID );
1683             } else {
1684                 $session->delete();
1685                 $session->flush;
1686                 C4::Context->_unset_userenv($sessionID);
1687                 $userid    = undef;
1688                 $sessionID = undef;
1689                 return ( "failed", undef );
1690             }
1691         }
1692     } else {
1693         return ( "expired", undef );
1694     }
1695 }
1696
1697 =head2 get_session
1698
1699   use CGI::Session;
1700   my $session = get_session($sessionID);
1701
1702 Given a session ID, retrieve the CGI::Session object used to store
1703 the session's state.  The session object can be used to store
1704 data that needs to be accessed by different scripts during a
1705 user's session.
1706
1707 If the C<$sessionID> parameter is an empty string, a new session
1708 will be created.
1709
1710 =cut
1711
1712 sub get_session {
1713     my $sessionID      = shift;
1714     my $storage_method = C4::Context->preference('SessionStorage');
1715     my $dbh            = C4::Context->dbh;
1716     my $session;
1717     if ( $storage_method eq 'mysql' ) {
1718         $session = new CGI::Session( "driver:MySQL;serializer:yaml;id:md5", $sessionID, { Handle => $dbh } );
1719     }
1720     elsif ( $storage_method eq 'Pg' ) {
1721         $session = new CGI::Session( "driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, { Handle => $dbh } );
1722     }
1723     elsif ( $storage_method eq 'memcached' && C4::Context->ismemcached ) {
1724         $session = new CGI::Session( "driver:memcached;serializer:yaml;id:md5", $sessionID, { Memcached => C4::Context->memcached } );
1725     }
1726     else {
1727         # catch all defaults to tmp should work on all systems
1728         my $dir = File::Spec->tmpdir;
1729         my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1730         $session = new CGI::Session( "driver:File;serializer:yaml;id:md5", $sessionID, { Directory => "$dir/cgisess_$instance" } );
1731     }
1732     return $session;
1733 }
1734
1735
1736 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1737 # (or something similar)
1738 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1739 # not having a userenv defined could cause a crash.
1740 sub checkpw {
1741     my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1742     $type = 'opac' unless $type;
1743     if ($ldap) {
1744         $debug and print STDERR "## checkpw - checking LDAP\n";
1745         my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_);    # EXTERNAL AUTH
1746         return 0 if $retval == -1;                                  # Incorrect password for LDAP login attempt
1747         ($retval) and return ( $retval, $retcard, $retuserid );
1748     }
1749
1750     if ( $cas && $query && $query->param('ticket') ) {
1751         $debug and print STDERR "## checkpw - checking CAS\n";
1752
1753         # In case of a CAS authentication, we use the ticket instead of the password
1754         my $ticket = $query->param('ticket');
1755         $query->delete('ticket');                                   # remove ticket to come back to original URL
1756         my ( $retval, $retcard, $retuserid ) = checkpw_cas( $dbh, $ticket, $query, $type );    # EXTERNAL AUTH
1757         ($retval) and return ( $retval, $retcard, $retuserid );
1758         return 0;
1759     }
1760
1761     # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1762     # Check for password to asertain whether we want to be testing against shibboleth or another method this
1763     # time around.
1764     if ( $shib && $shib_login && !$password ) {
1765
1766         $debug and print STDERR "## checkpw - checking Shibboleth\n";
1767
1768         # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1769         # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1770         # shibboleth-authenticated user
1771
1772         # Then, we check if it matches a valid koha user
1773         if ($shib_login) {
1774             my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login);    # EXTERNAL AUTH
1775             ($retval) and return ( $retval, $retcard, $retuserid );
1776             return 0;
1777         }
1778     }
1779
1780     # INTERNAL AUTH
1781     return checkpw_internal( $dbh, $userid, $password, $no_set_userenv);
1782 }
1783
1784 sub checkpw_internal {
1785     my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
1786
1787     $password = Encode::encode( 'UTF-8', $password )
1788       if Encode::is_utf8($password);
1789
1790     if ( $userid && $userid eq C4::Context->config('user') ) {
1791         if ( $password && $password eq C4::Context->config('pass') ) {
1792
1793             # Koha superuser account
1794             #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1795             return 2;
1796         }
1797         else {
1798             return 0;
1799         }
1800     }
1801
1802     my $sth =
1803       $dbh->prepare(
1804         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1805       );
1806     $sth->execute($userid);
1807     if ( $sth->rows ) {
1808         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1809             $surname, $branchcode, $branchname, $flags )
1810           = $sth->fetchrow;
1811
1812         if ( checkpw_hash( $password, $stored_hash ) ) {
1813
1814             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1815                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1816             return 1, $cardnumber, $userid;
1817         }
1818     }
1819     $sth =
1820       $dbh->prepare(
1821         "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1822       );
1823     $sth->execute($userid);
1824     if ( $sth->rows ) {
1825         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1826             $surname, $branchcode, $branchname, $flags )
1827           = $sth->fetchrow;
1828
1829         if ( checkpw_hash( $password, $stored_hash ) ) {
1830
1831             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1832                 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1833             return 1, $cardnumber, $userid;
1834         }
1835     }
1836     if ( $userid && $userid eq 'demo'
1837         && "$password" eq 'demo'
1838         && C4::Context->config('demo') )
1839     {
1840
1841         # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1842         # some features won't be effective : modify systempref, modify MARC structure,
1843         return 2;
1844     }
1845     return 0;
1846 }
1847
1848 sub checkpw_hash {
1849     my ( $password, $stored_hash ) = @_;
1850
1851     return if $stored_hash eq '!';
1852
1853     # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1854     my $hash;
1855     if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1856         $hash = hash_password( $password, $stored_hash );
1857     } else {
1858         $hash = md5_base64($password);
1859     }
1860     return $hash eq $stored_hash;
1861 }
1862
1863 =head2 getuserflags
1864
1865     my $authflags = getuserflags($flags, $userid, [$dbh]);
1866
1867 Translates integer flags into permissions strings hash.
1868
1869 C<$flags> is the integer userflags value ( borrowers.userflags )
1870 C<$userid> is the members.userid, used for building subpermissions
1871 C<$authflags> is a hashref of permissions
1872
1873 =cut
1874
1875 sub getuserflags {
1876     my $flags  = shift;
1877     my $userid = shift;
1878     my $dbh    = @_ ? shift : C4::Context->dbh;
1879     my $userflags;
1880     {
1881         # I don't want to do this, but if someone logs in as the database
1882         # user, it would be preferable not to spam them to death with
1883         # numeric warnings. So, we make $flags numeric.
1884         no warnings 'numeric';
1885         $flags += 0;
1886     }
1887     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1888     $sth->execute;
1889
1890     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1891         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1892             $userflags->{$flag} = 1;
1893         }
1894         else {
1895             $userflags->{$flag} = 0;
1896         }
1897     }
1898
1899     # get subpermissions and merge with top-level permissions
1900     my $user_subperms = get_user_subpermissions($userid);
1901     foreach my $module ( keys %$user_subperms ) {
1902         next if $userflags->{$module} == 1;    # user already has permission for everything in this module
1903         $userflags->{$module} = $user_subperms->{$module};
1904     }
1905
1906     return $userflags;
1907 }
1908
1909 =head2 get_user_subpermissions
1910
1911   $user_perm_hashref = get_user_subpermissions($userid);
1912
1913 Given the userid (note, not the borrowernumber) of a staff user,
1914 return a hashref of hashrefs of the specific subpermissions
1915 accorded to the user.  An example return is
1916
1917  {
1918     tools => {
1919         export_catalog => 1,
1920         import_patrons => 1,
1921     }
1922  }
1923
1924 The top-level hash-key is a module or function code from
1925 userflags.flag, while the second-level key is a code
1926 from permissions.
1927
1928 The results of this function do not give a complete picture
1929 of the functions that a staff user can access; it is also
1930 necessary to check borrowers.flags.
1931
1932 =cut
1933
1934 sub get_user_subpermissions {
1935     my $userid = shift;
1936
1937     my $dbh = C4::Context->dbh;
1938     my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
1939                              FROM user_permissions
1940                              JOIN permissions USING (module_bit, code)
1941                              JOIN userflags ON (module_bit = bit)
1942                              JOIN borrowers USING (borrowernumber)
1943                              WHERE userid = ?" );
1944     $sth->execute($userid);
1945
1946     my $user_perms = {};
1947     while ( my $perm = $sth->fetchrow_hashref ) {
1948         $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1949     }
1950     return $user_perms;
1951 }
1952
1953 =head2 get_all_subpermissions
1954
1955   my $perm_hashref = get_all_subpermissions();
1956
1957 Returns a hashref of hashrefs defining all specific
1958 permissions currently defined.  The return value
1959 has the same structure as that of C<get_user_subpermissions>,
1960 except that the innermost hash value is the description
1961 of the subpermission.
1962
1963 =cut
1964
1965 sub get_all_subpermissions {
1966     my $dbh = C4::Context->dbh;
1967     my $sth = $dbh->prepare( "SELECT flag, code
1968                              FROM permissions
1969                              JOIN userflags ON (module_bit = bit)" );
1970     $sth->execute();
1971
1972     my $all_perms = {};
1973     while ( my $perm = $sth->fetchrow_hashref ) {
1974         $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1975     }
1976     return $all_perms;
1977 }
1978
1979 =head2 haspermission
1980
1981   $flags = ($userid, $flagsrequired);
1982
1983 C<$userid> the userid of the member
1984 C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
1985
1986 Returns member's flags or 0 if a permission is not met.
1987
1988 =cut
1989
1990 sub haspermission {
1991     my ( $userid, $flagsrequired ) = @_;
1992     my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1993     $sth->execute($userid);
1994     my $row = $sth->fetchrow();
1995     my $flags = getuserflags( $row, $userid );
1996     if ( $userid eq C4::Context->config('user') ) {
1997
1998         # Super User Account from /etc/koha.conf
1999         $flags->{'superlibrarian'} = 1;
2000     }
2001     elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
2002
2003         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
2004         $flags->{'superlibrarian'} = 1;
2005     }
2006
2007     return $flags if $flags->{superlibrarian};
2008
2009     foreach my $module ( keys %$flagsrequired ) {
2010         my $subperm = $flagsrequired->{$module};
2011         if ( $subperm eq '*' ) {
2012             return 0 unless ( $flags->{$module} == 1 or ref( $flags->{$module} ) );
2013         } else {
2014             return 0 unless (
2015                 ( defined $flags->{$module} and
2016                     $flags->{$module} == 1 )
2017                 or
2018                 ( ref( $flags->{$module} ) and
2019                     exists $flags->{$module}->{$subperm} and
2020                     $flags->{$module}->{$subperm} == 1 )
2021             );
2022         }
2023     }
2024     return $flags;
2025
2026     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2027 }
2028
2029 sub getborrowernumber {
2030     my ($userid) = @_;
2031     my $userenv = C4::Context->userenv;
2032     if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2033         return $userenv->{number};
2034     }
2035     my $dbh = C4::Context->dbh;
2036     for my $field ( 'userid', 'cardnumber' ) {
2037         my $sth =
2038           $dbh->prepare("select borrowernumber from borrowers where $field=?");
2039         $sth->execute($userid);
2040         if ( $sth->rows ) {
2041             my ($bnumber) = $sth->fetchrow;
2042             return $bnumber;
2043         }
2044     }
2045     return 0;
2046 }
2047
2048 END { }    # module clean-up code here (global destructor)
2049 1;
2050 __END__
2051
2052 =head1 SEE ALSO
2053
2054 CGI(3)
2055
2056 C4::Output(3)
2057
2058 Crypt::Eksblowfish::Bcrypt(3)
2059
2060 Digest::MD5(3)
2061
2062 =cut