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