3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
24 use Digest::MD5 qw(md5_base64);
25 use JSON qw/encode_json/;
31 use C4::Templates; # to get the template
33 use C4::Search::History;
36 use Koha::AuthUtils qw(get_script_name hash_password);
38 use Koha::DateUtils qw(dt_from_string);
39 use Koha::Library::Groups;
42 use Koha::Patron::Consents;
43 use POSIX qw/strftime/;
44 use List::MoreUtils qw/ any /;
45 use Encode qw( encode is_utf8);
46 use C4::Auth_with_shibboleth;
50 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout);
53 sub psgi_env { any { /^psgi\./ } keys %ENV }
56 if (psgi_env) { die 'psgi:exit' }
60 C4::Context->set_remote_address;
64 @EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
65 @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash
66 &get_all_subpermissions &get_user_subpermissions track_login_daily &in_iprange
68 %EXPORT_TAGS = ( EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)] );
69 $ldap = C4::Context->config('useldapserver') || 0;
70 $cas = C4::Context->preference('casAuthentication');
71 $caslogout = C4::Context->preference('casLogout');
72 require C4::Auth_with_cas; # no import
75 require C4::Auth_with_ldap;
76 import C4::Auth_with_ldap qw(checkpw_ldap);
79 import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url logout_if_required);
86 C4::Auth - Authenticates Koha users
96 my ($template, $borrowernumber, $cookie)
97 = get_template_and_user(
99 template_name => "opac-main.tt",
102 authnotrequired => 0,
103 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
107 output_html_with_http_headers $query, $cookie, $template->output;
111 The main function of this module is to provide
112 authentification. However the get_template_and_user function has
113 been provided so that a users login information is passed along
114 automatically. This gets loaded into the template.
118 =head2 get_template_and_user
120 my ($template, $borrowernumber, $cookie)
121 = get_template_and_user(
123 template_name => "opac-main.tt",
126 authnotrequired => 0,
127 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
131 This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
132 to C<&checkauth> (in this module) to perform authentification.
133 See C<&checkauth> for an explanation of these parameters.
135 The C<template_name> is then used to find the correct template for
136 the page. The authenticated users details are loaded onto the
137 template in the logged_in_user variable (which is a Koha::Patron object). Also the
138 C<sessionID> is passed to the template. This can be used in templates
139 if cookies are disabled. It needs to be put as and input to every
142 More information on the C<gettemplate> sub can be found in the
147 sub get_template_and_user {
150 my ( $user, $cookie, $sessionID, $flags );
152 # Get shibboleth login attribute
153 my $shib = C4::Context->config('useshibboleth') && shib_ok();
154 my $shib_login = $shib ? get_login_shib() : undef;
156 C4::Context->interface( $in->{type} );
158 $in->{'authnotrequired'} ||= 0;
160 # the following call includes a bad template check; might croak
161 my $template = C4::Templates::gettemplate(
162 $in->{'template_name'},
167 if ( $in->{'template_name'} !~ m/maintenance/ ) {
168 ( $user, $cookie, $sessionID, $flags ) = checkauth(
170 $in->{'authnotrequired'},
171 $in->{'flagsrequired'},
174 $in->{template_name},
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);
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 );
330 foreach my $module ( keys %$all_perms ) {
331 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
332 $template->param( "CAN_user_${module}_${subperm}" => 1 );
338 foreach my $module ( keys %$all_perms ) {
339 if ( defined($flags->{$module}) && $flags->{$module} == 1 ) {
340 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
341 $template->param( "CAN_user_${module}_${subperm}" => 1 );
343 } elsif ( ref( $flags->{$module} ) ) {
344 foreach my $subperm ( keys %{ $flags->{$module} } ) {
345 $template->param( "CAN_user_${module}_${subperm}" => 1 );
352 foreach my $module ( keys %$flags ) {
353 if ( $flags->{$module} == 1 or ref( $flags->{$module} ) ) {
354 $template->param( "CAN_user_$module" => 1 );
359 # Logged-in opac search history
360 # If the requested template is an opac one and opac search history is enabled
361 if ( $in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory') ) {
362 my $dbh = C4::Context->dbh;
363 my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
364 my $sth = $dbh->prepare($query);
365 $sth->execute($borrowernumber);
367 # If at least one search has already been performed
368 if ( $sth->fetchrow_array > 0 ) {
370 # We show the link in opac
371 $template->param( EnableOpacSearchHistory => 1 );
373 if (C4::Context->preference('LoadSearchHistoryToTheFirstLoggedUser'))
375 # And if there are searches performed when the user was not logged in,
376 # we add them to the logged-in search history
377 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
378 if (@recentSearches) {
379 my $dbh = C4::Context->dbh;
381 INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, type, total, time )
382 VALUES (?, ?, ?, ?, ?, ?, ?)
384 my $sth = $dbh->prepare($query);
385 $sth->execute( $borrowernumber,
386 $in->{query}->cookie("CGISESSID"),
389 $_->{type} || 'biblio',
392 ) foreach @recentSearches;
394 # clear out the search history from the session now that
395 # we've saved it to the database
398 C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } );
400 } elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) {
401 $template->param( EnableSearchHistory => 1 );
404 else { # if this is an anonymous session, setup to display public lists...
406 # If shibboleth is enabled, and we're in an anonymous session, we should allow
407 # the user to attempt login via shibboleth.
409 $template->param( shibbolethAuthentication => $shib,
410 shibbolethLoginUrl => login_shib_url( $in->{'query'} ),
413 # If shibboleth is enabled and we have a shibboleth login attribute,
414 # but we are in an anonymous session, then we clearly have an invalid
415 # shibboleth koha account.
417 $template->param( invalidShibLogin => '1' );
421 $template->param( sessionID => $sessionID );
423 if ( $in->{'type'} eq 'opac' ){
424 require Koha::Virtualshelves;
425 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
431 some_public_shelves => $some_public_shelves,
436 # Anonymous opac search history
437 # If opac search history is enabled and at least one search has already been performed
438 if ( C4::Context->preference('EnableOpacSearchHistory') ) {
439 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
440 if (@recentSearches) {
441 $template->param( EnableOpacSearchHistory => 1 );
445 if ( C4::Context->preference('dateformat') ) {
446 $template->param( dateformat => C4::Context->preference('dateformat') );
449 $template->param(auth_forwarded_hash => scalar $in->{'query'}->param('auth_forwarded_hash'));
451 # these template parameters are set the same regardless of $in->{'type'}
453 my $minPasswordLength = C4::Context->preference('minPasswordLength');
454 $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
456 "BiblioDefaultView" . C4::Context->preference("BiblioDefaultView") => 1,
457 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
458 GoogleJackets => C4::Context->preference("GoogleJackets"),
459 OpenLibraryCovers => C4::Context->preference("OpenLibraryCovers"),
460 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
461 LoginBranchcode => ( C4::Context->userenv ? C4::Context->userenv->{"branch"} : undef ),
462 LoginFirstname => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
463 LoginSurname => C4::Context->userenv ? C4::Context->userenv->{"surname"} : "Inconnu",
464 emailaddress => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
465 TagsEnabled => C4::Context->preference("TagsEnabled"),
466 hide_marc => C4::Context->preference("hide_marc"),
467 item_level_itypes => C4::Context->preference('item-level_itypes'),
468 patronimages => C4::Context->preference("patronimages"),
469 singleBranchMode => ( Koha::Libraries->search->count == 1 ),
470 XSLTDetailsDisplay => C4::Context->preference("XSLTDetailsDisplay"),
471 XSLTResultsDisplay => C4::Context->preference("XSLTResultsDisplay"),
472 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 LoginBranchname => ( C4::Context->userenv ? C4::Context->userenv->{"branchname"} : undef ),
489 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
490 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
491 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
492 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
493 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
494 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
495 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
496 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
497 intranetbookbag => C4::Context->preference("intranetbookbag"),
498 suggestion => C4::Context->preference("suggestion"),
499 virtualshelves => C4::Context->preference("virtualshelves"),
500 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
501 EasyAnalyticalRecords => C4::Context->preference('EasyAnalyticalRecords'),
502 LocalCoverImages => C4::Context->preference('LocalCoverImages'),
503 OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'),
504 AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'),
505 EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'),
506 UseKohaPlugins => C4::Context->preference('UseKohaPlugins'),
507 UseCourseReserves => C4::Context->preference("UseCourseReserves"),
508 useDischarge => C4::Context->preference('useDischarge'),
509 pending_checkout_notes => scalar Koha::Checkouts->search({ noteseen => 0 }),
513 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
515 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
516 my $LibraryNameTitle = C4::Context->preference("LibraryName");
517 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
518 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
520 # clean up the busc param in the session
521 # if the page is not opac-detail and not the "add to list" page
522 # and not the "edit comments" page
523 if ( C4::Context->preference("OpacBrowseResults")
524 && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
526 unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
527 or $pagename =~ /^addbybiblionumber$/
528 or $pagename =~ /^review$/ ) {
529 my $sessionSearch = get_session( $sessionID || $in->{'query'}->cookie("CGISESSID") );
530 $sessionSearch->clear( ["busc"] ) if ( $sessionSearch->param("busc") );
534 # variables passed from CGI: opac_css_override and opac_search_limits.
535 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
536 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
539 ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:([\w-]+)/ ) ||
540 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:([\w-]+)/ ) ||
541 ( $in->{'query'}->param('multibranchlimit') && $in->{'query'}->param('multibranchlimit') =~ /multibranchlimit-(\w+)/ )
543 $opac_name = $1; # opac_search_limit is a branch, so we use it.
544 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
545 $opac_name = $in->{'query'}->param('multibranchlimit');
546 } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
547 $opac_name = C4::Context->userenv->{'branch'};
550 my @search_groups = Koha::Library::Groups->get_search_groups({ interface => 'opac' });
552 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
553 LibrarySearchGroups => \@search_groups,
554 opac_name => $opac_name,
555 LibraryName => "" . C4::Context->preference("LibraryName"),
556 LibraryNameTitle => "" . $LibraryNameTitle,
557 LoginBranchname => C4::Context->userenv ? C4::Context->userenv->{"branchname"} : "",
558 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
559 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
560 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
561 OPACShelfBrowser => "" . C4::Context->preference("OPACShelfBrowser"),
562 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
563 OPACUserCSS => "" . C4::Context->preference("OPACUserCSS"),
564 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
565 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
566 opac_search_limit => $opac_search_limit,
567 opac_limit_override => $opac_limit_override,
568 OpacBrowser => C4::Context->preference("OpacBrowser"),
569 OpacCloud => C4::Context->preference("OpacCloud"),
570 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
571 OpacMainUserBlock => "" . C4::Context->preference("OpacMainUserBlock"),
572 OpacNav => "" . C4::Context->preference("OpacNav"),
573 OpacNavBottom => "" . C4::Context->preference("OpacNavBottom"),
574 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
575 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
576 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
577 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
578 OpacTopissue => C4::Context->preference("OpacTopissue"),
579 RequestOnOpac => C4::Context->preference("RequestOnOpac"),
580 'Version' => C4::Context->preference('Version'),
581 hidelostitems => C4::Context->preference("hidelostitems"),
582 mylibraryfirst => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
583 opacbookbag => "" . C4::Context->preference("opacbookbag"),
584 opaccredits => "" . C4::Context->preference("opaccredits"),
585 OpacFavicon => C4::Context->preference("OpacFavicon"),
586 opacheader => "" . C4::Context->preference("opacheader"),
587 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
588 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
589 OPACUserJS => C4::Context->preference("OPACUserJS"),
590 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
591 OpenLibrarySearch => C4::Context->preference("OpenLibrarySearch"),
592 ShowReviewer => C4::Context->preference("ShowReviewer"),
593 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
594 suggestion => "" . C4::Context->preference("suggestion"),
595 virtualshelves => "" . C4::Context->preference("virtualshelves"),
596 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
597 OPACXSLTDetailsDisplay => C4::Context->preference("OPACXSLTDetailsDisplay"),
598 OPACXSLTResultsDisplay => C4::Context->preference("OPACXSLTResultsDisplay"),
599 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
600 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
601 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
602 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
603 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
604 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
605 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
606 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
607 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
608 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
609 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
610 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
611 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
612 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
613 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
614 useDischarge => C4::Context->preference('useDischarge'),
617 $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
620 # Check if we were asked using parameters to force a specific language
621 if ( defined $in->{'query'}->param('language') ) {
623 # Extract the language, let C4::Languages::getlanguage choose
625 my $language = C4::Languages::getlanguage( $in->{'query'} );
626 my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
627 if ( ref $cookie eq 'ARRAY' ) {
628 push @{$cookie}, $languagecookie;
630 $cookie = [ $cookie, $languagecookie ];
634 return ( $template, $borrowernumber, $cookie, $flags );
639 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
641 Verifies that the user is authorized to run this script. If
642 the user is authorized, a (userid, cookie, session-id, flags)
643 quadruple is returned. If the user is not authorized but does
644 not have the required privilege (see $flagsrequired below), it
645 displays an error page and exits. Otherwise, it displays the
646 login page and exits.
648 Note that C<&checkauth> will return if and only if the user
649 is authorized, so it should be called early on, before any
650 unfinished operations (e.g., if you've opened a file, then
651 C<&checkauth> won't close it for you).
653 C<$query> is the CGI object for the script calling C<&checkauth>.
655 The C<$noauth> argument is optional. If it is set, then no
656 authorization is required for the script.
658 C<&checkauth> fetches user and session information from C<$query> and
659 ensures that the user is authorized to run scripts that require
662 The C<$flagsrequired> argument specifies the required privileges
663 the user must have if the username and password are correct.
664 It should be specified as a reference-to-hash; keys in the hash
665 should be the "flags" for the user, as specified in the Members
666 intranet module. Any key specified must correspond to a "flag"
667 in the userflags table. E.g., { circulate => 1 } would specify
668 that the user must have the "circulate" privilege in order to
669 proceed. To make sure that access control is correct, the
670 C<$flagsrequired> parameter must be specified correctly.
672 Koha also has a concept of sub-permissions, also known as
673 granular permissions. This makes the value of each key
674 in the C<flagsrequired> hash take on an additional
679 The user must have access to all subfunctions of the module
680 specified by the hash key.
684 The user must have access to at least one subfunction of the module
685 specified by the hash key.
687 specific permission, e.g., 'export_catalog'
689 The user must have access to the specific subfunction list, which
690 must correspond to a row in the permissions table.
692 The C<$type> argument specifies whether the template should be
693 retrieved from the opac or intranet directory tree. "opac" is
694 assumed if it is not specified; however, if C<$type> is specified,
695 "intranet" is assumed if it is not "opac".
697 If C<$query> does not have a valid session ID associated with it
698 (i.e., the user has not logged in) or if the session has expired,
699 C<&checkauth> presents the user with a login page (from the point of
700 view of the original script, C<&checkauth> does not return). Once the
701 user has authenticated, C<&checkauth> restarts the original script
702 (this time, C<&checkauth> returns).
704 The login page is provided using a HTML::Template, which is set in the
705 systempreferences table or at the top of this file. The variable C<$type>
706 selects which template to use, either the opac or the intranet
707 authentification template.
709 C<&checkauth> returns a user ID, a cookie, and a session ID. The
710 cookie should be sent back to the browser; it verifies that the user
720 # If version syspref is unavailable, it means Koha is being installed,
721 # and so we must redirect to OPAC maintenance page or to the WebInstaller
722 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
723 if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
724 warn "OPAC Install required, redirecting to maintenance";
725 print $query->redirect("/cgi-bin/koha/maintenance.pl");
728 unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
729 if ( $type ne 'opac' ) {
730 warn "Install required, redirecting to Installer";
731 print $query->redirect("/cgi-bin/koha/installer/install.pl");
733 warn "OPAC Install required, redirecting to maintenance";
734 print $query->redirect("/cgi-bin/koha/maintenance.pl");
739 # check that database and koha version are the same
740 # there is no DB version, it's a fresh install,
741 # go to web installer
742 # there is a DB version, compare it to the code version
743 my $kohaversion = Koha::version();
745 # remove the 3 last . to have a Perl number
746 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
747 $debug and print STDERR "kohaversion : $kohaversion\n";
748 if ( $version < $kohaversion ) {
749 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
750 if ( $type ne 'opac' ) {
751 warn sprintf( $warning, 'Installer' );
752 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
754 warn sprintf( "OPAC: " . $warning, 'maintenance' );
755 print $query->redirect("/cgi-bin/koha/maintenance.pl");
763 open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
764 printf $fh join( "\n", @_ );
768 sub _timeout_syspref {
769 my $timeout = C4::Context->preference('timeout') || 600;
771 # value in days, convert in seconds
772 if ( $timeout =~ /(\d+)[dD]/ ) {
773 $timeout = $1 * 86400;
780 $debug and warn "Checking Auth";
782 # Get shibboleth login attribute
783 my $shib = C4::Context->config('useshibboleth') && shib_ok();
784 my $shib_login = $shib ? get_login_shib() : undef;
786 # $authnotrequired will be set for scripts which will run without authentication
787 my $authnotrequired = shift;
788 my $flagsrequired = shift;
790 my $emailaddress = shift;
791 my $template_name = shift;
792 $type = 'opac' unless $type;
794 unless ( C4::Context->preference("OpacPublic") ) {
795 my @allowed_scripts_for_private_opac = qw(
797 opac-registration-email-sent.tt
798 opac-registration-confirmation.tt
799 opac-memberentry-update-submitted.tt
800 opac-password-recovery.tt
802 $authnotrequired = 0 unless grep { $_ eq $template_name }
803 @allowed_scripts_for_private_opac;
806 my $dbh = C4::Context->dbh;
807 my $timeout = _timeout_syspref();
809 _version_check( $type, $query );
814 my ( $userid, $cookie, $sessionID, $flags );
815 my $logout = $query->param('logout.x');
817 my $anon_search_history;
819 # This parameter is the name of the CAS server we want to authenticate against,
820 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
821 my $casparam = $query->param('cas');
822 my $q_userid = $query->param('userid') // '';
826 # Basic authentication is incompatible with the use of Shibboleth,
827 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
828 # and it may not be the attribute we want to use to match the koha login.
830 # Also, do not consider an empty REMOTE_USER.
832 # Finally, after those tests, we can assume (although if it would be better with
833 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
834 # and we can affect it to $userid.
835 if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
837 # Using Basic Authentication, no cookies required
838 $cookie = $query->cookie(
839 -name => 'CGISESSID',
843 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
847 elsif ( $emailaddress) {
848 # the Google OpenID Connect passes an email address
850 elsif ( $sessionID = $query->cookie("CGISESSID") )
851 { # assignment, not comparison
852 $session = get_session($sessionID);
853 C4::Context->_new_userenv($sessionID);
854 my ( $ip, $lasttime, $sessiontype );
857 $s_userid = $session->param('id') // '';
858 C4::Context->set_userenv(
859 $session->param('number'), $s_userid,
860 $session->param('cardnumber'), $session->param('firstname'),
861 $session->param('surname'), $session->param('branch'),
862 $session->param('branchname'), $session->param('flags'),
863 $session->param('emailaddress'), $session->param('branchprinter'),
864 $session->param('shibboleth')
866 C4::Context::set_shelves_userenv( 'bar', $session->param('barshelves') );
867 C4::Context::set_shelves_userenv( 'pub', $session->param('pubshelves') );
868 C4::Context::set_shelves_userenv( 'tot', $session->param('totshelves') );
869 $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
870 $ip = $session->param('ip');
871 $lasttime = $session->param('lasttime');
873 $sessiontype = $session->param('sessiontype') || '';
875 if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
876 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
877 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
880 #if a user enters an id ne to the id in the current session, we need to log them in...
881 #first we need to clear the anonymous session...
882 $debug and warn "query id = $q_userid but session id = $s_userid";
883 $anon_search_history = $session->param('search_history');
886 C4::Context->_unset_userenv($sessionID);
892 # voluntary logout the user
893 # check wether the user was using their shibboleth session or a local one
894 my $shibSuccess = C4::Context->userenv->{'shibboleth'};
897 C4::Context->_unset_userenv($sessionID);
899 #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
903 if ($cas and $caslogout) {
904 logout_cas($query, $type);
907 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
908 if ( $shib and $shib_login and $shibSuccess) {
912 elsif ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
915 $info{'timed_out'} = 1;
920 C4::Context->_unset_userenv($sessionID);
922 #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
926 elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
928 # Different ip than originally logged in from
929 $info{'oldip'} = $ip;
930 $info{'newip'} = $ENV{'REMOTE_ADDR'};
931 $info{'different_ip'} = 1;
934 C4::Context->_unset_userenv($sessionID);
936 #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
941 $cookie = $query->cookie(
942 -name => 'CGISESSID',
943 -value => $session->id,
945 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
947 $session->param( 'lasttime', time() );
948 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...
949 $flags = haspermission( $userid, $flagsrequired );
953 $info{'nopermission'} = 1;
958 unless ( $userid || $sessionID ) {
959 #we initiate a session prior to checking for a username to allow for anonymous sessions...
960 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
962 # Save anonymous search history in new session so it can be retrieved
963 # by get_template_and_user to store it in user's search history after
964 # a successful login.
965 if ($anon_search_history) {
966 $session->param( 'search_history', $anon_search_history );
969 $sessionID = $session->id;
970 C4::Context->_new_userenv($sessionID);
971 $cookie = $query->cookie(
972 -name => 'CGISESSID',
973 -value => $session->id,
975 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
977 my $pki_field = C4::Context->preference('AllowPKIAuth');
978 if ( !defined($pki_field) ) {
979 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
982 if ( ( $cas && $query->param('ticket') )
984 || ( $shib && $shib_login )
985 || $pki_field ne 'None'
988 my $password = $query->param('password');
990 my ( $return, $cardnumber );
992 # If shib is enabled and we have a shib login, does the login match a valid koha user
993 if ( $shib && $shib_login ) {
996 # Do not pass password here, else shib will not be checked in checkpw.
997 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $q_userid, undef, $query );
998 $userid = $retuserid;
999 $shibSuccess = $return;
1000 $info{'invalidShibLogin'} = 1 unless ($return);
1003 # If shib login and match were successful, skip further login methods
1004 unless ($shibSuccess) {
1005 if ( $cas && $query->param('ticket') ) {
1007 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1008 checkpw( $dbh, $userid, $password, $query, $type );
1009 $userid = $retuserid;
1010 $info{'invalidCasLogin'} = 1 unless ($return);
1013 elsif ( $emailaddress ) {
1014 my $value = $emailaddress;
1016 # If we're looking up the email, there's a chance that the person
1017 # doesn't have a userid. So if there is none, we pass along the
1018 # borrower number, and the bits of code that need to know the user
1019 # ID will have to be smart enough to handle that.
1020 my $patrons = Koha::Patrons->search({ email => $value });
1021 if ($patrons->count) {
1023 # First the userid, then the borrowernum
1024 my $patron = $patrons->next;
1025 $value = $patron->userid || $patron->borrowernumber;
1029 $return = $value ? 1 : 0;
1034 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1035 || ( $pki_field eq 'emailAddress'
1036 && $ENV{'SSL_CLIENT_S_DN_Email'} )
1040 if ( $pki_field eq 'Common Name' ) {
1041 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1043 elsif ( $pki_field eq 'emailAddress' ) {
1044 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1046 # If we're looking up the email, there's a chance that the person
1047 # doesn't have a userid. So if there is none, we pass along the
1048 # borrower number, and the bits of code that need to know the user
1049 # ID will have to be smart enough to handle that.
1050 my $patrons = Koha::Patrons->search({ email => $value });
1051 if ($patrons->count) {
1053 # First the userid, then the borrowernum
1054 my $patron = $patrons->next;
1055 $value = $patron->userid || $patron->borrowernumber;
1061 $return = $value ? 1 : 0;
1067 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1068 checkpw( $dbh, $q_userid, $password, $query, $type );
1069 $userid = $retuserid if ($retuserid);
1070 $info{'invalid_username_or_password'} = 1 unless ($return);
1074 # $return: 1 = valid user
1077 #_session_log(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
1078 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1082 $info{'nopermission'} = 1;
1083 C4::Context->_unset_userenv($sessionID);
1085 my ( $borrowernumber, $firstname, $surname, $userflags,
1086 $branchcode, $branchname, $branchprinter, $emailaddress );
1088 if ( $return == 1 ) {
1090 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1091 branches.branchname as branchname,
1092 branches.branchprinter as branchprinter,
1095 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1097 my $sth = $dbh->prepare("$select where userid=?");
1098 $sth->execute($userid);
1099 unless ( $sth->rows ) {
1100 $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
1101 $sth = $dbh->prepare("$select where cardnumber=?");
1102 $sth->execute($cardnumber);
1104 unless ( $sth->rows ) {
1105 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1106 $sth->execute($userid);
1107 unless ( $sth->rows ) {
1108 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1113 ( $borrowernumber, $firstname, $surname, $userflags,
1114 $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow;
1115 $debug and print STDERR "AUTH_3 results: " .
1116 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1118 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1121 # launch a sequence to check if we have a ip for the branch, i
1122 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1124 my $ip = $ENV{'REMOTE_ADDR'};
1126 # if they specify at login, use that
1127 if ( $query->param('branch') ) {
1128 $branchcode = $query->param('branch');
1129 my $library = Koha::Libraries->find($branchcode);
1130 $branchname = $library? $library->branchname: '';
1132 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1133 if ( $type ne 'opac' and C4::Context->boolean_preference('AutoLocation') ) {
1135 # we have to check they are coming from the right ip range
1136 my $domain = $branches->{$branchcode}->{'branchip'};
1137 $domain =~ s|\.\*||g;
1138 if ( $ip !~ /^$domain/ ) {
1140 $cookie = $query->cookie(
1141 -name => 'CGISESSID',
1144 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1146 $info{'wrongip'} = 1;
1150 foreach my $br ( keys %$branches ) {
1152 # now we work with the treatment of ip
1153 my $domain = $branches->{$br}->{'branchip'};
1154 if ( $domain && $ip =~ /^$domain/ ) {
1155 $branchcode = $branches->{$br}->{'branchcode'};
1157 # new op dev : add the branchprinter and branchname in the cookie
1158 $branchprinter = $branches->{$br}->{'branchprinter'};
1159 $branchname = $branches->{$br}->{'branchname'};
1162 $session->param( 'number', $borrowernumber );
1163 $session->param( 'id', $userid );
1164 $session->param( 'cardnumber', $cardnumber );
1165 $session->param( 'firstname', $firstname );
1166 $session->param( 'surname', $surname );
1167 $session->param( 'branch', $branchcode );
1168 $session->param( 'branchname', $branchname );
1169 $session->param( 'flags', $userflags );
1170 $session->param( 'emailaddress', $emailaddress );
1171 $session->param( 'ip', $session->remote_addr() );
1172 $session->param( 'lasttime', time() );
1173 $session->param( 'interface', $type);
1174 $session->param( 'shibboleth', $shibSuccess );
1175 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1177 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1178 C4::Context->set_userenv(
1179 $session->param('number'), $session->param('id'),
1180 $session->param('cardnumber'), $session->param('firstname'),
1181 $session->param('surname'), $session->param('branch'),
1182 $session->param('branchname'), $session->param('flags'),
1183 $session->param('emailaddress'), $session->param('branchprinter'),
1184 $session->param('shibboleth')
1188 # $return: 0 = invalid user
1189 # reset to anonymous session
1191 $debug and warn "Login failed, resetting anonymous session...";
1193 $info{'invalid_username_or_password'} = 1;
1194 C4::Context->_unset_userenv($sessionID);
1196 $session->param( 'lasttime', time() );
1197 $session->param( 'ip', $session->remote_addr() );
1198 $session->param( 'sessiontype', 'anon' );
1199 $session->param( 'interface', $type);
1201 } # END if ( $q_userid
1202 elsif ( $type eq "opac" ) {
1204 # if we are here this is an anonymous session; add public lists to it and a few other items...
1205 # anonymous sessions are created only for the OPAC
1206 $debug and warn "Initiating an anonymous session...";
1208 # setting a couple of other session vars...
1209 $session->param( 'ip', $session->remote_addr() );
1210 $session->param( 'lasttime', time() );
1211 $session->param( 'sessiontype', 'anon' );
1212 $session->param( 'interface', $type);
1214 } # END unless ($userid)
1216 # finished authentification, now respond
1217 if ( $loggedin || $authnotrequired )
1221 $cookie = $query->cookie(
1222 -name => 'CGISESSID',
1225 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1229 track_login_daily( $userid );
1231 # In case, that this request was a login attempt, we want to prevent that users can repost the opac login
1232 # request. We therefore redirect the user to the requested page again without the login parameters.
1233 # See Post/Redirect/Get (PRG) design pattern: https://en.wikipedia.org/wiki/Post/Redirect/Get
1234 if ( $type eq "opac" && $query->param('koha_login_context') && $query->param('koha_login_context') ne 'sco' && $query->param('password') && $query->param('userid') ) {
1235 my $uri = URI->new($query->url(-relative=>1, -query_string=>1));
1236 $uri->query_param_delete('userid');
1237 $uri->query_param_delete('password');
1238 $uri->query_param_delete('koha_login_context');
1239 print $query->redirect(-uri => $uri->as_string, -cookie => $cookie, -status=>'303 See other');
1243 return ( $userid, $cookie, $sessionID, $flags );
1248 # AUTH rejected, show the login/password template, after checking the DB.
1252 # get the inputs from the incoming query
1254 foreach my $name ( param $query) {
1255 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1256 my @value = $query->multi_param($name);
1257 push @inputs, { name => $name, value => $_ } for @value;
1260 my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1262 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1263 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1264 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1266 my $auth_template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1267 my $template = C4::Templates::gettemplate( $auth_template_name, $type, $query );
1271 script_name => get_script_name(),
1272 casAuthentication => C4::Context->preference("casAuthentication"),
1273 shibbolethAuthentication => $shib,
1274 SessionRestrictionByIP => C4::Context->preference("SessionRestrictionByIP"),
1275 suggestion => C4::Context->preference("suggestion"),
1276 virtualshelves => C4::Context->preference("virtualshelves"),
1277 LibraryName => "" . C4::Context->preference("LibraryName"),
1278 LibraryNameTitle => "" . $LibraryNameTitle,
1279 opacuserlogin => C4::Context->preference("opacuserlogin"),
1280 OpacNav => C4::Context->preference("OpacNav"),
1281 OpacNavBottom => C4::Context->preference("OpacNavBottom"),
1282 opaccredits => C4::Context->preference("opaccredits"),
1283 OpacFavicon => C4::Context->preference("OpacFavicon"),
1284 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1285 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1286 OPACUserJS => C4::Context->preference("OPACUserJS"),
1287 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1288 OpacCloud => C4::Context->preference("OpacCloud"),
1289 OpacTopissue => C4::Context->preference("OpacTopissue"),
1290 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1291 OpacBrowser => C4::Context->preference("OpacBrowser"),
1292 opacheader => C4::Context->preference("opacheader"),
1293 TagsEnabled => C4::Context->preference("TagsEnabled"),
1294 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1295 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1296 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1297 intranetbookbag => C4::Context->preference("intranetbookbag"),
1298 IntranetNav => C4::Context->preference("IntranetNav"),
1299 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1300 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
1301 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1302 IndependentBranches => C4::Context->preference("IndependentBranches"),
1303 AutoLocation => C4::Context->preference("AutoLocation"),
1304 wrongip => $info{'wrongip'},
1305 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1306 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1307 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1308 too_many_login_attempts => ( $patron and $patron->account_locked )
1311 $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1312 $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1313 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1314 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1316 if ( $type eq 'opac' ) {
1317 require Koha::Virtualshelves;
1318 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1324 some_public_shelves => $some_public_shelves,
1330 # Is authentication against multiple CAS servers enabled?
1331 if ( C4::Auth_with_cas::multipleAuth && !$casparam ) {
1332 my $casservers = C4::Auth_with_cas::getMultipleAuth();
1334 foreach my $key ( keys %$casservers ) {
1335 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1338 casServersLoop => \@tmplservers
1342 casServerUrl => login_cas_url($query, undef, $type),
1347 invalidCasLogin => $info{'invalidCasLogin'}
1353 shibbolethAuthentication => $shib,
1354 shibbolethLoginUrl => login_shib_url($query),
1358 if (C4::Context->preference('GoogleOpenIDConnect')) {
1359 if ($query->param("OpenIDConnectFailed")) {
1360 my $reason = $query->param('OpenIDConnectFailed');
1361 $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1366 LibraryName => C4::Context->preference("LibraryName"),
1368 $template->param(%info);
1370 # $cookie = $query->cookie(CGISESSID => $session->id
1372 print $query->header(
1373 { type => 'text/html',
1376 'X-Frame-Options' => 'SAMEORIGIN'
1383 =head2 check_api_auth
1385 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1387 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1388 cookie, determine if the user has the privileges specified by C<$userflags>.
1390 C<check_api_auth> is is meant for authenticating users of web services, and
1391 consequently will always return and will not attempt to redirect the user
1394 If a valid session cookie is already present, check_api_auth will return a status
1395 of "ok", the cookie, and the Koha session ID.
1397 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1398 parameters and create a session cookie and Koha session if the supplied credentials
1401 Possible return values in C<$status> are:
1405 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1407 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1409 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1411 =item "expired -- session cookie has expired; API user should resubmit userid and password
1417 sub check_api_auth {
1420 my $flagsrequired = shift;
1421 my $dbh = C4::Context->dbh;
1422 my $timeout = _timeout_syspref();
1424 unless ( C4::Context->preference('Version') ) {
1426 # database has not been installed yet
1427 return ( "maintenance", undef, undef );
1429 my $kohaversion = Koha::version();
1430 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1431 if ( C4::Context->preference('Version') < $kohaversion ) {
1433 # database in need of version update; assume that
1434 # no API should be called while databsae is in
1436 return ( "maintenance", undef, undef );
1439 # FIXME -- most of what follows is a copy-and-paste
1440 # of code from checkauth. There is an obvious need
1441 # for refactoring to separate the various parts of
1442 # the authentication code, but as of 2007-11-19 this
1443 # is deferred so as to not introduce bugs into the
1444 # regular authentication code for Koha 3.0.
1446 # see if we have a valid session cookie already
1447 # however, if a userid parameter is present (i.e., from
1448 # a form submission, assume that any current cookie
1450 my $sessionID = undef;
1451 unless ( $query->param('userid') ) {
1452 $sessionID = $query->cookie("CGISESSID");
1454 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1455 my $session = get_session($sessionID);
1456 C4::Context->_new_userenv($sessionID);
1458 C4::Context->interface($session->param('interface'));
1459 C4::Context->set_userenv(
1460 $session->param('number'), $session->param('id'),
1461 $session->param('cardnumber'), $session->param('firstname'),
1462 $session->param('surname'), $session->param('branch'),
1463 $session->param('branchname'), $session->param('flags'),
1464 $session->param('emailaddress'), $session->param('branchprinter')
1467 my $ip = $session->param('ip');
1468 my $lasttime = $session->param('lasttime');
1469 my $userid = $session->param('id');
1470 if ( $lasttime < time() - $timeout ) {
1475 C4::Context->_unset_userenv($sessionID);
1478 return ( "expired", undef, undef );
1479 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1481 # IP address changed
1484 C4::Context->_unset_userenv($sessionID);
1487 return ( "expired", undef, undef );
1489 my $cookie = $query->cookie(
1490 -name => 'CGISESSID',
1491 -value => $session->id,
1493 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1495 $session->param( 'lasttime', time() );
1496 my $flags = haspermission( $userid, $flagsrequired );
1498 return ( "ok", $cookie, $sessionID );
1502 C4::Context->_unset_userenv($sessionID);
1505 return ( "failed", undef, undef );
1509 return ( "expired", undef, undef );
1514 my $userid = $query->param('userid');
1515 my $password = $query->param('password');
1516 my ( $return, $cardnumber, $cas_ticket );
1519 if ( $cas && $query->param('PT') ) {
1521 $debug and print STDERR "## check_api_auth - checking CAS\n";
1523 # In case of a CAS authentication, we use the ticket instead of the password
1524 my $PT = $query->param('PT');
1525 ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $dbh, $PT, $query ); # EXTERNAL AUTH
1528 # User / password auth
1529 unless ( $userid and $password ) {
1531 # caller did something wrong, fail the authenticateion
1532 return ( "failed", undef, undef );
1535 ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $dbh, $userid, $password, $query );
1538 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1539 my $session = get_session("");
1540 return ( "failed", undef, undef ) unless $session;
1542 my $sessionID = $session->id;
1543 C4::Context->_new_userenv($sessionID);
1544 my $cookie = $query->cookie(
1545 -name => 'CGISESSID',
1546 -value => $sessionID,
1548 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1550 if ( $return == 1 ) {
1552 $borrowernumber, $firstname, $surname,
1553 $userflags, $branchcode, $branchname,
1554 $branchprinter, $emailaddress
1558 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname,branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1560 $sth->execute($userid);
1562 $borrowernumber, $firstname, $surname,
1563 $userflags, $branchcode, $branchname,
1564 $branchprinter, $emailaddress
1565 ) = $sth->fetchrow if ( $sth->rows );
1567 unless ( $sth->rows ) {
1568 my $sth = $dbh->prepare(
1569 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1571 $sth->execute($cardnumber);
1573 $borrowernumber, $firstname, $surname,
1574 $userflags, $branchcode, $branchname,
1575 $branchprinter, $emailaddress
1576 ) = $sth->fetchrow if ( $sth->rows );
1578 unless ( $sth->rows ) {
1579 $sth->execute($userid);
1581 $borrowernumber, $firstname, $surname, $userflags,
1582 $branchcode, $branchname, $branchprinter, $emailaddress
1583 ) = $sth->fetchrow if ( $sth->rows );
1587 my $ip = $ENV{'REMOTE_ADDR'};
1589 # if they specify at login, use that
1590 if ( $query->param('branch') ) {
1591 $branchcode = $query->param('branch');
1592 my $library = Koha::Libraries->find($branchcode);
1593 $branchname = $library? $library->branchname: '';
1595 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1596 foreach my $br ( keys %$branches ) {
1598 # now we work with the treatment of ip
1599 my $domain = $branches->{$br}->{'branchip'};
1600 if ( $domain && $ip =~ /^$domain/ ) {
1601 $branchcode = $branches->{$br}->{'branchcode'};
1603 # new op dev : add the branchprinter and branchname in the cookie
1604 $branchprinter = $branches->{$br}->{'branchprinter'};
1605 $branchname = $branches->{$br}->{'branchname'};
1608 $session->param( 'number', $borrowernumber );
1609 $session->param( 'id', $userid );
1610 $session->param( 'cardnumber', $cardnumber );
1611 $session->param( 'firstname', $firstname );
1612 $session->param( 'surname', $surname );
1613 $session->param( 'branch', $branchcode );
1614 $session->param( 'branchname', $branchname );
1615 $session->param( 'flags', $userflags );
1616 $session->param( 'emailaddress', $emailaddress );
1617 $session->param( 'ip', $session->remote_addr() );
1618 $session->param( 'lasttime', time() );
1619 $session->param( 'interface', 'api' );
1621 $session->param( 'cas_ticket', $cas_ticket);
1622 C4::Context->set_userenv(
1623 $session->param('number'), $session->param('id'),
1624 $session->param('cardnumber'), $session->param('firstname'),
1625 $session->param('surname'), $session->param('branch'),
1626 $session->param('branchname'), $session->param('flags'),
1627 $session->param('emailaddress'), $session->param('branchprinter')
1629 return ( "ok", $cookie, $sessionID );
1631 return ( "failed", undef, undef );
1636 =head2 check_cookie_auth
1638 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1640 Given a CGISESSID cookie set during a previous login to Koha, determine
1641 if the user has the privileges specified by C<$userflags>. C<$userflags>
1642 is passed unaltered into C<haspermission> and as such accepts all options
1643 avaiable to that routine with the one caveat that C<check_api_auth> will
1644 also allow 'undef' to be passed and in such a case the permissions check
1645 will be skipped altogether.
1647 C<check_cookie_auth> is meant for authenticating special services
1648 such as tools/upload-file.pl that are invoked by other pages that
1649 have been authenticated in the usual way.
1651 Possible return values in C<$status> are:
1655 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1657 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1659 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1661 =item "expired -- session cookie has expired; API user should resubmit userid and password
1667 sub check_cookie_auth {
1669 my $flagsrequired = shift;
1672 my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1673 my $dbh = C4::Context->dbh;
1674 my $timeout = _timeout_syspref();
1676 unless ( C4::Context->preference('Version') ) {
1678 # database has not been installed yet
1679 return ( "maintenance", undef );
1681 my $kohaversion = Koha::version();
1682 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1683 if ( C4::Context->preference('Version') < $kohaversion ) {
1685 # database in need of version update; assume that
1686 # no API should be called while databsae is in
1688 return ( "maintenance", undef );
1691 # FIXME -- most of what follows is a copy-and-paste
1692 # of code from checkauth. There is an obvious need
1693 # for refactoring to separate the various parts of
1694 # the authentication code, but as of 2007-11-23 this
1695 # is deferred so as to not introduce bugs into the
1696 # regular authentication code for Koha 3.0.
1698 # see if we have a valid session cookie already
1699 # however, if a userid parameter is present (i.e., from
1700 # a form submission, assume that any current cookie
1702 unless ( defined $cookie and $cookie ) {
1703 return ( "failed", undef );
1705 my $sessionID = $cookie;
1706 my $session = get_session($sessionID);
1707 C4::Context->_new_userenv($sessionID);
1709 C4::Context->interface($session->param('interface'));
1710 C4::Context->set_userenv(
1711 $session->param('number'), $session->param('id'),
1712 $session->param('cardnumber'), $session->param('firstname'),
1713 $session->param('surname'), $session->param('branch'),
1714 $session->param('branchname'), $session->param('flags'),
1715 $session->param('emailaddress'), $session->param('branchprinter')
1718 my $ip = $session->param('ip');
1719 my $lasttime = $session->param('lasttime');
1720 my $userid = $session->param('id');
1721 if ( $lasttime < time() - $timeout ) {
1726 C4::Context->_unset_userenv($sessionID);
1729 return ("expired", undef);
1730 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1732 # IP address changed
1735 C4::Context->_unset_userenv($sessionID);
1738 return ( "expired", undef );
1740 $session->param( 'lasttime', time() );
1741 my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1743 return ( "ok", $sessionID );
1747 C4::Context->_unset_userenv($sessionID);
1750 return ( "failed", undef );
1754 return ( "expired", undef );
1761 my $session = get_session($sessionID);
1763 Given a session ID, retrieve the CGI::Session object used to store
1764 the session's state. The session object can be used to store
1765 data that needs to be accessed by different scripts during a
1768 If the C<$sessionID> parameter is an empty string, a new session
1773 sub _get_session_params {
1774 my $storage_method = C4::Context->preference('SessionStorage');
1775 if ( $storage_method eq 'mysql' ) {
1776 my $dbh = C4::Context->dbh;
1777 return { dsn => "driver:MySQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1779 elsif ( $storage_method eq 'Pg' ) {
1780 my $dbh = C4::Context->dbh;
1781 return { dsn => "driver:PostgreSQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1783 elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1784 my $memcached = Koha::Caches->get_instance()->memcached_cache;
1785 return { dsn => "driver:memcached;serializer:yaml;id:md5", dsn_args => { Memcached => $memcached } };
1788 # catch all defaults to tmp should work on all systems
1789 my $dir = C4::Context::temporary_directory;
1790 my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1791 return { dsn => "driver:File;serializer:yaml;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1796 my $sessionID = shift;
1797 my $params = _get_session_params();
1798 return new CGI::Session( $params->{dsn}, $sessionID, $params->{dsn_args} );
1802 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1803 # (or something similar)
1804 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1805 # not having a userenv defined could cause a crash.
1807 my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1808 $type = 'opac' unless $type;
1810 # Get shibboleth login attribute
1811 my $shib = C4::Context->config('useshibboleth') && shib_ok();
1812 my $shib_login = $shib ? get_login_shib() : undef;
1816 if ( defined $userid ){
1817 $patron = Koha::Patrons->find({ userid => $userid });
1818 $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1820 my $check_internal_as_fallback = 0;
1822 # Note: checkpw_* routines returns:
1825 # -1 if user bind failed (LDAP only)
1827 if ( $patron and $patron->account_locked ) {
1828 # Nothing to check, account is locked
1829 } elsif ($ldap && defined($password)) {
1830 $debug and print STDERR "## checkpw - checking LDAP\n";
1831 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
1832 if ( $retval == 1 ) {
1833 @return = ( $retval, $retcard, $retuserid );
1836 $check_internal_as_fallback = 1 if $retval == 0;
1838 } elsif ( $cas && $query && $query->param('ticket') ) {
1839 $debug and print STDERR "## checkpw - checking CAS\n";
1841 # In case of a CAS authentication, we use the ticket instead of the password
1842 my $ticket = $query->param('ticket');
1843 $query->delete('ticket'); # remove ticket to come back to original URL
1844 my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $dbh, $ticket, $query, $type ); # EXTERNAL AUTH
1846 @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1850 $passwd_ok = $retval;
1853 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1854 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1856 elsif ( $shib && $shib_login && !$password ) {
1858 $debug and print STDERR "## checkpw - checking Shibboleth\n";
1860 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1861 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1862 # shibboleth-authenticated user
1864 # Then, we check if it matches a valid koha user
1866 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
1868 @return = ( $retval, $retcard, $retuserid );
1870 $passwd_ok = $retval;
1873 $check_internal_as_fallback = 1;
1877 if ( $check_internal_as_fallback ) {
1878 @return = checkpw_internal( $dbh, $userid, $password, $no_set_userenv);
1879 $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1884 $patron->update({ login_attempts => 0 });
1885 } elsif( !$patron->account_locked ) {
1886 $patron->update({ login_attempts => $patron->login_attempts + 1 });
1892 sub checkpw_internal {
1893 my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
1895 $password = Encode::encode( 'UTF-8', $password )
1896 if Encode::is_utf8($password);
1900 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1902 $sth->execute($userid);
1904 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1905 $surname, $branchcode, $branchname, $flags )
1908 if ( checkpw_hash( $password, $stored_hash ) ) {
1910 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1911 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1912 return 1, $cardnumber, $userid;
1917 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1919 $sth->execute($userid);
1921 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1922 $surname, $branchcode, $branchname, $flags )
1925 if ( checkpw_hash( $password, $stored_hash ) ) {
1927 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1928 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1929 return 1, $cardnumber, $userid;
1936 my ( $password, $stored_hash ) = @_;
1938 return if $stored_hash eq '!';
1940 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1942 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1943 $hash = hash_password( $password, $stored_hash );
1945 $hash = md5_base64($password);
1947 return $hash eq $stored_hash;
1952 my $authflags = getuserflags($flags, $userid, [$dbh]);
1954 Translates integer flags into permissions strings hash.
1956 C<$flags> is the integer userflags value ( borrowers.userflags )
1957 C<$userid> is the members.userid, used for building subpermissions
1958 C<$authflags> is a hashref of permissions
1965 my $dbh = @_ ? shift : C4::Context->dbh;
1968 # I don't want to do this, but if someone logs in as the database
1969 # user, it would be preferable not to spam them to death with
1970 # numeric warnings. So, we make $flags numeric.
1971 no warnings 'numeric';
1974 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1977 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1978 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1979 $userflags->{$flag} = 1;
1982 $userflags->{$flag} = 0;
1986 # get subpermissions and merge with top-level permissions
1987 my $user_subperms = get_user_subpermissions($userid);
1988 foreach my $module ( keys %$user_subperms ) {
1989 next if $userflags->{$module} == 1; # user already has permission for everything in this module
1990 $userflags->{$module} = $user_subperms->{$module};
1996 =head2 get_user_subpermissions
1998 $user_perm_hashref = get_user_subpermissions($userid);
2000 Given the userid (note, not the borrowernumber) of a staff user,
2001 return a hashref of hashrefs of the specific subpermissions
2002 accorded to the user. An example return is
2006 export_catalog => 1,
2007 import_patrons => 1,
2011 The top-level hash-key is a module or function code from
2012 userflags.flag, while the second-level key is a code
2015 The results of this function do not give a complete picture
2016 of the functions that a staff user can access; it is also
2017 necessary to check borrowers.flags.
2021 sub get_user_subpermissions {
2024 my $dbh = C4::Context->dbh;
2025 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2026 FROM user_permissions
2027 JOIN permissions USING (module_bit, code)
2028 JOIN userflags ON (module_bit = bit)
2029 JOIN borrowers USING (borrowernumber)
2030 WHERE userid = ?" );
2031 $sth->execute($userid);
2033 my $user_perms = {};
2034 while ( my $perm = $sth->fetchrow_hashref ) {
2035 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2040 =head2 get_all_subpermissions
2042 my $perm_hashref = get_all_subpermissions();
2044 Returns a hashref of hashrefs defining all specific
2045 permissions currently defined. The return value
2046 has the same structure as that of C<get_user_subpermissions>,
2047 except that the innermost hash value is the description
2048 of the subpermission.
2052 sub get_all_subpermissions {
2053 my $dbh = C4::Context->dbh;
2054 my $sth = $dbh->prepare( "SELECT flag, code
2056 JOIN userflags ON (module_bit = bit)" );
2060 while ( my $perm = $sth->fetchrow_hashref ) {
2061 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2066 =head2 haspermission
2068 $flagsrequired = '*'; # Any permission at all
2069 $flagsrequired = 'a_flag'; # a_flag must be satisfied (all subpermissions)
2070 $flagsrequired = [ 'a_flag', 'b_flag' ]; # a_flag OR b_flag must be satisfied
2071 $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 }; # a_flag AND b_flag must be satisfied
2072 $flagsrequired = { 'a_flag' => 'sub_a' }; # sub_a of a_flag must be satisfied
2073 $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2075 $flags = ($userid, $flagsrequired);
2077 C<$userid> the userid of the member
2078 C<$flags> is a query structure similar to that used by SQL::Abstract that
2079 denotes the combination of flags required. It is a required parameter.
2081 The main logic of this method is that things in arrays are OR'ed, and things
2082 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2084 Returns member's flags or 0 if a permission is not met.
2089 my ($required, $flags) = @_;
2091 my $ref = ref($required);
2093 if ($required eq '*') {
2094 return 0 unless ( $flags or ref( $flags ) );
2096 return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2098 } elsif ($ref eq 'HASH') {
2099 foreach my $key (keys %{$required}) {
2100 next if $flags == 1;
2101 my $require = $required->{$key};
2102 my $rflags = $flags->{$key};
2103 return 0 unless _dispatch($require, $rflags);
2105 } elsif ($ref eq 'ARRAY') {
2107 foreach my $require ( @{$required} ) {
2109 ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2110 ? $flags->{$require}
2112 $satisfied++ if _dispatch( $require, $rflags );
2114 return 0 unless $satisfied;
2116 croak "Unexpected structure found: $ref";
2123 my ( $userid, $flagsrequired ) = @_;
2125 #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2126 # unless defined($flagsrequired);
2128 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2129 $sth->execute($userid);
2130 my $row = $sth->fetchrow();
2131 my $flags = getuserflags( $row, $userid );
2133 return $flags unless defined($flagsrequired);
2134 return $flags if $flags->{superlibrarian};
2135 return _dispatch($flagsrequired, $flags);
2137 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2142 $flags = ($iprange);
2144 C<$iprange> A space separated string describing an IP range. Can include single IPs or ranges
2146 Returns 1 if the remote address is in the provided iprange, or 0 otherwise.
2153 my @allowedipranges = $iprange ? split(' ', $iprange) : ();
2154 if (scalar @allowedipranges > 0) {
2156 eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2157 eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || ( $ENV{DEBUG} && warn 'cidrlookup failed for ' . join(' ',@rangelist) );
2159 return $result ? 1 : 0;
2162 sub getborrowernumber {
2164 my $userenv = C4::Context->userenv;
2165 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2166 return $userenv->{number};
2168 my $dbh = C4::Context->dbh;
2169 for my $field ( 'userid', 'cardnumber' ) {
2171 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2172 $sth->execute($userid);
2174 my ($bnumber) = $sth->fetchrow;
2181 =head2 track_login_daily
2183 track_login_daily( $userid );
2185 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2189 sub track_login_daily {
2191 return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2193 my $cache = Koha::Caches->get_instance();
2194 my $cache_key = "track_login_" . $userid;
2195 my $cached = $cache->get_from_cache($cache_key);
2196 my $today = dt_from_string()->ymd;
2197 return if $cached && $cached eq $today;
2199 my $patron = Koha::Patrons->find({ userid => $userid });
2200 return unless $patron;
2201 $patron->track_login;
2202 $cache->set_in_cache( $cache_key, $today );
2205 END { } # module clean-up code here (global destructor)
2215 Crypt::Eksblowfish::Bcrypt(3)