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