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