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           || ( $cas && $query->param('ticket') ) ) {
 693             #if a user enters an id ne to the id in the current session, we need to log them in...
 694             #first we need to clear the anonymous session...
 695             $debug and warn "query id = " . $query->param('userid') . " but session id = " . $session->param('id');
 696             $session->flush;
 697             $session->delete();
 698             C4::Context->_unset_userenv($sessionID);
 699                         $sessionID = undef;
 700                         $userid = undef;
 701                 }
 702         elsif ($logout) {
 703             # voluntary logout the user
 704             $session->flush;
 705             $session->delete();
 706             C4::Context->_unset_userenv($sessionID);
 707             #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
 708             $sessionID = undef;
 709             $userid    = undef;
 710
 711             if ($cas and $caslogout) {
 712                 logout_cas($query);
 713             }
 714         }
 715         elsif ( $lasttime < time() - $timeout ) {
 716             # timed logout
 717             $info{'timed_out'} = 1;
 718             $session->delete();
 719             C4::Context->_unset_userenv($sessionID);
 720             #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
 721             $userid    = undef;
 722             $sessionID = undef;
 723         }
 724         elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 725             # Different ip than originally logged in from
 726             $info{'oldip'}        = $ip;
 727             $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 728             $info{'different_ip'} = 1;
 729             $session->delete();
 730             C4::Context->_unset_userenv($sessionID);
 731             #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
 732             $sessionID = undef;
 733             $userid    = undef;
 734         }
 735         else {
 736             $cookie = $query->cookie( CGISESSID => $session->id );
 737             $session->param('lasttime',time());
 738             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...
 739                 $flags = haspermission($userid, $flagsrequired);
 740                 if ($flags) {
 741                     $loggedin = 1;
 742                 } else {
 743                     $info{'nopermission'} = 1;
 744                 }
 745             }
 746         }
 747     }
 748     unless ($userid || $sessionID) {
 749         #we initiate a session prior to checking for a username to allow for anonymous sessions...
 750                 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
 751         my $sessionID = $session->id;
 752         C4::Context->_new_userenv($sessionID);
 753         $cookie = $query->cookie(CGISESSID => $sessionID);
 754             $userid    = $query->param('userid');
 755             if (($cas && $query->param('ticket')) || $userid) {
 756                 my $password = $query->param('password');
 757                 my ($return, $cardnumber);
 758                 if ($cas && $query->param('ticket')) {
 759                     my $retuserid;
 760                     ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $userid, $password, $query );
 761                     $userid = $retuserid;
 762                     $info{'invalidCasLogin'} = 1 unless ($return);
 763                 } else {
 764                     my $retuserid;
 765                     ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $userid, $password, $query );
 766                     $userid = $retuserid if ($retuserid ne '');
 767                 }
 768                 if ($return) {
 769                #_session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
 770                 if ( $flags = haspermission(  $userid, $flagsrequired ) ) {
 771                                         $loggedin = 1;
 772                 }
 773                         else {
 774                         $info{'nopermission'} = 1;
 775                         C4::Context->_unset_userenv($sessionID);
 776                 }
 777
 778                                 my ($borrowernumber, $firstname, $surname, $userflags,
 779                                         $branchcode, $branchname, $branchprinter, $emailaddress);
 780
 781                 if ( $return == 1 ) {
 782                         my $select = "
 783                         SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
 784                             branches.branchname    as branchname,
 785                                 branches.branchprinter as branchprinter,
 786                                 email
 787                         FROM borrowers
 788                         LEFT JOIN branches on borrowers.branchcode=branches.branchcode
 789                         ";
 790                         my $sth = $dbh->prepare("$select where userid=?");
 791                         $sth->execute($userid);
 792                         unless ($sth->rows) {
 793                             $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
 794                             $sth = $dbh->prepare("$select where cardnumber=?");
 795                             $sth->execute($cardnumber);
 796
 797                             unless ($sth->rows) {
 798                                 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
 799                                 $sth->execute($userid);
 800                                 unless ($sth->rows) {
 801                                     $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
 802                                 }
 803                             }
 804                         }
 805                         if ($sth->rows) {
 806                             ($borrowernumber, $firstname, $surname, $userflags,
 807                                 $branchcode, $branchname, $branchprinter, $emailaddress) = $sth->fetchrow;
 808                                                 $debug and print STDERR "AUTH_3 results: " .
 809                                                         "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
 810                                         } else {
 811                                                 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
 812                                         }
 813
 814 # launch a sequence to check if we have a ip for the branch, i
 815 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
 816
 817                                         my $ip       = $ENV{'REMOTE_ADDR'};
 818                                         # if they specify at login, use that
 819                                         if ($query->param('branch')) {
 820                                                 $branchcode  = $query->param('branch');
 821                                                 $branchname = GetBranchName($branchcode);
 822                                         }
 823                                         my $branches = GetBranches();
 824                                         if (C4::Context->boolean_preference('IndependantBranches') && C4::Context->boolean_preference('Autolocation')){
 825                                                 # we have to check they are coming from the right ip range
 826                                                 my $domain = $branches->{$branchcode}->{'branchip'};
 827                                                 if ($ip !~ /^$domain/){
 828                                                         $loggedin=0;
 829                                                         $info{'wrongip'} = 1;
 830                                                 }
 831                                         }
 832
 833                                         my @branchesloop;
 834                                         foreach my $br ( keys %$branches ) {
 835                                                 #     now we work with the treatment of ip
 836                                                 my $domain = $branches->{$br}->{'branchip'};
 837                                                 if ( $domain && $ip =~ /^$domain/ ) {
 838                                                         $branchcode = $branches->{$br}->{'branchcode'};
 839
 840                                                         # new op dev : add the branchprinter and branchname in the cookie
 841                                                         $branchprinter = $branches->{$br}->{'branchprinter'};
 842                                                         $branchname    = $branches->{$br}->{'branchname'};
 843                                                 }
 844                                         }
 845                                         $session->param('number',$borrowernumber);
 846                                         $session->param('id',$userid);
 847                                         $session->param('cardnumber',$cardnumber);
 848                                         $session->param('firstname',$firstname);
 849                                         $session->param('surname',$surname);
 850                                         $session->param('branch',$branchcode);
 851                                         $session->param('branchname',$branchname);
 852                                         $session->param('flags',$userflags);
 853                                         $session->param('emailaddress',$emailaddress);
 854                                         $session->param('ip',$session->remote_addr());
 855                                         $session->param('lasttime',time());
 856                                         $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 857                                 }
 858                                 elsif ( $return == 2 ) {
 859                                         #We suppose the user is the superlibrarian
 860                                         $borrowernumber = 0;
 861                                         $session->param('number',0);
 862                                         $session->param('id',C4::Context->config('user'));
 863                                         $session->param('cardnumber',C4::Context->config('user'));
 864                                         $session->param('firstname',C4::Context->config('user'));
 865                                         $session->param('surname',C4::Context->config('user'));
 866                                         $session->param('branch','NO_LIBRARY_SET');
 867                                         $session->param('branchname','NO_LIBRARY_SET');
 868                                         $session->param('flags',1);
 869                                         $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 870                                         $session->param('ip',$session->remote_addr());
 871                                         $session->param('lasttime',time());
 872                                 }
 873                                 C4::Context::set_userenv(
 874                                         $session->param('number'),       $session->param('id'),
 875                                         $session->param('cardnumber'),   $session->param('firstname'),
 876                                         $session->param('surname'),      $session->param('branch'),
 877                                         $session->param('branchname'),   $session->param('flags'),
 878                                         $session->param('emailaddress'), $session->param('branchprinter')
 879                                 );
 880
 881                                 # Grab borrower's shelves and public shelves and add them to the session
 882                                 # $row_count determines how many records are returned from the db query
 883                                 # and the number of lists to be displayed of each type in the 'Lists' button drop down
 884                                 my $row_count = 10; # FIXME:This probably should be a syspref
 885                                 my ($total, $totshelves, $barshelves, $pubshelves);
 886                                 ($barshelves, $totshelves) = C4::VirtualShelves::GetRecentShelves(1, $row_count, $borrowernumber);
 887                                 $total->{'bartotal'} = $totshelves;
 888                                 ($pubshelves, $totshelves) = C4::VirtualShelves::GetRecentShelves(2, $row_count, undef);
 889                                 $total->{'pubtotal'} = $totshelves;
 890                                 $session->param('barshelves', $barshelves);
 891                                 $session->param('pubshelves', $pubshelves);
 892                                 $session->param('totshelves', $total);
 893
 894                                 C4::Context::set_shelves_userenv('bar',$barshelves);
 895                                 C4::Context::set_shelves_userenv('pub',$pubshelves);
 896                                 C4::Context::set_shelves_userenv('tot',$total);
 897                         }
 898                 else {
 899                 if ($userid) {
 900                         $info{'invalid_username_or_password'} = 1;
 901                         C4::Context->_unset_userenv($sessionID);
 902                 }
 903                         }
 904         }       # END if ( $userid    = $query->param('userid') )
 905                 elsif ($type eq "opac") {
 906             # if we are here this is an anonymous session; add public lists to it and a few other items...
 907             # anonymous sessions are created only for the OPAC
 908                         $debug and warn "Initiating an anonymous session...";
 909
 910                         # Grab the public shelves and add to the session...
 911                         my $row_count = 20; # FIXME:This probably should be a syspref
 912                         my ($total, $totshelves, $pubshelves);
 913                         ($pubshelves, $totshelves) = C4::VirtualShelves::GetRecentShelves(2, $row_count, undef);
 914                         $total->{'pubtotal'} = $totshelves;
 915                         $session->param('pubshelves', $pubshelves);
 916                         $session->param('totshelves', $total);
 917                         C4::Context::set_shelves_userenv('pub',$pubshelves);
 918                         C4::Context::set_shelves_userenv('tot',$total);
 919
 920                         # setting a couple of other session vars...
 921                         $session->param('ip',$session->remote_addr());
 922                         $session->param('lasttime',time());
 923                         $session->param('sessiontype','anon');
 924                 }
 925     }   # END unless ($userid)
 926     my $insecure = C4::Context->boolean_preference('insecure');
 927
 928     # finished authentification, now respond
 929     if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
 930     {
 931         # successful login
 932         unless ($cookie) {
 933             $cookie = $query->cookie( CGISESSID => '' );
 934         }
 935         return ( $userid, $cookie, $sessionID, $flags );
 936     }
 937
 938 #
 939 #
 940 # AUTH rejected, show the login/password template, after checking the DB.
 941 #
 942 #
 943
 944     # get the inputs from the incoming query
 945     my @inputs = ();
 946     foreach my $name ( param $query) {
 947         (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
 948         my $value = $query->param($name);
 949         push @inputs, { name => $name, value => $value };
 950     }
 951     # get the branchloop, which we need for authentication
 952     my $branches = GetBranches();
 953     my @branch_loop;
 954     for my $branch_hash (sort keys %$branches) {
 955                 push @branch_loop, {branchcode => "$branch_hash", branchname => $branches->{$branch_hash}->{'branchname'}, };
 956     }
 957
 958     my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tmpl' : 'auth.tmpl';
 959     my $template = C4::Templates::gettemplate( $template_name, $type, $query );
 960     $template->param(branchloop => \@branch_loop,);
 961     my $checkstyle = C4::Context->preference("opaccolorstylesheet");
 962     if ($checkstyle =~ /\//)
 963         {
 964                 $template->param( opacexternalsheet => $checkstyle);
 965         } else
 966         {
 967                 my $opaccolorstylesheet = C4::Context->preference("opaccolorstylesheet");
 968             $template->param( opaccolorstylesheet => $opaccolorstylesheet);
 969         }
 970     $template->param(
 971     login        => 1,
 972         INPUTS               => \@inputs,
 973         casAuthentication    => C4::Context->preference("casAuthentication"),
 974         suggestion           => C4::Context->preference("suggestion"),
 975         virtualshelves       => C4::Context->preference("virtualshelves"),
 976         LibraryName          => C4::Context->preference("LibraryName"),
 977         opacuserlogin        => C4::Context->preference("opacuserlogin"),
 978         OpacNav              => C4::Context->preference("OpacNav"),
 979         OpacNavBottom        => C4::Context->preference("OpacNavBottom"),
 980         opaccredits          => C4::Context->preference("opaccredits"),
 981         OpacFavicon          => C4::Context->preference("OpacFavicon"),
 982         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
 983         opacsmallimage       => C4::Context->preference("opacsmallimage"),
 984         opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
 985         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
 986         opacuserjs           => C4::Context->preference("opacuserjs"),
 987         opacbookbag          => "" . C4::Context->preference("opacbookbag"),
 988         OpacCloud            => C4::Context->preference("OpacCloud"),
 989         OpacTopissue         => C4::Context->preference("OpacTopissue"),
 990         OpacAuthorities      => C4::Context->preference("OpacAuthorities"),
 991         OpacBrowser          => C4::Context->preference("OpacBrowser"),
 992         opacheader           => C4::Context->preference("opacheader"),
 993         TagsEnabled                  => C4::Context->preference("TagsEnabled"),
 994         OPACUserCSS           => C4::Context->preference("OPACUserCSS"),
 995         opacstylesheet       => C4::Context->preference("opacstylesheet"),
 996         intranetcolorstylesheet =>
 997                                                                 C4::Context->preference("intranetcolorstylesheet"),
 998         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 999         intranetbookbag    => C4::Context->preference("intranetbookbag"),
1000         IntranetNav        => C4::Context->preference("IntranetNav"),
1001         intranetuserjs     => C4::Context->preference("intranetuserjs"),
1002         IndependantBranches=> C4::Context->preference("IndependantBranches"),
1003         AutoLocation       => C4::Context->preference("AutoLocation"),
1004                 wrongip            => $info{'wrongip'},
1005     );
1006
1007     $template->param( OpacPublic => C4::Context->preference("OpacPublic"));
1008     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1009
1010     if ($cas) {
1011
1012         # Is authentication against multiple CAS servers enabled?
1013         if (C4::Auth_with_cas::multipleAuth && !$casparam) {
1014             my $casservers = C4::Auth_with_cas::getMultipleAuth();
1015             my @tmplservers;
1016             foreach my $key (keys %$casservers) {
1017                 push @tmplservers, {name => $key, value => login_cas_url($query, $key) . "?cas=$key" };
1018             }
1019             #warn Data::Dumper::Dumper(\@tmplservers);
1020             $template->param(
1021                 casServersLoop => \@tmplservers
1022             );
1023         } else {
1024         $template->param(
1025             casServerUrl    => login_cas_url($query),
1026             );
1027         }
1028
1029         $template->param(
1030             invalidCasLogin => $info{'invalidCasLogin'}
1031         );
1032     }
1033
1034     my $self_url = $query->url( -absolute => 1 );
1035     $template->param(
1036         url         => $self_url,
1037         LibraryName => C4::Context->preference("LibraryName"),
1038     );
1039     $template->param( %info );
1040 #    $cookie = $query->cookie(CGISESSID => $session->id
1041 #   );
1042     print $query->header(
1043         -type   => 'text/html',
1044         -charset => 'utf-8',
1045         -cookie => $cookie
1046       ),
1047       $template->output;
1048     safe_exit;
1049 }
1050
1051 =head2 check_api_auth
1052
1053   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1054
1055 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1056 cookie, determine if the user has the privileges specified by C<$userflags>.
1057
1058 C<check_api_auth> is is meant for authenticating users of web services, and
1059 consequently will always return and will not attempt to redirect the user
1060 agent.
1061
1062 If a valid session cookie is already present, check_api_auth will return a status
1063 of "ok", the cookie, and the Koha session ID.
1064
1065 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1066 parameters and create a session cookie and Koha session if the supplied credentials
1067 are OK.
1068
1069 Possible return values in C<$status> are:
1070
1071 =over
1072
1073 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1074
1075 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1076
1077 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1078
1079 =item "expired -- session cookie has expired; API user should resubmit userid and password
1080
1081 =back
1082
1083 =cut
1084
1085 sub check_api_auth {
1086     my $query = shift;
1087     my $flagsrequired = shift;
1088
1089     my $dbh     = C4::Context->dbh;
1090     my $timeout = C4::Context->preference('timeout');
1091     $timeout = 600 unless $timeout;
1092
1093     unless (C4::Context->preference('Version')) {
1094         # database has not been installed yet
1095         return ("maintenance", undef, undef);
1096     }
1097     my $kohaversion=C4::Context::KOHAVERSION;
1098     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1099     if (C4::Context->preference('Version') < $kohaversion) {
1100         # database in need of version update; assume that
1101         # no API should be called while databsae is in
1102         # this condition.
1103         return ("maintenance", undef, undef);
1104     }
1105
1106     # FIXME -- most of what follows is a copy-and-paste
1107     # of code from checkauth.  There is an obvious need
1108     # for refactoring to separate the various parts of
1109     # the authentication code, but as of 2007-11-19 this
1110     # is deferred so as to not introduce bugs into the
1111     # regular authentication code for Koha 3.0.
1112
1113     # see if we have a valid session cookie already
1114     # however, if a userid parameter is present (i.e., from
1115     # a form submission, assume that any current cookie
1116     # is to be ignored
1117     my $sessionID = undef;
1118     unless ($query->param('userid')) {
1119         $sessionID = $query->cookie("CGISESSID");
1120     }
1121     if ($sessionID && not ($cas && $query->param('PT')) ) {
1122         my $session = get_session($sessionID);
1123         C4::Context->_new_userenv($sessionID);
1124         if ($session) {
1125             C4::Context::set_userenv(
1126                 $session->param('number'),       $session->param('id'),
1127                 $session->param('cardnumber'),   $session->param('firstname'),
1128                 $session->param('surname'),      $session->param('branch'),
1129                 $session->param('branchname'),   $session->param('flags'),
1130                 $session->param('emailaddress'), $session->param('branchprinter')
1131             );
1132
1133             my $ip = $session->param('ip');
1134             my $lasttime = $session->param('lasttime');
1135             my $userid = $session->param('id');
1136             if ( $lasttime < time() - $timeout ) {
1137                 # time out
1138                 $session->delete();
1139                 C4::Context->_unset_userenv($sessionID);
1140                 $userid    = undef;
1141                 $sessionID = undef;
1142                 return ("expired", undef, undef);
1143             } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1144                 # IP address changed
1145                 $session->delete();
1146                 C4::Context->_unset_userenv($sessionID);
1147                 $userid    = undef;
1148                 $sessionID = undef;
1149                 return ("expired", undef, undef);
1150             } else {
1151                 my $cookie = $query->cookie( CGISESSID => $session->id );
1152                 $session->param('lasttime',time());
1153                 my $flags = haspermission($userid, $flagsrequired);
1154                 if ($flags) {
1155                     return ("ok", $cookie, $sessionID);
1156                 } else {
1157                     $session->delete();
1158                     C4::Context->_unset_userenv($sessionID);
1159                     $userid    = undef;
1160                     $sessionID = undef;
1161                     return ("failed", undef, undef);
1162                 }
1163             }
1164         } else {
1165             return ("expired", undef, undef);
1166         }
1167     } else {
1168         # new login
1169         my $userid = $query->param('userid');
1170         my $password = $query->param('password');
1171         my ($return, $cardnumber);
1172
1173         # Proxy CAS auth
1174         if ($cas && $query->param('PT')) {
1175             my $retuserid;
1176             $debug and print STDERR "## check_api_auth - checking CAS\n";
1177             # In case of a CAS authentication, we use the ticket instead of the password
1178             my $PT = $query->param('PT');
1179             ($return,$cardnumber,$userid) = check_api_auth_cas($dbh, $PT, $query);    # EXTERNAL AUTH
1180         } else {
1181             # User / password auth
1182             unless ($userid and $password) {
1183                 # caller did something wrong, fail the authenticateion
1184                 return ("failed", undef, undef);
1185             }
1186             ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password, $query );
1187         }
1188
1189         if ($return and haspermission(  $userid, $flagsrequired)) {
1190             my $session = get_session("");
1191             return ("failed", undef, undef) unless $session;
1192
1193             my $sessionID = $session->id;
1194             C4::Context->_new_userenv($sessionID);
1195             my $cookie = $query->cookie(CGISESSID => $sessionID);
1196             if ( $return == 1 ) {
1197                 my (
1198                     $borrowernumber, $firstname,  $surname,
1199                     $userflags,      $branchcode, $branchname,
1200                     $branchprinter,  $emailaddress
1201                 );
1202                 my $sth =
1203                   $dbh->prepare(
1204 "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=?"
1205                   );
1206                 $sth->execute($userid);
1207                 (
1208                     $borrowernumber, $firstname,  $surname,
1209                     $userflags,      $branchcode, $branchname,
1210                     $branchprinter,  $emailaddress
1211                 ) = $sth->fetchrow if ( $sth->rows );
1212
1213                 unless ($sth->rows ) {
1214                     my $sth = $dbh->prepare(
1215 "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=?"
1216                       );
1217                     $sth->execute($cardnumber);
1218                     (
1219                         $borrowernumber, $firstname,  $surname,
1220                         $userflags,      $branchcode, $branchname,
1221                         $branchprinter,  $emailaddress
1222                     ) = $sth->fetchrow if ( $sth->rows );
1223
1224                     unless ( $sth->rows ) {
1225                         $sth->execute($userid);
1226                         (
1227                             $borrowernumber, $firstname, $surname, $userflags,
1228                             $branchcode, $branchname, $branchprinter, $emailaddress
1229                         ) = $sth->fetchrow if ( $sth->rows );
1230                     }
1231                 }
1232
1233                 my $ip       = $ENV{'REMOTE_ADDR'};
1234                 # if they specify at login, use that
1235                 if ($query->param('branch')) {
1236                     $branchcode  = $query->param('branch');
1237                     $branchname = GetBranchName($branchcode);
1238                 }
1239                 my $branches = GetBranches();
1240                 my @branchesloop;
1241                 foreach my $br ( keys %$branches ) {
1242                     #     now we work with the treatment of ip
1243                     my $domain = $branches->{$br}->{'branchip'};
1244                     if ( $domain && $ip =~ /^$domain/ ) {
1245                         $branchcode = $branches->{$br}->{'branchcode'};
1246
1247                         # new op dev : add the branchprinter and branchname in the cookie
1248                         $branchprinter = $branches->{$br}->{'branchprinter'};
1249                         $branchname    = $branches->{$br}->{'branchname'};
1250                     }
1251                 }
1252                 $session->param('number',$borrowernumber);
1253                 $session->param('id',$userid);
1254                 $session->param('cardnumber',$cardnumber);
1255                 $session->param('firstname',$firstname);
1256                 $session->param('surname',$surname);
1257                 $session->param('branch',$branchcode);
1258                 $session->param('branchname',$branchname);
1259                 $session->param('flags',$userflags);
1260                 $session->param('emailaddress',$emailaddress);
1261                 $session->param('ip',$session->remote_addr());
1262                 $session->param('lasttime',time());
1263             } elsif ( $return == 2 ) {
1264                 #We suppose the user is the superlibrarian
1265                 $session->param('number',0);
1266                 $session->param('id',C4::Context->config('user'));
1267                 $session->param('cardnumber',C4::Context->config('user'));
1268                 $session->param('firstname',C4::Context->config('user'));
1269                 $session->param('surname',C4::Context->config('user'));
1270                 $session->param('branch','NO_LIBRARY_SET');
1271                 $session->param('branchname','NO_LIBRARY_SET');
1272                 $session->param('flags',1);
1273                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
1274                 $session->param('ip',$session->remote_addr());
1275                 $session->param('lasttime',time());
1276             }
1277             C4::Context::set_userenv(
1278                 $session->param('number'),       $session->param('id'),
1279                 $session->param('cardnumber'),   $session->param('firstname'),
1280                 $session->param('surname'),      $session->param('branch'),
1281                 $session->param('branchname'),   $session->param('flags'),
1282                 $session->param('emailaddress'), $session->param('branchprinter')
1283             );
1284             return ("ok", $cookie, $sessionID);
1285         } else {
1286             return ("failed", undef, undef);
1287         }
1288     }
1289 }
1290
1291 =head2 check_cookie_auth
1292
1293   ($status, $sessionId) = check_api_auth($cookie, $userflags);
1294
1295 Given a CGISESSID cookie set during a previous login to Koha, determine
1296 if the user has the privileges specified by C<$userflags>.
1297
1298 C<check_cookie_auth> is meant for authenticating special services
1299 such as tools/upload-file.pl that are invoked by other pages that
1300 have been authenticated in the usual way.
1301
1302 Possible return values in C<$status> are:
1303
1304 =over
1305
1306 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1307
1308 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1309
1310 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1311
1312 =item "expired -- session cookie has expired; API user should resubmit userid and password
1313
1314 =back
1315
1316 =cut
1317
1318 sub check_cookie_auth {
1319     my $cookie = shift;
1320     my $flagsrequired = shift;
1321
1322     my $dbh     = C4::Context->dbh;
1323     my $timeout = C4::Context->preference('timeout');
1324     $timeout = 600 unless $timeout;
1325
1326     unless (C4::Context->preference('Version')) {
1327         # database has not been installed yet
1328         return ("maintenance", undef);
1329     }
1330     my $kohaversion=C4::Context::KOHAVERSION;
1331     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1332     if (C4::Context->preference('Version') < $kohaversion) {
1333         # database in need of version update; assume that
1334         # no API should be called while databsae is in
1335         # this condition.
1336         return ("maintenance", undef);
1337     }
1338
1339     # FIXME -- most of what follows is a copy-and-paste
1340     # of code from checkauth.  There is an obvious need
1341     # for refactoring to separate the various parts of
1342     # the authentication code, but as of 2007-11-23 this
1343     # is deferred so as to not introduce bugs into the
1344     # regular authentication code for Koha 3.0.
1345
1346     # see if we have a valid session cookie already
1347     # however, if a userid parameter is present (i.e., from
1348     # a form submission, assume that any current cookie
1349     # is to be ignored
1350     unless (defined $cookie and $cookie) {
1351         return ("failed", undef);
1352     }
1353     my $sessionID = $cookie;
1354     my $session = get_session($sessionID);
1355     C4::Context->_new_userenv($sessionID);
1356     if ($session) {
1357         C4::Context::set_userenv(
1358             $session->param('number'),       $session->param('id'),
1359             $session->param('cardnumber'),   $session->param('firstname'),
1360             $session->param('surname'),      $session->param('branch'),
1361             $session->param('branchname'),   $session->param('flags'),
1362             $session->param('emailaddress'), $session->param('branchprinter')
1363         );
1364
1365         my $ip = $session->param('ip');
1366         my $lasttime = $session->param('lasttime');
1367         my $userid = $session->param('id');
1368         if ( $lasttime < time() - $timeout ) {
1369             # time out
1370             $session->delete();
1371             C4::Context->_unset_userenv($sessionID);
1372             $userid    = undef;
1373             $sessionID = undef;
1374             return ("expired", undef);
1375         } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1376             # IP address changed
1377             $session->delete();
1378             C4::Context->_unset_userenv($sessionID);
1379             $userid    = undef;
1380             $sessionID = undef;
1381             return ("expired", undef);
1382         } else {
1383             $session->param('lasttime',time());
1384             my $flags = haspermission($userid, $flagsrequired);
1385             if ($flags) {
1386                 return ("ok", $sessionID);
1387             } else {
1388                 $session->delete();
1389                 C4::Context->_unset_userenv($sessionID);
1390                 $userid    = undef;
1391                 $sessionID = undef;
1392                 return ("failed", undef);
1393             }
1394         }
1395     } else {
1396         return ("expired", undef);
1397     }
1398 }
1399
1400 =head2 get_session
1401
1402   use CGI::Session;
1403   my $session = get_session($sessionID);
1404
1405 Given a session ID, retrieve the CGI::Session object used to store
1406 the session's state.  The session object can be used to store
1407 data that needs to be accessed by different scripts during a
1408 user's session.
1409
1410 If the C<$sessionID> parameter is an empty string, a new session
1411 will be created.
1412
1413 =cut
1414
1415 sub get_session {
1416     my $sessionID = shift;
1417     my $storage_method = C4::Context->preference('SessionStorage');
1418     my $dbh = C4::Context->dbh;
1419     my $session;
1420     if ($storage_method eq 'mysql'){
1421         $session = new CGI::Session("driver:MySQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1422     }
1423     elsif ($storage_method eq 'Pg') {
1424         $session = new CGI::Session("driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1425     }
1426     elsif ($storage_method eq 'memcached' && $servers){
1427         $session = new CGI::Session("driver:memcached;serializer:yaml;id:md5", $sessionID, { Memcached => $memcached } );
1428     }
1429     else {
1430         # catch all defaults to tmp should work on all systems
1431         $session = new CGI::Session("driver:File;serializer:yaml;id:md5", $sessionID, {Directory=>'/tmp'});
1432     }
1433     return $session;
1434 }
1435
1436 sub checkpw {
1437
1438     my ( $dbh, $userid, $password, $query ) = @_;
1439     if ($ldap) {
1440         $debug and print "## checkpw - checking LDAP\n";
1441         my ($retval,$retcard,$retuserid) = checkpw_ldap(@_);    # EXTERNAL AUTH
1442         ($retval) and return ($retval,$retcard,$retuserid);
1443     }
1444
1445     if ($cas && $query && $query->param('ticket')) {
1446         $debug and print STDERR "## checkpw - checking CAS\n";
1447         # In case of a CAS authentication, we use the ticket instead of the password
1448         my $ticket = $query->param('ticket');
1449         my ($retval,$retcard,$retuserid) = checkpw_cas($dbh, $ticket, $query);    # EXTERNAL AUTH
1450         ($retval) and return ($retval,$retcard,$retuserid);
1451         return 0;
1452     }
1453
1454     # INTERNAL AUTH
1455     my $sth =
1456       $dbh->prepare(
1457 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1458       );
1459     $sth->execute($userid);
1460     if ( $sth->rows ) {
1461         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1462             $surname, $branchcode, $flags )
1463           = $sth->fetchrow;
1464         if ( md5_base64($password) eq $md5password and $md5password ne "!") {
1465
1466             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1467                 $firstname, $surname, $branchcode, $flags );
1468             return 1, $cardnumber, $userid;
1469         }
1470     }
1471     $sth =
1472       $dbh->prepare(
1473 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1474       );
1475     $sth->execute($userid);
1476     if ( $sth->rows ) {
1477         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1478             $surname, $branchcode, $flags )
1479           = $sth->fetchrow;
1480         if ( md5_base64($password) eq $md5password ) {
1481
1482             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1483                 $firstname, $surname, $branchcode, $flags );
1484             return 1, $cardnumber, $userid;
1485         }
1486     }
1487     if (   $userid && $userid eq C4::Context->config('user')
1488         && "$password" eq C4::Context->config('pass') )
1489     {
1490
1491 # Koha superuser account
1492 #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1493         return 2;
1494     }
1495     if (   $userid && $userid eq 'demo'
1496         && "$password" eq 'demo'
1497         && C4::Context->config('demo') )
1498     {
1499
1500 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1501 # some features won't be effective : modify systempref, modify MARC structure,
1502         return 2;
1503     }
1504     return 0;
1505 }
1506
1507 =head2 getuserflags
1508
1509     my $authflags = getuserflags($flags, $userid, [$dbh]);
1510
1511 Translates integer flags into permissions strings hash.
1512
1513 C<$flags> is the integer userflags value ( borrowers.userflags )
1514 C<$userid> is the members.userid, used for building subpermissions
1515 C<$authflags> is a hashref of permissions
1516
1517 =cut
1518
1519 sub getuserflags {
1520     my $flags   = shift;
1521     my $userid  = shift;
1522     my $dbh     = @_ ? shift : C4::Context->dbh;
1523     my $userflags;
1524     $flags = 0 unless $flags;
1525     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1526     $sth->execute;
1527
1528     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1529         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1530             $userflags->{$flag} = 1;
1531         }
1532         else {
1533             $userflags->{$flag} = 0;
1534         }
1535     }
1536
1537     # get subpermissions and merge with top-level permissions
1538     my $user_subperms = get_user_subpermissions($userid);
1539     foreach my $module (keys %$user_subperms) {
1540         next if $userflags->{$module} == 1; # user already has permission for everything in this module
1541         $userflags->{$module} = $user_subperms->{$module};
1542     }
1543
1544     return $userflags;
1545 }
1546
1547 =head2 get_user_subpermissions
1548
1549   $user_perm_hashref = get_user_subpermissions($userid);
1550
1551 Given the userid (note, not the borrowernumber) of a staff user,
1552 return a hashref of hashrefs of the specific subpermissions
1553 accorded to the user.  An example return is
1554
1555  {
1556     tools => {
1557         export_catalog => 1,
1558         import_patrons => 1,
1559     }
1560  }
1561
1562 The top-level hash-key is a module or function code from
1563 userflags.flag, while the second-level key is a code
1564 from permissions.
1565
1566 The results of this function do not give a complete picture
1567 of the functions that a staff user can access; it is also
1568 necessary to check borrowers.flags.
1569
1570 =cut
1571
1572 sub get_user_subpermissions {
1573     my $userid = shift;
1574
1575     my $dbh = C4::Context->dbh;
1576     my $sth = $dbh->prepare("SELECT flag, user_permissions.code
1577                              FROM user_permissions
1578                              JOIN permissions USING (module_bit, code)
1579                              JOIN userflags ON (module_bit = bit)
1580                              JOIN borrowers USING (borrowernumber)
1581                              WHERE userid = ?");
1582     $sth->execute($userid);
1583
1584     my $user_perms = {};
1585     while (my $perm = $sth->fetchrow_hashref) {
1586         $user_perms->{$perm->{'flag'}}->{$perm->{'code'}} = 1;
1587     }
1588     return $user_perms;
1589 }
1590
1591 =head2 get_all_subpermissions
1592
1593   my $perm_hashref = get_all_subpermissions();
1594
1595 Returns a hashref of hashrefs defining all specific
1596 permissions currently defined.  The return value
1597 has the same structure as that of C<get_user_subpermissions>,
1598 except that the innermost hash value is the description
1599 of the subpermission.
1600
1601 =cut
1602
1603 sub get_all_subpermissions {
1604     my $dbh = C4::Context->dbh;
1605     my $sth = $dbh->prepare("SELECT flag, code, description
1606                              FROM permissions
1607                              JOIN userflags ON (module_bit = bit)");
1608     $sth->execute();
1609
1610     my $all_perms = {};
1611     while (my $perm = $sth->fetchrow_hashref) {
1612         $all_perms->{$perm->{'flag'}}->{$perm->{'code'}} = $perm->{'description'};
1613     }
1614     return $all_perms;
1615 }
1616
1617 =head2 haspermission
1618
1619   $flags = ($userid, $flagsrequired);
1620
1621 C<$userid> the userid of the member
1622 C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
1623
1624 Returns member's flags or 0 if a permission is not met.
1625
1626 =cut
1627
1628 sub haspermission {
1629     my ($userid, $flagsrequired) = @_;
1630     my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1631     $sth->execute($userid);
1632     my $flags = getuserflags($sth->fetchrow(), $userid);
1633     if ( $userid eq C4::Context->config('user') ) {
1634         # Super User Account from /etc/koha.conf
1635         $flags->{'superlibrarian'} = 1;
1636     }
1637     elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
1638         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1639         $flags->{'superlibrarian'} = 1;
1640     }
1641
1642     return $flags if $flags->{superlibrarian};
1643
1644     foreach my $module ( keys %$flagsrequired ) {
1645         my $subperm = $flagsrequired->{$module};
1646         if ($subperm eq '*') {
1647             return 0 unless ( $flags->{$module} == 1 or ref($flags->{$module}) );
1648         } else {
1649             return 0 unless ( $flags->{$module} == 1 or
1650                                 ( ref($flags->{$module}) and
1651                                   exists $flags->{$module}->{$subperm} and
1652                                   $flags->{$module}->{$subperm} == 1
1653                                 )
1654                             );
1655         }
1656     }
1657     return $flags;
1658     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1659 }
1660
1661
1662 sub getborrowernumber {
1663     my ($userid) = @_;
1664     my $userenv = C4::Context->userenv;
1665     if ( defined( $userenv ) && ref( $userenv ) eq 'HASH' && $userenv->{number} ) {
1666         return $userenv->{number};
1667     }
1668     my $dbh = C4::Context->dbh;
1669     for my $field ( 'userid', 'cardnumber' ) {
1670         my $sth =
1671           $dbh->prepare("select borrowernumber from borrowers where $field=?");
1672         $sth->execute($userid);
1673         if ( $sth->rows ) {
1674             my ($bnumber) = $sth->fetchrow;
1675             return $bnumber;
1676         }
1677     }
1678     return 0;
1679 }
1680
1681 END { }    # module clean-up code here (global destructor)
1682 1;
1683 __END__
1684
1685 =head1 SEE ALSO
1686
1687 CGI(3)
1688
1689 C4::Output(3)
1690
1691 Digest::MD5(3)
1692
1693 =cut