C4/Auth.pm

   1 package C4::Auth;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use strict;
  21 #use warnings; FIXME - Bug 2505
  22 use Digest::MD5 qw(md5_base64);
  23 use Storable qw(thaw freeze);
  24 use URI::Escape;
  25 use CGI::Session;
  26
  27 require Exporter;
  28 use C4::Context;
  29 use C4::Templates;    # to get the template
  30 use C4::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 sub get_template_and_user {
 133     my $in       = shift;
 134     my $template =
 135       C4::Templates::gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
 136     my ( $user, $cookie, $sessionID, $flags );
 137     if ( $in->{'template_name'} !~m/maintenance/ ) {
 138         ( $user, $cookie, $sessionID, $flags ) = checkauth(
 139             $in->{'query'},
 140             $in->{'authnotrequired'},
 141             $in->{'flagsrequired'},
 142             $in->{'type'}
 143         );
 144     }
 145
 146     my $borrowernumber;
 147     my $insecure = C4::Context->preference('insecure');
 148     if ($user or $insecure) {
 149         # It's possible for $user to be the borrowernumber if they don't have a
 150         # userid defined (and are logging in through some other method, such
 151         # as SSL certs against an email address)
 152         $borrowernumber = getborrowernumber($user) if defined($user);
 153         if (!defined($borrowernumber) && defined($user)) {
 154                 my $borrower = GetMember(borrowernumber => $user);
 155                 if ($borrower) {
 156                 $borrowernumber = $user;
 157                 # A bit of a hack, but I don't know there's a nicer way
 158                 # to do it.
 159                 $user = $borrower->{firstname} . ' ' . $borrower->{surname};
 160             }
 161         }
 162
 163         # user info
 164         $template->param( loggedinusername => $user );
 165         $template->param( sessionID        => $sessionID );
 166
 167         my ($total, $pubshelves, $barshelves) = C4::VirtualShelves::GetSomeShelfNames($borrowernumber, 'MASTHEAD');
 168         $template->param(
 169             pubshelves     => $total->{pubtotal},
 170             pubshelvesloop => $pubshelves,
 171             barshelves      => $total->{bartotal},
 172             barshelvesloop  => $barshelves,
 173         );
 174
 175         require C4::Members;
 176         my ( $borr ) = C4::Members::GetMemberDetails( $borrowernumber );
 177         my @bordat;
 178         $bordat[0] = $borr;
 179         $template->param( "USER_INFO" => \@bordat );
 180
 181         my $all_perms = get_all_subpermissions();
 182
 183         my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
 184                             editcatalogue updatecharges management tools editauthorities serials reports acquisition);
 185         # We are going to use the $flags returned by checkauth
 186         # to create the template's parameters that will indicate
 187         # which menus the user can access.
 188         if (( $flags && $flags->{superlibrarian}==1) or $insecure==1) {
 189             $template->param( CAN_user_circulate        => 1 );
 190             $template->param( CAN_user_catalogue        => 1 );
 191             $template->param( CAN_user_parameters       => 1 );
 192             $template->param( CAN_user_borrowers        => 1 );
 193             $template->param( CAN_user_permissions      => 1 );
 194             $template->param( CAN_user_reserveforothers => 1 );
 195             $template->param( CAN_user_borrow           => 1 );
 196             $template->param( CAN_user_editcatalogue    => 1 );
 197             $template->param( CAN_user_updatecharges     => 1 );
 198             $template->param( CAN_user_acquisition      => 1 );
 199             $template->param( CAN_user_management       => 1 );
 200             $template->param( CAN_user_tools            => 1 );
 201             $template->param( CAN_user_editauthorities  => 1 );
 202             $template->param( CAN_user_serials          => 1 );
 203             $template->param( CAN_user_reports          => 1 );
 204             $template->param( CAN_user_staffaccess      => 1 );
 205             foreach my $module (keys %$all_perms) {
 206                 foreach my $subperm (keys %{ $all_perms->{$module} }) {
 207                     $template->param( "CAN_user_${module}_${subperm}" => 1 );
 208                 }
 209             }
 210         }
 211
 212         if ( $flags ) {
 213             foreach my $module (keys %$all_perms) {
 214                 if ( $flags->{$module} == 1) {
 215                     foreach my $subperm (keys %{ $all_perms->{$module} }) {
 216                         $template->param( "CAN_user_${module}_${subperm}" => 1 );
 217                     }
 218                 } elsif ( ref($flags->{$module}) ) {
 219                     foreach my $subperm (keys %{ $flags->{$module} } ) {
 220                         $template->param( "CAN_user_${module}_${subperm}" => 1 );
 221                     }
 222                 }
 223             }
 224         }
 225
 226         if ($flags) {
 227             foreach my $module (keys %$flags) {
 228                 if ( $flags->{$module} == 1 or ref($flags->{$module}) ) {
 229                     $template->param( "CAN_user_$module" => 1 );
 230                     if ($module eq "parameters") {
 231                         $template->param( CAN_user_management => 1 );
 232                     }
 233                 }
 234             }
 235         }
 236                 # Logged-in opac search history
 237                 # If the requested template is an opac one and opac search history is enabled
 238                 if ($in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory')) {
 239                         my $dbh = C4::Context->dbh;
 240                         my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
 241                         my $sth = $dbh->prepare($query);
 242                         $sth->execute($borrowernumber);
 243
 244                         # If at least one search has already been performed
 245                         if ($sth->fetchrow_array > 0) {
 246                         # We show the link in opac
 247                         $template->param(ShowOpacRecentSearchLink => 1);
 248                         }
 249
 250                         # And if there's a cookie with searches performed when the user was not logged in,
 251                         # we add them to the logged-in search history
 252                         my $searchcookie = $in->{'query'}->cookie('KohaOpacRecentSearches');
 253                         if ($searchcookie){
 254                                 $searchcookie = uri_unescape($searchcookie);
 255                                 my @recentSearches = @{thaw($searchcookie) || []};
 256                                 if (@recentSearches) {
 257                                         my $sth = $dbh->prepare($SEARCH_HISTORY_INSERT_SQL);
 258                                         $sth->execute( $borrowernumber,
 259                                                        $in->{'query'}->cookie("CGISESSID"),
 260                                                        $_->{'query_desc'},
 261                                                        $_->{'query_cgi'},
 262                                                        $_->{'total'},
 263                                                        $_->{'time'},
 264                             ) foreach @recentSearches;
 265
 266                                         # And then, delete the cookie's content
 267                                         my $newsearchcookie = $in->{'query'}->cookie(
 268                                                                                                 -name => 'KohaOpacRecentSearches',
 269                                                                                                 -value => freeze([]),
 270                                                                                                 -expires => ''
 271                                                                                          );
 272                                         $cookie = [$cookie, $newsearchcookie];
 273                                 }
 274                         }
 275                 }
 276     }
 277         else {  # if this is an anonymous session, setup to display public lists...
 278
 279         $template->param( sessionID        => $sessionID );
 280
 281         my ($total, $pubshelves) = C4::VirtualShelves::GetSomeShelfNames(undef, 'MASTHEAD');
 282         $template->param(
 283             pubshelves     => $total->{pubtotal},
 284             pubshelvesloop => $pubshelves,
 285         );
 286     }
 287         # Anonymous opac search history
 288         # If opac search history is enabled and at least one search has already been performed
 289         if (C4::Context->preference('EnableOpacSearchHistory')) {
 290                 my $searchcookie = $in->{'query'}->cookie('KohaOpacRecentSearches');
 291                 if ($searchcookie){
 292                         $searchcookie = uri_unescape($searchcookie);
 293                         my @recentSearches = @{thaw($searchcookie) || []};
 294             # We show the link in opac
 295                         if (@recentSearches) {
 296                                 $template->param(ShowOpacRecentSearchLink => 1);
 297                         }
 298             }
 299         }
 300
 301     if(C4::Context->preference('dateformat')){
 302         if(C4::Context->preference('dateformat') eq "metric"){
 303             $template->param(dateformat_metric => 1);
 304         } elsif(C4::Context->preference('dateformat') eq "us"){
 305             $template->param(dateformat_us => 1);
 306         } else {
 307             $template->param(dateformat_iso => 1);
 308         }
 309     } else {
 310         $template->param(dateformat_iso => 1);
 311     }
 312
 313     # these template parameters are set the same regardless of $in->{'type'}
 314     $template->param(
 315             "BiblioDefaultView".C4::Context->preference("BiblioDefaultView")         => 1,
 316             EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
 317             GoogleJackets                => C4::Context->preference("GoogleJackets"),
 318             OpenLibraryCovers            => C4::Context->preference("OpenLibraryCovers"),
 319             KohaAdminEmailAddress        => "" . C4::Context->preference("KohaAdminEmailAddress"),
 320             LoginBranchcode              => (C4::Context->userenv?C4::Context->userenv->{"branch"}:"insecure"),
 321             LoginFirstname               => (C4::Context->userenv?C4::Context->userenv->{"firstname"}:"Bel"),
 322             LoginSurname                 => C4::Context->userenv?C4::Context->userenv->{"surname"}:"Inconnu",
 323             TagsEnabled                  => C4::Context->preference("TagsEnabled"),
 324             hide_marc                    => C4::Context->preference("hide_marc"),
 325             item_level_itypes            => C4::Context->preference('item-level_itypes'),
 326             patronimages                 => C4::Context->preference("patronimages"),
 327             singleBranchMode             => C4::Context->preference("singleBranchMode"),
 328             XSLTDetailsDisplay           => C4::Context->preference("XSLTDetailsDisplay"),
 329             XSLTResultsDisplay           => C4::Context->preference("XSLTResultsDisplay"),
 330             using_https                  => $in->{'query'}->https() ? 1 : 0,
 331             noItemTypeImages            => C4::Context->preference("noItemTypeImages"),
 332     );
 333
 334     if ( $in->{'type'} eq "intranet" ) {
 335         $template->param(
 336             AmazonContent               => C4::Context->preference("AmazonContent"),
 337             AmazonCoverImages           => C4::Context->preference("AmazonCoverImages"),
 338             AmazonEnabled               => C4::Context->preference("AmazonEnabled"),
 339             AmazonSimilarItems          => C4::Context->preference("AmazonSimilarItems"),
 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         );
 368     }
 369     else {
 370         warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
 371         #TODO : replace LibraryName syspref with 'system name', and remove this html processing
 372         my $LibraryNameTitle = C4::Context->preference("LibraryName");
 373         $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
 374         $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
 375         # clean up the busc param in the session if the page is not opac-detail
 376         if (C4::Context->preference("OpacBrowseResults") && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ && $1 !~ /^(?:MARC|ISBD)?detail$/) {
 377             my $sessionSearch = get_session($sessionID || $in->{'query'}->cookie("CGISESSID"));
 378             $sessionSearch->clear(["busc"]) if ($sessionSearch->param("busc"));
 379         }
 380         # variables passed from CGI: opac_css_override and opac_search_limits.
 381         my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
 382         my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
 383         my $opac_name = '';
 384         if (($opac_search_limit =~ /branch:(\w+)/ && $opac_limit_override) || $in->{'query'}->param('limit') =~ /branch:(\w+)/){
 385             $opac_name = $1;   # opac_search_limit is a branch, so we use it.
 386         } elsif (C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'}) {
 387             $opac_name = C4::Context->userenv->{'branch'};
 388         }
 389         my $checkstyle = C4::Context->preference("opaccolorstylesheet");
 390         if ($checkstyle =~ /http/)
 391         {
 392                 $template->param( opacexternalsheet => $checkstyle);
 393         } else
 394         {
 395                 my $opaccolorstylesheet = C4::Context->preference("opaccolorstylesheet");
 396             $template->param( opaccolorstylesheet => $opaccolorstylesheet);
 397         }
 398         $template->param(
 399             AmazonContent             => "" . C4::Context->preference("AmazonContent"),
 400             AnonSuggestions           => "" . C4::Context->preference("AnonSuggestions"),
 401             AuthorisedValueImages     => C4::Context->preference("AuthorisedValueImages"),
 402             BranchesLoop              => GetBranchesLoop($opac_name),
 403             CalendarFirstDayOfWeek      => (C4::Context->preference("CalendarFirstDayOfWeek") eq "Sunday")?0:1,
 404             LibraryName               => "" . C4::Context->preference("LibraryName"),
 405             LibraryNameTitle          => "" . $LibraryNameTitle,
 406             LoginBranchname           => C4::Context->userenv?C4::Context->userenv->{"branchname"}:"",
 407             OPACAmazonEnabled         => C4::Context->preference("OPACAmazonEnabled"),
 408             OPACAmazonSimilarItems    => C4::Context->preference("OPACAmazonSimilarItems"),
 409             OPACAmazonCoverImages     => C4::Context->preference("OPACAmazonCoverImages"),
 410             OPACAmazonReviews         => C4::Context->preference("OPACAmazonReviews"),
 411             OPACFRBRizeEditions       => C4::Context->preference("OPACFRBRizeEditions"),
 412             OpacHighlightedWords       => C4::Context->preference("OpacHighlightedWords"),
 413             OPACItemHolds             => C4::Context->preference("OPACItemHolds"),
 414             OPACShelfBrowser          => "". C4::Context->preference("OPACShelfBrowser"),
 415             OpacShowRecentComments    => C4::Context->preference("OpacShowRecentComments"),
 416             OPACURLOpenInNewWindow    => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
 417             OPACUserCSS               => "". C4::Context->preference("OPACUserCSS"),
 418             OPACViewOthersSuggestions => "" . C4::Context->preference("OPACViewOthersSuggestions"),
 419             OpacAuthorities           => C4::Context->preference("OpacAuthorities"),
 420             OPACBaseURL               => ($in->{'query'}->https() ? "https://" : "http://") . $ENV{'SERVER_NAME'} .
 421                    ($ENV{'SERVER_PORT'} eq ($in->{'query'}->https() ? "443" : "80") ? '' : ":$ENV{'SERVER_PORT'}"),
 422             opac_css_override           => $ENV{'OPAC_CSS_OVERRIDE'},
 423             opac_search_limit         => $opac_search_limit,
 424             opac_limit_override       => $opac_limit_override,
 425             OpacBrowser               => C4::Context->preference("OpacBrowser"),
 426             OpacCloud                 => C4::Context->preference("OpacCloud"),
 427             OpacKohaUrl               => C4::Context->preference("OpacKohaUrl"),
 428             OpacMainUserBlock         => "" . C4::Context->preference("OpacMainUserBlock"),
 429             OpacNav                   => "" . C4::Context->preference("OpacNav"),
 430             OpacNavBottom             => "" . C4::Context->preference("OpacNavBottom"),
 431             OpacPasswordChange        => C4::Context->preference("OpacPasswordChange"),
 432             OPACPatronDetails        => C4::Context->preference("OPACPatronDetails"),
 433             OPACPrivacy               => C4::Context->preference("OPACPrivacy"),
 434             OPACFinesTab              => C4::Context->preference("OPACFinesTab"),
 435             OpacTopissue              => C4::Context->preference("OpacTopissue"),
 436             RequestOnOpac             => C4::Context->preference("RequestOnOpac"),
 437             'Version'                 => C4::Context->preference('Version'),
 438             hidelostitems             => C4::Context->preference("hidelostitems"),
 439             mylibraryfirst            => (C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv) ? C4::Context->userenv->{'branch'} : '',
 440             opaclayoutstylesheet      => "" . C4::Context->preference("opaclayoutstylesheet"),
 441             opacstylesheet            => "" . C4::Context->preference("opacstylesheet"),
 442             opacbookbag               => "" . C4::Context->preference("opacbookbag"),
 443             opaccredits               => "" . C4::Context->preference("opaccredits"),
 444             OpacFavicon               => C4::Context->preference("OpacFavicon"),
 445             opacheader                => "" . C4::Context->preference("opacheader"),
 446             opaclanguagesdisplay      => "" . C4::Context->preference("opaclanguagesdisplay"),
 447             opacreadinghistory        => C4::Context->preference("opacreadinghistory"),
 448             opacsmallimage            => "" . C4::Context->preference("opacsmallimage"),
 449             opacuserjs                => C4::Context->preference("opacuserjs"),
 450             opacuserlogin             => "" . C4::Context->preference("opacuserlogin"),
 451             reviewson                 => C4::Context->preference("reviewson"),
 452             ShowReviewer              => C4::Context->preference("ShowReviewer"),
 453             ShowReviewerPhoto         => C4::Context->preference("ShowReviewerPhoto"),
 454             suggestion                => "" . C4::Context->preference("suggestion"),
 455             virtualshelves            => "" . C4::Context->preference("virtualshelves"),
 456             OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
 457             OpacAddMastheadLibraryPulldown => C4::Context->preference("OpacAddMastheadLibraryPulldown"),
 458             OPACXSLTDetailsDisplay           => C4::Context->preference("OPACXSLTDetailsDisplay"),
 459             OPACXSLTResultsDisplay           => C4::Context->preference("OPACXSLTResultsDisplay"),
 460             SyndeticsClientCode          => C4::Context->preference("SyndeticsClientCode"),
 461             SyndeticsEnabled             => C4::Context->preference("SyndeticsEnabled"),
 462             SyndeticsCoverImages         => C4::Context->preference("SyndeticsCoverImages"),
 463             SyndeticsTOC                 => C4::Context->preference("SyndeticsTOC"),
 464             SyndeticsSummary             => C4::Context->preference("SyndeticsSummary"),
 465             SyndeticsEditions            => C4::Context->preference("SyndeticsEditions"),
 466             SyndeticsExcerpt             => C4::Context->preference("SyndeticsExcerpt"),
 467             SyndeticsReviews             => C4::Context->preference("SyndeticsReviews"),
 468             SyndeticsAuthorNotes         => C4::Context->preference("SyndeticsAuthorNotes"),
 469             SyndeticsAwards              => C4::Context->preference("SyndeticsAwards"),
 470             SyndeticsSeries              => C4::Context->preference("SyndeticsSeries"),
 471             SyndeticsCoverImageSize      => C4::Context->preference("SyndeticsCoverImageSize"),
 472             OPACLocalCoverImages         => C4::Context->preference("OPACLocalCoverImages"),
 473         );
 474
 475         $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic"));
 476     }
 477     return ( $template, $borrowernumber, $cookie, $flags);
 478 }
 479
 480 =head2 checkauth
 481
 482   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 483
 484 Verifies that the user is authorized to run this script.  If
 485 the user is authorized, a (userid, cookie, session-id, flags)
 486 quadruple is returned.  If the user is not authorized but does
 487 not have the required privilege (see $flagsrequired below), it
 488 displays an error page and exits.  Otherwise, it displays the
 489 login page and exits.
 490
 491 Note that C<&checkauth> will return if and only if the user
 492 is authorized, so it should be called early on, before any
 493 unfinished operations (e.g., if you've opened a file, then
 494 C<&checkauth> won't close it for you).
 495
 496 C<$query> is the CGI object for the script calling C<&checkauth>.
 497
 498 The C<$noauth> argument is optional. If it is set, then no
 499 authorization is required for the script.
 500
 501 C<&checkauth> fetches user and session information from C<$query> and
 502 ensures that the user is authorized to run scripts that require
 503 authorization.
 504
 505 The C<$flagsrequired> argument specifies the required privileges
 506 the user must have if the username and password are correct.
 507 It should be specified as a reference-to-hash; keys in the hash
 508 should be the "flags" for the user, as specified in the Members
 509 intranet module. Any key specified must correspond to a "flag"
 510 in the userflags table. E.g., { circulate => 1 } would specify
 511 that the user must have the "circulate" privilege in order to
 512 proceed. To make sure that access control is correct, the
 513 C<$flagsrequired> parameter must be specified correctly.
 514
 515 Koha also has a concept of sub-permissions, also known as
 516 granular permissions.  This makes the value of each key
 517 in the C<flagsrequired> hash take on an additional
 518 meaning, i.e.,
 519
 520  1
 521
 522 The user must have access to all subfunctions of the module
 523 specified by the hash key.
 524
 525  *
 526
 527 The user must have access to at least one subfunction of the module
 528 specified by the hash key.
 529
 530  specific permission, e.g., 'export_catalog'
 531
 532 The user must have access to the specific subfunction list, which
 533 must correspond to a row in the permissions table.
 534
 535 The C<$type> argument specifies whether the template should be
 536 retrieved from the opac or intranet directory tree.  "opac" is
 537 assumed if it is not specified; however, if C<$type> is specified,
 538 "intranet" is assumed if it is not "opac".
 539
 540 If C<$query> does not have a valid session ID associated with it
 541 (i.e., the user has not logged in) or if the session has expired,
 542 C<&checkauth> presents the user with a login page (from the point of
 543 view of the original script, C<&checkauth> does not return). Once the
 544 user has authenticated, C<&checkauth> restarts the original script
 545 (this time, C<&checkauth> returns).
 546
 547 The login page is provided using a HTML::Template, which is set in the
 548 systempreferences table or at the top of this file. The variable C<$type>
 549 selects which template to use, either the opac or the intranet
 550 authentification template.
 551
 552 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 553 cookie should be sent back to the browser; it verifies that the user
 554 has authenticated.
 555
 556 =cut
 557
 558 sub _version_check ($$) {
 559     my $type = shift;
 560     my $query = shift;
 561     my $version;
 562     # If Version syspref is unavailable, it means Koha is beeing installed,
 563     # and so we must redirect to OPAC maintenance page or to the WebInstaller
 564         # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
 565         if (C4::Context->preference('OpacMaintenance') && $type eq 'opac') {
 566         warn "OPAC Install required, redirecting to maintenance";
 567         print $query->redirect("/cgi-bin/koha/maintenance.pl");
 568     }
 569     unless ( $version = C4::Context->preference('Version') ) {    # assignment, not comparison
 570         if ( $type ne 'opac' ) {
 571             warn "Install required, redirecting to Installer";
 572             print $query->redirect("/cgi-bin/koha/installer/install.pl");
 573         } else {
 574             warn "OPAC Install required, redirecting to maintenance";
 575             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 576         }
 577         safe_exit;
 578     }
 579
 580     # check that database and koha version are the same
 581     # there is no DB version, it's a fresh install,
 582     # go to web installer
 583     # there is a DB version, compare it to the code version
 584     my $kohaversion=C4::Context::KOHAVERSION;
 585     # remove the 3 last . to have a Perl number
 586     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 587     $debug and print STDERR "kohaversion : $kohaversion\n";
 588     if ($version < $kohaversion){
 589         my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
 590         if ($type ne 'opac'){
 591             warn sprintf($warning, 'Installer');
 592             print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
 593         } else {
 594             warn sprintf("OPAC: " . $warning, 'maintenance');
 595             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 596         }
 597         safe_exit;
 598     }
 599 }
 600
 601 sub _session_log {
 602     (@_) or return 0;
 603     open L, ">>/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
 604     printf L join("\n",@_);
 605     close L;
 606 }
 607
 608 sub checkauth {
 609     my $query = shift;
 610         $debug and warn "Checking Auth";
 611     # $authnotrequired will be set for scripts which will run without authentication
 612     my $authnotrequired = shift;
 613     my $flagsrequired   = shift;
 614     my $type            = shift;
 615     $type = 'opac' unless $type;
 616
 617     my $dbh     = C4::Context->dbh;
 618     my $timeout = C4::Context->preference('timeout');
 619     # days
 620     if ($timeout =~ /(\d+)[dD]/) {
 621         $timeout = $1 * 86400;
 622     };
 623     $timeout = 600 unless $timeout;
 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         );
 643         $loggedin = 1;
 644     }
 645     elsif ( $sessionID = $query->cookie("CGISESSID")) {     # assignment, not comparison
 646         my $session = get_session($sessionID);
 647         C4::Context->_new_userenv($sessionID);
 648         my ($ip, $lasttime, $sessiontype);
 649         if ($session){
 650             C4::Context::set_userenv(
 651                 $session->param('number'),       $session->param('id'),
 652                 $session->param('cardnumber'),   $session->param('firstname'),
 653                 $session->param('surname'),      $session->param('branch'),
 654                 $session->param('branchname'),   $session->param('flags'),
 655                 $session->param('emailaddress'), $session->param('branchprinter')
 656             );
 657             C4::Context::set_shelves_userenv('bar',$session->param('barshelves'));
 658             C4::Context::set_shelves_userenv('pub',$session->param('pubshelves'));
 659             C4::Context::set_shelves_userenv('tot',$session->param('totshelves'));
 660             $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 661             $ip       = $session->param('ip');
 662             $lasttime = $session->param('lasttime');
 663             $userid   = $session->param('id');
 664                         $sessiontype = $session->param('sessiontype');
 665         }
 666         if ( ( ($query->param('koha_login_context')) && ($query->param('userid') ne $session->param('id')) )
 667           || ( $cas && $query->param('ticket') ) ) {
 668             #if a user enters an id ne to the id in the current session, we need to log them in...
 669             #first we need to clear the anonymous session...
 670             $debug and warn "query id = " . $query->param('userid') . " but session id = " . $session->param('id');
 671             $session->flush;
 672             $session->delete();
 673             C4::Context->_unset_userenv($sessionID);
 674                         $sessionID = undef;
 675                         $userid = undef;
 676                 }
 677         elsif ($logout) {
 678             # voluntary logout the user
 679             $session->flush;
 680             $session->delete();
 681             C4::Context->_unset_userenv($sessionID);
 682             #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
 683             $sessionID = undef;
 684             $userid    = undef;
 685
 686             if ($cas and $caslogout) {
 687                 logout_cas($query);
 688             }
 689         }
 690         elsif ( $lasttime < time() - $timeout ) {
 691             # timed logout
 692             $info{'timed_out'} = 1;
 693             $session->delete() if $session;
 694             C4::Context->_unset_userenv($sessionID);
 695             #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
 696             $userid    = undef;
 697             $sessionID = undef;
 698         }
 699         elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 700             # Different ip than originally logged in from
 701             $info{'oldip'}        = $ip;
 702             $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 703             $info{'different_ip'} = 1;
 704             $session->delete();
 705             C4::Context->_unset_userenv($sessionID);
 706             #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
 707             $sessionID = undef;
 708             $userid    = undef;
 709         }
 710         else {
 711             $cookie = $query->cookie( CGISESSID => $session->id );
 712             $session->param('lasttime',time());
 713             unless ( $sessiontype eq 'anon' ) { #if this is an anonymous session, we want to update the session, but not behave as if they are logged in...
 714                 $flags = haspermission($userid, $flagsrequired);
 715                 if ($flags) {
 716                     $loggedin = 1;
 717                 } else {
 718                     $info{'nopermission'} = 1;
 719                 }
 720             }
 721         }
 722     }
 723     unless ($userid || $sessionID) {
 724         #we initiate a session prior to checking for a username to allow for anonymous sessions...
 725         my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
 726         my $sessionID = $session->id;
 727         C4::Context->_new_userenv($sessionID);
 728         $cookie = $query->cookie( CGISESSID => $sessionID );
 729         $userid = $query->param('userid');
 730         if (   ( $cas && $query->param('ticket') )
 731             || $userid
 732             || ( my $pki_field = C4::Context->preference('AllowPKIAuth') ) ne
 733             'None' )
 734         {
 735             my $password = $query->param('password');
 736             my ( $return, $cardnumber );
 737             if ( $cas && $query->param('ticket') ) {
 738                 my $retuserid;
 739                 ( $return, $cardnumber, $retuserid ) =
 740                   checkpw( $dbh, $userid, $password, $query );
 741                 $userid = $retuserid;
 742                 $info{'invalidCasLogin'} = 1 unless ($return);
 743             }
 744             elsif (
 745                 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
 746                 || (   $pki_field eq 'emailAddress'
 747                     && $ENV{'SSL_CLIENT_S_DN_Email'} )
 748               )
 749             {
 750                 my $value;
 751                 if ( $pki_field eq 'Common Name' ) {
 752                     $value = $ENV{'SSL_CLIENT_S_DN_CN'};
 753                 }
 754                 elsif ( $pki_field eq 'emailAddress' ) {
 755                     $value = $ENV{'SSL_CLIENT_S_DN_Email'};
 756
 757               # If we're looking up the email, there's a chance that the person
 758               # doesn't have a userid. So if there is none, we pass along the
 759               # borrower number, and the bits of code that need to know the user
 760               # ID will have to be smart enough to handle that.
 761                     require C4::Members;
 762                     my @users_info = C4::Members::GetBorrowersWithEmail($value);
 763                     if (@users_info) {
 764
 765                         # First the userid, then the borrowernum
 766                         $value = $users_info[0][1] || $users_info[0][0];
 767                     } else {
 768                         undef $value;
 769                     }
 770                 }
 771
 772                 # 0 for no user, 1 for normal, 2 for demo user.
 773                 $return = $value ? 1 : 0;
 774                 $userid = $value;
 775             }
 776             else {
 777                 my $retuserid;
 778                 ( $return, $cardnumber, $retuserid ) =
 779                   checkpw( $dbh, $userid, $password, $query );
 780                 $userid = $retuserid if ( $retuserid ne '' );
 781             }
 782                 if ($return) {
 783                #_session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
 784                 if ( $flags = haspermission(  $userid, $flagsrequired ) ) {
 785                                         $loggedin = 1;
 786                 }
 787                         else {
 788                         $info{'nopermission'} = 1;
 789                         C4::Context->_unset_userenv($sessionID);
 790                 }
 791                 my ($borrowernumber, $firstname, $surname, $userflags,
 792                     $branchcode, $branchname, $branchprinter, $emailaddress);
 793
 794                 if ( $return == 1 ) {
 795                     my $select = "
 796                     SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
 797                     branches.branchname    as branchname,
 798                     branches.branchprinter as branchprinter,
 799                     email
 800                     FROM borrowers
 801                     LEFT JOIN branches on borrowers.branchcode=branches.branchcode
 802                     ";
 803                     my $sth = $dbh->prepare("$select where userid=?");
 804                     $sth->execute($userid);
 805                     unless ($sth->rows) {
 806                         $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
 807                         $sth = $dbh->prepare("$select where cardnumber=?");
 808                         $sth->execute($cardnumber);
 809
 810                         unless ($sth->rows) {
 811                             $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
 812                             $sth->execute($userid);
 813                             unless ($sth->rows) {
 814                                 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
 815                             }
 816                         }
 817                     }
 818                     if ($sth->rows) {
 819                         ($borrowernumber, $firstname, $surname, $userflags,
 820                             $branchcode, $branchname, $branchprinter, $emailaddress) = $sth->fetchrow;
 821                         $debug and print STDERR "AUTH_3 results: " .
 822                         "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
 823                     } else {
 824                         print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
 825                     }
 826
 827 # launch a sequence to check if we have a ip for the branch, i
 828 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
 829
 830                     my $ip       = $ENV{'REMOTE_ADDR'};
 831                     # if they specify at login, use that
 832                     if ($query->param('branch')) {
 833                         $branchcode  = $query->param('branch');
 834                         $branchname = GetBranchName($branchcode);
 835                     }
 836                     my $branches = GetBranches();
 837                     if (C4::Context->boolean_preference('IndependantBranches') && C4::Context->boolean_preference('Autolocation')){
 838                         # we have to check they are coming from the right ip range
 839                         my $domain = $branches->{$branchcode}->{'branchip'};
 840                         if ($ip !~ /^$domain/){
 841                             $loggedin=0;
 842                             $info{'wrongip'} = 1;
 843                         }
 844                     }
 845
 846                     my @branchesloop;
 847                     foreach my $br ( keys %$branches ) {
 848                         #     now we work with the treatment of ip
 849                         my $domain = $branches->{$br}->{'branchip'};
 850                         if ( $domain && $ip =~ /^$domain/ ) {
 851                             $branchcode = $branches->{$br}->{'branchcode'};
 852
 853                             # new op dev : add the branchprinter and branchname in the cookie
 854                             $branchprinter = $branches->{$br}->{'branchprinter'};
 855                             $branchname    = $branches->{$br}->{'branchname'};
 856                         }
 857                     }
 858                     $session->param('number',$borrowernumber);
 859                     $session->param('id',$userid);
 860                     $session->param('cardnumber',$cardnumber);
 861                     $session->param('firstname',$firstname);
 862                     $session->param('surname',$surname);
 863                     $session->param('branch',$branchcode);
 864                     $session->param('branchname',$branchname);
 865                     $session->param('flags',$userflags);
 866                     $session->param('emailaddress',$emailaddress);
 867                     $session->param('ip',$session->remote_addr());
 868                     $session->param('lasttime',time());
 869                     $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 870                 }
 871                 elsif ( $return == 2 ) {
 872                     #We suppose the user is the superlibrarian
 873                     $borrowernumber = 0;
 874                     $session->param('number',0);
 875                     $session->param('id',C4::Context->config('user'));
 876                     $session->param('cardnumber',C4::Context->config('user'));
 877                     $session->param('firstname',C4::Context->config('user'));
 878                     $session->param('surname',C4::Context->config('user'));
 879                     $session->param('branch','NO_LIBRARY_SET');
 880                     $session->param('branchname','NO_LIBRARY_SET');
 881                     $session->param('flags',1);
 882                     $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 883                     $session->param('ip',$session->remote_addr());
 884                     $session->param('lasttime',time());
 885                 }
 886                 C4::Context::set_userenv(
 887                     $session->param('number'),       $session->param('id'),
 888                     $session->param('cardnumber'),   $session->param('firstname'),
 889                     $session->param('surname'),      $session->param('branch'),
 890                     $session->param('branchname'),   $session->param('flags'),
 891                     $session->param('emailaddress'), $session->param('branchprinter')
 892                 );
 893
 894             }
 895                 else {
 896                 if ($userid) {
 897                         $info{'invalid_username_or_password'} = 1;
 898                         C4::Context->_unset_userenv($sessionID);
 899                 }
 900                         }
 901         }       # END if ( $userid    = $query->param('userid') )
 902                 elsif ($type eq "opac") {
 903             # if we are here this is an anonymous session; add public lists to it and a few other items...
 904             # anonymous sessions are created only for the OPAC
 905                         $debug and warn "Initiating an anonymous session...";
 906
 907                         # setting a couple of other session vars...
 908                         $session->param('ip',$session->remote_addr());
 909                         $session->param('lasttime',time());
 910                         $session->param('sessiontype','anon');
 911                 }
 912     }   # END unless ($userid)
 913     my $insecure = C4::Context->boolean_preference('insecure');
 914
 915     # finished authentification, now respond
 916     if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
 917     {
 918         # successful login
 919         unless ($cookie) {
 920             $cookie = $query->cookie( CGISESSID => '' );
 921         }
 922         return ( $userid, $cookie, $sessionID, $flags );
 923     }
 924
 925 #
 926 #
 927 # AUTH rejected, show the login/password template, after checking the DB.
 928 #
 929 #
 930
 931     # get the inputs from the incoming query
 932     my @inputs = ();
 933     foreach my $name ( param $query) {
 934         (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
 935         my $value = $query->param($name);
 936         push @inputs, { name => $name, value => $value };
 937     }
 938     # get the branchloop, which we need for authentication
 939     my $branches = GetBranches();
 940     my @branch_loop;
 941     for my $branch_hash (sort keys %$branches) {
 942                 push @branch_loop, {branchcode => "$branch_hash", branchname => $branches->{$branch_hash}->{'branchname'}, };
 943     }
 944
 945     my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tmpl' : 'auth.tmpl';
 946     my $template = C4::Templates::gettemplate( $template_name, $type, $query );
 947     $template->param(branchloop => \@branch_loop,);
 948     my $checkstyle = C4::Context->preference("opaccolorstylesheet");
 949     if ($checkstyle =~ /\//)
 950         {
 951                 $template->param( opacexternalsheet => $checkstyle);
 952         } else
 953         {
 954                 my $opaccolorstylesheet = C4::Context->preference("opaccolorstylesheet");
 955             $template->param( opaccolorstylesheet => $opaccolorstylesheet);
 956         }
 957     $template->param(
 958     login        => 1,
 959         INPUTS               => \@inputs,
 960         casAuthentication    => C4::Context->preference("casAuthentication"),
 961         suggestion           => C4::Context->preference("suggestion"),
 962         virtualshelves       => C4::Context->preference("virtualshelves"),
 963         LibraryName          => C4::Context->preference("LibraryName"),
 964         opacuserlogin        => C4::Context->preference("opacuserlogin"),
 965         OpacNav              => C4::Context->preference("OpacNav"),
 966         OpacNavBottom        => C4::Context->preference("OpacNavBottom"),
 967         opaccredits          => C4::Context->preference("opaccredits"),
 968         OpacFavicon          => C4::Context->preference("OpacFavicon"),
 969         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
 970         opacsmallimage       => C4::Context->preference("opacsmallimage"),
 971         opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
 972         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
 973         opacuserjs           => C4::Context->preference("opacuserjs"),
 974         opacbookbag          => "" . C4::Context->preference("opacbookbag"),
 975         OpacCloud            => C4::Context->preference("OpacCloud"),
 976         OpacTopissue         => C4::Context->preference("OpacTopissue"),
 977         OpacAuthorities      => C4::Context->preference("OpacAuthorities"),
 978         OpacBrowser          => C4::Context->preference("OpacBrowser"),
 979         opacheader           => C4::Context->preference("opacheader"),
 980         TagsEnabled                  => C4::Context->preference("TagsEnabled"),
 981         OPACUserCSS           => C4::Context->preference("OPACUserCSS"),
 982         opacstylesheet       => C4::Context->preference("opacstylesheet"),
 983         intranetcolorstylesheet =>
 984                                                                 C4::Context->preference("intranetcolorstylesheet"),
 985         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 986         intranetbookbag    => C4::Context->preference("intranetbookbag"),
 987         IntranetNav        => C4::Context->preference("IntranetNav"),
 988         intranetuserjs     => C4::Context->preference("intranetuserjs"),
 989         IndependantBranches=> C4::Context->preference("IndependantBranches"),
 990         AutoLocation       => C4::Context->preference("AutoLocation"),
 991                 wrongip            => $info{'wrongip'},
 992     );
 993
 994     $template->param( OpacPublic => C4::Context->preference("OpacPublic"));
 995     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
 996
 997     if ($cas) {
 998
 999         # Is authentication against multiple CAS servers enabled?
1000         if (C4::Auth_with_cas::multipleAuth && !$casparam) {
1001             my $casservers = C4::Auth_with_cas::getMultipleAuth();
1002             my @tmplservers;
1003             foreach my $key (keys %$casservers) {
1004                 push @tmplservers, {name => $key, value => login_cas_url($query, $key) . "?cas=$key" };
1005             }
1006             #warn Data::Dumper::Dumper(\@tmplservers);
1007             $template->param(
1008                 casServersLoop => \@tmplservers
1009             );
1010         } else {
1011         $template->param(
1012             casServerUrl    => login_cas_url($query),
1013             );
1014         }
1015
1016         $template->param(
1017             invalidCasLogin => $info{'invalidCasLogin'}
1018         );
1019     }
1020
1021     my $self_url = $query->url( -absolute => 1 );
1022     $template->param(
1023         url         => $self_url,
1024         LibraryName => C4::Context->preference("LibraryName"),
1025     );
1026     $template->param( %info );
1027 #    $cookie = $query->cookie(CGISESSID => $session->id
1028 #   );
1029     print $query->header(
1030         -type   => 'text/html',
1031         -charset => 'utf-8',
1032         -cookie => $cookie
1033       ),
1034       $template->output;
1035     safe_exit;
1036 }
1037
1038 =head2 check_api_auth
1039
1040   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1041
1042 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1043 cookie, determine if the user has the privileges specified by C<$userflags>.
1044
1045 C<check_api_auth> is is meant for authenticating users of web services, and
1046 consequently will always return and will not attempt to redirect the user
1047 agent.
1048
1049 If a valid session cookie is already present, check_api_auth will return a status
1050 of "ok", the cookie, and the Koha session ID.
1051
1052 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1053 parameters and create a session cookie and Koha session if the supplied credentials
1054 are OK.
1055
1056 Possible return values in C<$status> are:
1057
1058 =over
1059
1060 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1061
1062 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1063
1064 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1065
1066 =item "expired -- session cookie has expired; API user should resubmit userid and password
1067
1068 =back
1069
1070 =cut
1071
1072 sub check_api_auth {
1073     my $query = shift;
1074     my $flagsrequired = shift;
1075
1076     my $dbh     = C4::Context->dbh;
1077     my $timeout = C4::Context->preference('timeout');
1078     $timeout = 600 unless $timeout;
1079
1080     unless (C4::Context->preference('Version')) {
1081         # database has not been installed yet
1082         return ("maintenance", undef, undef);
1083     }
1084     my $kohaversion=C4::Context::KOHAVERSION;
1085     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1086     if (C4::Context->preference('Version') < $kohaversion) {
1087         # database in need of version update; assume that
1088         # no API should be called while databsae is in
1089         # this condition.
1090         return ("maintenance", undef, undef);
1091     }
1092
1093     # FIXME -- most of what follows is a copy-and-paste
1094     # of code from checkauth.  There is an obvious need
1095     # for refactoring to separate the various parts of
1096     # the authentication code, but as of 2007-11-19 this
1097     # is deferred so as to not introduce bugs into the
1098     # regular authentication code for Koha 3.0.
1099
1100     # see if we have a valid session cookie already
1101     # however, if a userid parameter is present (i.e., from
1102     # a form submission, assume that any current cookie
1103     # is to be ignored
1104     my $sessionID = undef;
1105     unless ($query->param('userid')) {
1106         $sessionID = $query->cookie("CGISESSID");
1107     }
1108     if ($sessionID && not ($cas && $query->param('PT')) ) {
1109         my $session = get_session($sessionID);
1110         C4::Context->_new_userenv($sessionID);
1111         if ($session) {
1112             C4::Context::set_userenv(
1113                 $session->param('number'),       $session->param('id'),
1114                 $session->param('cardnumber'),   $session->param('firstname'),
1115                 $session->param('surname'),      $session->param('branch'),
1116                 $session->param('branchname'),   $session->param('flags'),
1117                 $session->param('emailaddress'), $session->param('branchprinter')
1118             );
1119
1120             my $ip = $session->param('ip');
1121             my $lasttime = $session->param('lasttime');
1122             my $userid = $session->param('id');
1123             if ( $lasttime < time() - $timeout ) {
1124                 # time out
1125                 $session->delete();
1126                 C4::Context->_unset_userenv($sessionID);
1127                 $userid    = undef;
1128                 $sessionID = undef;
1129                 return ("expired", undef, undef);
1130             } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1131                 # IP address changed
1132                 $session->delete();
1133                 C4::Context->_unset_userenv($sessionID);
1134                 $userid    = undef;
1135                 $sessionID = undef;
1136                 return ("expired", undef, undef);
1137             } else {
1138                 my $cookie = $query->cookie( CGISESSID => $session->id );
1139                 $session->param('lasttime',time());
1140                 my $flags = haspermission($userid, $flagsrequired);
1141                 if ($flags) {
1142                     return ("ok", $cookie, $sessionID);
1143                 } else {
1144                     $session->delete();
1145                     C4::Context->_unset_userenv($sessionID);
1146                     $userid    = undef;
1147                     $sessionID = undef;
1148                     return ("failed", undef, undef);
1149                 }
1150             }
1151         } else {
1152             return ("expired", undef, undef);
1153         }
1154     } else {
1155         # new login
1156         my $userid = $query->param('userid');
1157         my $password = $query->param('password');
1158         my ($return, $cardnumber);
1159
1160         # Proxy CAS auth
1161         if ($cas && $query->param('PT')) {
1162             my $retuserid;
1163             $debug and print STDERR "## check_api_auth - checking CAS\n";
1164             # In case of a CAS authentication, we use the ticket instead of the password
1165             my $PT = $query->param('PT');
1166             ($return,$cardnumber,$userid) = check_api_auth_cas($dbh, $PT, $query);    # EXTERNAL AUTH
1167         } else {
1168             # User / password auth
1169             unless ($userid and $password) {
1170                 # caller did something wrong, fail the authenticateion
1171                 return ("failed", undef, undef);
1172             }
1173             ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password, $query );
1174         }
1175
1176         if ($return and haspermission(  $userid, $flagsrequired)) {
1177             my $session = get_session("");
1178             return ("failed", undef, undef) unless $session;
1179
1180             my $sessionID = $session->id;
1181             C4::Context->_new_userenv($sessionID);
1182             my $cookie = $query->cookie(CGISESSID => $sessionID);
1183             if ( $return == 1 ) {
1184                 my (
1185                     $borrowernumber, $firstname,  $surname,
1186                     $userflags,      $branchcode, $branchname,
1187                     $branchprinter,  $emailaddress
1188                 );
1189                 my $sth =
1190                   $dbh->prepare(
1191 "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=?"
1192                   );
1193                 $sth->execute($userid);
1194                 (
1195                     $borrowernumber, $firstname,  $surname,
1196                     $userflags,      $branchcode, $branchname,
1197                     $branchprinter,  $emailaddress
1198                 ) = $sth->fetchrow if ( $sth->rows );
1199
1200                 unless ($sth->rows ) {
1201                     my $sth = $dbh->prepare(
1202 "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=?"
1203                       );
1204                     $sth->execute($cardnumber);
1205                     (
1206                         $borrowernumber, $firstname,  $surname,
1207                         $userflags,      $branchcode, $branchname,
1208                         $branchprinter,  $emailaddress
1209                     ) = $sth->fetchrow if ( $sth->rows );
1210
1211                     unless ( $sth->rows ) {
1212                         $sth->execute($userid);
1213                         (
1214                             $borrowernumber, $firstname, $surname, $userflags,
1215                             $branchcode, $branchname, $branchprinter, $emailaddress
1216                         ) = $sth->fetchrow if ( $sth->rows );
1217                     }
1218                 }
1219
1220                 my $ip       = $ENV{'REMOTE_ADDR'};
1221                 # if they specify at login, use that
1222                 if ($query->param('branch')) {
1223                     $branchcode  = $query->param('branch');
1224                     $branchname = GetBranchName($branchcode);
1225                 }
1226                 my $branches = GetBranches();
1227                 my @branchesloop;
1228                 foreach my $br ( keys %$branches ) {
1229                     #     now we work with the treatment of ip
1230                     my $domain = $branches->{$br}->{'branchip'};
1231                     if ( $domain && $ip =~ /^$domain/ ) {
1232                         $branchcode = $branches->{$br}->{'branchcode'};
1233
1234                         # new op dev : add the branchprinter and branchname in the cookie
1235                         $branchprinter = $branches->{$br}->{'branchprinter'};
1236                         $branchname    = $branches->{$br}->{'branchname'};
1237                     }
1238                 }
1239                 $session->param('number',$borrowernumber);
1240                 $session->param('id',$userid);
1241                 $session->param('cardnumber',$cardnumber);
1242                 $session->param('firstname',$firstname);
1243                 $session->param('surname',$surname);
1244                 $session->param('branch',$branchcode);
1245                 $session->param('branchname',$branchname);
1246                 $session->param('flags',$userflags);
1247                 $session->param('emailaddress',$emailaddress);
1248                 $session->param('ip',$session->remote_addr());
1249                 $session->param('lasttime',time());
1250             } elsif ( $return == 2 ) {
1251                 #We suppose the user is the superlibrarian
1252                 $session->param('number',0);
1253                 $session->param('id',C4::Context->config('user'));
1254                 $session->param('cardnumber',C4::Context->config('user'));
1255                 $session->param('firstname',C4::Context->config('user'));
1256                 $session->param('surname',C4::Context->config('user'));
1257                 $session->param('branch','NO_LIBRARY_SET');
1258                 $session->param('branchname','NO_LIBRARY_SET');
1259                 $session->param('flags',1);
1260                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
1261                 $session->param('ip',$session->remote_addr());
1262                 $session->param('lasttime',time());
1263             }
1264             C4::Context::set_userenv(
1265                 $session->param('number'),       $session->param('id'),
1266                 $session->param('cardnumber'),   $session->param('firstname'),
1267                 $session->param('surname'),      $session->param('branch'),
1268                 $session->param('branchname'),   $session->param('flags'),
1269                 $session->param('emailaddress'), $session->param('branchprinter')
1270             );
1271             return ("ok", $cookie, $sessionID);
1272         } else {
1273             return ("failed", undef, undef);
1274         }
1275     }
1276 }
1277
1278 =head2 check_cookie_auth
1279
1280   ($status, $sessionId) = check_api_auth($cookie, $userflags);
1281
1282 Given a CGISESSID cookie set during a previous login to Koha, determine
1283 if the user has the privileges specified by C<$userflags>.
1284
1285 C<check_cookie_auth> is meant for authenticating special services
1286 such as tools/upload-file.pl that are invoked by other pages that
1287 have been authenticated in the usual way.
1288
1289 Possible return values in C<$status> are:
1290
1291 =over
1292
1293 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1294
1295 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1296
1297 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1298
1299 =item "expired -- session cookie has expired; API user should resubmit userid and password
1300
1301 =back
1302
1303 =cut
1304
1305 sub check_cookie_auth {
1306     my $cookie = shift;
1307     my $flagsrequired = shift;
1308
1309     my $dbh     = C4::Context->dbh;
1310     my $timeout = C4::Context->preference('timeout');
1311     $timeout = 600 unless $timeout;
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     $flags = 0 unless $flags;
1512     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1513     $sth->execute;
1514
1515     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1516         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1517             $userflags->{$flag} = 1;
1518         }
1519         else {
1520             $userflags->{$flag} = 0;
1521         }
1522     }
1523
1524     # get subpermissions and merge with top-level permissions
1525     my $user_subperms = get_user_subpermissions($userid);
1526     foreach my $module (keys %$user_subperms) {
1527         next if $userflags->{$module} == 1; # user already has permission for everything in this module
1528         $userflags->{$module} = $user_subperms->{$module};
1529     }
1530
1531     return $userflags;
1532 }
1533
1534 =head2 get_user_subpermissions
1535
1536   $user_perm_hashref = get_user_subpermissions($userid);
1537
1538 Given the userid (note, not the borrowernumber) of a staff user,
1539 return a hashref of hashrefs of the specific subpermissions
1540 accorded to the user.  An example return is
1541
1542  {
1543     tools => {
1544         export_catalog => 1,
1545         import_patrons => 1,
1546     }
1547  }
1548
1549 The top-level hash-key is a module or function code from
1550 userflags.flag, while the second-level key is a code
1551 from permissions.
1552
1553 The results of this function do not give a complete picture
1554 of the functions that a staff user can access; it is also
1555 necessary to check borrowers.flags.
1556
1557 =cut
1558
1559 sub get_user_subpermissions {
1560     my $userid = shift;
1561
1562     my $dbh = C4::Context->dbh;
1563     my $sth = $dbh->prepare("SELECT flag, user_permissions.code
1564                              FROM user_permissions
1565                              JOIN permissions USING (module_bit, code)
1566                              JOIN userflags ON (module_bit = bit)
1567                              JOIN borrowers USING (borrowernumber)
1568                              WHERE userid = ?");
1569     $sth->execute($userid);
1570
1571     my $user_perms = {};
1572     while (my $perm = $sth->fetchrow_hashref) {
1573         $user_perms->{$perm->{'flag'}}->{$perm->{'code'}} = 1;
1574     }
1575     return $user_perms;
1576 }
1577
1578 =head2 get_all_subpermissions
1579
1580   my $perm_hashref = get_all_subpermissions();
1581
1582 Returns a hashref of hashrefs defining all specific
1583 permissions currently defined.  The return value
1584 has the same structure as that of C<get_user_subpermissions>,
1585 except that the innermost hash value is the description
1586 of the subpermission.
1587
1588 =cut
1589
1590 sub get_all_subpermissions {
1591     my $dbh = C4::Context->dbh;
1592     my $sth = $dbh->prepare("SELECT flag, code, description
1593                              FROM permissions
1594                              JOIN userflags ON (module_bit = bit)");
1595     $sth->execute();
1596
1597     my $all_perms = {};
1598     while (my $perm = $sth->fetchrow_hashref) {
1599         $all_perms->{$perm->{'flag'}}->{$perm->{'code'}} = $perm->{'description'};
1600     }
1601     return $all_perms;
1602 }
1603
1604 =head2 haspermission
1605
1606   $flags = ($userid, $flagsrequired);
1607
1608 C<$userid> the userid of the member
1609 C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
1610
1611 Returns member's flags or 0 if a permission is not met.
1612
1613 =cut
1614
1615 sub haspermission {
1616     my ($userid, $flagsrequired) = @_;
1617     my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1618     $sth->execute($userid);
1619     my $flags = getuserflags($sth->fetchrow(), $userid);
1620     if ( $userid eq C4::Context->config('user') ) {
1621         # Super User Account from /etc/koha.conf
1622         $flags->{'superlibrarian'} = 1;
1623     }
1624     elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
1625         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1626         $flags->{'superlibrarian'} = 1;
1627     }
1628
1629     return $flags if $flags->{superlibrarian};
1630
1631     foreach my $module ( keys %$flagsrequired ) {
1632         my $subperm = $flagsrequired->{$module};
1633         if ($subperm eq '*') {
1634             return 0 unless ( $flags->{$module} == 1 or ref($flags->{$module}) );
1635         } else {
1636             return 0 unless ( $flags->{$module} == 1 or
1637                                 ( ref($flags->{$module}) and
1638                                   exists $flags->{$module}->{$subperm} and
1639                                   $flags->{$module}->{$subperm} == 1
1640                                 )
1641                             );
1642         }
1643     }
1644     return $flags;
1645     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1646 }
1647
1648
1649 sub getborrowernumber {
1650     my ($userid) = @_;
1651     my $userenv = C4::Context->userenv;
1652     if ( defined( $userenv ) && ref( $userenv ) eq 'HASH' && $userenv->{number} ) {
1653         return $userenv->{number};
1654     }
1655     my $dbh = C4::Context->dbh;
1656     for my $field ( 'userid', 'cardnumber' ) {
1657         my $sth =
1658           $dbh->prepare("select borrowernumber from borrowers where $field=?");
1659         $sth->execute($userid);
1660         if ( $sth->rows ) {
1661             my ($bnumber) = $sth->fetchrow;
1662             return $bnumber;
1663         }
1664     }
1665     return 0;
1666 }
1667
1668
1669 END { }    # module clean-up code here (global destructor)
1670 1;
1671 __END__
1672
1673 =head1 SEE ALSO
1674
1675 CGI(3)
1676
1677 C4::Output(3)
1678
1679 Digest::MD5(3)
1680
1681 =cut