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