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                                                 -HttpOnly => 1,
 272                                                 -expires => ''
 273                                              );
 274                                         $cookie = [$cookie, $newsearchcookie];
 275                                 }
 276                         }
 277                 }
 278     }
 279         else {  # if this is an anonymous session, setup to display public lists...
 280
 281         $template->param( sessionID        => $sessionID );
 282
 283         my ($total, $pubshelves) = C4::VirtualShelves::GetSomeShelfNames(undef, 'MASTHEAD');
 284         $template->param(
 285             pubshelves     => $total->{pubtotal},
 286             pubshelvesloop => $pubshelves,
 287         );
 288     }
 289         # Anonymous opac search history
 290         # If opac search history is enabled and at least one search has already been performed
 291         if (C4::Context->preference('EnableOpacSearchHistory')) {
 292                 my $searchcookie = $in->{'query'}->cookie('KohaOpacRecentSearches');
 293                 if ($searchcookie){
 294                         $searchcookie = uri_unescape($searchcookie);
 295                         my @recentSearches = @{thaw($searchcookie) || []};
 296             # We show the link in opac
 297                         if (@recentSearches) {
 298                                 $template->param(ShowOpacRecentSearchLink => 1);
 299                         }
 300             }
 301         }
 302
 303     if(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(
1140                     -name  => 'CGISESSID',
1141                     -value => $session->id,
1142                     -HttpOnly => 1,
1143                 );
1144                 $session->param('lasttime',time());
1145                 my $flags = haspermission($userid, $flagsrequired);
1146                 if ($flags) {
1147                     return ("ok", $cookie, $sessionID);
1148                 } else {
1149                     $session->delete();
1150                     C4::Context->_unset_userenv($sessionID);
1151                     $userid    = undef;
1152                     $sessionID = undef;
1153                     return ("failed", undef, undef);
1154                 }
1155             }
1156         } else {
1157             return ("expired", undef, undef);
1158         }
1159     } else {
1160         # new login
1161         my $userid = $query->param('userid');
1162         my $password = $query->param('password');
1163         my ($return, $cardnumber);
1164
1165         # Proxy CAS auth
1166         if ($cas && $query->param('PT')) {
1167             my $retuserid;
1168             $debug and print STDERR "## check_api_auth - checking CAS\n";
1169             # In case of a CAS authentication, we use the ticket instead of the password
1170             my $PT = $query->param('PT');
1171             ($return,$cardnumber,$userid) = check_api_auth_cas($dbh, $PT, $query);    # EXTERNAL AUTH
1172         } else {
1173             # User / password auth
1174             unless ($userid and $password) {
1175                 # caller did something wrong, fail the authenticateion
1176                 return ("failed", undef, undef);
1177             }
1178             ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password, $query );
1179         }
1180
1181         if ($return and haspermission(  $userid, $flagsrequired)) {
1182             my $session = get_session("");
1183             return ("failed", undef, undef) unless $session;
1184
1185             my $sessionID = $session->id;
1186             C4::Context->_new_userenv($sessionID);
1187             my $cookie = $query->cookie(
1188                 -name  => 'CGISESSID',
1189                 -value => $sessionID,
1190                 -HttpOnly => 1,
1191             );
1192             if ( $return == 1 ) {
1193                 my (
1194                     $borrowernumber, $firstname,  $surname,
1195                     $userflags,      $branchcode, $branchname,
1196                     $branchprinter,  $emailaddress
1197                 );
1198                 my $sth =
1199                   $dbh->prepare(
1200 "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=?"
1201                   );
1202                 $sth->execute($userid);
1203                 (
1204                     $borrowernumber, $firstname,  $surname,
1205                     $userflags,      $branchcode, $branchname,
1206                     $branchprinter,  $emailaddress
1207                 ) = $sth->fetchrow if ( $sth->rows );
1208
1209                 unless ($sth->rows ) {
1210                     my $sth = $dbh->prepare(
1211 "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=?"
1212                       );
1213                     $sth->execute($cardnumber);
1214                     (
1215                         $borrowernumber, $firstname,  $surname,
1216                         $userflags,      $branchcode, $branchname,
1217                         $branchprinter,  $emailaddress
1218                     ) = $sth->fetchrow if ( $sth->rows );
1219
1220                     unless ( $sth->rows ) {
1221                         $sth->execute($userid);
1222                         (
1223                             $borrowernumber, $firstname, $surname, $userflags,
1224                             $branchcode, $branchname, $branchprinter, $emailaddress
1225                         ) = $sth->fetchrow if ( $sth->rows );
1226                     }
1227                 }
1228
1229                 my $ip       = $ENV{'REMOTE_ADDR'};
1230                 # if they specify at login, use that
1231                 if ($query->param('branch')) {
1232                     $branchcode  = $query->param('branch');
1233                     $branchname = GetBranchName($branchcode);
1234                 }
1235                 my $branches = GetBranches();
1236                 my @branchesloop;
1237                 foreach my $br ( keys %$branches ) {
1238                     #     now we work with the treatment of ip
1239                     my $domain = $branches->{$br}->{'branchip'};
1240                     if ( $domain && $ip =~ /^$domain/ ) {
1241                         $branchcode = $branches->{$br}->{'branchcode'};
1242
1243                         # new op dev : add the branchprinter and branchname in the cookie
1244                         $branchprinter = $branches->{$br}->{'branchprinter'};
1245                         $branchname    = $branches->{$br}->{'branchname'};
1246                     }
1247                 }
1248                 $session->param('number',$borrowernumber);
1249                 $session->param('id',$userid);
1250                 $session->param('cardnumber',$cardnumber);
1251                 $session->param('firstname',$firstname);
1252                 $session->param('surname',$surname);
1253                 $session->param('branch',$branchcode);
1254                 $session->param('branchname',$branchname);
1255                 $session->param('flags',$userflags);
1256                 $session->param('emailaddress',$emailaddress);
1257                 $session->param('ip',$session->remote_addr());
1258                 $session->param('lasttime',time());
1259             } elsif ( $return == 2 ) {
1260                 #We suppose the user is the superlibrarian
1261                 $session->param('number',0);
1262                 $session->param('id',C4::Context->config('user'));
1263                 $session->param('cardnumber',C4::Context->config('user'));
1264                 $session->param('firstname',C4::Context->config('user'));
1265                 $session->param('surname',C4::Context->config('user'));
1266                 $session->param('branch','NO_LIBRARY_SET');
1267                 $session->param('branchname','NO_LIBRARY_SET');
1268                 $session->param('flags',1);
1269                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
1270                 $session->param('ip',$session->remote_addr());
1271                 $session->param('lasttime',time());
1272             }
1273             C4::Context::set_userenv(
1274                 $session->param('number'),       $session->param('id'),
1275                 $session->param('cardnumber'),   $session->param('firstname'),
1276                 $session->param('surname'),      $session->param('branch'),
1277                 $session->param('branchname'),   $session->param('flags'),
1278                 $session->param('emailaddress'), $session->param('branchprinter')
1279             );
1280             return ("ok", $cookie, $sessionID);
1281         } else {
1282             return ("failed", undef, undef);
1283         }
1284     }
1285 }
1286
1287 =head2 check_cookie_auth
1288
1289   ($status, $sessionId) = check_api_auth($cookie, $userflags);
1290
1291 Given a CGISESSID cookie set during a previous login to Koha, determine
1292 if the user has the privileges specified by C<$userflags>.
1293
1294 C<check_cookie_auth> is meant for authenticating special services
1295 such as tools/upload-file.pl that are invoked by other pages that
1296 have been authenticated in the usual way.
1297
1298 Possible return values in C<$status> are:
1299
1300 =over
1301
1302 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1303
1304 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1305
1306 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1307
1308 =item "expired -- session cookie has expired; API user should resubmit userid and password
1309
1310 =back
1311
1312 =cut
1313
1314 sub check_cookie_auth {
1315     my $cookie = shift;
1316     my $flagsrequired = shift;
1317
1318     my $dbh     = C4::Context->dbh;
1319     my $timeout = _timeout_syspref();
1320
1321     unless (C4::Context->preference('Version')) {
1322         # database has not been installed yet
1323         return ("maintenance", undef);
1324     }
1325     my $kohaversion=C4::Context::KOHAVERSION;
1326     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1327     if (C4::Context->preference('Version') < $kohaversion) {
1328         # database in need of version update; assume that
1329         # no API should be called while databsae is in
1330         # this condition.
1331         return ("maintenance", undef);
1332     }
1333
1334     # FIXME -- most of what follows is a copy-and-paste
1335     # of code from checkauth.  There is an obvious need
1336     # for refactoring to separate the various parts of
1337     # the authentication code, but as of 2007-11-23 this
1338     # is deferred so as to not introduce bugs into the
1339     # regular authentication code for Koha 3.0.
1340
1341     # see if we have a valid session cookie already
1342     # however, if a userid parameter is present (i.e., from
1343     # a form submission, assume that any current cookie
1344     # is to be ignored
1345     unless (defined $cookie and $cookie) {
1346         return ("failed", undef);
1347     }
1348     my $sessionID = $cookie;
1349     my $session = get_session($sessionID);
1350     C4::Context->_new_userenv($sessionID);
1351     if ($session) {
1352         C4::Context::set_userenv(
1353             $session->param('number'),       $session->param('id'),
1354             $session->param('cardnumber'),   $session->param('firstname'),
1355             $session->param('surname'),      $session->param('branch'),
1356             $session->param('branchname'),   $session->param('flags'),
1357             $session->param('emailaddress'), $session->param('branchprinter')
1358         );
1359
1360         my $ip = $session->param('ip');
1361         my $lasttime = $session->param('lasttime');
1362         my $userid = $session->param('id');
1363         if ( $lasttime < time() - $timeout ) {
1364             # time out
1365             $session->delete();
1366             C4::Context->_unset_userenv($sessionID);
1367             $userid    = undef;
1368             $sessionID = undef;
1369             return ("expired", undef);
1370         } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1371             # IP address changed
1372             $session->delete();
1373             C4::Context->_unset_userenv($sessionID);
1374             $userid    = undef;
1375             $sessionID = undef;
1376             return ("expired", undef);
1377         } else {
1378             $session->param('lasttime',time());
1379             my $flags = haspermission($userid, $flagsrequired);
1380             if ($flags) {
1381                 return ("ok", $sessionID);
1382             } else {
1383                 $session->delete();
1384                 C4::Context->_unset_userenv($sessionID);
1385                 $userid    = undef;
1386                 $sessionID = undef;
1387                 return ("failed", undef);
1388             }
1389         }
1390     } else {
1391         return ("expired", undef);
1392     }
1393 }
1394
1395 =head2 get_session
1396
1397   use CGI::Session;
1398   my $session = get_session($sessionID);
1399
1400 Given a session ID, retrieve the CGI::Session object used to store
1401 the session's state.  The session object can be used to store
1402 data that needs to be accessed by different scripts during a
1403 user's session.
1404
1405 If the C<$sessionID> parameter is an empty string, a new session
1406 will be created.
1407
1408 =cut
1409
1410 sub get_session {
1411     my $sessionID = shift;
1412     my $storage_method = C4::Context->preference('SessionStorage');
1413     my $dbh = C4::Context->dbh;
1414     my $session;
1415     if ($storage_method eq 'mysql'){
1416         $session = new CGI::Session("driver:MySQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1417     }
1418     elsif ($storage_method eq 'Pg') {
1419         $session = new CGI::Session("driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1420     }
1421     elsif ($storage_method eq 'memcached' && C4::Context->ismemcached){
1422         $session = new CGI::Session("driver:memcached;serializer:yaml;id:md5", $sessionID, { Memcached => C4::Context->memcached } );
1423     }
1424     else {
1425         # catch all defaults to tmp should work on all systems
1426         $session = new CGI::Session("driver:File;serializer:yaml;id:md5", $sessionID, {Directory=>'/tmp'});
1427     }
1428     return $session;
1429 }
1430
1431 sub checkpw {
1432
1433     my ( $dbh, $userid, $password, $query ) = @_;
1434     if ($ldap) {
1435         $debug and print STDERR "## checkpw - checking LDAP\n";
1436         my ($retval,$retcard,$retuserid) = checkpw_ldap(@_);    # EXTERNAL AUTH
1437         ($retval) and return ($retval,$retcard,$retuserid);
1438     }
1439
1440     if ($cas && $query && $query->param('ticket')) {
1441         $debug and print STDERR "## checkpw - checking CAS\n";
1442         # In case of a CAS authentication, we use the ticket instead of the password
1443         my $ticket = $query->param('ticket');
1444         my ($retval,$retcard,$retuserid) = checkpw_cas($dbh, $ticket, $query);    # EXTERNAL AUTH
1445         ($retval) and return ($retval,$retcard,$retuserid);
1446         return 0;
1447     }
1448
1449     # INTERNAL AUTH
1450     my $sth =
1451       $dbh->prepare(
1452 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1453       );
1454     $sth->execute($userid);
1455     if ( $sth->rows ) {
1456         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1457             $surname, $branchcode, $flags )
1458           = $sth->fetchrow;
1459         if ( md5_base64($password) eq $md5password and $md5password ne "!") {
1460
1461             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1462                 $firstname, $surname, $branchcode, $flags );
1463             return 1, $cardnumber, $userid;
1464         }
1465     }
1466     $sth =
1467       $dbh->prepare(
1468 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1469       );
1470     $sth->execute($userid);
1471     if ( $sth->rows ) {
1472         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1473             $surname, $branchcode, $flags )
1474           = $sth->fetchrow;
1475         if ( md5_base64($password) eq $md5password ) {
1476
1477             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1478                 $firstname, $surname, $branchcode, $flags );
1479             return 1, $cardnumber, $userid;
1480         }
1481     }
1482     if (   $userid && $userid eq C4::Context->config('user')
1483         && "$password" eq C4::Context->config('pass') )
1484     {
1485
1486 # Koha superuser account
1487 #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1488         return 2;
1489     }
1490     if (   $userid && $userid eq 'demo'
1491         && "$password" eq 'demo'
1492         && C4::Context->config('demo') )
1493     {
1494
1495 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1496 # some features won't be effective : modify systempref, modify MARC structure,
1497         return 2;
1498     }
1499     return 0;
1500 }
1501
1502 =head2 getuserflags
1503
1504     my $authflags = getuserflags($flags, $userid, [$dbh]);
1505
1506 Translates integer flags into permissions strings hash.
1507
1508 C<$flags> is the integer userflags value ( borrowers.userflags )
1509 C<$userid> is the members.userid, used for building subpermissions
1510 C<$authflags> is a hashref of permissions
1511
1512 =cut
1513
1514 sub getuserflags {
1515     my $flags   = shift;
1516     my $userid  = shift;
1517     my $dbh     = @_ ? shift : C4::Context->dbh;
1518     my $userflags;
1519     {
1520         # I don't want to do this, but if someone logs in as the database
1521         # user, it would be preferable not to spam them to death with
1522         # numeric warnings. So, we make $flags numeric.
1523         no warnings 'numeric';
1524         $flags += 0;
1525     }
1526     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1527     $sth->execute;
1528
1529     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1530         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1531             $userflags->{$flag} = 1;
1532         }
1533         else {
1534             $userflags->{$flag} = 0;
1535         }
1536     }
1537
1538     # get subpermissions and merge with top-level permissions
1539     my $user_subperms = get_user_subpermissions($userid);
1540     foreach my $module (keys %$user_subperms) {
1541         next if $userflags->{$module} == 1; # user already has permission for everything in this module
1542         $userflags->{$module} = $user_subperms->{$module};
1543     }
1544
1545     return $userflags;
1546 }
1547
1548 =head2 get_user_subpermissions
1549
1550   $user_perm_hashref = get_user_subpermissions($userid);
1551
1552 Given the userid (note, not the borrowernumber) of a staff user,
1553 return a hashref of hashrefs of the specific subpermissions
1554 accorded to the user.  An example return is
1555
1556  {
1557     tools => {
1558         export_catalog => 1,
1559         import_patrons => 1,
1560     }
1561  }
1562
1563 The top-level hash-key is a module or function code from
1564 userflags.flag, while the second-level key is a code
1565 from permissions.
1566
1567 The results of this function do not give a complete picture
1568 of the functions that a staff user can access; it is also
1569 necessary to check borrowers.flags.
1570
1571 =cut
1572
1573 sub get_user_subpermissions {
1574     my $userid = shift;
1575
1576     my $dbh = C4::Context->dbh;
1577     my $sth = $dbh->prepare("SELECT flag, user_permissions.code
1578                              FROM user_permissions
1579                              JOIN permissions USING (module_bit, code)
1580                              JOIN userflags ON (module_bit = bit)
1581                              JOIN borrowers USING (borrowernumber)
1582                              WHERE userid = ?");
1583     $sth->execute($userid);
1584
1585     my $user_perms = {};
1586     while (my $perm = $sth->fetchrow_hashref) {
1587         $user_perms->{$perm->{'flag'}}->{$perm->{'code'}} = 1;
1588     }
1589     return $user_perms;
1590 }
1591
1592 =head2 get_all_subpermissions
1593
1594   my $perm_hashref = get_all_subpermissions();
1595
1596 Returns a hashref of hashrefs defining all specific
1597 permissions currently defined.  The return value
1598 has the same structure as that of C<get_user_subpermissions>,
1599 except that the innermost hash value is the description
1600 of the subpermission.
1601
1602 =cut
1603
1604 sub get_all_subpermissions {
1605     my $dbh = C4::Context->dbh;
1606     my $sth = $dbh->prepare("SELECT flag, code, description
1607                              FROM permissions
1608                              JOIN userflags ON (module_bit = bit)");
1609     $sth->execute();
1610
1611     my $all_perms = {};
1612     while (my $perm = $sth->fetchrow_hashref) {
1613         $all_perms->{$perm->{'flag'}}->{$perm->{'code'}} = $perm->{'description'};
1614     }
1615     return $all_perms;
1616 }
1617
1618 =head2 haspermission
1619
1620   $flags = ($userid, $flagsrequired);
1621
1622 C<$userid> the userid of the member
1623 C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
1624
1625 Returns member's flags or 0 if a permission is not met.
1626
1627 =cut
1628
1629 sub haspermission {
1630     my ($userid, $flagsrequired) = @_;
1631     my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1632     $sth->execute($userid);
1633     my $flags = getuserflags($sth->fetchrow(), $userid);
1634     if ( $userid eq C4::Context->config('user') ) {
1635         # Super User Account from /etc/koha.conf
1636         $flags->{'superlibrarian'} = 1;
1637     }
1638     elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
1639         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1640         $flags->{'superlibrarian'} = 1;
1641     }
1642
1643     return $flags if $flags->{superlibrarian};
1644
1645     foreach my $module ( keys %$flagsrequired ) {
1646         my $subperm = $flagsrequired->{$module};
1647         if ($subperm eq '*') {
1648             return 0 unless ( $flags->{$module} == 1 or ref($flags->{$module}) );
1649         } else {
1650             return 0 unless ( $flags->{$module} == 1 or
1651                                 ( ref($flags->{$module}) and
1652                                   exists $flags->{$module}->{$subperm} and
1653                                   $flags->{$module}->{$subperm} == 1
1654                                 )
1655                             );
1656         }
1657     }
1658     return $flags;
1659     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1660 }
1661
1662
1663 sub getborrowernumber {
1664     my ($userid) = @_;
1665     my $userenv = C4::Context->userenv;
1666     if ( defined( $userenv ) && ref( $userenv ) eq 'HASH' && $userenv->{number} ) {
1667         return $userenv->{number};
1668     }
1669     my $dbh = C4::Context->dbh;
1670     for my $field ( 'userid', 'cardnumber' ) {
1671         my $sth =
1672           $dbh->prepare("select borrowernumber from borrowers where $field=?");
1673         $sth->execute($userid);
1674         if ( $sth->rows ) {
1675             my ($bnumber) = $sth->fetchrow;
1676             return $bnumber;
1677         }
1678     }
1679     return 0;
1680 }
1681
1682
1683 END { }    # module clean-up code here (global destructor)
1684 1;
1685 __END__
1686
1687 =head1 SEE ALSO
1688
1689 CGI(3)
1690
1691 C4::Output(3)
1692
1693 Digest::MD5(3)
1694
1695 =cut