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