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;
48 use C4::Log qw/logaction/;
51 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout);
54 sub psgi_env { any { /^psgi\./ } keys %ENV }
57 if (psgi_env) { die 'psgi:exit' }
61 C4::Context->set_remote_address;
65 @EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
66 @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash
67 &get_all_subpermissions &get_user_subpermissions track_login_daily &in_iprange
69 %EXPORT_TAGS = ( EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)] );
70 $ldap = C4::Context->config('useldapserver') || 0;
71 $cas = C4::Context->preference('casAuthentication');
72 $caslogout = C4::Context->preference('casLogout');
73 require C4::Auth_with_cas; # no import
76 require C4::Auth_with_ldap;
77 import C4::Auth_with_ldap qw(checkpw_ldap);
80 import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url logout_if_required);
87 C4::Auth - Authenticates Koha users
97 my ($template, $borrowernumber, $cookie)
98 = get_template_and_user(
100 template_name => "opac-main.tt",
103 authnotrequired => 0,
104 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
108 output_html_with_http_headers $query, $cookie, $template->output;
112 The main function of this module is to provide
113 authentification. However the get_template_and_user function has
114 been provided so that a users login information is passed along
115 automatically. This gets loaded into the template.
119 =head2 get_template_and_user
121 my ($template, $borrowernumber, $cookie)
122 = get_template_and_user(
124 template_name => "opac-main.tt",
127 authnotrequired => 0,
128 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
132 This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
133 to C<&checkauth> (in this module) to perform authentification.
134 See C<&checkauth> for an explanation of these parameters.
136 The C<template_name> is then used to find the correct template for
137 the page. The authenticated users details are loaded onto the
138 template in the logged_in_user variable (which is a Koha::Patron object). Also the
139 C<sessionID> is passed to the template. This can be used in templates
140 if cookies are disabled. It needs to be put as and input to every
143 More information on the C<gettemplate> sub can be found in the
148 sub get_template_and_user {
151 my ( $user, $cookie, $sessionID, $flags );
153 # Get shibboleth login attribute
154 my $shib = C4::Context->config('useshibboleth') && shib_ok();
155 my $shib_login = $shib ? get_login_shib() : undef;
157 C4::Context->interface( $in->{type} );
159 $in->{'authnotrequired'} ||= 0;
161 # the following call includes a bad template check; might croak
162 my $template = C4::Templates::gettemplate(
163 $in->{'template_name'},
168 if ( $in->{'template_name'} !~ m/maintenance/ ) {
169 ( $user, $cookie, $sessionID, $flags ) = checkauth(
171 $in->{'authnotrequired'},
172 $in->{'flagsrequired'},
175 $in->{template_name},
179 # If we enforce GDPR and the user did not consent, redirect
180 # Exceptions for consent page itself and SCI/SCO system
181 if( $in->{type} eq 'opac' && $user &&
182 $in->{'template_name'} !~ /^(opac-patron-consent|sc[io]\/)/ &&
183 C4::Context->preference('GDPR_Policy') eq 'Enforced' )
185 my $consent = Koha::Patron::Consents->search({
186 borrowernumber => getborrowernumber($user),
187 type => 'GDPR_PROCESSING',
188 given_on => { '!=', undef },
191 print $in->{query}->redirect(-uri => '/cgi-bin/koha/opac-patron-consent.pl', -cookie => $cookie);
196 if ( $in->{type} eq 'opac' && $user ) {
200 # If the user logged in is the SCO user and they try to go out of the SCO module,
201 # log the user out removing the CGISESSID cookie
202 $in->{template_name} !~ m|sco/| && $in->{template_name} !~ m|errors/errorpage.tt|
203 && C4::Context->preference('AutoSelfCheckID')
204 && $user eq C4::Context->preference('AutoSelfCheckID')
210 # If the user logged in is the SCI user and they try to go out of the SCI module,
211 # kick them out unless it is SCO with a valid permission
212 # or they are a superlibrarian
213 $in->{template_name} !~ m|sci/|
214 && haspermission( $user, { self_check => 'self_checkin_module' } )
216 $in->{template_name} =~ m|sco/| && haspermission(
217 $user, { self_check => 'self_checkout_module' }
220 && $flags && $flags->{superlibrarian} != 1
227 $template = C4::Templates::gettemplate( 'opac-auth.tt', 'opac',
229 $cookie = $in->{query}->cookie(
230 -name => 'CGISESSID',
234 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
239 script_name => get_script_name(),
242 print $in->{query}->header(
247 'X-Frame-Options' => 'SAMEORIGIN'
258 # It's possible for $user to be the borrowernumber if they don't have a
259 # userid defined (and are logging in through some other method, such
260 # as SSL certs against an email address)
262 $borrowernumber = getborrowernumber($user) if defined($user);
263 if ( !defined($borrowernumber) && defined($user) ) {
264 $patron = Koha::Patrons->find( $user );
266 $borrowernumber = $user;
268 # A bit of a hack, but I don't know there's a nicer way
270 $user = $patron->firstname . ' ' . $patron->surname;
273 $patron = Koha::Patrons->find( $borrowernumber );
274 # FIXME What to do if $patron does not exist?
278 $template->param( loggedinusername => $user ); # OBSOLETE - Do not reuse this in template, use logged_in_user.userid instead
279 $template->param( loggedinusernumber => $borrowernumber ); # FIXME Should be replaced with logged_in_user.borrowernumber
280 $template->param( logged_in_user => $patron );
281 $template->param( sessionID => $sessionID );
283 if ( $in->{'type'} eq 'opac' ) {
284 require Koha::Virtualshelves;
285 my $some_private_shelves = Koha::Virtualshelves->get_some_shelves(
287 borrowernumber => $borrowernumber,
291 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
297 some_private_shelves => $some_private_shelves,
298 some_public_shelves => $some_public_shelves,
302 my $all_perms = get_all_subpermissions();
304 my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
305 editcatalogue updatecharges tools editauthorities serials reports acquisition clubs problem_reports);
307 # We are going to use the $flags returned by checkauth
308 # to create the template's parameters that will indicate
309 # which menus the user can access.
310 if ( $flags && $flags->{superlibrarian} == 1 ) {
311 $template->param( CAN_user_circulate => 1 );
312 $template->param( CAN_user_catalogue => 1 );
313 $template->param( CAN_user_parameters => 1 );
314 $template->param( CAN_user_borrowers => 1 );
315 $template->param( CAN_user_permissions => 1 );
316 $template->param( CAN_user_reserveforothers => 1 );
317 $template->param( CAN_user_editcatalogue => 1 );
318 $template->param( CAN_user_updatecharges => 1 );
319 $template->param( CAN_user_acquisition => 1 );
320 $template->param( CAN_user_tools => 1 );
321 $template->param( CAN_user_editauthorities => 1 );
322 $template->param( CAN_user_serials => 1 );
323 $template->param( CAN_user_reports => 1 );
324 $template->param( CAN_user_staffaccess => 1 );
325 $template->param( CAN_user_plugins => 1 );
326 $template->param( CAN_user_coursereserves => 1 );
327 $template->param( CAN_user_clubs => 1 );
328 $template->param( CAN_user_ill => 1 );
329 $template->param( CAN_user_stockrotation => 1 );
330 $template->param( CAN_user_problem_reports => 1 );
332 foreach my $module ( keys %$all_perms ) {
333 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
334 $template->param( "CAN_user_${module}_${subperm}" => 1 );
340 foreach my $module ( keys %$all_perms ) {
341 if ( defined($flags->{$module}) && $flags->{$module} == 1 ) {
342 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
343 $template->param( "CAN_user_${module}_${subperm}" => 1 );
345 } elsif ( ref( $flags->{$module} ) ) {
346 foreach my $subperm ( keys %{ $flags->{$module} } ) {
347 $template->param( "CAN_user_${module}_${subperm}" => 1 );
354 foreach my $module ( keys %$flags ) {
355 if ( $flags->{$module} == 1 or ref( $flags->{$module} ) ) {
356 $template->param( "CAN_user_$module" => 1 );
361 # Logged-in opac search history
362 # If the requested template is an opac one and opac search history is enabled
363 if ( $in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory') ) {
364 my $dbh = C4::Context->dbh;
365 my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
366 my $sth = $dbh->prepare($query);
367 $sth->execute($borrowernumber);
369 # If at least one search has already been performed
370 if ( $sth->fetchrow_array > 0 ) {
372 # We show the link in opac
373 $template->param( EnableOpacSearchHistory => 1 );
375 if (C4::Context->preference('LoadSearchHistoryToTheFirstLoggedUser'))
377 # And if there are searches performed when the user was not logged in,
378 # we add them to the logged-in search history
379 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
380 if (@recentSearches) {
381 my $dbh = C4::Context->dbh;
383 INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, type, total, time )
384 VALUES (?, ?, ?, ?, ?, ?, ?)
386 my $sth = $dbh->prepare($query);
387 $sth->execute( $borrowernumber,
388 $in->{query}->cookie("CGISESSID"),
391 $_->{type} || 'biblio',
394 ) foreach @recentSearches;
396 # clear out the search history from the session now that
397 # we've saved it to the database
400 C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } );
402 } elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) {
403 $template->param( EnableSearchHistory => 1 );
406 else { # if this is an anonymous session, setup to display public lists...
408 # If shibboleth is enabled, and we're in an anonymous session, we should allow
409 # the user to attempt login via shibboleth.
411 $template->param( shibbolethAuthentication => $shib,
412 shibbolethLoginUrl => login_shib_url( $in->{'query'} ),
415 # If shibboleth is enabled and we have a shibboleth login attribute,
416 # but we are in an anonymous session, then we clearly have an invalid
417 # shibboleth koha account.
419 $template->param( invalidShibLogin => '1' );
423 $template->param( sessionID => $sessionID );
425 if ( $in->{'type'} eq 'opac' ){
426 require Koha::Virtualshelves;
427 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
433 some_public_shelves => $some_public_shelves,
438 # Anonymous opac search history
439 # If opac search history is enabled and at least one search has already been performed
440 if ( C4::Context->preference('EnableOpacSearchHistory') ) {
441 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
442 if (@recentSearches) {
443 $template->param( EnableOpacSearchHistory => 1 );
447 if ( C4::Context->preference('dateformat') ) {
448 $template->param( dateformat => C4::Context->preference('dateformat') );
451 $template->param(auth_forwarded_hash => scalar $in->{'query'}->param('auth_forwarded_hash'));
453 # these template parameters are set the same regardless of $in->{'type'}
455 my $minPasswordLength = C4::Context->preference('minPasswordLength');
456 $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
458 "BiblioDefaultView" . C4::Context->preference("BiblioDefaultView") => 1,
459 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
460 GoogleJackets => C4::Context->preference("GoogleJackets"),
461 OpenLibraryCovers => C4::Context->preference("OpenLibraryCovers"),
462 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
463 LoginFirstname => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
464 LoginSurname => C4::Context->userenv ? C4::Context->userenv->{"surname"} : "Inconnu",
465 emailaddress => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
466 TagsEnabled => C4::Context->preference("TagsEnabled"),
467 hide_marc => C4::Context->preference("hide_marc"),
468 item_level_itypes => C4::Context->preference('item-level_itypes'),
469 patronimages => C4::Context->preference("patronimages"),
470 singleBranchMode => ( Koha::Libraries->search->count == 1 ),
471 XSLTDetailsDisplay => C4::Context->preference("XSLTDetailsDisplay"),
472 XSLTResultsDisplay => C4::Context->preference("XSLTResultsDisplay"),
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 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
490 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
491 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
492 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
493 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
494 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
495 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
496 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
497 intranetbookbag => C4::Context->preference("intranetbookbag"),
498 suggestion => C4::Context->preference("suggestion"),
499 virtualshelves => C4::Context->preference("virtualshelves"),
500 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
501 EasyAnalyticalRecords => C4::Context->preference('EasyAnalyticalRecords'),
502 LocalCoverImages => C4::Context->preference('LocalCoverImages'),
503 OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'),
504 AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'),
505 EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'),
506 UseCourseReserves => C4::Context->preference("UseCourseReserves"),
507 useDischarge => C4::Context->preference('useDischarge'),
508 pending_checkout_notes => scalar Koha::Checkouts->search({ noteseen => 0 }),
512 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
514 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
515 my $LibraryNameTitle = C4::Context->preference("LibraryName");
516 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
517 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
519 # clean up the busc param in the session
520 # if the page is not opac-detail and not the "add to list" page
521 # and not the "edit comments" page
522 if ( C4::Context->preference("OpacBrowseResults")
523 && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
525 unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
526 or $pagename =~ /^addbybiblionumber$/
527 or $pagename =~ /^review$/ ) {
528 my $sessionSearch = get_session( $sessionID || $in->{'query'}->cookie("CGISESSID") );
529 $sessionSearch->clear( ["busc"] ) if ( $sessionSearch->param("busc") );
533 # variables passed from CGI: opac_css_override and opac_search_limits.
534 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
535 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
538 ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:([\w-]+)/ ) ||
539 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:([\w-]+)/ ) ||
540 ( $in->{'query'}->param('multibranchlimit') && $in->{'query'}->param('multibranchlimit') =~ /multibranchlimit-(\w+)/ )
542 $opac_name = $1; # opac_search_limit is a branch, so we use it.
543 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
544 $opac_name = $in->{'query'}->param('multibranchlimit');
545 } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
546 $opac_name = C4::Context->userenv->{'branch'};
549 my @search_groups = Koha::Library::Groups->get_search_groups({ interface => 'opac' });
551 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
552 LibrarySearchGroups => \@search_groups,
553 opac_name => $opac_name,
554 LibraryName => "" . C4::Context->preference("LibraryName"),
555 LibraryNameTitle => "" . $LibraryNameTitle,
556 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
557 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
558 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
559 OPACShelfBrowser => "" . C4::Context->preference("OPACShelfBrowser"),
560 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
561 OPACUserCSS => "" . C4::Context->preference("OPACUserCSS"),
562 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
563 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
564 opac_search_limit => $opac_search_limit,
565 opac_limit_override => $opac_limit_override,
566 OpacBrowser => C4::Context->preference("OpacBrowser"),
567 OpacCloud => C4::Context->preference("OpacCloud"),
568 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
569 OpacNav => "" . C4::Context->preference("OpacNav"),
570 OpacNavBottom => "" . C4::Context->preference("OpacNavBottom"),
571 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
572 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
573 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
574 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
575 OpacTopissue => C4::Context->preference("OpacTopissue"),
576 RequestOnOpac => C4::Context->preference("RequestOnOpac"),
577 'Version' => C4::Context->preference('Version'),
578 hidelostitems => C4::Context->preference("hidelostitems"),
579 mylibraryfirst => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
580 opacbookbag => "" . C4::Context->preference("opacbookbag"),
581 OpacFavicon => C4::Context->preference("OpacFavicon"),
582 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
583 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
584 OPACUserJS => C4::Context->preference("OPACUserJS"),
585 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
586 OpenLibrarySearch => C4::Context->preference("OpenLibrarySearch"),
587 ShowReviewer => C4::Context->preference("ShowReviewer"),
588 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
589 suggestion => "" . C4::Context->preference("suggestion"),
590 virtualshelves => "" . C4::Context->preference("virtualshelves"),
591 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
592 OPACXSLTDetailsDisplay => C4::Context->preference("OPACXSLTDetailsDisplay"),
593 OPACXSLTResultsDisplay => C4::Context->preference("OPACXSLTResultsDisplay"),
594 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
595 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
596 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
597 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
598 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
599 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
600 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
601 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
602 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
603 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
604 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
605 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
606 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
607 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
608 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
609 useDischarge => C4::Context->preference('useDischarge'),
612 $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
615 # Check if we were asked using parameters to force a specific language
616 if ( defined $in->{'query'}->param('language') ) {
618 # Extract the language, let C4::Languages::getlanguage choose
620 my $language = C4::Languages::getlanguage( $in->{'query'} );
621 my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
622 if ( ref $cookie eq 'ARRAY' ) {
623 push @{$cookie}, $languagecookie;
625 $cookie = [ $cookie, $languagecookie ];
629 return ( $template, $borrowernumber, $cookie, $flags );
634 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
636 Verifies that the user is authorized to run this script. If
637 the user is authorized, a (userid, cookie, session-id, flags)
638 quadruple is returned. If the user is not authorized but does
639 not have the required privilege (see $flagsrequired below), it
640 displays an error page and exits. Otherwise, it displays the
641 login page and exits.
643 Note that C<&checkauth> will return if and only if the user
644 is authorized, so it should be called early on, before any
645 unfinished operations (e.g., if you've opened a file, then
646 C<&checkauth> won't close it for you).
648 C<$query> is the CGI object for the script calling C<&checkauth>.
650 The C<$noauth> argument is optional. If it is set, then no
651 authorization is required for the script.
653 C<&checkauth> fetches user and session information from C<$query> and
654 ensures that the user is authorized to run scripts that require
657 The C<$flagsrequired> argument specifies the required privileges
658 the user must have if the username and password are correct.
659 It should be specified as a reference-to-hash; keys in the hash
660 should be the "flags" for the user, as specified in the Members
661 intranet module. Any key specified must correspond to a "flag"
662 in the userflags table. E.g., { circulate => 1 } would specify
663 that the user must have the "circulate" privilege in order to
664 proceed. To make sure that access control is correct, the
665 C<$flagsrequired> parameter must be specified correctly.
667 Koha also has a concept of sub-permissions, also known as
668 granular permissions. This makes the value of each key
669 in the C<flagsrequired> hash take on an additional
674 The user must have access to all subfunctions of the module
675 specified by the hash key.
679 The user must have access to at least one subfunction of the module
680 specified by the hash key.
682 specific permission, e.g., 'export_catalog'
684 The user must have access to the specific subfunction list, which
685 must correspond to a row in the permissions table.
687 The C<$type> argument specifies whether the template should be
688 retrieved from the opac or intranet directory tree. "opac" is
689 assumed if it is not specified; however, if C<$type> is specified,
690 "intranet" is assumed if it is not "opac".
692 If C<$query> does not have a valid session ID associated with it
693 (i.e., the user has not logged in) or if the session has expired,
694 C<&checkauth> presents the user with a login page (from the point of
695 view of the original script, C<&checkauth> does not return). Once the
696 user has authenticated, C<&checkauth> restarts the original script
697 (this time, C<&checkauth> returns).
699 The login page is provided using a HTML::Template, which is set in the
700 systempreferences table or at the top of this file. The variable C<$type>
701 selects which template to use, either the opac or the intranet
702 authentification template.
704 C<&checkauth> returns a user ID, a cookie, and a session ID. The
705 cookie should be sent back to the browser; it verifies that the user
715 # If version syspref is unavailable, it means Koha is being installed,
716 # and so we must redirect to OPAC maintenance page or to the WebInstaller
717 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
718 if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
719 warn "OPAC Install required, redirecting to maintenance";
720 print $query->redirect("/cgi-bin/koha/maintenance.pl");
723 unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
724 if ( $type ne 'opac' ) {
725 warn "Install required, redirecting to Installer";
726 print $query->redirect("/cgi-bin/koha/installer/install.pl");
728 warn "OPAC Install required, redirecting to maintenance";
729 print $query->redirect("/cgi-bin/koha/maintenance.pl");
734 # check that database and koha version are the same
735 # there is no DB version, it's a fresh install,
736 # go to web installer
737 # there is a DB version, compare it to the code version
738 my $kohaversion = Koha::version();
740 # remove the 3 last . to have a Perl number
741 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
742 $debug and print STDERR "kohaversion : $kohaversion\n";
743 if ( $version < $kohaversion ) {
744 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
745 if ( $type ne 'opac' ) {
746 warn sprintf( $warning, 'Installer' );
747 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
749 warn sprintf( "OPAC: " . $warning, 'maintenance' );
750 print $query->redirect("/cgi-bin/koha/maintenance.pl");
758 open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
759 printf $fh join( "\n", @_ );
763 sub _timeout_syspref {
764 my $timeout = C4::Context->preference('timeout') || 600;
766 # value in days, convert in seconds
767 if ( $timeout =~ /(\d+)[dD]/ ) {
768 $timeout = $1 * 86400;
775 $debug and warn "Checking Auth";
777 # Get shibboleth login attribute
778 my $shib = C4::Context->config('useshibboleth') && shib_ok();
779 my $shib_login = $shib ? get_login_shib() : undef;
781 # $authnotrequired will be set for scripts which will run without authentication
782 my $authnotrequired = shift;
783 my $flagsrequired = shift;
785 my $emailaddress = shift;
786 my $template_name = shift;
787 $type = 'opac' unless $type;
789 unless ( C4::Context->preference("OpacPublic") ) {
790 my @allowed_scripts_for_private_opac = qw(
792 opac-registration-email-sent.tt
793 opac-registration-confirmation.tt
794 opac-memberentry-update-submitted.tt
795 opac-password-recovery.tt
797 $authnotrequired = 0 unless grep { $_ eq $template_name }
798 @allowed_scripts_for_private_opac;
801 my $dbh = C4::Context->dbh;
802 my $timeout = _timeout_syspref();
804 _version_check( $type, $query );
809 my ( $userid, $cookie, $sessionID, $flags );
810 my $logout = $query->param('logout.x');
812 my $anon_search_history;
814 # This parameter is the name of the CAS server we want to authenticate against,
815 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
816 my $casparam = $query->param('cas');
817 my $q_userid = $query->param('userid') // '';
821 # Basic authentication is incompatible with the use of Shibboleth,
822 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
823 # and it may not be the attribute we want to use to match the koha login.
825 # Also, do not consider an empty REMOTE_USER.
827 # Finally, after those tests, we can assume (although if it would be better with
828 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
829 # and we can affect it to $userid.
830 if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
832 # Using Basic Authentication, no cookies required
833 $cookie = $query->cookie(
834 -name => 'CGISESSID',
838 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
842 elsif ( $emailaddress) {
843 # the Google OpenID Connect passes an email address
845 elsif ( $sessionID = $query->cookie("CGISESSID") )
846 { # assignment, not comparison
847 $session = get_session($sessionID);
848 C4::Context->_new_userenv($sessionID);
849 my ( $ip, $lasttime, $sessiontype );
852 $s_userid = $session->param('id') // '';
853 C4::Context->set_userenv(
854 $session->param('number'), $s_userid,
855 $session->param('cardnumber'), $session->param('firstname'),
856 $session->param('surname'), $session->param('branch'),
857 $session->param('branchname'), $session->param('flags'),
858 $session->param('emailaddress'),
859 $session->param('shibboleth')
861 C4::Context::set_shelves_userenv( 'bar', $session->param('barshelves') );
862 C4::Context::set_shelves_userenv( 'pub', $session->param('pubshelves') );
863 C4::Context::set_shelves_userenv( 'tot', $session->param('totshelves') );
864 $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
865 $ip = $session->param('ip');
866 $lasttime = $session->param('lasttime');
868 $sessiontype = $session->param('sessiontype') || '';
870 if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
871 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
872 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
875 #if a user enters an id ne to the id in the current session, we need to log them in...
876 #first we need to clear the anonymous session...
877 $debug and warn "query id = $q_userid but session id = $s_userid";
878 $anon_search_history = $session->param('search_history');
881 C4::Context->_unset_userenv($sessionID);
887 # voluntary logout the user
888 # check wether the user was using their shibboleth session or a local one
889 my $shibSuccess = C4::Context->userenv->{'shibboleth'};
892 C4::Context->_unset_userenv($sessionID);
894 #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
898 if ($cas and $caslogout) {
899 logout_cas($query, $type);
902 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
903 if ( $shib and $shib_login and $shibSuccess) {
907 elsif ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
910 $info{'timed_out'} = 1;
915 C4::Context->_unset_userenv($sessionID);
917 #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
921 elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
923 # Different ip than originally logged in from
924 $info{'oldip'} = $ip;
925 $info{'newip'} = $ENV{'REMOTE_ADDR'};
926 $info{'different_ip'} = 1;
929 C4::Context->_unset_userenv($sessionID);
931 #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
936 $cookie = $query->cookie(
937 -name => 'CGISESSID',
938 -value => $session->id,
940 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
942 $session->param( 'lasttime', time() );
943 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...
944 $flags = haspermission( $userid, $flagsrequired );
948 $info{'nopermission'} = 1;
953 unless ( $userid || $sessionID ) {
954 #we initiate a session prior to checking for a username to allow for anonymous sessions...
955 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
957 # Save anonymous search history in new session so it can be retrieved
958 # by get_template_and_user to store it in user's search history after
959 # a successful login.
960 if ($anon_search_history) {
961 $session->param( 'search_history', $anon_search_history );
964 $sessionID = $session->id;
965 C4::Context->_new_userenv($sessionID);
966 $cookie = $query->cookie(
967 -name => 'CGISESSID',
968 -value => $session->id,
970 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
972 my $pki_field = C4::Context->preference('AllowPKIAuth');
973 if ( !defined($pki_field) ) {
974 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
977 if ( ( $cas && $query->param('ticket') )
979 || ( $shib && $shib_login )
980 || $pki_field ne 'None'
983 my $password = $query->param('password');
985 my ( $return, $cardnumber );
987 # If shib is enabled and we have a shib login, does the login match a valid koha user
988 if ( $shib && $shib_login ) {
991 # Do not pass password here, else shib will not be checked in checkpw.
992 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $q_userid, undef, $query );
993 $userid = $retuserid;
994 $shibSuccess = $return;
995 $info{'invalidShibLogin'} = 1 unless ($return);
998 # If shib login and match were successful, skip further login methods
999 unless ($shibSuccess) {
1000 if ( $cas && $query->param('ticket') ) {
1002 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1003 checkpw( $dbh, $userid, $password, $query, $type );
1004 $userid = $retuserid;
1005 $info{'invalidCasLogin'} = 1 unless ($return);
1008 elsif ( $emailaddress ) {
1009 my $value = $emailaddress;
1011 # If we're looking up the email, there's a chance that the person
1012 # doesn't have a userid. So if there is none, we pass along the
1013 # borrower number, and the bits of code that need to know the user
1014 # ID will have to be smart enough to handle that.
1015 my $patrons = Koha::Patrons->search({ email => $value });
1016 if ($patrons->count) {
1018 # First the userid, then the borrowernum
1019 my $patron = $patrons->next;
1020 $value = $patron->userid || $patron->borrowernumber;
1024 $return = $value ? 1 : 0;
1029 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1030 || ( $pki_field eq 'emailAddress'
1031 && $ENV{'SSL_CLIENT_S_DN_Email'} )
1035 if ( $pki_field eq 'Common Name' ) {
1036 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1038 elsif ( $pki_field eq 'emailAddress' ) {
1039 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1041 # If we're looking up the email, there's a chance that the person
1042 # doesn't have a userid. So if there is none, we pass along the
1043 # borrower number, and the bits of code that need to know the user
1044 # ID will have to be smart enough to handle that.
1045 my $patrons = Koha::Patrons->search({ email => $value });
1046 if ($patrons->count) {
1048 # First the userid, then the borrowernum
1049 my $patron = $patrons->next;
1050 $value = $patron->userid || $patron->borrowernumber;
1056 $return = $value ? 1 : 0;
1062 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1063 checkpw( $dbh, $q_userid, $password, $query, $type );
1064 $userid = $retuserid if ($retuserid);
1065 $info{'invalid_username_or_password'} = 1 unless ($return);
1069 # $return: 1 = valid user
1072 #_session_log(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
1073 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1077 $info{'nopermission'} = 1;
1078 C4::Context->_unset_userenv($sessionID);
1080 my ( $borrowernumber, $firstname, $surname, $userflags,
1081 $branchcode, $branchname, $emailaddress );
1083 if ( $return == 1 ) {
1085 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1086 branches.branchname as branchname, email
1088 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1090 my $sth = $dbh->prepare("$select where userid=?");
1091 $sth->execute($userid);
1092 unless ( $sth->rows ) {
1093 $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
1094 $sth = $dbh->prepare("$select where cardnumber=?");
1095 $sth->execute($cardnumber);
1097 unless ( $sth->rows ) {
1098 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1099 $sth->execute($userid);
1100 unless ( $sth->rows ) {
1101 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1106 ( $borrowernumber, $firstname, $surname, $userflags,
1107 $branchcode, $branchname, $emailaddress ) = $sth->fetchrow;
1108 $debug and print STDERR "AUTH_3 results: " .
1109 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1111 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1114 # launch a sequence to check if we have a ip for the branch, i
1115 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1117 my $ip = $ENV{'REMOTE_ADDR'};
1119 # if they specify at login, use that
1120 if ( $query->param('branch') ) {
1121 $branchcode = $query->param('branch');
1122 my $library = Koha::Libraries->find($branchcode);
1123 $branchname = $library? $library->branchname: '';
1125 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1126 if ( $type ne 'opac' and C4::Context->boolean_preference('AutoLocation') ) {
1128 # we have to check they are coming from the right ip range
1129 my $domain = $branches->{$branchcode}->{'branchip'};
1130 $domain =~ s|\.\*||g;
1131 if ( $ip !~ /^$domain/ ) {
1133 $cookie = $query->cookie(
1134 -name => 'CGISESSID',
1137 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1139 $info{'wrongip'} = 1;
1143 foreach my $br ( keys %$branches ) {
1145 # now we work with the treatment of ip
1146 my $domain = $branches->{$br}->{'branchip'};
1147 if ( $domain && $ip =~ /^$domain/ ) {
1148 $branchcode = $branches->{$br}->{'branchcode'};
1150 # new op dev : add the branchname to the cookie
1151 $branchname = $branches->{$br}->{'branchname'};
1154 $session->param( 'number', $borrowernumber );
1155 $session->param( 'id', $userid );
1156 $session->param( 'cardnumber', $cardnumber );
1157 $session->param( 'firstname', $firstname );
1158 $session->param( 'surname', $surname );
1159 $session->param( 'branch', $branchcode );
1160 $session->param( 'branchname', $branchname );
1161 $session->param( 'flags', $userflags );
1162 $session->param( 'emailaddress', $emailaddress );
1163 $session->param( 'ip', $session->remote_addr() );
1164 $session->param( 'lasttime', time() );
1165 $session->param( 'interface', $type);
1166 $session->param( 'shibboleth', $shibSuccess );
1167 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1169 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1170 C4::Context->set_userenv(
1171 $session->param('number'), $session->param('id'),
1172 $session->param('cardnumber'), $session->param('firstname'),
1173 $session->param('surname'), $session->param('branch'),
1174 $session->param('branchname'), $session->param('flags'),
1175 $session->param('emailaddress'), $session->param('shibboleth')
1179 # $return: 0 = invalid user
1180 # reset to anonymous session
1182 $debug and warn "Login failed, resetting anonymous session...";
1184 $info{'invalid_username_or_password'} = 1;
1185 C4::Context->_unset_userenv($sessionID);
1187 $session->param( 'lasttime', time() );
1188 $session->param( 'ip', $session->remote_addr() );
1189 $session->param( 'sessiontype', 'anon' );
1190 $session->param( 'interface', $type);
1192 } # END if ( $q_userid
1193 elsif ( $type eq "opac" ) {
1195 # if we are here this is an anonymous session; add public lists to it and a few other items...
1196 # anonymous sessions are created only for the OPAC
1197 $debug and warn "Initiating an anonymous session...";
1199 # setting a couple of other session vars...
1200 $session->param( 'ip', $session->remote_addr() );
1201 $session->param( 'lasttime', time() );
1202 $session->param( 'sessiontype', 'anon' );
1203 $session->param( 'interface', $type);
1205 } # END unless ($userid)
1207 # finished authentification, now respond
1208 if ( $loggedin || $authnotrequired )
1212 $cookie = $query->cookie(
1213 -name => 'CGISESSID',
1216 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1220 # In case, that this request was a login attempt, we want to prevent that users can repost the opac login
1221 # request. We therefore redirect the user to the requested page again without the login parameters.
1222 # See Post/Redirect/Get (PRG) design pattern: https://en.wikipedia.org/wiki/Post/Redirect/Get
1223 if ( $type eq "opac" && $query->param('koha_login_context') && $query->param('koha_login_context') ne 'sco' && $query->param('password') && $query->param('userid') ) {
1224 my $uri = URI->new($query->url(-relative=>1, -query_string=>1));
1225 $uri->query_param_delete('userid');
1226 $uri->query_param_delete('password');
1227 $uri->query_param_delete('koha_login_context');
1228 print $query->redirect(-uri => $uri->as_string, -cookie => $cookie, -status=>'303 See other');
1232 track_login_daily( $userid );
1234 return ( $userid, $cookie, $sessionID, $flags );
1239 # AUTH rejected, show the login/password template, after checking the DB.
1243 # get the inputs from the incoming query
1245 foreach my $name ( param $query) {
1246 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1247 my @value = $query->multi_param($name);
1248 push @inputs, { name => $name, value => $_ } for @value;
1251 my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1253 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1254 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1255 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1257 my $auth_template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1258 my $template = C4::Templates::gettemplate( $auth_template_name, $type, $query );
1262 script_name => get_script_name(),
1263 casAuthentication => C4::Context->preference("casAuthentication"),
1264 shibbolethAuthentication => $shib,
1265 SessionRestrictionByIP => C4::Context->preference("SessionRestrictionByIP"),
1266 suggestion => C4::Context->preference("suggestion"),
1267 virtualshelves => C4::Context->preference("virtualshelves"),
1268 LibraryName => "" . C4::Context->preference("LibraryName"),
1269 LibraryNameTitle => "" . $LibraryNameTitle,
1270 opacuserlogin => C4::Context->preference("opacuserlogin"),
1271 OpacNav => C4::Context->preference("OpacNav"),
1272 OpacNavBottom => C4::Context->preference("OpacNavBottom"),
1273 OpacFavicon => C4::Context->preference("OpacFavicon"),
1274 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1275 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1276 OPACUserJS => C4::Context->preference("OPACUserJS"),
1277 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1278 OpacCloud => C4::Context->preference("OpacCloud"),
1279 OpacTopissue => C4::Context->preference("OpacTopissue"),
1280 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1281 OpacBrowser => C4::Context->preference("OpacBrowser"),
1282 TagsEnabled => C4::Context->preference("TagsEnabled"),
1283 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1284 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1285 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1286 intranetbookbag => C4::Context->preference("intranetbookbag"),
1287 IntranetNav => C4::Context->preference("IntranetNav"),
1288 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1289 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
1290 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1291 IndependentBranches => C4::Context->preference("IndependentBranches"),
1292 AutoLocation => C4::Context->preference("AutoLocation"),
1293 wrongip => $info{'wrongip'},
1294 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1295 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1296 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1297 too_many_login_attempts => ( $patron and $patron->account_locked )
1300 $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1301 $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1302 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1303 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1305 if ( $type eq 'opac' ) {
1306 require Koha::Virtualshelves;
1307 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1313 some_public_shelves => $some_public_shelves,
1319 # Is authentication against multiple CAS servers enabled?
1320 if ( C4::Auth_with_cas::multipleAuth && !$casparam ) {
1321 my $casservers = C4::Auth_with_cas::getMultipleAuth();
1323 foreach my $key ( keys %$casservers ) {
1324 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1327 casServersLoop => \@tmplservers
1331 casServerUrl => login_cas_url($query, undef, $type),
1336 invalidCasLogin => $info{'invalidCasLogin'}
1342 shibbolethAuthentication => $shib,
1343 shibbolethLoginUrl => login_shib_url($query),
1347 if (C4::Context->preference('GoogleOpenIDConnect')) {
1348 if ($query->param("OpenIDConnectFailed")) {
1349 my $reason = $query->param('OpenIDConnectFailed');
1350 $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1355 LibraryName => C4::Context->preference("LibraryName"),
1357 $template->param(%info);
1359 # $cookie = $query->cookie(CGISESSID => $session->id
1361 print $query->header(
1362 { type => 'text/html',
1365 'X-Frame-Options' => 'SAMEORIGIN'
1372 =head2 check_api_auth
1374 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1376 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1377 cookie, determine if the user has the privileges specified by C<$userflags>.
1379 C<check_api_auth> is is meant for authenticating users of web services, and
1380 consequently will always return and will not attempt to redirect the user
1383 If a valid session cookie is already present, check_api_auth will return a status
1384 of "ok", the cookie, and the Koha session ID.
1386 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1387 parameters and create a session cookie and Koha session if the supplied credentials
1390 Possible return values in C<$status> are:
1394 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1396 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1398 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1400 =item "expired -- session cookie has expired; API user should resubmit userid and password
1406 sub check_api_auth {
1409 my $flagsrequired = shift;
1410 my $dbh = C4::Context->dbh;
1411 my $timeout = _timeout_syspref();
1413 unless ( C4::Context->preference('Version') ) {
1415 # database has not been installed yet
1416 return ( "maintenance", undef, undef );
1418 my $kohaversion = Koha::version();
1419 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1420 if ( C4::Context->preference('Version') < $kohaversion ) {
1422 # database in need of version update; assume that
1423 # no API should be called while databsae is in
1425 return ( "maintenance", undef, undef );
1428 # FIXME -- most of what follows is a copy-and-paste
1429 # of code from checkauth. There is an obvious need
1430 # for refactoring to separate the various parts of
1431 # the authentication code, but as of 2007-11-19 this
1432 # is deferred so as to not introduce bugs into the
1433 # regular authentication code for Koha 3.0.
1435 # see if we have a valid session cookie already
1436 # however, if a userid parameter is present (i.e., from
1437 # a form submission, assume that any current cookie
1439 my $sessionID = undef;
1440 unless ( $query->param('userid') ) {
1441 $sessionID = $query->cookie("CGISESSID");
1443 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1444 my $session = get_session($sessionID);
1445 C4::Context->_new_userenv($sessionID);
1447 C4::Context->interface($session->param('interface'));
1448 C4::Context->set_userenv(
1449 $session->param('number'), $session->param('id'),
1450 $session->param('cardnumber'), $session->param('firstname'),
1451 $session->param('surname'), $session->param('branch'),
1452 $session->param('branchname'), $session->param('flags'),
1453 $session->param('emailaddress')
1456 my $ip = $session->param('ip');
1457 my $lasttime = $session->param('lasttime');
1458 my $userid = $session->param('id');
1459 if ( $lasttime < time() - $timeout ) {
1464 C4::Context->_unset_userenv($sessionID);
1467 return ( "expired", undef, undef );
1468 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1470 # IP address changed
1473 C4::Context->_unset_userenv($sessionID);
1476 return ( "expired", undef, undef );
1478 my $cookie = $query->cookie(
1479 -name => 'CGISESSID',
1480 -value => $session->id,
1482 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1484 $session->param( 'lasttime', time() );
1485 my $flags = haspermission( $userid, $flagsrequired );
1487 return ( "ok", $cookie, $sessionID );
1491 C4::Context->_unset_userenv($sessionID);
1494 return ( "failed", undef, undef );
1498 return ( "expired", undef, undef );
1503 my $userid = $query->param('userid');
1504 my $password = $query->param('password');
1505 my ( $return, $cardnumber, $cas_ticket );
1508 if ( $cas && $query->param('PT') ) {
1510 $debug and print STDERR "## check_api_auth - checking CAS\n";
1512 # In case of a CAS authentication, we use the ticket instead of the password
1513 my $PT = $query->param('PT');
1514 ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $dbh, $PT, $query ); # EXTERNAL AUTH
1517 # User / password auth
1518 unless ( $userid and $password ) {
1520 # caller did something wrong, fail the authenticateion
1521 return ( "failed", undef, undef );
1524 ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $dbh, $userid, $password, $query );
1527 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1528 my $session = get_session("");
1529 return ( "failed", undef, undef ) unless $session;
1531 my $sessionID = $session->id;
1532 C4::Context->_new_userenv($sessionID);
1533 my $cookie = $query->cookie(
1534 -name => 'CGISESSID',
1535 -value => $sessionID,
1537 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1539 if ( $return == 1 ) {
1541 $borrowernumber, $firstname, $surname,
1542 $userflags, $branchcode, $branchname,
1547 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1549 $sth->execute($userid);
1551 $borrowernumber, $firstname, $surname,
1552 $userflags, $branchcode, $branchname,
1554 ) = $sth->fetchrow if ( $sth->rows );
1556 unless ( $sth->rows ) {
1557 my $sth = $dbh->prepare(
1558 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1560 $sth->execute($cardnumber);
1562 $borrowernumber, $firstname, $surname,
1563 $userflags, $branchcode, $branchname,
1565 ) = $sth->fetchrow if ( $sth->rows );
1567 unless ( $sth->rows ) {
1568 $sth->execute($userid);
1570 $borrowernumber, $firstname, $surname, $userflags,
1571 $branchcode, $branchname, $emailaddress
1572 ) = $sth->fetchrow if ( $sth->rows );
1576 my $ip = $ENV{'REMOTE_ADDR'};
1578 # if they specify at login, use that
1579 if ( $query->param('branch') ) {
1580 $branchcode = $query->param('branch');
1581 my $library = Koha::Libraries->find($branchcode);
1582 $branchname = $library? $library->branchname: '';
1584 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1585 foreach my $br ( keys %$branches ) {
1587 # now we work with the treatment of ip
1588 my $domain = $branches->{$br}->{'branchip'};
1589 if ( $domain && $ip =~ /^$domain/ ) {
1590 $branchcode = $branches->{$br}->{'branchcode'};
1592 # new op dev : add the branchname to the cookie
1593 $branchname = $branches->{$br}->{'branchname'};
1596 $session->param( 'number', $borrowernumber );
1597 $session->param( 'id', $userid );
1598 $session->param( 'cardnumber', $cardnumber );
1599 $session->param( 'firstname', $firstname );
1600 $session->param( 'surname', $surname );
1601 $session->param( 'branch', $branchcode );
1602 $session->param( 'branchname', $branchname );
1603 $session->param( 'flags', $userflags );
1604 $session->param( 'emailaddress', $emailaddress );
1605 $session->param( 'ip', $session->remote_addr() );
1606 $session->param( 'lasttime', time() );
1607 $session->param( 'interface', 'api' );
1609 $session->param( 'cas_ticket', $cas_ticket);
1610 C4::Context->set_userenv(
1611 $session->param('number'), $session->param('id'),
1612 $session->param('cardnumber'), $session->param('firstname'),
1613 $session->param('surname'), $session->param('branch'),
1614 $session->param('branchname'), $session->param('flags'),
1615 $session->param('emailaddress')
1617 return ( "ok", $cookie, $sessionID );
1619 return ( "failed", undef, undef );
1624 =head2 check_cookie_auth
1626 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1628 Given a CGISESSID cookie set during a previous login to Koha, determine
1629 if the user has the privileges specified by C<$userflags>. C<$userflags>
1630 is passed unaltered into C<haspermission> and as such accepts all options
1631 avaiable to that routine with the one caveat that C<check_api_auth> will
1632 also allow 'undef' to be passed and in such a case the permissions check
1633 will be skipped altogether.
1635 C<check_cookie_auth> is meant for authenticating special services
1636 such as tools/upload-file.pl that are invoked by other pages that
1637 have been authenticated in the usual way.
1639 Possible return values in C<$status> are:
1643 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1645 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1647 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1649 =item "expired -- session cookie has expired; API user should resubmit userid and password
1655 sub check_cookie_auth {
1657 my $flagsrequired = shift;
1660 my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1661 my $dbh = C4::Context->dbh;
1662 my $timeout = _timeout_syspref();
1664 unless ( C4::Context->preference('Version') ) {
1666 # database has not been installed yet
1667 return ( "maintenance", undef );
1669 my $kohaversion = Koha::version();
1670 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1671 if ( C4::Context->preference('Version') < $kohaversion ) {
1673 # database in need of version update; assume that
1674 # no API should be called while databsae is in
1676 return ( "maintenance", undef );
1679 # FIXME -- most of what follows is a copy-and-paste
1680 # of code from checkauth. There is an obvious need
1681 # for refactoring to separate the various parts of
1682 # the authentication code, but as of 2007-11-23 this
1683 # is deferred so as to not introduce bugs into the
1684 # regular authentication code for Koha 3.0.
1686 # see if we have a valid session cookie already
1687 # however, if a userid parameter is present (i.e., from
1688 # a form submission, assume that any current cookie
1690 unless ( defined $cookie and $cookie ) {
1691 return ( "failed", undef );
1693 my $sessionID = $cookie;
1694 my $session = get_session($sessionID);
1695 C4::Context->_new_userenv($sessionID);
1697 C4::Context->interface($session->param('interface'));
1698 C4::Context->set_userenv(
1699 $session->param('number'), $session->param('id'),
1700 $session->param('cardnumber'), $session->param('firstname'),
1701 $session->param('surname'), $session->param('branch'),
1702 $session->param('branchname'), $session->param('flags'),
1703 $session->param('emailaddress')
1706 my $ip = $session->param('ip');
1707 my $lasttime = $session->param('lasttime');
1708 my $userid = $session->param('id');
1709 if ( $lasttime < time() - $timeout ) {
1714 C4::Context->_unset_userenv($sessionID);
1717 return ("expired", undef);
1718 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1720 # IP address changed
1723 C4::Context->_unset_userenv($sessionID);
1726 return ( "expired", undef );
1728 $session->param( 'lasttime', time() );
1729 my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1731 return ( "ok", $sessionID );
1735 C4::Context->_unset_userenv($sessionID);
1738 return ( "failed", undef );
1742 return ( "expired", undef );
1749 my $session = get_session($sessionID);
1751 Given a session ID, retrieve the CGI::Session object used to store
1752 the session's state. The session object can be used to store
1753 data that needs to be accessed by different scripts during a
1756 If the C<$sessionID> parameter is an empty string, a new session
1761 sub _get_session_params {
1762 my $storage_method = C4::Context->preference('SessionStorage');
1763 if ( $storage_method eq 'mysql' ) {
1764 my $dbh = C4::Context->dbh;
1765 return { dsn => "driver:MySQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1767 elsif ( $storage_method eq 'Pg' ) {
1768 my $dbh = C4::Context->dbh;
1769 return { dsn => "driver:PostgreSQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1771 elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1772 my $memcached = Koha::Caches->get_instance()->memcached_cache;
1773 return { dsn => "driver:memcached;serializer:yaml;id:md5", dsn_args => { Memcached => $memcached } };
1776 # catch all defaults to tmp should work on all systems
1777 my $dir = C4::Context::temporary_directory;
1778 my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1779 return { dsn => "driver:File;serializer:yaml;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1784 my $sessionID = shift;
1785 my $params = _get_session_params();
1786 return new CGI::Session( $params->{dsn}, $sessionID, $params->{dsn_args} );
1790 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1791 # (or something similar)
1792 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1793 # not having a userenv defined could cause a crash.
1795 my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1796 $type = 'opac' unless $type;
1798 # Get shibboleth login attribute
1799 my $shib = C4::Context->config('useshibboleth') && shib_ok();
1800 my $shib_login = $shib ? get_login_shib() : undef;
1804 if ( defined $userid ){
1805 $patron = Koha::Patrons->find({ userid => $userid });
1806 $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1808 my $check_internal_as_fallback = 0;
1810 # Note: checkpw_* routines returns:
1813 # -1 if user bind failed (LDAP only)
1815 if ( $patron and $patron->account_locked ) {
1816 # Nothing to check, account is locked
1817 } elsif ($ldap && defined($password)) {
1818 $debug and print STDERR "## checkpw - checking LDAP\n";
1819 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
1820 if ( $retval == 1 ) {
1821 @return = ( $retval, $retcard, $retuserid );
1824 $check_internal_as_fallback = 1 if $retval == 0;
1826 } elsif ( $cas && $query && $query->param('ticket') ) {
1827 $debug and print STDERR "## checkpw - checking CAS\n";
1829 # In case of a CAS authentication, we use the ticket instead of the password
1830 my $ticket = $query->param('ticket');
1831 $query->delete('ticket'); # remove ticket to come back to original URL
1832 my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $dbh, $ticket, $query, $type ); # EXTERNAL AUTH
1834 @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1838 $passwd_ok = $retval;
1841 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1842 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1844 elsif ( $shib && $shib_login && !$password ) {
1846 $debug and print STDERR "## checkpw - checking Shibboleth\n";
1848 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1849 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1850 # shibboleth-authenticated user
1852 # Then, we check if it matches a valid koha user
1854 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
1856 @return = ( $retval, $retcard, $retuserid );
1858 $passwd_ok = $retval;
1861 $check_internal_as_fallback = 1;
1865 if ( $check_internal_as_fallback ) {
1866 @return = checkpw_internal( $dbh, $userid, $password, $no_set_userenv);
1867 $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1872 $patron->update({ login_attempts => 0 });
1873 } elsif( !$patron->account_locked ) {
1874 $patron->update({ login_attempts => $patron->login_attempts + 1 });
1878 # Optionally log success or failure
1879 if( $patron && $passwd_ok && C4::Context->preference('AuthSuccessLog') ) {
1880 logaction( 'AUTH', 'SUCCESS', $patron->id, "Valid password for $userid", $type );
1881 } elsif( !$passwd_ok && C4::Context->preference('AuthFailureLog') ) {
1882 logaction( 'AUTH', 'FAILURE', $patron ? $patron->id : 0, "Wrong password for $userid", $type );
1888 sub checkpw_internal {
1889 my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
1891 $password = Encode::encode( 'UTF-8', $password )
1892 if Encode::is_utf8($password);
1896 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1898 $sth->execute($userid);
1900 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1901 $surname, $branchcode, $branchname, $flags )
1904 if ( checkpw_hash( $password, $stored_hash ) ) {
1906 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1907 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1908 return 1, $cardnumber, $userid;
1913 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1915 $sth->execute($userid);
1917 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1918 $surname, $branchcode, $branchname, $flags )
1921 if ( checkpw_hash( $password, $stored_hash ) ) {
1923 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1924 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1925 return 1, $cardnumber, $userid;
1932 my ( $password, $stored_hash ) = @_;
1934 return if $stored_hash eq '!';
1936 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1938 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1939 $hash = hash_password( $password, $stored_hash );
1941 $hash = md5_base64($password);
1943 return $hash eq $stored_hash;
1948 my $authflags = getuserflags($flags, $userid, [$dbh]);
1950 Translates integer flags into permissions strings hash.
1952 C<$flags> is the integer userflags value ( borrowers.userflags )
1953 C<$userid> is the members.userid, used for building subpermissions
1954 C<$authflags> is a hashref of permissions
1961 my $dbh = @_ ? shift : C4::Context->dbh;
1964 # I don't want to do this, but if someone logs in as the database
1965 # user, it would be preferable not to spam them to death with
1966 # numeric warnings. So, we make $flags numeric.
1967 no warnings 'numeric';
1970 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1973 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1974 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1975 $userflags->{$flag} = 1;
1978 $userflags->{$flag} = 0;
1982 # get subpermissions and merge with top-level permissions
1983 my $user_subperms = get_user_subpermissions($userid);
1984 foreach my $module ( keys %$user_subperms ) {
1985 next if $userflags->{$module} == 1; # user already has permission for everything in this module
1986 $userflags->{$module} = $user_subperms->{$module};
1992 =head2 get_user_subpermissions
1994 $user_perm_hashref = get_user_subpermissions($userid);
1996 Given the userid (note, not the borrowernumber) of a staff user,
1997 return a hashref of hashrefs of the specific subpermissions
1998 accorded to the user. An example return is
2002 export_catalog => 1,
2003 import_patrons => 1,
2007 The top-level hash-key is a module or function code from
2008 userflags.flag, while the second-level key is a code
2011 The results of this function do not give a complete picture
2012 of the functions that a staff user can access; it is also
2013 necessary to check borrowers.flags.
2017 sub get_user_subpermissions {
2020 my $dbh = C4::Context->dbh;
2021 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2022 FROM user_permissions
2023 JOIN permissions USING (module_bit, code)
2024 JOIN userflags ON (module_bit = bit)
2025 JOIN borrowers USING (borrowernumber)
2026 WHERE userid = ?" );
2027 $sth->execute($userid);
2029 my $user_perms = {};
2030 while ( my $perm = $sth->fetchrow_hashref ) {
2031 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2036 =head2 get_all_subpermissions
2038 my $perm_hashref = get_all_subpermissions();
2040 Returns a hashref of hashrefs defining all specific
2041 permissions currently defined. The return value
2042 has the same structure as that of C<get_user_subpermissions>,
2043 except that the innermost hash value is the description
2044 of the subpermission.
2048 sub get_all_subpermissions {
2049 my $dbh = C4::Context->dbh;
2050 my $sth = $dbh->prepare( "SELECT flag, code
2052 JOIN userflags ON (module_bit = bit)" );
2056 while ( my $perm = $sth->fetchrow_hashref ) {
2057 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2062 =head2 haspermission
2064 $flagsrequired = '*'; # Any permission at all
2065 $flagsrequired = 'a_flag'; # a_flag must be satisfied (all subpermissions)
2066 $flagsrequired = [ 'a_flag', 'b_flag' ]; # a_flag OR b_flag must be satisfied
2067 $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 }; # a_flag AND b_flag must be satisfied
2068 $flagsrequired = { 'a_flag' => 'sub_a' }; # sub_a of a_flag must be satisfied
2069 $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2071 $flags = ($userid, $flagsrequired);
2073 C<$userid> the userid of the member
2074 C<$flags> is a query structure similar to that used by SQL::Abstract that
2075 denotes the combination of flags required. It is a required parameter.
2077 The main logic of this method is that things in arrays are OR'ed, and things
2078 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2080 Returns member's flags or 0 if a permission is not met.
2085 my ($required, $flags) = @_;
2087 my $ref = ref($required);
2089 if ($required eq '*') {
2090 return 0 unless ( $flags or ref( $flags ) );
2092 return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2094 } elsif ($ref eq 'HASH') {
2095 foreach my $key (keys %{$required}) {
2096 next if $flags == 1;
2097 my $require = $required->{$key};
2098 my $rflags = $flags->{$key};
2099 return 0 unless _dispatch($require, $rflags);
2101 } elsif ($ref eq 'ARRAY') {
2103 foreach my $require ( @{$required} ) {
2105 ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2106 ? $flags->{$require}
2108 $satisfied++ if _dispatch( $require, $rflags );
2110 return 0 unless $satisfied;
2112 croak "Unexpected structure found: $ref";
2119 my ( $userid, $flagsrequired ) = @_;
2121 #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2122 # unless defined($flagsrequired);
2124 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2125 $sth->execute($userid);
2126 my $row = $sth->fetchrow();
2127 my $flags = getuserflags( $row, $userid );
2129 return $flags unless defined($flagsrequired);
2130 return $flags if $flags->{superlibrarian};
2131 return _dispatch($flagsrequired, $flags);
2133 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2138 $flags = ($iprange);
2140 C<$iprange> A space separated string describing an IP range. Can include single IPs or ranges
2142 Returns 1 if the remote address is in the provided iprange, or 0 otherwise.
2149 my @allowedipranges = $iprange ? split(' ', $iprange) : ();
2150 if (scalar @allowedipranges > 0) {
2152 eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2153 eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || ( $ENV{DEBUG} && warn 'cidrlookup failed for ' . join(' ',@rangelist) );
2155 return $result ? 1 : 0;
2158 sub getborrowernumber {
2160 my $userenv = C4::Context->userenv;
2161 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2162 return $userenv->{number};
2164 my $dbh = C4::Context->dbh;
2165 for my $field ( 'userid', 'cardnumber' ) {
2167 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2168 $sth->execute($userid);
2170 my ($bnumber) = $sth->fetchrow;
2177 =head2 track_login_daily
2179 track_login_daily( $userid );
2181 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2185 sub track_login_daily {
2187 return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2189 my $cache = Koha::Caches->get_instance();
2190 my $cache_key = "track_login_" . $userid;
2191 my $cached = $cache->get_from_cache($cache_key);
2192 my $today = dt_from_string()->ymd;
2193 return if $cached && $cached eq $today;
2195 my $patron = Koha::Patrons->find({ userid => $userid });
2196 return unless $patron;
2197 $patron->track_login;
2198 $cache->set_in_cache( $cache_key, $today );
2201 END { } # module clean-up code here (global destructor)
2211 Crypt::Eksblowfish::Bcrypt(3)