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