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     if ($user) {
 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 ) {
 189             $template->param( CAN_user_circulate        => 1 );
 190             $template->param( CAN_user_catalogue        => 1 );
 191             $template->param( CAN_user_parameters       => 1 );
 192             $template->param( CAN_user_borrowers        => 1 );
 193             $template->param( CAN_user_permissions      => 1 );
 194             $template->param( CAN_user_reserveforothers => 1 );
 195             $template->param( CAN_user_borrow           => 1 );
 196             $template->param( CAN_user_editcatalogue    => 1 );
 197             $template->param( CAN_user_updatecharges    => 1 );
 198             $template->param( CAN_user_acquisition      => 1 );
 199             $template->param( CAN_user_management       => 1 );
 200             $template->param( CAN_user_tools            => 1 );
 201             $template->param( CAN_user_editauthorities  => 1 );
 202             $template->param( CAN_user_serials          => 1 );
 203             $template->param( CAN_user_reports          => 1 );
 204             $template->param( CAN_user_staffaccess      => 1 );
 205             foreach my $module (keys %$all_perms) {
 206                 foreach my $subperm (keys %{ $all_perms->{$module} }) {
 207                     $template->param( "CAN_user_${module}_${subperm}" => 1 );
 208                 }
 209             }
 210         }
 211
 212         if ( $flags ) {
 213             foreach my $module (keys %$all_perms) {
 214                 if ( $flags->{$module} == 1) {
 215                     foreach my $subperm (keys %{ $all_perms->{$module} }) {
 216                         $template->param( "CAN_user_${module}_${subperm}" => 1 );
 217                     }
 218                 } elsif ( ref($flags->{$module}) ) {
 219                     foreach my $subperm (keys %{ $flags->{$module} } ) {
 220                         $template->param( "CAN_user_${module}_${subperm}" => 1 );
 221                     }
 222                 }
 223             }
 224         }
 225
 226         if ($flags) {
 227             foreach my $module (keys %$flags) {
 228                 if ( $flags->{$module} == 1 or ref($flags->{$module}) ) {
 229                     $template->param( "CAN_user_$module" => 1 );
 230                     if ($module eq "parameters") {
 231                         $template->param( CAN_user_management => 1 );
 232                     }
 233                 }
 234             }
 235         }
 236         # Logged-in opac search history
 237         # If the requested template is an opac one and opac search history is enabled
 238         if ($in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory')) {
 239             my $dbh = C4::Context->dbh;
 240             my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
 241             my $sth = $dbh->prepare($query);
 242             $sth->execute($borrowernumber);
 243
 244             # If at least one search has already been performed
 245             if ($sth->fetchrow_array > 0) {
 246             # We show the link in opac
 247             $template->param(ShowOpacRecentSearchLink => 1);
 248             }
 249
 250             # And if there's a cookie with searches performed when the user was not logged in,
 251             # we add them to the logged-in search history
 252             my $searchcookie = $in->{'query'}->cookie('KohaOpacRecentSearches');
 253             if ($searchcookie){
 254                 $searchcookie = uri_unescape($searchcookie);
 255                     my @recentSearches = @{thaw($searchcookie) || []};
 256                 if (@recentSearches) {
 257                     my $sth = $dbh->prepare($SEARCH_HISTORY_INSERT_SQL);
 258                     $sth->execute( $borrowernumber,
 259                                $in->{'query'}->cookie("CGISESSID"),
 260                                $_->{'query_desc'},
 261                                $_->{'query_cgi'},
 262                                $_->{'total'},
 263                                $_->{'time'},
 264                             ) foreach @recentSearches;
 265
 266                     # And then, delete the cookie's content
 267                     my $newsearchcookie = $in->{'query'}->cookie(
 268                                                 -name => 'KohaOpacRecentSearches',
 269                                                 -value => freeze([]),
 270                                                 -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 = @{thaw($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         $template->param( dateformat => C4::Context->preference('dateformat') );
 304         if(C4::Context->preference('dateformat') eq "metric"){
 305             $template->param(dateformat_metric => 1);
 306         } elsif(C4::Context->preference('dateformat') eq "us"){
 307             $template->param(dateformat_us => 1);
 308         } else {
 309             $template->param(dateformat_iso => 1);
 310         }
 311     } else {
 312         $template->param(dateformat_iso => 1);
 313     }
 314
 315     # these template parameters are set the same regardless of $in->{'type'}
 316     $template->param(
 317             "BiblioDefaultView".C4::Context->preference("BiblioDefaultView")         => 1,
 318             EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
 319             GoogleJackets                => C4::Context->preference("GoogleJackets"),
 320             OpenLibraryCovers            => C4::Context->preference("OpenLibraryCovers"),
 321             KohaAdminEmailAddress        => "" . C4::Context->preference("KohaAdminEmailAddress"),
 322             LoginBranchcode              => (C4::Context->userenv?C4::Context->userenv->{"branch"}:undef),
 323             LoginFirstname               => (C4::Context->userenv?C4::Context->userenv->{"firstname"}:"Bel"),
 324             LoginSurname                 => C4::Context->userenv?C4::Context->userenv->{"surname"}:"Inconnu",
 325             emailaddress                 => C4::Context->userenv?C4::Context->userenv->{"emailaddress"}:undef,
 326             loggedinpersona              => C4::Context->userenv?C4::Context->userenv->{"persona"}: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     if ( $in->{'type'} eq "intranet" ) {
 340         $template->param(
 341             AmazonCoverImages           => C4::Context->preference("AmazonCoverImages"),
 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"}:undef),
 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             EasyAnalyticalRecords       => C4::Context->preference('EasyAnalyticalRecords'),
 365             LocalCoverImages            => C4::Context->preference('LocalCoverImages'),
 366             OPACLocalCoverImages        => C4::Context->preference('OPACLocalCoverImages'),
 367             AllowMultipleCovers         => C4::Context->preference('AllowMultipleCovers'),
 368             EnableBorrowerFiles         => C4::Context->preference('EnableBorrowerFiles'),
 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         $template->param(
 392             opaccolorstylesheet       => C4::Context->preference("opaccolorstylesheet"),
 393             AnonSuggestions           => "" . C4::Context->preference("AnonSuggestions"),
 394             AuthorisedValueImages     => C4::Context->preference("AuthorisedValueImages"),
 395             BranchesLoop              => GetBranchesLoop($opac_name),
 396             CalendarFirstDayOfWeek      => (C4::Context->preference("CalendarFirstDayOfWeek") eq "Sunday")?0:1,
 397             LibraryName               => "" . C4::Context->preference("LibraryName"),
 398             LibraryNameTitle          => "" . $LibraryNameTitle,
 399             LoginBranchname           => C4::Context->userenv?C4::Context->userenv->{"branchname"}:"",
 400             OPACAmazonCoverImages     => C4::Context->preference("OPACAmazonCoverImages"),
 401             OPACFRBRizeEditions       => C4::Context->preference("OPACFRBRizeEditions"),
 402             OpacHighlightedWords       => C4::Context->preference("OpacHighlightedWords"),
 403             OPACItemHolds             => C4::Context->preference("OPACItemHolds"),
 404             OPACShelfBrowser          => "". C4::Context->preference("OPACShelfBrowser"),
 405             OpacShowRecentComments    => C4::Context->preference("OpacShowRecentComments"),
 406             OPACURLOpenInNewWindow    => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
 407             OPACUserCSS               => "". C4::Context->preference("OPACUserCSS"),
 408             OPACMobileUserCSS         => "". C4::Context->preference("OPACMobileUserCSS"),
 409             OPACViewOthersSuggestions => "" . C4::Context->preference("OPACViewOthersSuggestions"),
 410             OpacAuthorities           => C4::Context->preference("OpacAuthorities"),
 411             OPACBaseURL               => ($in->{'query'}->https() ? "https://" : "http://") . $ENV{'SERVER_NAME'} .
 412                    ($ENV{'SERVER_PORT'} eq ($in->{'query'}->https() ? "443" : "80") ? '' : ":$ENV{'SERVER_PORT'}"),
 413             opac_css_override           => $ENV{'OPAC_CSS_OVERRIDE'},
 414             opac_search_limit         => $opac_search_limit,
 415             opac_limit_override       => $opac_limit_override,
 416             OpacBrowser               => C4::Context->preference("OpacBrowser"),
 417             OpacCloud                 => C4::Context->preference("OpacCloud"),
 418             OpacKohaUrl               => C4::Context->preference("OpacKohaUrl"),
 419             OpacMainUserBlock         => "" . C4::Context->preference("OpacMainUserBlock"),
 420             OpacMainUserBlockMobile   => "" . C4::Context->preference("OpacMainUserBlockMobile"),
 421             OpacShowFiltersPulldownMobile => C4::Context->preference("OpacShowFiltersPulldownMobile"),
 422             OpacShowLibrariesPulldownMobile => C4::Context->preference("OpacShowLibrariesPulldownMobile"),
 423             OpacNav                   => "" . C4::Context->preference("OpacNav"),
 424             OpacNavRight              => "" . C4::Context->preference("OpacNavRight"),
 425             OpacNavBottom             => "" . C4::Context->preference("OpacNavBottom"),
 426             OpacPasswordChange        => C4::Context->preference("OpacPasswordChange"),
 427             OPACPatronDetails        => C4::Context->preference("OPACPatronDetails"),
 428             OPACPrivacy               => C4::Context->preference("OPACPrivacy"),
 429             OPACFinesTab              => C4::Context->preference("OPACFinesTab"),
 430             OpacTopissue              => C4::Context->preference("OpacTopissue"),
 431             RequestOnOpac             => C4::Context->preference("RequestOnOpac"),
 432             'Version'                 => C4::Context->preference('Version'),
 433             hidelostitems             => C4::Context->preference("hidelostitems"),
 434             mylibraryfirst            => (C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv) ? C4::Context->userenv->{'branch'} : '',
 435             opaclayoutstylesheet      => "" . C4::Context->preference("opaclayoutstylesheet"),
 436             opacbookbag               => "" . C4::Context->preference("opacbookbag"),
 437             opaccredits               => "" . C4::Context->preference("opaccredits"),
 438             OpacFavicon               => C4::Context->preference("OpacFavicon"),
 439             opacheader                => "" . C4::Context->preference("opacheader"),
 440             opaclanguagesdisplay      => "" . C4::Context->preference("opaclanguagesdisplay"),
 441             opacreadinghistory        => C4::Context->preference("opacreadinghistory"),
 442             opacsmallimage            => "" . C4::Context->preference("opacsmallimage"),
 443             opacuserjs                => C4::Context->preference("opacuserjs"),
 444             opacuserlogin             => "" . C4::Context->preference("opacuserlogin"),
 445             reviewson                 => C4::Context->preference("reviewson"),
 446             ShowReviewer              => C4::Context->preference("ShowReviewer"),
 447             ShowReviewerPhoto         => C4::Context->preference("ShowReviewerPhoto"),
 448             suggestion                => "" . C4::Context->preference("suggestion"),
 449             virtualshelves            => "" . C4::Context->preference("virtualshelves"),
 450             OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
 451             OpacAddMastheadLibraryPulldown => C4::Context->preference("OpacAddMastheadLibraryPulldown"),
 452             OPACXSLTDetailsDisplay           => C4::Context->preference("OPACXSLTDetailsDisplay"),
 453             OPACXSLTResultsDisplay           => C4::Context->preference("OPACXSLTResultsDisplay"),
 454             SyndeticsClientCode          => C4::Context->preference("SyndeticsClientCode"),
 455             SyndeticsEnabled             => C4::Context->preference("SyndeticsEnabled"),
 456             SyndeticsCoverImages         => C4::Context->preference("SyndeticsCoverImages"),
 457             SyndeticsTOC                 => C4::Context->preference("SyndeticsTOC"),
 458             SyndeticsSummary             => C4::Context->preference("SyndeticsSummary"),
 459             SyndeticsEditions            => C4::Context->preference("SyndeticsEditions"),
 460             SyndeticsExcerpt             => C4::Context->preference("SyndeticsExcerpt"),
 461             SyndeticsReviews             => C4::Context->preference("SyndeticsReviews"),
 462             SyndeticsAuthorNotes         => C4::Context->preference("SyndeticsAuthorNotes"),
 463             SyndeticsAwards              => C4::Context->preference("SyndeticsAwards"),
 464             SyndeticsSeries              => C4::Context->preference("SyndeticsSeries"),
 465             SyndeticsCoverImageSize      => C4::Context->preference("SyndeticsCoverImageSize"),
 466             OPACLocalCoverImages         => C4::Context->preference("OPACLocalCoverImages"),
 467             PatronSelfRegistration       => C4::Context->preference("PatronSelfRegistration"),
 468             PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
 469         );
 470
 471         $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic"));
 472     }
 473     return ( $template, $borrowernumber, $cookie, $flags);
 474 }
 475
 476 =head2 checkauth
 477
 478   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 479
 480 Verifies that the user is authorized to run this script.  If
 481 the user is authorized, a (userid, cookie, session-id, flags)
 482 quadruple is returned.  If the user is not authorized but does
 483 not have the required privilege (see $flagsrequired below), it
 484 displays an error page and exits.  Otherwise, it displays the
 485 login page and exits.
 486
 487 Note that C<&checkauth> will return if and only if the user
 488 is authorized, so it should be called early on, before any
 489 unfinished operations (e.g., if you've opened a file, then
 490 C<&checkauth> won't close it for you).
 491
 492 C<$query> is the CGI object for the script calling C<&checkauth>.
 493
 494 The C<$noauth> argument is optional. If it is set, then no
 495 authorization is required for the script.
 496
 497 C<&checkauth> fetches user and session information from C<$query> and
 498 ensures that the user is authorized to run scripts that require
 499 authorization.
 500
 501 The C<$flagsrequired> argument specifies the required privileges
 502 the user must have if the username and password are correct.
 503 It should be specified as a reference-to-hash; keys in the hash
 504 should be the "flags" for the user, as specified in the Members
 505 intranet module. Any key specified must correspond to a "flag"
 506 in the userflags table. E.g., { circulate => 1 } would specify
 507 that the user must have the "circulate" privilege in order to
 508 proceed. To make sure that access control is correct, the
 509 C<$flagsrequired> parameter must be specified correctly.
 510
 511 Koha also has a concept of sub-permissions, also known as
 512 granular permissions.  This makes the value of each key
 513 in the C<flagsrequired> hash take on an additional
 514 meaning, i.e.,
 515
 516  1
 517
 518 The user must have access to all subfunctions of the module
 519 specified by the hash key.
 520
 521  *
 522
 523 The user must have access to at least one subfunction of the module
 524 specified by the hash key.
 525
 526  specific permission, e.g., 'export_catalog'
 527
 528 The user must have access to the specific subfunction list, which
 529 must correspond to a row in the permissions table.
 530
 531 The C<$type> argument specifies whether the template should be
 532 retrieved from the opac or intranet directory tree.  "opac" is
 533 assumed if it is not specified; however, if C<$type> is specified,
 534 "intranet" is assumed if it is not "opac".
 535
 536 If C<$query> does not have a valid session ID associated with it
 537 (i.e., the user has not logged in) or if the session has expired,
 538 C<&checkauth> presents the user with a login page (from the point of
 539 view of the original script, C<&checkauth> does not return). Once the
 540 user has authenticated, C<&checkauth> restarts the original script
 541 (this time, C<&checkauth> returns).
 542
 543 The login page is provided using a HTML::Template, which is set in the
 544 systempreferences table or at the top of this file. The variable C<$type>
 545 selects which template to use, either the opac or the intranet
 546 authentification template.
 547
 548 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 549 cookie should be sent back to the browser; it verifies that the user
 550 has authenticated.
 551
 552 =cut
 553
 554 sub _version_check {
 555     my $type = shift;
 556     my $query = shift;
 557     my $version;
 558     # If Version syspref is unavailable, it means Koha is beeing installed,
 559     # and so we must redirect to OPAC maintenance page or to the WebInstaller
 560     # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
 561     if (C4::Context->preference('OpacMaintenance') && $type eq 'opac') {
 562         warn "OPAC Install required, redirecting to maintenance";
 563         print $query->redirect("/cgi-bin/koha/maintenance.pl");
 564         safe_exit;
 565     }
 566     unless ( $version = C4::Context->preference('Version') ) {    # assignment, not comparison
 567         if ( $type ne 'opac' ) {
 568             warn "Install required, redirecting to Installer";
 569             print $query->redirect("/cgi-bin/koha/installer/install.pl");
 570         } else {
 571             warn "OPAC Install required, redirecting to maintenance";
 572             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 573         }
 574         safe_exit;
 575     }
 576
 577     # check that database and koha version are the same
 578     # there is no DB version, it's a fresh install,
 579     # go to web installer
 580     # there is a DB version, compare it to the code version
 581     my $kohaversion=C4::Context::KOHAVERSION;
 582     # remove the 3 last . to have a Perl number
 583     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 584     $debug and print STDERR "kohaversion : $kohaversion\n";
 585     if ($version < $kohaversion){
 586         my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
 587         if ($type ne 'opac'){
 588             warn sprintf($warning, 'Installer');
 589             print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
 590         } else {
 591             warn sprintf("OPAC: " . $warning, 'maintenance');
 592             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 593         }
 594         safe_exit;
 595     }
 596 }
 597
 598 sub _session_log {
 599     (@_) or return 0;
 600     open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
 601     printf $fh join("\n",@_);
 602     close $fh;
 603 }
 604
 605 sub _timeout_syspref {
 606     my $timeout = C4::Context->preference('timeout') || 600;
 607     # value in days, convert in seconds
 608     if ($timeout =~ /(\d+)[dD]/) {
 609         $timeout = $1 * 86400;
 610     };
 611     return $timeout;
 612 }
 613
 614 sub checkauth {
 615     my $query = shift;
 616     $debug and warn "Checking Auth";
 617     # $authnotrequired will be set for scripts which will run without authentication
 618     my $authnotrequired = shift;
 619     my $flagsrequired   = shift;
 620     my $type            = shift;
 621     my $persona         = shift;
 622     $type = 'opac' unless $type;
 623
 624     my $dbh     = C4::Context->dbh;
 625     my $timeout = _timeout_syspref();
 626
 627     _version_check($type,$query);
 628     # state variables
 629     my $loggedin = 0;
 630     my %info;
 631     my ( $userid, $cookie, $sessionID, $flags, $barshelves, $pubshelves );
 632     my $logout = $query->param('logout.x');
 633
 634     # This parameter is the name of the CAS server we want to authenticate against,
 635     # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
 636     my $casparam = $query->param('cas');
 637
 638     if ( $userid = $ENV{'REMOTE_USER'} ) {
 639             # Using Basic Authentication, no cookies required
 640         $cookie = $query->cookie(
 641             -name     => 'CGISESSID',
 642             -value    => '',
 643             -expires  => '',
 644             -HttpOnly => 1,
 645         );
 646         $loggedin = 1;
 647     }
 648     elsif ( $persona ){
 649       # we dont want to set a session because we are being called by a persona callback
 650     }
 651     elsif ( $sessionID = $query->cookie("CGISESSID") )
 652     {    # assignment, not comparison
 653         my $session = get_session($sessionID);
 654         C4::Context->_new_userenv($sessionID);
 655         my ($ip, $lasttime, $sessiontype);
 656         if ($session){
 657             C4::Context::set_userenv(
 658                 $session->param('number'),       $session->param('id'),
 659                 $session->param('cardnumber'),   $session->param('firstname'),
 660                 $session->param('surname'),      $session->param('branch'),
 661                 $session->param('branchname'),   $session->param('flags'),
 662                 $session->param('emailaddress'), $session->param('branchprinter'),
 663                 $session->param('persona')
 664             );
 665             C4::Context::set_shelves_userenv('bar',$session->param('barshelves'));
 666             C4::Context::set_shelves_userenv('pub',$session->param('pubshelves'));
 667             C4::Context::set_shelves_userenv('tot',$session->param('totshelves'));
 668             $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 669             $ip       = $session->param('ip');
 670             $lasttime = $session->param('lasttime');
 671             $userid   = $session->param('id');
 672             $sessiontype = $session->param('sessiontype') || '';
 673         }
 674         if ( ( ($query->param('koha_login_context')) && ($query->param('userid') ne $session->param('id')) )
 675           || ( $cas && $query->param('ticket') ) ) {
 676             #if a user enters an id ne to the id in the current session, we need to log them in...
 677             #first we need to clear the anonymous session...
 678             $debug and warn "query id = " . $query->param('userid') . " but session id = " . $session->param('id');
 679             $session->flush;
 680             $session->delete();
 681             C4::Context->_unset_userenv($sessionID);
 682             $sessionID = undef;
 683             $userid = undef;
 684         }
 685         elsif ($logout) {
 686             # voluntary logout the user
 687             $session->flush;
 688             $session->delete();
 689             C4::Context->_unset_userenv($sessionID);
 690             #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
 691             $sessionID = undef;
 692             $userid    = undef;
 693
 694         if ($cas and $caslogout) {
 695         logout_cas($query);
 696         }
 697         }
 698         elsif ( $lasttime < time() - $timeout ) {
 699             # timed logout
 700             $info{'timed_out'} = 1;
 701             $session->delete() if $session;
 702             C4::Context->_unset_userenv($sessionID);
 703             #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
 704             $userid    = undef;
 705             $sessionID = undef;
 706         }
 707         elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 708             # Different ip than originally logged in from
 709             $info{'oldip'}        = $ip;
 710             $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 711             $info{'different_ip'} = 1;
 712             $session->delete();
 713             C4::Context->_unset_userenv($sessionID);
 714             #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
 715             $sessionID = undef;
 716             $userid    = undef;
 717         }
 718         else {
 719             $cookie = $query->cookie(
 720                 -name     => 'CGISESSID',
 721                 -value    => $session->id,
 722                 -HttpOnly => 1
 723             );
 724             $session->param( 'lasttime', time() );
 725             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...
 726                 $flags = haspermission($userid, $flagsrequired);
 727                 if ($flags) {
 728                     $loggedin = 1;
 729                 } else {
 730                     $info{'nopermission'} = 1;
 731                 }
 732             }
 733         }
 734     }
 735     unless ($userid || $sessionID) {
 736
 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' || $persona )
 751         {
 752             my $password = $query->param('password');
 753
 754             my ( $return, $cardnumber );
 755             if ( $cas && $query->param('ticket') ) {
 756                 my $retuserid;
 757                 ( $return, $cardnumber, $retuserid ) =
 758                   checkpw( $dbh, $userid, $password, $query );
 759                 $userid = $retuserid;
 760                 $info{'invalidCasLogin'} = 1 unless ($return);
 761             }
 762
 763     elsif ($persona) {
 764         my $value = $persona;
 765
 766         # If we're looking up the email, there's a chance that the person
 767         # doesn't have a userid. So if there is none, we pass along the
 768         # borrower number, and the bits of code that need to know the user
 769         # ID will have to be smart enough to handle that.
 770         require C4::Members;
 771         my @users_info = C4::Members::GetBorrowersWithEmail($value);
 772         if (@users_info) {
 773
 774             # First the userid, then the borrowernum
 775             $value = $users_info[0][1] || $users_info[0][0];
 776         }
 777         else {
 778             undef $value;
 779         }
 780         $return = $value ? 1 : 0;
 781         $userid = $value;
 782     }
 783
 784     elsif (
 785                 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
 786                 || (   $pki_field eq 'emailAddress'
 787                     && $ENV{'SSL_CLIENT_S_DN_Email'} )
 788               )
 789             {
 790                 my $value;
 791                 if ( $pki_field eq 'Common Name' ) {
 792                     $value = $ENV{'SSL_CLIENT_S_DN_CN'};
 793                 }
 794                 elsif ( $pki_field eq 'emailAddress' ) {
 795                     $value = $ENV{'SSL_CLIENT_S_DN_Email'};
 796
 797               # If we're looking up the email, there's a chance that the person
 798               # doesn't have a userid. So if there is none, we pass along the
 799               # borrower number, and the bits of code that need to know the user
 800               # ID will have to be smart enough to handle that.
 801                     require C4::Members;
 802                     my @users_info = C4::Members::GetBorrowersWithEmail($value);
 803                     if (@users_info) {
 804
 805                         # First the userid, then the borrowernum
 806                         $value = $users_info[0][1] || $users_info[0][0];
 807                     } else {
 808                         undef $value;
 809                     }
 810                 }
 811
 812
 813                 $return = $value ? 1 : 0;
 814                 $userid = $value;
 815
 816     }
 817             else {
 818                 my $retuserid;
 819                 ( $return, $cardnumber, $retuserid ) =
 820                   checkpw( $dbh, $userid, $password, $query );
 821                 $userid = $retuserid if ( $retuserid ne '' );
 822         }
 823         if ($return) {
 824                #_session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
 825                 if ( $flags = haspermission(  $userid, $flagsrequired ) ) {
 826                     $loggedin = 1;
 827                 }
 828                    else {
 829                     $info{'nopermission'} = 1;
 830                     C4::Context->_unset_userenv($sessionID);
 831                 }
 832                 my ($borrowernumber, $firstname, $surname, $userflags,
 833                     $branchcode, $branchname, $branchprinter, $emailaddress);
 834
 835                 if ( $return == 1 ) {
 836                     my $select = "
 837                     SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
 838                     branches.branchname    as branchname,
 839                     branches.branchprinter as branchprinter,
 840                     email
 841                     FROM borrowers
 842                     LEFT JOIN branches on borrowers.branchcode=branches.branchcode
 843                     ";
 844                     my $sth = $dbh->prepare("$select where userid=?");
 845                     $sth->execute($userid);
 846                     unless ($sth->rows) {
 847                         $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
 848                         $sth = $dbh->prepare("$select where cardnumber=?");
 849                         $sth->execute($cardnumber);
 850
 851                         unless ($sth->rows) {
 852                             $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
 853                             $sth->execute($userid);
 854                             unless ($sth->rows) {
 855                                 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
 856                             }
 857                         }
 858                     }
 859                     if ($sth->rows) {
 860                         ($borrowernumber, $firstname, $surname, $userflags,
 861                             $branchcode, $branchname, $branchprinter, $emailaddress) = $sth->fetchrow;
 862                         $debug and print STDERR "AUTH_3 results: " .
 863                         "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
 864                     } else {
 865                         print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
 866                     }
 867
 868 # launch a sequence to check if we have a ip for the branch, i
 869 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
 870
 871                     my $ip       = $ENV{'REMOTE_ADDR'};
 872                     # if they specify at login, use that
 873                     if ($query->param('branch')) {
 874                         $branchcode  = $query->param('branch');
 875                         $branchname = GetBranchName($branchcode);
 876                     }
 877                     my $branches = GetBranches();
 878                     if (C4::Context->boolean_preference('IndependantBranches') && C4::Context->boolean_preference('Autolocation')){
 879                         # we have to check they are coming from the right ip range
 880                         my $domain = $branches->{$branchcode}->{'branchip'};
 881                         if ($ip !~ /^$domain/){
 882                             $loggedin=0;
 883                             $info{'wrongip'} = 1;
 884                         }
 885                     }
 886
 887                     my @branchesloop;
 888                     foreach my $br ( keys %$branches ) {
 889                         #     now we work with the treatment of ip
 890                         my $domain = $branches->{$br}->{'branchip'};
 891                         if ( $domain && $ip =~ /^$domain/ ) {
 892                             $branchcode = $branches->{$br}->{'branchcode'};
 893
 894                             # new op dev : add the branchprinter and branchname in the cookie
 895                             $branchprinter = $branches->{$br}->{'branchprinter'};
 896                             $branchname    = $branches->{$br}->{'branchname'};
 897                         }
 898                     }
 899                     $session->param('number',$borrowernumber);
 900                     $session->param('id',$userid);
 901                     $session->param('cardnumber',$cardnumber);
 902                     $session->param('firstname',$firstname);
 903                     $session->param('surname',$surname);
 904                     $session->param('branch',$branchcode);
 905                     $session->param('branchname',$branchname);
 906                     $session->param('flags',$userflags);
 907                     $session->param('emailaddress',$emailaddress);
 908                     $session->param('ip',$session->remote_addr());
 909                     $session->param('lasttime',time());
 910                     $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 911                 }
 912                 elsif ( $return == 2 ) {
 913                     #We suppose the user is the superlibrarian
 914                     $borrowernumber = 0;
 915                     $session->param('number',0);
 916                     $session->param('id',C4::Context->config('user'));
 917                     $session->param('cardnumber',C4::Context->config('user'));
 918                     $session->param('firstname',C4::Context->config('user'));
 919                     $session->param('surname',C4::Context->config('user'));
 920                     $session->param('branch','NO_LIBRARY_SET');
 921                     $session->param('branchname','NO_LIBRARY_SET');
 922                     $session->param('flags',1);
 923                     $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 924                     $session->param('ip',$session->remote_addr());
 925                     $session->param('lasttime',time());
 926                 }
 927                 if ($persona){
 928                     $session->param('persona',1);
 929                 }
 930                 C4::Context::set_userenv(
 931                     $session->param('number'),       $session->param('id'),
 932                     $session->param('cardnumber'),   $session->param('firstname'),
 933                     $session->param('surname'),      $session->param('branch'),
 934                     $session->param('branchname'),   $session->param('flags'),
 935                     $session->param('emailaddress'), $session->param('branchprinter'),
 936                     $session->param('persona')
 937                 );
 938
 939             }
 940             else {
 941                 if ($userid) {
 942                     $info{'invalid_username_or_password'} = 1;
 943                     C4::Context->_unset_userenv($sessionID);
 944                 }
 945             }
 946         }    # END if ( $userid    = $query->param('userid') )
 947         elsif ($type eq "opac") {
 948             # if we are here this is an anonymous session; add public lists to it and a few other items...
 949             # anonymous sessions are created only for the OPAC
 950             $debug and warn "Initiating an anonymous session...";
 951
 952             # setting a couple of other session vars...
 953             $session->param('ip',$session->remote_addr());
 954             $session->param('lasttime',time());
 955             $session->param('sessiontype','anon');
 956         }
 957     }    # END unless ($userid)
 958
 959     # finished authentification, now respond
 960     if ( $loggedin || $authnotrequired )
 961     {
 962         # successful login
 963         unless ($cookie) {
 964             $cookie = $query->cookie(
 965                 -name     => 'CGISESSID',
 966                 -value    => '',
 967                 -HttpOnly => 1
 968             );
 969         }
 970         return ( $userid, $cookie, $sessionID, $flags );
 971     }
 972
 973 #
 974 #
 975 # AUTH rejected, show the login/password template, after checking the DB.
 976 #
 977 #
 978
 979     # get the inputs from the incoming query
 980     my @inputs = ();
 981     foreach my $name ( param $query) {
 982         (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
 983         my $value = $query->param($name);
 984         push @inputs, { name => $name, value => $value };
 985     }
 986
 987     my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tmpl' : 'auth.tmpl';
 988     my $template = C4::Templates::gettemplate($template_name, $type, $query );
 989     $template->param(
 990         branchloop           => GetBranchesLoop(),
 991         opaccolorstylesheet  => C4::Context->preference("opaccolorstylesheet"),
 992         opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
 993         login                => 1,
 994         INPUTS               => \@inputs,
 995         casAuthentication    => C4::Context->preference("casAuthentication"),
 996         suggestion           => C4::Context->preference("suggestion"),
 997         virtualshelves       => C4::Context->preference("virtualshelves"),
 998         LibraryName          => C4::Context->preference("LibraryName"),
 999         opacuserlogin        => C4::Context->preference("opacuserlogin"),
1000         OpacNav              => C4::Context->preference("OpacNav"),
1001         OpacNavRight         => C4::Context->preference("OpacNavRight"),
1002         OpacNavBottom        => C4::Context->preference("OpacNavBottom"),
1003         opaccredits          => C4::Context->preference("opaccredits"),
1004         OpacFavicon          => C4::Context->preference("OpacFavicon"),
1005         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
1006         opacsmallimage       => C4::Context->preference("opacsmallimage"),
1007         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1008         opacuserjs           => C4::Context->preference("opacuserjs"),
1009         opacbookbag          => "" . C4::Context->preference("opacbookbag"),
1010         OpacCloud            => C4::Context->preference("OpacCloud"),
1011         OpacTopissue         => C4::Context->preference("OpacTopissue"),
1012         OpacAuthorities      => C4::Context->preference("OpacAuthorities"),
1013         OpacBrowser          => C4::Context->preference("OpacBrowser"),
1014         opacheader           => C4::Context->preference("opacheader"),
1015         TagsEnabled          => C4::Context->preference("TagsEnabled"),
1016         OPACUserCSS           => C4::Context->preference("OPACUserCSS"),
1017         intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1018         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1019         intranetbookbag    => C4::Context->preference("intranetbookbag"),
1020         IntranetNav        => C4::Context->preference("IntranetNav"),
1021         IntranetFavicon    => C4::Context->preference("IntranetFavicon"),
1022         intranetuserjs     => C4::Context->preference("intranetuserjs"),
1023         IndependantBranches=> C4::Context->preference("IndependantBranches"),
1024         AutoLocation       => C4::Context->preference("AutoLocation"),
1025         wrongip            => $info{'wrongip'},
1026         PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1027         PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1028         persona            => C4::Context->preference("Persona"),
1029     );
1030
1031     $template->param( OpacPublic => C4::Context->preference("OpacPublic"));
1032     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1033
1034     if ($cas) {
1035
1036     # Is authentication against multiple CAS servers enabled?
1037         if (C4::Auth_with_cas::multipleAuth && !$casparam) {
1038         my $casservers = C4::Auth_with_cas::getMultipleAuth();
1039         my @tmplservers;
1040         foreach my $key (keys %$casservers) {
1041         push @tmplservers, {name => $key, value => login_cas_url($query, $key) . "?cas=$key" };
1042         }
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