3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
24 use Digest
::MD5
qw(md5_base64);
25 use JSON qw
/encode_json/;
31 use C4
::Templates
; # to get the template
33 use C4
::Search
::History
;
36 use Koha
::AuthUtils
qw(get_script_name hash_password);
38 use Koha
::DateUtils
qw(dt_from_string);
39 use Koha
::Library
::Groups
;
42 use Koha
::Patron
::Consents
;
43 use POSIX qw
/strftime/;
44 use List
::MoreUtils qw
/ any /;
45 use Encode
qw( encode is_utf8);
46 use C4
::Auth_with_shibboleth
;
50 use vars
qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout);
53 sub psgi_env { any { /^psgi\./ } keys %ENV }
56 if (psgi_env) { die 'psgi:exit' }
62 @EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
63 @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash
64 &get_all_subpermissions &get_user_subpermissions track_login_daily &in_ipset
66 %EXPORT_TAGS = ( EditPermissions
=> [qw(get_all_subpermissions get_user_subpermissions)] );
67 $ldap = C4
::Context
->config('useldapserver') || 0;
68 $cas = C4
::Context
->preference('casAuthentication');
69 $caslogout = C4
::Context
->preference('casLogout');
70 require C4
::Auth_with_cas
; # no import
73 require C4
::Auth_with_ldap
;
74 import C4
::Auth_with_ldap
qw(checkpw_ldap);
77 import C4
::Auth_with_cas
qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url logout_if_required);
84 C4::Auth - Authenticates Koha users
94 my ($template, $borrowernumber, $cookie)
95 = get_template_and_user(
97 template_name => "opac-main.tt",
100 authnotrequired => 0,
101 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
105 output_html_with_http_headers $query, $cookie, $template->output;
109 The main function of this module is to provide
110 authentification. However the get_template_and_user function has
111 been provided so that a users login information is passed along
112 automatically. This gets loaded into the template.
116 =head2 get_template_and_user
118 my ($template, $borrowernumber, $cookie)
119 = get_template_and_user(
121 template_name => "opac-main.tt",
124 authnotrequired => 0,
125 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
129 This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
130 to C<&checkauth> (in this module) to perform authentification.
131 See C<&checkauth> for an explanation of these parameters.
133 The C<template_name> is then used to find the correct template for
134 the page. The authenticated users details are loaded onto the
135 template in the logged_in_user variable (which is a Koha::Patron object). Also the
136 C<sessionID> is passed to the template. This can be used in templates
137 if cookies are disabled. It needs to be put as and input to every
140 More information on the C<gettemplate> sub can be found in the
145 sub get_template_and_user
{
148 my ( $user, $cookie, $sessionID, $flags );
150 # Get shibboleth login attribute
151 my $shib = C4
::Context
->config('useshibboleth') && shib_ok
();
152 my $shib_login = $shib ? get_login_shib
() : undef;
154 C4
::Context
->interface( $in->{type
} );
156 $in->{'authnotrequired'} ||= 0;
158 # the following call includes a bad template check; might croak
159 my $template = C4
::Templates
::gettemplate
(
160 $in->{'template_name'},
165 if ( $in->{'template_name'} !~ m/maintenance/ ) {
166 ( $user, $cookie, $sessionID, $flags ) = checkauth
(
168 $in->{'authnotrequired'},
169 $in->{'flagsrequired'},
174 # If we enforce GDPR and the user did not consent, redirect
175 # Exceptions for consent page itself and SCI/SCO system
176 if( $in->{type
} eq 'opac' && $user &&
177 $in->{'template_name'} !~ /^(opac-patron-consent|sc[io]\/)/ &&
178 C4
::Context
->preference('GDPR_Policy') eq 'Enforced' )
180 my $consent = Koha
::Patron
::Consents
->search({
181 borrowernumber
=> getborrowernumber
($user),
182 type
=> 'GDPR_PROCESSING',
183 given_on
=> { '!=', undef },
186 print $in->{query
}->redirect(-uri
=> '/cgi-bin/koha/opac-patron-consent.pl', -cookie
=> $cookie);
191 if ( $in->{type
} eq 'opac' && $user ) {
195 # If the user logged in is the SCO user and they try to go out of the SCO module,
196 # log the user out removing the CGISESSID cookie
197 $in->{template_name
} !~ m
|sco
/| && $in->{template_name} !~ m|errors/errorpage
.tt
|
198 && C4
::Context
->preference('AutoSelfCheckID')
199 && $user eq C4
::Context
->preference('AutoSelfCheckID')
205 # If the user logged in is the SCI user and they try to go out of the SCI module,
206 # kick them out unless it is SCO with a valid permission
207 # or they are a superlibrarian
208 $in->{template_name
} !~ m
|sci
/|
209 && haspermission
( $user, { self_check
=> 'self_checkin_module' } )
211 $in->{template_name
} =~ m
|sco
/| && haspermission
(
212 $user, { self_check
=> 'self_checkout_module' }
215 && $flags && $flags->{superlibrarian
} != 1
222 $template = C4
::Templates
::gettemplate
( 'opac-auth.tt', 'opac',
224 $cookie = $in->{query
}->cookie(
225 -name
=> 'CGISESSID',
233 script_name
=> get_script_name
(),
236 print $in->{query
}->header(
241 'X-Frame-Options' => 'SAMEORIGIN'
252 # It's possible for $user to be the borrowernumber if they don't have a
253 # userid defined (and are logging in through some other method, such
254 # as SSL certs against an email address)
256 $borrowernumber = getborrowernumber
($user) if defined($user);
257 if ( !defined($borrowernumber) && defined($user) ) {
258 $patron = Koha
::Patrons
->find( $user );
260 $borrowernumber = $user;
262 # A bit of a hack, but I don't know there's a nicer way
264 $user = $patron->firstname . ' ' . $patron->surname;
267 $patron = Koha
::Patrons
->find( $borrowernumber );
268 # FIXME What to do if $patron does not exist?
272 $template->param( loggedinusername
=> $user ); # OBSOLETE - Do not reuse this in template, use logged_in_user.userid instead
273 $template->param( loggedinusernumber
=> $borrowernumber ); # FIXME Should be replaced with logged_in_user.borrowernumber
274 $template->param( logged_in_user
=> $patron );
275 $template->param( sessionID
=> $sessionID );
277 if ( $in->{'type'} eq 'opac' ) {
278 require Koha
::Virtualshelves
;
279 my $some_private_shelves = Koha
::Virtualshelves
->get_some_shelves(
281 borrowernumber
=> $borrowernumber,
285 my $some_public_shelves = Koha
::Virtualshelves
->get_some_shelves(
291 some_private_shelves
=> $some_private_shelves,
292 some_public_shelves
=> $some_public_shelves,
296 my $all_perms = get_all_subpermissions
();
298 my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
299 editcatalogue updatecharges tools editauthorities serials reports acquisition clubs);
301 # We are going to use the $flags returned by checkauth
302 # to create the template's parameters that will indicate
303 # which menus the user can access.
304 if ( $flags && $flags->{superlibrarian
} == 1 ) {
305 $template->param( CAN_user_circulate
=> 1 );
306 $template->param( CAN_user_catalogue
=> 1 );
307 $template->param( CAN_user_parameters
=> 1 );
308 $template->param( CAN_user_borrowers
=> 1 );
309 $template->param( CAN_user_permissions
=> 1 );
310 $template->param( CAN_user_reserveforothers
=> 1 );
311 $template->param( CAN_user_editcatalogue
=> 1 );
312 $template->param( CAN_user_updatecharges
=> 1 );
313 $template->param( CAN_user_acquisition
=> 1 );
314 $template->param( CAN_user_tools
=> 1 );
315 $template->param( CAN_user_editauthorities
=> 1 );
316 $template->param( CAN_user_serials
=> 1 );
317 $template->param( CAN_user_reports
=> 1 );
318 $template->param( CAN_user_staffaccess
=> 1 );
319 $template->param( CAN_user_plugins
=> 1 );
320 $template->param( CAN_user_coursereserves
=> 1 );
321 $template->param( CAN_user_clubs
=> 1 );
322 $template->param( CAN_user_ill
=> 1 );
323 $template->param( CAN_user_stockrotation
=> 1 );
325 foreach my $module ( keys %$all_perms ) {
326 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
327 $template->param( "CAN_user_${module}_${subperm}" => 1 );
333 foreach my $module ( keys %$all_perms ) {
334 if ( defined($flags->{$module}) && $flags->{$module} == 1 ) {
335 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
336 $template->param( "CAN_user_${module}_${subperm}" => 1 );
338 } elsif ( ref( $flags->{$module} ) ) {
339 foreach my $subperm ( keys %{ $flags->{$module} } ) {
340 $template->param( "CAN_user_${module}_${subperm}" => 1 );
347 foreach my $module ( keys %$flags ) {
348 if ( $flags->{$module} == 1 or ref( $flags->{$module} ) ) {
349 $template->param( "CAN_user_$module" => 1 );
354 # Logged-in opac search history
355 # If the requested template is an opac one and opac search history is enabled
356 if ( $in->{type
} eq 'opac' && C4
::Context
->preference('EnableOpacSearchHistory') ) {
357 my $dbh = C4
::Context
->dbh;
358 my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
359 my $sth = $dbh->prepare($query);
360 $sth->execute($borrowernumber);
362 # If at least one search has already been performed
363 if ( $sth->fetchrow_array > 0 ) {
365 # We show the link in opac
366 $template->param( EnableOpacSearchHistory
=> 1 );
368 if (C4
::Context
->preference('LoadSearchHistoryToTheFirstLoggedUser'))
370 # And if there are searches performed when the user was not logged in,
371 # we add them to the logged-in search history
372 my @recentSearches = C4
::Search
::History
::get_from_session
( { cgi
=> $in->{'query'} } );
373 if (@recentSearches) {
374 my $dbh = C4
::Context
->dbh;
376 INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, type, total, time )
377 VALUES (?, ?, ?, ?, ?, ?, ?)
379 my $sth = $dbh->prepare($query);
380 $sth->execute( $borrowernumber,
381 $in->{query
}->cookie("CGISESSID"),
384 $_->{type
} || 'biblio',
387 ) foreach @recentSearches;
389 # clear out the search history from the session now that
390 # we've saved it to the database
393 C4
::Search
::History
::set_to_session
( { cgi
=> $in->{'query'}, search_history
=> [] } );
395 } elsif ( $in->{type
} eq 'intranet' and C4
::Context
->preference('EnableSearchHistory') ) {
396 $template->param( EnableSearchHistory
=> 1 );
399 else { # if this is an anonymous session, setup to display public lists...
401 # If shibboleth is enabled, and we're in an anonymous session, we should allow
402 # the user to attempt login via shibboleth.
404 $template->param( shibbolethAuthentication
=> $shib,
405 shibbolethLoginUrl
=> login_shib_url
( $in->{'query'} ),
408 # If shibboleth is enabled and we have a shibboleth login attribute,
409 # but we are in an anonymous session, then we clearly have an invalid
410 # shibboleth koha account.
412 $template->param( invalidShibLogin
=> '1' );
416 $template->param( sessionID
=> $sessionID );
418 if ( $in->{'type'} eq 'opac' ){
419 require Koha
::Virtualshelves
;
420 my $some_public_shelves = Koha
::Virtualshelves
->get_some_shelves(
426 some_public_shelves
=> $some_public_shelves,
431 # Anonymous opac search history
432 # If opac search history is enabled and at least one search has already been performed
433 if ( C4
::Context
->preference('EnableOpacSearchHistory') ) {
434 my @recentSearches = C4
::Search
::History
::get_from_session
( { cgi
=> $in->{'query'} } );
435 if (@recentSearches) {
436 $template->param( EnableOpacSearchHistory
=> 1 );
440 if ( C4
::Context
->preference('dateformat') ) {
441 $template->param( dateformat
=> C4
::Context
->preference('dateformat') );
444 $template->param(auth_forwarded_hash
=> scalar $in->{'query'}->param('auth_forwarded_hash'));
446 # these template parameters are set the same regardless of $in->{'type'}
448 # Set the using_https variable for templates
449 # FIXME Under Plack the CGI->https method always returns 'OFF'
450 my $https = $in->{query
}->https();
451 my $using_https = ( defined $https and $https ne 'OFF' ) ?
1 : 0;
453 my $minPasswordLength = C4
::Context
->preference('minPasswordLength');
454 $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
456 "BiblioDefaultView" . C4
::Context
->preference("BiblioDefaultView") => 1,
457 EnhancedMessagingPreferences
=> C4
::Context
->preference('EnhancedMessagingPreferences'),
458 GoogleJackets
=> C4
::Context
->preference("GoogleJackets"),
459 OpenLibraryCovers
=> C4
::Context
->preference("OpenLibraryCovers"),
460 KohaAdminEmailAddress
=> "" . C4
::Context
->preference("KohaAdminEmailAddress"),
461 LoginBranchcode
=> ( C4
::Context
->userenv ? C4
::Context
->userenv->{"branch"} : undef ),
462 LoginFirstname
=> ( C4
::Context
->userenv ? C4
::Context
->userenv->{"firstname"} : "Bel" ),
463 LoginSurname
=> C4
::Context
->userenv ? C4
::Context
->userenv->{"surname"} : "Inconnu",
464 emailaddress
=> C4
::Context
->userenv ? C4
::Context
->userenv->{"emailaddress"} : undef,
465 TagsEnabled
=> C4
::Context
->preference("TagsEnabled"),
466 hide_marc
=> C4
::Context
->preference("hide_marc"),
467 item_level_itypes
=> C4
::Context
->preference('item-level_itypes'),
468 patronimages
=> C4
::Context
->preference("patronimages"),
469 singleBranchMode
=> ( Koha
::Libraries
->search->count == 1 ),
470 XSLTDetailsDisplay
=> C4
::Context
->preference("XSLTDetailsDisplay"),
471 XSLTResultsDisplay
=> C4
::Context
->preference("XSLTResultsDisplay"),
472 using_https
=> $using_https,
473 noItemTypeImages
=> C4
::Context
->preference("noItemTypeImages"),
474 marcflavour
=> C4
::Context
->preference("marcflavour"),
475 OPACBaseURL
=> C4
::Context
->preference('OPACBaseURL'),
476 minPasswordLength
=> $minPasswordLength,
478 if ( $in->{'type'} eq "intranet" ) {
480 AmazonCoverImages
=> C4
::Context
->preference("AmazonCoverImages"),
481 AutoLocation
=> C4
::Context
->preference("AutoLocation"),
482 "BiblioDefaultView" . C4
::Context
->preference("IntranetBiblioDefaultView") => 1,
483 PatronAutoComplete
=> C4
::Context
->preference("PatronAutoComplete"),
484 FRBRizeEditions
=> C4
::Context
->preference("FRBRizeEditions"),
485 IndependentBranches
=> C4
::Context
->preference("IndependentBranches"),
486 IntranetNav
=> C4
::Context
->preference("IntranetNav"),
487 IntranetmainUserblock
=> C4
::Context
->preference("IntranetmainUserblock"),
488 LibraryName
=> C4
::Context
->preference("LibraryName"),
489 LoginBranchname
=> ( C4
::Context
->userenv ? C4
::Context
->userenv->{"branchname"} : undef ),
490 advancedMARCEditor
=> C4
::Context
->preference("advancedMARCEditor"),
491 canreservefromotherbranches
=> C4
::Context
->preference('canreservefromotherbranches'),
492 intranetcolorstylesheet
=> C4
::Context
->preference("intranetcolorstylesheet"),
493 IntranetFavicon
=> C4
::Context
->preference("IntranetFavicon"),
494 intranetreadinghistory
=> C4
::Context
->preference("intranetreadinghistory"),
495 intranetstylesheet
=> C4
::Context
->preference("intranetstylesheet"),
496 IntranetUserCSS
=> C4
::Context
->preference("IntranetUserCSS"),
497 IntranetUserJS
=> C4
::Context
->preference("IntranetUserJS"),
498 intranetbookbag
=> C4
::Context
->preference("intranetbookbag"),
499 suggestion
=> C4
::Context
->preference("suggestion"),
500 virtualshelves
=> C4
::Context
->preference("virtualshelves"),
501 StaffSerialIssueDisplayCount
=> C4
::Context
->preference("StaffSerialIssueDisplayCount"),
502 EasyAnalyticalRecords
=> C4
::Context
->preference('EasyAnalyticalRecords'),
503 LocalCoverImages
=> C4
::Context
->preference('LocalCoverImages'),
504 OPACLocalCoverImages
=> C4
::Context
->preference('OPACLocalCoverImages'),
505 AllowMultipleCovers
=> C4
::Context
->preference('AllowMultipleCovers'),
506 EnableBorrowerFiles
=> C4
::Context
->preference('EnableBorrowerFiles'),
507 UseKohaPlugins
=> C4
::Context
->preference('UseKohaPlugins'),
508 UseCourseReserves
=> C4
::Context
->preference("UseCourseReserves"),
509 useDischarge
=> C4
::Context
->preference('useDischarge'),
510 pending_checkout_notes
=> scalar Koha
::Checkouts
->search({ noteseen
=> 0 }),
514 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
516 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
517 my $LibraryNameTitle = C4
::Context
->preference("LibraryName");
518 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?
)>/ /sgi;
519 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
521 # clean up the busc param in the session
522 # if the page is not opac-detail and not the "add to list" page
523 # and not the "edit comments" page
524 if ( C4
::Context
->preference("OpacBrowseResults")
525 && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
527 unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
528 or $pagename =~ /^addbybiblionumber$/
529 or $pagename =~ /^review$/ ) {
530 my $sessionSearch = get_session
( $sessionID || $in->{'query'}->cookie("CGISESSID") );
531 $sessionSearch->clear( ["busc"] ) if ( $sessionSearch->param("busc") );
535 # variables passed from CGI: opac_css_override and opac_search_limits.
536 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
537 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
540 ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:([\w-]+)/ ) ||
541 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:([\w-]+)/ ) ||
542 ( $in->{'query'}->param('multibranchlimit') && $in->{'query'}->param('multibranchlimit') =~ /multibranchlimit-(\w+)/ )
544 $opac_name = $1; # opac_search_limit is a branch, so we use it.
545 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
546 $opac_name = $in->{'query'}->param('multibranchlimit');
547 } elsif ( C4
::Context
->preference("SearchMyLibraryFirst") && C4
::Context
->userenv && C4
::Context
->userenv->{'branch'} ) {
548 $opac_name = C4
::Context
->userenv->{'branch'};
551 my @search_groups = Koha
::Library
::Groups
->get_search_groups({ interface
=> 'opac' });
553 AnonSuggestions
=> "" . C4
::Context
->preference("AnonSuggestions"),
554 LibrarySearchGroups
=> \
@search_groups,
555 opac_name
=> $opac_name,
556 LibraryName
=> "" . C4
::Context
->preference("LibraryName"),
557 LibraryNameTitle
=> "" . $LibraryNameTitle,
558 LoginBranchname
=> C4
::Context
->userenv ? C4
::Context
->userenv->{"branchname"} : "",
559 OPACAmazonCoverImages
=> C4
::Context
->preference("OPACAmazonCoverImages"),
560 OPACFRBRizeEditions
=> C4
::Context
->preference("OPACFRBRizeEditions"),
561 OpacHighlightedWords
=> C4
::Context
->preference("OpacHighlightedWords"),
562 OPACShelfBrowser
=> "" . C4
::Context
->preference("OPACShelfBrowser"),
563 OPACURLOpenInNewWindow
=> "" . C4
::Context
->preference("OPACURLOpenInNewWindow"),
564 OPACUserCSS
=> "" . C4
::Context
->preference("OPACUserCSS"),
565 OpacAuthorities
=> C4
::Context
->preference("OpacAuthorities"),
566 opac_css_override
=> $ENV{'OPAC_CSS_OVERRIDE'},
567 opac_search_limit
=> $opac_search_limit,
568 opac_limit_override
=> $opac_limit_override,
569 OpacBrowser
=> C4
::Context
->preference("OpacBrowser"),
570 OpacCloud
=> C4
::Context
->preference("OpacCloud"),
571 OpacKohaUrl
=> C4
::Context
->preference("OpacKohaUrl"),
572 OpacMainUserBlock
=> "" . C4
::Context
->preference("OpacMainUserBlock"),
573 OpacNav
=> "" . C4
::Context
->preference("OpacNav"),
574 OpacNavBottom
=> "" . C4
::Context
->preference("OpacNavBottom"),
575 OpacPasswordChange
=> C4
::Context
->preference("OpacPasswordChange"),
576 OPACPatronDetails
=> C4
::Context
->preference("OPACPatronDetails"),
577 OPACPrivacy
=> C4
::Context
->preference("OPACPrivacy"),
578 OPACFinesTab
=> C4
::Context
->preference("OPACFinesTab"),
579 OpacTopissue
=> C4
::Context
->preference("OpacTopissue"),
580 RequestOnOpac
=> C4
::Context
->preference("RequestOnOpac"),
581 'Version' => C4
::Context
->preference('Version'),
582 hidelostitems
=> C4
::Context
->preference("hidelostitems"),
583 mylibraryfirst
=> ( C4
::Context
->preference("SearchMyLibraryFirst") && C4
::Context
->userenv ) ? C4
::Context
->userenv->{'branch'} : '',
584 opacbookbag
=> "" . C4
::Context
->preference("opacbookbag"),
585 opaccredits
=> "" . C4
::Context
->preference("opaccredits"),
586 OpacFavicon
=> C4
::Context
->preference("OpacFavicon"),
587 opacheader
=> "" . C4
::Context
->preference("opacheader"),
588 opaclanguagesdisplay
=> "" . C4
::Context
->preference("opaclanguagesdisplay"),
589 opacreadinghistory
=> C4
::Context
->preference("opacreadinghistory"),
590 OPACUserJS
=> C4
::Context
->preference("OPACUserJS"),
591 opacuserlogin
=> "" . C4
::Context
->preference("opacuserlogin"),
592 OpenLibrarySearch
=> C4
::Context
->preference("OpenLibrarySearch"),
593 ShowReviewer
=> C4
::Context
->preference("ShowReviewer"),
594 ShowReviewerPhoto
=> C4
::Context
->preference("ShowReviewerPhoto"),
595 suggestion
=> "" . C4
::Context
->preference("suggestion"),
596 virtualshelves
=> "" . C4
::Context
->preference("virtualshelves"),
597 OPACSerialIssueDisplayCount
=> C4
::Context
->preference("OPACSerialIssueDisplayCount"),
598 OPACXSLTDetailsDisplay
=> C4
::Context
->preference("OPACXSLTDetailsDisplay"),
599 OPACXSLTResultsDisplay
=> C4
::Context
->preference("OPACXSLTResultsDisplay"),
600 SyndeticsClientCode
=> C4
::Context
->preference("SyndeticsClientCode"),
601 SyndeticsEnabled
=> C4
::Context
->preference("SyndeticsEnabled"),
602 SyndeticsCoverImages
=> C4
::Context
->preference("SyndeticsCoverImages"),
603 SyndeticsTOC
=> C4
::Context
->preference("SyndeticsTOC"),
604 SyndeticsSummary
=> C4
::Context
->preference("SyndeticsSummary"),
605 SyndeticsEditions
=> C4
::Context
->preference("SyndeticsEditions"),
606 SyndeticsExcerpt
=> C4
::Context
->preference("SyndeticsExcerpt"),
607 SyndeticsReviews
=> C4
::Context
->preference("SyndeticsReviews"),
608 SyndeticsAuthorNotes
=> C4
::Context
->preference("SyndeticsAuthorNotes"),
609 SyndeticsAwards
=> C4
::Context
->preference("SyndeticsAwards"),
610 SyndeticsSeries
=> C4
::Context
->preference("SyndeticsSeries"),
611 SyndeticsCoverImageSize
=> C4
::Context
->preference("SyndeticsCoverImageSize"),
612 OPACLocalCoverImages
=> C4
::Context
->preference("OPACLocalCoverImages"),
613 PatronSelfRegistration
=> C4
::Context
->preference("PatronSelfRegistration"),
614 PatronSelfRegistrationDefaultCategory
=> C4
::Context
->preference("PatronSelfRegistrationDefaultCategory"),
615 useDischarge
=> C4
::Context
->preference('useDischarge'),
618 $template->param( OpacPublic
=> '1' ) if ( $user || C4
::Context
->preference("OpacPublic") );
621 # Check if we were asked using parameters to force a specific language
622 if ( defined $in->{'query'}->param('language') ) {
624 # Extract the language, let C4::Languages::getlanguage choose
626 my $language = C4
::Languages
::getlanguage
( $in->{'query'} );
627 my $languagecookie = C4
::Templates
::getlanguagecookie
( $in->{'query'}, $language );
628 if ( ref $cookie eq 'ARRAY' ) {
629 push @
{$cookie}, $languagecookie;
631 $cookie = [ $cookie, $languagecookie ];
635 return ( $template, $borrowernumber, $cookie, $flags );
640 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
642 Verifies that the user is authorized to run this script. If
643 the user is authorized, a (userid, cookie, session-id, flags)
644 quadruple is returned. If the user is not authorized but does
645 not have the required privilege (see $flagsrequired below), it
646 displays an error page and exits. Otherwise, it displays the
647 login page and exits.
649 Note that C<&checkauth> will return if and only if the user
650 is authorized, so it should be called early on, before any
651 unfinished operations (e.g., if you've opened a file, then
652 C<&checkauth> won't close it for you).
654 C<$query> is the CGI object for the script calling C<&checkauth>.
656 The C<$noauth> argument is optional. If it is set, then no
657 authorization is required for the script.
659 C<&checkauth> fetches user and session information from C<$query> and
660 ensures that the user is authorized to run scripts that require
663 The C<$flagsrequired> argument specifies the required privileges
664 the user must have if the username and password are correct.
665 It should be specified as a reference-to-hash; keys in the hash
666 should be the "flags" for the user, as specified in the Members
667 intranet module. Any key specified must correspond to a "flag"
668 in the userflags table. E.g., { circulate => 1 } would specify
669 that the user must have the "circulate" privilege in order to
670 proceed. To make sure that access control is correct, the
671 C<$flagsrequired> parameter must be specified correctly.
673 Koha also has a concept of sub-permissions, also known as
674 granular permissions. This makes the value of each key
675 in the C<flagsrequired> hash take on an additional
680 The user must have access to all subfunctions of the module
681 specified by the hash key.
685 The user must have access to at least one subfunction of the module
686 specified by the hash key.
688 specific permission, e.g., 'export_catalog'
690 The user must have access to the specific subfunction list, which
691 must correspond to a row in the permissions table.
693 The C<$type> argument specifies whether the template should be
694 retrieved from the opac or intranet directory tree. "opac" is
695 assumed if it is not specified; however, if C<$type> is specified,
696 "intranet" is assumed if it is not "opac".
698 If C<$query> does not have a valid session ID associated with it
699 (i.e., the user has not logged in) or if the session has expired,
700 C<&checkauth> presents the user with a login page (from the point of
701 view of the original script, C<&checkauth> does not return). Once the
702 user has authenticated, C<&checkauth> restarts the original script
703 (this time, C<&checkauth> returns).
705 The login page is provided using a HTML::Template, which is set in the
706 systempreferences table or at the top of this file. The variable C<$type>
707 selects which template to use, either the opac or the intranet
708 authentification template.
710 C<&checkauth> returns a user ID, a cookie, and a session ID. The
711 cookie should be sent back to the browser; it verifies that the user
721 # If version syspref is unavailable, it means Koha is being installed,
722 # and so we must redirect to OPAC maintenance page or to the WebInstaller
723 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
724 if ( C4
::Context
->preference('OpacMaintenance') && $type eq 'opac' ) {
725 warn "OPAC Install required, redirecting to maintenance";
726 print $query->redirect("/cgi-bin/koha/maintenance.pl");
729 unless ( $version = C4
::Context
->preference('Version') ) { # assignment, not comparison
730 if ( $type ne 'opac' ) {
731 warn "Install required, redirecting to Installer";
732 print $query->redirect("/cgi-bin/koha/installer/install.pl");
734 warn "OPAC Install required, redirecting to maintenance";
735 print $query->redirect("/cgi-bin/koha/maintenance.pl");
740 # check that database and koha version are the same
741 # there is no DB version, it's a fresh install,
742 # go to web installer
743 # there is a DB version, compare it to the code version
744 my $kohaversion = Koha
::version
();
746 # remove the 3 last . to have a Perl number
747 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
748 $debug and print STDERR
"kohaversion : $kohaversion\n";
749 if ( $version < $kohaversion ) {
750 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
751 if ( $type ne 'opac' ) {
752 warn sprintf( $warning, 'Installer' );
753 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
755 warn sprintf( "OPAC: " . $warning, 'maintenance' );
756 print $query->redirect("/cgi-bin/koha/maintenance.pl");
764 open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
765 printf $fh join( "\n", @_ );
769 sub _timeout_syspref
{
770 my $timeout = C4
::Context
->preference('timeout') || 600;
772 # value in days, convert in seconds
773 if ( $timeout =~ /(\d+)[dD]/ ) {
774 $timeout = $1 * 86400;
781 $debug and warn "Checking Auth";
783 # Get shibboleth login attribute
784 my $shib = C4
::Context
->config('useshibboleth') && shib_ok
();
785 my $shib_login = $shib ? get_login_shib
() : undef;
787 # $authnotrequired will be set for scripts which will run without authentication
788 my $authnotrequired = shift;
789 my $flagsrequired = shift;
791 my $emailaddress = shift;
792 $type = 'opac' unless $type;
794 my $dbh = C4
::Context
->dbh;
795 my $timeout = _timeout_syspref
();
797 _version_check
( $type, $query );
802 my ( $userid, $cookie, $sessionID, $flags );
803 my $logout = $query->param('logout.x');
805 my $anon_search_history;
807 # This parameter is the name of the CAS server we want to authenticate against,
808 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
809 my $casparam = $query->param('cas');
810 my $q_userid = $query->param('userid') // '';
814 # Basic authentication is incompatible with the use of Shibboleth,
815 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
816 # and it may not be the attribute we want to use to match the koha login.
818 # Also, do not consider an empty REMOTE_USER.
820 # Finally, after those tests, we can assume (although if it would be better with
821 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
822 # and we can affect it to $userid.
823 if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
825 # Using Basic Authentication, no cookies required
826 $cookie = $query->cookie(
827 -name
=> 'CGISESSID',
834 elsif ( $emailaddress) {
835 # the Google OpenID Connect passes an email address
837 elsif ( $sessionID = $query->cookie("CGISESSID") )
838 { # assignment, not comparison
839 $session = get_session
($sessionID);
840 C4
::Context
->_new_userenv($sessionID);
841 my ( $ip, $lasttime, $sessiontype );
844 $s_userid = $session->param('id') // '';
845 C4
::Context
->set_userenv(
846 $session->param('number'), $s_userid,
847 $session->param('cardnumber'), $session->param('firstname'),
848 $session->param('surname'), $session->param('branch'),
849 $session->param('branchname'), $session->param('flags'),
850 $session->param('emailaddress'), $session->param('branchprinter'),
851 $session->param('shibboleth')
853 C4
::Context
::set_shelves_userenv
( 'bar', $session->param('barshelves') );
854 C4
::Context
::set_shelves_userenv
( 'pub', $session->param('pubshelves') );
855 C4
::Context
::set_shelves_userenv
( 'tot', $session->param('totshelves') );
856 $debug and printf STDERR
"AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
857 $ip = $session->param('ip');
858 $lasttime = $session->param('lasttime');
860 $sessiontype = $session->param('sessiontype') || '';
862 if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
863 || ( $cas && $query->param('ticket') && !C4
::Context
->userenv->{'id'} )
864 || ( $shib && $shib_login && !$logout && !C4
::Context
->userenv->{'id'} )
867 #if a user enters an id ne to the id in the current session, we need to log them in...
868 #first we need to clear the anonymous session...
869 $debug and warn "query id = $q_userid but session id = $s_userid";
870 $anon_search_history = $session->param('search_history');
873 C4
::Context
->_unset_userenv($sessionID);
879 # voluntary logout the user
880 # check wether the user was using their shibboleth session or a local one
881 my $shibSuccess = C4
::Context
->userenv->{'shibboleth'};
884 C4
::Context
->_unset_userenv($sessionID);
886 #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
890 if ($cas and $caslogout) {
891 logout_cas
($query, $type);
894 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
895 if ( $shib and $shib_login and $shibSuccess) {
899 elsif ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
902 $info{'timed_out'} = 1;
907 C4
::Context
->_unset_userenv($sessionID);
909 #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
913 elsif ( C4
::Context
->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
915 # Different ip than originally logged in from
916 $info{'oldip'} = $ip;
917 $info{'newip'} = $ENV{'REMOTE_ADDR'};
918 $info{'different_ip'} = 1;
921 C4
::Context
->_unset_userenv($sessionID);
923 #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
928 $cookie = $query->cookie(
929 -name
=> 'CGISESSID',
930 -value
=> $session->id,
933 $session->param( 'lasttime', time() );
934 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...
935 $flags = haspermission
( $userid, $flagsrequired );
939 $info{'nopermission'} = 1;
944 unless ( $userid || $sessionID ) {
945 #we initiate a session prior to checking for a username to allow for anonymous sessions...
946 my $session = get_session
("") or die "Auth ERROR: Cannot get_session()";
948 # Save anonymous search history in new session so it can be retrieved
949 # by get_template_and_user to store it in user's search history after
950 # a successful login.
951 if ($anon_search_history) {
952 $session->param( 'search_history', $anon_search_history );
955 $sessionID = $session->id;
956 C4
::Context
->_new_userenv($sessionID);
957 $cookie = $query->cookie(
958 -name
=> 'CGISESSID',
959 -value
=> $session->id,
962 my $pki_field = C4
::Context
->preference('AllowPKIAuth');
963 if ( !defined($pki_field) ) {
964 print STDERR
"ERROR: Missing system preference AllowPKIAuth.\n";
967 if ( ( $cas && $query->param('ticket') )
969 || ( $shib && $shib_login )
970 || $pki_field ne 'None'
973 my $password = $query->param('password');
975 my ( $return, $cardnumber );
977 # If shib is enabled and we have a shib login, does the login match a valid koha user
978 if ( $shib && $shib_login ) {
981 # Do not pass password here, else shib will not be checked in checkpw.
982 ( $return, $cardnumber, $retuserid ) = checkpw
( $dbh, $q_userid, undef, $query );
983 $userid = $retuserid;
984 $shibSuccess = $return;
985 $info{'invalidShibLogin'} = 1 unless ($return);
988 # If shib login and match were successful, skip further login methods
989 unless ($shibSuccess) {
990 if ( $cas && $query->param('ticket') ) {
992 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
993 checkpw
( $dbh, $userid, $password, $query, $type );
994 $userid = $retuserid;
995 $info{'invalidCasLogin'} = 1 unless ($return);
998 elsif ( $emailaddress ) {
999 my $value = $emailaddress;
1001 # If we're looking up the email, there's a chance that the person
1002 # doesn't have a userid. So if there is none, we pass along the
1003 # borrower number, and the bits of code that need to know the user
1004 # ID will have to be smart enough to handle that.
1005 my $patrons = Koha
::Patrons
->search({ email
=> $value });
1006 if ($patrons->count) {
1008 # First the userid, then the borrowernum
1009 my $patron = $patrons->next;
1010 $value = $patron->userid || $patron->borrowernumber;
1014 $return = $value ?
1 : 0;
1019 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1020 || ( $pki_field eq 'emailAddress'
1021 && $ENV{'SSL_CLIENT_S_DN_Email'} )
1025 if ( $pki_field eq 'Common Name' ) {
1026 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1028 elsif ( $pki_field eq 'emailAddress' ) {
1029 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1031 # If we're looking up the email, there's a chance that the person
1032 # doesn't have a userid. So if there is none, we pass along the
1033 # borrower number, and the bits of code that need to know the user
1034 # ID will have to be smart enough to handle that.
1035 my $patrons = Koha
::Patrons
->search({ email
=> $value });
1036 if ($patrons->count) {
1038 # First the userid, then the borrowernum
1039 my $patron = $patrons->next;
1040 $value = $patron->userid || $patron->borrowernumber;
1046 $return = $value ?
1 : 0;
1052 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1053 checkpw
( $dbh, $q_userid, $password, $query, $type );
1054 $userid = $retuserid if ($retuserid);
1055 $info{'invalid_username_or_password'} = 1 unless ($return);
1059 # $return: 1 = valid user
1062 #_session_log(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
1063 if ( $flags = haspermission
( $userid, $flagsrequired ) ) {
1067 $info{'nopermission'} = 1;
1068 C4
::Context
->_unset_userenv($sessionID);
1070 my ( $borrowernumber, $firstname, $surname, $userflags,
1071 $branchcode, $branchname, $branchprinter, $emailaddress );
1073 if ( $return == 1 ) {
1075 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1076 branches.branchname as branchname,
1077 branches.branchprinter as branchprinter,
1080 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1082 my $sth = $dbh->prepare("$select where userid=?");
1083 $sth->execute($userid);
1084 unless ( $sth->rows ) {
1085 $debug and print STDERR
"AUTH_1: no rows for userid='$userid'\n";
1086 $sth = $dbh->prepare("$select where cardnumber=?");
1087 $sth->execute($cardnumber);
1089 unless ( $sth->rows ) {
1090 $debug and print STDERR
"AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1091 $sth->execute($userid);
1092 unless ( $sth->rows ) {
1093 $debug and print STDERR
"AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1098 ( $borrowernumber, $firstname, $surname, $userflags,
1099 $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow;
1100 $debug and print STDERR
"AUTH_3 results: " .
1101 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1103 print STDERR
"AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1106 # launch a sequence to check if we have a ip for the branch, i
1107 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1109 my $ip = $ENV{'REMOTE_ADDR'};
1111 # if they specify at login, use that
1112 if ( $query->param('branch') ) {
1113 $branchcode = $query->param('branch');
1114 my $library = Koha
::Libraries
->find($branchcode);
1115 $branchname = $library?
$library->branchname: '';
1117 my $branches = { map { $_->branchcode => $_->unblessed } Koha
::Libraries
->search };
1118 if ( $type ne 'opac' and C4
::Context
->boolean_preference('AutoLocation') ) {
1120 # we have to check they are coming from the right ip range
1121 my $domain = $branches->{$branchcode}->{'branchip'};
1122 $domain =~ s
|\
.\
*||g
;
1123 if ( $ip !~ /^$domain/ ) {
1125 $cookie = $query->cookie(
1126 -name
=> 'CGISESSID',
1130 $info{'wrongip'} = 1;
1134 foreach my $br ( keys %$branches ) {
1136 # now we work with the treatment of ip
1137 my $domain = $branches->{$br}->{'branchip'};
1138 if ( $domain && $ip =~ /^$domain/ ) {
1139 $branchcode = $branches->{$br}->{'branchcode'};
1141 # new op dev : add the branchprinter and branchname in the cookie
1142 $branchprinter = $branches->{$br}->{'branchprinter'};
1143 $branchname = $branches->{$br}->{'branchname'};
1146 $session->param( 'number', $borrowernumber );
1147 $session->param( 'id', $userid );
1148 $session->param( 'cardnumber', $cardnumber );
1149 $session->param( 'firstname', $firstname );
1150 $session->param( 'surname', $surname );
1151 $session->param( 'branch', $branchcode );
1152 $session->param( 'branchname', $branchname );
1153 $session->param( 'flags', $userflags );
1154 $session->param( 'emailaddress', $emailaddress );
1155 $session->param( 'ip', $session->remote_addr() );
1156 $session->param( 'lasttime', time() );
1157 $session->param( 'interface', $type);
1158 $session->param( 'shibboleth', $shibSuccess );
1159 $debug and printf STDERR
"AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1161 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1162 C4
::Context
->set_userenv(
1163 $session->param('number'), $session->param('id'),
1164 $session->param('cardnumber'), $session->param('firstname'),
1165 $session->param('surname'), $session->param('branch'),
1166 $session->param('branchname'), $session->param('flags'),
1167 $session->param('emailaddress'), $session->param('branchprinter'),
1168 $session->param('shibboleth')
1172 # $return: 0 = invalid user
1173 # reset to anonymous session
1175 $debug and warn "Login failed, resetting anonymous session...";
1177 $info{'invalid_username_or_password'} = 1;
1178 C4
::Context
->_unset_userenv($sessionID);
1180 $session->param( 'lasttime', time() );
1181 $session->param( 'ip', $session->remote_addr() );
1182 $session->param( 'sessiontype', 'anon' );
1183 $session->param( 'interface', $type);
1185 } # END if ( $q_userid
1186 elsif ( $type eq "opac" ) {
1188 # if we are here this is an anonymous session; add public lists to it and a few other items...
1189 # anonymous sessions are created only for the OPAC
1190 $debug and warn "Initiating an anonymous session...";
1192 # setting a couple of other session vars...
1193 $session->param( 'ip', $session->remote_addr() );
1194 $session->param( 'lasttime', time() );
1195 $session->param( 'sessiontype', 'anon' );
1196 $session->param( 'interface', $type);
1198 } # END unless ($userid)
1200 # finished authentification, now respond
1201 if ( $loggedin || $authnotrequired )
1205 $cookie = $query->cookie(
1206 -name
=> 'CGISESSID',
1212 track_login_daily
( $userid );
1214 return ( $userid, $cookie, $sessionID, $flags );
1219 # AUTH rejected, show the login/password template, after checking the DB.
1223 # get the inputs from the incoming query
1225 foreach my $name ( param
$query) {
1226 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1227 my @value = $query->multi_param($name);
1228 push @inputs, { name
=> $name, value
=> $_ } for @value;
1231 my $patron = Koha
::Patrons
->find({ userid
=> $q_userid }); # Not necessary logged in!
1233 my $LibraryNameTitle = C4
::Context
->preference("LibraryName");
1234 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?
)>/ /sgi;
1235 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1237 my $template_name = ( $type eq 'opac' ) ?
'opac-auth.tt' : 'auth.tt';
1238 my $template = C4
::Templates
::gettemplate
( $template_name, $type, $query );
1242 script_name
=> get_script_name
(),
1243 casAuthentication
=> C4
::Context
->preference("casAuthentication"),
1244 shibbolethAuthentication
=> $shib,
1245 SessionRestrictionByIP
=> C4
::Context
->preference("SessionRestrictionByIP"),
1246 suggestion
=> C4
::Context
->preference("suggestion"),
1247 virtualshelves
=> C4
::Context
->preference("virtualshelves"),
1248 LibraryName
=> "" . C4
::Context
->preference("LibraryName"),
1249 LibraryNameTitle
=> "" . $LibraryNameTitle,
1250 opacuserlogin
=> C4
::Context
->preference("opacuserlogin"),
1251 OpacNav
=> C4
::Context
->preference("OpacNav"),
1252 OpacNavBottom
=> C4
::Context
->preference("OpacNavBottom"),
1253 opaccredits
=> C4
::Context
->preference("opaccredits"),
1254 OpacFavicon
=> C4
::Context
->preference("OpacFavicon"),
1255 opacreadinghistory
=> C4
::Context
->preference("opacreadinghistory"),
1256 opaclanguagesdisplay
=> C4
::Context
->preference("opaclanguagesdisplay"),
1257 OPACUserJS
=> C4
::Context
->preference("OPACUserJS"),
1258 opacbookbag
=> "" . C4
::Context
->preference("opacbookbag"),
1259 OpacCloud
=> C4
::Context
->preference("OpacCloud"),
1260 OpacTopissue
=> C4
::Context
->preference("OpacTopissue"),
1261 OpacAuthorities
=> C4
::Context
->preference("OpacAuthorities"),
1262 OpacBrowser
=> C4
::Context
->preference("OpacBrowser"),
1263 opacheader
=> C4
::Context
->preference("opacheader"),
1264 TagsEnabled
=> C4
::Context
->preference("TagsEnabled"),
1265 OPACUserCSS
=> C4
::Context
->preference("OPACUserCSS"),
1266 intranetcolorstylesheet
=> C4
::Context
->preference("intranetcolorstylesheet"),
1267 intranetstylesheet
=> C4
::Context
->preference("intranetstylesheet"),
1268 intranetbookbag
=> C4
::Context
->preference("intranetbookbag"),
1269 IntranetNav
=> C4
::Context
->preference("IntranetNav"),
1270 IntranetFavicon
=> C4
::Context
->preference("IntranetFavicon"),
1271 IntranetUserCSS
=> C4
::Context
->preference("IntranetUserCSS"),
1272 IntranetUserJS
=> C4
::Context
->preference("IntranetUserJS"),
1273 IndependentBranches
=> C4
::Context
->preference("IndependentBranches"),
1274 AutoLocation
=> C4
::Context
->preference("AutoLocation"),
1275 wrongip
=> $info{'wrongip'},
1276 PatronSelfRegistration
=> C4
::Context
->preference("PatronSelfRegistration"),
1277 PatronSelfRegistrationDefaultCategory
=> C4
::Context
->preference("PatronSelfRegistrationDefaultCategory"),
1278 opac_css_override
=> $ENV{'OPAC_CSS_OVERRIDE'},
1279 too_many_login_attempts
=> ( $patron and $patron->account_locked )
1282 $template->param( SCO_login
=> 1 ) if ( $query->param('sco_user_login') );
1283 $template->param( SCI_login
=> 1 ) if ( $query->param('sci_user_login') );
1284 $template->param( OpacPublic
=> C4
::Context
->preference("OpacPublic") );
1285 $template->param( loginprompt
=> 1 ) unless $info{'nopermission'};
1287 if ( $type eq 'opac' ) {
1288 require Koha
::Virtualshelves
;
1289 my $some_public_shelves = Koha
::Virtualshelves
->get_some_shelves(
1295 some_public_shelves
=> $some_public_shelves,
1301 # Is authentication against multiple CAS servers enabled?
1302 if ( C4
::Auth_with_cas
::multipleAuth
&& !$casparam ) {
1303 my $casservers = C4
::Auth_with_cas
::getMultipleAuth
();
1305 foreach my $key ( keys %$casservers ) {
1306 push @tmplservers, { name
=> $key, value
=> login_cas_url
( $query, $key, $type ) . "?cas=$key" };
1309 casServersLoop
=> \
@tmplservers
1313 casServerUrl
=> login_cas_url
($query, undef, $type),
1318 invalidCasLogin
=> $info{'invalidCasLogin'}
1324 shibbolethAuthentication
=> $shib,
1325 shibbolethLoginUrl
=> login_shib_url
($query),
1329 if (C4
::Context
->preference('GoogleOpenIDConnect')) {
1330 if ($query->param("OpenIDConnectFailed")) {
1331 my $reason = $query->param('OpenIDConnectFailed');
1332 $template->param(invalidGoogleOpenIDConnectLogin
=> $reason);
1337 LibraryName
=> C4
::Context
->preference("LibraryName"),
1339 $template->param(%info);
1341 # $cookie = $query->cookie(CGISESSID => $session->id
1343 print $query->header(
1344 { type
=> 'text/html',
1347 'X-Frame-Options' => 'SAMEORIGIN'
1354 =head2 check_api_auth
1356 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1358 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1359 cookie, determine if the user has the privileges specified by C<$userflags>.
1361 C<check_api_auth> is is meant for authenticating users of web services, and
1362 consequently will always return and will not attempt to redirect the user
1365 If a valid session cookie is already present, check_api_auth will return a status
1366 of "ok", the cookie, and the Koha session ID.
1368 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1369 parameters and create a session cookie and Koha session if the supplied credentials
1372 Possible return values in C<$status> are:
1376 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1378 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1380 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1382 =item "expired -- session cookie has expired; API user should resubmit userid and password
1388 sub check_api_auth
{
1391 my $flagsrequired = shift;
1392 my $dbh = C4
::Context
->dbh;
1393 my $timeout = _timeout_syspref
();
1395 unless ( C4
::Context
->preference('Version') ) {
1397 # database has not been installed yet
1398 return ( "maintenance", undef, undef );
1400 my $kohaversion = Koha
::version
();
1401 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1402 if ( C4
::Context
->preference('Version') < $kohaversion ) {
1404 # database in need of version update; assume that
1405 # no API should be called while databsae is in
1407 return ( "maintenance", undef, undef );
1410 # FIXME -- most of what follows is a copy-and-paste
1411 # of code from checkauth. There is an obvious need
1412 # for refactoring to separate the various parts of
1413 # the authentication code, but as of 2007-11-19 this
1414 # is deferred so as to not introduce bugs into the
1415 # regular authentication code for Koha 3.0.
1417 # see if we have a valid session cookie already
1418 # however, if a userid parameter is present (i.e., from
1419 # a form submission, assume that any current cookie
1421 my $sessionID = undef;
1422 unless ( $query->param('userid') ) {
1423 $sessionID = $query->cookie("CGISESSID");
1425 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1426 my $session = get_session
($sessionID);
1427 C4
::Context
->_new_userenv($sessionID);
1429 C4
::Context
->interface($session->param('interface'));
1430 C4
::Context
->set_userenv(
1431 $session->param('number'), $session->param('id'),
1432 $session->param('cardnumber'), $session->param('firstname'),
1433 $session->param('surname'), $session->param('branch'),
1434 $session->param('branchname'), $session->param('flags'),
1435 $session->param('emailaddress'), $session->param('branchprinter')
1438 my $ip = $session->param('ip');
1439 my $lasttime = $session->param('lasttime');
1440 my $userid = $session->param('id');
1441 if ( $lasttime < time() - $timeout ) {
1446 C4
::Context
->_unset_userenv($sessionID);
1449 return ( "expired", undef, undef );
1450 } elsif ( C4
::Context
->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1452 # IP address changed
1455 C4
::Context
->_unset_userenv($sessionID);
1458 return ( "expired", undef, undef );
1460 my $cookie = $query->cookie(
1461 -name
=> 'CGISESSID',
1462 -value
=> $session->id,
1465 $session->param( 'lasttime', time() );
1466 my $flags = haspermission
( $userid, $flagsrequired );
1468 return ( "ok", $cookie, $sessionID );
1472 C4
::Context
->_unset_userenv($sessionID);
1475 return ( "failed", undef, undef );
1479 return ( "expired", undef, undef );
1484 my $userid = $query->param('userid');
1485 my $password = $query->param('password');
1486 my ( $return, $cardnumber, $cas_ticket );
1489 if ( $cas && $query->param('PT') ) {
1491 $debug and print STDERR
"## check_api_auth - checking CAS\n";
1493 # In case of a CAS authentication, we use the ticket instead of the password
1494 my $PT = $query->param('PT');
1495 ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas
( $dbh, $PT, $query ); # EXTERNAL AUTH
1498 # User / password auth
1499 unless ( $userid and $password ) {
1501 # caller did something wrong, fail the authenticateion
1502 return ( "failed", undef, undef );
1505 ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw
( $dbh, $userid, $password, $query );
1508 if ( $return and haspermission
( $userid, $flagsrequired ) ) {
1509 my $session = get_session
("");
1510 return ( "failed", undef, undef ) unless $session;
1512 my $sessionID = $session->id;
1513 C4
::Context
->_new_userenv($sessionID);
1514 my $cookie = $query->cookie(
1515 -name
=> 'CGISESSID',
1516 -value
=> $sessionID,
1519 if ( $return == 1 ) {
1521 $borrowernumber, $firstname, $surname,
1522 $userflags, $branchcode, $branchname,
1523 $branchprinter, $emailaddress
1527 "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=?"
1529 $sth->execute($userid);
1531 $borrowernumber, $firstname, $surname,
1532 $userflags, $branchcode, $branchname,
1533 $branchprinter, $emailaddress
1534 ) = $sth->fetchrow if ( $sth->rows );
1536 unless ( $sth->rows ) {
1537 my $sth = $dbh->prepare(
1538 "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=?"
1540 $sth->execute($cardnumber);
1542 $borrowernumber, $firstname, $surname,
1543 $userflags, $branchcode, $branchname,
1544 $branchprinter, $emailaddress
1545 ) = $sth->fetchrow if ( $sth->rows );
1547 unless ( $sth->rows ) {
1548 $sth->execute($userid);
1550 $borrowernumber, $firstname, $surname, $userflags,
1551 $branchcode, $branchname, $branchprinter, $emailaddress
1552 ) = $sth->fetchrow if ( $sth->rows );
1556 my $ip = $ENV{'REMOTE_ADDR'};
1558 # if they specify at login, use that
1559 if ( $query->param('branch') ) {
1560 $branchcode = $query->param('branch');
1561 my $library = Koha
::Libraries
->find($branchcode);
1562 $branchname = $library?
$library->branchname: '';
1564 my $branches = { map { $_->branchcode => $_->unblessed } Koha
::Libraries
->search };
1565 foreach my $br ( keys %$branches ) {
1567 # now we work with the treatment of ip
1568 my $domain = $branches->{$br}->{'branchip'};
1569 if ( $domain && $ip =~ /^$domain/ ) {
1570 $branchcode = $branches->{$br}->{'branchcode'};
1572 # new op dev : add the branchprinter and branchname in the cookie
1573 $branchprinter = $branches->{$br}->{'branchprinter'};
1574 $branchname = $branches->{$br}->{'branchname'};
1577 $session->param( 'number', $borrowernumber );
1578 $session->param( 'id', $userid );
1579 $session->param( 'cardnumber', $cardnumber );
1580 $session->param( 'firstname', $firstname );
1581 $session->param( 'surname', $surname );
1582 $session->param( 'branch', $branchcode );
1583 $session->param( 'branchname', $branchname );
1584 $session->param( 'flags', $userflags );
1585 $session->param( 'emailaddress', $emailaddress );
1586 $session->param( 'ip', $session->remote_addr() );
1587 $session->param( 'lasttime', time() );
1588 $session->param( 'interface', 'api' );
1590 $session->param( 'cas_ticket', $cas_ticket);
1591 C4
::Context
->set_userenv(
1592 $session->param('number'), $session->param('id'),
1593 $session->param('cardnumber'), $session->param('firstname'),
1594 $session->param('surname'), $session->param('branch'),
1595 $session->param('branchname'), $session->param('flags'),
1596 $session->param('emailaddress'), $session->param('branchprinter')
1598 return ( "ok", $cookie, $sessionID );
1600 return ( "failed", undef, undef );
1605 =head2 check_cookie_auth
1607 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1609 Given a CGISESSID cookie set during a previous login to Koha, determine
1610 if the user has the privileges specified by C<$userflags>. C<$userflags>
1611 is passed unaltered into C<haspermission> and as such accepts all options
1612 avaiable to that routine with the one caveat that C<check_api_auth> will
1613 also allow 'undef' to be passed and in such a case the permissions check
1614 will be skipped altogether.
1616 C<check_cookie_auth> is meant for authenticating special services
1617 such as tools/upload-file.pl that are invoked by other pages that
1618 have been authenticated in the usual way.
1620 Possible return values in C<$status> are:
1624 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1626 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1628 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1630 =item "expired -- session cookie has expired; API user should resubmit userid and password
1636 sub check_cookie_auth
{
1638 my $flagsrequired = shift;
1641 my $remote_addr = $params->{remote_addr
} || $ENV{REMOTE_ADDR
};
1642 my $dbh = C4
::Context
->dbh;
1643 my $timeout = _timeout_syspref
();
1645 unless ( C4
::Context
->preference('Version') ) {
1647 # database has not been installed yet
1648 return ( "maintenance", undef );
1650 my $kohaversion = Koha
::version
();
1651 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1652 if ( C4
::Context
->preference('Version') < $kohaversion ) {
1654 # database in need of version update; assume that
1655 # no API should be called while databsae is in
1657 return ( "maintenance", undef );
1660 # FIXME -- most of what follows is a copy-and-paste
1661 # of code from checkauth. There is an obvious need
1662 # for refactoring to separate the various parts of
1663 # the authentication code, but as of 2007-11-23 this
1664 # is deferred so as to not introduce bugs into the
1665 # regular authentication code for Koha 3.0.
1667 # see if we have a valid session cookie already
1668 # however, if a userid parameter is present (i.e., from
1669 # a form submission, assume that any current cookie
1671 unless ( defined $cookie and $cookie ) {
1672 return ( "failed", undef );
1674 my $sessionID = $cookie;
1675 my $session = get_session
($sessionID);
1676 C4
::Context
->_new_userenv($sessionID);
1678 C4
::Context
->interface($session->param('interface'));
1679 C4
::Context
->set_userenv(
1680 $session->param('number'), $session->param('id'),
1681 $session->param('cardnumber'), $session->param('firstname'),
1682 $session->param('surname'), $session->param('branch'),
1683 $session->param('branchname'), $session->param('flags'),
1684 $session->param('emailaddress'), $session->param('branchprinter')
1687 my $ip = $session->param('ip');
1688 my $lasttime = $session->param('lasttime');
1689 my $userid = $session->param('id');
1690 if ( $lasttime < time() - $timeout ) {
1695 C4
::Context
->_unset_userenv($sessionID);
1698 return ("expired", undef);
1699 } elsif ( C4
::Context
->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1701 # IP address changed
1704 C4
::Context
->_unset_userenv($sessionID);
1707 return ( "expired", undef );
1709 $session->param( 'lasttime', time() );
1710 my $flags = defined($flagsrequired) ? haspermission
( $userid, $flagsrequired ) : 1;
1712 return ( "ok", $sessionID );
1716 C4
::Context
->_unset_userenv($sessionID);
1719 return ( "failed", undef );
1723 return ( "expired", undef );
1730 my $session = get_session($sessionID);
1732 Given a session ID, retrieve the CGI::Session object used to store
1733 the session's state. The session object can be used to store
1734 data that needs to be accessed by different scripts during a
1737 If the C<$sessionID> parameter is an empty string, a new session
1742 sub _get_session_params
{
1743 my $storage_method = C4
::Context
->preference('SessionStorage');
1744 if ( $storage_method eq 'mysql' ) {
1745 my $dbh = C4
::Context
->dbh;
1746 return { dsn
=> "driver:MySQL;serializer:yaml;id:md5", dsn_args
=> { Handle
=> $dbh } };
1748 elsif ( $storage_method eq 'Pg' ) {
1749 my $dbh = C4
::Context
->dbh;
1750 return { dsn
=> "driver:PostgreSQL;serializer:yaml;id:md5", dsn_args
=> { Handle
=> $dbh } };
1752 elsif ( $storage_method eq 'memcached' && Koha
::Caches
->get_instance->memcached_cache ) {
1753 my $memcached = Koha
::Caches
->get_instance()->memcached_cache;
1754 return { dsn
=> "driver:memcached;serializer:yaml;id:md5", dsn_args
=> { Memcached
=> $memcached } };
1757 # catch all defaults to tmp should work on all systems
1758 my $dir = C4
::Context
::temporary_directory
;
1759 my $instance = C4
::Context
->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1760 return { dsn
=> "driver:File;serializer:yaml;id:md5", dsn_args
=> { Directory
=> "$dir/cgisess_$instance" } };
1765 my $sessionID = shift;
1766 my $params = _get_session_params
();
1767 return new CGI
::Session
( $params->{dsn
}, $sessionID, $params->{dsn_args
} );
1771 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1772 # (or something similar)
1773 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1774 # not having a userenv defined could cause a crash.
1776 my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1777 $type = 'opac' unless $type;
1779 # Get shibboleth login attribute
1780 my $shib = C4
::Context
->config('useshibboleth') && shib_ok
();
1781 my $shib_login = $shib ? get_login_shib
() : undef;
1784 my $patron = Koha
::Patrons
->find({ userid
=> $userid });
1785 $patron = Koha
::Patrons
->find({ cardnumber
=> $userid }) unless $patron;
1786 my $check_internal_as_fallback = 0;
1788 # Note: checkpw_* routines returns:
1791 # -1 if user bind failed (LDAP only)
1793 if ( $patron and $patron->account_locked ) {
1794 # Nothing to check, account is locked
1795 } elsif ($ldap && defined($password)) {
1796 $debug and print STDERR
"## checkpw - checking LDAP\n";
1797 my ( $retval, $retcard, $retuserid ) = checkpw_ldap
(@_); # EXTERNAL AUTH
1798 if ( $retval == 1 ) {
1799 @return = ( $retval, $retcard, $retuserid );
1802 $check_internal_as_fallback = 1 if $retval == 0;
1804 } elsif ( $cas && $query && $query->param('ticket') ) {
1805 $debug and print STDERR
"## checkpw - checking CAS\n";
1807 # In case of a CAS authentication, we use the ticket instead of the password
1808 my $ticket = $query->param('ticket');
1809 $query->delete('ticket'); # remove ticket to come back to original URL
1810 my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas
( $dbh, $ticket, $query, $type ); # EXTERNAL AUTH
1812 @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1816 $passwd_ok = $retval;
1819 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1820 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1822 elsif ( $shib && $shib_login && !$password ) {
1824 $debug and print STDERR
"## checkpw - checking Shibboleth\n";
1826 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1827 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1828 # shibboleth-authenticated user
1830 # Then, we check if it matches a valid koha user
1832 my ( $retval, $retcard, $retuserid ) = C4
::Auth_with_shibboleth
::checkpw_shib
($shib_login); # EXTERNAL AUTH
1834 @return = ( $retval, $retcard, $retuserid );
1836 $passwd_ok = $retval;
1839 $check_internal_as_fallback = 1;
1843 if ( $check_internal_as_fallback ) {
1844 @return = checkpw_internal
( $dbh, $userid, $password, $no_set_userenv);
1845 $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1850 $patron->update({ login_attempts
=> 0 });
1851 } elsif( !$patron->account_locked ) {
1852 $patron->update({ login_attempts
=> $patron->login_attempts + 1 });
1858 sub checkpw_internal
{
1859 my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
1861 $password = Encode
::encode
( 'UTF-8', $password )
1862 if Encode
::is_utf8
($password);
1866 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1868 $sth->execute($userid);
1870 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1871 $surname, $branchcode, $branchname, $flags )
1874 if ( checkpw_hash
( $password, $stored_hash ) ) {
1876 C4
::Context
->set_userenv( "$borrowernumber", $userid, $cardnumber,
1877 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1878 return 1, $cardnumber, $userid;
1883 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1885 $sth->execute($userid);
1887 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1888 $surname, $branchcode, $branchname, $flags )
1891 if ( checkpw_hash
( $password, $stored_hash ) ) {
1893 C4
::Context
->set_userenv( $borrowernumber, $userid, $cardnumber,
1894 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1895 return 1, $cardnumber, $userid;
1902 my ( $password, $stored_hash ) = @_;
1904 return if $stored_hash eq '!';
1906 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1908 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1909 $hash = hash_password
( $password, $stored_hash );
1911 $hash = md5_base64
($password);
1913 return $hash eq $stored_hash;
1918 my $authflags = getuserflags($flags, $userid, [$dbh]);
1920 Translates integer flags into permissions strings hash.
1922 C<$flags> is the integer userflags value ( borrowers.userflags )
1923 C<$userid> is the members.userid, used for building subpermissions
1924 C<$authflags> is a hashref of permissions
1931 my $dbh = @_ ?
shift : C4
::Context
->dbh;
1934 # I don't want to do this, but if someone logs in as the database
1935 # user, it would be preferable not to spam them to death with
1936 # numeric warnings. So, we make $flags numeric.
1937 no warnings
'numeric';
1940 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1943 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1944 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1945 $userflags->{$flag} = 1;
1948 $userflags->{$flag} = 0;
1952 # get subpermissions and merge with top-level permissions
1953 my $user_subperms = get_user_subpermissions
($userid);
1954 foreach my $module ( keys %$user_subperms ) {
1955 next if $userflags->{$module} == 1; # user already has permission for everything in this module
1956 $userflags->{$module} = $user_subperms->{$module};
1962 =head2 get_user_subpermissions
1964 $user_perm_hashref = get_user_subpermissions($userid);
1966 Given the userid (note, not the borrowernumber) of a staff user,
1967 return a hashref of hashrefs of the specific subpermissions
1968 accorded to the user. An example return is
1972 export_catalog => 1,
1973 import_patrons => 1,
1977 The top-level hash-key is a module or function code from
1978 userflags.flag, while the second-level key is a code
1981 The results of this function do not give a complete picture
1982 of the functions that a staff user can access; it is also
1983 necessary to check borrowers.flags.
1987 sub get_user_subpermissions
{
1990 my $dbh = C4
::Context
->dbh;
1991 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
1992 FROM user_permissions
1993 JOIN permissions USING (module_bit, code)
1994 JOIN userflags ON (module_bit = bit)
1995 JOIN borrowers USING (borrowernumber)
1996 WHERE userid = ?" );
1997 $sth->execute($userid);
1999 my $user_perms = {};
2000 while ( my $perm = $sth->fetchrow_hashref ) {
2001 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2006 =head2 get_all_subpermissions
2008 my $perm_hashref = get_all_subpermissions();
2010 Returns a hashref of hashrefs defining all specific
2011 permissions currently defined. The return value
2012 has the same structure as that of C<get_user_subpermissions>,
2013 except that the innermost hash value is the description
2014 of the subpermission.
2018 sub get_all_subpermissions
{
2019 my $dbh = C4
::Context
->dbh;
2020 my $sth = $dbh->prepare( "SELECT flag, code
2022 JOIN userflags ON (module_bit = bit)" );
2026 while ( my $perm = $sth->fetchrow_hashref ) {
2027 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2032 =head2 haspermission
2034 $flagsrequired = '*'; # Any permission at all
2035 $flagsrequired = 'a_flag'; # a_flag must be satisfied (all subpermissions)
2036 $flagsrequired = [ 'a_flag', 'b_flag' ]; # a_flag OR b_flag must be satisfied
2037 $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 }; # a_flag AND b_flag must be satisfied
2038 $flagsrequired = { 'a_flag' => 'sub_a' }; # sub_a of a_flag must be satisfied
2039 $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2041 $flags = ($userid, $flagsrequired);
2043 C<$userid> the userid of the member
2044 C<$flags> is a query structure similar to that used by SQL::Abstract that
2045 denotes the combination of flags required. It is a required parameter.
2047 The main logic of this method is that things in arrays are OR'ed, and things
2048 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2050 Returns member's flags or 0 if a permission is not met.
2055 my ($required, $flags) = @_;
2057 my $ref = ref($required);
2059 if ($required eq '*') {
2060 return 0 unless ( $flags or ref( $flags ) );
2062 return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2064 } elsif ($ref eq 'HASH') {
2065 foreach my $key (keys %{$required}) {
2066 next if $flags == 1;
2067 my $require = $required->{$key};
2068 my $rflags = $flags->{$key};
2069 return 0 unless _dispatch
($require, $rflags);
2071 } elsif ($ref eq 'ARRAY') {
2073 foreach my $require ( @
{$required} ) {
2075 ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2076 ?
$flags->{$require}
2078 $satisfied++ if _dispatch
( $require, $rflags );
2080 return 0 unless $satisfied;
2082 croak
"Unexpected structure found: $ref";
2089 my ( $userid, $flagsrequired ) = @_;
2091 #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2092 # unless defined($flagsrequired);
2094 my $sth = C4
::Context
->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2095 $sth->execute($userid);
2096 my $row = $sth->fetchrow();
2097 my $flags = getuserflags
( $row, $userid );
2099 return $flags unless defined($flagsrequired);
2100 return $flags if $flags->{superlibrarian
};
2101 return _dispatch
($flagsrequired, $flags);
2103 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2110 C<$ipset> A space separated string describing an IP set. Can include single IPs or ranges
2112 Returns 1 if the remote address is in the provided ipset, or 0 otherwise.
2119 my @allowedipranges = $ipset ?
split(' ', $ipset) : ();
2120 if (scalar @allowedipranges > 0) {
2122 eval { @rangelist = Net
::CIDR
::range2cidr
(@allowedipranges); }; return 0 if $@
;
2123 eval { $result = Net
::CIDR
::cidrlookup
($ENV{'REMOTE_ADDR'}, @rangelist) } || ( $ENV{DEBUG
} && warn 'cidrlookup failed for ' . join(' ',@rangelist) );
2125 return $result ?
1 : 0;
2128 sub getborrowernumber
{
2130 my $userenv = C4
::Context
->userenv;
2131 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number
} ) {
2132 return $userenv->{number
};
2134 my $dbh = C4
::Context
->dbh;
2135 for my $field ( 'userid', 'cardnumber' ) {
2137 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2138 $sth->execute($userid);
2140 my ($bnumber) = $sth->fetchrow;
2147 =head2 track_login_daily
2149 track_login_daily( $userid );
2151 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2155 sub track_login_daily
{
2157 return if !$userid || !C4
::Context
->preference('TrackLastPatronActivity');
2159 my $cache = Koha
::Caches
->get_instance();
2160 my $cache_key = "track_login_" . $userid;
2161 my $cached = $cache->get_from_cache($cache_key);
2162 my $today = dt_from_string
()->ymd;
2163 return if $cached && $cached eq $today;
2165 my $patron = Koha
::Patrons
->find({ userid
=> $userid });
2166 return unless $patron;
2167 $patron->track_login;
2168 $cache->set_in_cache( $cache_key, $today );
2171 END { } # module clean-up code here (global destructor)
2181 Crypt::Eksblowfish::Bcrypt(3)