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