C4/Auth.pm

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