C4/Auth.pm

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