C4/Auth.pm

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