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