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