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