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