3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
24 use Digest::MD5 qw(md5_base64);
25 use JSON qw/encode_json/;
31 use C4::Templates; # to get the template
33 use C4::Search::History;
36 use Koha::AuthUtils qw(get_script_name hash_password);
38 use Koha::DateUtils qw(dt_from_string);
39 use Koha::Library::Groups;
42 use Koha::Patron::Consents;
43 use POSIX qw/strftime/;
44 use List::MoreUtils qw/ any /;
45 use Encode qw( encode is_utf8);
46 use C4::Auth_with_shibboleth;
50 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout);
53 sub psgi_env { any { /^psgi\./ } keys %ENV }
56 if (psgi_env) { die 'psgi:exit' }
60 C4::Context->set_remote_address;
64 @EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
65 @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash
66 &get_all_subpermissions &get_user_subpermissions track_login_daily &in_iprange
68 %EXPORT_TAGS = ( EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)] );
69 $ldap = C4::Context->config('useldapserver') || 0;
70 $cas = C4::Context->preference('casAuthentication');
71 $caslogout = C4::Context->preference('casLogout');
72 require C4::Auth_with_cas; # no import
75 require C4::Auth_with_ldap;
76 import C4::Auth_with_ldap qw(checkpw_ldap);
79 import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url logout_if_required);
86 C4::Auth - Authenticates Koha users
96 my ($template, $borrowernumber, $cookie)
97 = get_template_and_user(
99 template_name => "opac-main.tt",
102 authnotrequired => 0,
103 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
107 output_html_with_http_headers $query, $cookie, $template->output;
111 The main function of this module is to provide
112 authentification. However the get_template_and_user function has
113 been provided so that a users login information is passed along
114 automatically. This gets loaded into the template.
118 =head2 get_template_and_user
120 my ($template, $borrowernumber, $cookie)
121 = get_template_and_user(
123 template_name => "opac-main.tt",
126 authnotrequired => 0,
127 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
131 This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
132 to C<&checkauth> (in this module) to perform authentification.
133 See C<&checkauth> for an explanation of these parameters.
135 The C<template_name> is then used to find the correct template for
136 the page. The authenticated users details are loaded onto the
137 template in the logged_in_user variable (which is a Koha::Patron object). Also the
138 C<sessionID> is passed to the template. This can be used in templates
139 if cookies are disabled. It needs to be put as and input to every
142 More information on the C<gettemplate> sub can be found in the
147 sub get_template_and_user {
150 my ( $user, $cookie, $sessionID, $flags );
152 # Get shibboleth login attribute
153 my $shib = C4::Context->config('useshibboleth') && shib_ok();
154 my $shib_login = $shib ? get_login_shib() : undef;
156 C4::Context->interface( $in->{type} );
158 $in->{'authnotrequired'} ||= 0;
160 # the following call includes a bad template check; might croak
161 my $template = C4::Templates::gettemplate(
162 $in->{'template_name'},
167 if ( $in->{'template_name'} !~ m/maintenance/ ) {
168 ( $user, $cookie, $sessionID, $flags ) = checkauth(
170 $in->{'authnotrequired'},
171 $in->{'flagsrequired'},
174 $in->{template_name},
178 # If we enforce GDPR and the user did not consent, redirect
179 # Exceptions for consent page itself and SCI/SCO system
180 if( $in->{type} eq 'opac' && $user &&
181 $in->{'template_name'} !~ /^(opac-patron-consent|sc[io]\/)/ &&
182 C4::Context->preference('GDPR_Policy') eq 'Enforced' )
184 my $consent = Koha::Patron::Consents->search({
185 borrowernumber => getborrowernumber($user),
186 type => 'GDPR_PROCESSING',
187 given_on => { '!=', undef },
190 print $in->{query}->redirect(-uri => '/cgi-bin/koha/opac-patron-consent.pl', -cookie => $cookie);
195 if ( $in->{type} eq 'opac' && $user ) {
198 my $session = get_session($sessionID);
200 $is_sco_user = $session->param('sco_user');
206 # If the user logged in is the SCO user and they try to go out of the SCO module,
207 # log the user out removing the CGISESSID cookie
208 $in->{template_name} !~ m|sco/| && $in->{template_name} !~ m|errors/errorpage.tt|
212 C4::Context->preference('AutoSelfCheckID')
213 && $user eq C4::Context->preference('AutoSelfCheckID')
221 # If the user logged in is the SCI user and they try to go out of the SCI module,
222 # kick them out unless it is SCO with a valid permission
223 # or they are a superlibrarian
224 $in->{template_name} !~ m|sci/|
225 && haspermission( $user, { self_check => 'self_checkin_module' } )
227 $in->{template_name} =~ m|sco/| && haspermission(
228 $user, { self_check => 'self_checkout_module' }
231 && $flags && $flags->{superlibrarian} != 1
238 $template = C4::Templates::gettemplate( 'opac-auth.tt', 'opac',
240 $cookie = $in->{query}->cookie(
241 -name => 'CGISESSID',
245 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
250 script_name => get_script_name(),
253 print $in->{query}->header(
258 'X-Frame-Options' => 'SAMEORIGIN'
269 # It's possible for $user to be the borrowernumber if they don't have a
270 # userid defined (and are logging in through some other method, such
271 # as SSL certs against an email address)
273 $borrowernumber = getborrowernumber($user) if defined($user);
274 if ( !defined($borrowernumber) && defined($user) ) {
275 $patron = Koha::Patrons->find( $user );
277 $borrowernumber = $user;
279 # A bit of a hack, but I don't know there's a nicer way
281 $user = $patron->firstname . ' ' . $patron->surname;
284 $patron = Koha::Patrons->find( $borrowernumber );
285 # FIXME What to do if $patron does not exist?
289 $template->param( loggedinusername => $user ); # OBSOLETE - Do not reuse this in template, use logged_in_user.userid instead
290 $template->param( loggedinusernumber => $borrowernumber ); # FIXME Should be replaced with logged_in_user.borrowernumber
291 $template->param( logged_in_user => $patron );
292 $template->param( sessionID => $sessionID );
294 if ( $in->{'type'} eq 'opac' ) {
295 require Koha::Virtualshelves;
296 my $some_private_shelves = Koha::Virtualshelves->get_some_shelves(
298 borrowernumber => $borrowernumber,
302 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
308 some_private_shelves => $some_private_shelves,
309 some_public_shelves => $some_public_shelves,
313 my $all_perms = get_all_subpermissions();
315 my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
316 editcatalogue updatecharges tools editauthorities serials reports acquisition clubs);
318 # We are going to use the $flags returned by checkauth
319 # to create the template's parameters that will indicate
320 # which menus the user can access.
321 if ( $flags && $flags->{superlibrarian} == 1 ) {
322 $template->param( CAN_user_circulate => 1 );
323 $template->param( CAN_user_catalogue => 1 );
324 $template->param( CAN_user_parameters => 1 );
325 $template->param( CAN_user_borrowers => 1 );
326 $template->param( CAN_user_permissions => 1 );
327 $template->param( CAN_user_reserveforothers => 1 );
328 $template->param( CAN_user_editcatalogue => 1 );
329 $template->param( CAN_user_updatecharges => 1 );
330 $template->param( CAN_user_acquisition => 1 );
331 $template->param( CAN_user_tools => 1 );
332 $template->param( CAN_user_editauthorities => 1 );
333 $template->param( CAN_user_serials => 1 );
334 $template->param( CAN_user_reports => 1 );
335 $template->param( CAN_user_staffaccess => 1 );
336 $template->param( CAN_user_plugins => 1 );
337 $template->param( CAN_user_coursereserves => 1 );
338 $template->param( CAN_user_clubs => 1 );
339 $template->param( CAN_user_ill => 1 );
340 $template->param( CAN_user_stockrotation => 1 );
342 foreach my $module ( keys %$all_perms ) {
343 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
344 $template->param( "CAN_user_${module}_${subperm}" => 1 );
350 foreach my $module ( keys %$all_perms ) {
351 if ( defined($flags->{$module}) && $flags->{$module} == 1 ) {
352 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
353 $template->param( "CAN_user_${module}_${subperm}" => 1 );
355 } elsif ( ref( $flags->{$module} ) ) {
356 foreach my $subperm ( keys %{ $flags->{$module} } ) {
357 $template->param( "CAN_user_${module}_${subperm}" => 1 );
364 foreach my $module ( keys %$flags ) {
365 if ( $flags->{$module} == 1 or ref( $flags->{$module} ) ) {
366 $template->param( "CAN_user_$module" => 1 );
371 # Logged-in opac search history
372 # If the requested template is an opac one and opac search history is enabled
373 if ( $in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory') ) {
374 my $dbh = C4::Context->dbh;
375 my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
376 my $sth = $dbh->prepare($query);
377 $sth->execute($borrowernumber);
379 # If at least one search has already been performed
380 if ( $sth->fetchrow_array > 0 ) {
382 # We show the link in opac
383 $template->param( EnableOpacSearchHistory => 1 );
385 if (C4::Context->preference('LoadSearchHistoryToTheFirstLoggedUser'))
387 # And if there are searches performed when the user was not logged in,
388 # we add them to the logged-in search history
389 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
390 if (@recentSearches) {
391 my $dbh = C4::Context->dbh;
393 INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, type, total, time )
394 VALUES (?, ?, ?, ?, ?, ?, ?)
396 my $sth = $dbh->prepare($query);
397 $sth->execute( $borrowernumber,
398 $in->{query}->cookie("CGISESSID"),
401 $_->{type} || 'biblio',
404 ) foreach @recentSearches;
406 # clear out the search history from the session now that
407 # we've saved it to the database
410 C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } );
412 } elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) {
413 $template->param( EnableSearchHistory => 1 );
416 else { # if this is an anonymous session, setup to display public lists...
418 # If shibboleth is enabled, and we're in an anonymous session, we should allow
419 # the user to attempt login via shibboleth.
421 $template->param( shibbolethAuthentication => $shib,
422 shibbolethLoginUrl => login_shib_url( $in->{'query'} ),
425 # If shibboleth is enabled and we have a shibboleth login attribute,
426 # but we are in an anonymous session, then we clearly have an invalid
427 # shibboleth koha account.
429 $template->param( invalidShibLogin => '1' );
433 $template->param( sessionID => $sessionID );
435 if ( $in->{'type'} eq 'opac' ){
436 require Koha::Virtualshelves;
437 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
443 some_public_shelves => $some_public_shelves,
448 # Sysprefs disabled via URL param
449 # Note that value must be defined in order to override via ENV
450 foreach my $syspref (
456 OpacAdditionalStylesheet
458 intranetcolorstylesheet
463 $ENV{"OVERRIDE_SYSPREF_$syspref"} = q{}
464 if $in->{'query'}->param("DISABLE_SYSPREF_$syspref");
467 # Anonymous opac search history
468 # If opac search history is enabled and at least one search has already been performed
469 if ( C4::Context->preference('EnableOpacSearchHistory') ) {
470 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
471 if (@recentSearches) {
472 $template->param( EnableOpacSearchHistory => 1 );
476 if ( C4::Context->preference('dateformat') ) {
477 $template->param( dateformat => C4::Context->preference('dateformat') );
480 $template->param(auth_forwarded_hash => scalar $in->{'query'}->param('auth_forwarded_hash'));
482 # these template parameters are set the same regardless of $in->{'type'}
484 my $minPasswordLength = C4::Context->preference('minPasswordLength');
485 $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
487 "BiblioDefaultView" . C4::Context->preference("BiblioDefaultView") => 1,
488 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
489 GoogleJackets => C4::Context->preference("GoogleJackets"),
490 OpenLibraryCovers => C4::Context->preference("OpenLibraryCovers"),
491 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
492 LoginBranchcode => ( C4::Context->userenv ? C4::Context->userenv->{"branch"} : undef ),
493 LoginFirstname => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
494 LoginSurname => C4::Context->userenv ? C4::Context->userenv->{"surname"} : "Inconnu",
495 emailaddress => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
496 TagsEnabled => C4::Context->preference("TagsEnabled"),
497 hide_marc => C4::Context->preference("hide_marc"),
498 item_level_itypes => C4::Context->preference('item-level_itypes'),
499 patronimages => C4::Context->preference("patronimages"),
500 singleBranchMode => ( Koha::Libraries->search->count == 1 ),
501 XSLTDetailsDisplay => C4::Context->preference("XSLTDetailsDisplay"),
502 XSLTResultsDisplay => C4::Context->preference("XSLTResultsDisplay"),
503 noItemTypeImages => C4::Context->preference("noItemTypeImages"),
504 marcflavour => C4::Context->preference("marcflavour"),
505 OPACBaseURL => C4::Context->preference('OPACBaseURL'),
506 minPasswordLength => $minPasswordLength,
508 if ( $in->{'type'} eq "intranet" ) {
510 AmazonCoverImages => C4::Context->preference("AmazonCoverImages"),
511 AutoLocation => C4::Context->preference("AutoLocation"),
512 "BiblioDefaultView" . C4::Context->preference("IntranetBiblioDefaultView") => 1,
513 PatronAutoComplete => C4::Context->preference("PatronAutoComplete"),
514 FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
515 IndependentBranches => C4::Context->preference("IndependentBranches"),
516 IntranetNav => C4::Context->preference("IntranetNav"),
517 IntranetmainUserblock => C4::Context->preference("IntranetmainUserblock"),
518 LibraryName => C4::Context->preference("LibraryName"),
519 LoginBranchname => ( C4::Context->userenv ? C4::Context->userenv->{"branchname"} : undef ),
520 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
521 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
522 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
523 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
524 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
525 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
526 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
527 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
528 intranetbookbag => C4::Context->preference("intranetbookbag"),
529 suggestion => C4::Context->preference("suggestion"),
530 virtualshelves => C4::Context->preference("virtualshelves"),
531 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
532 EasyAnalyticalRecords => C4::Context->preference('EasyAnalyticalRecords'),
533 LocalCoverImages => C4::Context->preference('LocalCoverImages'),
534 OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'),
535 AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'),
536 EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'),
537 UseKohaPlugins => C4::Context->preference('UseKohaPlugins'),
538 UseCourseReserves => C4::Context->preference("UseCourseReserves"),
539 useDischarge => C4::Context->preference('useDischarge'),
540 pending_checkout_notes => scalar Koha::Checkouts->search({ noteseen => 0 }),
544 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
546 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
547 my $LibraryNameTitle = C4::Context->preference("LibraryName");
548 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
549 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
551 # clean up the busc param in the session
552 # if the page is not opac-detail and not the "add to list" page
553 # and not the "edit comments" page
554 if ( C4::Context->preference("OpacBrowseResults")
555 && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
557 unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
558 or $pagename =~ /^addbybiblionumber$/
559 or $pagename =~ /^review$/ ) {
560 my $sessionSearch = get_session( $sessionID || $in->{'query'}->cookie("CGISESSID") );
561 $sessionSearch->clear( ["busc"] ) if ( $sessionSearch->param("busc") );
565 # variables passed from CGI: opac_css_override and opac_search_limits.
566 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
567 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
570 ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:([\w-]+)/ ) ||
571 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:([\w-]+)/ ) ||
572 ( $in->{'query'}->param('multibranchlimit') && $in->{'query'}->param('multibranchlimit') =~ /multibranchlimit-(\w+)/ )
574 $opac_name = $1; # opac_search_limit is a branch, so we use it.
575 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
576 $opac_name = $in->{'query'}->param('multibranchlimit');
577 } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
578 $opac_name = C4::Context->userenv->{'branch'};
581 my @search_groups = Koha::Library::Groups->get_search_groups({ interface => 'opac' });
583 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
584 LibrarySearchGroups => \@search_groups,
585 opac_name => $opac_name,
586 LibraryName => "" . C4::Context->preference("LibraryName"),
587 LibraryNameTitle => "" . $LibraryNameTitle,
588 LoginBranchname => C4::Context->userenv ? C4::Context->userenv->{"branchname"} : "",
589 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
590 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
591 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
592 OPACShelfBrowser => "" . C4::Context->preference("OPACShelfBrowser"),
593 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
594 OPACUserCSS => "" . C4::Context->preference("OPACUserCSS"),
595 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
596 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
597 opac_search_limit => $opac_search_limit,
598 opac_limit_override => $opac_limit_override,
599 OpacBrowser => C4::Context->preference("OpacBrowser"),
600 OpacCloud => C4::Context->preference("OpacCloud"),
601 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
602 OpacMainUserBlock => "" . C4::Context->preference("OpacMainUserBlock"),
603 OpacNav => "" . C4::Context->preference("OpacNav"),
604 OpacNavBottom => "" . C4::Context->preference("OpacNavBottom"),
605 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
606 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
607 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
608 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
609 OpacTopissue => C4::Context->preference("OpacTopissue"),
610 RequestOnOpac => C4::Context->preference("RequestOnOpac"),
611 'Version' => C4::Context->preference('Version'),
612 hidelostitems => C4::Context->preference("hidelostitems"),
613 mylibraryfirst => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
614 opacbookbag => "" . C4::Context->preference("opacbookbag"),
615 opaccredits => "" . C4::Context->preference("opaccredits"),
616 OpacFavicon => C4::Context->preference("OpacFavicon"),
617 opacheader => "" . C4::Context->preference("opacheader"),
618 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
619 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
620 OPACUserJS => C4::Context->preference("OPACUserJS"),
621 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
622 OpenLibrarySearch => C4::Context->preference("OpenLibrarySearch"),
623 ShowReviewer => C4::Context->preference("ShowReviewer"),
624 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
625 suggestion => "" . C4::Context->preference("suggestion"),
626 virtualshelves => "" . C4::Context->preference("virtualshelves"),
627 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
628 OPACXSLTDetailsDisplay => C4::Context->preference("OPACXSLTDetailsDisplay"),
629 OPACXSLTResultsDisplay => C4::Context->preference("OPACXSLTResultsDisplay"),
630 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
631 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
632 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
633 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
634 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
635 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
636 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
637 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
638 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
639 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
640 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
641 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
642 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
643 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
644 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
645 useDischarge => C4::Context->preference('useDischarge'),
648 $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
651 # Check if we were asked using parameters to force a specific language
652 if ( defined $in->{'query'}->param('language') ) {
654 # Extract the language, let C4::Languages::getlanguage choose
656 my $language = C4::Languages::getlanguage( $in->{'query'} );
657 my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
658 if ( ref $cookie eq 'ARRAY' ) {
659 push @{$cookie}, $languagecookie;
661 $cookie = [ $cookie, $languagecookie ];
665 return ( $template, $borrowernumber, $cookie, $flags );
670 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
672 Verifies that the user is authorized to run this script. If
673 the user is authorized, a (userid, cookie, session-id, flags)
674 quadruple is returned. If the user is not authorized but does
675 not have the required privilege (see $flagsrequired below), it
676 displays an error page and exits. Otherwise, it displays the
677 login page and exits.
679 Note that C<&checkauth> will return if and only if the user
680 is authorized, so it should be called early on, before any
681 unfinished operations (e.g., if you've opened a file, then
682 C<&checkauth> won't close it for you).
684 C<$query> is the CGI object for the script calling C<&checkauth>.
686 The C<$noauth> argument is optional. If it is set, then no
687 authorization is required for the script.
689 C<&checkauth> fetches user and session information from C<$query> and
690 ensures that the user is authorized to run scripts that require
693 The C<$flagsrequired> argument specifies the required privileges
694 the user must have if the username and password are correct.
695 It should be specified as a reference-to-hash; keys in the hash
696 should be the "flags" for the user, as specified in the Members
697 intranet module. Any key specified must correspond to a "flag"
698 in the userflags table. E.g., { circulate => 1 } would specify
699 that the user must have the "circulate" privilege in order to
700 proceed. To make sure that access control is correct, the
701 C<$flagsrequired> parameter must be specified correctly.
703 Koha also has a concept of sub-permissions, also known as
704 granular permissions. This makes the value of each key
705 in the C<flagsrequired> hash take on an additional
710 The user must have access to all subfunctions of the module
711 specified by the hash key.
715 The user must have access to at least one subfunction of the module
716 specified by the hash key.
718 specific permission, e.g., 'export_catalog'
720 The user must have access to the specific subfunction list, which
721 must correspond to a row in the permissions table.
723 The C<$type> argument specifies whether the template should be
724 retrieved from the opac or intranet directory tree. "opac" is
725 assumed if it is not specified; however, if C<$type> is specified,
726 "intranet" is assumed if it is not "opac".
728 If C<$query> does not have a valid session ID associated with it
729 (i.e., the user has not logged in) or if the session has expired,
730 C<&checkauth> presents the user with a login page (from the point of
731 view of the original script, C<&checkauth> does not return). Once the
732 user has authenticated, C<&checkauth> restarts the original script
733 (this time, C<&checkauth> returns).
735 The login page is provided using a HTML::Template, which is set in the
736 systempreferences table or at the top of this file. The variable C<$type>
737 selects which template to use, either the opac or the intranet
738 authentification template.
740 C<&checkauth> returns a user ID, a cookie, and a session ID. The
741 cookie should be sent back to the browser; it verifies that the user
751 # If version syspref is unavailable, it means Koha is being installed,
752 # and so we must redirect to OPAC maintenance page or to the WebInstaller
753 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
754 if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
755 warn "OPAC Install required, redirecting to maintenance";
756 print $query->redirect("/cgi-bin/koha/maintenance.pl");
759 unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
760 if ( $type ne 'opac' ) {
761 warn "Install required, redirecting to Installer";
762 print $query->redirect("/cgi-bin/koha/installer/install.pl");
764 warn "OPAC Install required, redirecting to maintenance";
765 print $query->redirect("/cgi-bin/koha/maintenance.pl");
770 # check that database and koha version are the same
771 # there is no DB version, it's a fresh install,
772 # go to web installer
773 # there is a DB version, compare it to the code version
774 my $kohaversion = Koha::version();
776 # remove the 3 last . to have a Perl number
777 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
778 $debug and print STDERR "kohaversion : $kohaversion\n";
779 if ( $version < $kohaversion ) {
780 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
781 if ( $type ne 'opac' ) {
782 warn sprintf( $warning, 'Installer' );
783 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
785 warn sprintf( "OPAC: " . $warning, 'maintenance' );
786 print $query->redirect("/cgi-bin/koha/maintenance.pl");
794 open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
795 printf $fh join( "\n", @_ );
799 sub _timeout_syspref {
800 my $default_timeout = 600;
801 my $timeout = C4::Context->preference('timeout') || $default_timeout;
803 # value in days, convert in seconds
804 if ( $timeout =~ /^(\d+)[dD]$/ ) {
805 $timeout = $1 * 86400;
807 # value in hours, convert in seconds
808 elsif ( $timeout =~ /^(\d+)[hH]$/ ) {
809 $timeout = $1 * 3600;
811 elsif ( $timeout !~ m/^\d+$/ ) {
812 warn "The value of the system preference 'timeout' is not correct, defaulting to $default_timeout";
813 $timeout = $default_timeout;
821 $debug and warn "Checking Auth";
823 # Get shibboleth login attribute
824 my $shib = C4::Context->config('useshibboleth') && shib_ok();
825 my $shib_login = $shib ? get_login_shib() : undef;
827 # $authnotrequired will be set for scripts which will run without authentication
828 my $authnotrequired = shift;
829 my $flagsrequired = shift;
831 my $emailaddress = shift;
832 my $template_name = shift;
833 $type = 'opac' unless $type;
835 unless ( C4::Context->preference("OpacPublic") ) {
836 my @allowed_scripts_for_private_opac = qw(
838 opac-registration-email-sent.tt
839 opac-registration-confirmation.tt
840 opac-memberentry-update-submitted.tt
841 opac-password-recovery.tt
843 $authnotrequired = 0 unless grep { $_ eq $template_name }
844 @allowed_scripts_for_private_opac;
847 my $dbh = C4::Context->dbh;
848 my $timeout = _timeout_syspref();
850 _version_check( $type, $query );
855 my ( $userid, $cookie, $sessionID, $flags );
856 my $logout = $query->param('logout.x');
858 my $anon_search_history;
860 # This parameter is the name of the CAS server we want to authenticate against,
861 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
862 my $casparam = $query->param('cas');
863 my $q_userid = $query->param('userid') // '';
867 # Basic authentication is incompatible with the use of Shibboleth,
868 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
869 # and it may not be the attribute we want to use to match the koha login.
871 # Also, do not consider an empty REMOTE_USER.
873 # Finally, after those tests, we can assume (although if it would be better with
874 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
875 # and we can affect it to $userid.
876 if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
878 # Using Basic Authentication, no cookies required
879 $cookie = $query->cookie(
880 -name => 'CGISESSID',
884 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
888 elsif ( $emailaddress) {
889 # the Google OpenID Connect passes an email address
891 elsif ( $sessionID = $query->cookie("CGISESSID") )
892 { # assignment, not comparison
893 $session = get_session($sessionID);
894 C4::Context->_new_userenv($sessionID);
895 my ( $ip, $lasttime, $sessiontype );
898 $s_userid = $session->param('id') // '';
899 C4::Context->set_userenv(
900 $session->param('number'), $s_userid,
901 $session->param('cardnumber'), $session->param('firstname'),
902 $session->param('surname'), $session->param('branch'),
903 $session->param('branchname'), $session->param('flags'),
904 $session->param('emailaddress'), $session->param('branchprinter'),
905 $session->param('shibboleth')
907 C4::Context::set_shelves_userenv( 'bar', $session->param('barshelves') );
908 C4::Context::set_shelves_userenv( 'pub', $session->param('pubshelves') );
909 C4::Context::set_shelves_userenv( 'tot', $session->param('totshelves') );
910 $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
911 $ip = $session->param('ip');
912 $lasttime = $session->param('lasttime');
914 $sessiontype = $session->param('sessiontype') || '';
916 if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
917 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
918 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
921 #if a user enters an id ne to the id in the current session, we need to log them in...
922 #first we need to clear the anonymous session...
923 $debug and warn "query id = $q_userid but session id = $s_userid";
924 $anon_search_history = $session->param('search_history');
927 C4::Context->_unset_userenv($sessionID);
933 # voluntary logout the user
934 # check wether the user was using their shibboleth session or a local one
935 my $shibSuccess = C4::Context->userenv->{'shibboleth'};
938 C4::Context->_unset_userenv($sessionID);
940 #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
944 if ($cas and $caslogout) {
945 logout_cas($query, $type);
948 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
949 if ( $shib and $shib_login and $shibSuccess) {
953 elsif ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
956 $info{'timed_out'} = 1;
961 C4::Context->_unset_userenv($sessionID);
963 #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
967 elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
969 # Different ip than originally logged in from
970 $info{'oldip'} = $ip;
971 $info{'newip'} = $ENV{'REMOTE_ADDR'};
972 $info{'different_ip'} = 1;
975 C4::Context->_unset_userenv($sessionID);
977 #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
982 $cookie = $query->cookie(
983 -name => 'CGISESSID',
984 -value => $session->id,
986 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
988 $session->param( 'lasttime', time() );
989 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...
990 $flags = haspermission( $userid, $flagsrequired );
994 $info{'nopermission'} = 1;
999 unless ( $userid || $sessionID ) {
1000 #we initiate a session prior to checking for a username to allow for anonymous sessions...
1001 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
1003 # Save anonymous search history in new session so it can be retrieved
1004 # by get_template_and_user to store it in user's search history after
1005 # a successful login.
1006 if ($anon_search_history) {
1007 $session->param( 'search_history', $anon_search_history );
1010 $sessionID = $session->id;
1011 C4::Context->_new_userenv($sessionID);
1012 $cookie = $query->cookie(
1013 -name => 'CGISESSID',
1014 -value => $session->id,
1016 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1018 my $pki_field = C4::Context->preference('AllowPKIAuth');
1019 if ( !defined($pki_field) ) {
1020 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
1021 $pki_field = 'None';
1023 if ( ( $cas && $query->param('ticket') )
1025 || ( $shib && $shib_login )
1026 || $pki_field ne 'None'
1029 my $password = $query->param('password');
1030 my $shibSuccess = 0;
1031 my ( $return, $cardnumber );
1033 # If shib is enabled and we have a shib login, does the login match a valid koha user
1034 if ( $shib && $shib_login ) {
1037 # Do not pass password here, else shib will not be checked in checkpw.
1038 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $q_userid, undef, $query );
1039 $userid = $retuserid;
1040 $shibSuccess = $return;
1041 $info{'invalidShibLogin'} = 1 unless ($return);
1044 # If shib login and match were successful, skip further login methods
1045 unless ($shibSuccess) {
1046 if ( $cas && $query->param('ticket') ) {
1048 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1049 checkpw( $dbh, $userid, $password, $query, $type );
1050 $userid = $retuserid;
1051 $info{'invalidCasLogin'} = 1 unless ($return);
1054 elsif ( $emailaddress ) {
1055 my $value = $emailaddress;
1057 # If we're looking up the email, there's a chance that the person
1058 # doesn't have a userid. So if there is none, we pass along the
1059 # borrower number, and the bits of code that need to know the user
1060 # ID will have to be smart enough to handle that.
1061 my $patrons = Koha::Patrons->search({ email => $value });
1062 if ($patrons->count) {
1064 # First the userid, then the borrowernum
1065 my $patron = $patrons->next;
1066 $value = $patron->userid || $patron->borrowernumber;
1070 $return = $value ? 1 : 0;
1075 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1076 || ( $pki_field eq 'emailAddress'
1077 && $ENV{'SSL_CLIENT_S_DN_Email'} )
1081 if ( $pki_field eq 'Common Name' ) {
1082 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1084 elsif ( $pki_field eq 'emailAddress' ) {
1085 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1087 # If we're looking up the email, there's a chance that the person
1088 # doesn't have a userid. So if there is none, we pass along the
1089 # borrower number, and the bits of code that need to know the user
1090 # ID will have to be smart enough to handle that.
1091 my $patrons = Koha::Patrons->search({ email => $value });
1092 if ($patrons->count) {
1094 # First the userid, then the borrowernum
1095 my $patron = $patrons->next;
1096 $value = $patron->userid || $patron->borrowernumber;
1102 $return = $value ? 1 : 0;
1108 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1109 checkpw( $dbh, $q_userid, $password, $query, $type );
1110 $userid = $retuserid if ($retuserid);
1111 $info{'invalid_username_or_password'} = 1 unless ($return);
1115 # $return: 1 = valid user
1118 #_session_log(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
1119 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1123 $info{'nopermission'} = 1;
1124 C4::Context->_unset_userenv($sessionID);
1126 my ( $borrowernumber, $firstname, $surname, $userflags,
1127 $branchcode, $branchname, $branchprinter, $emailaddress, $register_id, $register_name );
1129 if ( $return == 1 ) {
1131 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1132 branches.branchname as branchname,
1133 branches.branchprinter as branchprinter,
1136 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1138 my $sth = $dbh->prepare("$select where userid=?");
1139 $sth->execute($userid);
1140 unless ( $sth->rows ) {
1141 $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
1142 $sth = $dbh->prepare("$select where cardnumber=?");
1143 $sth->execute($cardnumber);
1145 unless ( $sth->rows ) {
1146 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1147 $sth->execute($userid);
1148 unless ( $sth->rows ) {
1149 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1154 ( $borrowernumber, $firstname, $surname, $userflags,
1155 $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow;
1156 $debug and print STDERR "AUTH_3 results: " .
1157 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1159 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1162 # launch a sequence to check if we have a ip for the branch, i
1163 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1165 my $ip = $ENV{'REMOTE_ADDR'};
1167 # if they specify at login, use that
1168 if ( $query->param('branch') ) {
1169 $branchcode = $query->param('branch');
1170 my $library = Koha::Libraries->find($branchcode);
1171 $branchname = $library? $library->branchname: '';
1173 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1174 if ( $type ne 'opac' and C4::Context->boolean_preference('AutoLocation') ) {
1176 # we have to check they are coming from the right ip range
1177 my $domain = $branches->{$branchcode}->{'branchip'};
1178 $domain =~ s|\.\*||g;
1179 if ( $ip !~ /^$domain/ ) {
1181 $cookie = $query->cookie(
1182 -name => 'CGISESSID',
1185 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1187 $info{'wrongip'} = 1;
1191 foreach my $br ( keys %$branches ) {
1193 # now we work with the treatment of ip
1194 my $domain = $branches->{$br}->{'branchip'};
1195 if ( $domain && $ip =~ /^$domain/ ) {
1196 $branchcode = $branches->{$br}->{'branchcode'};
1198 # new op dev : add the branchprinter and branchname in the cookie
1199 $branchprinter = $branches->{$br}->{'branchprinter'};
1200 $branchname = $branches->{$br}->{'branchname'};
1204 my $is_sco_user = 0;
1205 if ( $query->param('sco_user_login') && ( $query->param('sco_user_login') eq '1' ) ){
1209 $session->param( 'number', $borrowernumber );
1210 $session->param( 'id', $userid );
1211 $session->param( 'cardnumber', $cardnumber );
1212 $session->param( 'firstname', $firstname );
1213 $session->param( 'surname', $surname );
1214 $session->param( 'branch', $branchcode );
1215 $session->param( 'branchname', $branchname );
1216 $session->param( 'flags', $userflags );
1217 $session->param( 'emailaddress', $emailaddress );
1218 $session->param( 'ip', $session->remote_addr() );
1219 $session->param( 'lasttime', time() );
1220 $session->param( 'interface', $type);
1221 $session->param( 'shibboleth', $shibSuccess );
1222 $session->param( 'register_id', $register_id );
1223 $session->param( 'register_name', $register_name );
1224 $session->param( 'sco_user', $is_sco_user );
1226 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1227 C4::Context->set_userenv(
1228 $session->param('number'), $session->param('id'),
1229 $session->param('cardnumber'), $session->param('firstname'),
1230 $session->param('surname'), $session->param('branch'),
1231 $session->param('branchname'), $session->param('flags'),
1232 $session->param('emailaddress'), $session->param('branchprinter'),
1233 $session->param('shibboleth')
1237 # $return: 0 = invalid user
1238 # reset to anonymous session
1240 $debug and warn "Login failed, resetting anonymous session...";
1242 $info{'invalid_username_or_password'} = 1;
1243 C4::Context->_unset_userenv($sessionID);
1245 $session->param( 'lasttime', time() );
1246 $session->param( 'ip', $session->remote_addr() );
1247 $session->param( 'sessiontype', 'anon' );
1248 $session->param( 'interface', $type);
1250 } # END if ( $q_userid
1251 elsif ( $type eq "opac" ) {
1253 # if we are here this is an anonymous session; add public lists to it and a few other items...
1254 # anonymous sessions are created only for the OPAC
1255 $debug and warn "Initiating an anonymous session...";
1257 # setting a couple of other session vars...
1258 $session->param( 'ip', $session->remote_addr() );
1259 $session->param( 'lasttime', time() );
1260 $session->param( 'sessiontype', 'anon' );
1261 $session->param( 'interface', $type);
1263 } # END unless ($userid)
1265 # finished authentification, now respond
1266 if ( $loggedin || $authnotrequired )
1270 $cookie = $query->cookie(
1271 -name => 'CGISESSID',
1274 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1278 track_login_daily( $userid );
1280 # In case, that this request was a login attempt, we want to prevent that users can repost the opac login
1281 # request. We therefore redirect the user to the requested page again without the login parameters.
1282 # See Post/Redirect/Get (PRG) design pattern: https://en.wikipedia.org/wiki/Post/Redirect/Get
1283 if ( $type eq "opac" && $query->param('koha_login_context') && $query->param('koha_login_context') ne 'sco' && $query->param('password') && $query->param('userid') ) {
1284 my $uri = URI->new($query->url(-relative=>1, -query_string=>1));
1285 $uri->query_param_delete('userid');
1286 $uri->query_param_delete('password');
1287 $uri->query_param_delete('koha_login_context');
1288 print $query->redirect(-uri => $uri->as_string, -cookie => $cookie, -status=>'303 See other');
1292 return ( $userid, $cookie, $sessionID, $flags );
1297 # AUTH rejected, show the login/password template, after checking the DB.
1301 # get the inputs from the incoming query
1303 foreach my $name ( param $query) {
1304 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1305 my @value = $query->multi_param($name);
1306 push @inputs, { name => $name, value => $_ } for @value;
1309 my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1311 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1312 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1313 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1315 my $auth_template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1316 my $template = C4::Templates::gettemplate( $auth_template_name, $type, $query );
1320 script_name => get_script_name(),
1321 casAuthentication => C4::Context->preference("casAuthentication"),
1322 shibbolethAuthentication => $shib,
1323 SessionRestrictionByIP => C4::Context->preference("SessionRestrictionByIP"),
1324 suggestion => C4::Context->preference("suggestion"),
1325 virtualshelves => C4::Context->preference("virtualshelves"),
1326 LibraryName => "" . C4::Context->preference("LibraryName"),
1327 LibraryNameTitle => "" . $LibraryNameTitle,
1328 opacuserlogin => C4::Context->preference("opacuserlogin"),
1329 OpacNav => C4::Context->preference("OpacNav"),
1330 OpacNavBottom => C4::Context->preference("OpacNavBottom"),
1331 opaccredits => C4::Context->preference("opaccredits"),
1332 OpacFavicon => C4::Context->preference("OpacFavicon"),
1333 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1334 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1335 OPACUserJS => C4::Context->preference("OPACUserJS"),
1336 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1337 OpacCloud => C4::Context->preference("OpacCloud"),
1338 OpacTopissue => C4::Context->preference("OpacTopissue"),
1339 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1340 OpacBrowser => C4::Context->preference("OpacBrowser"),
1341 opacheader => C4::Context->preference("opacheader"),
1342 TagsEnabled => C4::Context->preference("TagsEnabled"),
1343 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1344 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1345 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1346 intranetbookbag => C4::Context->preference("intranetbookbag"),
1347 IntranetNav => C4::Context->preference("IntranetNav"),
1348 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1349 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
1350 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1351 IndependentBranches => C4::Context->preference("IndependentBranches"),
1352 AutoLocation => C4::Context->preference("AutoLocation"),
1353 wrongip => $info{'wrongip'},
1354 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1355 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1356 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1357 too_many_login_attempts => ( $patron and $patron->account_locked )
1360 $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1361 $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1362 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1363 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1365 if ( $type eq 'opac' ) {
1366 require Koha::Virtualshelves;
1367 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1373 some_public_shelves => $some_public_shelves,
1379 # Is authentication against multiple CAS servers enabled?
1380 if ( C4::Auth_with_cas::multipleAuth && !$casparam ) {
1381 my $casservers = C4::Auth_with_cas::getMultipleAuth();
1383 foreach my $key ( keys %$casservers ) {
1384 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1387 casServersLoop => \@tmplservers
1391 casServerUrl => login_cas_url($query, undef, $type),
1396 invalidCasLogin => $info{'invalidCasLogin'}
1402 shibbolethAuthentication => $shib,
1403 shibbolethLoginUrl => login_shib_url($query),
1407 if (C4::Context->preference('GoogleOpenIDConnect')) {
1408 if ($query->param("OpenIDConnectFailed")) {
1409 my $reason = $query->param('OpenIDConnectFailed');
1410 $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1415 LibraryName => C4::Context->preference("LibraryName"),
1417 $template->param(%info);
1419 # $cookie = $query->cookie(CGISESSID => $session->id
1421 print $query->header(
1422 { type => 'text/html',
1425 'X-Frame-Options' => 'SAMEORIGIN'
1432 =head2 check_api_auth
1434 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1436 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1437 cookie, determine if the user has the privileges specified by C<$userflags>.
1439 C<check_api_auth> is is meant for authenticating users of web services, and
1440 consequently will always return and will not attempt to redirect the user
1443 If a valid session cookie is already present, check_api_auth will return a status
1444 of "ok", the cookie, and the Koha session ID.
1446 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1447 parameters and create a session cookie and Koha session if the supplied credentials
1450 Possible return values in C<$status> are:
1454 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1456 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1458 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1460 =item "expired -- session cookie has expired; API user should resubmit userid and password
1466 sub check_api_auth {
1469 my $flagsrequired = shift;
1470 my $dbh = C4::Context->dbh;
1471 my $timeout = _timeout_syspref();
1473 unless ( C4::Context->preference('Version') ) {
1475 # database has not been installed yet
1476 return ( "maintenance", undef, undef );
1478 my $kohaversion = Koha::version();
1479 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1480 if ( C4::Context->preference('Version') < $kohaversion ) {
1482 # database in need of version update; assume that
1483 # no API should be called while databsae is in
1485 return ( "maintenance", undef, undef );
1488 # FIXME -- most of what follows is a copy-and-paste
1489 # of code from checkauth. There is an obvious need
1490 # for refactoring to separate the various parts of
1491 # the authentication code, but as of 2007-11-19 this
1492 # is deferred so as to not introduce bugs into the
1493 # regular authentication code for Koha 3.0.
1495 # see if we have a valid session cookie already
1496 # however, if a userid parameter is present (i.e., from
1497 # a form submission, assume that any current cookie
1499 my $sessionID = undef;
1500 unless ( $query->param('userid') ) {
1501 $sessionID = $query->cookie("CGISESSID");
1503 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1504 my $session = get_session($sessionID);
1505 C4::Context->_new_userenv($sessionID);
1507 C4::Context->interface($session->param('interface'));
1508 C4::Context->set_userenv(
1509 $session->param('number'), $session->param('id'),
1510 $session->param('cardnumber'), $session->param('firstname'),
1511 $session->param('surname'), $session->param('branch'),
1512 $session->param('branchname'), $session->param('flags'),
1513 $session->param('emailaddress'), $session->param('branchprinter')
1516 my $ip = $session->param('ip');
1517 my $lasttime = $session->param('lasttime');
1518 my $userid = $session->param('id');
1519 if ( $lasttime < time() - $timeout ) {
1524 C4::Context->_unset_userenv($sessionID);
1527 return ( "expired", undef, undef );
1528 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1530 # IP address changed
1533 C4::Context->_unset_userenv($sessionID);
1536 return ( "expired", undef, undef );
1538 my $cookie = $query->cookie(
1539 -name => 'CGISESSID',
1540 -value => $session->id,
1542 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1544 $session->param( 'lasttime', time() );
1545 my $flags = haspermission( $userid, $flagsrequired );
1547 return ( "ok", $cookie, $sessionID );
1551 C4::Context->_unset_userenv($sessionID);
1554 return ( "failed", undef, undef );
1558 return ( "expired", undef, undef );
1563 my $userid = $query->param('userid');
1564 my $password = $query->param('password');
1565 my ( $return, $cardnumber, $cas_ticket );
1568 if ( $cas && $query->param('PT') ) {
1570 $debug and print STDERR "## check_api_auth - checking CAS\n";
1572 # In case of a CAS authentication, we use the ticket instead of the password
1573 my $PT = $query->param('PT');
1574 ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $dbh, $PT, $query ); # EXTERNAL AUTH
1577 # User / password auth
1578 unless ( $userid and $password ) {
1580 # caller did something wrong, fail the authenticateion
1581 return ( "failed", undef, undef );
1584 ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $dbh, $userid, $password, $query );
1587 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1588 my $session = get_session("");
1589 return ( "failed", undef, undef ) unless $session;
1591 my $sessionID = $session->id;
1592 C4::Context->_new_userenv($sessionID);
1593 my $cookie = $query->cookie(
1594 -name => 'CGISESSID',
1595 -value => $sessionID,
1597 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1599 if ( $return == 1 ) {
1601 $borrowernumber, $firstname, $surname,
1602 $userflags, $branchcode, $branchname,
1603 $branchprinter, $emailaddress
1607 "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=?"
1609 $sth->execute($userid);
1611 $borrowernumber, $firstname, $surname,
1612 $userflags, $branchcode, $branchname,
1613 $branchprinter, $emailaddress
1614 ) = $sth->fetchrow if ( $sth->rows );
1616 unless ( $sth->rows ) {
1617 my $sth = $dbh->prepare(
1618 "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=?"
1620 $sth->execute($cardnumber);
1622 $borrowernumber, $firstname, $surname,
1623 $userflags, $branchcode, $branchname,
1624 $branchprinter, $emailaddress
1625 ) = $sth->fetchrow if ( $sth->rows );
1627 unless ( $sth->rows ) {
1628 $sth->execute($userid);
1630 $borrowernumber, $firstname, $surname, $userflags,
1631 $branchcode, $branchname, $branchprinter, $emailaddress
1632 ) = $sth->fetchrow if ( $sth->rows );
1636 my $ip = $ENV{'REMOTE_ADDR'};
1638 # if they specify at login, use that
1639 if ( $query->param('branch') ) {
1640 $branchcode = $query->param('branch');
1641 my $library = Koha::Libraries->find($branchcode);
1642 $branchname = $library? $library->branchname: '';
1644 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1645 foreach my $br ( keys %$branches ) {
1647 # now we work with the treatment of ip
1648 my $domain = $branches->{$br}->{'branchip'};
1649 if ( $domain && $ip =~ /^$domain/ ) {
1650 $branchcode = $branches->{$br}->{'branchcode'};
1652 # new op dev : add the branchprinter and branchname in the cookie
1653 $branchprinter = $branches->{$br}->{'branchprinter'};
1654 $branchname = $branches->{$br}->{'branchname'};
1657 $session->param( 'number', $borrowernumber );
1658 $session->param( 'id', $userid );
1659 $session->param( 'cardnumber', $cardnumber );
1660 $session->param( 'firstname', $firstname );
1661 $session->param( 'surname', $surname );
1662 $session->param( 'branch', $branchcode );
1663 $session->param( 'branchname', $branchname );
1664 $session->param( 'flags', $userflags );
1665 $session->param( 'emailaddress', $emailaddress );
1666 $session->param( 'ip', $session->remote_addr() );
1667 $session->param( 'lasttime', time() );
1668 $session->param( 'interface', 'api' );
1670 $session->param( 'cas_ticket', $cas_ticket);
1671 C4::Context->set_userenv(
1672 $session->param('number'), $session->param('id'),
1673 $session->param('cardnumber'), $session->param('firstname'),
1674 $session->param('surname'), $session->param('branch'),
1675 $session->param('branchname'), $session->param('flags'),
1676 $session->param('emailaddress'), $session->param('branchprinter')
1678 return ( "ok", $cookie, $sessionID );
1680 return ( "failed", undef, undef );
1685 =head2 check_cookie_auth
1687 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1689 Given a CGISESSID cookie set during a previous login to Koha, determine
1690 if the user has the privileges specified by C<$userflags>. C<$userflags>
1691 is passed unaltered into C<haspermission> and as such accepts all options
1692 avaiable to that routine with the one caveat that C<check_api_auth> will
1693 also allow 'undef' to be passed and in such a case the permissions check
1694 will be skipped altogether.
1696 C<check_cookie_auth> is meant for authenticating special services
1697 such as tools/upload-file.pl that are invoked by other pages that
1698 have been authenticated in the usual way.
1700 Possible return values in C<$status> are:
1704 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1706 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1708 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1710 =item "expired -- session cookie has expired; API user should resubmit userid and password
1716 sub check_cookie_auth {
1718 my $flagsrequired = shift;
1721 my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1722 my $dbh = C4::Context->dbh;
1723 my $timeout = _timeout_syspref();
1725 unless ( C4::Context->preference('Version') ) {
1727 # database has not been installed yet
1728 return ( "maintenance", undef );
1730 my $kohaversion = Koha::version();
1731 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1732 if ( C4::Context->preference('Version') < $kohaversion ) {
1734 # database in need of version update; assume that
1735 # no API should be called while databsae is in
1737 return ( "maintenance", undef );
1740 # FIXME -- most of what follows is a copy-and-paste
1741 # of code from checkauth. There is an obvious need
1742 # for refactoring to separate the various parts of
1743 # the authentication code, but as of 2007-11-23 this
1744 # is deferred so as to not introduce bugs into the
1745 # regular authentication code for Koha 3.0.
1747 # see if we have a valid session cookie already
1748 # however, if a userid parameter is present (i.e., from
1749 # a form submission, assume that any current cookie
1751 unless ( defined $cookie and $cookie ) {
1752 return ( "failed", undef );
1754 my $sessionID = $cookie;
1755 my $session = get_session($sessionID);
1756 C4::Context->_new_userenv($sessionID);
1758 C4::Context->interface($session->param('interface'));
1759 C4::Context->set_userenv(
1760 $session->param('number'), $session->param('id'),
1761 $session->param('cardnumber'), $session->param('firstname'),
1762 $session->param('surname'), $session->param('branch'),
1763 $session->param('branchname'), $session->param('flags'),
1764 $session->param('emailaddress'), $session->param('branchprinter')
1767 my $ip = $session->param('ip');
1768 my $lasttime = $session->param('lasttime');
1769 my $userid = $session->param('id');
1770 if ( $lasttime < time() - $timeout ) {
1775 C4::Context->_unset_userenv($sessionID);
1778 return ("expired", undef);
1779 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1781 # IP address changed
1784 C4::Context->_unset_userenv($sessionID);
1787 return ( "expired", undef );
1789 $session->param( 'lasttime', time() );
1790 my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1792 return ( "ok", $sessionID );
1796 C4::Context->_unset_userenv($sessionID);
1799 return ( "failed", undef );
1803 return ( "expired", undef );
1810 my $session = get_session($sessionID);
1812 Given a session ID, retrieve the CGI::Session object used to store
1813 the session's state. The session object can be used to store
1814 data that needs to be accessed by different scripts during a
1817 If the C<$sessionID> parameter is an empty string, a new session
1822 sub _get_session_params {
1823 my $storage_method = C4::Context->preference('SessionStorage');
1824 if ( $storage_method eq 'mysql' ) {
1825 my $dbh = C4::Context->dbh;
1826 return { dsn => "driver:MySQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1828 elsif ( $storage_method eq 'Pg' ) {
1829 my $dbh = C4::Context->dbh;
1830 return { dsn => "driver:PostgreSQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1832 elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1833 my $memcached = Koha::Caches->get_instance()->memcached_cache;
1834 return { dsn => "driver:memcached;serializer:yaml;id:md5", dsn_args => { Memcached => $memcached } };
1837 # catch all defaults to tmp should work on all systems
1838 my $dir = C4::Context::temporary_directory;
1839 my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1840 return { dsn => "driver:File;serializer:yaml;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1845 my $sessionID = shift;
1846 my $params = _get_session_params();
1847 return new CGI::Session( $params->{dsn}, $sessionID, $params->{dsn_args} );
1851 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1852 # (or something similar)
1853 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1854 # not having a userenv defined could cause a crash.
1856 my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1857 $type = 'opac' unless $type;
1859 # Get shibboleth login attribute
1860 my $shib = C4::Context->config('useshibboleth') && shib_ok();
1861 my $shib_login = $shib ? get_login_shib() : undef;
1865 if ( defined $userid ){
1866 $patron = Koha::Patrons->find({ userid => $userid });
1867 $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1869 my $check_internal_as_fallback = 0;
1871 # Note: checkpw_* routines returns:
1874 # -1 if user bind failed (LDAP only)
1876 if ( $patron and $patron->account_locked ) {
1877 # Nothing to check, account is locked
1878 } elsif ($ldap && defined($password)) {
1879 $debug and print STDERR "## checkpw - checking LDAP\n";
1880 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
1881 if ( $retval == 1 ) {
1882 @return = ( $retval, $retcard, $retuserid );
1885 $check_internal_as_fallback = 1 if $retval == 0;
1887 } elsif ( $cas && $query && $query->param('ticket') ) {
1888 $debug and print STDERR "## checkpw - checking CAS\n";
1890 # In case of a CAS authentication, we use the ticket instead of the password
1891 my $ticket = $query->param('ticket');
1892 $query->delete('ticket'); # remove ticket to come back to original URL
1893 my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $dbh, $ticket, $query, $type ); # EXTERNAL AUTH
1895 @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1899 $passwd_ok = $retval;
1902 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1903 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1905 elsif ( $shib && $shib_login && !$password ) {
1907 $debug and print STDERR "## checkpw - checking Shibboleth\n";
1909 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1910 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1911 # shibboleth-authenticated user
1913 # Then, we check if it matches a valid koha user
1915 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
1917 @return = ( $retval, $retcard, $retuserid );
1919 $passwd_ok = $retval;
1922 $check_internal_as_fallback = 1;
1926 if ( $check_internal_as_fallback ) {
1927 @return = checkpw_internal( $dbh, $userid, $password, $no_set_userenv);
1928 $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1933 $patron->update({ login_attempts => 0 });
1934 } elsif( !$patron->account_locked ) {
1935 $patron->update({ login_attempts => $patron->login_attempts + 1 });
1941 sub checkpw_internal {
1942 my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
1944 $password = Encode::encode( 'UTF-8', $password )
1945 if Encode::is_utf8($password);
1949 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1951 $sth->execute($userid);
1953 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1954 $surname, $branchcode, $branchname, $flags )
1957 if ( checkpw_hash( $password, $stored_hash ) ) {
1959 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1960 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1961 return 1, $cardnumber, $userid;
1966 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1968 $sth->execute($userid);
1970 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1971 $surname, $branchcode, $branchname, $flags )
1974 if ( checkpw_hash( $password, $stored_hash ) ) {
1976 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1977 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1978 return 1, $cardnumber, $userid;
1985 my ( $password, $stored_hash ) = @_;
1987 return if $stored_hash eq '!';
1989 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1991 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1992 $hash = hash_password( $password, $stored_hash );
1994 $hash = md5_base64($password);
1996 return $hash eq $stored_hash;
2001 my $authflags = getuserflags($flags, $userid, [$dbh]);
2003 Translates integer flags into permissions strings hash.
2005 C<$flags> is the integer userflags value ( borrowers.userflags )
2006 C<$userid> is the members.userid, used for building subpermissions
2007 C<$authflags> is a hashref of permissions
2014 my $dbh = @_ ? shift : C4::Context->dbh;
2017 # I don't want to do this, but if someone logs in as the database
2018 # user, it would be preferable not to spam them to death with
2019 # numeric warnings. So, we make $flags numeric.
2020 no warnings 'numeric';
2023 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
2026 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
2027 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
2028 $userflags->{$flag} = 1;
2031 $userflags->{$flag} = 0;
2035 # get subpermissions and merge with top-level permissions
2036 my $user_subperms = get_user_subpermissions($userid);
2037 foreach my $module ( keys %$user_subperms ) {
2038 next if $userflags->{$module} == 1; # user already has permission for everything in this module
2039 $userflags->{$module} = $user_subperms->{$module};
2045 =head2 get_user_subpermissions
2047 $user_perm_hashref = get_user_subpermissions($userid);
2049 Given the userid (note, not the borrowernumber) of a staff user,
2050 return a hashref of hashrefs of the specific subpermissions
2051 accorded to the user. An example return is
2055 export_catalog => 1,
2056 import_patrons => 1,
2060 The top-level hash-key is a module or function code from
2061 userflags.flag, while the second-level key is a code
2064 The results of this function do not give a complete picture
2065 of the functions that a staff user can access; it is also
2066 necessary to check borrowers.flags.
2070 sub get_user_subpermissions {
2073 my $dbh = C4::Context->dbh;
2074 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2075 FROM user_permissions
2076 JOIN permissions USING (module_bit, code)
2077 JOIN userflags ON (module_bit = bit)
2078 JOIN borrowers USING (borrowernumber)
2079 WHERE userid = ?" );
2080 $sth->execute($userid);
2082 my $user_perms = {};
2083 while ( my $perm = $sth->fetchrow_hashref ) {
2084 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2089 =head2 get_all_subpermissions
2091 my $perm_hashref = get_all_subpermissions();
2093 Returns a hashref of hashrefs defining all specific
2094 permissions currently defined. The return value
2095 has the same structure as that of C<get_user_subpermissions>,
2096 except that the innermost hash value is the description
2097 of the subpermission.
2101 sub get_all_subpermissions {
2102 my $dbh = C4::Context->dbh;
2103 my $sth = $dbh->prepare( "SELECT flag, code
2105 JOIN userflags ON (module_bit = bit)" );
2109 while ( my $perm = $sth->fetchrow_hashref ) {
2110 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2115 =head2 haspermission
2117 $flagsrequired = '*'; # Any permission at all
2118 $flagsrequired = 'a_flag'; # a_flag must be satisfied (all subpermissions)
2119 $flagsrequired = [ 'a_flag', 'b_flag' ]; # a_flag OR b_flag must be satisfied
2120 $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 }; # a_flag AND b_flag must be satisfied
2121 $flagsrequired = { 'a_flag' => 'sub_a' }; # sub_a of a_flag must be satisfied
2122 $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2124 $flags = ($userid, $flagsrequired);
2126 C<$userid> the userid of the member
2127 C<$flags> is a query structure similar to that used by SQL::Abstract that
2128 denotes the combination of flags required. It is a required parameter.
2130 The main logic of this method is that things in arrays are OR'ed, and things
2131 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2133 Returns member's flags or 0 if a permission is not met.
2138 my ($required, $flags) = @_;
2140 my $ref = ref($required);
2142 if ($required eq '*') {
2143 return 0 unless ( $flags or ref( $flags ) );
2145 return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2147 } elsif ($ref eq 'HASH') {
2148 foreach my $key (keys %{$required}) {
2149 next if $flags == 1;
2150 my $require = $required->{$key};
2151 my $rflags = $flags->{$key};
2152 return 0 unless _dispatch($require, $rflags);
2154 } elsif ($ref eq 'ARRAY') {
2156 foreach my $require ( @{$required} ) {
2158 ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2159 ? $flags->{$require}
2161 $satisfied++ if _dispatch( $require, $rflags );
2163 return 0 unless $satisfied;
2165 croak "Unexpected structure found: $ref";
2172 my ( $userid, $flagsrequired ) = @_;
2174 #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2175 # unless defined($flagsrequired);
2177 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2178 $sth->execute($userid);
2179 my $row = $sth->fetchrow();
2180 my $flags = getuserflags( $row, $userid );
2182 return $flags unless defined($flagsrequired);
2183 return $flags if $flags->{superlibrarian};
2184 return _dispatch($flagsrequired, $flags);
2186 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2191 $flags = ($iprange);
2193 C<$iprange> A space separated string describing an IP range. Can include single IPs or ranges
2195 Returns 1 if the remote address is in the provided iprange, or 0 otherwise.
2202 my @allowedipranges = $iprange ? split(' ', $iprange) : ();
2203 if (scalar @allowedipranges > 0) {
2205 eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2206 eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || ( $ENV{DEBUG} && warn 'cidrlookup failed for ' . join(' ',@rangelist) );
2208 return $result ? 1 : 0;
2211 sub getborrowernumber {
2213 my $userenv = C4::Context->userenv;
2214 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2215 return $userenv->{number};
2217 my $dbh = C4::Context->dbh;
2218 for my $field ( 'userid', 'cardnumber' ) {
2220 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2221 $sth->execute($userid);
2223 my ($bnumber) = $sth->fetchrow;
2230 =head2 track_login_daily
2232 track_login_daily( $userid );
2234 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2238 sub track_login_daily {
2240 return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2242 my $cache = Koha::Caches->get_instance();
2243 my $cache_key = "track_login_" . $userid;
2244 my $cached = $cache->get_from_cache($cache_key);
2245 my $today = dt_from_string()->ymd;
2246 return if $cached && $cached eq $today;
2248 my $patron = Koha::Patrons->find({ userid => $userid });
2249 return unless $patron;
2250 $patron->track_login;
2251 $cache->set_in_cache( $cache_key, $today );
2254 END { } # module clean-up code here (global destructor)
2264 Crypt::Eksblowfish::Bcrypt(3)