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 $debug = 1 || $ENV{DEBUG};
62 @EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
63 @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash
64 &get_all_subpermissions &get_user_subpermissions track_login_daily &in_ipset
66 %EXPORT_TAGS = ( EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)] );
67 $ldap = C4::Context->config('useldapserver') || 0;
68 $cas = C4::Context->preference('casAuthentication');
69 $caslogout = C4::Context->preference('casLogout');
70 require C4::Auth_with_cas; # no import
73 require C4::Auth_with_ldap;
74 import C4::Auth_with_ldap qw(checkpw_ldap);
77 import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url logout_if_required);
84 C4::Auth - Authenticates Koha users
94 my ($template, $borrowernumber, $cookie)
95 = get_template_and_user(
97 template_name => "opac-main.tt",
100 authnotrequired => 0,
101 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
105 output_html_with_http_headers $query, $cookie, $template->output;
109 The main function of this module is to provide
110 authentification. However the get_template_and_user function has
111 been provided so that a users login information is passed along
112 automatically. This gets loaded into the template.
116 =head2 get_template_and_user
118 my ($template, $borrowernumber, $cookie)
119 = get_template_and_user(
121 template_name => "opac-main.tt",
124 authnotrequired => 0,
125 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
129 This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
130 to C<&checkauth> (in this module) to perform authentification.
131 See C<&checkauth> for an explanation of these parameters.
133 The C<template_name> is then used to find the correct template for
134 the page. The authenticated users details are loaded onto the
135 template in the logged_in_user variable (which is a Koha::Patron object). Also the
136 C<sessionID> is passed to the template. This can be used in templates
137 if cookies are disabled. It needs to be put as and input to every
140 More information on the C<gettemplate> sub can be found in the
145 sub get_template_and_user {
148 my ( $user, $cookie, $sessionID, $flags );
150 # Get shibboleth login attribute
151 my $shib = C4::Context->config('useshibboleth') && shib_ok();
152 my $shib_login = $shib ? get_login_shib() : undef;
154 C4::Context->interface( $in->{type} );
156 $in->{'authnotrequired'} ||= 0;
158 # the following call includes a bad template check; might croak
159 my $template = C4::Templates::gettemplate(
160 $in->{'template_name'},
165 if ( $in->{'template_name'} !~ m/maintenance/ ) {
166 ( $user, $cookie, $sessionID, $flags ) = checkauth(
168 $in->{'authnotrequired'},
169 $in->{'flagsrequired'},
174 # If we enforce GDPR and the user did not consent, redirect
175 if( $in->{type} eq 'opac' && $user &&
176 $in->{'template_name'} !~ /opac-patron-consent/ &&
177 C4::Context->preference('GDPR_Policy') eq 'Enforced' )
179 my $consent = Koha::Patron::Consents->search({
180 borrowernumber => getborrowernumber($user),
181 type => 'GDPR_PROCESSING',
182 given_on => { '!=', undef },
185 print $in->{query}->redirect(-uri => '/cgi-bin/koha/opac-patron-consent.pl', -cookie => $cookie);
190 if ( $in->{type} eq 'opac' && $user ) {
194 # If the user logged in is the SCO user and they try to go out of the SCO module,
195 # log the user out removing the CGISESSID cookie
196 $in->{template_name} !~ m|sco/| && $in->{template_name} !~ m|errors/errorpage.tt|
197 && C4::Context->preference('AutoSelfCheckID')
198 && $user eq C4::Context->preference('AutoSelfCheckID')
204 # If the user logged in is the SCI user and they try to go out of the SCI module,
205 # kick them out unless it is SCO with a valid permission
206 # or they are a superlibrarian
207 $in->{template_name} !~ m|sci/|
208 && haspermission( $user, { self_check => 'self_checkin_module' } )
210 $in->{template_name} =~ m|sco/| && haspermission(
211 $user, { self_check => 'self_checkout_module' }
214 && $flags && $flags->{superlibrarian} != 1
221 $template = C4::Templates::gettemplate( 'opac-auth.tt', 'opac',
223 $cookie = $in->{query}->cookie(
224 -name => 'CGISESSID',
232 script_name => get_script_name(),
235 print $in->{query}->header(
240 'X-Frame-Options' => 'SAMEORIGIN'
251 # It's possible for $user to be the borrowernumber if they don't have a
252 # userid defined (and are logging in through some other method, such
253 # as SSL certs against an email address)
255 $borrowernumber = getborrowernumber($user) if defined($user);
256 if ( !defined($borrowernumber) && defined($user) ) {
257 $patron = Koha::Patrons->find( $user );
259 $borrowernumber = $user;
261 # A bit of a hack, but I don't know there's a nicer way
263 $user = $patron->firstname . ' ' . $patron->surname;
266 $patron = Koha::Patrons->find( $borrowernumber );
267 # FIXME What to do if $patron does not exist?
271 $template->param( loggedinusername => $user ); # OBSOLETE - Do not reuse this in template, use logged_in_user.userid instead
272 $template->param( loggedinusernumber => $borrowernumber ); # FIXME Should be replaced with logged_in_user.borrowernumber
273 $template->param( logged_in_user => $patron );
274 $template->param( sessionID => $sessionID );
276 if ( $in->{'type'} eq 'opac' ) {
277 require Koha::Virtualshelves;
278 my $some_private_shelves = Koha::Virtualshelves->get_some_shelves(
280 borrowernumber => $borrowernumber,
284 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
290 some_private_shelves => $some_private_shelves,
291 some_public_shelves => $some_public_shelves,
295 my $all_perms = get_all_subpermissions();
297 my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
298 editcatalogue updatecharges tools editauthorities serials reports acquisition clubs);
300 # We are going to use the $flags returned by checkauth
301 # to create the template's parameters that will indicate
302 # which menus the user can access.
303 if ( $flags && $flags->{superlibrarian} == 1 ) {
304 $template->param( CAN_user_circulate => 1 );
305 $template->param( CAN_user_catalogue => 1 );
306 $template->param( CAN_user_parameters => 1 );
307 $template->param( CAN_user_borrowers => 1 );
308 $template->param( CAN_user_permissions => 1 );
309 $template->param( CAN_user_reserveforothers => 1 );
310 $template->param( CAN_user_editcatalogue => 1 );
311 $template->param( CAN_user_updatecharges => 1 );
312 $template->param( CAN_user_acquisition => 1 );
313 $template->param( CAN_user_tools => 1 );
314 $template->param( CAN_user_editauthorities => 1 );
315 $template->param( CAN_user_serials => 1 );
316 $template->param( CAN_user_reports => 1 );
317 $template->param( CAN_user_staffaccess => 1 );
318 $template->param( CAN_user_plugins => 1 );
319 $template->param( CAN_user_coursereserves => 1 );
320 $template->param( CAN_user_clubs => 1 );
321 $template->param( CAN_user_ill => 1 );
322 $template->param( CAN_user_stockrotation => 1 );
324 foreach my $module ( keys %$all_perms ) {
325 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
326 $template->param( "CAN_user_${module}_${subperm}" => 1 );
332 foreach my $module ( keys %$all_perms ) {
333 if ( defined($flags->{$module}) && $flags->{$module} == 1 ) {
334 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
335 $template->param( "CAN_user_${module}_${subperm}" => 1 );
337 } elsif ( ref( $flags->{$module} ) ) {
338 foreach my $subperm ( keys %{ $flags->{$module} } ) {
339 $template->param( "CAN_user_${module}_${subperm}" => 1 );
346 foreach my $module ( keys %$flags ) {
347 if ( $flags->{$module} == 1 or ref( $flags->{$module} ) ) {
348 $template->param( "CAN_user_$module" => 1 );
353 # Logged-in opac search history
354 # If the requested template is an opac one and opac search history is enabled
355 if ( $in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory') ) {
356 my $dbh = C4::Context->dbh;
357 my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
358 my $sth = $dbh->prepare($query);
359 $sth->execute($borrowernumber);
361 # If at least one search has already been performed
362 if ( $sth->fetchrow_array > 0 ) {
364 # We show the link in opac
365 $template->param( EnableOpacSearchHistory => 1 );
367 if (C4::Context->preference('LoadSearchHistoryToTheFirstLoggedUser'))
369 # And if there are searches performed when the user was not logged in,
370 # we add them to the logged-in search history
371 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
372 if (@recentSearches) {
373 my $dbh = C4::Context->dbh;
375 INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, type, total, time )
376 VALUES (?, ?, ?, ?, ?, ?, ?)
378 my $sth = $dbh->prepare($query);
379 $sth->execute( $borrowernumber,
380 $in->{query}->cookie("CGISESSID"),
383 $_->{type} || 'biblio',
386 ) foreach @recentSearches;
388 # clear out the search history from the session now that
389 # we've saved it to the database
392 C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } );
394 } elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) {
395 $template->param( EnableSearchHistory => 1 );
398 else { # if this is an anonymous session, setup to display public lists...
400 # If shibboleth is enabled, and we're in an anonymous session, we should allow
401 # the user to attempt login via shibboleth.
403 $template->param( shibbolethAuthentication => $shib,
404 shibbolethLoginUrl => login_shib_url( $in->{'query'} ),
407 # If shibboleth is enabled and we have a shibboleth login attribute,
408 # but we are in an anonymous session, then we clearly have an invalid
409 # shibboleth koha account.
411 $template->param( invalidShibLogin => '1' );
415 $template->param( sessionID => $sessionID );
417 if ( $in->{'type'} eq 'opac' ){
418 require Koha::Virtualshelves;
419 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
425 some_public_shelves => $some_public_shelves,
430 # Anonymous opac search history
431 # If opac search history is enabled and at least one search has already been performed
432 if ( C4::Context->preference('EnableOpacSearchHistory') ) {
433 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
434 if (@recentSearches) {
435 $template->param( EnableOpacSearchHistory => 1 );
439 if ( C4::Context->preference('dateformat') ) {
440 $template->param( dateformat => C4::Context->preference('dateformat') );
443 $template->param(auth_forwarded_hash => scalar $in->{'query'}->param('auth_forwarded_hash'));
445 # these template parameters are set the same regardless of $in->{'type'}
447 # Set the using_https variable for templates
448 # FIXME Under Plack the CGI->https method always returns 'OFF'
449 my $https = $in->{query}->https();
450 my $using_https = ( defined $https and $https ne 'OFF' ) ? 1 : 0;
452 my $minPasswordLength = C4::Context->preference('minPasswordLength');
453 $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
455 "BiblioDefaultView" . C4::Context->preference("BiblioDefaultView") => 1,
456 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
457 GoogleJackets => C4::Context->preference("GoogleJackets"),
458 OpenLibraryCovers => C4::Context->preference("OpenLibraryCovers"),
459 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
460 LoginBranchcode => ( C4::Context->userenv ? C4::Context->userenv->{"branch"} : undef ),
461 LoginFirstname => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
462 LoginSurname => C4::Context->userenv ? C4::Context->userenv->{"surname"} : "Inconnu",
463 emailaddress => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
464 TagsEnabled => C4::Context->preference("TagsEnabled"),
465 hide_marc => C4::Context->preference("hide_marc"),
466 item_level_itypes => C4::Context->preference('item-level_itypes'),
467 patronimages => C4::Context->preference("patronimages"),
468 singleBranchMode => ( Koha::Libraries->search->count == 1 ),
469 XSLTDetailsDisplay => C4::Context->preference("XSLTDetailsDisplay"),
470 XSLTResultsDisplay => C4::Context->preference("XSLTResultsDisplay"),
471 using_https => $using_https,
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 CircAutocompl => C4::Context->preference("CircAutocompl"),
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 $type = 'opac' unless $type;
793 my $dbh = C4::Context->dbh;
794 my $timeout = _timeout_syspref();
796 _version_check( $type, $query );
801 my ( $userid, $cookie, $sessionID, $flags );
802 my $logout = $query->param('logout.x');
804 my $anon_search_history;
806 # This parameter is the name of the CAS server we want to authenticate against,
807 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
808 my $casparam = $query->param('cas');
809 my $q_userid = $query->param('userid') // '';
813 # Basic authentication is incompatible with the use of Shibboleth,
814 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
815 # and it may not be the attribute we want to use to match the koha login.
817 # Also, do not consider an empty REMOTE_USER.
819 # Finally, after those tests, we can assume (although if it would be better with
820 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
821 # and we can affect it to $userid.
822 =for removed-for-saml
823 if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
825 # Using Basic Authentication, no cookies required
826 $cookie = $query->cookie(
827 -name => 'CGISESSID',
837 use Data::Dump qw(dump);
838 warn "YYY ENV = ",dump( \%ENV );
840 $userid = $ENV{'HTTP_ATTR_CODE'};
841 $sessionID = $query->cookie("CGISESSID");
842 warn "XXX userid = [$userid] sessionID = $sessionID";
845 if ( $sessionID && $userid ) {
846 my $s = get_session($sessionID);
847 if ( $s->param('sessiontype') eq 'anon' ) {
848 undef $sessionID; # remove anonymous session if we have SAML user
849 warn "XXX remote anonymous session";
853 # ($userid,$sessionID) = () if $userid eq '_everyone';
854 # return clear_saml($query) if $userid && $userid eq '_everyone';
858 # create new user from SAML data
859 my $token = $query->cookie('AuthMemCookie');
860 if ( defined($token) ) {
862 use Cache::Memcached;
863 my $memd = new Cache::Memcached { 'servers' => [ '127.0.0.1:11211' ], 'compress_threshold' => 10_000 };
864 if ( my $data = $memd->get($token) ) {
866 warn "XXX AuthMemCookie $token = $data";
869 foreach ( split(/[\n\r]+/,$data) ) {
870 my ($n,$v) = split /=/, $_;
875 $saml->{ATTR_code} =~ m/^\d{10}$/ ? 'S' : # JMBAG
876 $saml->{ATTR_code} =~ m/^\w\w\d+/ ? 'D' :
879 my $cardnumber = $categorycode . $saml->{ATTR_code};
881 if ( my $borrowernumber = getborrowernumber($saml->{ATTR_nick}) ) {
882 warn "SAML login OK $borrowernumber using ATTR_nick: ", $saml->{ATTR_nick};
883 $userid = $saml->{ATTR_nick};
884 } elsif ( $borrowernumber = getborrowernumber( $cardnumber ) ) {
885 warn "SAML login OK $borrowernumber using cardnumber: $cardnumber update userid: $userid";
886 my $sth = $dbh->prepare(qq{ update borrowers set userid = ? where userid = cardnumber and cardnumber = ? });
887 $sth->execute( $userid, $cardnumber );
890 cardnumber => $cardnumber,
891 categorycode => $categorycode,
893 userid => $saml->{ATTR_nick},
894 firstname => $saml->{ATTR_first_name},
895 surname => $saml->{ATTR_last_name},
896 branchcode => 'SRE', # FIXME
897 email => $saml->{ATTR_email},
898 dateexpiry => '2020-12-13',
899 password => $token, # required so AddMember won't erase userid
902 #require C4::Members;
903 #C4::Members::AddMember( %$borrower );
905 my @columns = Koha::Patrons->columns;
906 my $patron = Koha::Patron->new(
908 map { exists( $borrower{$_} ) ? ( $_ => $borrower{$_} ) : () } @columns
911 die "Insert of new patron failed" unless $patron;
912 $borrowernumber = $patron->borrowernumber;
913 C4::Members::Messaging::SetMessagingPreferencesFromDefaults( { borrowernumber => $borrowernumber, categorycode => $borrower{'categorycode'} } );
919 # Create session for SAML user
923 borrowernumber as number,
928 borrowers.branchcode as branch,
929 branches.branchname as branchname,
931 email as emailaddress
933 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
936 my $sth = $dbh->prepare($sql);
937 $sth->execute( $userid );
938 die "can't find $userid" unless $sth->rows;
940 if ( $sessionID = $query->cookie("CGISESSID") ) {
941 warn "AAA updateing existing session $sessionID";
942 $session = get_session($sessionID);
943 C4::Context->_new_userenv($sessionID);
946 $session = get_session('') or die "can't create session";
947 $sessionID = $session->id;
948 C4::Context->_new_userenv($sessionID);
949 warn "AAA created new session $sessionID";
952 $cookie = $query->cookie(
953 -name => 'CGISESSID',
954 -value => $session->id,
958 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
961 warn "ERROR: haspermission $userid ",dump($flagsrequired);
964 my $row = $sth->fetchrow_hashref;
965 # warn "XXX row = ",dump( $row );
967 $session->param( $_ => defined $row->{$_} ? $row->{$_} : '' ) foreach keys %$row;
969 $session->param('flags', $flags);
970 $session->param('ip', $session->remote_addr);
971 $session->param('lasttime',time());
972 $session->param( 'interface', $type);
973 $session->param( 'shibboleth', 1 );
974 $session->param( 'sessiontype', '' ); # XXX not 'anon'
977 C4::Context->set_userenv(
978 $session->param('number'), $session->param('id'),
979 $session->param('cardnumber'), $session->param('firstname'),
980 $session->param('surname'), $session->param('branch'),
981 $session->param('branchname'), $session->param('flags'),
982 $session->param('emailaddress'), $session->param('branchprinter'),
983 $session->param('shibboleth')
986 C4::Context::set_shelves_userenv( 'bar', $session->param('barshelves') );
987 C4::Context::set_shelves_userenv( 'pub', $session->param('pubshelves') );
988 C4::Context::set_shelves_userenv( 'tot', $session->param('totshelves') );
990 warn "DEBUG ",dump( $C4::Context::context->{userenv} );
992 =for old-and-unsupported
993 my $row_count = 10; # FIXME:This probably should be a syspref
994 my ($total, $totshelves, $barshelves, $pubshelves);
995 ($barshelves, $totshelves) = C4::VirtualShelves::GetRecentShelves(1, $row_count, $session->param('number'));
996 $total->{'bartotal'} = $totshelves;
997 ($pubshelves, $totshelves) = C4::VirtualShelves::GetRecentShelves(2, $row_count, undef);
998 $total->{'pubtotal'} = $totshelves;
999 $session->param('barshelves', $barshelves);
1000 $session->param('pubshelves', $pubshelves);
1001 $session->param('totshelves', $total);
1003 C4::Context::set_shelves_userenv('bar',$barshelves);
1004 C4::Context::set_shelves_userenv('pub',$pubshelves);
1005 C4::Context::set_shelves_userenv('tot',$total);
1009 if ( $type eq 'opac' ) {
1010 # TODO path_info isn't correct under plack
1011 my $to = 'https://' . $query->virtual_host . '/' . $query->path_info . '?ferweb_login='.time();
1012 warn "XXX redirect $userid to $to";
1013 print $query->redirect( -uri => $to, -status => 302, -cookie => $cookie );
1015 warn "FAKE, FALLING THROUGH";
1020 warn "ERROR: Can't find SAML token $token for user $userid\n";
1023 warn "XXX-11 userid = $userid sessionID = $sessionID";
1025 #XXX END OF SAML MODIFICATIONS -- next line is elsif!
1027 elsif ( $emailaddress) {
1028 # the Google OpenID Connect passes an email address
1030 elsif ( $sessionID = $query->cookie("CGISESSID") )
1031 { # assignment, not comparison
1032 $session = get_session($sessionID);
1033 #warn "XXX-9001 sessionID = $sessionID session =", dump( $session );
1034 C4::Context->_new_userenv($sessionID);
1035 my ( $ip, $lasttime, $sessiontype );
1038 $s_userid = $session->param('id') // '';
1039 C4::Context->set_userenv(
1040 $session->param('number'), $s_userid,
1041 $session->param('cardnumber'), $session->param('firstname'),
1042 $session->param('surname'), $session->param('branch'),
1043 $session->param('branchname'), $session->param('flags'),
1044 $session->param('emailaddress'), $session->param('branchprinter'),
1045 $session->param('shibboleth')
1047 C4::Context::set_shelves_userenv( 'bar', $session->param('barshelves') );
1048 C4::Context::set_shelves_userenv( 'pub', $session->param('pubshelves') );
1049 C4::Context::set_shelves_userenv( 'tot', $session->param('totshelves') );
1050 $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1051 $ip = $session->param('ip');
1052 $lasttime = $session->param('lasttime');
1053 $userid = $s_userid;
1054 $sessiontype = $session->param('sessiontype') || '';
1056 if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
1057 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
1058 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
1061 #if a user enters an id ne to the id in the current session, we need to log them in...
1062 #first we need to clear the anonymous session...
1063 $debug and warn "query id = $q_userid but session id = $s_userid";
1064 $anon_search_history = $session->param('search_history');
1067 C4::Context->_unset_userenv($sessionID);
1070 warn "FLUSH session query id = $q_userid but session id = $s_userid";
1074 # voluntary logout the user
1075 # check wether the user was using their shibboleth session or a local one
1076 my $shibSuccess = C4::Context->userenv->{'shibboleth'};
1079 C4::Context->_unset_userenv($sessionID);
1080 warn "FLUSH session logout $sessionID";
1082 #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
1086 if ($cas and $caslogout) {
1087 logout_cas($query, $type);
1090 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
1091 if ( $shib and $shib_login and $shibSuccess) {
1092 logout_shib($query);
1095 elsif ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
1098 $info{'timed_out'} = 1;
1103 C4::Context->_unset_userenv($sessionID);
1105 #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
1108 warn "XXX-LOGOUT lasttime $lasttime";
1110 elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1112 # Different ip than originally logged in from
1113 $info{'oldip'} = $ip;
1114 $info{'newip'} = $ENV{'REMOTE_ADDR'};
1115 $info{'different_ip'} = 1;
1118 C4::Context->_unset_userenv($sessionID);
1120 #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
1123 warn "XXX-LOGOUT ip $ip";
1126 warn "XXX-new-cookie";
1127 $cookie = $query->cookie(
1128 -name => 'CGISESSID',
1129 -value => $session->id,
1132 $session->param( 'lasttime', time() );
1133 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...
1134 $flags = haspermission( $userid, $flagsrequired );
1135 # warn "XXX flags = ",dump( $flags );
1139 $info{'nopermission'} = 1;
1144 warn "XXX-11 userid = $userid sessionID = $sessionID ", defined $session ? $session->id : '';
1146 unless ( $userid || $sessionID ) {
1147 warn "XXX-30 userid = $userid sessionID = $sessionID";
1148 #we initiate a session prior to checking for a username to allow for anonymous sessions...
1149 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
1151 # Save anonymous search history in new session so it can be retrieved
1152 # by get_template_and_user to store it in user's search history after
1153 # a successful login.
1154 if ($anon_search_history) {
1155 $session->param( 'search_history', $anon_search_history );
1158 $sessionID = $session->id;
1159 C4::Context->_new_userenv($sessionID);
1160 $cookie = $query->cookie(
1161 -name => 'CGISESSID',
1162 -value => $session->id,
1165 my $pki_field = C4::Context->preference('AllowPKIAuth');
1166 if ( !defined($pki_field) ) {
1167 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
1168 $pki_field = 'None';
1170 if ( ( $cas && $query->param('ticket') )
1172 || ( $shib && $shib_login )
1173 || $pki_field ne 'None'
1176 my $password = $query->param('password');
1177 my $shibSuccess = 0;
1178 my ( $return, $cardnumber );
1180 # If shib is enabled and we have a shib login, does the login match a valid koha user
1181 if ( $shib && $shib_login ) {
1184 # Do not pass password here, else shib will not be checked in checkpw.
1185 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $q_userid, undef, $query );
1186 $userid = $retuserid;
1187 $shibSuccess = $return;
1188 $info{'invalidShibLogin'} = 1 unless ($return);
1191 # If shib login and match were successful, skip further login methods
1192 unless ($shibSuccess) {
1193 if ( $cas && $query->param('ticket') ) {
1195 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1196 checkpw( $dbh, $userid, $password, $query, $type );
1197 $userid = $retuserid;
1198 $info{'invalidCasLogin'} = 1 unless ($return);
1201 elsif ( $emailaddress ) {
1202 my $value = $emailaddress;
1204 # If we're looking up the email, there's a chance that the person
1205 # doesn't have a userid. So if there is none, we pass along the
1206 # borrower number, and the bits of code that need to know the user
1207 # ID will have to be smart enough to handle that.
1208 my $patrons = Koha::Patrons->search({ email => $value });
1209 if ($patrons->count) {
1211 # First the userid, then the borrowernum
1212 my $patron = $patrons->next;
1213 $value = $patron->userid || $patron->borrowernumber;
1217 $return = $value ? 1 : 0;
1222 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1223 || ( $pki_field eq 'emailAddress'
1224 && $ENV{'SSL_CLIENT_S_DN_Email'} )
1228 if ( $pki_field eq 'Common Name' ) {
1229 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1231 elsif ( $pki_field eq 'emailAddress' ) {
1232 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1234 # If we're looking up the email, there's a chance that the person
1235 # doesn't have a userid. So if there is none, we pass along the
1236 # borrower number, and the bits of code that need to know the user
1237 # ID will have to be smart enough to handle that.
1238 my $patrons = Koha::Patrons->search({ email => $value });
1239 if ($patrons->count) {
1241 # First the userid, then the borrowernum
1242 my $patron = $patrons->next;
1243 $value = $patron->userid || $patron->borrowernumber;
1249 $return = $value ? 1 : 0;
1255 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1256 checkpw( $dbh, $q_userid, $password, $query, $type );
1257 $userid = $retuserid if ($retuserid);
1258 $info{'invalid_username_or_password'} = 1 unless ($return);
1262 # $return: 1 = valid user
1265 #_session_log(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
1266 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1270 $info{'nopermission'} = 1;
1271 C4::Context->_unset_userenv($sessionID);
1273 my ( $borrowernumber, $firstname, $surname, $userflags,
1274 $branchcode, $branchname, $branchprinter, $emailaddress );
1276 if ( $return == 1 ) {
1278 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1279 branches.branchname as branchname,
1280 branches.branchprinter as branchprinter,
1283 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1285 my $sth = $dbh->prepare("$select where userid=?");
1286 $sth->execute($userid);
1287 unless ( $sth->rows ) {
1288 $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
1289 $sth = $dbh->prepare("$select where cardnumber=?");
1290 $sth->execute($cardnumber);
1292 unless ( $sth->rows ) {
1293 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1294 $sth->execute($userid);
1295 unless ( $sth->rows ) {
1296 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1301 ( $borrowernumber, $firstname, $surname, $userflags,
1302 $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow;
1303 $debug and print STDERR "AUTH_3 results: " .
1304 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1306 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1309 # launch a sequence to check if we have a ip for the branch, i
1310 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1312 my $ip = $ENV{'REMOTE_ADDR'};
1314 # if they specify at login, use that
1315 if ( $query->param('branch') ) {
1316 $branchcode = $query->param('branch');
1317 my $library = Koha::Libraries->find($branchcode);
1318 $branchname = $library? $library->branchname: '';
1320 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1321 if ( $type ne 'opac' and C4::Context->boolean_preference('AutoLocation') ) {
1323 # we have to check they are coming from the right ip range
1324 my $domain = $branches->{$branchcode}->{'branchip'};
1325 $domain =~ s|\.\*||g;
1326 if ( $ip !~ /^$domain/ ) {
1328 $cookie = $query->cookie(
1329 -name => 'CGISESSID',
1333 $info{'wrongip'} = 1;
1337 foreach my $br ( keys %$branches ) {
1339 # now we work with the treatment of ip
1340 my $domain = $branches->{$br}->{'branchip'};
1341 if ( $domain && $ip =~ /^$domain/ ) {
1342 $branchcode = $branches->{$br}->{'branchcode'};
1344 # new op dev : add the branchprinter and branchname in the cookie
1345 $branchprinter = $branches->{$br}->{'branchprinter'};
1346 $branchname = $branches->{$br}->{'branchname'};
1349 $session->param( 'number', $borrowernumber );
1350 $session->param( 'id', $userid );
1351 $session->param( 'cardnumber', $cardnumber );
1352 $session->param( 'firstname', $firstname );
1353 $session->param( 'surname', $surname );
1354 $session->param( 'branch', $branchcode );
1355 $session->param( 'branchname', $branchname );
1356 $session->param( 'flags', $userflags );
1357 $session->param( 'emailaddress', $emailaddress );
1358 $session->param( 'ip', $session->remote_addr() );
1359 $session->param( 'lasttime', time() );
1360 $session->param( 'interface', $type);
1361 $session->param( 'shibboleth', $shibSuccess );
1362 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1364 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1365 C4::Context->set_userenv(
1366 $session->param('number'), $session->param('id'),
1367 $session->param('cardnumber'), $session->param('firstname'),
1368 $session->param('surname'), $session->param('branch'),
1369 $session->param('branchname'), $session->param('flags'),
1370 $session->param('emailaddress'), $session->param('branchprinter'),
1371 $session->param('shibboleth')
1375 # $return: 0 = invalid user
1376 # reset to anonymous session
1378 $debug and warn "Login failed, resetting anonymous session...";
1380 $info{'invalid_username_or_password'} = 1;
1381 C4::Context->_unset_userenv($sessionID);
1383 $session->param( 'lasttime', time() );
1384 $session->param( 'ip', $session->remote_addr() );
1385 $session->param( 'sessiontype', 'anon' );
1386 $session->param( 'interface', $type);
1388 } # END if ( $q_userid
1389 elsif ( $type eq "opac" ) {
1391 # if we are here this is an anonymous session; add public lists to it and a few other items...
1392 # anonymous sessions are created only for the OPAC
1393 $debug and warn "Initiating an anonymous session...";
1395 # setting a couple of other session vars...
1396 $session->param( 'ip', $session->remote_addr() );
1397 $session->param( 'lasttime', time() );
1398 $session->param( 'sessiontype', 'anon' );
1399 $session->param( 'interface', $type);
1401 } # END unless ($userid)
1403 # warn "XXX-44 userid = $userid cookie = ",dump( $cookie ), " sessionID = $sessionID loggedin = $loggedin flags = $flags";
1404 # finished authentification, now respond
1405 if ( $loggedin || $authnotrequired )
1409 $cookie = $query->cookie(
1410 -name => 'CGISESSID',
1417 track_login_daily( $userid );
1418 #warn "XXX session = ",dump($session);
1419 #warn "XXX userenv = ",dump( C4::Context->userenv );
1420 # warn "XXX RETURN = ", dump( $userid, $cookie, $sessionID, $flags );
1421 return ( $userid, $cookie, $sessionID, $flags );
1426 # AUTH rejected, show the login/password template, after checking the DB.
1430 # get the inputs from the incoming query
1432 foreach my $name ( param $query) {
1433 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1434 my @value = $query->multi_param($name);
1435 push @inputs, { name => $name, value => $_ } for @value;
1438 my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1440 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1441 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1442 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1444 my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1445 my $template = C4::Templates::gettemplate( $template_name, $type, $query );
1449 script_name => get_script_name(),
1450 casAuthentication => C4::Context->preference("casAuthentication"),
1451 shibbolethAuthentication => $shib,
1452 SessionRestrictionByIP => C4::Context->preference("SessionRestrictionByIP"),
1453 suggestion => C4::Context->preference("suggestion"),
1454 virtualshelves => C4::Context->preference("virtualshelves"),
1455 LibraryName => "" . C4::Context->preference("LibraryName"),
1456 LibraryNameTitle => "" . $LibraryNameTitle,
1457 opacuserlogin => C4::Context->preference("opacuserlogin"),
1458 OpacNav => C4::Context->preference("OpacNav"),
1459 OpacNavBottom => C4::Context->preference("OpacNavBottom"),
1460 opaccredits => C4::Context->preference("opaccredits"),
1461 OpacFavicon => C4::Context->preference("OpacFavicon"),
1462 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1463 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1464 OPACUserJS => C4::Context->preference("OPACUserJS"),
1465 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1466 OpacCloud => C4::Context->preference("OpacCloud"),
1467 OpacTopissue => C4::Context->preference("OpacTopissue"),
1468 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1469 OpacBrowser => C4::Context->preference("OpacBrowser"),
1470 opacheader => C4::Context->preference("opacheader"),
1471 TagsEnabled => C4::Context->preference("TagsEnabled"),
1472 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1473 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1474 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1475 intranetbookbag => C4::Context->preference("intranetbookbag"),
1476 IntranetNav => C4::Context->preference("IntranetNav"),
1477 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1478 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
1479 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1480 IndependentBranches => C4::Context->preference("IndependentBranches"),
1481 AutoLocation => C4::Context->preference("AutoLocation"),
1482 wrongip => $info{'wrongip'},
1483 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1484 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1485 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1486 too_many_login_attempts => ( $patron and $patron->account_locked )
1489 $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1490 $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1491 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1492 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1494 if ( $type eq 'opac' ) {
1495 require Koha::Virtualshelves;
1496 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1502 some_public_shelves => $some_public_shelves,
1508 # Is authentication against multiple CAS servers enabled?
1509 if ( C4::Auth_with_cas::multipleAuth && !$casparam ) {
1510 my $casservers = C4::Auth_with_cas::getMultipleAuth();
1512 foreach my $key ( keys %$casservers ) {
1513 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1516 casServersLoop => \@tmplservers
1520 casServerUrl => login_cas_url($query, undef, $type),
1525 invalidCasLogin => $info{'invalidCasLogin'}
1531 shibbolethAuthentication => $shib,
1532 shibbolethLoginUrl => login_shib_url($query),
1536 if (C4::Context->preference('GoogleOpenIDConnect')) {
1537 if ($query->param("OpenIDConnectFailed")) {
1538 my $reason = $query->param('OpenIDConnectFailed');
1539 $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1544 LibraryName => C4::Context->preference("LibraryName"),
1546 $template->param(%info);
1548 # $cookie = $query->cookie(CGISESSID => $session->id
1550 print $query->header(
1551 { type => 'text/html',
1554 'X-Frame-Options' => 'SAMEORIGIN'
1561 =head2 check_api_auth
1563 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1565 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1566 cookie, determine if the user has the privileges specified by C<$userflags>.
1568 C<check_api_auth> is is meant for authenticating users of web services, and
1569 consequently will always return and will not attempt to redirect the user
1572 If a valid session cookie is already present, check_api_auth will return a status
1573 of "ok", the cookie, and the Koha session ID.
1575 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1576 parameters and create a session cookie and Koha session if the supplied credentials
1579 Possible return values in C<$status> are:
1583 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1585 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1587 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1589 =item "expired -- session cookie has expired; API user should resubmit userid and password
1595 sub check_api_auth {
1598 my $flagsrequired = shift;
1599 my $dbh = C4::Context->dbh;
1600 my $timeout = _timeout_syspref();
1602 unless ( C4::Context->preference('Version') ) {
1604 # database has not been installed yet
1605 return ( "maintenance", undef, undef );
1607 my $kohaversion = Koha::version();
1608 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1609 if ( C4::Context->preference('Version') < $kohaversion ) {
1611 # database in need of version update; assume that
1612 # no API should be called while databsae is in
1614 return ( "maintenance", undef, undef );
1617 # FIXME -- most of what follows is a copy-and-paste
1618 # of code from checkauth. There is an obvious need
1619 # for refactoring to separate the various parts of
1620 # the authentication code, but as of 2007-11-19 this
1621 # is deferred so as to not introduce bugs into the
1622 # regular authentication code for Koha 3.0.
1624 # see if we have a valid session cookie already
1625 # however, if a userid parameter is present (i.e., from
1626 # a form submission, assume that any current cookie
1628 my $sessionID = undef;
1629 unless ( $query->param('userid') ) {
1630 $sessionID = $query->cookie("CGISESSID");
1632 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1633 my $session = get_session($sessionID);
1634 C4::Context->_new_userenv($sessionID);
1636 C4::Context->interface($session->param('interface'));
1637 C4::Context->set_userenv(
1638 $session->param('number'), $session->param('id'),
1639 $session->param('cardnumber'), $session->param('firstname'),
1640 $session->param('surname'), $session->param('branch'),
1641 $session->param('branchname'), $session->param('flags'),
1642 $session->param('emailaddress'), $session->param('branchprinter')
1645 my $ip = $session->param('ip');
1646 my $lasttime = $session->param('lasttime');
1647 my $userid = $session->param('id');
1648 if ( $lasttime < time() - $timeout ) {
1653 C4::Context->_unset_userenv($sessionID);
1656 return ( "expired", undef, undef );
1657 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1659 # IP address changed
1662 C4::Context->_unset_userenv($sessionID);
1665 return ( "expired", undef, undef );
1667 my $cookie = $query->cookie(
1668 -name => 'CGISESSID',
1669 -value => $session->id,
1672 $session->param( 'lasttime', time() );
1673 my $flags = haspermission( $userid, $flagsrequired );
1675 return ( "ok", $cookie, $sessionID );
1679 C4::Context->_unset_userenv($sessionID);
1682 return ( "failed", undef, undef );
1686 return ( "expired", undef, undef );
1691 my $userid = $query->param('userid');
1692 my $password = $query->param('password');
1693 my ( $return, $cardnumber, $cas_ticket );
1696 if ( $cas && $query->param('PT') ) {
1698 $debug and print STDERR "## check_api_auth - checking CAS\n";
1700 # In case of a CAS authentication, we use the ticket instead of the password
1701 my $PT = $query->param('PT');
1702 ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $dbh, $PT, $query ); # EXTERNAL AUTH
1705 # User / password auth
1706 unless ( $userid and $password ) {
1708 # caller did something wrong, fail the authenticateion
1709 return ( "failed", undef, undef );
1712 ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $dbh, $userid, $password, $query );
1715 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1716 my $session = get_session("");
1717 return ( "failed", undef, undef ) unless $session;
1719 my $sessionID = $session->id;
1720 C4::Context->_new_userenv($sessionID);
1721 my $cookie = $query->cookie(
1722 -name => 'CGISESSID',
1723 -value => $sessionID,
1726 if ( $return == 1 ) {
1728 $borrowernumber, $firstname, $surname,
1729 $userflags, $branchcode, $branchname,
1730 $branchprinter, $emailaddress
1734 "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=?"
1736 $sth->execute($userid);
1738 $borrowernumber, $firstname, $surname,
1739 $userflags, $branchcode, $branchname,
1740 $branchprinter, $emailaddress
1741 ) = $sth->fetchrow if ( $sth->rows );
1743 unless ( $sth->rows ) {
1744 my $sth = $dbh->prepare(
1745 "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=?"
1747 $sth->execute($cardnumber);
1749 $borrowernumber, $firstname, $surname,
1750 $userflags, $branchcode, $branchname,
1751 $branchprinter, $emailaddress
1752 ) = $sth->fetchrow if ( $sth->rows );
1754 unless ( $sth->rows ) {
1755 $sth->execute($userid);
1757 $borrowernumber, $firstname, $surname, $userflags,
1758 $branchcode, $branchname, $branchprinter, $emailaddress
1759 ) = $sth->fetchrow if ( $sth->rows );
1763 my $ip = $ENV{'REMOTE_ADDR'};
1765 # if they specify at login, use that
1766 if ( $query->param('branch') ) {
1767 $branchcode = $query->param('branch');
1768 my $library = Koha::Libraries->find($branchcode);
1769 $branchname = $library? $library->branchname: '';
1771 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1772 foreach my $br ( keys %$branches ) {
1774 # now we work with the treatment of ip
1775 my $domain = $branches->{$br}->{'branchip'};
1776 if ( $domain && $ip =~ /^$domain/ ) {
1777 $branchcode = $branches->{$br}->{'branchcode'};
1779 # new op dev : add the branchprinter and branchname in the cookie
1780 $branchprinter = $branches->{$br}->{'branchprinter'};
1781 $branchname = $branches->{$br}->{'branchname'};
1784 $session->param( 'number', $borrowernumber );
1785 $session->param( 'id', $userid );
1786 $session->param( 'cardnumber', $cardnumber );
1787 $session->param( 'firstname', $firstname );
1788 $session->param( 'surname', $surname );
1789 $session->param( 'branch', $branchcode );
1790 $session->param( 'branchname', $branchname );
1791 $session->param( 'flags', $userflags );
1792 $session->param( 'emailaddress', $emailaddress );
1793 $session->param( 'ip', $session->remote_addr() );
1794 $session->param( 'lasttime', time() );
1795 $session->param( 'interface', 'api' );
1797 $session->param( 'cas_ticket', $cas_ticket);
1798 C4::Context->set_userenv(
1799 $session->param('number'), $session->param('id'),
1800 $session->param('cardnumber'), $session->param('firstname'),
1801 $session->param('surname'), $session->param('branch'),
1802 $session->param('branchname'), $session->param('flags'),
1803 $session->param('emailaddress'), $session->param('branchprinter')
1805 return ( "ok", $cookie, $sessionID );
1807 return ( "failed", undef, undef );
1812 =head2 check_cookie_auth
1814 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1816 Given a CGISESSID cookie set during a previous login to Koha, determine
1817 if the user has the privileges specified by C<$userflags>. C<$userflags>
1818 is passed unaltered into C<haspermission> and as such accepts all options
1819 avaiable to that routine with the one caveat that C<check_api_auth> will
1820 also allow 'undef' to be passed and in such a case the permissions check
1821 will be skipped altogether.
1823 C<check_cookie_auth> is meant for authenticating special services
1824 such as tools/upload-file.pl that are invoked by other pages that
1825 have been authenticated in the usual way.
1827 Possible return values in C<$status> are:
1831 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1833 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1835 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1837 =item "expired -- session cookie has expired; API user should resubmit userid and password
1843 sub check_cookie_auth {
1845 my $flagsrequired = shift;
1848 my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1849 my $dbh = C4::Context->dbh;
1850 my $timeout = _timeout_syspref();
1852 unless ( C4::Context->preference('Version') ) {
1854 # database has not been installed yet
1855 return ( "maintenance", undef );
1857 my $kohaversion = Koha::version();
1858 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1859 if ( C4::Context->preference('Version') < $kohaversion ) {
1861 # database in need of version update; assume that
1862 # no API should be called while databsae is in
1864 return ( "maintenance", undef );
1867 # FIXME -- most of what follows is a copy-and-paste
1868 # of code from checkauth. There is an obvious need
1869 # for refactoring to separate the various parts of
1870 # the authentication code, but as of 2007-11-23 this
1871 # is deferred so as to not introduce bugs into the
1872 # regular authentication code for Koha 3.0.
1874 # see if we have a valid session cookie already
1875 # however, if a userid parameter is present (i.e., from
1876 # a form submission, assume that any current cookie
1878 unless ( defined $cookie and $cookie ) {
1879 return ( "failed", undef );
1881 my $sessionID = $cookie;
1882 my $session = get_session($sessionID);
1883 C4::Context->_new_userenv($sessionID);
1885 C4::Context->interface($session->param('interface'));
1886 C4::Context->set_userenv(
1887 $session->param('number'), $session->param('id'),
1888 $session->param('cardnumber'), $session->param('firstname'),
1889 $session->param('surname'), $session->param('branch'),
1890 $session->param('branchname'), $session->param('flags'),
1891 $session->param('emailaddress'), $session->param('branchprinter')
1894 my $ip = $session->param('ip');
1895 my $lasttime = $session->param('lasttime');
1896 my $userid = $session->param('id');
1897 if ( $lasttime < time() - $timeout ) {
1902 C4::Context->_unset_userenv($sessionID);
1905 return ("expired", undef);
1906 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1908 # IP address changed
1911 C4::Context->_unset_userenv($sessionID);
1914 return ( "expired", undef );
1916 $session->param( 'lasttime', time() );
1917 my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1919 return ( "ok", $sessionID );
1923 C4::Context->_unset_userenv($sessionID);
1926 return ( "failed", undef );
1930 return ( "expired", undef );
1937 my $session = get_session($sessionID);
1939 Given a session ID, retrieve the CGI::Session object used to store
1940 the session's state. The session object can be used to store
1941 data that needs to be accessed by different scripts during a
1944 If the C<$sessionID> parameter is an empty string, a new session
1949 sub _get_session_params {
1950 my $storage_method = C4::Context->preference('SessionStorage');
1951 if ( $storage_method eq 'mysql' ) {
1952 my $dbh = C4::Context->dbh;
1953 return { dsn => "driver:MySQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1955 elsif ( $storage_method eq 'Pg' ) {
1956 my $dbh = C4::Context->dbh;
1957 return { dsn => "driver:PostgreSQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1959 elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1960 my $memcached = Koha::Caches->get_instance()->memcached_cache;
1961 return { dsn => "driver:memcached;serializer:yaml;id:md5", dsn_args => { Memcached => $memcached } };
1964 # catch all defaults to tmp should work on all systems
1965 my $dir = C4::Context::temporary_directory;
1966 my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1967 return { dsn => "driver:File;serializer:yaml;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1972 my $sessionID = shift;
1973 my $params = _get_session_params();
1974 return new CGI::Session( $params->{dsn}, $sessionID, $params->{dsn_args} );
1978 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1979 # (or something similar)
1980 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1981 # not having a userenv defined could cause a crash.
1983 my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1984 $type = 'opac' unless $type;
1986 # Get shibboleth login attribute
1987 my $shib = C4::Context->config('useshibboleth') && shib_ok();
1988 my $shib_login = $shib ? get_login_shib() : undef;
1991 my $patron = Koha::Patrons->find({ userid => $userid });
1992 $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1993 my $check_internal_as_fallback = 0;
1995 # Note: checkpw_* routines returns:
1998 # -1 if user bind failed (LDAP only)
2000 if ( $patron and $patron->account_locked ) {
2001 # Nothing to check, account is locked
2002 } elsif ($ldap && defined($password)) {
2003 $debug and print STDERR "## checkpw - checking LDAP\n";
2004 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
2005 if ( $retval == 1 ) {
2006 @return = ( $retval, $retcard, $retuserid );
2009 $check_internal_as_fallback = 1 if $retval == 0;
2011 } elsif ( $cas && $query && $query->param('ticket') ) {
2012 $debug and print STDERR "## checkpw - checking CAS\n";
2014 # In case of a CAS authentication, we use the ticket instead of the password
2015 my $ticket = $query->param('ticket');
2016 $query->delete('ticket'); # remove ticket to come back to original URL
2017 my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $dbh, $ticket, $query, $type ); # EXTERNAL AUTH
2019 @return = ( $retval, $retcard, $retuserid, $cas_ticket );
2023 $passwd_ok = $retval;
2026 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
2027 # Check for password to asertain whether we want to be testing against shibboleth or another method this
2029 elsif ( $shib && $shib_login && !$password ) {
2031 $debug and print STDERR "## checkpw - checking Shibboleth\n";
2033 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
2034 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
2035 # shibboleth-authenticated user
2037 # Then, we check if it matches a valid koha user
2039 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
2041 @return = ( $retval, $retcard, $retuserid );
2043 $passwd_ok = $retval;
2046 $check_internal_as_fallback = 1;
2050 if ( $check_internal_as_fallback ) {
2051 @return = checkpw_internal( $dbh, $userid, $password, $no_set_userenv);
2052 $passwd_ok = 1 if $return[0] > 0; # 1 or 2
2057 $patron->update({ login_attempts => 0 });
2058 } elsif( !$patron->account_locked ) {
2059 $patron->update({ login_attempts => $patron->login_attempts + 1 });
2065 sub checkpw_internal {
2066 my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
2068 $password = Encode::encode( 'UTF-8', $password )
2069 if Encode::is_utf8($password);
2073 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
2075 $sth->execute($userid);
2077 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
2078 $surname, $branchcode, $branchname, $flags )
2081 if ( checkpw_hash( $password, $stored_hash ) ) {
2083 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
2084 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
2085 return 1, $cardnumber, $userid;
2090 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
2092 $sth->execute($userid);
2094 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
2095 $surname, $branchcode, $branchname, $flags )
2098 if ( checkpw_hash( $password, $stored_hash ) ) {
2100 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
2101 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
2102 return 1, $cardnumber, $userid;
2109 my ( $password, $stored_hash ) = @_;
2111 return if $stored_hash eq '!';
2113 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
2115 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
2116 $hash = hash_password( $password, $stored_hash );
2118 $hash = md5_base64($password);
2120 return $hash eq $stored_hash;
2125 my $authflags = getuserflags($flags, $userid, [$dbh]);
2127 Translates integer flags into permissions strings hash.
2129 C<$flags> is the integer userflags value ( borrowers.userflags )
2130 C<$userid> is the members.userid, used for building subpermissions
2131 C<$authflags> is a hashref of permissions
2138 my $dbh = @_ ? shift : C4::Context->dbh;
2141 # I don't want to do this, but if someone logs in as the database
2142 # user, it would be preferable not to spam them to death with
2143 # numeric warnings. So, we make $flags numeric.
2144 no warnings 'numeric';
2147 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
2150 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
2151 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
2152 $userflags->{$flag} = 1;
2155 $userflags->{$flag} = 0;
2159 # get subpermissions and merge with top-level permissions
2160 my $user_subperms = get_user_subpermissions($userid);
2161 foreach my $module ( keys %$user_subperms ) {
2162 next if $userflags->{$module} == 1; # user already has permission for everything in this module
2163 $userflags->{$module} = $user_subperms->{$module};
2169 =head2 get_user_subpermissions
2171 $user_perm_hashref = get_user_subpermissions($userid);
2173 Given the userid (note, not the borrowernumber) of a staff user,
2174 return a hashref of hashrefs of the specific subpermissions
2175 accorded to the user. An example return is
2179 export_catalog => 1,
2180 import_patrons => 1,
2184 The top-level hash-key is a module or function code from
2185 userflags.flag, while the second-level key is a code
2188 The results of this function do not give a complete picture
2189 of the functions that a staff user can access; it is also
2190 necessary to check borrowers.flags.
2194 sub get_user_subpermissions {
2197 my $dbh = C4::Context->dbh;
2198 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2199 FROM user_permissions
2200 JOIN permissions USING (module_bit, code)
2201 JOIN userflags ON (module_bit = bit)
2202 JOIN borrowers USING (borrowernumber)
2203 WHERE userid = ?" );
2204 $sth->execute($userid);
2206 my $user_perms = {};
2207 while ( my $perm = $sth->fetchrow_hashref ) {
2208 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2213 =head2 get_all_subpermissions
2215 my $perm_hashref = get_all_subpermissions();
2217 Returns a hashref of hashrefs defining all specific
2218 permissions currently defined. The return value
2219 has the same structure as that of C<get_user_subpermissions>,
2220 except that the innermost hash value is the description
2221 of the subpermission.
2225 sub get_all_subpermissions {
2226 my $dbh = C4::Context->dbh;
2227 my $sth = $dbh->prepare( "SELECT flag, code
2229 JOIN userflags ON (module_bit = bit)" );
2233 while ( my $perm = $sth->fetchrow_hashref ) {
2234 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2239 =head2 haspermission
2241 $flagsrequired = '*'; # Any permission at all
2242 $flagsrequired = 'a_flag'; # a_flag must be satisfied (all subpermissions)
2243 $flagsrequired = [ 'a_flag', 'b_flag' ]; # a_flag OR b_flag must be satisfied
2244 $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 }; # a_flag AND b_flag must be satisfied
2245 $flagsrequired = { 'a_flag' => 'sub_a' }; # sub_a of a_flag must be satisfied
2246 $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2248 $flags = ($userid, $flagsrequired);
2250 C<$userid> the userid of the member
2251 C<$flags> is a query structure similar to that used by SQL::Abstract that
2252 denotes the combination of flags required. It is a required parameter.
2254 The main logic of this method is that things in arrays are OR'ed, and things
2255 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2257 Returns member's flags or 0 if a permission is not met.
2262 my ($required, $flags) = @_;
2264 my $ref = ref($required);
2266 if ($required eq '*') {
2267 return 0 unless ( $flags or ref( $flags ) );
2269 return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2271 } elsif ($ref eq 'HASH') {
2272 foreach my $key (keys %{$required}) {
2273 next if $flags == 1;
2274 my $require = $required->{$key};
2275 my $rflags = $flags->{$key};
2276 return 0 unless _dispatch($require, $rflags);
2278 } elsif ($ref eq 'ARRAY') {
2280 foreach my $require ( @{$required} ) {
2282 ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2283 ? $flags->{$require}
2285 $satisfied++ if _dispatch( $require, $rflags );
2287 return 0 unless $satisfied;
2289 croak "Unexpected structure found: $ref";
2296 my ( $userid, $flagsrequired ) = @_;
2298 #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2299 # unless defined($flagsrequired);
2301 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2302 $sth->execute($userid);
2303 my $row = $sth->fetchrow();
2304 my $flags = getuserflags( $row, $userid );
2306 return $flags unless defined($flagsrequired);
2307 return $flags if $flags->{superlibrarian};
2308 return _dispatch($flagsrequired, $flags);
2310 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2317 C<$ipset> A space separated string describing an IP set. Can include single IPs or ranges
2319 Returns 1 if the remote address is in the provided ipset, or 0 otherwise.
2326 my @allowedipranges = $ipset ? split(' ', $ipset) : ();
2327 if (scalar @allowedipranges > 0) {
2329 eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2330 eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || ( $ENV{DEBUG} && warn 'cidrlookup failed for ' . join(' ',@rangelist) );
2332 return $result ? 1 : 0;
2335 sub getborrowernumber {
2337 my $userenv = C4::Context->userenv;
2338 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2339 return $userenv->{number};
2341 my $dbh = C4::Context->dbh;
2342 for my $field ( 'userid', 'cardnumber' ) {
2344 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2345 $sth->execute($userid);
2347 my ($bnumber) = $sth->fetchrow;
2354 =head2 track_login_daily
2356 track_login_daily( $userid );
2358 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2362 sub track_login_daily {
2364 return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2366 my $cache = Koha::Caches->get_instance();
2367 my $cache_key = "track_login_" . $userid;
2368 my $cached = $cache->get_from_cache($cache_key);
2369 my $today = dt_from_string()->ymd;
2370 return if $cached && $cached eq $today;
2372 my $patron = Koha::Patrons->find({ userid => $userid });
2373 return unless $patron;
2374 $patron->track_login;
2375 $cache->set_in_cache( $cache_key, $today );
2378 END { } # module clean-up code here (global destructor)
2388 Crypt::Eksblowfish::Bcrypt(3)