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