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