koha-dev.rot13.org Git - srvgit/blob - 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         NoLoginInstructions => C4::Context->preference("NoLoginInstructions"),
1072     );
1073
1074     $template->param( OpacPublic => C4::Context->preference("OpacPublic"));
1075     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1076
1077     if($type eq 'opac'){
1078         my ($total, $pubshelves) = C4::VirtualShelves::GetSomeShelfNames(undef, 'MASTHEAD');
1079         $template->param(
1080             pubshelves     => $total->{pubtotal},
1081             pubshelvesloop => $pubshelves,
1082         );
1083     }
1084
1085     if ($cas) {
1086
1087     # Is authentication against multiple CAS servers enabled?
1088         if (C4::Auth_with_cas::multipleAuth && !$casparam) {
1089         my $casservers = C4::Auth_with_cas::getMultipleAuth();
1090         my @tmplservers;
1091         foreach my $key (keys %$casservers) {
1092         push @tmplservers, {name => $key, value => login_cas_url($query, $key) . "?cas=$key" };
1093         }
1094         $template->param(
1095         casServersLoop => \@tmplservers
1096         );
1097     } else {
1098         $template->param(
1099             casServerUrl    => login_cas_url($query),
1100         );
1101     }
1102
1103     $template->param(
1104             invalidCasLogin => $info{'invalidCasLogin'}
1105         );
1106     }
1107
1108     my $self_url = $query->url( -absolute => 1 );
1109     $template->param(
1110         url         => $self_url,
1111         LibraryName => C4::Context->preference("LibraryName"),
1112     );
1113     $template->param( %info );
1114 #    $cookie = $query->cookie(CGISESSID => $session->id
1115 #   );
1116     print $query->header(
1117         -type   => 'text/html',
1118         -charset => 'utf-8',
1119         -cookie => $cookie
1120       ),
1121       $template->output;
1122     safe_exit;
1123 }
1124
1125 =head2 check_api_auth
1126
1127   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1128
1129 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1130 cookie, determine if the user has the privileges specified by C<$userflags>.
1131
1132 C<check_api_auth> is is meant for authenticating users of web services, and
1133 consequently will always return and will not attempt to redirect the user
1134 agent.
1135
1136 If a valid session cookie is already present, check_api_auth will return a status
1137 of "ok", the cookie, and the Koha session ID.
1138
1139 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1140 parameters and create a session cookie and Koha session if the supplied credentials
1141 are OK.
1142
1143 Possible return values in C<$status> are:
1144
1145 =over
1146
1147 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1148
1149 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1150
1151 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1152
1153 =item "expired -- session cookie has expired; API user should resubmit userid and password
1154
1155 =back
1156
1157 =cut
1158
1159 sub check_api_auth {
1160     my $query = shift;
1161     my $flagsrequired = shift;
1162
1163     my $dbh     = C4::Context->dbh;
1164     my $timeout = _timeout_syspref();
1165
1166     unless (C4::Context->preference('Version')) {
1167         # database has not been installed yet
1168         return ("maintenance", undef, undef);
1169     }
1170     my $kohaversion=C4::Context::KOHAVERSION;
1171     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1172     if (C4::Context->preference('Version') < $kohaversion) {
1173         # database in need of version update; assume that
1174         # no API should be called while databsae is in
1175         # this condition.
1176         return ("maintenance", undef, undef);
1177     }
1178
1179     # FIXME -- most of what follows is a copy-and-paste
1180     # of code from checkauth.  There is an obvious need
1181     # for refactoring to separate the various parts of
1182     # the authentication code, but as of 2007-11-19 this
1183     # is deferred so as to not introduce bugs into the
1184     # regular authentication code for Koha 3.0.
1185
1186     # see if we have a valid session cookie already
1187     # however, if a userid parameter is present (i.e., from
1188     # a form submission, assume that any current cookie
1189     # is to be ignored
1190     my $sessionID = undef;
1191     unless ($query->param('userid')) {
1192         $sessionID = $query->cookie("CGISESSID");
1193     }
1194     if ($sessionID && not ($cas && $query->param('PT')) ) {
1195         my $session = get_session($sessionID);
1196         C4::Context->_new_userenv($sessionID);
1197         if ($session) {
1198             C4::Context::set_userenv(
1199                 $session->param('number'),       $session->param('id'),
1200                 $session->param('cardnumber'),   $session->param('firstname'),
1201                 $session->param('surname'),      $session->param('branch'),
1202                 $session->param('branchname'),   $session->param('flags'),
1203                 $session->param('emailaddress'), $session->param('branchprinter')
1204             );
1205
1206             my $ip = $session->param('ip');
1207             my $lasttime = $session->param('lasttime');
1208             my $userid = $session->param('id');
1209             if ( $lasttime < time() - $timeout ) {
1210                 # time out
1211                 $session->delete();
1212                 $session->flush;
1213                 C4::Context->_unset_userenv($sessionID);
1214                 $userid    = undef;
1215                 $sessionID = undef;
1216                 return ("expired", undef, undef);
1217             } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1218                 # IP address changed
1219                 $session->delete();
1220                 $session->flush;
1221                 C4::Context->_unset_userenv($sessionID);
1222                 $userid    = undef;
1223                 $sessionID = undef;
1224                 return ("expired", undef, undef);
1225             } else {
1226                 my $cookie = $query->cookie(
1227                     -name  => 'CGISESSID',
1228                     -value => $session->id,
1229                     -HttpOnly => 1,
1230                 );
1231                 $session->param('lasttime',time());
1232                 my $flags = haspermission($userid, $flagsrequired);
1233                 if ($flags) {
1234                     return ("ok", $cookie, $sessionID);
1235                 } else {
1236                     $session->delete();
1237                     $session->flush;
1238                     C4::Context->_unset_userenv($sessionID);
1239                     $userid    = undef;
1240                     $sessionID = undef;
1241                     return ("failed", undef, undef);
1242                 }
1243             }
1244         } else {
1245             return ("expired", undef, undef);
1246         }
1247     } else {
1248         # new login
1249         my $userid = $query->param('userid');
1250         my $password = $query->param('password');
1251            my ($return, $cardnumber);
1252
1253     # Proxy CAS auth
1254     if ($cas && $query->param('PT')) {
1255         my $retuserid;
1256         $debug and print STDERR "## check_api_auth - checking CAS\n";
1257         # In case of a CAS authentication, we use the ticket instead of the password
1258         my $PT = $query->param('PT');
1259         ($return,$cardnumber,$userid) = check_api_auth_cas($dbh, $PT, $query);    # EXTERNAL AUTH
1260     } else {
1261         # User / password auth
1262         unless ($userid and $password) {
1263         # caller did something wrong, fail the authenticateion
1264         return ("failed", undef, undef);
1265         }
1266         ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password, $query );
1267     }
1268
1269         if ($return and haspermission(  $userid, $flagsrequired)) {
1270             my $session = get_session("");
1271             return ("failed", undef, undef) unless $session;
1272
1273             my $sessionID = $session->id;
1274             C4::Context->_new_userenv($sessionID);
1275             my $cookie = $query->cookie(
1276                 -name  => 'CGISESSID',
1277                 -value => $sessionID,
1278                 -HttpOnly => 1,
1279             );
1280             if ( $return == 1 ) {
1281                 my (
1282                     $borrowernumber, $firstname,  $surname,
1283                     $userflags,      $branchcode, $branchname,
1284                     $branchprinter,  $emailaddress
1285                 );
1286                 my $sth =
1287                   $dbh->prepare(
1288 "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=?"
1289                   );
1290                 $sth->execute($userid);
1291                 (
1292                     $borrowernumber, $firstname,  $surname,
1293                     $userflags,      $branchcode, $branchname,
1294                     $branchprinter,  $emailaddress
1295                 ) = $sth->fetchrow if ( $sth->rows );
1296
1297                 unless ($sth->rows ) {
1298                     my $sth = $dbh->prepare(
1299 "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=?"
1300                       );
1301                     $sth->execute($cardnumber);
1302                     (
1303                         $borrowernumber, $firstname,  $surname,
1304                         $userflags,      $branchcode, $branchname,
1305                         $branchprinter,  $emailaddress
1306                     ) = $sth->fetchrow if ( $sth->rows );
1307
1308                     unless ( $sth->rows ) {
1309                         $sth->execute($userid);
1310                         (
1311                             $borrowernumber, $firstname, $surname, $userflags,
1312                             $branchcode, $branchname, $branchprinter, $emailaddress
1313                         ) = $sth->fetchrow if ( $sth->rows );
1314                     }
1315                 }
1316
1317                 my $ip       = $ENV{'REMOTE_ADDR'};
1318                 # if they specify at login, use that
1319                 if ($query->param('branch')) {
1320                     $branchcode  = $query->param('branch');
1321                     $branchname = GetBranchName($branchcode);
1322                 }
1323                 my $branches = GetBranches();
1324                 my @branchesloop;
1325                 foreach my $br ( keys %$branches ) {
1326                     #     now we work with the treatment of ip
1327                     my $domain = $branches->{$br}->{'branchip'};
1328                     if ( $domain && $ip =~ /^$domain/ ) {
1329                         $branchcode = $branches->{$br}->{'branchcode'};
1330
1331                         # new op dev : add the branchprinter and branchname in the cookie
1332                         $branchprinter = $branches->{$br}->{'branchprinter'};
1333                         $branchname    = $branches->{$br}->{'branchname'};
1334                     }
1335                 }
1336                 $session->param('number',$borrowernumber);
1337                 $session->param('id',$userid);
1338                 $session->param('cardnumber',$cardnumber);
1339                 $session->param('firstname',$firstname);
1340                 $session->param('surname',$surname);
1341                 $session->param('branch',$branchcode);
1342                 $session->param('branchname',$branchname);
1343                 $session->param('flags',$userflags);
1344                 $session->param('emailaddress',$emailaddress);
1345                 $session->param('ip',$session->remote_addr());
1346                 $session->param('lasttime',time());
1347             } elsif ( $return == 2 ) {
1348                 #We suppose the user is the superlibrarian
1349                 $session->param('number',0);
1350                 $session->param('id',C4::Context->config('user'));
1351                 $session->param('cardnumber',C4::Context->config('user'));
1352                 $session->param('firstname',C4::Context->config('user'));
1353                 $session->param('surname',C4::Context->config('user'));
1354                 $session->param('branch','NO_LIBRARY_SET');
1355                 $session->param('branchname','NO_LIBRARY_SET');
1356                 $session->param('flags',1);
1357                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
1358                 $session->param('ip',$session->remote_addr());
1359                 $session->param('lasttime',time());
1360             }
1361             C4::Context::set_userenv(
1362                 $session->param('number'),       $session->param('id'),
1363                 $session->param('cardnumber'),   $session->param('firstname'),
1364                 $session->param('surname'),      $session->param('branch'),
1365                 $session->param('branchname'),   $session->param('flags'),
1366                 $session->param('emailaddress'), $session->param('branchprinter')
1367             );
1368             return ("ok", $cookie, $sessionID);
1369         } else {
1370             return ("failed", undef, undef);
1371         }
1372     }
1373 }
1374
1375 =head2 check_cookie_auth
1376
1377   ($status, $sessionId) = check_api_auth($cookie, $userflags);
1378
1379 Given a CGISESSID cookie set during a previous login to Koha, determine
1380 if the user has the privileges specified by C<$userflags>.
1381
1382 C<check_cookie_auth> is meant for authenticating special services
1383 such as tools/upload-file.pl that are invoked by other pages that
1384 have been authenticated in the usual way.
1385
1386 Possible return values in C<$status> are:
1387
1388 =over
1389
1390 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1391
1392 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1393
1394 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1395
1396 =item "expired -- session cookie has expired; API user should resubmit userid and password
1397
1398 =back
1399
1400 =cut
1401
1402 sub check_cookie_auth {
1403     my $cookie = shift;
1404     my $flagsrequired = shift;
1405
1406     my $dbh     = C4::Context->dbh;
1407     my $timeout = _timeout_syspref();
1408
1409     unless (C4::Context->preference('Version')) {
1410         # database has not been installed yet
1411         return ("maintenance", undef);
1412     }
1413     my $kohaversion=C4::Context::KOHAVERSION;
1414     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1415     if (C4::Context->preference('Version') < $kohaversion) {
1416         # database in need of version update; assume that
1417         # no API should be called while databsae is in
1418         # this condition.
1419         return ("maintenance", undef);
1420     }
1421
1422     # FIXME -- most of what follows is a copy-and-paste
1423     # of code from checkauth.  There is an obvious need
1424     # for refactoring to separate the various parts of
1425     # the authentication code, but as of 2007-11-23 this
1426     # is deferred so as to not introduce bugs into the
1427     # regular authentication code for Koha 3.0.
1428
1429     # see if we have a valid session cookie already
1430     # however, if a userid parameter is present (i.e., from
1431     # a form submission, assume that any current cookie
1432     # is to be ignored
1433     unless (defined $cookie and $cookie) {
1434         return ("failed", undef);
1435     }
1436     my $sessionID = $cookie;
1437     my $session = get_session($sessionID);
1438     C4::Context->_new_userenv($sessionID);
1439     if ($session) {
1440         C4::Context::set_userenv(
1441             $session->param('number'),       $session->param('id'),
1442             $session->param('cardnumber'),   $session->param('firstname'),
1443             $session->param('surname'),      $session->param('branch'),
1444             $session->param('branchname'),   $session->param('flags'),
1445             $session->param('emailaddress'), $session->param('branchprinter')
1446         );
1447
1448         my $ip = $session->param('ip');
1449         my $lasttime = $session->param('lasttime');
1450         my $userid = $session->param('id');
1451         if ( $lasttime < time() - $timeout ) {
1452             # time out
1453             $session->delete();
1454             $session->flush;
1455             C4::Context->_unset_userenv($sessionID);
1456             $userid    = undef;
1457             $sessionID = undef;
1458             return ("expired", undef);
1459         } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1460             # IP address changed
1461             $session->delete();
1462             $session->flush;
1463             C4::Context->_unset_userenv($sessionID);
1464             $userid    = undef;
1465             $sessionID = undef;
1466             return ("expired", undef);
1467         } else {
1468             $session->param('lasttime',time());
1469             my $flags = haspermission($userid, $flagsrequired);
1470             if ($flags) {
1471                 return ("ok", $sessionID);
1472             } else {
1473                 $session->delete();
1474                 $session->flush;
1475                 C4::Context->_unset_userenv($sessionID);
1476                 $userid    = undef;
1477                 $sessionID = undef;
1478                 return ("failed", undef);
1479             }
1480         }
1481     } else {
1482         return ("expired", undef);
1483     }
1484 }
1485
1486 =head2 get_session
1487
1488   use CGI::Session;
1489   my $session = get_session($sessionID);
1490
1491 Given a session ID, retrieve the CGI::Session object used to store
1492 the session's state.  The session object can be used to store
1493 data that needs to be accessed by different scripts during a
1494 user's session.
1495
1496 If the C<$sessionID> parameter is an empty string, a new session
1497 will be created.
1498
1499 =cut
1500
1501 sub get_session {
1502     my $sessionID = shift;
1503     my $storage_method = C4::Context->preference('SessionStorage');
1504     my $dbh = C4::Context->dbh;
1505     my $session;
1506     if ($storage_method eq 'mysql'){
1507         $session = new CGI::Session("driver:MySQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1508     }
1509     elsif ($storage_method eq 'Pg') {
1510         $session = new CGI::Session("driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1511     }
1512     elsif ($storage_method eq 'memcached' && C4::Context->ismemcached){
1513     $session = new CGI::Session("driver:memcached;serializer:yaml;id:md5", $sessionID, { Memcached => C4::Context->memcached } );
1514     }
1515     else {
1516         # catch all defaults to tmp should work on all systems
1517         $session = new CGI::Session("driver:File;serializer:yaml;id:md5", $sessionID, {Directory=>'/tmp'});
1518     }
1519     return $session;
1520 }
1521
1522 sub checkpw {
1523     my ( $dbh, $userid, $password, $query ) = @_;
1524
1525     if ($ldap) {
1526         $debug and print STDERR "## checkpw - checking LDAP\n";
1527         my ($retval,$retcard,$retuserid) = checkpw_ldap(@_);    # EXTERNAL AUTH
1528         ($retval) and return ($retval,$retcard,$retuserid);
1529     }
1530
1531     if ($cas && $query && $query->param('ticket')) {
1532         $debug and print STDERR "## checkpw - checking CAS\n";
1533     # In case of a CAS authentication, we use the ticket instead of the password
1534         my $ticket = $query->param('ticket');
1535         my ($retval,$retcard,$retuserid) = checkpw_cas($dbh, $ticket, $query);    # EXTERNAL AUTH
1536         ($retval) and return ($retval,$retcard,$retuserid);
1537         return 0;
1538     }
1539
1540     return checkpw_internal(@_)
1541 }
1542
1543 sub checkpw_internal {
1544     my ( $dbh, $userid, $password ) = @_;
1545
1546     my $sth =
1547       $dbh->prepare(
1548 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1549       );
1550     $sth->execute($userid);
1551     if ( $sth->rows ) {
1552         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1553             $surname, $branchcode, $flags )
1554           = $sth->fetchrow;
1555
1556         if ( checkpw_hash($password, $stored_hash) ) {
1557
1558             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1559                 $firstname, $surname, $branchcode, $flags );
1560             return 1, $cardnumber, $userid;
1561         }
1562     }
1563     $sth =
1564       $dbh->prepare(
1565 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1566       );
1567     $sth->execute($userid);
1568     if ( $sth->rows ) {
1569         my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1570             $surname, $branchcode, $flags )
1571           = $sth->fetchrow;
1572
1573         if ( checkpw_hash($password, $stored_hash) ) {
1574
1575             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1576                 $firstname, $surname, $branchcode, $flags );
1577             return 1, $cardnumber, $userid;
1578         }
1579     }
1580     if (   $userid && $userid eq C4::Context->config('user')
1581         && "$password" eq C4::Context->config('pass') )
1582     {
1583
1584 # Koha superuser account
1585 #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1586         return 2;
1587     }
1588     if (   $userid && $userid eq 'demo'
1589         && "$password" eq 'demo'
1590         && C4::Context->config('demo') )
1591     {
1592
1593 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1594 # some features won't be effective : modify systempref, modify MARC structure,
1595         return 2;
1596     }
1597     return 0;
1598 }
1599
1600 sub checkpw_hash {
1601     my ( $password, $stored_hash ) = @_;
1602
1603     return if $stored_hash eq '!';
1604
1605     # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1606     my $hash;
1607     if ( substr($stored_hash,0,2) eq '$2') {
1608         $hash = hash_password($password, $stored_hash);
1609     } else {
1610         $hash = md5_base64($password);
1611     }
1612     return $hash eq $stored_hash;
1613 }
1614
1615 =head2 getuserflags
1616
1617     my $authflags = getuserflags($flags, $userid, [$dbh]);
1618
1619 Translates integer flags into permissions strings hash.
1620
1621 C<$flags> is the integer userflags value ( borrowers.userflags )
1622 C<$userid> is the members.userid, used for building subpermissions
1623 C<$authflags> is a hashref of permissions
1624
1625 =cut
1626
1627 sub getuserflags {
1628     my $flags   = shift;
1629     my $userid  = shift;
1630     my $dbh     = @_ ? shift : C4::Context->dbh;
1631     my $userflags;
1632     {
1633         # I don't want to do this, but if someone logs in as the database
1634         # user, it would be preferable not to spam them to death with
1635         # numeric warnings. So, we make $flags numeric.
1636         no warnings 'numeric';
1637         $flags += 0;
1638     }
1639     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1640     $sth->execute;
1641
1642     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1643         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1644             $userflags->{$flag} = 1;
1645         }
1646         else {
1647             $userflags->{$flag} = 0;
1648         }
1649     }
1650     # get subpermissions and merge with top-level permissions
1651     my $user_subperms = get_user_subpermissions($userid);
1652     foreach my $module (keys %$user_subperms) {
1653         next if $userflags->{$module} == 1; # user already has permission for everything in this module
1654         $userflags->{$module} = $user_subperms->{$module};
1655     }
1656
1657     return $userflags;
1658 }
1659
1660 =head2 get_user_subpermissions
1661
1662   $user_perm_hashref = get_user_subpermissions($userid);
1663
1664 Given the userid (note, not the borrowernumber) of a staff user,
1665 return a hashref of hashrefs of the specific subpermissions
1666 accorded to the user.  An example return is
1667
1668  {
1669     tools => {
1670         export_catalog => 1,
1671         import_patrons => 1,
1672     }
1673  }
1674
1675 The top-level hash-key is a module or function code from
1676 userflags.flag, while the second-level key is a code
1677 from permissions.
1678
1679 The results of this function do not give a complete picture
1680 of the functions that a staff user can access; it is also
1681 necessary to check borrowers.flags.
1682
1683 =cut
1684
1685 sub get_user_subpermissions {
1686     my $userid = shift;
1687
1688     my $dbh = C4::Context->dbh;
1689     my $sth = $dbh->prepare("SELECT flag, user_permissions.code
1690                              FROM user_permissions
1691                              JOIN permissions USING (module_bit, code)
1692                              JOIN userflags ON (module_bit = bit)
1693                              JOIN borrowers USING (borrowernumber)
1694                              WHERE userid = ?");
1695     $sth->execute($userid);
1696
1697     my $user_perms = {};
1698     while (my $perm = $sth->fetchrow_hashref) {
1699         $user_perms->{$perm->{'flag'}}->{$perm->{'code'}} = 1;
1700     }
1701     return $user_perms;
1702 }
1703
1704 =head2 get_all_subpermissions
1705
1706   my $perm_hashref = get_all_subpermissions();
1707
1708 Returns a hashref of hashrefs defining all specific
1709 permissions currently defined.  The return value
1710 has the same structure as that of C<get_user_subpermissions>,
1711 except that the innermost hash value is the description
1712 of the subpermission.
1713
1714 =cut
1715
1716 sub get_all_subpermissions {
1717     my $dbh = C4::Context->dbh;
1718     my $sth = $dbh->prepare("SELECT flag, code, description
1719                              FROM permissions
1720                              JOIN userflags ON (module_bit = bit)");
1721     $sth->execute();
1722
1723     my $all_perms = {};
1724     while (my $perm = $sth->fetchrow_hashref) {
1725         $all_perms->{$perm->{'flag'}}->{$perm->{'code'}} = $perm->{'description'};
1726     }
1727     return $all_perms;
1728 }
1729
1730 =head2 haspermission
1731
1732   $flags = ($userid, $flagsrequired);
1733
1734 C<$userid> the userid of the member
1735 C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
1736
1737 Returns member's flags or 0 if a permission is not met.
1738
1739 =cut
1740
1741 sub haspermission {
1742     my ($userid, $flagsrequired) = @_;
1743     my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1744     $sth->execute($userid);
1745     my $row = $sth->fetchrow();
1746     my $flags = getuserflags($row, $userid);
1747     if ( $userid eq C4::Context->config('user') ) {
1748         # Super User Account from /etc/koha.conf
1749         $flags->{'superlibrarian'} = 1;
1750     }
1751     elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
1752         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1753         $flags->{'superlibrarian'} = 1;
1754     }
1755
1756     return $flags if $flags->{superlibrarian};
1757
1758     foreach my $module ( keys %$flagsrequired ) {
1759         my $subperm = $flagsrequired->{$module};
1760         if ($subperm eq '*') {
1761             return 0 unless ( $flags->{$module} == 1 or ref($flags->{$module}) );
1762         } else {
1763             return 0 unless ( $flags->{$module} == 1 or
1764                                 ( ref($flags->{$module}) and
1765                                   exists $flags->{$module}->{$subperm} and
1766                                   $flags->{$module}->{$subperm} == 1
1767                                 )
1768                             );
1769         }
1770     }
1771     return $flags;
1772     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1773 }
1774
1775
1776 sub getborrowernumber {
1777     my ($userid) = @_;
1778     my $userenv = C4::Context->userenv;
1779     if ( defined( $userenv ) && ref( $userenv ) eq 'HASH' && $userenv->{number} ) {
1780         return $userenv->{number};
1781     }
1782     my $dbh = C4::Context->dbh;
1783     for my $field ( 'userid', 'cardnumber' ) {
1784         my $sth =
1785           $dbh->prepare("select borrowernumber from borrowers where $field=?");
1786         $sth->execute($userid);
1787         if ( $sth->rows ) {
1788             my ($bnumber) = $sth->fetchrow;
1789             return $bnumber;
1790         }
1791     }
1792     return 0;
1793 }
1794
1795 sub ParseSearchHistorySession {
1796     my $cgi = shift;
1797     my $sessionID = $cgi->cookie('CGISESSID');
1798     return () unless $sessionID;
1799     my $session = get_session($sessionID);
1800     return () unless $session and $session->param('search_history');
1801     my $obj = eval { decode_json(uri_unescape($session->param('search_history'))) };
1802     return () unless defined $obj;
1803     return () unless ref $obj eq 'ARRAY';
1804     return @{ $obj };
1805 }
1806
1807 sub SetSearchHistorySession {
1808     my ($cgi, $search_history) = @_;
1809     my $sessionID = $cgi->cookie('CGISESSID');
1810     return () unless $sessionID;
1811     my $session = get_session($sessionID);
1812     return () unless $session;
1813     $session->param('search_history', uri_escape(encode_json($search_history)));
1814 }
1815
1816 END { }    # module clean-up code here (global destructor)
1817 1;
1818 __END__
1819
1820 =head1 SEE ALSO
1821
1822 CGI(3)
1823
1824 C4::Output(3)
1825
1826 Crypt::Eksblowfish::Bcrypt(3)
1827
1828 Digest::MD5(3)
1829
1830 =cut