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