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             OpacShowFiltersPulldownMobile => C4::Context->preference("OpacShowFiltersPulldownMobile"),
 443             OpacShowLibrariesPulldownMobile => C4::Context->preference("OpacShowLibrariesPulldownMobile"),
 444             OpacNav                   => "" . C4::Context->preference("OpacNav"),
 445             OpacNavRight              => "" . C4::Context->preference("OpacNavRight"),
 446             OpacNavBottom             => "" . C4::Context->preference("OpacNavBottom"),
 447             OpacPasswordChange        => C4::Context->preference("OpacPasswordChange"),
 448             OPACPatronDetails         => C4::Context->preference("OPACPatronDetails"),
 449             OPACPrivacy               => C4::Context->preference("OPACPrivacy"),
 450             OPACFinesTab              => C4::Context->preference("OPACFinesTab"),
 451             OpacTopissue              => C4::Context->preference("OpacTopissue"),
 452             RequestOnOpac             => C4::Context->preference("RequestOnOpac"),
 453             'Version'                 => C4::Context->preference('Version'),
 454             hidelostitems             => C4::Context->preference("hidelostitems"),
 455             mylibraryfirst            => (C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv) ? C4::Context->userenv->{'branch'} : '',
 456             opaclayoutstylesheet      => "" . C4::Context->preference("opaclayoutstylesheet"),
 457             opacbookbag               => "" . C4::Context->preference("opacbookbag"),
 458             opaccredits               => "" . C4::Context->preference("opaccredits"),
 459             OpacFavicon               => C4::Context->preference("OpacFavicon"),
 460             opacheader                => "" . C4::Context->preference("opacheader"),
 461             opaclanguagesdisplay      => "" . C4::Context->preference("opaclanguagesdisplay"),
 462             opacreadinghistory        => C4::Context->preference("opacreadinghistory"),
 463             opacuserjs                => C4::Context->preference("opacuserjs"),
 464             opacuserlogin             => "" . C4::Context->preference("opacuserlogin"),
 465             ShowReviewer              => C4::Context->preference("ShowReviewer"),
 466             ShowReviewerPhoto         => C4::Context->preference("ShowReviewerPhoto"),
 467             suggestion                => "" . C4::Context->preference("suggestion"),
 468             virtualshelves            => "" . C4::Context->preference("virtualshelves"),
 469             OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
 470             OPACXSLTDetailsDisplay           => C4::Context->preference("OPACXSLTDetailsDisplay"),
 471             OPACXSLTResultsDisplay           => C4::Context->preference("OPACXSLTResultsDisplay"),
 472             SyndeticsClientCode          => C4::Context->preference("SyndeticsClientCode"),
 473             SyndeticsEnabled             => C4::Context->preference("SyndeticsEnabled"),
 474             SyndeticsCoverImages         => C4::Context->preference("SyndeticsCoverImages"),
 475             SyndeticsTOC                 => C4::Context->preference("SyndeticsTOC"),
 476             SyndeticsSummary             => C4::Context->preference("SyndeticsSummary"),
 477             SyndeticsEditions            => C4::Context->preference("SyndeticsEditions"),
 478             SyndeticsExcerpt             => C4::Context->preference("SyndeticsExcerpt"),
 479             SyndeticsReviews             => C4::Context->preference("SyndeticsReviews"),
 480             SyndeticsAuthorNotes         => C4::Context->preference("SyndeticsAuthorNotes"),
 481             SyndeticsAwards              => C4::Context->preference("SyndeticsAwards"),
 482             SyndeticsSeries              => C4::Context->preference("SyndeticsSeries"),
 483             SyndeticsCoverImageSize      => C4::Context->preference("SyndeticsCoverImageSize"),
 484             OPACLocalCoverImages         => C4::Context->preference("OPACLocalCoverImages"),
 485             PatronSelfRegistration       => C4::Context->preference("PatronSelfRegistration"),
 486             PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
 487         );
 488
 489         $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic"));
 490     }
 491
 492     # Check if we were asked using parameters to force a specific language
 493     if ( defined $in->{'query'}->param('language') ) {
 494         # Extract the language, let C4::Languages::getlanguage choose
 495         # what to do
 496         my $language = C4::Languages::getlanguage($in->{'query'});
 497         my $languagecookie = C4::Templates::getlanguagecookie($in->{'query'},$language);
 498         if ( ref $cookie eq 'ARRAY' ) {
 499             push @{ $cookie }, $languagecookie;
 500         } else {
 501             $cookie = [$cookie, $languagecookie];
 502         }
 503     }
 504
 505     return ( $template, $borrowernumber, $cookie, $flags);
 506 }
 507
 508 =head2 checkauth
 509
 510   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 511
 512 Verifies that the user is authorized to run this script.  If
 513 the user is authorized, a (userid, cookie, session-id, flags)
 514 quadruple is returned.  If the user is not authorized but does
 515 not have the required privilege (see $flagsrequired below), it
 516 displays an error page and exits.  Otherwise, it displays the
 517 login page and exits.
 518
 519 Note that C<&checkauth> will return if and only if the user
 520 is authorized, so it should be called early on, before any
 521 unfinished operations (e.g., if you've opened a file, then
 522 C<&checkauth> won't close it for you).
 523
 524 C<$query> is the CGI object for the script calling C<&checkauth>.
 525
 526 The C<$noauth> argument is optional. If it is set, then no
 527 authorization is required for the script.
 528
 529 C<&checkauth> fetches user and session information from C<$query> and
 530 ensures that the user is authorized to run scripts that require
 531 authorization.
 532
 533 The C<$flagsrequired> argument specifies the required privileges
 534 the user must have if the username and password are correct.
 535 It should be specified as a reference-to-hash; keys in the hash
 536 should be the "flags" for the user, as specified in the Members
 537 intranet module. Any key specified must correspond to a "flag"
 538 in the userflags table. E.g., { circulate => 1 } would specify
 539 that the user must have the "circulate" privilege in order to
 540 proceed. To make sure that access control is correct, the
 541 C<$flagsrequired> parameter must be specified correctly.
 542
 543 Koha also has a concept of sub-permissions, also known as
 544 granular permissions.  This makes the value of each key
 545 in the C<flagsrequired> hash take on an additional
 546 meaning, i.e.,
 547
 548  1
 549
 550 The user must have access to all subfunctions of the module
 551 specified by the hash key.
 552
 553  *
 554
 555 The user must have access to at least one subfunction of the module
 556 specified by the hash key.
 557
 558  specific permission, e.g., 'export_catalog'
 559
 560 The user must have access to the specific subfunction list, which
 561 must correspond to a row in the permissions table.
 562
 563 The C<$type> argument specifies whether the template should be
 564 retrieved from the opac or intranet directory tree.  "opac" is
 565 assumed if it is not specified; however, if C<$type> is specified,
 566 "intranet" is assumed if it is not "opac".
 567
 568 If C<$query> does not have a valid session ID associated with it
 569 (i.e., the user has not logged in) or if the session has expired,
 570 C<&checkauth> presents the user with a login page (from the point of
 571 view of the original script, C<&checkauth> does not return). Once the
 572 user has authenticated, C<&checkauth> restarts the original script
 573 (this time, C<&checkauth> returns).
 574
 575 The login page is provided using a HTML::Template, which is set in the
 576 systempreferences table or at the top of this file. The variable C<$type>
 577 selects which template to use, either the opac or the intranet
 578 authentification template.
 579
 580 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 581 cookie should be sent back to the browser; it verifies that the user
 582 has authenticated.
 583
 584 =cut
 585
 586 sub _version_check {
 587     my $type = shift;
 588     my $query = shift;
 589     my $version;
 590     # If Version syspref is unavailable, it means Koha is beeing installed,
 591     # and so we must redirect to OPAC maintenance page or to the WebInstaller
 592     # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
 593     if (C4::Context->preference('OpacMaintenance') && $type eq 'opac') {
 594         warn "OPAC Install required, redirecting to maintenance";
 595         print $query->redirect("/cgi-bin/koha/maintenance.pl");
 596         safe_exit;
 597     }
 598     unless ( $version = C4::Context->preference('Version') ) {    # assignment, not comparison
 599         if ( $type ne 'opac' ) {
 600             warn "Install required, redirecting to Installer";
 601             print $query->redirect("/cgi-bin/koha/installer/install.pl");
 602         } else {
 603             warn "OPAC Install required, redirecting to maintenance";
 604             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 605         }
 606         safe_exit;
 607     }
 608
 609     # check that database and koha version are the same
 610     # there is no DB version, it's a fresh install,
 611     # go to web installer
 612     # there is a DB version, compare it to the code version
 613     my $kohaversion=C4::Context::KOHAVERSION;
 614     # remove the 3 last . to have a Perl number
 615     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 616     $debug and print STDERR "kohaversion : $kohaversion\n";
 617     if ($version < $kohaversion){
 618         my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
 619         if ($type ne 'opac'){
 620             warn sprintf($warning, 'Installer');
 621             print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
 622         } else {
 623             warn sprintf("OPAC: " . $warning, 'maintenance');
 624             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 625         }
 626         safe_exit;
 627     }
 628 }
 629
 630 sub _session_log {
 631     (@_) or return 0;
 632     open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
 633     printf $fh join("\n",@_);
 634     close $fh;
 635 }
 636
 637 sub _timeout_syspref {
 638     my $timeout = C4::Context->preference('timeout') || 600;
 639     # value in days, convert in seconds
 640     if ($timeout =~ /(\d+)[dD]/) {
 641         $timeout = $1 * 86400;
 642     };
 643     return $timeout;
 644 }
 645
 646 sub checkauth {
 647     my $query = shift;
 648     $debug and warn "Checking Auth";
 649     # $authnotrequired will be set for scripts which will run without authentication
 650     my $authnotrequired = shift;
 651     my $flagsrequired   = shift;
 652     my $type            = shift;
 653     my $persona         = shift;
 654     $type = 'opac' unless $type;
 655
 656     my $dbh     = C4::Context->dbh;
 657     my $timeout = _timeout_syspref();
 658
 659     _version_check($type,$query);
 660     # state variables
 661     my $loggedin = 0;
 662     my %info;
 663     my ( $userid, $cookie, $sessionID, $flags, $barshelves, $pubshelves );
 664     my $logout = $query->param('logout.x');
 665
 666     my $anon_search_history;
 667
 668     # This parameter is the name of the CAS server we want to authenticate against,
 669     # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
 670     my $casparam = $query->param('cas');
 671     my $q_userid = $query->param('userid') // '';
 672
 673     if ( $userid = $ENV{'REMOTE_USER'} ) {
 674             # Using Basic Authentication, no cookies required
 675         $cookie = $query->cookie(
 676             -name     => 'CGISESSID',
 677             -value    => '',
 678             -expires  => '',
 679             -HttpOnly => 1,
 680         );
 681         $loggedin = 1;
 682     }
 683     elsif ( $persona ){
 684       # we dont want to set a session because we are being called by a persona callback
 685     }
 686     elsif ( $sessionID = $query->cookie("CGISESSID") )
 687     {    # assignment, not comparison
 688         my $session = get_session($sessionID);
 689         C4::Context->_new_userenv($sessionID);
 690         my ($ip, $lasttime, $sessiontype);
 691         my $s_userid = '';
 692         if ($session){
 693             $s_userid = $session->param('id') // '';
 694             C4::Context::set_userenv(
 695                 $session->param('number'),       $s_userid,
 696                 $session->param('cardnumber'),   $session->param('firstname'),
 697                 $session->param('surname'),      $session->param('branch'),
 698                 $session->param('branchname'),   $session->param('flags'),
 699                 $session->param('emailaddress'), $session->param('branchprinter'),
 700                 $session->param('persona')
 701             );
 702             C4::Context::set_shelves_userenv('bar',$session->param('barshelves'));
 703             C4::Context::set_shelves_userenv('pub',$session->param('pubshelves'));
 704             C4::Context::set_shelves_userenv('tot',$session->param('totshelves'));
 705             $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 706             $ip       = $session->param('ip');
 707             $lasttime = $session->param('lasttime');
 708             $userid   = $s_userid;
 709             $sessiontype = $session->param('sessiontype') || '';
 710         }
 711         if ( ( $query->param('koha_login_context') && ($q_userid ne $s_userid) )
 712           || ( $cas && $query->param('ticket') ) ) {
 713             #if a user enters an id ne to the id in the current session, we need to log them in...
 714             #first we need to clear the anonymous session...
 715             $debug and warn "query id = $q_userid but session id = $s_userid";
 716             $anon_search_history = $session->param('search_history');
 717             $session->delete();
 718             $session->flush;
 719             C4::Context->_unset_userenv($sessionID);
 720             $sessionID = undef;
 721             $userid = undef;
 722         }
 723         elsif ($logout) {
 724             # voluntary logout the user
 725             $session->delete();
 726             $session->flush;
 727             C4::Context->_unset_userenv($sessionID);
 728             #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
 729             $sessionID = undef;
 730             $userid    = undef;
 731
 732         if ($cas and $caslogout) {
 733         logout_cas($query);
 734         }
 735         }
 736         elsif ( !$lasttime || ($lasttime < time() - $timeout) ) {
 737             # timed logout
 738             $info{'timed_out'} = 1;
 739             if ($session) {
 740                 $session->delete();
 741                 $session->flush;
 742             }
 743             C4::Context->_unset_userenv($sessionID);
 744             #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
 745             $userid    = undef;
 746             $sessionID = undef;
 747         }
 748         elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 749             # Different ip than originally logged in from
 750             $info{'oldip'}        = $ip;
 751             $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 752             $info{'different_ip'} = 1;
 753             $session->delete();
 754             $session->flush;
 755             C4::Context->_unset_userenv($sessionID);
 756             #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
 757             $sessionID = undef;
 758             $userid    = undef;
 759         }
 760         else {
 761             $cookie = $query->cookie(
 762                 -name     => 'CGISESSID',
 763                 -value    => $session->id,
 764                 -HttpOnly => 1
 765             );
 766             $session->param( 'lasttime', time() );
 767             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...
 768                 $flags = haspermission($userid, $flagsrequired);
 769                 if ($flags) {
 770                     $loggedin = 1;
 771                 } else {
 772                     $info{'nopermission'} = 1;
 773                 }
 774             }
 775         }
 776     }
 777     unless ($userid || $sessionID) {
 778
 779         #we initiate a session prior to checking for a username to allow for anonymous sessions...
 780         my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
 781
 782         # Save anonymous search history in new session so it can be retrieved
 783         # by get_template_and_user to store it in user's search history after
 784         # a successful login.
 785         if ($anon_search_history) {
 786             $session->param('search_history', $anon_search_history);
 787         }
 788
 789         my $sessionID = $session->id;
 790         C4::Context->_new_userenv($sessionID);
 791         $cookie = $query->cookie(
 792             -name     => 'CGISESSID',
 793             -value    => $session->id,
 794             -HttpOnly => 1
 795         );
 796         $userid = $q_userid;
 797         my $pki_field = C4::Context->preference('AllowPKIAuth');
 798         if (! defined($pki_field) ) {
 799             print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
 800             $pki_field = 'None';
 801         }
 802         if (   ( $cas && $query->param('ticket') )
 803             || $userid
 804             || $pki_field ne 'None'
 805             || $persona )
 806         {
 807             my $password = $query->param('password');
 808
 809             my ( $return, $cardnumber );
 810             if ( $cas && $query->param('ticket') ) {
 811                 my $retuserid;
 812                 ( $return, $cardnumber, $retuserid ) =
 813                   checkpw( $dbh, $userid, $password, $query );
 814                 $userid = $retuserid;
 815                 $info{'invalidCasLogin'} = 1 unless ($return);
 816             }
 817
 818     elsif ($persona) {
 819         my $value = $persona;
 820
 821         # If we're looking up the email, there's a chance that the person
 822         # doesn't have a userid. So if there is none, we pass along the
 823         # borrower number, and the bits of code that need to know the user
 824         # ID will have to be smart enough to handle that.
 825         require C4::Members;
 826         my @users_info = C4::Members::GetBorrowersWithEmail($value);
 827         if (@users_info) {
 828
 829             # First the userid, then the borrowernum
 830             $value = $users_info[0][1] || $users_info[0][0];
 831         }
 832         else {
 833             undef $value;
 834         }
 835         $return = $value ? 1 : 0;
 836         $userid = $value;
 837     }
 838
 839     elsif (
 840                 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
 841                 || (   $pki_field eq 'emailAddress'
 842                     && $ENV{'SSL_CLIENT_S_DN_Email'} )
 843               )
 844             {
 845                 my $value;
 846                 if ( $pki_field eq 'Common Name' ) {
 847                     $value = $ENV{'SSL_CLIENT_S_DN_CN'};
 848                 }
 849                 elsif ( $pki_field eq 'emailAddress' ) {
 850                     $value = $ENV{'SSL_CLIENT_S_DN_Email'};
 851
 852               # If we're looking up the email, there's a chance that the person
 853               # doesn't have a userid. So if there is none, we pass along the
 854               # borrower number, and the bits of code that need to know the user
 855               # ID will have to be smart enough to handle that.
 856                     require C4::Members;
 857                     my @users_info = C4::Members::GetBorrowersWithEmail($value);
 858                     if (@users_info) {
 859
 860                         # First the userid, then the borrowernum
 861                         $value = $users_info[0][1] || $users_info[0][0];
 862                     } else {
 863                         undef $value;
 864                     }
 865                 }
 866
 867
 868                 $return = $value ? 1 : 0;
 869                 $userid = $value;
 870
 871     }
 872             else {
 873                 my $retuserid;
 874                 ( $return, $cardnumber, $retuserid ) =
 875                   checkpw( $dbh, $userid, $password, $query );
 876                 $userid = $retuserid if ( $retuserid );
 877         }
 878         if ($return) {
 879                #_session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
 880                 if ( $flags = haspermission(  $userid, $flagsrequired ) ) {
 881                     $loggedin = 1;
 882                 }
 883                    else {
 884                     $info{'nopermission'} = 1;
 885                     C4::Context->_unset_userenv($sessionID);
 886                 }
 887                 my ($borrowernumber, $firstname, $surname, $userflags,
 888                     $branchcode, $branchname, $branchprinter, $emailaddress);
 889
 890                 if ( $return == 1 ) {
 891                     my $select = "
 892                     SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
 893                     branches.branchname    as branchname,
 894                     branches.branchprinter as branchprinter,
 895                     email
 896                     FROM borrowers
 897                     LEFT JOIN branches on borrowers.branchcode=branches.branchcode
 898                     ";
 899                     my $sth = $dbh->prepare("$select where userid=?");
 900                     $sth->execute($userid);
 901                     unless ($sth->rows) {
 902                         $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
 903                         $sth = $dbh->prepare("$select where cardnumber=?");
 904                         $sth->execute($cardnumber);
 905
 906                         unless ($sth->rows) {
 907                             $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
 908                             $sth->execute($userid);
 909                             unless ($sth->rows) {
 910                                 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
 911                             }
 912                         }
 913                     }
 914                     if ($sth->rows) {
 915                         ($borrowernumber, $firstname, $surname, $userflags,
 916                             $branchcode, $branchname, $branchprinter, $emailaddress) = $sth->fetchrow;
 917                         $debug and print STDERR "AUTH_3 results: " .
 918                         "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
 919                     } else {
 920                         print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
 921                     }
 922
 923 # launch a sequence to check if we have a ip for the branch, i
 924 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
 925
 926                     my $ip       = $ENV{'REMOTE_ADDR'};
 927                     # if they specify at login, use that
 928                     if ($query->param('branch')) {
 929                         $branchcode  = $query->param('branch');
 930                         $branchname = GetBranchName($branchcode);
 931                     }
 932                     my $branches = GetBranches();
 933                     if (C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation')){
 934                         # we have to check they are coming from the right ip range
 935                         my $domain = $branches->{$branchcode}->{'branchip'};
 936                         if ($ip !~ /^$domain/){
 937                             $loggedin=0;
 938                             $info{'wrongip'} = 1;
 939                         }
 940                     }
 941
 942                     my @branchesloop;
 943                     foreach my $br ( keys %$branches ) {
 944                         #     now we work with the treatment of ip
 945                         my $domain = $branches->{$br}->{'branchip'};
 946                         if ( $domain && $ip =~ /^$domain/ ) {
 947                             $branchcode = $branches->{$br}->{'branchcode'};
 948
 949                             # new op dev : add the branchprinter and branchname in the cookie
 950                             $branchprinter = $branches->{$br}->{'branchprinter'};
 951                             $branchname    = $branches->{$br}->{'branchname'};
 952                         }
 953                     }
 954                     $session->param('number',$borrowernumber);
 955                     $session->param('id',$userid);
 956                     $session->param('cardnumber',$cardnumber);
 957                     $session->param('firstname',$firstname);
 958                     $session->param('surname',$surname);
 959                     $session->param('branch',$branchcode);
 960                     $session->param('branchname',$branchname);
 961                     $session->param('flags',$userflags);
 962                     $session->param('emailaddress',$emailaddress);
 963                     $session->param('ip',$session->remote_addr());
 964                     $session->param('lasttime',time());
 965                     $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 966                 }
 967                 elsif ( $return == 2 ) {
 968                     #We suppose the user is the superlibrarian
 969                     $borrowernumber = 0;
 970                     $session->param('number',0);
 971                     $session->param('id',C4::Context->config('user'));
 972                     $session->param('cardnumber',C4::Context->config('user'));
 973                     $session->param('firstname',C4::Context->config('user'));
 974                     $session->param('surname',C4::Context->config('user'));
 975                     $session->param('branch','NO_LIBRARY_SET');
 976                     $session->param('branchname','NO_LIBRARY_SET');
 977                     $session->param('flags',1);
 978                     $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 979                     $session->param('ip',$session->remote_addr());
 980                     $session->param('lasttime',time());
 981                 }
 982                 if ($persona){
 983                     $session->param('persona',1);
 984                 }
 985                 C4::Context::set_userenv(
 986                     $session->param('number'),       $session->param('id'),
 987                     $session->param('cardnumber'),   $session->param('firstname'),
 988                     $session->param('surname'),      $session->param('branch'),
 989                     $session->param('branchname'),   $session->param('flags'),
 990                     $session->param('emailaddress'), $session->param('branchprinter'),
 991                     $session->param('persona')
 992                 );
 993
 994             }
 995             else {
 996                 if ($userid) {
 997                     $info{'invalid_username_or_password'} = 1;
 998                     C4::Context->_unset_userenv($sessionID);
 999                 }
1000                 $session->param('lasttime',time());
1001                 $session->param('ip',$session->remote_addr());
1002             }
1003         }    # END if ( $userid    = $query->param('userid') )
1004         elsif ($type eq "opac") {
1005             # if we are here this is an anonymous session; add public lists to it and a few other items...
1006             # anonymous sessions are created only for the OPAC
1007             $debug and warn "Initiating an anonymous session...";
1008
1009             # setting a couple of other session vars...
1010             $session->param('ip',$session->remote_addr());
1011             $session->param('lasttime',time());
1012             $session->param('sessiontype','anon');
1013         }
1014     }    # END unless ($userid)
1015
1016     # finished authentification, now respond
1017     if ( $loggedin || $authnotrequired )
1018     {
1019         # successful login
1020         unless ($cookie) {
1021             $cookie = $query->cookie(
1022                 -name     => 'CGISESSID',
1023                 -value    => '',
1024                 -HttpOnly => 1
1025             );
1026         }
1027         return ( $userid, $cookie, $sessionID, $flags );
1028     }
1029
1030 #
1031 #
1032 # AUTH rejected, show the login/password template, after checking the DB.
1033 #
1034 #
1035
1036     # get the inputs from the incoming query
1037     my @inputs = ();
1038     foreach my $name ( param $query) {
1039         (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1040         my $value = $query->param($name);
1041         push @inputs, { name => $name, value => $value };
1042     }
1043
1044     my $LibraryNameTitle = C4::Context->preference("LibraryName");
1045     $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1046     $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1047
1048     my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1049     my $template = C4::Templates::gettemplate($template_name, $type, $query );
1050     $template->param(
1051         branchloop           => GetBranchesLoop(),
1052         opaccolorstylesheet  => C4::Context->preference("opaccolorstylesheet"),
1053         opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
1054         login                => 1,
1055         INPUTS               => \@inputs,
1056         casAuthentication    => C4::Context->preference("casAuthentication"),
1057         suggestion           => C4::Context->preference("suggestion"),
1058         virtualshelves       => C4::Context->preference("virtualshelves"),
1059         LibraryName          => "" . C4::Context->preference("LibraryName"),
1060         LibraryNameTitle     => "" . $LibraryNameTitle,
1061         opacuserlogin        => C4::Context->preference("opacuserlogin"),
1062         OpacNav              => C4::Context->preference("OpacNav"),
1063         OpacNavRight         => C4::Context->preference("OpacNavRight"),
1064         OpacNavBottom        => C4::Context->preference("OpacNavBottom"),
1065         opaccredits          => C4::Context->preference("opaccredits"),
1066         OpacFavicon          => C4::Context->preference("OpacFavicon"),
1067         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
1068         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1069         opacuserjs           => C4::Context->preference("opacuserjs"),
1070         opacbookbag          => "" . C4::Context->preference("opacbookbag"),
1071         OpacCloud            => C4::Context->preference("OpacCloud"),
1072         OpacTopissue         => C4::Context->preference("OpacTopissue"),
1073         OpacAuthorities      => C4::Context->preference("OpacAuthorities"),
1074         OpacBrowser          => C4::Context->preference("OpacBrowser"),
1075         opacheader           => C4::Context->preference("opacheader"),
1076         TagsEnabled          => C4::Context->preference("TagsEnabled"),
1077         OPACUserCSS           => C4::Context->preference("OPACUserCSS"),
1078         intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1079         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1080         intranetbookbag    => C4::Context->preference("intranetbookbag"),
1081         IntranetNav        => C4::Context->preference("IntranetNav"),
1082         IntranetFavicon    => C4::Context->preference("IntranetFavicon"),
1083         intranetuserjs     => C4::Context->preference("intranetuserjs"),
1084         IndependentBranches=> C4::Context->preference("IndependentBranches"),
1085         AutoLocation       => C4::Context->preference("AutoLocation"),
1086         wrongip            => $info{'wrongip'},
1087         PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1088         PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1089         persona            => C4::Context->preference("Persona"),
1090         opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1091     );
1092
1093     $template->param( OpacPublic => C4::Context->preference("OpacPublic"));
1094     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1095
1096     if($type eq 'opac'){
1097         my ($total, $pubshelves) = C4::VirtualShelves::GetSomeShelfNames(undef, 'MASTHEAD');
1098         $template->param(
1099             pubshelves     => $total->{pubtotal},
1100             pubshelvesloop => $pubshelves,
1101         );
1102     }
1103
1104     if ($cas) {
1105
1106     # Is authentication against multiple CAS servers enabled?
1107         if (C4::Auth_with_cas::multipleAuth && !$casparam) {
1108         my $casservers = C4::Auth_with_cas::getMultipleAuth();
1109         my @tmplservers;
1110         foreach my $key (keys %$casservers) {
1111         push @tmplservers, {name => $key, value => login_cas_url($query, $key) . "?cas=$key" };
1112         }
1113         $template->param(
1114         casServersLoop => \@tmplservers
1115         );
1116     } else {
1117         $template->param(
1118             casServerUrl    => login_cas_url($query),
1119         );
1120     }
1121
1122     $template->param(
1123             invalidCasLogin => $info{'invalidCasLogin'}
1124         );
1125     }
1126
1127     my $self_url = $query->url( -absolute => 1 );
1128     $template->param(
1129         url         => $self_url,
1130         LibraryName => C4::Context->preference("LibraryName"),
1131     );
1132     $template->param( %info );
1133 #    $cookie = $query->cookie(CGISESSID => $session->id
1134 #   );
1135     print $query->header(
1136         -type   => 'text/html',
1137         -charset => 'utf-8',
1138         -cookie => $cookie
1139       ),
1140       $template->output;
1141     safe_exit;
1142 }
1143
1144 =head2 check_api_auth
1145
1146   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1147
1148 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1149 cookie, determine if the user has the privileges specified by C<$userflags>.
1150
1151 C<check_api_auth> is is meant for authenticating users of web services, and
1152 consequently will always return and will not attempt to redirect the user
1153 agent.
1154
1155 If a valid session cookie is already present, check_api_auth will return a status
1156 of "ok", the cookie, and the Koha session ID.
1157
1158 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1159 parameters and create a session cookie and Koha session if the supplied credentials
1160 are OK.
1161
1162 Possible return values in C<$status> are:
1163
1164 =over
1165
1166 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1167
1168 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1169
1170 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1171
1172 =item "expired -- session cookie has expired; API user should resubmit userid and password
1173
1174 =back
1175
1176 =cut
1177
1178 sub check_api_auth {
1179     my $query = shift;
1180     my $flagsrequired = shift;
1181
1182     my $dbh     = C4::Context->dbh;
1183     my $timeout = _timeout_syspref();
1184
1185     unless (C4::Context->preference('Version')) {
1186         # database has not been installed yet
1187         return ("maintenance", undef, undef);
1188     }
1189     my $kohaversion=C4::Context::KOHAVERSION;
1190     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1191     if (C4::Context->preference('Version') < $kohaversion) {
1192         # database in need of version update; assume that
1193         # no API should be called while databsae is in
1194         # this condition.
1195         return ("maintenance", undef, undef);
1196     }
1197
1198     # FIXME -- most of what follows is a copy-and-paste
1199     # of code from checkauth.  There is an obvious need
1200     # for refactoring to separate the various parts of
1201     # the authentication code, but as of 2007-11-19 this
1202     # is deferred so as to not introduce bugs into the
1203     # regular authentication code for Koha 3.0.
1204
1205     # see if we have a valid session cookie already
1206     # however, if a userid parameter is present (i.e., from
1207     # a form submission, assume that any current cookie
1208     # is to be ignored
1209     my $sessionID = undef;
1210     unless ($query->param('userid')) {
1211         $sessionID = $query->cookie("CGISESSID");
1212     }
1213     if ($sessionID && not ($cas && $query->param('PT')) ) {
1214         my $session = get_session($sessionID);
1215         C4::Context->_new_userenv($sessionID);
1216         if ($session) {
1217             C4::Context::set_userenv(
1218                 $session->param('number'),       $session->param('id'),
1219                 $session->param('cardnumber'),   $session->param('firstname'),
1220                 $session->param('surname'),      $session->param('branch'),
1221                 $session->param('branchname'),   $session->param('flags'),
1222                 $session->param('emailaddress'), $session->param('branchprinter')
1223             );
1224
1225             my $ip = $session->param('ip');
1226             my $lasttime = $session->param('lasttime');
1227             my $userid = $session->param('id');
1228             if ( $lasttime < time() - $timeout ) {
1229                 # time out
1230                 $session->delete();
1231                 $session->flush;
1232                 C4::Context->_unset_userenv($sessionID);
1233                 $userid    = undef;
1234                 $sessionID = undef;
1235                 return ("expired", undef, undef);
1236             } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1237                 # IP address changed
1238                 $session->delete();
1239                 $session->flush;
1240                 C4::Context->_unset_userenv($sessionID);
1241                 $userid    = undef;
1242                 $sessionID = undef;
1243                 return ("expired", undef, undef);
1244             } else {
1245                 my $cookie = $query->cookie(
1246                     -name  => 'CGISESSID',
1247                     -value => $session->id,
1248                     -HttpOnly => 1,
1249                 );
1250                 $session->param('lasttime',time());
1251                 my $flags = haspermission($userid, $flagsrequired);
1252                 if ($flags) {
1253                     return ("ok", $cookie, $sessionID);
1254                 } else {
1255                     $session->delete();
1256                     $session->flush;
1257                     C4::Context->_unset_userenv($sessionID);
1258                     $userid    = undef;
1259                     $sessionID = undef;
1260                     return ("failed", undef, undef);
1261                 }
1262             }
1263         } else {
1264             return ("expired", undef, undef);
1265         }
1266     } else {
1267         # new login
1268         my $userid = $query->param('userid');
1269         my $password = $query->param('password');
1270            my ($return, $cardnumber);
1271
1272     # Proxy CAS auth
1273     if ($cas && $query->param('PT')) {
1274         my $retuserid;
1275         $debug and print STDERR "## check_api_auth - checking CAS\n";
1276         # In case of a CAS authentication, we use the ticket instead of the password
1277         my $PT = $query->param('PT');
1278         ($return,$cardnumber,$userid) = check_api_auth_cas($dbh, $PT, $query);    # EXTERNAL AUTH
1279     } else {
1280         # User / password auth
1281         unless ($userid and $password) {
1282         # caller did something wrong, fail the authenticateion
1283         return ("failed", undef, undef);
1284         }
1285         ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password, $query );
1286     }
1287
1288         if ($return and haspermission(  $userid, $flagsrequired)) {
1289             my $session = get_session("");
1290             return ("failed", undef, undef) unless $session;
1291
1292             my $sessionID = $session->id;
1293             C4::Context->_new_userenv($sessionID);
1294             my $cookie = $query->cookie(
1295                 -name  => 'CGISESSID',
1296                 -value => $sessionID,
1297                 -HttpOnly => 1,
1298             );
1299             if ( $return == 1 ) {
1300                 my (
1301                     $borrowernumber, $firstname,  $surname,
1302                     $userflags,      $branchcode, $branchname,
1303                     $branchprinter,  $emailaddress
1304                 );
1305                 my $sth =
1306                   $dbh->prepare(
1307 "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=?"
1308                   );
1309                 $sth->execute($userid);
1310                 (
1311                     $borrowernumber, $firstname,  $surname,
1312                     $userflags,      $branchcode, $branchname,
1313                     $branchprinter,  $emailaddress
1314                 ) = $sth->fetchrow if ( $sth->rows );
1315
1316                 unless ($sth->rows ) {
1317                     my $sth = $dbh->prepare(
1318 "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=?"
1319                       );
1320                     $sth->execute($cardnumber);
1321                     (
1322                         $borrowernumber, $firstname,  $surname,
1323                         $userflags,      $branchcode, $branchname,
1324                         $branchprinter,  $emailaddress
1325                     ) = $sth->fetchrow if ( $sth->rows );
1326
1327                     unless ( $sth->rows ) {
1328                         $sth->execute($userid);
1329                         (
1330                             $borrowernumber, $firstname, $surname, $userflags,
1331                             $branchcode, $branchname, $branchprinter, $emailaddress
1332                         ) = $sth->fetchrow if ( $sth->rows );
1333                     }
1334                 }
1335
1336                 my $ip       = $ENV{'REMOTE_ADDR'};
1337                 # if they specify at login, use that
1338                 if ($query->param('branch')) {
1339                     $branchcode  = $query->param('branch');
1340                     $branchname = GetBranchName($branchcode);
1341                 }
1342                 my $branches = GetBranches();
1343                 my @branchesloop;
1344                 foreach my $br ( keys %$branches ) {
1345                     #     now we work with the treatment of ip
1346                     my $domain = $branches->{$br}->{'branchip'};
1347                     if ( $domain && $ip =~ /^$domain/ ) {
1348                         $branchcode = $branches->{$br}->{'branchcode'};
1349
1350                         # new op dev : add the branchprinter and branchname in the cookie
1351                         $branchprinter = $branches->{$br}->{'branchprinter'};
1352                         $branchname    = $branches->{$br}->{'branchname'};
1353                     }
1354                 }
1355                 $session->param('number',$borrowernumber);
1356                 $session->param('id',$userid);
1357                 $session->param('cardnumber',$cardnumber);
1358                 $session->param('firstname',$firstname);
1359                 $session->param('surname',$surname);
1360                 $session->param('branch',$branchcode);
1361                 $session->param('branchname',$branchname);
1362                 $session->param('flags',$userflags);
1363                 $session->param('emailaddress',$emailaddress);
1364                 $session->param('ip',$session->remote_addr());
1365                 $session->param('lasttime',time());
1366             } elsif ( $return == 2 ) {
1367                 #We suppose the user is the superlibrarian
1368                 $session->param('number',0);
1369                 $session->param('id',C4::Context->config('user'));
1370                 $session->param('cardnumber',C4::Context->config('user'));
1371                 $session->param('firstname',C4::Context->config('user'));
1372                 $session->param('surname',C4::Context->config('user'));
1373                 $session->param('branch','NO_LIBRARY_SET');
1374                 $session->param('branchname','NO_LIBRARY_SET');
1375                 $session->param('flags',1);
1376                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
1377                 $session->param('ip',$session->remote_addr());
1378                 $session->param('lasttime',time());
1379             }
1380             C4::Context::set_userenv(
1381                 $session->param('number'),       $session->param('id'),
1382                 $session->param('cardnumber'),   $session->param('firstname'),
1383                 $session->param('surname'),      $session->param('branch'),
1384                 $session->param('branchname'),   $session->param('flags'),
1385                 $session->param('emailaddress'), $session->param('branchprinter')
1386             );
1387             return ("ok", $cookie, $sessionID);
1388         } else {
1389             return ("failed", undef, undef);
1390         }
1391     }
1392 }
1393
1394 =head2 check_cookie_auth
1395
1396   ($status, $sessionId) = check_api_auth($cookie, $userflags);
1397
1398 Given a CGISESSID cookie set during a previous login to Koha, determine
1399 if the user has the privileges specified by C<$userflags>.
1400
1401 C<check_cookie_auth> is meant for authenticating special services
1402 such as tools/upload-file.pl that are invoked by other pages that
1403 have been authenticated in the usual way.
1404
1405 Possible return values in C<$status> are:
1406
1407 =over
1408
1409 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1410
1411 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1412
1413 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1414
1415 =item "expired -- session cookie has expired; API user should resubmit userid and password
1416
1417 =back
1418
1419 =cut
1420
1421 sub check_cookie_auth {
1422     my $cookie = shift;
1423     my $flagsrequired = shift;
1424
1425     my $dbh     = C4::Context->dbh;
1426     my $timeout = _timeout_syspref();
1427
1428     unless (C4::Context->preference('Version')) {
1429         # database has not been installed yet
1430         return ("maintenance", undef);
1431     }
1432     my $kohaversion=C4::Context::KOHAVERSION;
1433     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1434     if (C4::Context->preference('Version') < $kohaversion) {
1435         # database in need of version update; assume that
1436         # no API should be called while databsae is in
1437         # this condition.
1438         return ("maintenance", undef);
1439     }
1440
1441     # FIXME -- most of what follows is a copy-and-paste
1442     # of code from checkauth.  There is an obvious need
1443     # for refactoring to separate the various parts of
1444     # the authentication code, but as of 2007-11-23 this
1445     # is deferred so as to not introduce bugs into the
1446     # regular authentication code for Koha 3.0.
1447
1448     # see if we have a valid session cookie already
1449     # however, if a userid parameter is present (i.e., from
1450     # a form submission, assume that any current cookie
1451     # is to be ignored
1452     unless (defined $cookie and $cookie) {
1453         return ("failed", undef);
1454     }
1455     my $sessionID = $cookie;
1456     my $session = get_session($sessionID);
1457     C4::Context->_new_userenv($sessionID);
1458     if ($session) {
1459         C4::Context::set_userenv(
1460             $session->param('number'),       $session->param('id'),
1461             $session->param('cardnumber'),   $session->param('firstname'),
1462             $session->param('surname'),      $session->param('branch'),
1463             $session->param('branchname'),   $session->param('flags'),
1464             $session->param('emailaddress'), $session->param('branchprinter')
1465         );
1466
1467         my $ip = $session->param('ip');
1468         my $lasttime = $session->param('lasttime');
1469         my $userid = $session->param('id');
1470         if ( $lasttime < time() - $timeout ) {
1471             # time out
1472             $session->delete();
1473             $session->flush;
1474             C4::Context->_unset_userenv($sessionID);
1475             $userid    = undef;
1476             $sessionID = undef;
1477             return ("expired", undef);
1478         } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1479             # IP address changed
1480             $session->delete();
1481             $session->flush;
1482             C4::Context->_unset_userenv($sessionID);
1483             $userid    = undef;
1484             $sessionID = undef;
1485             return ("expired", undef);
1486         } else {
1487             $session->param('lasttime',time());
1488             my $flags = haspermission($userid, $flagsrequired);
1489             if ($flags) {
1490                 return ("ok", $sessionID);
1491             } else {
1492                 $session->delete();
1493                 $session->flush;
1494                 C4::Context->_unset_userenv($sessionID);
1495                 $userid    = undef;
1496                 $sessionID = undef;
1497                 return ("failed", undef);
1498             }
1499         }
1500     } else {
1501         return ("expired", undef);
1502     }
1503 }
1504
1505 =head2 get_session
1506
1507   use CGI::Session;
1508   my $session = get_session($sessionID);
1509
1510 Given a session ID, retrieve the CGI::Session object used to store
1511 the session's state.  The session object can be used to store
1512 data that needs to be accessed by different scripts during a
1513 user's session.
1514
1515 If the C<$sessionID> parameter is an empty string, a new session
1516 will be created.
1517
1518 =cut
1519
1520 sub get_session {
1521     my $sessionID = shift;
1522     my $storage_method = C4::Context->preference('SessionStorage');
1523     my $dbh = C4::Context->dbh;
1524     my $session;
1525     if ($storage_method eq 'mysql'){
1526         $session = new CGI::Session("driver:MySQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1527     }
1528     elsif ($storage_method eq 'Pg') {
1529         $session = new CGI::Session("driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1530     }
1531     elsif ($storage_method eq 'memcached' && C4::Context->ismemcached){
1532     $session = new CGI::Session("driver:memcached;serializer:yaml;id:md5", $sessionID, { Memcached => C4::Context->memcached } );
1533     }
1534     else {
1535         # catch all defaults to tmp should work on all systems
1536         $session = new CGI::Session("driver:File;serializer:yaml;id:md5", $sessionID, {Directory=>'/tmp'});
1537     }
1538     return $session;
1539 }
1540
1541 sub checkpw {
1542     my ( $dbh, $userid, $password, $query ) = @_;
1543
1544     if ($ldap) {
1545         $debug and print STDERR "## checkpw - checking LDAP\n";
1546         my ($retval,$retcard,$retuserid) = checkpw_ldap(@_);    # EXTERNAL AUTH
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