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