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