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