C4/Auth.pm

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