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