C4/Auth.pm

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