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