koha-dev.rot13.org Git - srvgit/blob - 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             OpacNav                   => "" . C4::Context->preference("OpacNav"),
 473             OpacNavRight              => "" . C4::Context->preference("OpacNavRight"),
 474             OpacNavBottom             => "" . C4::Context->preference("OpacNavBottom"),
 475             OpacPasswordChange        => C4::Context->preference("OpacPasswordChange"),
 476             OPACPatronDetails         => C4::Context->preference("OPACPatronDetails"),
 477             OPACPrivacy               => C4::Context->preference("OPACPrivacy"),
 478             OPACFinesTab              => C4::Context->preference("OPACFinesTab"),
 479             OpacTopissue              => C4::Context->preference("OpacTopissue"),
 480             RequestOnOpac             => C4::Context->preference("RequestOnOpac"),
 481             'Version'                 => C4::Context->preference('Version'),
 482             hidelostitems             => C4::Context->preference("hidelostitems"),
 483             mylibraryfirst            => (C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv) ? C4::Context->userenv->{'branch'} : '',
 484             opaclayoutstylesheet      => "" . C4::Context->preference("opaclayoutstylesheet"),
 485             opacbookbag               => "" . C4::Context->preference("opacbookbag"),
 486             opaccredits               => "" . C4::Context->preference("opaccredits"),
 487             OpacFavicon               => C4::Context->preference("OpacFavicon"),
 488             opacheader                => "" . C4::Context->preference("opacheader"),
 489             opaclanguagesdisplay      => "" . C4::Context->preference("opaclanguagesdisplay"),
 490             opacreadinghistory        => C4::Context->preference("opacreadinghistory"),
 491             opacuserjs                => C4::Context->preference("opacuserjs"),
 492             opacuserlogin             => "" . C4::Context->preference("opacuserlogin"),
 493             ShowReviewer              => C4::Context->preference("ShowReviewer"),
 494             ShowReviewerPhoto         => C4::Context->preference("ShowReviewerPhoto"),
 495             suggestion                => "" . C4::Context->preference("suggestion"),
 496             virtualshelves            => "" . C4::Context->preference("virtualshelves"),
 497             OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
 498             OPACXSLTDetailsDisplay           => C4::Context->preference("OPACXSLTDetailsDisplay"),
 499             OPACXSLTResultsDisplay           => C4::Context->preference("OPACXSLTResultsDisplay"),
 500             SyndeticsClientCode          => C4::Context->preference("SyndeticsClientCode"),
 501             SyndeticsEnabled             => C4::Context->preference("SyndeticsEnabled"),
 502             SyndeticsCoverImages         => C4::Context->preference("SyndeticsCoverImages"),
 503             SyndeticsTOC                 => C4::Context->preference("SyndeticsTOC"),
 504             SyndeticsSummary             => C4::Context->preference("SyndeticsSummary"),
 505             SyndeticsEditions            => C4::Context->preference("SyndeticsEditions"),
 506             SyndeticsExcerpt             => C4::Context->preference("SyndeticsExcerpt"),
 507             SyndeticsReviews             => C4::Context->preference("SyndeticsReviews"),
 508             SyndeticsAuthorNotes         => C4::Context->preference("SyndeticsAuthorNotes"),
 509             SyndeticsAwards              => C4::Context->preference("SyndeticsAwards"),
 510             SyndeticsSeries              => C4::Context->preference("SyndeticsSeries"),
 511             SyndeticsCoverImageSize      => C4::Context->preference("SyndeticsCoverImageSize"),
 512             OPACLocalCoverImages         => C4::Context->preference("OPACLocalCoverImages"),
 513             PatronSelfRegistration       => C4::Context->preference("PatronSelfRegistration"),
 514             PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
 515         );
 516
 517         $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic"));
 518     }
 519
 520     # Check if we were asked using parameters to force a specific language
 521     if ( defined $in->{'query'}->param('language') ) {
 522         # Extract the language, let C4::Languages::getlanguage choose
 523         # what to do
 524         my $language = C4::Languages::getlanguage($in->{'query'});
 525         my $languagecookie = C4::Templates::getlanguagecookie($in->{'query'},$language);
 526         if ( ref $cookie eq 'ARRAY' ) {
 527             push @{ $cookie }, $languagecookie;
 528         } else {
 529             $cookie = [$cookie, $languagecookie];
 530         }
 531     }
 532
 533     return ( $template, $borrowernumber, $cookie, $flags);
 534 }
 535
 536 =head2 checkauth
 537
 538   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 539
 540 Verifies that the user is authorized to run this script.  If
 541 the user is authorized, a (userid, cookie, session-id, flags)
 542 quadruple is returned.  If the user is not authorized but does
 543 not have the required privilege (see $flagsrequired below), it
 544 displays an error page and exits.  Otherwise, it displays the
 545 login page and exits.
 546
 547 Note that C<&checkauth> will return if and only if the user
 548 is authorized, so it should be called early on, before any
 549 unfinished operations (e.g., if you've opened a file, then
 550 C<&checkauth> won't close it for you).
 551
 552 C<$query> is the CGI object for the script calling C<&checkauth>.
 553
 554 The C<$noauth> argument is optional. If it is set, then no
 555 authorization is required for the script.
 556
 557 C<&checkauth> fetches user and session information from C<$query> and
 558 ensures that the user is authorized to run scripts that require
 559 authorization.
 560
 561 The C<$flagsrequired> argument specifies the required privileges
 562 the user must have if the username and password are correct.
 563 It should be specified as a reference-to-hash; keys in the hash
 564 should be the "flags" for the user, as specified in the Members
 565 intranet module. Any key specified must correspond to a "flag"
 566 in the userflags table. E.g., { circulate => 1 } would specify
 567 that the user must have the "circulate" privilege in order to
 568 proceed. To make sure that access control is correct, the
 569 C<$flagsrequired> parameter must be specified correctly.
 570
 571 Koha also has a concept of sub-permissions, also known as
 572 granular permissions.  This makes the value of each key
 573 in the C<flagsrequired> hash take on an additional
 574 meaning, i.e.,
 575
 576  1
 577
 578 The user must have access to all subfunctions of the module
 579 specified by the hash key.
 580
 581  *
 582
 583 The user must have access to at least one subfunction of the module
 584 specified by the hash key.
 585
 586  specific permission, e.g., 'export_catalog'
 587
 588 The user must have access to the specific subfunction list, which
 589 must correspond to a row in the permissions table.
 590
 591 The C<$type> argument specifies whether the template should be
 592 retrieved from the opac or intranet directory tree.  "opac" is
 593 assumed if it is not specified; however, if C<$type> is specified,
 594 "intranet" is assumed if it is not "opac".
 595
 596 If C<$query> does not have a valid session ID associated with it
 597 (i.e., the user has not logged in) or if the session has expired,
 598 C<&checkauth> presents the user with a login page (from the point of
 599 view of the original script, C<&checkauth> does not return). Once the
 600 user has authenticated, C<&checkauth> restarts the original script
 601 (this time, C<&checkauth> returns).
 602
 603 The login page is provided using a HTML::Template, which is set in the
 604 systempreferences table or at the top of this file. The variable C<$type>
 605 selects which template to use, either the opac or the intranet
 606 authentification template.
 607
 608 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 609 cookie should be sent back to the browser; it verifies that the user
 610 has authenticated.
 611
 612 =cut
 613
 614 sub _version_check {
 615     my $type = shift;
 616     my $query = shift;
 617     my $version;
 618     # If Version syspref is unavailable, it means Koha is beeing installed,
 619     # and so we must redirect to OPAC maintenance page or to the WebInstaller
 620     # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
 621     if (C4::Context->preference('OpacMaintenance') && $type eq 'opac') {
 622         warn "OPAC Install required, redirecting to maintenance";
 623         print $query->redirect("/cgi-bin/koha/maintenance.pl");
 624         safe_exit;
 625     }
 626     unless ( $version = C4::Context->preference('Version') ) {    # assignment, not comparison
 627         if ( $type ne 'opac' ) {
 628             warn "Install required, redirecting to Installer";
 629             print $query->redirect("/cgi-bin/koha/installer/install.pl");
 630         } else {
 631             warn "OPAC Install required, redirecting to maintenance";
 632             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 633         }
 634         safe_exit;
 635     }
 636
 637     # check that database and koha version are the same
 638     # there is no DB version, it's a fresh install,
 639     # go to web installer
 640     # there is a DB version, compare it to the code version
 641     my $kohaversion=C4::Context::KOHAVERSION;
 642     # remove the 3 last . to have a Perl number
 643     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 644     $debug and print STDERR "kohaversion : $kohaversion\n";
 645     if ($version < $kohaversion){
 646         my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
 647         if ($type ne 'opac'){
 648             warn sprintf($warning, 'Installer');
 649             print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
 650         } else {
 651             warn sprintf("OPAC: " . $warning, 'maintenance');
 652             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 653         }
 654         safe_exit;
 655     }
 656 }
 657
 658 sub _session_log {
 659     (@_) or return 0;
 660     open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
 661     printf $fh join("\n",@_);
 662     close $fh;
 663 }
 664
 665 sub _timeout_syspref {
 666     my $timeout = C4::Context->preference('timeout') || 600;
 667     # value in days, convert in seconds
 668     if ($timeout =~ /(\d+)[dD]/) {
 669         $timeout = $1 * 86400;
 670     };
 671     return $timeout;
 672 }
 673
 674 sub checkauth {
 675     my $query = shift;
 676     $debug and warn "Checking Auth";
 677     # $authnotrequired will be set for scripts which will run without authentication
 678     my $authnotrequired = shift;
 679     my $flagsrequired   = shift;
 680     my $type            = shift;
 681     my $persona         = shift;
 682     $type = 'opac' unless $type;
 683
 684     my $dbh     = C4::Context->dbh;
 685     my $timeout = _timeout_syspref();
 686
 687     _version_check($type,$query);
 688     # state variables
 689     my $loggedin = 0;
 690     my %info;
 691     my ( $userid, $cookie, $sessionID, $flags, $barshelves, $pubshelves );
 692     my $logout = $query->param('logout.x');
 693
 694     my $anon_search_history;
 695
 696     # This parameter is the name of the CAS server we want to authenticate against,
 697     # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
 698     my $casparam = $query->param('cas');
 699     my $q_userid = $query->param('userid') // '';
 700
 701     # Basic authentication is incompatible with the use of Shibboleth,
 702     # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
 703     # and it may not be the attribute we want to use to match the koha login.
 704     #
 705     # Also, do not consider an empty REMOTE_USER.
 706     #
 707     # Finally, after those tests, we can assume (although if it would be better with
 708     # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
 709     # and we can affect it to $userid.
 710     if ( !$shib and defined($ENV{'REMOTE_USER'}) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
 711
 712         # Using Basic Authentication, no cookies required
 713         $cookie = $query->cookie(
 714             -name     => 'CGISESSID',
 715             -value    => '',
 716             -expires  => '',
 717             -HttpOnly => 1,
 718         );
 719         $loggedin = 1;
 720     }
 721     elsif ( $persona ){
 722       # we dont want to set a session because we are being called by a persona callback
 723     }
 724     elsif ( $sessionID = $query->cookie("CGISESSID") )
 725     {    # assignment, not comparison
 726         my $session = get_session($sessionID);
 727         C4::Context->_new_userenv($sessionID);
 728         my ($ip, $lasttime, $sessiontype);
 729         my $s_userid = '';
 730         if ($session){
 731             $s_userid = $session->param('id') // '';
 732             C4::Context::set_userenv(
 733                 $session->param('number'),       $s_userid,
 734                 $session->param('cardnumber'),   $session->param('firstname'),
 735                 $session->param('surname'),      $session->param('branch'),
 736                 $session->param('branchname'),   $session->param('flags'),
 737                 $session->param('emailaddress'), $session->param('branchprinter'),
 738                 $session->param('persona'),      $session->param('shibboleth')
 739             );
 740             C4::Context::set_shelves_userenv('bar',$session->param('barshelves'));
 741             C4::Context::set_shelves_userenv('pub',$session->param('pubshelves'));
 742             C4::Context::set_shelves_userenv('tot',$session->param('totshelves'));
 743             $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 744             $ip       = $session->param('ip');
 745             $lasttime = $session->param('lasttime');
 746             $userid   = $s_userid;
 747             $sessiontype = $session->param('sessiontype') || '';
 748         }
 749         if ( ( $query->param('koha_login_context') && ($q_userid ne $s_userid) )
 750           || ( $cas && $query->param('ticket') ) || ( $shib && $shib_login && !$logout ) ) {
 751             #if a user enters an id ne to the id in the current session, we need to log them in...
 752             #first we need to clear the anonymous session...
 753             $debug and warn "query id = $q_userid but session id = $s_userid";
 754             $anon_search_history = $session->param('search_history');
 755             $session->delete();
 756             $session->flush;
 757             C4::Context->_unset_userenv($sessionID);
 758             $sessionID = undef;
 759             $userid = undef;
 760         }
 761         elsif ($logout) {
 762             # voluntary logout the user
 763         # check wether the user was using their shibboleth session or a local one
 764             my $shibSuccess = C4::Context->userenv->{'shibboleth'};
 765             $session->delete();
 766             $session->flush;
 767             C4::Context->_unset_userenv($sessionID);
 768             #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
 769             $sessionID = undef;
 770             $userid    = undef;
 771
 772             if ($cas and $caslogout) {
 773                 logout_cas($query);
 774             }
 775
 776             # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
 777             if ( $shib and $shib_login and $shibSuccess and $type eq 'opac') {
 778             # (Note: $type eq 'opac' condition should be removed when shibboleth authentication for intranet will be implemented)
 779                 logout_shib($query);
 780             }
 781         }
 782         elsif ( !$lasttime || ($lasttime < time() - $timeout) ) {
 783             # timed logout
 784             $info{'timed_out'} = 1;
 785             if ($session) {
 786                 $session->delete();
 787                 $session->flush;
 788             }
 789             C4::Context->_unset_userenv($sessionID);
 790             #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
 791             $userid    = undef;
 792             $sessionID = undef;
 793         }
 794         elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 795             # Different ip than originally logged in from
 796             $info{'oldip'}        = $ip;
 797             $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 798             $info{'different_ip'} = 1;
 799             $session->delete();
 800             $session->flush;
 801             C4::Context->_unset_userenv($sessionID);
 802             #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
 803             $sessionID = undef;
 804             $userid    = undef;
 805         }
 806         else {
 807             $cookie = $query->cookie(
 808                 -name     => 'CGISESSID',
 809                 -value    => $session->id,
 810                 -HttpOnly => 1
 811             );
 812             $session->param( 'lasttime', time() );
 813             unless ( $sessiontype && $sessiontype eq 'anon' ) { #if this is an anonymous session, we want to update the session, but not behave as if they are logged in...
 814                 $flags = haspermission($userid, $flagsrequired);
 815                 if ($flags) {
 816                     $loggedin = 1;
 817                 } else {
 818                     $info{'nopermission'} = 1;
 819                 }
 820             }
 821         }
 822     }
 823     unless ($userid || $sessionID) {
 824
 825         #we initiate a session prior to checking for a username to allow for anonymous sessions...
 826         my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
 827
 828         # Save anonymous search history in new session so it can be retrieved
 829         # by get_template_and_user to store it in user's search history after
 830         # a successful login.
 831         if ($anon_search_history) {
 832             $session->param('search_history', $anon_search_history);
 833         }
 834
 835         my $sessionID = $session->id;
 836         C4::Context->_new_userenv($sessionID);
 837         $cookie = $query->cookie(
 838             -name     => 'CGISESSID',
 839             -value    => $session->id,
 840             -HttpOnly => 1
 841         );
 842         $userid = $q_userid;
 843         my $pki_field = C4::Context->preference('AllowPKIAuth');
 844         if (! defined($pki_field) ) {
 845             print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
 846             $pki_field = 'None';
 847         }
 848         if (   ( $cas && $query->param('ticket') )
 849             || $userid
 850             || ( $shib && $shib_login )
 851             || $pki_field ne 'None'
 852             || $persona )
 853         {
 854             my $password = $query->param('password');
 855         my $shibSuccess = 0;
 856
 857             my ( $return, $cardnumber );
 858         # If shib is enabled and we have a shib login, does the login match a valid koha user
 859             if ( $shib && $shib_login && $type eq 'opac' ) {
 860                 my $retuserid;
 861         # Do not pass password here, else shib will not be checked in checkpw.
 862                 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $userid, undef, $query );
 863                 $userid = $retuserid;
 864         $shibSuccess = $return;
 865                 $info{'invalidShibLogin'} = 1 unless ($return);
 866             }
 867         # If shib login and match were successfull, skip further login methods
 868         unless ( $shibSuccess ) {
 869         if ( $cas && $query->param('ticket') ) {
 870                 my $retuserid;
 871                 ( $return, $cardnumber, $retuserid ) =
 872                   checkpw( $dbh, $userid, $password, $query );
 873                 $userid = $retuserid;
 874                 $info{'invalidCasLogin'} = 1 unless ($return);
 875             }
 876
 877     elsif ($persona) {
 878         my $value = $persona;
 879
 880         # If we're looking up the email, there's a chance that the person
 881         # doesn't have a userid. So if there is none, we pass along the
 882         # borrower number, and the bits of code that need to know the user
 883         # ID will have to be smart enough to handle that.
 884         require C4::Members;
 885         my @users_info = C4::Members::GetBorrowersWithEmail($value);
 886         if (@users_info) {
 887
 888             # First the userid, then the borrowernum
 889             $value = $users_info[0][1] || $users_info[0][0];
 890         }
 891         else {
 892             undef $value;
 893         }
 894         $return = $value ? 1 : 0;
 895         $userid = $value;
 896     }
 897
 898     elsif (
 899                 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
 900                 || (   $pki_field eq 'emailAddress'
 901                     && $ENV{'SSL_CLIENT_S_DN_Email'} )
 902               )
 903             {
 904                 my $value;
 905                 if ( $pki_field eq 'Common Name' ) {
 906                     $value = $ENV{'SSL_CLIENT_S_DN_CN'};
 907                 }
 908                 elsif ( $pki_field eq 'emailAddress' ) {
 909                     $value = $ENV{'SSL_CLIENT_S_DN_Email'};
 910
 911               # If we're looking up the email, there's a chance that the person
 912               # doesn't have a userid. So if there is none, we pass along the
 913               # borrower number, and the bits of code that need to know the user
 914               # ID will have to be smart enough to handle that.
 915                     require C4::Members;
 916                     my @users_info = C4::Members::GetBorrowersWithEmail($value);
 917                     if (@users_info) {
 918
 919                         # First the userid, then the borrowernum
 920                         $value = $users_info[0][1] || $users_info[0][0];
 921                     } else {
 922                         undef $value;
 923                     }
 924                 }
 925
 926
 927                 $return = $value ? 1 : 0;
 928                 $userid = $value;
 929
 930     }
 931             else {
 932                 my $retuserid;
 933                 ( $return, $cardnumber, $retuserid ) =
 934                   checkpw( $dbh, $userid, $password, $query );
 935                 $userid = $retuserid if ( $retuserid );
 936         $info{'invalid_username_or_password'} = 1 unless ($return);
 937         } }
 938         if ($return) {
 939                #_session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
 940                 if ( $flags = haspermission(  $userid, $flagsrequired ) ) {
 941                     $loggedin = 1;
 942                 }
 943                    else {
 944                     $info{'nopermission'} = 1;
 945                     C4::Context->_unset_userenv($sessionID);
 946                 }
 947                 my ($borrowernumber, $firstname, $surname, $userflags,
 948                     $branchcode, $branchname, $branchprinter, $emailaddress);
 949
 950                 if ( $return == 1 ) {
 951                     my $select = "
 952                     SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
 953                     branches.branchname    as branchname,
 954                     branches.branchprinter as branchprinter,
 955                     email
 956                     FROM borrowers
 957                     LEFT JOIN branches on borrowers.branchcode=branches.branchcode
 958                     ";
 959                     my $sth = $dbh->prepare("$select where userid=?");
 960                     $sth->execute($userid);
 961                     unless ($sth->rows) {
 962                         $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
 963                         $sth = $dbh->prepare("$select where cardnumber=?");
 964                         $sth->execute($cardnumber);
 965
 966                         unless ($sth->rows) {
 967                             $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
 968                             $sth->execute($userid);
 969                             unless ($sth->rows) {
 970                                 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
 971                             }
 972                         }
 973                     }
 974                     if ($sth->rows) {
 975                         ($borrowernumber, $firstname, $surname, $userflags,
 976                             $branchcode, $branchname, $branchprinter, $emailaddress) = $sth->fetchrow;
 977                         $debug and print STDERR "AUTH_3 results: " .
 978                         "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
 979                     } else {
 980                         print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
 981                     }
 982
 983 # launch a sequence to check if we have a ip for the branch, i
 984 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
 985
 986                     my $ip       = $ENV{'REMOTE_ADDR'};
 987                     # if they specify at login, use that
 988                     if ($query->param('branch')) {
 989                         $branchcode  = $query->param('branch');
 990                         $branchname = GetBranchName($branchcode);
 991                     }
 992                     my $branches = GetBranches();
 993                     if (C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation')){
 994                         # we have to check they are coming from the right ip range
 995                         my $domain = $branches->{$branchcode}->{'branchip'};
 996                         if ($ip !~ /^$domain/){
 997                             $loggedin=0;
 998                             $info{'wrongip'} = 1;
 999                         }
1000                     }
1001
1002                     my @branchesloop;
1003                     foreach my $br ( keys %$branches ) {
1004                         #     now we work with the treatment of ip
1005                         my $domain = $branches->{$br}->{'branchip'};
1006                         if ( $domain && $ip =~ /^$domain/ ) {
1007                             $branchcode = $branches->{$br}->{'branchcode'};
1008
1009                             # new op dev : add the branchprinter and branchname in the cookie
1010                             $branchprinter = $branches->{$br}->{'branchprinter'};
1011                             $branchname    = $branches->{$br}->{'branchname'};
1012                         }
1013                     }
1014                     $session->param('number',$borrowernumber);
1015                     $session->param('id',$userid);
1016                     $session->param('cardnumber',$cardnumber);
1017                     $session->param('firstname',$firstname);
1018                     $session->param('surname',$surname);
1019                     $session->param('branch',$branchcode);
1020                     $session->param('branchname',$branchname);
1021                     $session->param('flags',$userflags);
1022                     $session->param('emailaddress',$emailaddress);
1023                     $session->param('ip',$session->remote_addr());
1024                     $session->param('lasttime',time());
1025             $session->param('shibboleth',$shibSuccess);
1026                     $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
1027                 }
1028                 elsif ( $return == 2 ) {
1029                     #We suppose the user is the superlibrarian
1030                     $borrowernumber = 0;
1031                     $session->param('number',0);
1032                     $session->param('id',C4::Context->config('user'));
1033                     $session->param('cardnumber',C4::Context->config('user'));
1034                     $session->param('firstname',C4::Context->config('user'));
1035                     $session->param('surname',C4::Context->config('user'));
1036                     $session->param('branch','NO_LIBRARY_SET');
1037                     $session->param('branchname','NO_LIBRARY_SET');
1038                     $session->param('flags',1);
1039                     $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
1040                     $session->param('ip',$session->remote_addr());
1041                     $session->param('lasttime',time());
1042                 }
1043                 if ($persona){
1044                     $session->param('persona',1);
1045                 }
1046                 C4::Context::set_userenv(
1047                     $session->param('number'),       $session->param('id'),
1048                     $session->param('cardnumber'),   $session->param('firstname'),
1049                     $session->param('surname'),      $session->param('branch'),
1050                     $session->param('branchname'),   $session->param('flags'),
1051                     $session->param('emailaddress'), $session->param('branchprinter'),
1052                     $session->param('persona'),      $session->param('shibboleth')
1053                 );
1054
1055             }
1056             else {
1057                 if ($userid) {
1058                     $info{'invalid_username_or_password'} = 1;
1059                     C4::Context->_unset_userenv($sessionID);
1060                 }
1061                 $session->param('lasttime',time());
1062                 $session->param('ip',$session->remote_addr());
1063             }
1064         }    # END if ( $userid    = $query->param('userid') )
1065         elsif ($type eq "opac") {
1066             # if we are here this is an anonymous session; add public lists to it and a few other items...
1067             # anonymous sessions are created only for the OPAC
1068             $debug and warn "Initiating an anonymous session...";
1069
1070             # setting a couple of other session vars...
1071             $session->param('ip',$session->remote_addr());
1072             $session->param('lasttime',time());
1073             $session->param('sessiontype','anon');
1074         }
1075     }    # END unless ($userid)
1076
1077     # finished authentification, now respond
1078     if ( $loggedin || $authnotrequired )
1079     {
1080         # successful login
1081         unless ($cookie) {
1082             $cookie = $query->cookie(
1083                 -name     => 'CGISESSID',
1084                 -value    => '',
1085                 -HttpOnly => 1
1086             );
1087         }
1088         return ( $userid, $cookie, $sessionID, $flags );
1089     }
1090
1091 #
1092 #
1093 # AUTH rejected, show the login/password template, after checking the DB.
1094 #
1095 #
1096
1097     # get the inputs from the incoming query
1098     my @inputs = ();
1099     foreach my $name ( param $query) {
1100         (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1101         my $value = $query->param($name);
1102         push @inputs, { name => $name, value => $value };
1103     }
1104
1105     my $LibraryNameTitle = C4::Context->preference("LibraryName");
1106     $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1107     $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1108
1109     my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1110     my $template = C4::Templates::gettemplate($template_name, $type, $query );
1111     $template->param(
1112         branchloop           => GetBranchesLoop(),
1113         opaccolorstylesheet  => C4::Context->preference("opaccolorstylesheet"),
1114         opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
1115         login                => 1,
1116         INPUTS               => \@inputs,
1117         casAuthentication    => C4::Context->preference("casAuthentication"),
1118         shibbolethAuthentication => $shib,
1119         suggestion           => C4::Context->preference("suggestion"),
1120         virtualshelves       => C4::Context->preference("virtualshelves"),
1121         LibraryName          => "" . C4::Context->preference("LibraryName"),
1122         LibraryNameTitle     => "" . $LibraryNameTitle,
1123         opacuserlogin        => C4::Context->preference("opacuserlogin"),
1124         OpacNav              => C4::Context->preference("OpacNav"),
1125         OpacNavRight         => C4::Context->preference("OpacNavRight"),
1126         OpacNavBottom        => C4::Context->preference("OpacNavBottom"),
1127         opaccredits          => C4::Context->preference("opaccredits"),
1128         OpacFavicon          => C4::Context->preference("OpacFavicon"),
1129         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
1130         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1131         opacuserjs           => C4::Context->preference("opacuserjs"),
1132         opacbookbag          => "" . C4::Context->preference("opacbookbag"),
1133         OpacCloud            => C4::Context->preference("OpacCloud"),
1134         OpacTopissue         => C4::Context->preference("OpacTopissue"),
1135         OpacAuthorities      => C4::Context->preference("OpacAuthorities"),
1136         OpacBrowser          => C4::Context->preference("OpacBrowser"),
1137         opacheader           => C4::Context->preference("opacheader"),
1138         TagsEnabled          => C4::Context->preference("TagsEnabled"),
1139         OPACUserCSS           => C4::Context->preference("OPACUserCSS"),
1140         intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1141         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1142         intranetbookbag    => C4::Context->preference("intranetbookbag"),
1143         IntranetNav        => C4::Context->preference("IntranetNav"),
1144         IntranetFavicon    => C4::Context->preference("IntranetFavicon"),
1145         intranetuserjs     => C4::Context->preference("intranetuserjs"),
1146         IndependentBranches=> C4::Context->preference("IndependentBranches"),
1147         AutoLocation       => C4::Context->preference("AutoLocation"),
1148         wrongip            => $info{'wrongip'},
1149         PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1150         PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1151         persona            => C4::Context->preference("Persona"),
1152         opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1153     );
1154
1155     $template->param( OpacPublic => C4::Context->preference("OpacPublic"));
1156     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1157
1158     if($type eq 'opac'){
1159         my ($total, $pubshelves) = C4::VirtualShelves::GetSomeShelfNames(undef, 'MASTHEAD');
1160         $template->param(
1161             pubshelves     => $total->{pubtotal},
1162             pubshelvesloop => $pubshelves,
1163         );
1164     }
1165
1166     if ($cas) {
1167
1168     # Is authentication against multiple CAS servers enabled?
1169         if (C4::Auth_with_cas::multipleAuth && !$casparam) {
1170         my $casservers = C4::Auth_with_cas::getMultipleAuth();
1171         my @tmplservers;
1172         foreach my $key (keys %$casservers) {
1173         push @tmplservers, {name => $key, value => login_cas_url($query, $key) . "?cas=$key" };
1174         }
1175         $template->param(
1176         casServersLoop => \@tmplservers
1177         );
1178     } else {
1179         $template->param(
1180             casServerUrl    => login_cas_url($query),
1181         );
1182     }
1183
1184     $template->param(
1185             invalidCasLogin => $info{'invalidCasLogin'}
1186         );
1187     }
1188
1189     if ($shib) {
1190             $template->param(
1191                 shibbolethAuthentication => $shib,
1192                 shibbolethLoginUrl    => login_shib_url($query),
1193             );
1194     }
1195
1196     my $self_url = $query->url( -absolute => 1 );
1197     $template->param(
1198         url         => $self_url,
1199         LibraryName => C4::Context->preference("LibraryName"),
1200     );
1201     $template->param( %info );
1202 #    $cookie = $query->cookie(CGISESSID => $session->id
1203 #   );
1204     print $query->header(
1205         -type   => 'text/html',
1206         -charset => 'utf-8',
1207         -cookie => $cookie
1208       ),
1209       $template->output;
1210     safe_exit;
1211 }
1212
1213 =head2 check_api_auth
1214
1215   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1216
1217 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1218 cookie, determine if the user has the privileges specified by C<$userflags>.
1219
1220 C<check_api_auth> is is meant for authenticating users of web services, and
1221 consequently will always return and will not attempt to redirect the user
1222 agent.
1223
1224 If a valid session cookie is already present, check_api_auth will return a status
1225 of "ok", the cookie, and the Koha session ID.
1226
1227 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1228 parameters and create a session cookie and Koha session if the supplied credentials
1229 are OK.
1230
1231 Possible return values in C<$status> are:
1232
1233 =over
1234
1235 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1236
1237 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1238
1239 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1240
1241 =item "expired -- session cookie has expired; API user should resubmit userid and password
1242
1243 =back
1244
1245 =cut
1246
1247 sub check_api_auth {
1248     my $query = shift;
1249     my $flagsrequired = shift;
1250
1251     my $dbh     = C4::Context->dbh;
1252     my $timeout = _timeout_syspref();
1253
1254     unless (C4::Context->preference('Version')) {
1255         # database has not been installed yet
1256         return ("maintenance", undef, undef);
1257     }
1258     my $kohaversion=C4::Context::KOHAVERSION;
1259     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1260     if (C4::Context->preference('Version') < $kohaversion) {
1261         # database in need of version update; assume that
1262         # no API should be called while databsae is in
1263         # this condition.
1264         return ("maintenance", undef, undef);
1265     }
1266
1267     # FIXME -- most of what follows is a copy-and-paste
1268     # of code from checkauth.  There is an obvious need
1269     # for refactoring to separate the various parts of
1270     # the authentication code, but as of 2007-11-19 this
1271     # is deferred so as to not introduce bugs into the
1272     # regular authentication code for Koha 3.0.
1273
1274     # see if we have a valid session cookie already
1275     # however, if a userid parameter is present (i.e., from
1276     # a form submission, assume that any current cookie
1277     # is to be ignored
1278     my $sessionID = undef;
1279     unless ($query->param('userid')) {
1280         $sessionID = $query->cookie("CGISESSID");
1281     }
1282     if ($sessionID && not ($cas && $query->param('PT')) ) {
1283         my $session = get_session($sessionID);
1284         C4::Context->_new_userenv($sessionID);
1285         if ($session) {
1286             C4::Context::set_userenv(
1287                 $session->param('number'),       $session->param('id'),
1288                 $session->param('cardnumber'),   $session->param('firstname'),
1289                 $session->param('surname'),      $session->param('branch'),
1290                 $session->param('branchname'),   $session->param('flags'),
1291                 $session->param('emailaddress'), $session->param('branchprinter')
1292             );
1293
1294             my $ip = $session->param('ip');
1295             my $lasttime = $session->param('lasttime');
1296             my $userid = $session->param('id');
1297             if ( $lasttime < time() - $timeout ) {
1298                 # time out
1299                 $session->delete();
1300                 $session->flush;
1301                 C4::Context->_unset_userenv($sessionID);
1302                 $userid    = undef;
1303                 $sessionID = undef;
1304                 return ("expired", undef, undef);
1305             } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1306                 # IP address changed
1307                 $session->delete();
1308                 $session->flush;
1309                 C4::Context->_unset_userenv($sessionID);
1310                 $userid    = undef;
1311                 $sessionID = undef;
1312                 return ("expired", undef, undef);
1313             } else {
1314                 my $cookie = $query->cookie(
1315                     -name  => 'CGISESSID',
1316                     -value => $session->id,
1317                     -HttpOnly => 1,
1318                 );
1319                 $session->param('lasttime',time());
1320                 my $flags = haspermission($userid, $flagsrequired);
1321                 if ($flags) {
1322                     return ("ok", $cookie, $sessionID);
1323                 } else {
1324                     $session->delete();
1325                     $session->flush;
1326                     C4::Context->_unset_userenv($sessionID);
1327                     $userid    = undef;
1328                     $sessionID = undef;
1329                     return ("failed", undef, undef);
1330                 }
1331             }
1332         } else {
1333             return ("expired", undef, undef);
1334         }
1335     } else {
1336         # new login
1337         my $userid = $query->param('userid');
1338         my $password = $query->param('password');
1339            my ($return, $cardnumber);
1340
1341     # Proxy CAS auth
1342     if ($cas && $query->param('PT')) {
1343         my $retuserid;
1344         $debug and print STDERR "## check_api_auth - checking CAS\n";
1345         # In case of a CAS authentication, we use the ticket instead of the password
1346         my $PT = $query->param('PT');
1347         ($return,$cardnumber,$userid) = check_api_auth_cas($dbh, $PT, $query);    # EXTERNAL AUTH
1348     } else {
1349         # User / password auth
1350         unless ($userid and $password) {
1351         # caller did something wrong, fail the authenticateion
1352         return ("failed", undef, undef);
1353         }
1354         ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password, $query );
1355     }
1356
1357         if ($return and haspermission(  $userid, $flagsrequired)) {
1358             my $session = get_session("");
1359             return ("failed", undef, undef) unless $session;
1360
1361             my $sessionID = $session->id;
1362             C4::Context->_new_userenv($sessionID);
1363             my $cookie = $query->cookie(
1364                 -name  => 'CGISESSID',
1365                 -value => $sessionID,
1366                 -HttpOnly => 1,
1367             );
1368             if ( $return == 1 ) {
1369                 my (
1370                     $borrowernumber, $firstname,  $surname,
1371                     $userflags,      $branchcode, $branchname,
1372                     $branchprinter,  $emailaddress
1373                 );
1374                 my $sth =
1375                   $dbh->prepare(
1376 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname,branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1377                   );
1378                 $sth->execute($userid);
1379                 (
1380                     $borrowernumber, $firstname,  $surname,
1381                     $userflags,      $branchcode, $branchname,
1382                     $branchprinter,  $emailaddress
1383                 ) = $sth->fetchrow if ( $sth->rows );
1384
1385                 unless ($sth->rows ) {
1386                     my $sth = $dbh->prepare(
1387 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1388                       );
1389                     $sth->execute($cardnumber);
1390                     (
1391                         $borrowernumber, $firstname,  $surname,
1392                         $userflags,      $branchcode, $branchname,
1393                         $branchprinter,  $emailaddress
1394                     ) = $sth->fetchrow if ( $sth->rows );
1395
1396                     unless ( $sth->rows ) {
1397                         $sth->execute($userid);
1398                         (
1399                             $borrowernumber, $firstname, $surname, $userflags,
1400                             $branchcode, $branchname, $branchprinter, $emailaddress
1401                         ) = $sth->fetchrow if ( $sth->rows );
1402                     }
1403                 }
1404
1405                 my $ip       = $ENV{'REMOTE_ADDR'};
1406                 # if they specify at login, use that
1407                 if ($query->param('branch')) {
1408                     $branchcode  = $query->param('branch');
1409                     $branchname = GetBranchName($branchcode);
1410                 }
1411                 my $branches = GetBranches();
1412                 my @branchesloop;
1413                 foreach my $br ( keys %$branches ) {
1414                     #     now we work with the treatment of ip
1415                     my $domain = $branches->{$br}->{'branchip'};
1416                     if ( $domain && $ip =~ /^$domain/ ) {
1417                         $branchcode = $branches->{$br}->{'branchcode'};
1418
1419                         # new op dev : add the branchprinter and branchname in the cookie
1420                         $branchprinter = $branches->{$br}->{'branchprinter'};
1421                         $branchname    = $branches->{$br}->{'branchname'};
1422                     }
1423                 }
1424                 $session->param('number',$borrowernumber);
1425                 $session->param('id',$userid);
1426                 $session->param('cardnumber',$cardnumber);
1427                 $session->param('firstname',$firstname);
1428                 $session->param('surname',$surname);
1429                 $session->param('branch',$branchcode);
1430                 $session->param('branchname',$branchname);
1431                 $session->param('flags',$userflags);
1432                 $session->param('emailaddress',$emailaddress);
1433                 $session->param('ip',$session->remote_addr());
1434                 $session->param('lasttime',time());
1435             } elsif ( $return == 2 ) {
1436                 #We suppose the user is the superlibrarian
1437                 $session->param('number',0);
1438                 $session->param('id',C4::Context->config('user'));
1439                 $session->param('cardnumber',C4::Context->config('user'));
1440                 $session->param('firstname',C4::Context->config('user'));
1441                 $session->param('surname',C4::Context->config('user'));
1442                 $session->param('branch','NO_LIBRARY_SET');
1443                 $session->param('branchname','NO_LIBRARY_SET');
1444                 $session->param('flags',1);
1445                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
1446                 $session->param('ip',$session->remote_addr());
1447                 $session->param('lasttime',time());
1448             }
1449             C4::Context::set_userenv(
1450                 $session->param('number'),       $session->param('id'),
1451                 $session->param('cardnumber'),   $session->param('firstname'),
1452                 $session->param('surname'),      $session->param('branch'),
1453                 $session->param('branchname'),   $session->param('flags'),
1454                 $session->param('emailaddress'), $session->param('branchprinter')
1455             );
1456             return ("ok", $cookie, $sessionID);
1457         } else {
1458             return ("failed", undef, undef);
1459         }
1460     }
1461 }
1462
1463 =head2 check_cookie_auth
1464
1465   ($status, $sessionId) = check_api_auth($cookie, $userflags);
1466
1467 Given a CGISESSID cookie set during a previous login to Koha, determine
1468 if the user has the privileges specified by C<$userflags>.
1469
1470 C<check_cookie_auth> is meant for authenticating special services
1471 such as tools/upload-file.pl that are invoked by other pages that
1472 have been authenticated in the usual way.
1473
1474 Possible return values in C<$status> are:
1475
1476 =over
1477
1478 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1479
1480 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1481
1482 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1483
1484 =item "expired -- session cookie has expired; API user should resubmit userid and password
1485
1486 =back
1487
1488 =cut
1489
1490 sub check_cookie_auth {
1491     my $cookie = shift;
1492     my $flagsrequired = shift;
1493
1494     my $dbh     = C4::Context->dbh;
1495     my $timeout = _timeout_syspref();
1496
1497     unless (C4::Context->preference('Version')) {
1498         # database has not been installed yet
1499         return ("maintenance", undef);
1500     }
1501     my $kohaversion=C4::Context::KOHAVERSION;
1502     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1503     if (C4::Context->preference('Version') < $kohaversion) {
1504         # database in need of version update; assume that
1505         # no API should be called while databsae is in
1506         # this condition.
1507         return ("maintenance", undef);
1508     }
1509
1510     # FIXME -- most of what follows is a copy-and-paste
1511     # of code from checkauth.  There is an obvious need
1512     # for refactoring to separate the various parts of
1513     # the authentication code, but as of 2007-11-23 this
1514     # is deferred so as to not introduce bugs into the
1515     # regular authentication code for Koha 3.0.
1516
1517     # see if we have a valid session cookie already
1518     # however, if a userid parameter is present (i.e., from
1519     # a form submission, assume that any current cookie
1520     # is to be ignored
1521     unless (defined $cookie and $cookie) {
1522         return ("failed", undef);
1523     }
1524     my $sessionID = $cookie;
1525     my $session = get_session($sessionID);
1526     C4::Context->_new_userenv($sessionID);
1527     if ($session) {
1528         C4::Context::set_userenv(
1529             $session->param('number'),       $session->param('id'),
1530             $session->param('cardnumber'),   $session->param('firstname'),
1531             $session->param('surname'),      $session->param('branch'),
1532             $session->param('branchname'),   $session->param('flags'),
1533             $session->param('emailaddress'), $session->param('branchprinter')
1534         );
1535
1536         my $ip = $session->param('ip');
1537         my $lasttime = $session->param('lasttime');
1538         my $userid = $session->param('id');
1539         if ( $lasttime < time() - $timeout ) {
1540             # time out
1541             $session->delete();
1542             $session->flush;
1543             C4::Context->_unset_userenv($sessionID);
1544             $userid    = undef;
1545             $sessionID = undef;
1546             return ("expired", undef);
1547         } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1548             # IP address changed
1549             $session->delete();
1550             $session->flush;
1551             C4::Context->_unset_userenv($sessionID);
1552             $userid    = undef;
1553             $sessionID = undef;
1554             return ("expired", undef);
1555         } else {
1556             $session->param('lasttime',time());
1557             my $flags = haspermission($userid, $flagsrequired);
1558             if ($flags) {
1559                 return ("ok", $sessionID);
1560             } else {
1561                 $session->delete();
1562                 $session->flush;
1563                 C4::Context->_unset_userenv($sessionID);
1564                 $userid    = undef;
1565                 $sessionID = undef;
1566                 return ("failed", undef);
1567             }
1568         }
1569     } else {
1570         return ("expired", undef);
1571     }
1572 }
1573
1574 =head2 get_session
1575
1576   use CGI::Session;
1577   my $session = get_session($sessionID);
1578
1579 Given a session ID, retrieve the CGI::Session object used to store
1580 the session's state.  The session object can be used to store
1581 data that needs to be accessed by different scripts during a
1582 user's session.
1583
1584 If the C<$sessionID> parameter is an empty string, a new session
1585 will be created.
1586
1587 =cut
1588
1589 sub get_session {
1590     my $sessionID = shift;
1591     my $storage_method = C4::Context->preference('SessionStorage');
1592     my $dbh = C4::Context->dbh;
1593     my $session;
1594     if ($storage_method eq 'mysql'){
1595         $session = new CGI::Session("driver:MySQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1596     }
1597     elsif ($storage_method eq 'Pg') {
1598         $session = new CGI::Session("driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1599     }
1600     elsif ($storage_method eq 'memcached' && C4::Context->ismemcached){
1601     $session = new CGI::Session("driver:memcached;serializer:yaml;id:md5", $sessionID, { Memcached => C4::Context->memcached } );
1602     }
1603     else {
1604         # catch all defaults to tmp should work on all systems
1605         $session = new CGI::Session("driver:File;serializer:yaml;id:md5", $sessionID, {Directory=>'/tmp'});
1606     }
1607     return $session;
1608 }
1609
1610 sub checkpw {
1611     my ( $dbh, $userid, $password, $query ) = @_;
1612     if ($ldap) {
1613         $debug and print STDERR "## checkpw - checking LDAP\n";
1614         my ($retval,$retcard,$retuserid) = checkpw_ldap(@_);    # EXTERNAL AUTH
1615         return 0 if $retval == -1; # Incorrect password for LDAP login attempt
1616         ($retval) and return ($retval,$retcard,$retuserid);
1617     }
1618
1619     if ($cas && $query && $query->param('ticket')) {
1620         $debug and print STDERR "## checkpw - checking CAS\n";
1621     # In case of a CAS authentication, we use the ticket instead of the password
1622         my $ticket = $query->param('ticket');
1623         $query->delete('ticket'); # remove ticket to come back to original URL
1624         my ($retval,$retcard,$retuserid) = checkpw_cas($dbh, $ticket, $query);    # EXTERNAL AUTH
1625         ($retval) and return ($retval,$retcard,$retuserid);
1626         return 0;
1627     }
1628
1629     # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1630     # Check for password to asertain whether we want to be testing against shibboleth or another method this
1631     # time around.
1632     if ($shib && $shib_login && !$password) {
1633
1634         $debug and print STDERR "## checkpw - checking Shibboleth\n";
1635         # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1636         # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1637         # shibboleth-authenticated user
1638
1639         # Then, we check if it matches a valid koha user
1640         if ($shib_login) {
1641             my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib( $shib_login );    # EXTERNAL AUTH
1642             ($retval) and return ( $retval, $retcard, $retuserid );
1643             return 0;
1644         }
1645     }
1646
1647     # INTERNAL AUTH
1648     return checkpw_internal(@_)
1649 }
1650
1651 sub checkpw_internal {
1652     my ( $dbh, $userid, $password ) = @_;
1653
1654     if ( $userid && $userid eq C4::Context->config('user') ) {
1655         if ( $password && $password eq C4::Context->config('pass') ) {
1656         # Koha superuser account
1657 #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1658             return 2;
1659         }
1660         else {
1661             return 0;
1662         }
1663     }
1664
1665     my $sth =
1666       $dbh->prepare(
1667 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1668       );
1669     $sth->execute($userid);
1670     if ( $sth->rows ) {
1671         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1672             $surname, $branchcode, $flags )
1673           = $sth->fetchrow;
1674
1675         if ( checkpw_hash($password, $stored_hash) ) {
1676
1677             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1678                 $firstname, $surname, $branchcode, $flags );
1679             return 1, $cardnumber, $userid;
1680         }
1681     }
1682     $sth =
1683       $dbh->prepare(
1684 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1685       );
1686     $sth->execute($userid);
1687     if ( $sth->rows ) {
1688         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1689             $surname, $branchcode, $flags )
1690           = $sth->fetchrow;
1691
1692         if ( checkpw_hash($password, $stored_hash) ) {
1693
1694             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1695                 $firstname, $surname, $branchcode, $flags );
1696             return 1, $cardnumber, $userid;
1697         }
1698     }
1699     if (   $userid && $userid eq 'demo'
1700         && "$password" eq 'demo'
1701         && C4::Context->config('demo') )
1702     {
1703
1704 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1705 # some features won't be effective : modify systempref, modify MARC structure,
1706         return 2;
1707     }
1708     return 0;
1709 }
1710
1711 sub checkpw_hash {
1712     my ( $password, $stored_hash ) = @_;
1713
1714     return if $stored_hash eq '!';
1715
1716     # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1717     my $hash;
1718     if ( substr($stored_hash,0,2) eq '$2') {
1719         $hash = hash_password($password, $stored_hash);
1720     } else {
1721         $hash = md5_base64($password);
1722     }
1723     return $hash eq $stored_hash;
1724 }
1725
1726 =head2 getuserflags
1727
1728     my $authflags = getuserflags($flags, $userid, [$dbh]);
1729
1730 Translates integer flags into permissions strings hash.
1731
1732 C<$flags> is the integer userflags value ( borrowers.userflags )
1733 C<$userid> is the members.userid, used for building subpermissions
1734 C<$authflags> is a hashref of permissions
1735
1736 =cut
1737
1738 sub getuserflags {
1739     my $flags   = shift;
1740     my $userid  = shift;
1741     my $dbh     = @_ ? shift : C4::Context->dbh;
1742     my $userflags;
1743     {
1744         # I don't want to do this, but if someone logs in as the database
1745         # user, it would be preferable not to spam them to death with
1746         # numeric warnings. So, we make $flags numeric.
1747         no warnings 'numeric';
1748         $flags += 0;
1749     }
1750     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1751     $sth->execute;
1752
1753     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1754         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1755             $userflags->{$flag} = 1;
1756         }
1757         else {
1758             $userflags->{$flag} = 0;
1759         }
1760     }
1761     # get subpermissions and merge with top-level permissions
1762     my $user_subperms = get_user_subpermissions($userid);
1763     foreach my $module (keys %$user_subperms) {
1764         next if $userflags->{$module} == 1; # user already has permission for everything in this module
1765         $userflags->{$module} = $user_subperms->{$module};
1766     }
1767
1768     return $userflags;
1769 }
1770
1771 =head2 get_user_subpermissions
1772
1773   $user_perm_hashref = get_user_subpermissions($userid);
1774
1775 Given the userid (note, not the borrowernumber) of a staff user,
1776 return a hashref of hashrefs of the specific subpermissions
1777 accorded to the user.  An example return is
1778
1779  {
1780     tools => {
1781         export_catalog => 1,
1782         import_patrons => 1,
1783     }
1784  }
1785
1786 The top-level hash-key is a module or function code from
1787 userflags.flag, while the second-level key is a code
1788 from permissions.
1789
1790 The results of this function do not give a complete picture
1791 of the functions that a staff user can access; it is also
1792 necessary to check borrowers.flags.
1793
1794 =cut
1795
1796 sub get_user_subpermissions {
1797     my $userid = shift;
1798
1799     my $dbh = C4::Context->dbh;
1800     my $sth = $dbh->prepare("SELECT flag, user_permissions.code
1801                              FROM user_permissions
1802                              JOIN permissions USING (module_bit, code)
1803                              JOIN userflags ON (module_bit = bit)
1804                              JOIN borrowers USING (borrowernumber)
1805                              WHERE userid = ?");
1806     $sth->execute($userid);
1807
1808     my $user_perms = {};
1809     while (my $perm = $sth->fetchrow_hashref) {
1810         $user_perms->{$perm->{'flag'}}->{$perm->{'code'}} = 1;
1811     }
1812     return $user_perms;
1813 }
1814
1815 =head2 get_all_subpermissions
1816
1817   my $perm_hashref = get_all_subpermissions();
1818
1819 Returns a hashref of hashrefs defining all specific
1820 permissions currently defined.  The return value
1821 has the same structure as that of C<get_user_subpermissions>,
1822 except that the innermost hash value is the description
1823 of the subpermission.
1824
1825 =cut
1826
1827 sub get_all_subpermissions {
1828     my $dbh = C4::Context->dbh;
1829     my $sth = $dbh->prepare("SELECT flag, code, description
1830                              FROM permissions
1831                              JOIN userflags ON (module_bit = bit)");
1832     $sth->execute();
1833
1834     my $all_perms = {};
1835     while (my $perm = $sth->fetchrow_hashref) {
1836         $all_perms->{$perm->{'flag'}}->{$perm->{'code'}} = $perm->{'description'};
1837     }
1838     return $all_perms;
1839 }
1840
1841 =head2 haspermission
1842
1843   $flags = ($userid, $flagsrequired);
1844
1845 C<$userid> the userid of the member
1846 C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
1847
1848 Returns member's flags or 0 if a permission is not met.
1849
1850 =cut
1851
1852 sub haspermission {
1853     my ($userid, $flagsrequired) = @_;
1854     my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1855     $sth->execute($userid);
1856     my $row = $sth->fetchrow();
1857     my $flags = getuserflags($row, $userid);
1858     if ( $userid eq C4::Context->config('user') ) {
1859         # Super User Account from /etc/koha.conf
1860         $flags->{'superlibrarian'} = 1;
1861     }
1862     elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
1863         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1864         $flags->{'superlibrarian'} = 1;
1865     }
1866
1867     return $flags if $flags->{superlibrarian};
1868
1869     foreach my $module ( keys %$flagsrequired ) {
1870         my $subperm = $flagsrequired->{$module};
1871         if ($subperm eq '*') {
1872             return 0 unless ( $flags->{$module} == 1 or ref($flags->{$module}) );
1873         } else {
1874             return 0 unless ( $flags->{$module} == 1 or
1875                                 ( ref($flags->{$module}) and
1876                                   exists $flags->{$module}->{$subperm} and
1877                                   $flags->{$module}->{$subperm} == 1
1878                                 )
1879                             );
1880         }
1881     }
1882     return $flags;
1883     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1884 }
1885
1886
1887 sub getborrowernumber {
1888     my ($userid) = @_;
1889     my $userenv = C4::Context->userenv;
1890     if ( defined( $userenv ) && ref( $userenv ) eq 'HASH' && $userenv->{number} ) {
1891         return $userenv->{number};
1892     }
1893     my $dbh = C4::Context->dbh;
1894     for my $field ( 'userid', 'cardnumber' ) {
1895         my $sth =
1896           $dbh->prepare("select borrowernumber from borrowers where $field=?");
1897         $sth->execute($userid);
1898         if ( $sth->rows ) {
1899             my ($bnumber) = $sth->fetchrow;
1900             return $bnumber;
1901         }
1902     }
1903     return 0;
1904 }
1905
1906 END { }    # module clean-up code here (global destructor)
1907 1;
1908 __END__
1909
1910 =head1 SEE ALSO
1911
1912 CGI(3)
1913
1914 C4::Output(3)
1915
1916 Crypt::Eksblowfish::Bcrypt(3)
1917
1918 Digest::MD5(3)
1919
1920 =cut