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