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