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' }
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 OpacAdditionalStylesheet => C4::Context->preference("OpacAdditionalStylesheet"),
553 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
554 LibrarySearchGroups => \@search_groups,
555 opac_name => $opac_name,
556 LibraryName => "" . C4::Context->preference("LibraryName"),
557 LibraryNameTitle => "" . $LibraryNameTitle,
558 LoginBranchname => C4::Context->userenv ? C4::Context->userenv->{"branchname"} : "",
559 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
560 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
561 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
562 OPACShelfBrowser => "" . C4::Context->preference("OPACShelfBrowser"),
563 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
564 OPACUserCSS => "" . C4::Context->preference("OPACUserCSS"),
565 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
566 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
567 opac_search_limit => $opac_search_limit,
568 opac_limit_override => $opac_limit_override,
569 OpacBrowser => C4::Context->preference("OpacBrowser"),
570 OpacCloud => C4::Context->preference("OpacCloud"),
571 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
572 OpacMainUserBlock => "" . C4::Context->preference("OpacMainUserBlock"),
573 OpacNav => "" . C4::Context->preference("OpacNav"),
574 OpacNavRight => "" . C4::Context->preference("OpacNavRight"),
575 OpacNavBottom => "" . C4::Context->preference("OpacNavBottom"),
576 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
577 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
578 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
579 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
580 OpacTopissue => C4::Context->preference("OpacTopissue"),
581 RequestOnOpac => C4::Context->preference("RequestOnOpac"),
582 'Version' => C4::Context->preference('Version'),
583 hidelostitems => C4::Context->preference("hidelostitems"),
584 mylibraryfirst => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
585 opaclayoutstylesheet => "" . C4::Context->preference("opaclayoutstylesheet"),
586 opacbookbag => "" . C4::Context->preference("opacbookbag"),
587 opaccredits => "" . C4::Context->preference("opaccredits"),
588 OpacFavicon => C4::Context->preference("OpacFavicon"),
589 opacheader => "" . C4::Context->preference("opacheader"),
590 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
591 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
592 OPACUserJS => C4::Context->preference("OPACUserJS"),
593 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
594 OpenLibrarySearch => C4::Context->preference("OpenLibrarySearch"),
595 ShowReviewer => C4::Context->preference("ShowReviewer"),
596 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
597 suggestion => "" . C4::Context->preference("suggestion"),
598 virtualshelves => "" . C4::Context->preference("virtualshelves"),
599 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
600 OPACXSLTDetailsDisplay => C4::Context->preference("OPACXSLTDetailsDisplay"),
601 OPACXSLTResultsDisplay => C4::Context->preference("OPACXSLTResultsDisplay"),
602 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
603 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
604 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
605 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
606 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
607 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
608 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
609 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
610 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
611 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
612 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
613 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
614 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
615 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
616 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
617 useDischarge => C4::Context->preference('useDischarge'),
620 $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
623 # Check if we were asked using parameters to force a specific language
624 if ( defined $in->{'query'}->param('language') ) {
626 # Extract the language, let C4::Languages::getlanguage choose
628 my $language = C4::Languages::getlanguage( $in->{'query'} );
629 my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
630 if ( ref $cookie eq 'ARRAY' ) {
631 push @{$cookie}, $languagecookie;
633 $cookie = [ $cookie, $languagecookie ];
637 return ( $template, $borrowernumber, $cookie, $flags );
642 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
644 Verifies that the user is authorized to run this script. If
645 the user is authorized, a (userid, cookie, session-id, flags)
646 quadruple is returned. If the user is not authorized but does
647 not have the required privilege (see $flagsrequired below), it
648 displays an error page and exits. Otherwise, it displays the
649 login page and exits.
651 Note that C<&checkauth> will return if and only if the user
652 is authorized, so it should be called early on, before any
653 unfinished operations (e.g., if you've opened a file, then
654 C<&checkauth> won't close it for you).
656 C<$query> is the CGI object for the script calling C<&checkauth>.
658 The C<$noauth> argument is optional. If it is set, then no
659 authorization is required for the script.
661 C<&checkauth> fetches user and session information from C<$query> and
662 ensures that the user is authorized to run scripts that require
665 The C<$flagsrequired> argument specifies the required privileges
666 the user must have if the username and password are correct.
667 It should be specified as a reference-to-hash; keys in the hash
668 should be the "flags" for the user, as specified in the Members
669 intranet module. Any key specified must correspond to a "flag"
670 in the userflags table. E.g., { circulate => 1 } would specify
671 that the user must have the "circulate" privilege in order to
672 proceed. To make sure that access control is correct, the
673 C<$flagsrequired> parameter must be specified correctly.
675 Koha also has a concept of sub-permissions, also known as
676 granular permissions. This makes the value of each key
677 in the C<flagsrequired> hash take on an additional
682 The user must have access to all subfunctions of the module
683 specified by the hash key.
687 The user must have access to at least one subfunction of the module
688 specified by the hash key.
690 specific permission, e.g., 'export_catalog'
692 The user must have access to the specific subfunction list, which
693 must correspond to a row in the permissions table.
695 The C<$type> argument specifies whether the template should be
696 retrieved from the opac or intranet directory tree. "opac" is
697 assumed if it is not specified; however, if C<$type> is specified,
698 "intranet" is assumed if it is not "opac".
700 If C<$query> does not have a valid session ID associated with it
701 (i.e., the user has not logged in) or if the session has expired,
702 C<&checkauth> presents the user with a login page (from the point of
703 view of the original script, C<&checkauth> does not return). Once the
704 user has authenticated, C<&checkauth> restarts the original script
705 (this time, C<&checkauth> returns).
707 The login page is provided using a HTML::Template, which is set in the
708 systempreferences table or at the top of this file. The variable C<$type>
709 selects which template to use, either the opac or the intranet
710 authentification template.
712 C<&checkauth> returns a user ID, a cookie, and a session ID. The
713 cookie should be sent back to the browser; it verifies that the user
723 # If version syspref is unavailable, it means Koha is being installed,
724 # and so we must redirect to OPAC maintenance page or to the WebInstaller
725 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
726 if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
727 warn "OPAC Install required, redirecting to maintenance";
728 print $query->redirect("/cgi-bin/koha/maintenance.pl");
731 unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
732 if ( $type ne 'opac' ) {
733 warn "Install required, redirecting to Installer";
734 print $query->redirect("/cgi-bin/koha/installer/install.pl");
736 warn "OPAC Install required, redirecting to maintenance";
737 print $query->redirect("/cgi-bin/koha/maintenance.pl");
742 # check that database and koha version are the same
743 # there is no DB version, it's a fresh install,
744 # go to web installer
745 # there is a DB version, compare it to the code version
746 my $kohaversion = Koha::version();
748 # remove the 3 last . to have a Perl number
749 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
750 $debug and print STDERR "kohaversion : $kohaversion\n";
751 if ( $version < $kohaversion ) {
752 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
753 if ( $type ne 'opac' ) {
754 warn sprintf( $warning, 'Installer' );
755 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
757 warn sprintf( "OPAC: " . $warning, 'maintenance' );
758 print $query->redirect("/cgi-bin/koha/maintenance.pl");
766 open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
767 printf $fh join( "\n", @_ );
771 sub _timeout_syspref {
772 my $timeout = C4::Context->preference('timeout') || 600;
774 # value in days, convert in seconds
775 if ( $timeout =~ /(\d+)[dD]/ ) {
776 $timeout = $1 * 86400;
783 $debug and warn "Checking Auth";
785 # Get shibboleth login attribute
786 my $shib = C4::Context->config('useshibboleth') && shib_ok();
787 my $shib_login = $shib ? get_login_shib() : undef;
789 # $authnotrequired will be set for scripts which will run without authentication
790 my $authnotrequired = shift;
791 my $flagsrequired = shift;
793 my $emailaddress = shift;
794 $type = 'opac' unless $type;
796 my $dbh = C4::Context->dbh;
797 my $timeout = _timeout_syspref();
799 _version_check( $type, $query );
804 my ( $userid, $cookie, $sessionID, $flags );
805 my $logout = $query->param('logout.x');
807 my $anon_search_history;
809 # This parameter is the name of the CAS server we want to authenticate against,
810 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
811 my $casparam = $query->param('cas');
812 my $q_userid = $query->param('userid') // '';
816 # Basic authentication is incompatible with the use of Shibboleth,
817 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
818 # and it may not be the attribute we want to use to match the koha login.
820 # Also, do not consider an empty REMOTE_USER.
822 # Finally, after those tests, we can assume (although if it would be better with
823 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
824 # and we can affect it to $userid.
825 =for removed-for-saml
826 if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
828 # Using Basic Authentication, no cookies required
829 $cookie = $query->cookie(
830 -name => 'CGISESSID',
840 use Data::Dump qw(dump);
841 warn "YYY ENV = ",dump( \%ENV );
843 $userid = $ENV{'HTTP_ATTR_CODE'};
844 warn "XXX userid = [$userid] ";
845 $sessionID = $query->cookie("CGISESSID");
847 if ( $sessionID && $userid ) {
848 my $s = get_session($sessionID);
849 if ( $s->param('sessiontype') eq 'anon' ) {
850 undef $sessionID; # remove anonymous session if we have SAML user
854 # ($userid,$sessionID) = () if $userid eq '_everyone';
855 return clear_saml($query) if $userid && $userid eq '_everyone';
857 if ( ! $sessionID && $userid ) { # anonymous SAML user
858 warn "# userid: $userid";
860 # create new user from SAML data
861 if ( my $token = $query->cookie('AuthMemCookie') ) {
864 use Cache::Memcached;
865 my $memd = new Cache::Memcached { 'servers' => [ '127.0.0.1:11211' ], 'compress_threshold' => 10_000 };
866 if ( my $data = $memd->get($token) ) {
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 } elsif ( $borrowernumber = getborrowernumber( $cardnumber ) ) {
884 warn "SAML login OK $borrowernumber using cardnumber: $cardnumber update userid: $userid";
885 my $sth = $dbh->prepare(qq{ update borrowers set userid = ? where userid = cardnumber and cardnumber = ? });
886 $sth->execute( $userid, $cardnumber );
889 cardnumber => $cardnumber,
890 categorycode => $categorycode,
892 userid => $saml->{ATTR_nick},
893 firstname => $saml->{ATTR_first_name},
894 surname => $saml->{ATTR_last_name},
895 branchcode => 'SRE', # FIXME
896 email => $saml->{ATTR_email},
897 dateexpiry => '2020-12-13',
898 password => $token, # required so AddMember won't erase userid
902 C4::Members::AddMember( %$borrower );
908 # Create session for SAML user
912 borrowernumber as number,
917 borrowers.branchcode as branch,
918 branches.branchname as branchname,
920 email as emailaddress
922 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
925 my $sth = $dbh->prepare($sql);
926 $sth->execute( $userid );
927 die "can't find $userid" unless $sth->rows;
929 my $session = get_session('') or die "can't create session";
930 my $sessionID = $session->id;
931 C4::Context->_new_userenv($sessionID);
932 $cookie = $query->cookie(CGISESSID => $sessionID);
934 my $row = $sth->fetchrow_hashref;
936 $session->param( $_ => $row->{$_} ) foreach keys %$row;
938 $session->param('ip', $ENV{'REMOTE_ADDR'});
939 $session->param('lasttime',time());
941 $session->param('AuthMemCookie', $token);
943 C4::Context::set_userenv(
944 $session->param('number'), $session->param('id'),
945 $session->param('cardnumber'), $session->param('firstname'),
946 $session->param('surname'), $session->param('branch'),
947 $session->param('branchname'), $session->param('flags'),
948 $session->param('emailaddress'), $session->param('branchprinter')
952 my $row_count = 10; # FIXME:This probably should be a syspref
953 my ($total, $totshelves, $barshelves, $pubshelves);
954 ($barshelves, $totshelves) = C4::VirtualShelves::GetRecentShelves(1, $row_count, $session->param('number'));
955 $total->{'bartotal'} = $totshelves;
956 ($pubshelves, $totshelves) = C4::VirtualShelves::GetRecentShelves(2, $row_count, undef);
957 $total->{'pubtotal'} = $totshelves;
958 $session->param('barshelves', $barshelves);
959 $session->param('pubshelves', $pubshelves);
960 $session->param('totshelves', $total);
962 C4::Context::set_shelves_userenv('bar',$barshelves);
963 C4::Context::set_shelves_userenv('pub',$pubshelves);
964 C4::Context::set_shelves_userenv('tot',$total);
969 if ( $type eq 'opac' ) {
970 my $to = 'https://' . $query->virtual_host . '/' . $query->path_info;
971 warn "XXX redirect $userid to $to";
972 ## FIXME 2011-12-20 dpavlin -- redirect logged in users to http
973 print $query->redirect( -uri => $to, -status => 302, -cookie => $cookie );
978 die "Can't find SAML token $token for user $userid\n";
981 die "Can't find SAML token for user $userid\n";
984 } # XXX SAML anon user
987 elsif ( $emailaddress) {
988 # the Google OpenID Connect passes an email address
990 elsif ( $sessionID = $query->cookie("CGISESSID") )
991 { # assignment, not comparison
992 $session = get_session($sessionID);
993 C4::Context->_new_userenv($sessionID);
994 my ( $ip, $lasttime, $sessiontype );
997 $s_userid = $session->param('id') // '';
998 C4::Context->set_userenv(
999 $session->param('number'), $s_userid,
1000 $session->param('cardnumber'), $session->param('firstname'),
1001 $session->param('surname'), $session->param('branch'),
1002 $session->param('branchname'), $session->param('flags'),
1003 $session->param('emailaddress'), $session->param('branchprinter'),
1004 $session->param('shibboleth')
1006 C4::Context::set_shelves_userenv( 'bar', $session->param('barshelves') );
1007 C4::Context::set_shelves_userenv( 'pub', $session->param('pubshelves') );
1008 C4::Context::set_shelves_userenv( 'tot', $session->param('totshelves') );
1009 $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1010 $ip = $session->param('ip');
1011 $lasttime = $session->param('lasttime');
1012 $userid = $s_userid;
1013 $sessiontype = $session->param('sessiontype') || '';
1015 if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
1016 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
1017 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
1020 #if a user enters an id ne to the id in the current session, we need to log them in...
1021 #first we need to clear the anonymous session...
1022 $debug and warn "query id = $q_userid but session id = $s_userid";
1023 $anon_search_history = $session->param('search_history');
1026 C4::Context->_unset_userenv($sessionID);
1032 # voluntary logout the user
1033 # check wether the user was using their shibboleth session or a local one
1034 my $shibSuccess = C4::Context->userenv->{'shibboleth'};
1037 C4::Context->_unset_userenv($sessionID);
1039 #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
1043 if ($cas and $caslogout) {
1044 logout_cas($query, $type);
1047 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
1048 if ( $shib and $shib_login and $shibSuccess) {
1049 logout_shib($query);
1052 elsif ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
1055 $info{'timed_out'} = 1;
1060 C4::Context->_unset_userenv($sessionID);
1062 #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
1066 elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1068 # Different ip than originally logged in from
1069 $info{'oldip'} = $ip;
1070 $info{'newip'} = $ENV{'REMOTE_ADDR'};
1071 $info{'different_ip'} = 1;
1074 C4::Context->_unset_userenv($sessionID);
1076 #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
1081 $cookie = $query->cookie(
1082 -name => 'CGISESSID',
1083 -value => $session->id,
1086 $session->param( 'lasttime', time() );
1087 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...
1088 $flags = haspermission( $userid, $flagsrequired );
1092 $info{'nopermission'} = 1;
1097 unless ( $userid || $sessionID ) {
1098 #we initiate a session prior to checking for a username to allow for anonymous sessions...
1099 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
1101 # Save anonymous search history in new session so it can be retrieved
1102 # by get_template_and_user to store it in user's search history after
1103 # a successful login.
1104 if ($anon_search_history) {
1105 $session->param( 'search_history', $anon_search_history );
1108 $sessionID = $session->id;
1109 C4::Context->_new_userenv($sessionID);
1110 $cookie = $query->cookie(
1111 -name => 'CGISESSID',
1112 -value => $session->id,
1115 my $pki_field = C4::Context->preference('AllowPKIAuth');
1116 if ( !defined($pki_field) ) {
1117 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
1118 $pki_field = 'None';
1120 if ( ( $cas && $query->param('ticket') )
1122 || ( $shib && $shib_login )
1123 || $pki_field ne 'None'
1126 my $password = $query->param('password');
1127 my $shibSuccess = 0;
1128 my ( $return, $cardnumber );
1130 # If shib is enabled and we have a shib login, does the login match a valid koha user
1131 if ( $shib && $shib_login ) {
1134 # Do not pass password here, else shib will not be checked in checkpw.
1135 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $q_userid, undef, $query );
1136 $userid = $retuserid;
1137 $shibSuccess = $return;
1138 $info{'invalidShibLogin'} = 1 unless ($return);
1141 # If shib login and match were successful, skip further login methods
1142 unless ($shibSuccess) {
1143 if ( $cas && $query->param('ticket') ) {
1145 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1146 checkpw( $dbh, $userid, $password, $query, $type );
1147 $userid = $retuserid;
1148 $info{'invalidCasLogin'} = 1 unless ($return);
1151 elsif ( $emailaddress ) {
1152 my $value = $emailaddress;
1154 # If we're looking up the email, there's a chance that the person
1155 # doesn't have a userid. So if there is none, we pass along the
1156 # borrower number, and the bits of code that need to know the user
1157 # ID will have to be smart enough to handle that.
1158 my $patrons = Koha::Patrons->search({ email => $value });
1159 if ($patrons->count) {
1161 # First the userid, then the borrowernum
1162 my $patron = $patrons->next;
1163 $value = $patron->userid || $patron->borrowernumber;
1167 $return = $value ? 1 : 0;
1172 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1173 || ( $pki_field eq 'emailAddress'
1174 && $ENV{'SSL_CLIENT_S_DN_Email'} )
1178 if ( $pki_field eq 'Common Name' ) {
1179 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1181 elsif ( $pki_field eq 'emailAddress' ) {
1182 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1184 # If we're looking up the email, there's a chance that the person
1185 # doesn't have a userid. So if there is none, we pass along the
1186 # borrower number, and the bits of code that need to know the user
1187 # ID will have to be smart enough to handle that.
1188 my $patrons = Koha::Patrons->search({ email => $value });
1189 if ($patrons->count) {
1191 # First the userid, then the borrowernum
1192 my $patron = $patrons->next;
1193 $value = $patron->userid || $patron->borrowernumber;
1199 $return = $value ? 1 : 0;
1205 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1206 checkpw( $dbh, $q_userid, $password, $query, $type );
1207 $userid = $retuserid if ($retuserid);
1208 $info{'invalid_username_or_password'} = 1 unless ($return);
1212 # $return: 1 = valid user
1215 #_session_log(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
1216 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1220 $info{'nopermission'} = 1;
1221 C4::Context->_unset_userenv($sessionID);
1223 my ( $borrowernumber, $firstname, $surname, $userflags,
1224 $branchcode, $branchname, $branchprinter, $emailaddress );
1226 if ( $return == 1 ) {
1228 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1229 branches.branchname as branchname,
1230 branches.branchprinter as branchprinter,
1233 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1235 my $sth = $dbh->prepare("$select where userid=?");
1236 $sth->execute($userid);
1237 unless ( $sth->rows ) {
1238 $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
1239 $sth = $dbh->prepare("$select where cardnumber=?");
1240 $sth->execute($cardnumber);
1242 unless ( $sth->rows ) {
1243 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1244 $sth->execute($userid);
1245 unless ( $sth->rows ) {
1246 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1251 ( $borrowernumber, $firstname, $surname, $userflags,
1252 $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow;
1253 $debug and print STDERR "AUTH_3 results: " .
1254 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1256 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1259 # launch a sequence to check if we have a ip for the branch, i
1260 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1262 my $ip = $ENV{'REMOTE_ADDR'};
1264 # if they specify at login, use that
1265 if ( $query->param('branch') ) {
1266 $branchcode = $query->param('branch');
1267 my $library = Koha::Libraries->find($branchcode);
1268 $branchname = $library? $library->branchname: '';
1270 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1271 if ( $type ne 'opac' and C4::Context->boolean_preference('AutoLocation') ) {
1273 # we have to check they are coming from the right ip range
1274 my $domain = $branches->{$branchcode}->{'branchip'};
1275 $domain =~ s|\.\*||g;
1276 if ( $ip !~ /^$domain/ ) {
1278 $cookie = $query->cookie(
1279 -name => 'CGISESSID',
1283 $info{'wrongip'} = 1;
1287 foreach my $br ( keys %$branches ) {
1289 # now we work with the treatment of ip
1290 my $domain = $branches->{$br}->{'branchip'};
1291 if ( $domain && $ip =~ /^$domain/ ) {
1292 $branchcode = $branches->{$br}->{'branchcode'};
1294 # new op dev : add the branchprinter and branchname in the cookie
1295 $branchprinter = $branches->{$br}->{'branchprinter'};
1296 $branchname = $branches->{$br}->{'branchname'};
1299 $session->param( 'number', $borrowernumber );
1300 $session->param( 'id', $userid );
1301 $session->param( 'cardnumber', $cardnumber );
1302 $session->param( 'firstname', $firstname );
1303 $session->param( 'surname', $surname );
1304 $session->param( 'branch', $branchcode );
1305 $session->param( 'branchname', $branchname );
1306 $session->param( 'flags', $userflags );
1307 $session->param( 'emailaddress', $emailaddress );
1308 $session->param( 'ip', $session->remote_addr() );
1309 $session->param( 'lasttime', time() );
1310 $session->param( 'interface', $type);
1311 $session->param( 'shibboleth', $shibSuccess );
1312 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1314 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1315 C4::Context->set_userenv(
1316 $session->param('number'), $session->param('id'),
1317 $session->param('cardnumber'), $session->param('firstname'),
1318 $session->param('surname'), $session->param('branch'),
1319 $session->param('branchname'), $session->param('flags'),
1320 $session->param('emailaddress'), $session->param('branchprinter'),
1321 $session->param('shibboleth')
1325 # $return: 0 = invalid user
1326 # reset to anonymous session
1328 $debug and warn "Login failed, resetting anonymous session...";
1330 $info{'invalid_username_or_password'} = 1;
1331 C4::Context->_unset_userenv($sessionID);
1333 $session->param( 'lasttime', time() );
1334 $session->param( 'ip', $session->remote_addr() );
1335 $session->param( 'sessiontype', 'anon' );
1336 $session->param( 'interface', $type);
1338 } # END if ( $q_userid
1339 elsif ( $type eq "opac" ) {
1341 # if we are here this is an anonymous session; add public lists to it and a few other items...
1342 # anonymous sessions are created only for the OPAC
1343 $debug and warn "Initiating an anonymous session...";
1345 # setting a couple of other session vars...
1346 $session->param( 'ip', $session->remote_addr() );
1347 $session->param( 'lasttime', time() );
1348 $session->param( 'sessiontype', 'anon' );
1349 $session->param( 'interface', $type);
1351 } # END unless ($userid)
1353 # finished authentification, now respond
1354 if ( $loggedin || $authnotrequired )
1358 $cookie = $query->cookie(
1359 -name => 'CGISESSID',
1365 track_login_daily( $userid );
1367 return ( $userid, $cookie, $sessionID, $flags );
1372 # AUTH rejected, show the login/password template, after checking the DB.
1376 # get the inputs from the incoming query
1378 foreach my $name ( param $query) {
1379 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1380 my @value = $query->multi_param($name);
1381 push @inputs, { name => $name, value => $_ } for @value;
1384 my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1386 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1387 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1388 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1390 my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1391 my $template = C4::Templates::gettemplate( $template_name, $type, $query );
1393 OpacAdditionalStylesheet => C4::Context->preference("OpacAdditionalStylesheet"),
1394 opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
1397 script_name => get_script_name(),
1398 casAuthentication => C4::Context->preference("casAuthentication"),
1399 shibbolethAuthentication => $shib,
1400 SessionRestrictionByIP => C4::Context->preference("SessionRestrictionByIP"),
1401 suggestion => C4::Context->preference("suggestion"),
1402 virtualshelves => C4::Context->preference("virtualshelves"),
1403 LibraryName => "" . C4::Context->preference("LibraryName"),
1404 LibraryNameTitle => "" . $LibraryNameTitle,
1405 opacuserlogin => C4::Context->preference("opacuserlogin"),
1406 OpacNav => C4::Context->preference("OpacNav"),
1407 OpacNavRight => C4::Context->preference("OpacNavRight"),
1408 OpacNavBottom => C4::Context->preference("OpacNavBottom"),
1409 opaccredits => C4::Context->preference("opaccredits"),
1410 OpacFavicon => C4::Context->preference("OpacFavicon"),
1411 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1412 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1413 OPACUserJS => C4::Context->preference("OPACUserJS"),
1414 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1415 OpacCloud => C4::Context->preference("OpacCloud"),
1416 OpacTopissue => C4::Context->preference("OpacTopissue"),
1417 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1418 OpacBrowser => C4::Context->preference("OpacBrowser"),
1419 opacheader => C4::Context->preference("opacheader"),
1420 TagsEnabled => C4::Context->preference("TagsEnabled"),
1421 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1422 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1423 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1424 intranetbookbag => C4::Context->preference("intranetbookbag"),
1425 IntranetNav => C4::Context->preference("IntranetNav"),
1426 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1427 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
1428 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1429 IndependentBranches => C4::Context->preference("IndependentBranches"),
1430 AutoLocation => C4::Context->preference("AutoLocation"),
1431 wrongip => $info{'wrongip'},
1432 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1433 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1434 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1435 too_many_login_attempts => ( $patron and $patron->account_locked )
1438 $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1439 $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1440 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1441 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1443 if ( $type eq 'opac' ) {
1444 require Koha::Virtualshelves;
1445 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1451 some_public_shelves => $some_public_shelves,
1457 # Is authentication against multiple CAS servers enabled?
1458 if ( C4::Auth_with_cas::multipleAuth && !$casparam ) {
1459 my $casservers = C4::Auth_with_cas::getMultipleAuth();
1461 foreach my $key ( keys %$casservers ) {
1462 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1465 casServersLoop => \@tmplservers
1469 casServerUrl => login_cas_url($query, undef, $type),
1474 invalidCasLogin => $info{'invalidCasLogin'}
1480 shibbolethAuthentication => $shib,
1481 shibbolethLoginUrl => login_shib_url($query),
1485 if (C4::Context->preference('GoogleOpenIDConnect')) {
1486 if ($query->param("OpenIDConnectFailed")) {
1487 my $reason = $query->param('OpenIDConnectFailed');
1488 $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1493 LibraryName => C4::Context->preference("LibraryName"),
1495 $template->param(%info);
1497 # $cookie = $query->cookie(CGISESSID => $session->id
1499 print $query->header(
1500 { type => 'text/html',
1503 'X-Frame-Options' => 'SAMEORIGIN'
1510 =head2 check_api_auth
1512 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1514 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1515 cookie, determine if the user has the privileges specified by C<$userflags>.
1517 C<check_api_auth> is is meant for authenticating users of web services, and
1518 consequently will always return and will not attempt to redirect the user
1521 If a valid session cookie is already present, check_api_auth will return a status
1522 of "ok", the cookie, and the Koha session ID.
1524 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1525 parameters and create a session cookie and Koha session if the supplied credentials
1528 Possible return values in C<$status> are:
1532 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1534 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1536 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1538 =item "expired -- session cookie has expired; API user should resubmit userid and password
1544 sub check_api_auth {
1547 my $flagsrequired = shift;
1548 my $dbh = C4::Context->dbh;
1549 my $timeout = _timeout_syspref();
1551 unless ( C4::Context->preference('Version') ) {
1553 # database has not been installed yet
1554 return ( "maintenance", undef, undef );
1556 my $kohaversion = Koha::version();
1557 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1558 if ( C4::Context->preference('Version') < $kohaversion ) {
1560 # database in need of version update; assume that
1561 # no API should be called while databsae is in
1563 return ( "maintenance", undef, undef );
1566 # FIXME -- most of what follows is a copy-and-paste
1567 # of code from checkauth. There is an obvious need
1568 # for refactoring to separate the various parts of
1569 # the authentication code, but as of 2007-11-19 this
1570 # is deferred so as to not introduce bugs into the
1571 # regular authentication code for Koha 3.0.
1573 # see if we have a valid session cookie already
1574 # however, if a userid parameter is present (i.e., from
1575 # a form submission, assume that any current cookie
1577 my $sessionID = undef;
1578 unless ( $query->param('userid') ) {
1579 $sessionID = $query->cookie("CGISESSID");
1581 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1582 my $session = get_session($sessionID);
1583 C4::Context->_new_userenv($sessionID);
1585 C4::Context->interface($session->param('interface'));
1586 C4::Context->set_userenv(
1587 $session->param('number'), $session->param('id'),
1588 $session->param('cardnumber'), $session->param('firstname'),
1589 $session->param('surname'), $session->param('branch'),
1590 $session->param('branchname'), $session->param('flags'),
1591 $session->param('emailaddress'), $session->param('branchprinter')
1594 my $ip = $session->param('ip');
1595 my $lasttime = $session->param('lasttime');
1596 my $userid = $session->param('id');
1597 if ( $lasttime < time() - $timeout ) {
1602 C4::Context->_unset_userenv($sessionID);
1605 return ( "expired", undef, undef );
1606 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1608 # IP address changed
1611 C4::Context->_unset_userenv($sessionID);
1614 return ( "expired", undef, undef );
1616 my $cookie = $query->cookie(
1617 -name => 'CGISESSID',
1618 -value => $session->id,
1621 $session->param( 'lasttime', time() );
1622 my $flags = haspermission( $userid, $flagsrequired );
1624 return ( "ok", $cookie, $sessionID );
1628 C4::Context->_unset_userenv($sessionID);
1631 return ( "failed", undef, undef );
1635 return ( "expired", undef, undef );
1640 my $userid = $query->param('userid');
1641 my $password = $query->param('password');
1642 my ( $return, $cardnumber, $cas_ticket );
1645 if ( $cas && $query->param('PT') ) {
1647 $debug and print STDERR "## check_api_auth - checking CAS\n";
1649 # In case of a CAS authentication, we use the ticket instead of the password
1650 my $PT = $query->param('PT');
1651 ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $dbh, $PT, $query ); # EXTERNAL AUTH
1654 # User / password auth
1655 unless ( $userid and $password ) {
1657 # caller did something wrong, fail the authenticateion
1658 return ( "failed", undef, undef );
1661 ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $dbh, $userid, $password, $query );
1664 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1665 my $session = get_session("");
1666 return ( "failed", undef, undef ) unless $session;
1668 my $sessionID = $session->id;
1669 C4::Context->_new_userenv($sessionID);
1670 my $cookie = $query->cookie(
1671 -name => 'CGISESSID',
1672 -value => $sessionID,
1675 if ( $return == 1 ) {
1677 $borrowernumber, $firstname, $surname,
1678 $userflags, $branchcode, $branchname,
1679 $branchprinter, $emailaddress
1683 "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=?"
1685 $sth->execute($userid);
1687 $borrowernumber, $firstname, $surname,
1688 $userflags, $branchcode, $branchname,
1689 $branchprinter, $emailaddress
1690 ) = $sth->fetchrow if ( $sth->rows );
1692 unless ( $sth->rows ) {
1693 my $sth = $dbh->prepare(
1694 "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=?"
1696 $sth->execute($cardnumber);
1698 $borrowernumber, $firstname, $surname,
1699 $userflags, $branchcode, $branchname,
1700 $branchprinter, $emailaddress
1701 ) = $sth->fetchrow if ( $sth->rows );
1703 unless ( $sth->rows ) {
1704 $sth->execute($userid);
1706 $borrowernumber, $firstname, $surname, $userflags,
1707 $branchcode, $branchname, $branchprinter, $emailaddress
1708 ) = $sth->fetchrow if ( $sth->rows );
1712 my $ip = $ENV{'REMOTE_ADDR'};
1714 # if they specify at login, use that
1715 if ( $query->param('branch') ) {
1716 $branchcode = $query->param('branch');
1717 my $library = Koha::Libraries->find($branchcode);
1718 $branchname = $library? $library->branchname: '';
1720 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1721 foreach my $br ( keys %$branches ) {
1723 # now we work with the treatment of ip
1724 my $domain = $branches->{$br}->{'branchip'};
1725 if ( $domain && $ip =~ /^$domain/ ) {
1726 $branchcode = $branches->{$br}->{'branchcode'};
1728 # new op dev : add the branchprinter and branchname in the cookie
1729 $branchprinter = $branches->{$br}->{'branchprinter'};
1730 $branchname = $branches->{$br}->{'branchname'};
1733 $session->param( 'number', $borrowernumber );
1734 $session->param( 'id', $userid );
1735 $session->param( 'cardnumber', $cardnumber );
1736 $session->param( 'firstname', $firstname );
1737 $session->param( 'surname', $surname );
1738 $session->param( 'branch', $branchcode );
1739 $session->param( 'branchname', $branchname );
1740 $session->param( 'flags', $userflags );
1741 $session->param( 'emailaddress', $emailaddress );
1742 $session->param( 'ip', $session->remote_addr() );
1743 $session->param( 'lasttime', time() );
1744 $session->param( 'interface', 'api' );
1746 $session->param( 'cas_ticket', $cas_ticket);
1747 C4::Context->set_userenv(
1748 $session->param('number'), $session->param('id'),
1749 $session->param('cardnumber'), $session->param('firstname'),
1750 $session->param('surname'), $session->param('branch'),
1751 $session->param('branchname'), $session->param('flags'),
1752 $session->param('emailaddress'), $session->param('branchprinter')
1754 return ( "ok", $cookie, $sessionID );
1756 return ( "failed", undef, undef );
1761 =head2 check_cookie_auth
1763 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1765 Given a CGISESSID cookie set during a previous login to Koha, determine
1766 if the user has the privileges specified by C<$userflags>. C<$userflags>
1767 is passed unaltered into C<haspermission> and as such accepts all options
1768 avaiable to that routine with the one caveat that C<check_api_auth> will
1769 also allow 'undef' to be passed and in such a case the permissions check
1770 will be skipped altogether.
1772 C<check_cookie_auth> is meant for authenticating special services
1773 such as tools/upload-file.pl that are invoked by other pages that
1774 have been authenticated in the usual way.
1776 Possible return values in C<$status> are:
1780 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1782 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1784 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1786 =item "expired -- session cookie has expired; API user should resubmit userid and password
1792 sub check_cookie_auth {
1794 my $flagsrequired = shift;
1797 my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1798 my $dbh = C4::Context->dbh;
1799 my $timeout = _timeout_syspref();
1801 unless ( C4::Context->preference('Version') ) {
1803 # database has not been installed yet
1804 return ( "maintenance", undef );
1806 my $kohaversion = Koha::version();
1807 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1808 if ( C4::Context->preference('Version') < $kohaversion ) {
1810 # database in need of version update; assume that
1811 # no API should be called while databsae is in
1813 return ( "maintenance", undef );
1816 # FIXME -- most of what follows is a copy-and-paste
1817 # of code from checkauth. There is an obvious need
1818 # for refactoring to separate the various parts of
1819 # the authentication code, but as of 2007-11-23 this
1820 # is deferred so as to not introduce bugs into the
1821 # regular authentication code for Koha 3.0.
1823 # see if we have a valid session cookie already
1824 # however, if a userid parameter is present (i.e., from
1825 # a form submission, assume that any current cookie
1827 unless ( defined $cookie and $cookie ) {
1828 return ( "failed", undef );
1830 my $sessionID = $cookie;
1831 my $session = get_session($sessionID);
1832 C4::Context->_new_userenv($sessionID);
1834 C4::Context->interface($session->param('interface'));
1835 C4::Context->set_userenv(
1836 $session->param('number'), $session->param('id'),
1837 $session->param('cardnumber'), $session->param('firstname'),
1838 $session->param('surname'), $session->param('branch'),
1839 $session->param('branchname'), $session->param('flags'),
1840 $session->param('emailaddress'), $session->param('branchprinter')
1843 my $ip = $session->param('ip');
1844 my $lasttime = $session->param('lasttime');
1845 my $userid = $session->param('id');
1846 if ( $lasttime < time() - $timeout ) {
1851 C4::Context->_unset_userenv($sessionID);
1854 return ("expired", undef);
1855 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1857 # IP address changed
1860 C4::Context->_unset_userenv($sessionID);
1863 return ( "expired", undef );
1865 $session->param( 'lasttime', time() );
1866 my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1868 return ( "ok", $sessionID );
1872 C4::Context->_unset_userenv($sessionID);
1875 return ( "failed", undef );
1879 return ( "expired", undef );
1886 my $session = get_session($sessionID);
1888 Given a session ID, retrieve the CGI::Session object used to store
1889 the session's state. The session object can be used to store
1890 data that needs to be accessed by different scripts during a
1893 If the C<$sessionID> parameter is an empty string, a new session
1898 sub _get_session_params {
1899 my $storage_method = C4::Context->preference('SessionStorage');
1900 if ( $storage_method eq 'mysql' ) {
1901 my $dbh = C4::Context->dbh;
1902 return { dsn => "driver:MySQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1904 elsif ( $storage_method eq 'Pg' ) {
1905 my $dbh = C4::Context->dbh;
1906 return { dsn => "driver:PostgreSQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1908 elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1909 my $memcached = Koha::Caches->get_instance()->memcached_cache;
1910 return { dsn => "driver:memcached;serializer:yaml;id:md5", dsn_args => { Memcached => $memcached } };
1913 # catch all defaults to tmp should work on all systems
1914 my $dir = C4::Context::temporary_directory;
1915 my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1916 return { dsn => "driver:File;serializer:yaml;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1921 my $sessionID = shift;
1922 my $params = _get_session_params();
1923 return new CGI::Session( $params->{dsn}, $sessionID, $params->{dsn_args} );
1927 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1928 # (or something similar)
1929 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1930 # not having a userenv defined could cause a crash.
1932 my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1933 $type = 'opac' unless $type;
1935 # Get shibboleth login attribute
1936 my $shib = C4::Context->config('useshibboleth') && shib_ok();
1937 my $shib_login = $shib ? get_login_shib() : undef;
1940 my $patron = Koha::Patrons->find({ userid => $userid });
1941 $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1942 my $check_internal_as_fallback = 0;
1944 # Note: checkpw_* routines returns:
1947 # -1 if user bind failed (LDAP only)
1949 if ( $patron and $patron->account_locked ) {
1950 # Nothing to check, account is locked
1951 } elsif ($ldap && defined($password)) {
1952 $debug and print STDERR "## checkpw - checking LDAP\n";
1953 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
1954 if ( $retval == 1 ) {
1955 @return = ( $retval, $retcard, $retuserid );
1958 $check_internal_as_fallback = 1 if $retval == 0;
1960 } elsif ( $cas && $query && $query->param('ticket') ) {
1961 $debug and print STDERR "## checkpw - checking CAS\n";
1963 # In case of a CAS authentication, we use the ticket instead of the password
1964 my $ticket = $query->param('ticket');
1965 $query->delete('ticket'); # remove ticket to come back to original URL
1966 my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $dbh, $ticket, $query, $type ); # EXTERNAL AUTH
1968 @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1972 $passwd_ok = $retval;
1975 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1976 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1978 elsif ( $shib && $shib_login && !$password ) {
1980 $debug and print STDERR "## checkpw - checking Shibboleth\n";
1982 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1983 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1984 # shibboleth-authenticated user
1986 # Then, we check if it matches a valid koha user
1988 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
1990 @return = ( $retval, $retcard, $retuserid );
1992 $passwd_ok = $retval;
1995 $check_internal_as_fallback = 1;
1999 if ( $check_internal_as_fallback ) {
2000 @return = checkpw_internal( $dbh, $userid, $password, $no_set_userenv);
2001 $passwd_ok = 1 if $return[0] > 0; # 1 or 2
2006 $patron->update({ login_attempts => 0 });
2007 } elsif( !$patron->account_locked ) {
2008 $patron->update({ login_attempts => $patron->login_attempts + 1 });
2014 sub checkpw_internal {
2015 my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
2017 $password = Encode::encode( 'UTF-8', $password )
2018 if Encode::is_utf8($password);
2022 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
2024 $sth->execute($userid);
2026 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
2027 $surname, $branchcode, $branchname, $flags )
2030 if ( checkpw_hash( $password, $stored_hash ) ) {
2032 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
2033 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
2034 return 1, $cardnumber, $userid;
2039 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
2041 $sth->execute($userid);
2043 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
2044 $surname, $branchcode, $branchname, $flags )
2047 if ( checkpw_hash( $password, $stored_hash ) ) {
2049 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
2050 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
2051 return 1, $cardnumber, $userid;
2058 my ( $password, $stored_hash ) = @_;
2060 return if $stored_hash eq '!';
2062 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
2064 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
2065 $hash = hash_password( $password, $stored_hash );
2067 $hash = md5_base64($password);
2069 return $hash eq $stored_hash;
2074 my $authflags = getuserflags($flags, $userid, [$dbh]);
2076 Translates integer flags into permissions strings hash.
2078 C<$flags> is the integer userflags value ( borrowers.userflags )
2079 C<$userid> is the members.userid, used for building subpermissions
2080 C<$authflags> is a hashref of permissions
2087 my $dbh = @_ ? shift : C4::Context->dbh;
2090 # I don't want to do this, but if someone logs in as the database
2091 # user, it would be preferable not to spam them to death with
2092 # numeric warnings. So, we make $flags numeric.
2093 no warnings 'numeric';
2096 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
2099 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
2100 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
2101 $userflags->{$flag} = 1;
2104 $userflags->{$flag} = 0;
2108 # get subpermissions and merge with top-level permissions
2109 my $user_subperms = get_user_subpermissions($userid);
2110 foreach my $module ( keys %$user_subperms ) {
2111 next if $userflags->{$module} == 1; # user already has permission for everything in this module
2112 $userflags->{$module} = $user_subperms->{$module};
2118 =head2 get_user_subpermissions
2120 $user_perm_hashref = get_user_subpermissions($userid);
2122 Given the userid (note, not the borrowernumber) of a staff user,
2123 return a hashref of hashrefs of the specific subpermissions
2124 accorded to the user. An example return is
2128 export_catalog => 1,
2129 import_patrons => 1,
2133 The top-level hash-key is a module or function code from
2134 userflags.flag, while the second-level key is a code
2137 The results of this function do not give a complete picture
2138 of the functions that a staff user can access; it is also
2139 necessary to check borrowers.flags.
2143 sub get_user_subpermissions {
2146 my $dbh = C4::Context->dbh;
2147 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2148 FROM user_permissions
2149 JOIN permissions USING (module_bit, code)
2150 JOIN userflags ON (module_bit = bit)
2151 JOIN borrowers USING (borrowernumber)
2152 WHERE userid = ?" );
2153 $sth->execute($userid);
2155 my $user_perms = {};
2156 while ( my $perm = $sth->fetchrow_hashref ) {
2157 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2162 =head2 get_all_subpermissions
2164 my $perm_hashref = get_all_subpermissions();
2166 Returns a hashref of hashrefs defining all specific
2167 permissions currently defined. The return value
2168 has the same structure as that of C<get_user_subpermissions>,
2169 except that the innermost hash value is the description
2170 of the subpermission.
2174 sub get_all_subpermissions {
2175 my $dbh = C4::Context->dbh;
2176 my $sth = $dbh->prepare( "SELECT flag, code
2178 JOIN userflags ON (module_bit = bit)" );
2182 while ( my $perm = $sth->fetchrow_hashref ) {
2183 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2188 =head2 haspermission
2190 $flagsrequired = '*'; # Any permission at all
2191 $flagsrequired = 'a_flag'; # a_flag must be satisfied (all subpermissions)
2192 $flagsrequired = [ 'a_flag', 'b_flag' ]; # a_flag OR b_flag must be satisfied
2193 $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 }; # a_flag AND b_flag must be satisfied
2194 $flagsrequired = { 'a_flag' => 'sub_a' }; # sub_a of a_flag must be satisfied
2195 $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2197 $flags = ($userid, $flagsrequired);
2199 C<$userid> the userid of the member
2200 C<$flags> is a query structure similar to that used by SQL::Abstract that
2201 denotes the combination of flags required. It is a required parameter.
2203 The main logic of this method is that things in arrays are OR'ed, and things
2204 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2206 Returns member's flags or 0 if a permission is not met.
2211 my ($required, $flags) = @_;
2213 my $ref = ref($required);
2215 if ($required eq '*') {
2216 return 0 unless ( $flags or ref( $flags ) );
2218 return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2220 } elsif ($ref eq 'HASH') {
2221 foreach my $key (keys %{$required}) {
2222 next if $flags == 1;
2223 my $require = $required->{$key};
2224 my $rflags = $flags->{$key};
2225 return 0 unless _dispatch($require, $rflags);
2227 } elsif ($ref eq 'ARRAY') {
2229 foreach my $require ( @{$required} ) {
2231 ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2232 ? $flags->{$require}
2234 $satisfied++ if _dispatch( $require, $rflags );
2236 return 0 unless $satisfied;
2238 croak "Unexpected structure found: $ref";
2245 my ( $userid, $flagsrequired ) = @_;
2247 #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2248 # unless defined($flagsrequired);
2250 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2251 $sth->execute($userid);
2252 my $row = $sth->fetchrow();
2253 my $flags = getuserflags( $row, $userid );
2255 return $flags unless defined($flagsrequired);
2256 return $flags if $flags->{superlibrarian};
2257 return _dispatch($flagsrequired, $flags);
2259 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2266 C<$ipset> A space separated string describing an IP set. Can include single IPs or ranges
2268 Returns 1 if the remote address is in the provided ipset, or 0 otherwise.
2275 my @allowedipranges = $ipset ? split(' ', $ipset) : ();
2276 if (scalar @allowedipranges > 0) {
2278 eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2279 eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || ( $ENV{DEBUG} && warn 'cidrlookup failed for ' . join(' ',@rangelist) );
2281 return $result ? 1 : 0;
2284 sub getborrowernumber {
2286 my $userenv = C4::Context->userenv;
2287 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2288 return $userenv->{number};
2290 my $dbh = C4::Context->dbh;
2291 for my $field ( 'userid', 'cardnumber' ) {
2293 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2294 $sth->execute($userid);
2296 my ($bnumber) = $sth->fetchrow;
2303 =head2 track_login_daily
2305 track_login_daily( $userid );
2307 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2311 sub track_login_daily {
2313 return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2315 my $cache = Koha::Caches->get_instance();
2316 my $cache_key = "track_login_" . $userid;
2317 my $cached = $cache->get_from_cache($cache_key);
2318 my $today = dt_from_string()->ymd;
2319 return if $cached && $cached eq $today;
2321 my $patron = Koha::Patrons->find({ userid => $userid });
2322 return unless $patron;
2323 $patron->track_login;
2324 $cache->set_in_cache( $cache_key, $today );
2327 END { } # module clean-up code here (global destructor)
2337 Crypt::Eksblowfish::Bcrypt(3)