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 # Set the using_https variable for templates
456 # FIXME Under Plack the CGI->https method always returns 'OFF'
457 my $https = $in->{query}->https();
458 my $using_https = ( defined $https and $https ne 'OFF' ) ? 1 : 0;
460 my $minPasswordLength = C4::Context->preference('minPasswordLength');
461 $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
463 "BiblioDefaultView" . C4::Context->preference("BiblioDefaultView") => 1,
464 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
465 GoogleJackets => C4::Context->preference("GoogleJackets"),
466 OpenLibraryCovers => C4::Context->preference("OpenLibraryCovers"),
467 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
468 LoginFirstname => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
469 LoginSurname => C4::Context->userenv ? C4::Context->userenv->{"surname"} : "Inconnu",
470 emailaddress => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
471 TagsEnabled => C4::Context->preference("TagsEnabled"),
472 hide_marc => C4::Context->preference("hide_marc"),
473 item_level_itypes => C4::Context->preference('item-level_itypes'),
474 patronimages => C4::Context->preference("patronimages"),
475 singleBranchMode => ( Koha::Libraries->search->count == 1 ),
476 XSLTDetailsDisplay => C4::Context->preference("XSLTDetailsDisplay"),
477 XSLTResultsDisplay => C4::Context->preference("XSLTResultsDisplay"),
478 using_https => $using_https,
479 noItemTypeImages => C4::Context->preference("noItemTypeImages"),
480 marcflavour => C4::Context->preference("marcflavour"),
481 OPACBaseURL => C4::Context->preference('OPACBaseURL'),
482 minPasswordLength => $minPasswordLength,
484 if ( $in->{'type'} eq "intranet" ) {
486 AmazonCoverImages => C4::Context->preference("AmazonCoverImages"),
487 AutoLocation => C4::Context->preference("AutoLocation"),
488 "BiblioDefaultView" . C4::Context->preference("IntranetBiblioDefaultView") => 1,
489 PatronAutoComplete => C4::Context->preference("PatronAutoComplete"),
490 FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
491 IndependentBranches => C4::Context->preference("IndependentBranches"),
492 IntranetNav => C4::Context->preference("IntranetNav"),
493 IntranetmainUserblock => C4::Context->preference("IntranetmainUserblock"),
494 LibraryName => C4::Context->preference("LibraryName"),
495 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
496 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
497 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
498 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
499 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
500 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
501 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
502 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
503 intranetbookbag => C4::Context->preference("intranetbookbag"),
504 suggestion => C4::Context->preference("suggestion"),
505 virtualshelves => C4::Context->preference("virtualshelves"),
506 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
507 EasyAnalyticalRecords => C4::Context->preference('EasyAnalyticalRecords'),
508 LocalCoverImages => C4::Context->preference('LocalCoverImages'),
509 OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'),
510 AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'),
511 EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'),
512 UseCourseReserves => C4::Context->preference("UseCourseReserves"),
513 useDischarge => C4::Context->preference('useDischarge'),
514 pending_checkout_notes => scalar Koha::Checkouts->search({ noteseen => 0 }),
518 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
520 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
521 my $LibraryNameTitle = C4::Context->preference("LibraryName");
522 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
523 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
525 # clean up the busc param in the session
526 # if the page is not opac-detail and not the "add to list" page
527 # and not the "edit comments" page
528 if ( C4::Context->preference("OpacBrowseResults")
529 && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
531 unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
532 or $pagename =~ /^addbybiblionumber$/
533 or $pagename =~ /^review$/ ) {
534 my $sessionSearch = get_session( $sessionID || $in->{'query'}->cookie("CGISESSID") );
535 $sessionSearch->clear( ["busc"] ) if ( $sessionSearch->param("busc") );
539 # variables passed from CGI: opac_css_override and opac_search_limits.
540 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
541 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
544 ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:([\w-]+)/ ) ||
545 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:([\w-]+)/ ) ||
546 ( $in->{'query'}->param('multibranchlimit') && $in->{'query'}->param('multibranchlimit') =~ /multibranchlimit-(\w+)/ )
548 $opac_name = $1; # opac_search_limit is a branch, so we use it.
549 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
550 $opac_name = $in->{'query'}->param('multibranchlimit');
551 } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
552 $opac_name = C4::Context->userenv->{'branch'};
555 my @search_groups = Koha::Library::Groups->get_search_groups({ interface => 'opac' });
557 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
558 LibrarySearchGroups => \@search_groups,
559 opac_name => $opac_name,
560 LibraryName => "" . C4::Context->preference("LibraryName"),
561 LibraryNameTitle => "" . $LibraryNameTitle,
562 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
563 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
564 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
565 OPACShelfBrowser => "" . C4::Context->preference("OPACShelfBrowser"),
566 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
567 OPACUserCSS => "" . C4::Context->preference("OPACUserCSS"),
568 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
569 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
570 opac_search_limit => $opac_search_limit,
571 opac_limit_override => $opac_limit_override,
572 OpacBrowser => C4::Context->preference("OpacBrowser"),
573 OpacCloud => C4::Context->preference("OpacCloud"),
574 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
575 OpacNav => "" . C4::Context->preference("OpacNav"),
576 OpacNavBottom => "" . C4::Context->preference("OpacNavBottom"),
577 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
578 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
579 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
580 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
581 OpacTopissue => C4::Context->preference("OpacTopissue"),
582 RequestOnOpac => C4::Context->preference("RequestOnOpac"),
583 'Version' => C4::Context->preference('Version'),
584 hidelostitems => C4::Context->preference("hidelostitems"),
585 mylibraryfirst => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
586 opacbookbag => "" . C4::Context->preference("opacbookbag"),
587 OpacFavicon => C4::Context->preference("OpacFavicon"),
588 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
589 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
590 OPACUserJS => C4::Context->preference("OPACUserJS"),
591 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
592 OpenLibrarySearch => C4::Context->preference("OpenLibrarySearch"),
593 ShowReviewer => C4::Context->preference("ShowReviewer"),
594 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
595 suggestion => "" . C4::Context->preference("suggestion"),
596 virtualshelves => "" . C4::Context->preference("virtualshelves"),
597 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
598 OPACXSLTDetailsDisplay => C4::Context->preference("OPACXSLTDetailsDisplay"),
599 OPACXSLTResultsDisplay => C4::Context->preference("OPACXSLTResultsDisplay"),
600 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
601 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
602 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
603 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
604 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
605 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
606 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
607 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
608 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
609 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
610 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
611 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
612 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
613 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
614 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
615 useDischarge => C4::Context->preference('useDischarge'),
618 $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
621 # Check if we were asked using parameters to force a specific language
622 if ( defined $in->{'query'}->param('language') ) {
624 # Extract the language, let C4::Languages::getlanguage choose
626 my $language = C4::Languages::getlanguage( $in->{'query'} );
627 my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
628 if ( ref $cookie eq 'ARRAY' ) {
629 push @{$cookie}, $languagecookie;
631 $cookie = [ $cookie, $languagecookie ];
635 return ( $template, $borrowernumber, $cookie, $flags );
640 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
642 Verifies that the user is authorized to run this script. If
643 the user is authorized, a (userid, cookie, session-id, flags)
644 quadruple is returned. If the user is not authorized but does
645 not have the required privilege (see $flagsrequired below), it
646 displays an error page and exits. Otherwise, it displays the
647 login page and exits.
649 Note that C<&checkauth> will return if and only if the user
650 is authorized, so it should be called early on, before any
651 unfinished operations (e.g., if you've opened a file, then
652 C<&checkauth> won't close it for you).
654 C<$query> is the CGI object for the script calling C<&checkauth>.
656 The C<$noauth> argument is optional. If it is set, then no
657 authorization is required for the script.
659 C<&checkauth> fetches user and session information from C<$query> and
660 ensures that the user is authorized to run scripts that require
663 The C<$flagsrequired> argument specifies the required privileges
664 the user must have if the username and password are correct.
665 It should be specified as a reference-to-hash; keys in the hash
666 should be the "flags" for the user, as specified in the Members
667 intranet module. Any key specified must correspond to a "flag"
668 in the userflags table. E.g., { circulate => 1 } would specify
669 that the user must have the "circulate" privilege in order to
670 proceed. To make sure that access control is correct, the
671 C<$flagsrequired> parameter must be specified correctly.
673 Koha also has a concept of sub-permissions, also known as
674 granular permissions. This makes the value of each key
675 in the C<flagsrequired> hash take on an additional
680 The user must have access to all subfunctions of the module
681 specified by the hash key.
685 The user must have access to at least one subfunction of the module
686 specified by the hash key.
688 specific permission, e.g., 'export_catalog'
690 The user must have access to the specific subfunction list, which
691 must correspond to a row in the permissions table.
693 The C<$type> argument specifies whether the template should be
694 retrieved from the opac or intranet directory tree. "opac" is
695 assumed if it is not specified; however, if C<$type> is specified,
696 "intranet" is assumed if it is not "opac".
698 If C<$query> does not have a valid session ID associated with it
699 (i.e., the user has not logged in) or if the session has expired,
700 C<&checkauth> presents the user with a login page (from the point of
701 view of the original script, C<&checkauth> does not return). Once the
702 user has authenticated, C<&checkauth> restarts the original script
703 (this time, C<&checkauth> returns).
705 The login page is provided using a HTML::Template, which is set in the
706 systempreferences table or at the top of this file. The variable C<$type>
707 selects which template to use, either the opac or the intranet
708 authentification template.
710 C<&checkauth> returns a user ID, a cookie, and a session ID. The
711 cookie should be sent back to the browser; it verifies that the user
721 # If version syspref is unavailable, it means Koha is being installed,
722 # and so we must redirect to OPAC maintenance page or to the WebInstaller
723 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
724 if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
725 warn "OPAC Install required, redirecting to maintenance";
726 print $query->redirect("/cgi-bin/koha/maintenance.pl");
729 unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
730 if ( $type ne 'opac' ) {
731 warn "Install required, redirecting to Installer";
732 print $query->redirect("/cgi-bin/koha/installer/install.pl");
734 warn "OPAC Install required, redirecting to maintenance";
735 print $query->redirect("/cgi-bin/koha/maintenance.pl");
740 # check that database and koha version are the same
741 # there is no DB version, it's a fresh install,
742 # go to web installer
743 # there is a DB version, compare it to the code version
744 my $kohaversion = Koha::version();
746 # remove the 3 last . to have a Perl number
747 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
748 $debug and print STDERR "kohaversion : $kohaversion\n";
749 if ( $version < $kohaversion ) {
750 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
751 if ( $type ne 'opac' ) {
752 warn sprintf( $warning, 'Installer' );
753 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
755 warn sprintf( "OPAC: " . $warning, 'maintenance' );
756 print $query->redirect("/cgi-bin/koha/maintenance.pl");
764 open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
765 printf $fh join( "\n", @_ );
769 sub _timeout_syspref {
770 my $timeout = C4::Context->preference('timeout') || 600;
772 # value in days, convert in seconds
773 if ( $timeout =~ /(\d+)[dD]/ ) {
774 $timeout = $1 * 86400;
781 $debug and warn "Checking Auth";
783 # Get shibboleth login attribute
784 my $shib = C4::Context->config('useshibboleth') && shib_ok();
785 my $shib_login = $shib ? get_login_shib() : undef;
787 # $authnotrequired will be set for scripts which will run without authentication
788 my $authnotrequired = shift;
789 my $flagsrequired = shift;
791 my $emailaddress = shift;
792 my $template_name = shift;
793 $type = 'opac' unless $type;
795 unless ( C4::Context->preference("OpacPublic") ) {
796 my @allowed_scripts_for_private_opac = qw(
798 opac-registration-email-sent.tt
799 opac-registration-confirmation.tt
800 opac-memberentry-update-submitted.tt
801 opac-password-recovery.tt
803 $authnotrequired = 0 unless grep { $_ eq $template_name }
804 @allowed_scripts_for_private_opac;
807 my $dbh = C4::Context->dbh;
808 my $timeout = _timeout_syspref();
810 _version_check( $type, $query );
815 my ( $userid, $cookie, $sessionID, $flags );
816 my $logout = $query->param('logout.x');
818 my $anon_search_history;
820 # This parameter is the name of the CAS server we want to authenticate against,
821 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
822 my $casparam = $query->param('cas');
823 my $q_userid = $query->param('userid') // '';
827 # Basic authentication is incompatible with the use of Shibboleth,
828 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
829 # and it may not be the attribute we want to use to match the koha login.
831 # Also, do not consider an empty REMOTE_USER.
833 # Finally, after those tests, we can assume (although if it would be better with
834 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
835 # and we can affect it to $userid.
836 if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
838 # Using Basic Authentication, no cookies required
839 $cookie = $query->cookie(
840 -name => 'CGISESSID',
844 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
848 elsif ( $emailaddress) {
849 # the Google OpenID Connect passes an email address
851 elsif ( $sessionID = $query->cookie("CGISESSID") )
852 { # assignment, not comparison
853 $session = get_session($sessionID);
854 C4::Context->_new_userenv($sessionID);
855 my ( $ip, $lasttime, $sessiontype );
858 $s_userid = $session->param('id') // '';
859 C4::Context->set_userenv(
860 $session->param('number'), $s_userid,
861 $session->param('cardnumber'), $session->param('firstname'),
862 $session->param('surname'), $session->param('branch'),
863 $session->param('branchname'), $session->param('flags'),
864 $session->param('emailaddress'),
865 $session->param('shibboleth')
867 C4::Context::set_shelves_userenv( 'bar', $session->param('barshelves') );
868 C4::Context::set_shelves_userenv( 'pub', $session->param('pubshelves') );
869 C4::Context::set_shelves_userenv( 'tot', $session->param('totshelves') );
870 $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
871 $ip = $session->param('ip');
872 $lasttime = $session->param('lasttime');
874 $sessiontype = $session->param('sessiontype') || '';
876 if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
877 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
878 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
881 #if a user enters an id ne to the id in the current session, we need to log them in...
882 #first we need to clear the anonymous session...
883 $debug and warn "query id = $q_userid but session id = $s_userid";
884 $anon_search_history = $session->param('search_history');
887 C4::Context->_unset_userenv($sessionID);
893 # voluntary logout the user
894 # check wether the user was using their shibboleth session or a local one
895 my $shibSuccess = C4::Context->userenv->{'shibboleth'};
898 C4::Context->_unset_userenv($sessionID);
900 #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
904 if ($cas and $caslogout) {
905 logout_cas($query, $type);
908 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
909 if ( $shib and $shib_login and $shibSuccess) {
913 elsif ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
916 $info{'timed_out'} = 1;
921 C4::Context->_unset_userenv($sessionID);
923 #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
927 elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
929 # Different ip than originally logged in from
930 $info{'oldip'} = $ip;
931 $info{'newip'} = $ENV{'REMOTE_ADDR'};
932 $info{'different_ip'} = 1;
935 C4::Context->_unset_userenv($sessionID);
937 #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
942 $cookie = $query->cookie(
943 -name => 'CGISESSID',
944 -value => $session->id,
946 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
948 $session->param( 'lasttime', time() );
949 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...
950 $flags = haspermission( $userid, $flagsrequired );
954 $info{'nopermission'} = 1;
959 unless ( $userid || $sessionID ) {
960 #we initiate a session prior to checking for a username to allow for anonymous sessions...
961 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
963 # Save anonymous search history in new session so it can be retrieved
964 # by get_template_and_user to store it in user's search history after
965 # a successful login.
966 if ($anon_search_history) {
967 $session->param( 'search_history', $anon_search_history );
970 $sessionID = $session->id;
971 C4::Context->_new_userenv($sessionID);
972 $cookie = $query->cookie(
973 -name => 'CGISESSID',
974 -value => $session->id,
976 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
978 my $pki_field = C4::Context->preference('AllowPKIAuth');
979 if ( !defined($pki_field) ) {
980 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
983 if ( ( $cas && $query->param('ticket') )
985 || ( $shib && $shib_login )
986 || $pki_field ne 'None'
989 my $password = $query->param('password');
991 my ( $return, $cardnumber );
993 # If shib is enabled and we have a shib login, does the login match a valid koha user
994 if ( $shib && $shib_login ) {
997 # Do not pass password here, else shib will not be checked in checkpw.
998 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $q_userid, undef, $query );
999 $userid = $retuserid;
1000 $shibSuccess = $return;
1001 $info{'invalidShibLogin'} = 1 unless ($return);
1004 # If shib login and match were successful, skip further login methods
1005 unless ($shibSuccess) {
1006 if ( $cas && $query->param('ticket') ) {
1008 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1009 checkpw( $dbh, $userid, $password, $query, $type );
1010 $userid = $retuserid;
1011 $info{'invalidCasLogin'} = 1 unless ($return);
1014 elsif ( $emailaddress ) {
1015 my $value = $emailaddress;
1017 # If we're looking up the email, there's a chance that the person
1018 # doesn't have a userid. So if there is none, we pass along the
1019 # borrower number, and the bits of code that need to know the user
1020 # ID will have to be smart enough to handle that.
1021 my $patrons = Koha::Patrons->search({ email => $value });
1022 if ($patrons->count) {
1024 # First the userid, then the borrowernum
1025 my $patron = $patrons->next;
1026 $value = $patron->userid || $patron->borrowernumber;
1030 $return = $value ? 1 : 0;
1035 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1036 || ( $pki_field eq 'emailAddress'
1037 && $ENV{'SSL_CLIENT_S_DN_Email'} )
1041 if ( $pki_field eq 'Common Name' ) {
1042 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1044 elsif ( $pki_field eq 'emailAddress' ) {
1045 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1047 # If we're looking up the email, there's a chance that the person
1048 # doesn't have a userid. So if there is none, we pass along the
1049 # borrower number, and the bits of code that need to know the user
1050 # ID will have to be smart enough to handle that.
1051 my $patrons = Koha::Patrons->search({ email => $value });
1052 if ($patrons->count) {
1054 # First the userid, then the borrowernum
1055 my $patron = $patrons->next;
1056 $value = $patron->userid || $patron->borrowernumber;
1062 $return = $value ? 1 : 0;
1068 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1069 checkpw( $dbh, $q_userid, $password, $query, $type );
1070 $userid = $retuserid if ($retuserid);
1071 $info{'invalid_username_or_password'} = 1 unless ($return);
1075 # $return: 1 = valid user
1078 #_session_log(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
1079 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1083 $info{'nopermission'} = 1;
1084 C4::Context->_unset_userenv($sessionID);
1086 my ( $borrowernumber, $firstname, $surname, $userflags,
1087 $branchcode, $branchname, $emailaddress );
1089 if ( $return == 1 ) {
1091 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1092 branches.branchname as branchname, email
1094 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1096 my $sth = $dbh->prepare("$select where userid=?");
1097 $sth->execute($userid);
1098 unless ( $sth->rows ) {
1099 $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
1100 $sth = $dbh->prepare("$select where cardnumber=?");
1101 $sth->execute($cardnumber);
1103 unless ( $sth->rows ) {
1104 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1105 $sth->execute($userid);
1106 unless ( $sth->rows ) {
1107 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1112 ( $borrowernumber, $firstname, $surname, $userflags,
1113 $branchcode, $branchname, $emailaddress ) = $sth->fetchrow;
1114 $debug and print STDERR "AUTH_3 results: " .
1115 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1117 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1120 # launch a sequence to check if we have a ip for the branch, i
1121 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1123 my $ip = $ENV{'REMOTE_ADDR'};
1125 # if they specify at login, use that
1126 if ( $query->param('branch') ) {
1127 $branchcode = $query->param('branch');
1128 my $library = Koha::Libraries->find($branchcode);
1129 $branchname = $library? $library->branchname: '';
1131 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1132 if ( $type ne 'opac' and C4::Context->boolean_preference('AutoLocation') ) {
1134 # we have to check they are coming from the right ip range
1135 my $domain = $branches->{$branchcode}->{'branchip'};
1136 $domain =~ s|\.\*||g;
1137 if ( $ip !~ /^$domain/ ) {
1139 $cookie = $query->cookie(
1140 -name => 'CGISESSID',
1143 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1145 $info{'wrongip'} = 1;
1149 foreach my $br ( keys %$branches ) {
1151 # now we work with the treatment of ip
1152 my $domain = $branches->{$br}->{'branchip'};
1153 if ( $domain && $ip =~ /^$domain/ ) {
1154 $branchcode = $branches->{$br}->{'branchcode'};
1156 # new op dev : add the branchname to the cookie
1157 $branchname = $branches->{$br}->{'branchname'};
1160 $session->param( 'number', $borrowernumber );
1161 $session->param( 'id', $userid );
1162 $session->param( 'cardnumber', $cardnumber );
1163 $session->param( 'firstname', $firstname );
1164 $session->param( 'surname', $surname );
1165 $session->param( 'branch', $branchcode );
1166 $session->param( 'branchname', $branchname );
1167 $session->param( 'flags', $userflags );
1168 $session->param( 'emailaddress', $emailaddress );
1169 $session->param( 'ip', $session->remote_addr() );
1170 $session->param( 'lasttime', time() );
1171 $session->param( 'interface', $type);
1172 $session->param( 'shibboleth', $shibSuccess );
1173 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1175 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1176 C4::Context->set_userenv(
1177 $session->param('number'), $session->param('id'),
1178 $session->param('cardnumber'), $session->param('firstname'),
1179 $session->param('surname'), $session->param('branch'),
1180 $session->param('branchname'), $session->param('flags'),
1181 $session->param('emailaddress'), $session->param('shibboleth')
1185 # $return: 0 = invalid user
1186 # reset to anonymous session
1188 $debug and warn "Login failed, resetting anonymous session...";
1190 $info{'invalid_username_or_password'} = 1;
1191 C4::Context->_unset_userenv($sessionID);
1193 $session->param( 'lasttime', time() );
1194 $session->param( 'ip', $session->remote_addr() );
1195 $session->param( 'sessiontype', 'anon' );
1196 $session->param( 'interface', $type);
1198 } # END if ( $q_userid
1199 elsif ( $type eq "opac" ) {
1201 # if we are here this is an anonymous session; add public lists to it and a few other items...
1202 # anonymous sessions are created only for the OPAC
1203 $debug and warn "Initiating an anonymous session...";
1205 # setting a couple of other session vars...
1206 $session->param( 'ip', $session->remote_addr() );
1207 $session->param( 'lasttime', time() );
1208 $session->param( 'sessiontype', 'anon' );
1209 $session->param( 'interface', $type);
1211 } # END unless ($userid)
1213 # finished authentification, now respond
1214 if ( $loggedin || $authnotrequired )
1218 $cookie = $query->cookie(
1219 -name => 'CGISESSID',
1222 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1226 # In case, that this request was a login attempt, we want to prevent that users can repost the opac login
1227 # request. We therefore redirect the user to the requested page again without the login parameters.
1228 # See Post/Redirect/Get (PRG) design pattern: https://en.wikipedia.org/wiki/Post/Redirect/Get
1229 if ( $type eq "opac" && $query->param('koha_login_context') && $query->param('koha_login_context') ne 'sco' && $query->param('password') && $query->param('userid') ) {
1230 my $uri = URI->new($query->url(-relative=>1, -query_string=>1));
1231 $uri->query_param_delete('userid');
1232 $uri->query_param_delete('password');
1233 $uri->query_param_delete('koha_login_context');
1234 print $query->redirect(-uri => $uri->as_string, -cookie => $cookie, -status=>'303 See other');
1238 track_login_daily( $userid );
1240 return ( $userid, $cookie, $sessionID, $flags );
1245 # AUTH rejected, show the login/password template, after checking the DB.
1249 # get the inputs from the incoming query
1251 foreach my $name ( param $query) {
1252 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1253 my @value = $query->multi_param($name);
1254 push @inputs, { name => $name, value => $_ } for @value;
1257 my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1259 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1260 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1261 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1263 my $auth_template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1264 my $template = C4::Templates::gettemplate( $auth_template_name, $type, $query );
1268 script_name => get_script_name(),
1269 casAuthentication => C4::Context->preference("casAuthentication"),
1270 shibbolethAuthentication => $shib,
1271 SessionRestrictionByIP => C4::Context->preference("SessionRestrictionByIP"),
1272 suggestion => C4::Context->preference("suggestion"),
1273 virtualshelves => C4::Context->preference("virtualshelves"),
1274 LibraryName => "" . C4::Context->preference("LibraryName"),
1275 LibraryNameTitle => "" . $LibraryNameTitle,
1276 opacuserlogin => C4::Context->preference("opacuserlogin"),
1277 OpacNav => C4::Context->preference("OpacNav"),
1278 OpacNavBottom => C4::Context->preference("OpacNavBottom"),
1279 OpacFavicon => C4::Context->preference("OpacFavicon"),
1280 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1281 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1282 OPACUserJS => C4::Context->preference("OPACUserJS"),
1283 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1284 OpacCloud => C4::Context->preference("OpacCloud"),
1285 OpacTopissue => C4::Context->preference("OpacTopissue"),
1286 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1287 OpacBrowser => C4::Context->preference("OpacBrowser"),
1288 TagsEnabled => C4::Context->preference("TagsEnabled"),
1289 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1290 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1291 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1292 intranetbookbag => C4::Context->preference("intranetbookbag"),
1293 IntranetNav => C4::Context->preference("IntranetNav"),
1294 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1295 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
1296 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1297 IndependentBranches => C4::Context->preference("IndependentBranches"),
1298 AutoLocation => C4::Context->preference("AutoLocation"),
1299 wrongip => $info{'wrongip'},
1300 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1301 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1302 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1303 too_many_login_attempts => ( $patron and $patron->account_locked )
1306 $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1307 $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1308 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1309 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1311 if ( $type eq 'opac' ) {
1312 require Koha::Virtualshelves;
1313 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1319 some_public_shelves => $some_public_shelves,
1325 # Is authentication against multiple CAS servers enabled?
1326 if ( C4::Auth_with_cas::multipleAuth && !$casparam ) {
1327 my $casservers = C4::Auth_with_cas::getMultipleAuth();
1329 foreach my $key ( keys %$casservers ) {
1330 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1333 casServersLoop => \@tmplservers
1337 casServerUrl => login_cas_url($query, undef, $type),
1342 invalidCasLogin => $info{'invalidCasLogin'}
1348 shibbolethAuthentication => $shib,
1349 shibbolethLoginUrl => login_shib_url($query),
1353 if (C4::Context->preference('GoogleOpenIDConnect')) {
1354 if ($query->param("OpenIDConnectFailed")) {
1355 my $reason = $query->param('OpenIDConnectFailed');
1356 $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1361 LibraryName => C4::Context->preference("LibraryName"),
1363 $template->param(%info);
1365 # $cookie = $query->cookie(CGISESSID => $session->id
1367 print $query->header(
1368 { type => 'text/html',
1371 'X-Frame-Options' => 'SAMEORIGIN'
1378 =head2 check_api_auth
1380 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1382 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1383 cookie, determine if the user has the privileges specified by C<$userflags>.
1385 C<check_api_auth> is is meant for authenticating users of web services, and
1386 consequently will always return and will not attempt to redirect the user
1389 If a valid session cookie is already present, check_api_auth will return a status
1390 of "ok", the cookie, and the Koha session ID.
1392 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1393 parameters and create a session cookie and Koha session if the supplied credentials
1396 Possible return values in C<$status> are:
1400 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1402 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1404 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1406 =item "expired -- session cookie has expired; API user should resubmit userid and password
1412 sub check_api_auth {
1415 my $flagsrequired = shift;
1416 my $dbh = C4::Context->dbh;
1417 my $timeout = _timeout_syspref();
1419 unless ( C4::Context->preference('Version') ) {
1421 # database has not been installed yet
1422 return ( "maintenance", undef, undef );
1424 my $kohaversion = Koha::version();
1425 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1426 if ( C4::Context->preference('Version') < $kohaversion ) {
1428 # database in need of version update; assume that
1429 # no API should be called while databsae is in
1431 return ( "maintenance", undef, undef );
1434 # FIXME -- most of what follows is a copy-and-paste
1435 # of code from checkauth. There is an obvious need
1436 # for refactoring to separate the various parts of
1437 # the authentication code, but as of 2007-11-19 this
1438 # is deferred so as to not introduce bugs into the
1439 # regular authentication code for Koha 3.0.
1441 # see if we have a valid session cookie already
1442 # however, if a userid parameter is present (i.e., from
1443 # a form submission, assume that any current cookie
1445 my $sessionID = undef;
1446 unless ( $query->param('userid') ) {
1447 $sessionID = $query->cookie("CGISESSID");
1449 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1450 my $session = get_session($sessionID);
1451 C4::Context->_new_userenv($sessionID);
1453 C4::Context->interface($session->param('interface'));
1454 C4::Context->set_userenv(
1455 $session->param('number'), $session->param('id'),
1456 $session->param('cardnumber'), $session->param('firstname'),
1457 $session->param('surname'), $session->param('branch'),
1458 $session->param('branchname'), $session->param('flags'),
1459 $session->param('emailaddress')
1462 my $ip = $session->param('ip');
1463 my $lasttime = $session->param('lasttime');
1464 my $userid = $session->param('id');
1465 if ( $lasttime < time() - $timeout ) {
1470 C4::Context->_unset_userenv($sessionID);
1473 return ( "expired", undef, undef );
1474 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1476 # IP address changed
1479 C4::Context->_unset_userenv($sessionID);
1482 return ( "expired", undef, undef );
1484 my $cookie = $query->cookie(
1485 -name => 'CGISESSID',
1486 -value => $session->id,
1488 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1490 $session->param( 'lasttime', time() );
1491 my $flags = haspermission( $userid, $flagsrequired );
1493 return ( "ok", $cookie, $sessionID );
1497 C4::Context->_unset_userenv($sessionID);
1500 return ( "failed", undef, undef );
1504 return ( "expired", undef, undef );
1509 my $userid = $query->param('userid');
1510 my $password = $query->param('password');
1511 my ( $return, $cardnumber, $cas_ticket );
1514 if ( $cas && $query->param('PT') ) {
1516 $debug and print STDERR "## check_api_auth - checking CAS\n";
1518 # In case of a CAS authentication, we use the ticket instead of the password
1519 my $PT = $query->param('PT');
1520 ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $dbh, $PT, $query ); # EXTERNAL AUTH
1523 # User / password auth
1524 unless ( $userid and $password ) {
1526 # caller did something wrong, fail the authenticateion
1527 return ( "failed", undef, undef );
1530 ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $dbh, $userid, $password, $query );
1533 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1534 my $session = get_session("");
1535 return ( "failed", undef, undef ) unless $session;
1537 my $sessionID = $session->id;
1538 C4::Context->_new_userenv($sessionID);
1539 my $cookie = $query->cookie(
1540 -name => 'CGISESSID',
1541 -value => $sessionID,
1543 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1545 if ( $return == 1 ) {
1547 $borrowernumber, $firstname, $surname,
1548 $userflags, $branchcode, $branchname,
1553 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1555 $sth->execute($userid);
1557 $borrowernumber, $firstname, $surname,
1558 $userflags, $branchcode, $branchname,
1560 ) = $sth->fetchrow if ( $sth->rows );
1562 unless ( $sth->rows ) {
1563 my $sth = $dbh->prepare(
1564 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1566 $sth->execute($cardnumber);
1568 $borrowernumber, $firstname, $surname,
1569 $userflags, $branchcode, $branchname,
1571 ) = $sth->fetchrow if ( $sth->rows );
1573 unless ( $sth->rows ) {
1574 $sth->execute($userid);
1576 $borrowernumber, $firstname, $surname, $userflags,
1577 $branchcode, $branchname, $emailaddress
1578 ) = $sth->fetchrow if ( $sth->rows );
1582 my $ip = $ENV{'REMOTE_ADDR'};
1584 # if they specify at login, use that
1585 if ( $query->param('branch') ) {
1586 $branchcode = $query->param('branch');
1587 my $library = Koha::Libraries->find($branchcode);
1588 $branchname = $library? $library->branchname: '';
1590 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1591 foreach my $br ( keys %$branches ) {
1593 # now we work with the treatment of ip
1594 my $domain = $branches->{$br}->{'branchip'};
1595 if ( $domain && $ip =~ /^$domain/ ) {
1596 $branchcode = $branches->{$br}->{'branchcode'};
1598 # new op dev : add the branchname to the cookie
1599 $branchname = $branches->{$br}->{'branchname'};
1602 $session->param( 'number', $borrowernumber );
1603 $session->param( 'id', $userid );
1604 $session->param( 'cardnumber', $cardnumber );
1605 $session->param( 'firstname', $firstname );
1606 $session->param( 'surname', $surname );
1607 $session->param( 'branch', $branchcode );
1608 $session->param( 'branchname', $branchname );
1609 $session->param( 'flags', $userflags );
1610 $session->param( 'emailaddress', $emailaddress );
1611 $session->param( 'ip', $session->remote_addr() );
1612 $session->param( 'lasttime', time() );
1613 $session->param( 'interface', 'api' );
1615 $session->param( 'cas_ticket', $cas_ticket);
1616 C4::Context->set_userenv(
1617 $session->param('number'), $session->param('id'),
1618 $session->param('cardnumber'), $session->param('firstname'),
1619 $session->param('surname'), $session->param('branch'),
1620 $session->param('branchname'), $session->param('flags'),
1621 $session->param('emailaddress')
1623 return ( "ok", $cookie, $sessionID );
1625 return ( "failed", undef, undef );
1630 =head2 check_cookie_auth
1632 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1634 Given a CGISESSID cookie set during a previous login to Koha, determine
1635 if the user has the privileges specified by C<$userflags>. C<$userflags>
1636 is passed unaltered into C<haspermission> and as such accepts all options
1637 avaiable to that routine with the one caveat that C<check_api_auth> will
1638 also allow 'undef' to be passed and in such a case the permissions check
1639 will be skipped altogether.
1641 C<check_cookie_auth> is meant for authenticating special services
1642 such as tools/upload-file.pl that are invoked by other pages that
1643 have been authenticated in the usual way.
1645 Possible return values in C<$status> are:
1649 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1651 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1653 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1655 =item "expired -- session cookie has expired; API user should resubmit userid and password
1661 sub check_cookie_auth {
1663 my $flagsrequired = shift;
1666 my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1667 my $dbh = C4::Context->dbh;
1668 my $timeout = _timeout_syspref();
1670 unless ( C4::Context->preference('Version') ) {
1672 # database has not been installed yet
1673 return ( "maintenance", undef );
1675 my $kohaversion = Koha::version();
1676 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1677 if ( C4::Context->preference('Version') < $kohaversion ) {
1679 # database in need of version update; assume that
1680 # no API should be called while databsae is in
1682 return ( "maintenance", undef );
1685 # FIXME -- most of what follows is a copy-and-paste
1686 # of code from checkauth. There is an obvious need
1687 # for refactoring to separate the various parts of
1688 # the authentication code, but as of 2007-11-23 this
1689 # is deferred so as to not introduce bugs into the
1690 # regular authentication code for Koha 3.0.
1692 # see if we have a valid session cookie already
1693 # however, if a userid parameter is present (i.e., from
1694 # a form submission, assume that any current cookie
1696 unless ( defined $cookie and $cookie ) {
1697 return ( "failed", undef );
1699 my $sessionID = $cookie;
1700 my $session = get_session($sessionID);
1701 C4::Context->_new_userenv($sessionID);
1703 C4::Context->interface($session->param('interface'));
1704 C4::Context->set_userenv(
1705 $session->param('number'), $session->param('id'),
1706 $session->param('cardnumber'), $session->param('firstname'),
1707 $session->param('surname'), $session->param('branch'),
1708 $session->param('branchname'), $session->param('flags'),
1709 $session->param('emailaddress')
1712 my $ip = $session->param('ip');
1713 my $lasttime = $session->param('lasttime');
1714 my $userid = $session->param('id');
1715 if ( $lasttime < time() - $timeout ) {
1720 C4::Context->_unset_userenv($sessionID);
1723 return ("expired", undef);
1724 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1726 # IP address changed
1729 C4::Context->_unset_userenv($sessionID);
1732 return ( "expired", undef );
1734 $session->param( 'lasttime', time() );
1735 my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1737 return ( "ok", $sessionID );
1741 C4::Context->_unset_userenv($sessionID);
1744 return ( "failed", undef );
1748 return ( "expired", undef );
1755 my $session = get_session($sessionID);
1757 Given a session ID, retrieve the CGI::Session object used to store
1758 the session's state. The session object can be used to store
1759 data that needs to be accessed by different scripts during a
1762 If the C<$sessionID> parameter is an empty string, a new session
1767 sub _get_session_params {
1768 my $storage_method = C4::Context->preference('SessionStorage');
1769 if ( $storage_method eq 'mysql' ) {
1770 my $dbh = C4::Context->dbh;
1771 return { dsn => "driver:MySQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1773 elsif ( $storage_method eq 'Pg' ) {
1774 my $dbh = C4::Context->dbh;
1775 return { dsn => "driver:PostgreSQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1777 elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1778 my $memcached = Koha::Caches->get_instance()->memcached_cache;
1779 return { dsn => "driver:memcached;serializer:yaml;id:md5", dsn_args => { Memcached => $memcached } };
1782 # catch all defaults to tmp should work on all systems
1783 my $dir = C4::Context::temporary_directory;
1784 my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1785 return { dsn => "driver:File;serializer:yaml;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1790 my $sessionID = shift;
1791 my $params = _get_session_params();
1792 return new CGI::Session( $params->{dsn}, $sessionID, $params->{dsn_args} );
1796 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1797 # (or something similar)
1798 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1799 # not having a userenv defined could cause a crash.
1801 my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1802 $type = 'opac' unless $type;
1804 # Get shibboleth login attribute
1805 my $shib = C4::Context->config('useshibboleth') && shib_ok();
1806 my $shib_login = $shib ? get_login_shib() : undef;
1810 if ( defined $userid ){
1811 $patron = Koha::Patrons->find({ userid => $userid });
1812 $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1814 my $check_internal_as_fallback = 0;
1816 # Note: checkpw_* routines returns:
1819 # -1 if user bind failed (LDAP only)
1821 if ( $patron and $patron->account_locked ) {
1822 # Nothing to check, account is locked
1823 } elsif ($ldap && defined($password)) {
1824 $debug and print STDERR "## checkpw - checking LDAP\n";
1825 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
1826 if ( $retval == 1 ) {
1827 @return = ( $retval, $retcard, $retuserid );
1830 $check_internal_as_fallback = 1 if $retval == 0;
1832 } elsif ( $cas && $query && $query->param('ticket') ) {
1833 $debug and print STDERR "## checkpw - checking CAS\n";
1835 # In case of a CAS authentication, we use the ticket instead of the password
1836 my $ticket = $query->param('ticket');
1837 $query->delete('ticket'); # remove ticket to come back to original URL
1838 my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $dbh, $ticket, $query, $type ); # EXTERNAL AUTH
1840 @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1844 $passwd_ok = $retval;
1847 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1848 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1850 elsif ( $shib && $shib_login && !$password ) {
1852 $debug and print STDERR "## checkpw - checking Shibboleth\n";
1854 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1855 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1856 # shibboleth-authenticated user
1858 # Then, we check if it matches a valid koha user
1860 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
1862 @return = ( $retval, $retcard, $retuserid );
1864 $passwd_ok = $retval;
1867 $check_internal_as_fallback = 1;
1871 if ( $check_internal_as_fallback ) {
1872 @return = checkpw_internal( $dbh, $userid, $password, $no_set_userenv);
1873 $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1878 $patron->update({ login_attempts => 0 });
1879 } elsif( !$patron->account_locked ) {
1880 $patron->update({ login_attempts => $patron->login_attempts + 1 });
1884 # Optionally log success or failure
1885 if( $patron && $passwd_ok && C4::Context->preference('AuthSuccessLog') ) {
1886 logaction( 'AUTH', 'SUCCESS', $patron->id, "Valid password for $userid", $type );
1887 } elsif( !$passwd_ok && C4::Context->preference('AuthFailureLog') ) {
1888 logaction( 'AUTH', 'FAILURE', $patron ? $patron->id : 0, "Wrong password for $userid", $type );
1894 sub checkpw_internal {
1895 my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
1897 $password = Encode::encode( 'UTF-8', $password )
1898 if Encode::is_utf8($password);
1902 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1904 $sth->execute($userid);
1906 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1907 $surname, $branchcode, $branchname, $flags )
1910 if ( checkpw_hash( $password, $stored_hash ) ) {
1912 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1913 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1914 return 1, $cardnumber, $userid;
1919 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1921 $sth->execute($userid);
1923 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1924 $surname, $branchcode, $branchname, $flags )
1927 if ( checkpw_hash( $password, $stored_hash ) ) {
1929 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1930 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1931 return 1, $cardnumber, $userid;
1938 my ( $password, $stored_hash ) = @_;
1940 return if $stored_hash eq '!';
1942 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1944 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1945 $hash = hash_password( $password, $stored_hash );
1947 $hash = md5_base64($password);
1949 return $hash eq $stored_hash;
1954 my $authflags = getuserflags($flags, $userid, [$dbh]);
1956 Translates integer flags into permissions strings hash.
1958 C<$flags> is the integer userflags value ( borrowers.userflags )
1959 C<$userid> is the members.userid, used for building subpermissions
1960 C<$authflags> is a hashref of permissions
1967 my $dbh = @_ ? shift : C4::Context->dbh;
1970 # I don't want to do this, but if someone logs in as the database
1971 # user, it would be preferable not to spam them to death with
1972 # numeric warnings. So, we make $flags numeric.
1973 no warnings 'numeric';
1976 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1979 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1980 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1981 $userflags->{$flag} = 1;
1984 $userflags->{$flag} = 0;
1988 # get subpermissions and merge with top-level permissions
1989 my $user_subperms = get_user_subpermissions($userid);
1990 foreach my $module ( keys %$user_subperms ) {
1991 next if $userflags->{$module} == 1; # user already has permission for everything in this module
1992 $userflags->{$module} = $user_subperms->{$module};
1998 =head2 get_user_subpermissions
2000 $user_perm_hashref = get_user_subpermissions($userid);
2002 Given the userid (note, not the borrowernumber) of a staff user,
2003 return a hashref of hashrefs of the specific subpermissions
2004 accorded to the user. An example return is
2008 export_catalog => 1,
2009 import_patrons => 1,
2013 The top-level hash-key is a module or function code from
2014 userflags.flag, while the second-level key is a code
2017 The results of this function do not give a complete picture
2018 of the functions that a staff user can access; it is also
2019 necessary to check borrowers.flags.
2023 sub get_user_subpermissions {
2026 my $dbh = C4::Context->dbh;
2027 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2028 FROM user_permissions
2029 JOIN permissions USING (module_bit, code)
2030 JOIN userflags ON (module_bit = bit)
2031 JOIN borrowers USING (borrowernumber)
2032 WHERE userid = ?" );
2033 $sth->execute($userid);
2035 my $user_perms = {};
2036 while ( my $perm = $sth->fetchrow_hashref ) {
2037 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2042 =head2 get_all_subpermissions
2044 my $perm_hashref = get_all_subpermissions();
2046 Returns a hashref of hashrefs defining all specific
2047 permissions currently defined. The return value
2048 has the same structure as that of C<get_user_subpermissions>,
2049 except that the innermost hash value is the description
2050 of the subpermission.
2054 sub get_all_subpermissions {
2055 my $dbh = C4::Context->dbh;
2056 my $sth = $dbh->prepare( "SELECT flag, code
2058 JOIN userflags ON (module_bit = bit)" );
2062 while ( my $perm = $sth->fetchrow_hashref ) {
2063 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2068 =head2 haspermission
2070 $flagsrequired = '*'; # Any permission at all
2071 $flagsrequired = 'a_flag'; # a_flag must be satisfied (all subpermissions)
2072 $flagsrequired = [ 'a_flag', 'b_flag' ]; # a_flag OR b_flag must be satisfied
2073 $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 }; # a_flag AND b_flag must be satisfied
2074 $flagsrequired = { 'a_flag' => 'sub_a' }; # sub_a of a_flag must be satisfied
2075 $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2077 $flags = ($userid, $flagsrequired);
2079 C<$userid> the userid of the member
2080 C<$flags> is a query structure similar to that used by SQL::Abstract that
2081 denotes the combination of flags required. It is a required parameter.
2083 The main logic of this method is that things in arrays are OR'ed, and things
2084 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2086 Returns member's flags or 0 if a permission is not met.
2091 my ($required, $flags) = @_;
2093 my $ref = ref($required);
2095 if ($required eq '*') {
2096 return 0 unless ( $flags or ref( $flags ) );
2098 return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2100 } elsif ($ref eq 'HASH') {
2101 foreach my $key (keys %{$required}) {
2102 next if $flags == 1;
2103 my $require = $required->{$key};
2104 my $rflags = $flags->{$key};
2105 return 0 unless _dispatch($require, $rflags);
2107 } elsif ($ref eq 'ARRAY') {
2109 foreach my $require ( @{$required} ) {
2111 ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2112 ? $flags->{$require}
2114 $satisfied++ if _dispatch( $require, $rflags );
2116 return 0 unless $satisfied;
2118 croak "Unexpected structure found: $ref";
2125 my ( $userid, $flagsrequired ) = @_;
2127 #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2128 # unless defined($flagsrequired);
2130 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2131 $sth->execute($userid);
2132 my $row = $sth->fetchrow();
2133 my $flags = getuserflags( $row, $userid );
2135 return $flags unless defined($flagsrequired);
2136 return $flags if $flags->{superlibrarian};
2137 return _dispatch($flagsrequired, $flags);
2139 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2144 $flags = ($iprange);
2146 C<$iprange> A space separated string describing an IP range. Can include single IPs or ranges
2148 Returns 1 if the remote address is in the provided iprange, or 0 otherwise.
2155 my @allowedipranges = $iprange ? split(' ', $iprange) : ();
2156 if (scalar @allowedipranges > 0) {
2158 eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2159 eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || ( $ENV{DEBUG} && warn 'cidrlookup failed for ' . join(' ',@rangelist) );
2161 return $result ? 1 : 0;
2164 sub getborrowernumber {
2166 my $userenv = C4::Context->userenv;
2167 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2168 return $userenv->{number};
2170 my $dbh = C4::Context->dbh;
2171 for my $field ( 'userid', 'cardnumber' ) {
2173 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2174 $sth->execute($userid);
2176 my ($bnumber) = $sth->fetchrow;
2183 =head2 track_login_daily
2185 track_login_daily( $userid );
2187 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2191 sub track_login_daily {
2193 return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2195 my $cache = Koha::Caches->get_instance();
2196 my $cache_key = "track_login_" . $userid;
2197 my $cached = $cache->get_from_cache($cache_key);
2198 my $today = dt_from_string()->ymd;
2199 return if $cached && $cached eq $today;
2201 my $patron = Koha::Patrons->find({ userid => $userid });
2202 return unless $patron;
2203 $patron->track_login;
2204 $cache->set_in_cache( $cache_key, $today );
2207 END { } # module clean-up code here (global destructor)
2217 Crypt::Eksblowfish::Bcrypt(3)