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