C4/Auth.pm

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