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