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