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