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