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