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