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