C4/Auth.pm

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