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