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;
43 use Koha::Patron::Consents;
44 use POSIX qw/strftime/;
45 use List::MoreUtils qw/ any /;
46 use Encode qw( encode is_utf8);
47 use C4::Auth_with_shibboleth;
49 use C4::Log qw/logaction/;
52 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout);
55 sub psgi_env { any { /^psgi\./ } keys %ENV }
58 if (psgi_env) { die 'psgi:exit' }
62 C4::Context->set_remote_address;
66 @EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
67 @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash
68 &get_all_subpermissions &get_user_subpermissions track_login_daily &in_iprange
70 %EXPORT_TAGS = ( EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)] );
71 $ldap = C4::Context->config('useldapserver') || 0;
72 $cas = C4::Context->preference('casAuthentication');
73 $caslogout = C4::Context->preference('casLogout');
74 require C4::Auth_with_cas; # no import
77 require C4::Auth_with_ldap;
78 import C4::Auth_with_ldap qw(checkpw_ldap);
81 import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url logout_if_required);
88 C4::Auth - Authenticates Koha users
98 my ($template, $borrowernumber, $cookie)
99 = get_template_and_user(
101 template_name => "opac-main.tt",
104 authnotrequired => 0,
105 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
109 output_html_with_http_headers $query, $cookie, $template->output;
113 The main function of this module is to provide
114 authentification. However the get_template_and_user function has
115 been provided so that a users login information is passed along
116 automatically. This gets loaded into the template.
120 =head2 get_template_and_user
122 my ($template, $borrowernumber, $cookie)
123 = get_template_and_user(
125 template_name => "opac-main.tt",
128 authnotrequired => 0,
129 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
133 This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
134 to C<&checkauth> (in this module) to perform authentification.
135 See C<&checkauth> for an explanation of these parameters.
137 The C<template_name> is then used to find the correct template for
138 the page. The authenticated users details are loaded onto the
139 template in the logged_in_user variable (which is a Koha::Patron object). Also the
140 C<sessionID> is passed to the template. This can be used in templates
141 if cookies are disabled. It needs to be put as and input to every
144 More information on the C<gettemplate> sub can be found in the
149 sub get_template_and_user {
152 my ( $user, $cookie, $sessionID, $flags );
154 # Get shibboleth login attribute
155 my $shib = C4::Context->config('useshibboleth') && shib_ok();
156 my $shib_login = $shib ? get_login_shib() : undef;
158 C4::Context->interface( $in->{type} );
160 $in->{'authnotrequired'} ||= 0;
162 # the following call includes a bad template check; might croak
163 my $template = C4::Templates::gettemplate(
164 $in->{'template_name'},
169 if ( $in->{'template_name'} !~ m/maintenance/ ) {
170 ( $user, $cookie, $sessionID, $flags ) = checkauth(
172 $in->{'authnotrequired'},
173 $in->{'flagsrequired'},
178 # If we enforce GDPR and the user did not consent, redirect
179 # Exceptions for consent page itself and SCI/SCO system
180 if( $in->{type} eq 'opac' && $user &&
181 $in->{'template_name'} !~ /^(opac-patron-consent|sc[io]\/)/ &&
182 C4::Context->preference('GDPR_Policy') eq 'Enforced' )
184 my $consent = Koha::Patron::Consents->search({
185 borrowernumber => getborrowernumber($user),
186 type => 'GDPR_PROCESSING',
187 given_on => { '!=', undef },
190 print $in->{query}->redirect(-uri => '/cgi-bin/koha/opac-patron-consent.pl', -cookie => $cookie);
195 if ( $in->{type} eq 'opac' && $user ) {
199 # If the user logged in is the SCO user and they try to go out of the SCO module,
200 # log the user out removing the CGISESSID cookie
201 $in->{template_name} !~ m|sco/| && $in->{template_name} !~ m|errors/errorpage.tt|
202 && C4::Context->preference('AutoSelfCheckID')
203 && $user eq C4::Context->preference('AutoSelfCheckID')
209 # If the user logged in is the SCI user and they try to go out of the SCI module,
210 # kick them out unless it is SCO with a valid permission
211 # or they are a superlibrarian
212 $in->{template_name} !~ m|sci/|
213 && haspermission( $user, { self_check => 'self_checkin_module' } )
215 $in->{template_name} =~ m|sco/| && haspermission(
216 $user, { self_check => 'self_checkout_module' }
219 && $flags && $flags->{superlibrarian} != 1
226 $template = C4::Templates::gettemplate( 'opac-auth.tt', 'opac',
228 $cookie = $in->{query}->cookie(
229 -name => 'CGISESSID',
233 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
238 script_name => get_script_name(),
241 print $in->{query}->header(
246 'X-Frame-Options' => 'SAMEORIGIN'
257 # It's possible for $user to be the borrowernumber if they don't have a
258 # userid defined (and are logging in through some other method, such
259 # as SSL certs against an email address)
261 $borrowernumber = getborrowernumber($user) if defined($user);
262 if ( !defined($borrowernumber) && defined($user) ) {
263 $patron = Koha::Patrons->find( $user );
265 $borrowernumber = $user;
267 # A bit of a hack, but I don't know there's a nicer way
269 $user = $patron->firstname . ' ' . $patron->surname;
272 $patron = Koha::Patrons->find( $borrowernumber );
273 # FIXME What to do if $patron does not exist?
277 $template->param( loggedinusername => $user ); # OBSOLETE - Do not reuse this in template, use logged_in_user.userid instead
278 $template->param( loggedinusernumber => $borrowernumber ); # FIXME Should be replaced with logged_in_user.borrowernumber
279 $template->param( logged_in_user => $patron );
280 $template->param( sessionID => $sessionID );
282 if ( $in->{'type'} eq 'opac' ) {
283 require Koha::Virtualshelves;
284 my $some_private_shelves = Koha::Virtualshelves->get_some_shelves(
286 borrowernumber => $borrowernumber,
290 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
296 some_private_shelves => $some_private_shelves,
297 some_public_shelves => $some_public_shelves,
301 my $all_perms = get_all_subpermissions();
303 my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
304 editcatalogue updatecharges tools editauthorities serials reports acquisition clubs problem_reports);
306 # We are going to use the $flags returned by checkauth
307 # to create the template's parameters that will indicate
308 # which menus the user can access.
309 if ( $flags && $flags->{superlibrarian} == 1 ) {
310 $template->param( CAN_user_circulate => 1 );
311 $template->param( CAN_user_catalogue => 1 );
312 $template->param( CAN_user_parameters => 1 );
313 $template->param( CAN_user_borrowers => 1 );
314 $template->param( CAN_user_permissions => 1 );
315 $template->param( CAN_user_reserveforothers => 1 );
316 $template->param( CAN_user_editcatalogue => 1 );
317 $template->param( CAN_user_updatecharges => 1 );
318 $template->param( CAN_user_acquisition => 1 );
319 $template->param( CAN_user_tools => 1 );
320 $template->param( CAN_user_editauthorities => 1 );
321 $template->param( CAN_user_serials => 1 );
322 $template->param( CAN_user_reports => 1 );
323 $template->param( CAN_user_staffaccess => 1 );
324 $template->param( CAN_user_plugins => 1 );
325 $template->param( CAN_user_coursereserves => 1 );
326 $template->param( CAN_user_clubs => 1 );
327 $template->param( CAN_user_ill => 1 );
328 $template->param( CAN_user_stockrotation => 1 );
329 $template->param( CAN_user_problem_reports => 1 );
331 foreach my $module ( keys %$all_perms ) {
332 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
333 $template->param( "CAN_user_${module}_${subperm}" => 1 );
339 foreach my $module ( keys %$all_perms ) {
340 if ( defined($flags->{$module}) && $flags->{$module} == 1 ) {
341 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
342 $template->param( "CAN_user_${module}_${subperm}" => 1 );
344 } elsif ( ref( $flags->{$module} ) ) {
345 foreach my $subperm ( keys %{ $flags->{$module} } ) {
346 $template->param( "CAN_user_${module}_${subperm}" => 1 );
353 foreach my $module ( keys %$flags ) {
354 if ( $flags->{$module} == 1 or ref( $flags->{$module} ) ) {
355 $template->param( "CAN_user_$module" => 1 );
360 # Logged-in opac search history
361 # If the requested template is an opac one and opac search history is enabled
362 if ( $in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory') ) {
363 my $dbh = C4::Context->dbh;
364 my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
365 my $sth = $dbh->prepare($query);
366 $sth->execute($borrowernumber);
368 # If at least one search has already been performed
369 if ( $sth->fetchrow_array > 0 ) {
371 # We show the link in opac
372 $template->param( EnableOpacSearchHistory => 1 );
374 if (C4::Context->preference('LoadSearchHistoryToTheFirstLoggedUser'))
376 # And if there are searches performed when the user was not logged in,
377 # we add them to the logged-in search history
378 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
379 if (@recentSearches) {
380 my $dbh = C4::Context->dbh;
382 INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, type, total, time )
383 VALUES (?, ?, ?, ?, ?, ?, ?)
385 my $sth = $dbh->prepare($query);
386 $sth->execute( $borrowernumber,
387 $in->{query}->cookie("CGISESSID"),
390 $_->{type} || 'biblio',
393 ) foreach @recentSearches;
395 # clear out the search history from the session now that
396 # we've saved it to the database
399 C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } );
401 } elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) {
402 $template->param( EnableSearchHistory => 1 );
405 else { # if this is an anonymous session, setup to display public lists...
407 # If shibboleth is enabled, and we're in an anonymous session, we should allow
408 # the user to attempt login via shibboleth.
410 $template->param( shibbolethAuthentication => $shib,
411 shibbolethLoginUrl => login_shib_url( $in->{'query'} ),
414 # If shibboleth is enabled and we have a shibboleth login attribute,
415 # but we are in an anonymous session, then we clearly have an invalid
416 # shibboleth koha account.
418 $template->param( invalidShibLogin => '1' );
422 $template->param( sessionID => $sessionID );
424 if ( $in->{'type'} eq 'opac' ){
425 require Koha::Virtualshelves;
426 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
432 some_public_shelves => $some_public_shelves,
437 # Anonymous opac search history
438 # If opac search history is enabled and at least one search has already been performed
439 if ( C4::Context->preference('EnableOpacSearchHistory') ) {
440 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
441 if (@recentSearches) {
442 $template->param( EnableOpacSearchHistory => 1 );
446 if ( C4::Context->preference('dateformat') ) {
447 $template->param( dateformat => C4::Context->preference('dateformat') );
450 $template->param(auth_forwarded_hash => scalar $in->{'query'}->param('auth_forwarded_hash'));
452 # these template parameters are set the same regardless of $in->{'type'}
454 my $minPasswordLength = C4::Context->preference('minPasswordLength');
455 $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
457 "BiblioDefaultView" . C4::Context->preference("BiblioDefaultView") => 1,
458 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
459 GoogleJackets => C4::Context->preference("GoogleJackets"),
460 OpenLibraryCovers => C4::Context->preference("OpenLibraryCovers"),
461 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
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 noItemTypeImages => C4::Context->preference("noItemTypeImages"),
473 marcflavour => C4::Context->preference("marcflavour"),
474 OPACBaseURL => C4::Context->preference('OPACBaseURL'),
475 minPasswordLength => $minPasswordLength,
477 if ( $in->{'type'} eq "intranet" ) {
479 AmazonCoverImages => C4::Context->preference("AmazonCoverImages"),
480 AutoLocation => C4::Context->preference("AutoLocation"),
481 "BiblioDefaultView" . C4::Context->preference("IntranetBiblioDefaultView") => 1,
482 PatronAutoComplete => C4::Context->preference("PatronAutoComplete"),
483 FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
484 IndependentBranches => C4::Context->preference("IndependentBranches"),
485 IntranetNav => C4::Context->preference("IntranetNav"),
486 IntranetmainUserblock => C4::Context->preference("IntranetmainUserblock"),
487 LibraryName => C4::Context->preference("LibraryName"),
488 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
489 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
490 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
491 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
492 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
493 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
494 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
495 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
496 intranetbookbag => C4::Context->preference("intranetbookbag"),
497 suggestion => C4::Context->preference("suggestion"),
498 virtualshelves => C4::Context->preference("virtualshelves"),
499 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
500 EasyAnalyticalRecords => C4::Context->preference('EasyAnalyticalRecords'),
501 LocalCoverImages => C4::Context->preference('LocalCoverImages'),
502 OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'),
503 AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'),
504 EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'),
505 UseCourseReserves => C4::Context->preference("UseCourseReserves"),
506 useDischarge => C4::Context->preference('useDischarge'),
507 pending_checkout_notes => scalar Koha::Checkouts->search({ noteseen => 0 }),
511 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
513 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
514 my $LibraryNameTitle = C4::Context->preference("LibraryName");
515 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
516 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
518 # clean up the busc param in the session
519 # if the page is not opac-detail and not the "add to list" page
520 # and not the "edit comments" page
521 if ( C4::Context->preference("OpacBrowseResults")
522 && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
524 unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
525 or $pagename =~ /^addbybiblionumber$/
526 or $pagename =~ /^review$/ ) {
527 my $sessionSearch = get_session( $sessionID || $in->{'query'}->cookie("CGISESSID") );
528 $sessionSearch->clear( ["busc"] ) if ( $sessionSearch->param("busc") );
532 # variables passed from CGI: opac_css_override and opac_search_limits.
533 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
534 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
537 ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:([\w-]+)/ ) ||
538 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:([\w-]+)/ ) ||
539 ( $in->{'query'}->param('multibranchlimit') && $in->{'query'}->param('multibranchlimit') =~ /multibranchlimit-(\w+)/ )
541 $opac_name = $1; # opac_search_limit is a branch, so we use it.
542 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
543 $opac_name = $in->{'query'}->param('multibranchlimit');
544 } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
545 $opac_name = C4::Context->userenv->{'branch'};
548 my @search_groups = Koha::Library::Groups->get_search_groups({ interface => 'opac' });
550 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
551 LibrarySearchGroups => \@search_groups,
552 opac_name => $opac_name,
553 LibraryName => "" . C4::Context->preference("LibraryName"),
554 LibraryNameTitle => "" . $LibraryNameTitle,
555 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
556 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
557 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
558 OPACShelfBrowser => "" . C4::Context->preference("OPACShelfBrowser"),
559 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
560 OPACUserCSS => "" . C4::Context->preference("OPACUserCSS"),
561 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
562 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
563 opac_search_limit => $opac_search_limit,
564 opac_limit_override => $opac_limit_override,
565 OpacBrowser => C4::Context->preference("OpacBrowser"),
566 OpacCloud => C4::Context->preference("OpacCloud"),
567 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
568 OpacNav => "" . C4::Context->preference("OpacNav"),
569 OpacNavBottom => "" . C4::Context->preference("OpacNavBottom"),
570 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
571 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
572 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
573 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
574 OpacTopissue => C4::Context->preference("OpacTopissue"),
575 RequestOnOpac => C4::Context->preference("RequestOnOpac"),
576 'Version' => C4::Context->preference('Version'),
577 hidelostitems => C4::Context->preference("hidelostitems"),
578 mylibraryfirst => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
579 opacbookbag => "" . C4::Context->preference("opacbookbag"),
580 OpacFavicon => C4::Context->preference("OpacFavicon"),
581 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
582 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
583 OPACUserJS => C4::Context->preference("OPACUserJS"),
584 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
585 OpenLibrarySearch => C4::Context->preference("OpenLibrarySearch"),
586 ShowReviewer => C4::Context->preference("ShowReviewer"),
587 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
588 suggestion => "" . C4::Context->preference("suggestion"),
589 virtualshelves => "" . C4::Context->preference("virtualshelves"),
590 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
591 OPACXSLTDetailsDisplay => C4::Context->preference("OPACXSLTDetailsDisplay"),
592 OPACXSLTResultsDisplay => C4::Context->preference("OPACXSLTResultsDisplay"),
593 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
594 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
595 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
596 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
597 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
598 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
599 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
600 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
601 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
602 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
603 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
604 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
605 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
606 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
607 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
608 useDischarge => C4::Context->preference('useDischarge'),
611 $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
614 # Check if we were asked using parameters to force a specific language
615 if ( defined $in->{'query'}->param('language') ) {
617 # Extract the language, let C4::Languages::getlanguage choose
619 my $language = C4::Languages::getlanguage( $in->{'query'} );
620 my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
621 if ( ref $cookie eq 'ARRAY' ) {
622 push @{$cookie}, $languagecookie;
624 $cookie = [ $cookie, $languagecookie ];
628 return ( $template, $borrowernumber, $cookie, $flags );
633 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
635 Verifies that the user is authorized to run this script. If
636 the user is authorized, a (userid, cookie, session-id, flags)
637 quadruple is returned. If the user is not authorized but does
638 not have the required privilege (see $flagsrequired below), it
639 displays an error page and exits. Otherwise, it displays the
640 login page and exits.
642 Note that C<&checkauth> will return if and only if the user
643 is authorized, so it should be called early on, before any
644 unfinished operations (e.g., if you've opened a file, then
645 C<&checkauth> won't close it for you).
647 C<$query> is the CGI object for the script calling C<&checkauth>.
649 The C<$noauth> argument is optional. If it is set, then no
650 authorization is required for the script.
652 C<&checkauth> fetches user and session information from C<$query> and
653 ensures that the user is authorized to run scripts that require
656 The C<$flagsrequired> argument specifies the required privileges
657 the user must have if the username and password are correct.
658 It should be specified as a reference-to-hash; keys in the hash
659 should be the "flags" for the user, as specified in the Members
660 intranet module. Any key specified must correspond to a "flag"
661 in the userflags table. E.g., { circulate => 1 } would specify
662 that the user must have the "circulate" privilege in order to
663 proceed. To make sure that access control is correct, the
664 C<$flagsrequired> parameter must be specified correctly.
666 Koha also has a concept of sub-permissions, also known as
667 granular permissions. This makes the value of each key
668 in the C<flagsrequired> hash take on an additional
673 The user must have access to all subfunctions of the module
674 specified by the hash key.
678 The user must have access to at least one subfunction of the module
679 specified by the hash key.
681 specific permission, e.g., 'export_catalog'
683 The user must have access to the specific subfunction list, which
684 must correspond to a row in the permissions table.
686 The C<$type> argument specifies whether the template should be
687 retrieved from the opac or intranet directory tree. "opac" is
688 assumed if it is not specified; however, if C<$type> is specified,
689 "intranet" is assumed if it is not "opac".
691 If C<$query> does not have a valid session ID associated with it
692 (i.e., the user has not logged in) or if the session has expired,
693 C<&checkauth> presents the user with a login page (from the point of
694 view of the original script, C<&checkauth> does not return). Once the
695 user has authenticated, C<&checkauth> restarts the original script
696 (this time, C<&checkauth> returns).
698 The login page is provided using a HTML::Template, which is set in the
699 systempreferences table or at the top of this file. The variable C<$type>
700 selects which template to use, either the opac or the intranet
701 authentification template.
703 C<&checkauth> returns a user ID, a cookie, and a session ID. The
704 cookie should be sent back to the browser; it verifies that the user
714 # If version syspref is unavailable, it means Koha is being installed,
715 # and so we must redirect to OPAC maintenance page or to the WebInstaller
716 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
717 if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
718 warn "OPAC Install required, redirecting to maintenance";
719 print $query->redirect("/cgi-bin/koha/maintenance.pl");
722 unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
723 if ( $type ne 'opac' ) {
724 warn "Install required, redirecting to Installer";
725 print $query->redirect("/cgi-bin/koha/installer/install.pl");
727 warn "OPAC Install required, redirecting to maintenance";
728 print $query->redirect("/cgi-bin/koha/maintenance.pl");
733 # check that database and koha version are the same
734 # there is no DB version, it's a fresh install,
735 # go to web installer
736 # there is a DB version, compare it to the code version
737 my $kohaversion = Koha::version();
739 # remove the 3 last . to have a Perl number
740 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
741 $debug and print STDERR "kohaversion : $kohaversion\n";
742 if ( $version < $kohaversion ) {
743 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
744 if ( $type ne 'opac' ) {
745 warn sprintf( $warning, 'Installer' );
746 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
748 warn sprintf( "OPAC: " . $warning, 'maintenance' );
749 print $query->redirect("/cgi-bin/koha/maintenance.pl");
757 open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
758 printf $fh join( "\n", @_ );
762 sub _timeout_syspref {
763 my $timeout = C4::Context->preference('timeout') || 600;
765 # value in days, convert in seconds
766 if ( $timeout =~ /(\d+)[dD]/ ) {
767 $timeout = $1 * 86400;
774 $debug and warn "Checking Auth";
776 # Get shibboleth login attribute
777 my $shib = C4::Context->config('useshibboleth') && shib_ok();
778 my $shib_login = $shib ? get_login_shib() : undef;
780 # $authnotrequired will be set for scripts which will run without authentication
781 my $authnotrequired = shift;
782 my $flagsrequired = shift;
784 my $emailaddress = shift;
785 $type = 'opac' unless $type;
787 my $dbh = C4::Context->dbh;
788 my $timeout = _timeout_syspref();
790 _version_check( $type, $query );
795 my ( $userid, $cookie, $sessionID, $flags );
796 my $logout = $query->param('logout.x');
798 my $anon_search_history;
800 # This parameter is the name of the CAS server we want to authenticate against,
801 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
802 my $casparam = $query->param('cas');
803 my $q_userid = $query->param('userid') // '';
807 # Basic authentication is incompatible with the use of Shibboleth,
808 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
809 # and it may not be the attribute we want to use to match the koha login.
811 # Also, do not consider an empty REMOTE_USER.
813 # Finally, after those tests, we can assume (although if it would be better with
814 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
815 # and we can affect it to $userid.
816 if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
818 # Using Basic Authentication, no cookies required
819 $cookie = $query->cookie(
820 -name => 'CGISESSID',
824 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
828 elsif ( $emailaddress) {
829 # the Google OpenID Connect passes an email address
831 elsif ( $sessionID = $query->cookie("CGISESSID") )
832 { # assignment, not comparison
833 $session = get_session($sessionID);
834 C4::Context->_new_userenv($sessionID);
835 my ( $ip, $lasttime, $sessiontype );
838 $s_userid = $session->param('id') // '';
839 C4::Context->set_userenv(
840 $session->param('number'), $s_userid,
841 $session->param('cardnumber'), $session->param('firstname'),
842 $session->param('surname'), $session->param('branch'),
843 $session->param('branchname'), $session->param('flags'),
844 $session->param('emailaddress'), $session->param('shibboleth'),
845 $session->param('desk_id'), $session->param('desk_name')
847 C4::Context::set_shelves_userenv( 'bar', $session->param('barshelves') );
848 C4::Context::set_shelves_userenv( 'pub', $session->param('pubshelves') );
849 C4::Context::set_shelves_userenv( 'tot', $session->param('totshelves') );
850 $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
851 $ip = $session->param('ip');
852 $lasttime = $session->param('lasttime');
854 $sessiontype = $session->param('sessiontype') || '';
856 if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
857 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
858 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
861 #if a user enters an id ne to the id in the current session, we need to log them in...
862 #first we need to clear the anonymous session...
863 $debug and warn "query id = $q_userid but session id = $s_userid";
864 $anon_search_history = $session->param('search_history');
867 C4::Context->_unset_userenv($sessionID);
873 # voluntary logout the user
874 # check wether the user was using their shibboleth session or a local one
875 my $shibSuccess = C4::Context->userenv->{'shibboleth'};
878 C4::Context->_unset_userenv($sessionID);
880 #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
884 if ($cas and $caslogout) {
885 logout_cas($query, $type);
888 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
889 if ( $shib and $shib_login and $shibSuccess) {
893 elsif ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
896 $info{'timed_out'} = 1;
901 C4::Context->_unset_userenv($sessionID);
903 #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
907 elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
909 # Different ip than originally logged in from
910 $info{'oldip'} = $ip;
911 $info{'newip'} = $ENV{'REMOTE_ADDR'};
912 $info{'different_ip'} = 1;
915 C4::Context->_unset_userenv($sessionID);
917 #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
922 $cookie = $query->cookie(
923 -name => 'CGISESSID',
924 -value => $session->id,
926 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
928 $session->param( 'lasttime', time() );
929 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...
930 $flags = haspermission( $userid, $flagsrequired );
934 $info{'nopermission'} = 1;
939 unless ( $userid || $sessionID ) {
940 #we initiate a session prior to checking for a username to allow for anonymous sessions...
941 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
943 # Save anonymous search history in new session so it can be retrieved
944 # by get_template_and_user to store it in user's search history after
945 # a successful login.
946 if ($anon_search_history) {
947 $session->param( 'search_history', $anon_search_history );
950 $sessionID = $session->id;
951 C4::Context->_new_userenv($sessionID);
952 $cookie = $query->cookie(
953 -name => 'CGISESSID',
954 -value => $session->id,
956 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
958 my $pki_field = C4::Context->preference('AllowPKIAuth');
959 if ( !defined($pki_field) ) {
960 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
963 if ( ( $cas && $query->param('ticket') )
965 || ( $shib && $shib_login )
966 || $pki_field ne 'None'
969 my $password = $query->param('password');
971 my ( $return, $cardnumber );
973 # If shib is enabled and we have a shib login, does the login match a valid koha user
974 if ( $shib && $shib_login ) {
977 # Do not pass password here, else shib will not be checked in checkpw.
978 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $q_userid, undef, $query );
979 $userid = $retuserid;
980 $shibSuccess = $return;
981 $info{'invalidShibLogin'} = 1 unless ($return);
984 # If shib login and match were successful, skip further login methods
985 unless ($shibSuccess) {
986 if ( $cas && $query->param('ticket') ) {
988 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
989 checkpw( $dbh, $userid, $password, $query, $type );
990 $userid = $retuserid;
991 $info{'invalidCasLogin'} = 1 unless ($return);
994 elsif ( $emailaddress ) {
995 my $value = $emailaddress;
997 # If we're looking up the email, there's a chance that the person
998 # doesn't have a userid. So if there is none, we pass along the
999 # borrower number, and the bits of code that need to know the user
1000 # ID will have to be smart enough to handle that.
1001 my $patrons = Koha::Patrons->search({ email => $value });
1002 if ($patrons->count) {
1004 # First the userid, then the borrowernum
1005 my $patron = $patrons->next;
1006 $value = $patron->userid || $patron->borrowernumber;
1010 $return = $value ? 1 : 0;
1015 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1016 || ( $pki_field eq 'emailAddress'
1017 && $ENV{'SSL_CLIENT_S_DN_Email'} )
1021 if ( $pki_field eq 'Common Name' ) {
1022 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1024 elsif ( $pki_field eq 'emailAddress' ) {
1025 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1027 # If we're looking up the email, there's a chance that the person
1028 # doesn't have a userid. So if there is none, we pass along the
1029 # borrower number, and the bits of code that need to know the user
1030 # ID will have to be smart enough to handle that.
1031 my $patrons = Koha::Patrons->search({ email => $value });
1032 if ($patrons->count) {
1034 # First the userid, then the borrowernum
1035 my $patron = $patrons->next;
1036 $value = $patron->userid || $patron->borrowernumber;
1042 $return = $value ? 1 : 0;
1048 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1049 checkpw( $dbh, $q_userid, $password, $query, $type );
1050 $userid = $retuserid if ($retuserid);
1051 $info{'invalid_username_or_password'} = 1 unless ($return);
1055 # $return: 1 = valid user
1058 #_session_log(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
1059 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1063 $info{'nopermission'} = 1;
1064 C4::Context->_unset_userenv($sessionID);
1066 my ( $borrowernumber, $firstname, $surname, $userflags,
1067 $branchcode, $branchname, $emailaddress, $desk_id, $desk_name );
1069 if ( $return == 1 ) {
1071 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1072 branches.branchname as branchname, email
1074 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1076 my $sth = $dbh->prepare("$select where userid=?");
1077 $sth->execute($userid);
1078 unless ( $sth->rows ) {
1079 $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
1080 $sth = $dbh->prepare("$select where cardnumber=?");
1081 $sth->execute($cardnumber);
1083 unless ( $sth->rows ) {
1084 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1085 $sth->execute($userid);
1086 unless ( $sth->rows ) {
1087 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1092 ( $borrowernumber, $firstname, $surname, $userflags,
1093 $branchcode, $branchname, $emailaddress ) = $sth->fetchrow;
1094 $debug and print STDERR "AUTH_3 results: " .
1095 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1097 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1100 # launch a sequence to check if we have a ip for the branch, i
1101 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1103 my $ip = $ENV{'REMOTE_ADDR'};
1105 # if they specify at login, use that
1106 if ( $query->param('branch') ) {
1107 $branchcode = $query->param('branch');
1108 my $library = Koha::Libraries->find($branchcode);
1109 $branchname = $library? $library->branchname: '';
1111 if ( $query->param('desk_id') ) {
1112 $desk_id = $query->param('desk_id');
1113 my $desk = Koha::Desks->find($desk_id);
1114 $desk_name = $desk ? $desk->desk_name : '';
1116 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1117 if ( $type ne 'opac' and C4::Context->boolean_preference('AutoLocation') ) {
1119 # we have to check they are coming from the right ip range
1120 my $domain = $branches->{$branchcode}->{'branchip'};
1121 $domain =~ s|\.\*||g;
1122 if ( $ip !~ /^$domain/ ) {
1124 $cookie = $query->cookie(
1125 -name => 'CGISESSID',
1128 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
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 branchname to the cookie
1142 $branchname = $branches->{$br}->{'branchname'};
1145 $session->param( 'number', $borrowernumber );
1146 $session->param( 'id', $userid );
1147 $session->param( 'cardnumber', $cardnumber );
1148 $session->param( 'firstname', $firstname );
1149 $session->param( 'surname', $surname );
1150 $session->param( 'branch', $branchcode );
1151 $session->param( 'branchname', $branchname );
1152 $session->param( 'desk_id', $desk_id);
1153 $session->param( 'desk_name', $desk_name);
1154 $session->param( 'flags', $userflags );
1155 $session->param( 'emailaddress', $emailaddress );
1156 $session->param( 'ip', $session->remote_addr() );
1157 $session->param( 'lasttime', time() );
1158 $session->param( 'interface', $type);
1159 $session->param( 'shibboleth', $shibSuccess );
1160 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1162 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1163 C4::Context->set_userenv(
1164 $session->param('number'), $session->param('id'),
1165 $session->param('cardnumber'), $session->param('firstname'),
1166 $session->param('surname'), $session->param('branch'),
1167 $session->param('branchname'), $session->param('flags'),
1168 $session->param('emailaddress'), $session->param('shibboleth'),
1169 $session->param('desk_id'), $session->param('desk_name')
1173 # $return: 0 = invalid user
1174 # reset to anonymous session
1176 $debug and warn "Login failed, resetting anonymous session...";
1178 $info{'invalid_username_or_password'} = 1;
1179 C4::Context->_unset_userenv($sessionID);
1181 $session->param( 'lasttime', time() );
1182 $session->param( 'ip', $session->remote_addr() );
1183 $session->param( 'sessiontype', 'anon' );
1184 $session->param( 'interface', $type);
1186 } # END if ( $q_userid
1187 elsif ( $type eq "opac" ) {
1189 # if we are here this is an anonymous session; add public lists to it and a few other items...
1190 # anonymous sessions are created only for the OPAC
1191 $debug and warn "Initiating an anonymous session...";
1193 # setting a couple of other session vars...
1194 $session->param( 'ip', $session->remote_addr() );
1195 $session->param( 'lasttime', time() );
1196 $session->param( 'sessiontype', 'anon' );
1197 $session->param( 'interface', $type);
1199 } # END unless ($userid)
1201 # finished authentification, now respond
1202 if ( $loggedin || $authnotrequired )
1206 $cookie = $query->cookie(
1207 -name => 'CGISESSID',
1210 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1214 # In case, that this request was a login attempt, we want to prevent that users can repost the opac login
1215 # request. We therefore redirect the user to the requested page again without the login parameters.
1216 # See Post/Redirect/Get (PRG) design pattern: https://en.wikipedia.org/wiki/Post/Redirect/Get
1217 if ( $type eq "opac" && $query->param('koha_login_context') && $query->param('koha_login_context') ne 'sco' && $query->param('password') && $query->param('userid') ) {
1218 my $uri = URI->new($query->url(-relative=>1, -query_string=>1));
1219 $uri->query_param_delete('userid');
1220 $uri->query_param_delete('password');
1221 $uri->query_param_delete('koha_login_context');
1222 print $query->redirect(-uri => $uri->as_string, -cookie => $cookie, -status=>'303 See other');
1226 track_login_daily( $userid );
1228 return ( $userid, $cookie, $sessionID, $flags );
1233 # AUTH rejected, show the login/password template, after checking the DB.
1237 # get the inputs from the incoming query
1239 foreach my $name ( param $query) {
1240 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1241 my @value = $query->multi_param($name);
1242 push @inputs, { name => $name, value => $_ } for @value;
1245 my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1247 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1248 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1249 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1251 my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1252 my $template = C4::Templates::gettemplate( $template_name, $type, $query );
1256 script_name => get_script_name(),
1257 casAuthentication => C4::Context->preference("casAuthentication"),
1258 shibbolethAuthentication => $shib,
1259 SessionRestrictionByIP => C4::Context->preference("SessionRestrictionByIP"),
1260 suggestion => C4::Context->preference("suggestion"),
1261 virtualshelves => C4::Context->preference("virtualshelves"),
1262 LibraryName => "" . C4::Context->preference("LibraryName"),
1263 LibraryNameTitle => "" . $LibraryNameTitle,
1264 opacuserlogin => C4::Context->preference("opacuserlogin"),
1265 OpacNav => C4::Context->preference("OpacNav"),
1266 OpacNavBottom => C4::Context->preference("OpacNavBottom"),
1267 OpacFavicon => C4::Context->preference("OpacFavicon"),
1268 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1269 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1270 OPACUserJS => C4::Context->preference("OPACUserJS"),
1271 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1272 OpacCloud => C4::Context->preference("OpacCloud"),
1273 OpacTopissue => C4::Context->preference("OpacTopissue"),
1274 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1275 OpacBrowser => C4::Context->preference("OpacBrowser"),
1276 TagsEnabled => C4::Context->preference("TagsEnabled"),
1277 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1278 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1279 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1280 intranetbookbag => C4::Context->preference("intranetbookbag"),
1281 IntranetNav => C4::Context->preference("IntranetNav"),
1282 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1283 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
1284 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1285 IndependentBranches => C4::Context->preference("IndependentBranches"),
1286 AutoLocation => C4::Context->preference("AutoLocation"),
1287 wrongip => $info{'wrongip'},
1288 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1289 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1290 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1291 too_many_login_attempts => ( $patron and $patron->account_locked )
1294 $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1295 $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1296 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1297 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1299 if ( $type eq 'opac' ) {
1300 require Koha::Virtualshelves;
1301 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1307 some_public_shelves => $some_public_shelves,
1313 # Is authentication against multiple CAS servers enabled?
1314 if ( C4::Auth_with_cas::multipleAuth && !$casparam ) {
1315 my $casservers = C4::Auth_with_cas::getMultipleAuth();
1317 foreach my $key ( keys %$casservers ) {
1318 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1321 casServersLoop => \@tmplservers
1325 casServerUrl => login_cas_url($query, undef, $type),
1330 invalidCasLogin => $info{'invalidCasLogin'}
1336 shibbolethAuthentication => $shib,
1337 shibbolethLoginUrl => login_shib_url($query),
1341 if (C4::Context->preference('GoogleOpenIDConnect')) {
1342 if ($query->param("OpenIDConnectFailed")) {
1343 my $reason = $query->param('OpenIDConnectFailed');
1344 $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1349 LibraryName => C4::Context->preference("LibraryName"),
1351 $template->param(%info);
1353 # $cookie = $query->cookie(CGISESSID => $session->id
1355 print $query->header(
1356 { type => 'text/html',
1359 'X-Frame-Options' => 'SAMEORIGIN'
1366 =head2 check_api_auth
1368 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1370 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1371 cookie, determine if the user has the privileges specified by C<$userflags>.
1373 C<check_api_auth> is is meant for authenticating users of web services, and
1374 consequently will always return and will not attempt to redirect the user
1377 If a valid session cookie is already present, check_api_auth will return a status
1378 of "ok", the cookie, and the Koha session ID.
1380 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1381 parameters and create a session cookie and Koha session if the supplied credentials
1384 Possible return values in C<$status> are:
1388 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1390 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1392 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1394 =item "expired -- session cookie has expired; API user should resubmit userid and password
1400 sub check_api_auth {
1403 my $flagsrequired = shift;
1404 my $dbh = C4::Context->dbh;
1405 my $timeout = _timeout_syspref();
1407 unless ( C4::Context->preference('Version') ) {
1409 # database has not been installed yet
1410 return ( "maintenance", undef, undef );
1412 my $kohaversion = Koha::version();
1413 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1414 if ( C4::Context->preference('Version') < $kohaversion ) {
1416 # database in need of version update; assume that
1417 # no API should be called while databsae is in
1419 return ( "maintenance", undef, undef );
1422 # FIXME -- most of what follows is a copy-and-paste
1423 # of code from checkauth. There is an obvious need
1424 # for refactoring to separate the various parts of
1425 # the authentication code, but as of 2007-11-19 this
1426 # is deferred so as to not introduce bugs into the
1427 # regular authentication code for Koha 3.0.
1429 # see if we have a valid session cookie already
1430 # however, if a userid parameter is present (i.e., from
1431 # a form submission, assume that any current cookie
1433 my $sessionID = undef;
1434 unless ( $query->param('userid') ) {
1435 $sessionID = $query->cookie("CGISESSID");
1437 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1438 my $session = get_session($sessionID);
1439 C4::Context->_new_userenv($sessionID);
1441 C4::Context->interface($session->param('interface'));
1442 C4::Context->set_userenv(
1443 $session->param('number'), $session->param('id'),
1444 $session->param('cardnumber'), $session->param('firstname'),
1445 $session->param('surname'), $session->param('branch'),
1446 $session->param('branchname'), $session->param('flags'),
1447 $session->param('emailaddress'), $session->param('shibboleth'),
1448 $session->param('desk_id'), $session->param('desk_name')
1451 my $ip = $session->param('ip');
1452 my $lasttime = $session->param('lasttime');
1453 my $userid = $session->param('id');
1454 if ( $lasttime < time() - $timeout ) {
1459 C4::Context->_unset_userenv($sessionID);
1462 return ( "expired", undef, undef );
1463 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1465 # IP address changed
1468 C4::Context->_unset_userenv($sessionID);
1471 return ( "expired", undef, undef );
1473 my $cookie = $query->cookie(
1474 -name => 'CGISESSID',
1475 -value => $session->id,
1477 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1479 $session->param( 'lasttime', time() );
1480 my $flags = haspermission( $userid, $flagsrequired );
1482 return ( "ok", $cookie, $sessionID );
1486 C4::Context->_unset_userenv($sessionID);
1489 return ( "failed", undef, undef );
1493 return ( "expired", undef, undef );
1498 my $userid = $query->param('userid');
1499 my $password = $query->param('password');
1500 my ( $return, $cardnumber, $cas_ticket );
1503 if ( $cas && $query->param('PT') ) {
1505 $debug and print STDERR "## check_api_auth - checking CAS\n";
1507 # In case of a CAS authentication, we use the ticket instead of the password
1508 my $PT = $query->param('PT');
1509 ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $dbh, $PT, $query ); # EXTERNAL AUTH
1512 # User / password auth
1513 unless ( $userid and $password ) {
1515 # caller did something wrong, fail the authenticateion
1516 return ( "failed", undef, undef );
1519 ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $dbh, $userid, $password, $query );
1522 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1523 my $session = get_session("");
1524 return ( "failed", undef, undef ) unless $session;
1526 my $sessionID = $session->id;
1527 C4::Context->_new_userenv($sessionID);
1528 my $cookie = $query->cookie(
1529 -name => 'CGISESSID',
1530 -value => $sessionID,
1532 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1534 if ( $return == 1 ) {
1536 $borrowernumber, $firstname, $surname,
1537 $userflags, $branchcode, $branchname,
1542 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1544 $sth->execute($userid);
1546 $borrowernumber, $firstname, $surname,
1547 $userflags, $branchcode, $branchname,
1549 ) = $sth->fetchrow if ( $sth->rows );
1551 unless ( $sth->rows ) {
1552 my $sth = $dbh->prepare(
1553 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1555 $sth->execute($cardnumber);
1557 $borrowernumber, $firstname, $surname,
1558 $userflags, $branchcode, $branchname,
1560 ) = $sth->fetchrow if ( $sth->rows );
1562 unless ( $sth->rows ) {
1563 $sth->execute($userid);
1565 $borrowernumber, $firstname, $surname, $userflags,
1566 $branchcode, $branchname, $emailaddress
1567 ) = $sth->fetchrow if ( $sth->rows );
1571 my $ip = $ENV{'REMOTE_ADDR'};
1573 # if they specify at login, use that
1574 if ( $query->param('branch') ) {
1575 $branchcode = $query->param('branch');
1576 my $library = Koha::Libraries->find($branchcode);
1577 $branchname = $library? $library->branchname: '';
1579 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1580 foreach my $br ( keys %$branches ) {
1582 # now we work with the treatment of ip
1583 my $domain = $branches->{$br}->{'branchip'};
1584 if ( $domain && $ip =~ /^$domain/ ) {
1585 $branchcode = $branches->{$br}->{'branchcode'};
1587 # new op dev : add the branchname to the cookie
1588 $branchname = $branches->{$br}->{'branchname'};
1591 $session->param( 'number', $borrowernumber );
1592 $session->param( 'id', $userid );
1593 $session->param( 'cardnumber', $cardnumber );
1594 $session->param( 'firstname', $firstname );
1595 $session->param( 'surname', $surname );
1596 $session->param( 'branch', $branchcode );
1597 $session->param( 'branchname', $branchname );
1598 $session->param( 'flags', $userflags );
1599 $session->param( 'emailaddress', $emailaddress );
1600 $session->param( 'ip', $session->remote_addr() );
1601 $session->param( 'lasttime', time() );
1602 $session->param( 'interface', 'api' );
1604 $session->param( 'cas_ticket', $cas_ticket);
1605 C4::Context->set_userenv(
1606 $session->param('number'), $session->param('id'),
1607 $session->param('cardnumber'), $session->param('firstname'),
1608 $session->param('surname'), $session->param('branch'),
1609 $session->param('emailaddress'), $session->param('shibboleth'),
1610 $session->param('desk_id'), $session->param('desk_name')
1612 return ( "ok", $cookie, $sessionID );
1614 return ( "failed", undef, undef );
1619 =head2 check_cookie_auth
1621 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1623 Given a CGISESSID cookie set during a previous login to Koha, determine
1624 if the user has the privileges specified by C<$userflags>. C<$userflags>
1625 is passed unaltered into C<haspermission> and as such accepts all options
1626 avaiable to that routine with the one caveat that C<check_api_auth> will
1627 also allow 'undef' to be passed and in such a case the permissions check
1628 will be skipped altogether.
1630 C<check_cookie_auth> is meant for authenticating special services
1631 such as tools/upload-file.pl that are invoked by other pages that
1632 have been authenticated in the usual way.
1634 Possible return values in C<$status> are:
1638 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1640 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1642 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1644 =item "expired -- session cookie has expired; API user should resubmit userid and password
1650 sub check_cookie_auth {
1652 my $flagsrequired = shift;
1655 my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1656 my $dbh = C4::Context->dbh;
1657 my $timeout = _timeout_syspref();
1659 unless ( C4::Context->preference('Version') ) {
1661 # database has not been installed yet
1662 return ( "maintenance", undef );
1664 my $kohaversion = Koha::version();
1665 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1666 if ( C4::Context->preference('Version') < $kohaversion ) {
1668 # database in need of version update; assume that
1669 # no API should be called while databsae is in
1671 return ( "maintenance", undef );
1674 # FIXME -- most of what follows is a copy-and-paste
1675 # of code from checkauth. There is an obvious need
1676 # for refactoring to separate the various parts of
1677 # the authentication code, but as of 2007-11-23 this
1678 # is deferred so as to not introduce bugs into the
1679 # regular authentication code for Koha 3.0.
1681 # see if we have a valid session cookie already
1682 # however, if a userid parameter is present (i.e., from
1683 # a form submission, assume that any current cookie
1685 unless ( defined $cookie and $cookie ) {
1686 return ( "failed", undef );
1688 my $sessionID = $cookie;
1689 my $session = get_session($sessionID);
1690 C4::Context->_new_userenv($sessionID);
1692 C4::Context->interface($session->param('interface'));
1693 C4::Context->set_userenv(
1694 $session->param('number'), $session->param('id'),
1695 $session->param('cardnumber'), $session->param('firstname'),
1696 $session->param('surname'), $session->param('branch'),
1697 $session->param('branchname'), $session->param('flags'),
1698 $session->param('emailaddress'), $session->param('shibboleth'),
1699 $session->param('desk_id'), $session->param('desk_name')
1702 my $ip = $session->param('ip');
1703 my $lasttime = $session->param('lasttime');
1704 my $userid = $session->param('id');
1705 if ( $lasttime < time() - $timeout ) {
1710 C4::Context->_unset_userenv($sessionID);
1713 return ("expired", undef);
1714 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1716 # IP address changed
1719 C4::Context->_unset_userenv($sessionID);
1722 return ( "expired", undef );
1724 $session->param( 'lasttime', time() );
1725 my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1727 return ( "ok", $sessionID );
1731 C4::Context->_unset_userenv($sessionID);
1734 return ( "failed", undef );
1738 return ( "expired", undef );
1745 my $session = get_session($sessionID);
1747 Given a session ID, retrieve the CGI::Session object used to store
1748 the session's state. The session object can be used to store
1749 data that needs to be accessed by different scripts during a
1752 If the C<$sessionID> parameter is an empty string, a new session
1757 sub _get_session_params {
1758 my $storage_method = C4::Context->preference('SessionStorage');
1759 if ( $storage_method eq 'mysql' ) {
1760 my $dbh = C4::Context->dbh;
1761 return { dsn => "driver:MySQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1763 elsif ( $storage_method eq 'Pg' ) {
1764 my $dbh = C4::Context->dbh;
1765 return { dsn => "driver:PostgreSQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1767 elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1768 my $memcached = Koha::Caches->get_instance()->memcached_cache;
1769 return { dsn => "driver:memcached;serializer:yaml;id:md5", dsn_args => { Memcached => $memcached } };
1772 # catch all defaults to tmp should work on all systems
1773 my $dir = C4::Context::temporary_directory;
1774 my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1775 return { dsn => "driver:File;serializer:yaml;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1780 my $sessionID = shift;
1781 my $params = _get_session_params();
1782 return new CGI::Session( $params->{dsn}, $sessionID, $params->{dsn_args} );
1786 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1787 # (or something similar)
1788 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1789 # not having a userenv defined could cause a crash.
1791 my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1792 $type = 'opac' unless $type;
1794 # Get shibboleth login attribute
1795 my $shib = C4::Context->config('useshibboleth') && shib_ok();
1796 my $shib_login = $shib ? get_login_shib() : undef;
1800 if ( defined $userid ){
1801 $patron = Koha::Patrons->find({ userid => $userid });
1802 $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1804 my $check_internal_as_fallback = 0;
1806 # Note: checkpw_* routines returns:
1809 # -1 if user bind failed (LDAP only)
1811 if ( $patron and $patron->account_locked ) {
1812 # Nothing to check, account is locked
1813 } elsif ($ldap && defined($password)) {
1814 $debug and print STDERR "## checkpw - checking LDAP\n";
1815 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
1816 if ( $retval == 1 ) {
1817 @return = ( $retval, $retcard, $retuserid );
1820 $check_internal_as_fallback = 1 if $retval == 0;
1822 } elsif ( $cas && $query && $query->param('ticket') ) {
1823 $debug and print STDERR "## checkpw - checking CAS\n";
1825 # In case of a CAS authentication, we use the ticket instead of the password
1826 my $ticket = $query->param('ticket');
1827 $query->delete('ticket'); # remove ticket to come back to original URL
1828 my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $dbh, $ticket, $query, $type ); # EXTERNAL AUTH
1830 @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1834 $passwd_ok = $retval;
1837 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1838 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1840 elsif ( $shib && $shib_login && !$password ) {
1842 $debug and print STDERR "## checkpw - checking Shibboleth\n";
1844 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1845 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1846 # shibboleth-authenticated user
1848 # Then, we check if it matches a valid koha user
1850 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
1852 @return = ( $retval, $retcard, $retuserid );
1854 $passwd_ok = $retval;
1857 $check_internal_as_fallback = 1;
1861 if ( $check_internal_as_fallback ) {
1862 @return = checkpw_internal( $dbh, $userid, $password, $no_set_userenv);
1863 $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1868 $patron->update({ login_attempts => 0 });
1869 } elsif( !$patron->account_locked ) {
1870 $patron->update({ login_attempts => $patron->login_attempts + 1 });
1874 # Optionally log success or failure
1875 if( $patron && $passwd_ok && C4::Context->preference('AuthSuccessLog') ) {
1876 logaction( 'AUTH', 'SUCCESS', $patron->id, "Valid password for $userid", $type );
1877 } elsif( !$passwd_ok && C4::Context->preference('AuthFailureLog') ) {
1878 logaction( 'AUTH', 'FAILURE', $patron ? $patron->id : 0, "Wrong password for $userid", $type );
1884 sub checkpw_internal {
1885 my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
1887 $password = Encode::encode( 'UTF-8', $password )
1888 if Encode::is_utf8($password);
1892 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1894 $sth->execute($userid);
1896 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1897 $surname, $branchcode, $branchname, $flags )
1900 if ( checkpw_hash( $password, $stored_hash ) ) {
1902 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1903 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1904 return 1, $cardnumber, $userid;
1909 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1911 $sth->execute($userid);
1913 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1914 $surname, $branchcode, $branchname, $flags )
1917 if ( checkpw_hash( $password, $stored_hash ) ) {
1919 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1920 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1921 return 1, $cardnumber, $userid;
1928 my ( $password, $stored_hash ) = @_;
1930 return if $stored_hash eq '!';
1932 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1934 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1935 $hash = hash_password( $password, $stored_hash );
1937 $hash = md5_base64($password);
1939 return $hash eq $stored_hash;
1944 my $authflags = getuserflags($flags, $userid, [$dbh]);
1946 Translates integer flags into permissions strings hash.
1948 C<$flags> is the integer userflags value ( borrowers.userflags )
1949 C<$userid> is the members.userid, used for building subpermissions
1950 C<$authflags> is a hashref of permissions
1957 my $dbh = @_ ? shift : C4::Context->dbh;
1960 # I don't want to do this, but if someone logs in as the database
1961 # user, it would be preferable not to spam them to death with
1962 # numeric warnings. So, we make $flags numeric.
1963 no warnings 'numeric';
1966 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1969 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1970 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1971 $userflags->{$flag} = 1;
1974 $userflags->{$flag} = 0;
1978 # get subpermissions and merge with top-level permissions
1979 my $user_subperms = get_user_subpermissions($userid);
1980 foreach my $module ( keys %$user_subperms ) {
1981 next if $userflags->{$module} == 1; # user already has permission for everything in this module
1982 $userflags->{$module} = $user_subperms->{$module};
1988 =head2 get_user_subpermissions
1990 $user_perm_hashref = get_user_subpermissions($userid);
1992 Given the userid (note, not the borrowernumber) of a staff user,
1993 return a hashref of hashrefs of the specific subpermissions
1994 accorded to the user. An example return is
1998 export_catalog => 1,
1999 import_patrons => 1,
2003 The top-level hash-key is a module or function code from
2004 userflags.flag, while the second-level key is a code
2007 The results of this function do not give a complete picture
2008 of the functions that a staff user can access; it is also
2009 necessary to check borrowers.flags.
2013 sub get_user_subpermissions {
2016 my $dbh = C4::Context->dbh;
2017 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2018 FROM user_permissions
2019 JOIN permissions USING (module_bit, code)
2020 JOIN userflags ON (module_bit = bit)
2021 JOIN borrowers USING (borrowernumber)
2022 WHERE userid = ?" );
2023 $sth->execute($userid);
2025 my $user_perms = {};
2026 while ( my $perm = $sth->fetchrow_hashref ) {
2027 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2032 =head2 get_all_subpermissions
2034 my $perm_hashref = get_all_subpermissions();
2036 Returns a hashref of hashrefs defining all specific
2037 permissions currently defined. The return value
2038 has the same structure as that of C<get_user_subpermissions>,
2039 except that the innermost hash value is the description
2040 of the subpermission.
2044 sub get_all_subpermissions {
2045 my $dbh = C4::Context->dbh;
2046 my $sth = $dbh->prepare( "SELECT flag, code
2048 JOIN userflags ON (module_bit = bit)" );
2052 while ( my $perm = $sth->fetchrow_hashref ) {
2053 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2058 =head2 haspermission
2060 $flagsrequired = '*'; # Any permission at all
2061 $flagsrequired = 'a_flag'; # a_flag must be satisfied (all subpermissions)
2062 $flagsrequired = [ 'a_flag', 'b_flag' ]; # a_flag OR b_flag must be satisfied
2063 $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 }; # a_flag AND b_flag must be satisfied
2064 $flagsrequired = { 'a_flag' => 'sub_a' }; # sub_a of a_flag must be satisfied
2065 $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2067 $flags = ($userid, $flagsrequired);
2069 C<$userid> the userid of the member
2070 C<$flags> is a query structure similar to that used by SQL::Abstract that
2071 denotes the combination of flags required. It is a required parameter.
2073 The main logic of this method is that things in arrays are OR'ed, and things
2074 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2076 Returns member's flags or 0 if a permission is not met.
2081 my ($required, $flags) = @_;
2083 my $ref = ref($required);
2085 if ($required eq '*') {
2086 return 0 unless ( $flags or ref( $flags ) );
2088 return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2090 } elsif ($ref eq 'HASH') {
2091 foreach my $key (keys %{$required}) {
2092 next if $flags == 1;
2093 my $require = $required->{$key};
2094 my $rflags = $flags->{$key};
2095 return 0 unless _dispatch($require, $rflags);
2097 } elsif ($ref eq 'ARRAY') {
2099 foreach my $require ( @{$required} ) {
2101 ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2102 ? $flags->{$require}
2104 $satisfied++ if _dispatch( $require, $rflags );
2106 return 0 unless $satisfied;
2108 croak "Unexpected structure found: $ref";
2115 my ( $userid, $flagsrequired ) = @_;
2117 #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2118 # unless defined($flagsrequired);
2120 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2121 $sth->execute($userid);
2122 my $row = $sth->fetchrow();
2123 my $flags = getuserflags( $row, $userid );
2125 return $flags unless defined($flagsrequired);
2126 return $flags if $flags->{superlibrarian};
2127 return _dispatch($flagsrequired, $flags);
2129 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2134 $flags = ($iprange);
2136 C<$iprange> A space separated string describing an IP range. Can include single IPs or ranges
2138 Returns 1 if the remote address is in the provided iprange, or 0 otherwise.
2145 my @allowedipranges = $iprange ? split(' ', $iprange) : ();
2146 if (scalar @allowedipranges > 0) {
2148 eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2149 eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || ( $ENV{DEBUG} && warn 'cidrlookup failed for ' . join(' ',@rangelist) );
2151 return $result ? 1 : 0;
2154 sub getborrowernumber {
2156 my $userenv = C4::Context->userenv;
2157 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2158 return $userenv->{number};
2160 my $dbh = C4::Context->dbh;
2161 for my $field ( 'userid', 'cardnumber' ) {
2163 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2164 $sth->execute($userid);
2166 my ($bnumber) = $sth->fetchrow;
2173 =head2 track_login_daily
2175 track_login_daily( $userid );
2177 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2181 sub track_login_daily {
2183 return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2185 my $cache = Koha::Caches->get_instance();
2186 my $cache_key = "track_login_" . $userid;
2187 my $cached = $cache->get_from_cache($cache_key);
2188 my $today = dt_from_string()->ymd;
2189 return if $cached && $cached eq $today;
2191 my $patron = Koha::Patrons->find({ userid => $userid });
2192 return unless $patron;
2193 $patron->track_login;
2194 $cache->set_in_cache( $cache_key, $today );
2197 END { } # module clean-up code here (global destructor)
2207 Crypt::Eksblowfish::Bcrypt(3)