C4/Auth.pm

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