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