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