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