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;
41 use Koha::Cash::Registers;
44 use Koha::Patron::Consents;
45 use POSIX qw/strftime/;
46 use List::MoreUtils qw/ any /;
47 use Encode qw( encode is_utf8);
48 use C4::Auth_with_shibboleth;
50 use C4::Log qw/logaction/;
53 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout);
56 sub psgi_env { any { /^psgi\./ } keys %ENV }
59 if (psgi_env) { die 'psgi:exit' }
63 C4::Context->set_remote_address;
67 @EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
68 @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash
69 &get_all_subpermissions &get_user_subpermissions track_login_daily &in_iprange
71 %EXPORT_TAGS = ( EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)] );
72 $ldap = C4::Context->config('useldapserver') || 0;
73 $cas = C4::Context->preference('casAuthentication');
74 $caslogout = C4::Context->preference('casLogout');
75 require C4::Auth_with_cas; # no import
78 require C4::Auth_with_ldap;
79 import C4::Auth_with_ldap qw(checkpw_ldap);
82 import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url logout_if_required);
89 C4::Auth - Authenticates Koha users
99 my ($template, $borrowernumber, $cookie)
100 = get_template_and_user(
102 template_name => "opac-main.tt",
105 authnotrequired => 0,
106 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
110 output_html_with_http_headers $query, $cookie, $template->output;
114 The main function of this module is to provide
115 authentification. However the get_template_and_user function has
116 been provided so that a users login information is passed along
117 automatically. This gets loaded into the template.
121 =head2 get_template_and_user
123 my ($template, $borrowernumber, $cookie)
124 = get_template_and_user(
126 template_name => "opac-main.tt",
129 authnotrequired => 0,
130 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
134 This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
135 to C<&checkauth> (in this module) to perform authentification.
136 See C<&checkauth> for an explanation of these parameters.
138 The C<template_name> is then used to find the correct template for
139 the page. The authenticated users details are loaded onto the
140 template in the logged_in_user variable (which is a Koha::Patron object). Also the
141 C<sessionID> is passed to the template. This can be used in templates
142 if cookies are disabled. It needs to be put as and input to every
145 More information on the C<gettemplate> sub can be found in the
150 sub get_template_and_user {
153 my ( $user, $cookie, $sessionID, $flags );
155 # Get shibboleth login attribute
156 my $shib = C4::Context->config('useshibboleth') && shib_ok();
157 my $shib_login = $shib ? get_login_shib() : undef;
159 C4::Context->interface( $in->{type} );
161 $in->{'authnotrequired'} ||= 0;
163 # the following call includes a bad template check; might croak
164 my $template = C4::Templates::gettemplate(
165 $in->{'template_name'},
170 if ( $in->{'template_name'} !~ m/maintenance/ ) {
171 ( $user, $cookie, $sessionID, $flags ) = checkauth(
173 $in->{'authnotrequired'},
174 $in->{'flagsrequired'},
177 $in->{template_name},
181 # If we enforce GDPR and the user did not consent, redirect
182 # Exceptions for consent page itself and SCI/SCO system
183 if( $in->{type} eq 'opac' && $user &&
184 $in->{'template_name'} !~ /^(opac-patron-consent|sc[io]\/)/ &&
185 C4::Context->preference('GDPR_Policy') eq 'Enforced' )
187 my $consent = Koha::Patron::Consents->search({
188 borrowernumber => getborrowernumber($user),
189 type => 'GDPR_PROCESSING',
190 given_on => { '!=', undef },
193 print $in->{query}->redirect(-uri => '/cgi-bin/koha/opac-patron-consent.pl', -cookie => $cookie);
198 if ( $in->{type} eq 'opac' && $user ) {
202 # If the user logged in is the SCO user and they try to go out of the SCO module,
203 # log the user out removing the CGISESSID cookie
204 $in->{template_name} !~ m|sco/| && $in->{template_name} !~ m|errors/errorpage.tt|
205 && C4::Context->preference('AutoSelfCheckID')
206 && $user eq C4::Context->preference('AutoSelfCheckID')
212 # If the user logged in is the SCI user and they try to go out of the SCI module,
213 # kick them out unless it is SCO with a valid permission
214 # or they are a superlibrarian
215 $in->{template_name} !~ m|sci/|
216 && haspermission( $user, { self_check => 'self_checkin_module' } )
218 $in->{template_name} =~ m|sco/| && haspermission(
219 $user, { self_check => 'self_checkout_module' }
222 && $flags && $flags->{superlibrarian} != 1
229 $template = C4::Templates::gettemplate( 'opac-auth.tt', 'opac',
231 $cookie = $in->{query}->cookie(
232 -name => 'CGISESSID',
236 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
241 script_name => get_script_name(),
244 print $in->{query}->header(
249 'X-Frame-Options' => 'SAMEORIGIN'
260 # It's possible for $user to be the borrowernumber if they don't have a
261 # userid defined (and are logging in through some other method, such
262 # as SSL certs against an email address)
264 $borrowernumber = getborrowernumber($user) if defined($user);
265 if ( !defined($borrowernumber) && defined($user) ) {
266 $patron = Koha::Patrons->find( $user );
268 $borrowernumber = $user;
270 # A bit of a hack, but I don't know there's a nicer way
272 $user = $patron->firstname . ' ' . $patron->surname;
275 $patron = Koha::Patrons->find( $borrowernumber );
276 # FIXME What to do if $patron does not exist?
280 $template->param( loggedinusername => $user ); # OBSOLETE - Do not reuse this in template, use logged_in_user.userid instead
281 $template->param( loggedinusernumber => $borrowernumber ); # FIXME Should be replaced with logged_in_user.borrowernumber
282 $template->param( logged_in_user => $patron );
283 $template->param( sessionID => $sessionID );
285 if ( $in->{'type'} eq 'opac' ) {
286 require Koha::Virtualshelves;
287 my $some_private_shelves = Koha::Virtualshelves->get_some_shelves(
289 borrowernumber => $borrowernumber,
293 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
299 some_private_shelves => $some_private_shelves,
300 some_public_shelves => $some_public_shelves,
304 my $all_perms = get_all_subpermissions();
306 my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
307 editcatalogue updatecharges tools editauthorities serials reports acquisition clubs problem_reports);
309 # We are going to use the $flags returned by checkauth
310 # to create the template's parameters that will indicate
311 # which menus the user can access.
312 if ( $flags && $flags->{superlibrarian} == 1 ) {
313 $template->param( CAN_user_circulate => 1 );
314 $template->param( CAN_user_catalogue => 1 );
315 $template->param( CAN_user_parameters => 1 );
316 $template->param( CAN_user_borrowers => 1 );
317 $template->param( CAN_user_permissions => 1 );
318 $template->param( CAN_user_reserveforothers => 1 );
319 $template->param( CAN_user_editcatalogue => 1 );
320 $template->param( CAN_user_updatecharges => 1 );
321 $template->param( CAN_user_acquisition => 1 );
322 $template->param( CAN_user_suggestions => 1 );
323 $template->param( CAN_user_tools => 1 );
324 $template->param( CAN_user_editauthorities => 1 );
325 $template->param( CAN_user_serials => 1 );
326 $template->param( CAN_user_reports => 1 );
327 $template->param( CAN_user_staffaccess => 1 );
328 $template->param( CAN_user_coursereserves => 1 );
329 $template->param( CAN_user_plugins => 1 );
330 $template->param( CAN_user_lists => 1 );
331 $template->param( CAN_user_clubs => 1 );
332 $template->param( CAN_user_ill => 1 );
333 $template->param( CAN_user_stockrotation => 1 );
334 $template->param( CAN_user_cash_management => 1 );
335 $template->param( CAN_user_problem_reports => 1 );
337 foreach my $module ( keys %$all_perms ) {
338 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
339 $template->param( "CAN_user_${module}_${subperm}" => 1 );
345 foreach my $module ( keys %$all_perms ) {
346 if ( defined($flags->{$module}) && $flags->{$module} == 1 ) {
347 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
348 $template->param( "CAN_user_${module}_${subperm}" => 1 );
350 } elsif ( ref( $flags->{$module} ) ) {
351 foreach my $subperm ( keys %{ $flags->{$module} } ) {
352 $template->param( "CAN_user_${module}_${subperm}" => 1 );
359 foreach my $module ( keys %$flags ) {
360 if ( $flags->{$module} == 1 or ref( $flags->{$module} ) ) {
361 $template->param( "CAN_user_$module" => 1 );
366 # Logged-in opac search history
367 # If the requested template is an opac one and opac search history is enabled
368 if ( $in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory') ) {
369 my $dbh = C4::Context->dbh;
370 my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
371 my $sth = $dbh->prepare($query);
372 $sth->execute($borrowernumber);
374 # If at least one search has already been performed
375 if ( $sth->fetchrow_array > 0 ) {
377 # We show the link in opac
378 $template->param( EnableOpacSearchHistory => 1 );
380 if (C4::Context->preference('LoadSearchHistoryToTheFirstLoggedUser'))
382 # And if there are searches performed when the user was not logged in,
383 # we add them to the logged-in search history
384 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
385 if (@recentSearches) {
386 my $dbh = C4::Context->dbh;
388 INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, type, total, time )
389 VALUES (?, ?, ?, ?, ?, ?, ?)
391 my $sth = $dbh->prepare($query);
392 $sth->execute( $borrowernumber,
393 $in->{query}->cookie("CGISESSID"),
396 $_->{type} || 'biblio',
399 ) foreach @recentSearches;
401 # clear out the search history from the session now that
402 # we've saved it to the database
405 C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } );
407 } elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) {
408 $template->param( EnableSearchHistory => 1 );
411 else { # if this is an anonymous session, setup to display public lists...
413 # If shibboleth is enabled, and we're in an anonymous session, we should allow
414 # the user to attempt login via shibboleth.
416 $template->param( shibbolethAuthentication => $shib,
417 shibbolethLoginUrl => login_shib_url( $in->{'query'} ),
420 # If shibboleth is enabled and we have a shibboleth login attribute,
421 # but we are in an anonymous session, then we clearly have an invalid
422 # shibboleth koha account.
424 $template->param( invalidShibLogin => '1' );
428 $template->param( sessionID => $sessionID );
430 if ( $in->{'type'} eq 'opac' ){
431 require Koha::Virtualshelves;
432 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
438 some_public_shelves => $some_public_shelves,
443 # Sysprefs disabled via URL param
444 # Note that value must be defined in order to override via ENV
445 foreach my $syspref ( qw( OPACUserCSS OPACUserJS IntranetUserCSS IntranetUserJS ) ) {
446 $ENV{"OVERRIDE_SYSPREF_$syspref"} = q{ } if $in->{'query'}->param("DISABLE_SYSPREF_$syspref");
448 foreach my $syspref ( qw( OpacAdditionalStylesheet opaclayoutstylesheet intranetcolorstylesheet intranetstylesheet ) ) {
449 $ENV{"OVERRIDE_SYSPREF_$syspref"} = 0 if $in->{'query'}->param("DISABLE_SYSPREF_$syspref");
452 # Anonymous opac search history
453 # If opac search history is enabled and at least one search has already been performed
454 if ( C4::Context->preference('EnableOpacSearchHistory') ) {
455 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
456 if (@recentSearches) {
457 $template->param( EnableOpacSearchHistory => 1 );
461 if ( C4::Context->preference('dateformat') ) {
462 $template->param( dateformat => C4::Context->preference('dateformat') );
465 $template->param(auth_forwarded_hash => scalar $in->{'query'}->param('auth_forwarded_hash'));
467 # these template parameters are set the same regardless of $in->{'type'}
469 my $minPasswordLength = C4::Context->preference('minPasswordLength');
470 $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
472 "BiblioDefaultView" . C4::Context->preference("BiblioDefaultView") => 1,
473 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
474 GoogleJackets => C4::Context->preference("GoogleJackets"),
475 OpenLibraryCovers => C4::Context->preference("OpenLibraryCovers"),
476 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
477 LoginFirstname => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
478 LoginSurname => C4::Context->userenv ? C4::Context->userenv->{"surname"} : "Inconnu",
479 emailaddress => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
480 TagsEnabled => C4::Context->preference("TagsEnabled"),
481 hide_marc => C4::Context->preference("hide_marc"),
482 item_level_itypes => C4::Context->preference('item-level_itypes'),
483 patronimages => C4::Context->preference("patronimages"),
484 singleBranchMode => ( Koha::Libraries->search->count == 1 ),
485 XSLTDetailsDisplay => C4::Context->preference("XSLTDetailsDisplay"),
486 XSLTResultsDisplay => C4::Context->preference("XSLTResultsDisplay"),
487 noItemTypeImages => C4::Context->preference("noItemTypeImages"),
488 marcflavour => C4::Context->preference("marcflavour"),
489 OPACBaseURL => C4::Context->preference('OPACBaseURL'),
490 minPasswordLength => $minPasswordLength,
492 if ( $in->{'type'} eq "intranet" ) {
494 AmazonCoverImages => C4::Context->preference("AmazonCoverImages"),
495 AutoLocation => C4::Context->preference("AutoLocation"),
496 "BiblioDefaultView" . C4::Context->preference("IntranetBiblioDefaultView") => 1,
497 PatronAutoComplete => C4::Context->preference("PatronAutoComplete"),
498 FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
499 IndependentBranches => C4::Context->preference("IndependentBranches"),
500 IntranetNav => C4::Context->preference("IntranetNav"),
501 IntranetmainUserblock => C4::Context->preference("IntranetmainUserblock"),
502 LibraryName => C4::Context->preference("LibraryName"),
503 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
504 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
505 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
506 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
507 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
508 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
509 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
510 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
511 suggestion => C4::Context->preference("suggestion"),
512 virtualshelves => C4::Context->preference("virtualshelves"),
513 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
514 EasyAnalyticalRecords => C4::Context->preference('EasyAnalyticalRecords'),
515 LocalCoverImages => C4::Context->preference('LocalCoverImages'),
516 OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'),
517 AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'),
518 EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'),
519 UseCourseReserves => C4::Context->preference("UseCourseReserves"),
520 useDischarge => C4::Context->preference('useDischarge'),
521 pending_checkout_notes => scalar Koha::Checkouts->search({ noteseen => 0 }),
525 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
527 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
528 my $LibraryNameTitle = C4::Context->preference("LibraryName");
529 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
530 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
532 # clean up the busc param in the session
533 # if the page is not opac-detail and not the "add to list" page
534 # and not the "edit comments" page
535 if ( C4::Context->preference("OpacBrowseResults")
536 && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
538 unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
539 or $pagename =~ /^addbybiblionumber$/
540 or $pagename =~ /^review$/ ) {
541 my $sessionSearch = get_session( $sessionID || $in->{'query'}->cookie("CGISESSID") );
542 $sessionSearch->clear( ["busc"] ) if ( $sessionSearch->param("busc") );
546 # variables passed from CGI: opac_css_override and opac_search_limits.
547 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
548 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
551 ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:([\w-]+)/ ) ||
552 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:([\w-]+)/ ) ||
553 ( $in->{'query'}->param('multibranchlimit') && $in->{'query'}->param('multibranchlimit') =~ /multibranchlimit-(\w+)/ )
555 $opac_name = $1; # opac_search_limit is a branch, so we use it.
556 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
557 $opac_name = $in->{'query'}->param('multibranchlimit');
558 } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
559 $opac_name = C4::Context->userenv->{'branch'};
562 my @search_groups = Koha::Library::Groups->get_search_groups({ interface => 'opac' });
564 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
565 LibrarySearchGroups => \@search_groups,
566 opac_name => $opac_name,
567 LibraryName => "" . C4::Context->preference("LibraryName"),
568 LibraryNameTitle => "" . $LibraryNameTitle,
569 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
570 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
571 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
572 OPACShelfBrowser => "" . C4::Context->preference("OPACShelfBrowser"),
573 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
574 OPACUserCSS => "" . C4::Context->preference("OPACUserCSS"),
575 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
576 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
577 opac_search_limit => $opac_search_limit,
578 opac_limit_override => $opac_limit_override,
579 OpacBrowser => C4::Context->preference("OpacBrowser"),
580 OpacCloud => C4::Context->preference("OpacCloud"),
581 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
582 OpacNav => "" . C4::Context->preference("OpacNav"),
583 OpacNavBottom => "" . C4::Context->preference("OpacNavBottom"),
584 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
585 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
586 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
587 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
588 OpacTopissue => C4::Context->preference("OpacTopissue"),
589 RequestOnOpac => C4::Context->preference("RequestOnOpac"),
590 'Version' => C4::Context->preference('Version'),
591 hidelostitems => C4::Context->preference("hidelostitems"),
592 mylibraryfirst => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
593 opacbookbag => "" . C4::Context->preference("opacbookbag"),
594 OpacFavicon => C4::Context->preference("OpacFavicon"),
595 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
596 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
597 OPACUserJS => C4::Context->preference("OPACUserJS"),
598 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
599 OpenLibrarySearch => C4::Context->preference("OpenLibrarySearch"),
600 ShowReviewer => C4::Context->preference("ShowReviewer"),
601 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
602 suggestion => "" . C4::Context->preference("suggestion"),
603 virtualshelves => "" . C4::Context->preference("virtualshelves"),
604 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
605 OPACXSLTDetailsDisplay => C4::Context->preference("OPACXSLTDetailsDisplay"),
606 OPACXSLTResultsDisplay => C4::Context->preference("OPACXSLTResultsDisplay"),
607 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
608 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
609 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
610 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
611 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
612 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
613 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
614 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
615 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
616 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
617 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
618 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
619 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
620 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
621 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
622 useDischarge => C4::Context->preference('useDischarge'),
625 $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
628 # Check if we were asked using parameters to force a specific language
629 if ( defined $in->{'query'}->param('language') ) {
631 # Extract the language, let C4::Languages::getlanguage choose
633 my $language = C4::Languages::getlanguage( $in->{'query'} );
634 my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
635 if ( ref $cookie eq 'ARRAY' ) {
636 push @{$cookie}, $languagecookie;
638 $cookie = [ $cookie, $languagecookie ];
642 return ( $template, $borrowernumber, $cookie, $flags );
647 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
649 Verifies that the user is authorized to run this script. If
650 the user is authorized, a (userid, cookie, session-id, flags)
651 quadruple is returned. If the user is not authorized but does
652 not have the required privilege (see $flagsrequired below), it
653 displays an error page and exits. Otherwise, it displays the
654 login page and exits.
656 Note that C<&checkauth> will return if and only if the user
657 is authorized, so it should be called early on, before any
658 unfinished operations (e.g., if you've opened a file, then
659 C<&checkauth> won't close it for you).
661 C<$query> is the CGI object for the script calling C<&checkauth>.
663 The C<$noauth> argument is optional. If it is set, then no
664 authorization is required for the script.
666 C<&checkauth> fetches user and session information from C<$query> and
667 ensures that the user is authorized to run scripts that require
670 The C<$flagsrequired> argument specifies the required privileges
671 the user must have if the username and password are correct.
672 It should be specified as a reference-to-hash; keys in the hash
673 should be the "flags" for the user, as specified in the Members
674 intranet module. Any key specified must correspond to a "flag"
675 in the userflags table. E.g., { circulate => 1 } would specify
676 that the user must have the "circulate" privilege in order to
677 proceed. To make sure that access control is correct, the
678 C<$flagsrequired> parameter must be specified correctly.
680 Koha also has a concept of sub-permissions, also known as
681 granular permissions. This makes the value of each key
682 in the C<flagsrequired> hash take on an additional
687 The user must have access to all subfunctions of the module
688 specified by the hash key.
692 The user must have access to at least one subfunction of the module
693 specified by the hash key.
695 specific permission, e.g., 'export_catalog'
697 The user must have access to the specific subfunction list, which
698 must correspond to a row in the permissions table.
700 The C<$type> argument specifies whether the template should be
701 retrieved from the opac or intranet directory tree. "opac" is
702 assumed if it is not specified; however, if C<$type> is specified,
703 "intranet" is assumed if it is not "opac".
705 If C<$query> does not have a valid session ID associated with it
706 (i.e., the user has not logged in) or if the session has expired,
707 C<&checkauth> presents the user with a login page (from the point of
708 view of the original script, C<&checkauth> does not return). Once the
709 user has authenticated, C<&checkauth> restarts the original script
710 (this time, C<&checkauth> returns).
712 The login page is provided using a HTML::Template, which is set in the
713 systempreferences table or at the top of this file. The variable C<$type>
714 selects which template to use, either the opac or the intranet
715 authentification template.
717 C<&checkauth> returns a user ID, a cookie, and a session ID. The
718 cookie should be sent back to the browser; it verifies that the user
728 # If version syspref is unavailable, it means Koha is being installed,
729 # and so we must redirect to OPAC maintenance page or to the WebInstaller
730 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
731 if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
732 warn "OPAC Install required, redirecting to maintenance";
733 print $query->redirect("/cgi-bin/koha/maintenance.pl");
736 unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
737 if ( $type ne 'opac' ) {
738 warn "Install required, redirecting to Installer";
739 print $query->redirect("/cgi-bin/koha/installer/install.pl");
741 warn "OPAC Install required, redirecting to maintenance";
742 print $query->redirect("/cgi-bin/koha/maintenance.pl");
747 # check that database and koha version are the same
748 # there is no DB version, it's a fresh install,
749 # go to web installer
750 # there is a DB version, compare it to the code version
751 my $kohaversion = Koha::version();
753 # remove the 3 last . to have a Perl number
754 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
755 $debug and print STDERR "kohaversion : $kohaversion\n";
756 if ( $version < $kohaversion ) {
757 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
758 if ( $type ne 'opac' ) {
759 warn sprintf( $warning, 'Installer' );
760 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
762 warn sprintf( "OPAC: " . $warning, 'maintenance' );
763 print $query->redirect("/cgi-bin/koha/maintenance.pl");
771 open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
772 printf $fh join( "\n", @_ );
776 sub _timeout_syspref {
777 my $default_timeout = 600;
778 my $timeout = C4::Context->preference('timeout') || $default_timeout;
780 # value in days, convert in seconds
781 if ( $timeout =~ /^(\d+)[dD]$/ ) {
782 $timeout = $1 * 86400;
784 # value in hours, convert in seconds
785 elsif ( $timeout =~ /^(\d+)[hH]$/ ) {
786 $timeout = $1 * 3600;
788 elsif ( $timeout !~ m/^\d+$/ ) {
789 warn "The value of the system preference 'timeout' is not correct, defaulting to $default_timeout";
790 $timeout = $default_timeout;
798 $debug and warn "Checking Auth";
800 # Get shibboleth login attribute
801 my $shib = C4::Context->config('useshibboleth') && shib_ok();
802 my $shib_login = $shib ? get_login_shib() : undef;
804 # $authnotrequired will be set for scripts which will run without authentication
805 my $authnotrequired = shift;
806 my $flagsrequired = shift;
808 my $emailaddress = shift;
809 my $template_name = shift;
810 $type = 'opac' unless $type;
812 unless ( C4::Context->preference("OpacPublic") ) {
813 my @allowed_scripts_for_private_opac = qw(
815 opac-registration-email-sent.tt
816 opac-registration-confirmation.tt
817 opac-memberentry-update-submitted.tt
818 opac-password-recovery.tt
820 $authnotrequired = 0 unless grep { $_ eq $template_name }
821 @allowed_scripts_for_private_opac;
824 my $dbh = C4::Context->dbh;
825 my $timeout = _timeout_syspref();
827 _version_check( $type, $query );
832 my ( $userid, $cookie, $sessionID, $flags );
833 my $logout = $query->param('logout.x');
835 my $anon_search_history;
837 # This parameter is the name of the CAS server we want to authenticate against,
838 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
839 my $casparam = $query->param('cas');
840 my $q_userid = $query->param('userid') // '';
844 # Basic authentication is incompatible with the use of Shibboleth,
845 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
846 # and it may not be the attribute we want to use to match the koha login.
848 # Also, do not consider an empty REMOTE_USER.
850 # Finally, after those tests, we can assume (although if it would be better with
851 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
852 # and we can affect it to $userid.
853 if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
855 # Using Basic Authentication, no cookies required
856 $cookie = $query->cookie(
857 -name => 'CGISESSID',
861 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
865 elsif ( $emailaddress) {
866 # the Google OpenID Connect passes an email address
868 elsif ( $sessionID = $query->cookie("CGISESSID") )
869 { # assignment, not comparison
870 $session = get_session($sessionID);
871 C4::Context->_new_userenv($sessionID);
872 my ( $ip, $lasttime, $sessiontype );
875 $s_userid = $session->param('id') // '';
876 C4::Context->set_userenv(
877 $session->param('number'), $s_userid,
878 $session->param('cardnumber'), $session->param('firstname'),
879 $session->param('surname'), $session->param('branch'),
880 $session->param('branchname'), $session->param('flags'),
881 $session->param('emailaddress'), $session->param('shibboleth'),
882 $session->param('desk_id'), $session->param('desk_name'),
883 $session->param('register_id'), $session->param('register_name')
885 C4::Context::set_shelves_userenv( 'bar', $session->param('barshelves') );
886 C4::Context::set_shelves_userenv( 'pub', $session->param('pubshelves') );
887 C4::Context::set_shelves_userenv( 'tot', $session->param('totshelves') );
888 $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
889 $ip = $session->param('ip');
890 $lasttime = $session->param('lasttime');
892 $sessiontype = $session->param('sessiontype') || '';
894 if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
895 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
896 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
899 #if a user enters an id ne to the id in the current session, we need to log them in...
900 #first we need to clear the anonymous session...
901 $debug and warn "query id = $q_userid but session id = $s_userid";
902 $anon_search_history = $session->param('search_history');
905 C4::Context->_unset_userenv($sessionID);
911 # voluntary logout the user
912 # check wether the user was using their shibboleth session or a local one
913 my $shibSuccess = C4::Context->userenv->{'shibboleth'};
916 C4::Context->_unset_userenv($sessionID);
918 #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
922 if ($cas and $caslogout) {
923 logout_cas($query, $type);
926 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
927 if ( $shib and $shib_login and $shibSuccess) {
931 elsif ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
934 $info{'timed_out'} = 1;
939 C4::Context->_unset_userenv($sessionID);
941 #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
945 elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
947 # Different ip than originally logged in from
948 $info{'oldip'} = $ip;
949 $info{'newip'} = $ENV{'REMOTE_ADDR'};
950 $info{'different_ip'} = 1;
953 C4::Context->_unset_userenv($sessionID);
955 #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
960 $cookie = $query->cookie(
961 -name => 'CGISESSID',
962 -value => $session->id,
964 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
966 $session->param( 'lasttime', time() );
967 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...
968 $flags = haspermission( $userid, $flagsrequired );
972 $info{'nopermission'} = 1;
977 unless ( $userid || $sessionID ) {
978 #we initiate a session prior to checking for a username to allow for anonymous sessions...
979 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
981 # Save anonymous search history in new session so it can be retrieved
982 # by get_template_and_user to store it in user's search history after
983 # a successful login.
984 if ($anon_search_history) {
985 $session->param( 'search_history', $anon_search_history );
988 $sessionID = $session->id;
989 C4::Context->_new_userenv($sessionID);
990 $cookie = $query->cookie(
991 -name => 'CGISESSID',
992 -value => $session->id,
994 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
996 my $pki_field = C4::Context->preference('AllowPKIAuth');
997 if ( !defined($pki_field) ) {
998 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
1001 if ( ( $cas && $query->param('ticket') )
1003 || ( $shib && $shib_login )
1004 || $pki_field ne 'None'
1007 my $password = $query->param('password');
1008 my $shibSuccess = 0;
1009 my ( $return, $cardnumber );
1011 # If shib is enabled and we have a shib login, does the login match a valid koha user
1012 if ( $shib && $shib_login ) {
1015 # Do not pass password here, else shib will not be checked in checkpw.
1016 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $q_userid, undef, $query );
1017 $userid = $retuserid;
1018 $shibSuccess = $return;
1019 $info{'invalidShibLogin'} = 1 unless ($return);
1022 # If shib login and match were successful, skip further login methods
1023 unless ($shibSuccess) {
1024 if ( $cas && $query->param('ticket') ) {
1026 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1027 checkpw( $dbh, $userid, $password, $query, $type );
1028 $userid = $retuserid;
1029 $info{'invalidCasLogin'} = 1 unless ($return);
1032 elsif ( $emailaddress ) {
1033 my $value = $emailaddress;
1035 # If we're looking up the email, there's a chance that the person
1036 # doesn't have a userid. So if there is none, we pass along the
1037 # borrower number, and the bits of code that need to know the user
1038 # ID will have to be smart enough to handle that.
1039 my $patrons = Koha::Patrons->search({ email => $value });
1040 if ($patrons->count) {
1042 # First the userid, then the borrowernum
1043 my $patron = $patrons->next;
1044 $value = $patron->userid || $patron->borrowernumber;
1048 $return = $value ? 1 : 0;
1053 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
1054 || ( $pki_field eq 'emailAddress'
1055 && $ENV{'SSL_CLIENT_S_DN_Email'} )
1059 if ( $pki_field eq 'Common Name' ) {
1060 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
1062 elsif ( $pki_field eq 'emailAddress' ) {
1063 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
1065 # If we're looking up the email, there's a chance that the person
1066 # doesn't have a userid. So if there is none, we pass along the
1067 # borrower number, and the bits of code that need to know the user
1068 # ID will have to be smart enough to handle that.
1069 my $patrons = Koha::Patrons->search({ email => $value });
1070 if ($patrons->count) {
1072 # First the userid, then the borrowernum
1073 my $patron = $patrons->next;
1074 $value = $patron->userid || $patron->borrowernumber;
1080 $return = $value ? 1 : 0;
1086 ( $return, $cardnumber, $retuserid, $cas_ticket ) =
1087 checkpw( $dbh, $q_userid, $password, $query, $type );
1088 $userid = $retuserid if ($retuserid);
1089 $info{'invalid_username_or_password'} = 1 unless ($return);
1093 # $return: 1 = valid user
1096 #_session_log(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
1097 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1101 $info{'nopermission'} = 1;
1102 C4::Context->_unset_userenv($sessionID);
1104 my ( $borrowernumber, $firstname, $surname, $userflags,
1105 $branchcode, $branchname, $emailaddress, $desk_id,
1106 $desk_name, $register_id, $register_name );
1108 if ( $return == 1 ) {
1110 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1111 branches.branchname as branchname, email
1113 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1115 my $sth = $dbh->prepare("$select where userid=?");
1116 $sth->execute($userid);
1117 unless ( $sth->rows ) {
1118 $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
1119 $sth = $dbh->prepare("$select where cardnumber=?");
1120 $sth->execute($cardnumber);
1122 unless ( $sth->rows ) {
1123 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1124 $sth->execute($userid);
1125 unless ( $sth->rows ) {
1126 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1131 ( $borrowernumber, $firstname, $surname, $userflags,
1132 $branchcode, $branchname, $emailaddress ) = $sth->fetchrow;
1133 $debug and print STDERR "AUTH_3 results: " .
1134 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1136 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1139 # launch a sequence to check if we have a ip for the branch, i
1140 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1142 my $ip = $ENV{'REMOTE_ADDR'};
1144 # if they specify at login, use that
1145 if ( $query->param('branch') ) {
1146 $branchcode = $query->param('branch');
1147 my $library = Koha::Libraries->find($branchcode);
1148 $branchname = $library? $library->branchname: '';
1150 if ( $query->param('desk_id') ) {
1151 $desk_id = $query->param('desk_id');
1152 my $desk = Koha::Desks->find($desk_id);
1153 $desk_name = $desk ? $desk->desk_name : '';
1155 if ( C4::Context->preference('UseCashRegisters') ) {
1157 $query->param('register_id')
1158 ? Koha::Cash::Registers->find($query->param('register_id'))
1159 : Koha::Cash::Registers->search(
1160 { branch => $branchcode, branch_default => 1 },
1161 { rows => 1 } )->single;
1162 $register_id = $register->id if ($register);
1163 $register_name = $register->name if ($register);
1165 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1166 if ( $type ne 'opac' and C4::Context->boolean_preference('AutoLocation') ) {
1168 # we have to check they are coming from the right ip range
1169 my $domain = $branches->{$branchcode}->{'branchip'};
1170 $domain =~ s|\.\*||g;
1171 if ( $ip !~ /^$domain/ ) {
1173 $cookie = $query->cookie(
1174 -name => 'CGISESSID',
1177 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1179 $info{'wrongip'} = 1;
1183 foreach my $br ( keys %$branches ) {
1185 # now we work with the treatment of ip
1186 my $domain = $branches->{$br}->{'branchip'};
1187 if ( $domain && $ip =~ /^$domain/ ) {
1188 $branchcode = $branches->{$br}->{'branchcode'};
1190 # new op dev : add the branchname to the cookie
1191 $branchname = $branches->{$br}->{'branchname'};
1194 $session->param( 'number', $borrowernumber );
1195 $session->param( 'id', $userid );
1196 $session->param( 'cardnumber', $cardnumber );
1197 $session->param( 'firstname', $firstname );
1198 $session->param( 'surname', $surname );
1199 $session->param( 'branch', $branchcode );
1200 $session->param( 'branchname', $branchname );
1201 $session->param( 'desk_id', $desk_id);
1202 $session->param( 'desk_name', $desk_name);
1203 $session->param( 'flags', $userflags );
1204 $session->param( 'emailaddress', $emailaddress );
1205 $session->param( 'ip', $session->remote_addr() );
1206 $session->param( 'lasttime', time() );
1207 $session->param( 'interface', $type);
1208 $session->param( 'shibboleth', $shibSuccess );
1209 $session->param( 'register_id', $register_id );
1210 $session->param( 'register_name', $register_name );
1211 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1213 $session->param('cas_ticket', $cas_ticket) if $cas_ticket;
1214 C4::Context->set_userenv(
1215 $session->param('number'), $session->param('id'),
1216 $session->param('cardnumber'), $session->param('firstname'),
1217 $session->param('surname'), $session->param('branch'),
1218 $session->param('branchname'), $session->param('flags'),
1219 $session->param('emailaddress'), $session->param('shibboleth'),
1220 $session->param('desk_id'), $session->param('desk_name'),
1221 $session->param('register_id'), $session->param('register_name')
1225 # $return: 0 = invalid user
1226 # reset to anonymous session
1228 $debug and warn "Login failed, resetting anonymous session...";
1230 $info{'invalid_username_or_password'} = 1;
1231 C4::Context->_unset_userenv($sessionID);
1233 $session->param( 'lasttime', time() );
1234 $session->param( 'ip', $session->remote_addr() );
1235 $session->param( 'sessiontype', 'anon' );
1236 $session->param( 'interface', $type);
1238 } # END if ( $q_userid
1239 elsif ( $type eq "opac" ) {
1241 # if we are here this is an anonymous session; add public lists to it and a few other items...
1242 # anonymous sessions are created only for the OPAC
1243 $debug and warn "Initiating an anonymous session...";
1245 # setting a couple of other session vars...
1246 $session->param( 'ip', $session->remote_addr() );
1247 $session->param( 'lasttime', time() );
1248 $session->param( 'sessiontype', 'anon' );
1249 $session->param( 'interface', $type);
1251 } # END unless ($userid)
1253 # finished authentification, now respond
1254 if ( $loggedin || $authnotrequired )
1258 $cookie = $query->cookie(
1259 -name => 'CGISESSID',
1262 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1266 track_login_daily( $userid );
1268 # In case, that this request was a login attempt, we want to prevent that users can repost the opac login
1269 # request. We therefore redirect the user to the requested page again without the login parameters.
1270 # See Post/Redirect/Get (PRG) design pattern: https://en.wikipedia.org/wiki/Post/Redirect/Get
1271 if ( $type eq "opac" && $query->param('koha_login_context') && $query->param('koha_login_context') ne 'sco' && $query->param('password') && $query->param('userid') ) {
1272 my $uri = URI->new($query->url(-relative=>1, -query_string=>1));
1273 $uri->query_param_delete('userid');
1274 $uri->query_param_delete('password');
1275 $uri->query_param_delete('koha_login_context');
1276 print $query->redirect(-uri => $uri->as_string, -cookie => $cookie, -status=>'303 See other');
1280 return ( $userid, $cookie, $sessionID, $flags );
1285 # AUTH rejected, show the login/password template, after checking the DB.
1289 # get the inputs from the incoming query
1291 foreach my $name ( param $query) {
1292 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1293 my @value = $query->multi_param($name);
1294 push @inputs, { name => $name, value => $_ } for @value;
1297 my $patron = Koha::Patrons->find({ userid => $q_userid }); # Not necessary logged in!
1299 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1300 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1301 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1303 my $auth_template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1304 my $template = C4::Templates::gettemplate( $auth_template_name, $type, $query );
1308 script_name => get_script_name(),
1309 casAuthentication => C4::Context->preference("casAuthentication"),
1310 shibbolethAuthentication => $shib,
1311 SessionRestrictionByIP => C4::Context->preference("SessionRestrictionByIP"),
1312 suggestion => C4::Context->preference("suggestion"),
1313 virtualshelves => C4::Context->preference("virtualshelves"),
1314 LibraryName => "" . C4::Context->preference("LibraryName"),
1315 LibraryNameTitle => "" . $LibraryNameTitle,
1316 opacuserlogin => C4::Context->preference("opacuserlogin"),
1317 OpacNav => C4::Context->preference("OpacNav"),
1318 OpacNavBottom => C4::Context->preference("OpacNavBottom"),
1319 OpacFavicon => C4::Context->preference("OpacFavicon"),
1320 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1321 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1322 OPACUserJS => C4::Context->preference("OPACUserJS"),
1323 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1324 OpacCloud => C4::Context->preference("OpacCloud"),
1325 OpacTopissue => C4::Context->preference("OpacTopissue"),
1326 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1327 OpacBrowser => C4::Context->preference("OpacBrowser"),
1328 TagsEnabled => C4::Context->preference("TagsEnabled"),
1329 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1330 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1331 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1332 IntranetNav => C4::Context->preference("IntranetNav"),
1333 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1334 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
1335 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1336 IndependentBranches => C4::Context->preference("IndependentBranches"),
1337 AutoLocation => C4::Context->preference("AutoLocation"),
1338 wrongip => $info{'wrongip'},
1339 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1340 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1341 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1342 too_many_login_attempts => ( $patron and $patron->account_locked )
1345 $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1346 $template->param( SCI_login => 1 ) if ( $query->param('sci_user_login') );
1347 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1348 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1350 if ( $type eq 'opac' ) {
1351 require Koha::Virtualshelves;
1352 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1358 some_public_shelves => $some_public_shelves,
1364 # Is authentication against multiple CAS servers enabled?
1365 if ( C4::Auth_with_cas::multipleAuth && !$casparam ) {
1366 my $casservers = C4::Auth_with_cas::getMultipleAuth();
1368 foreach my $key ( keys %$casservers ) {
1369 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1372 casServersLoop => \@tmplservers
1376 casServerUrl => login_cas_url($query, undef, $type),
1381 invalidCasLogin => $info{'invalidCasLogin'}
1387 shibbolethAuthentication => $shib,
1388 shibbolethLoginUrl => login_shib_url($query),
1392 if (C4::Context->preference('GoogleOpenIDConnect')) {
1393 if ($query->param("OpenIDConnectFailed")) {
1394 my $reason = $query->param('OpenIDConnectFailed');
1395 $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1400 LibraryName => C4::Context->preference("LibraryName"),
1402 $template->param(%info);
1404 # $cookie = $query->cookie(CGISESSID => $session->id
1406 print $query->header(
1407 { type => 'text/html',
1410 'X-Frame-Options' => 'SAMEORIGIN'
1417 =head2 check_api_auth
1419 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1421 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1422 cookie, determine if the user has the privileges specified by C<$userflags>.
1424 C<check_api_auth> is is meant for authenticating users of web services, and
1425 consequently will always return and will not attempt to redirect the user
1428 If a valid session cookie is already present, check_api_auth will return a status
1429 of "ok", the cookie, and the Koha session ID.
1431 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1432 parameters and create a session cookie and Koha session if the supplied credentials
1435 Possible return values in C<$status> are:
1439 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1441 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1443 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1445 =item "expired -- session cookie has expired; API user should resubmit userid and password
1451 sub check_api_auth {
1454 my $flagsrequired = shift;
1455 my $dbh = C4::Context->dbh;
1456 my $timeout = _timeout_syspref();
1458 unless ( C4::Context->preference('Version') ) {
1460 # database has not been installed yet
1461 return ( "maintenance", undef, undef );
1463 my $kohaversion = Koha::version();
1464 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1465 if ( C4::Context->preference('Version') < $kohaversion ) {
1467 # database in need of version update; assume that
1468 # no API should be called while databsae is in
1470 return ( "maintenance", undef, undef );
1473 # FIXME -- most of what follows is a copy-and-paste
1474 # of code from checkauth. There is an obvious need
1475 # for refactoring to separate the various parts of
1476 # the authentication code, but as of 2007-11-19 this
1477 # is deferred so as to not introduce bugs into the
1478 # regular authentication code for Koha 3.0.
1480 # see if we have a valid session cookie already
1481 # however, if a userid parameter is present (i.e., from
1482 # a form submission, assume that any current cookie
1484 my $sessionID = undef;
1485 unless ( $query->param('userid') ) {
1486 $sessionID = $query->cookie("CGISESSID");
1488 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1489 my $session = get_session($sessionID);
1490 C4::Context->_new_userenv($sessionID);
1492 C4::Context->interface($session->param('interface'));
1493 C4::Context->set_userenv(
1494 $session->param('number'), $session->param('id'),
1495 $session->param('cardnumber'), $session->param('firstname'),
1496 $session->param('surname'), $session->param('branch'),
1497 $session->param('branchname'), $session->param('flags'),
1498 $session->param('emailaddress'), $session->param('shibboleth'),
1499 $session->param('desk_id'), $session->param('desk_name'),
1500 $session->param('register_id'), $session->param('register_name')
1503 my $ip = $session->param('ip');
1504 my $lasttime = $session->param('lasttime');
1505 my $userid = $session->param('id');
1506 if ( $lasttime < time() - $timeout ) {
1511 C4::Context->_unset_userenv($sessionID);
1514 return ( "expired", undef, undef );
1515 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1517 # IP address changed
1520 C4::Context->_unset_userenv($sessionID);
1523 return ( "expired", undef, undef );
1525 my $cookie = $query->cookie(
1526 -name => 'CGISESSID',
1527 -value => $session->id,
1529 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1531 $session->param( 'lasttime', time() );
1532 my $flags = haspermission( $userid, $flagsrequired );
1534 return ( "ok", $cookie, $sessionID );
1538 C4::Context->_unset_userenv($sessionID);
1541 return ( "failed", undef, undef );
1545 return ( "expired", undef, undef );
1550 my $userid = $query->param('userid');
1551 my $password = $query->param('password');
1552 my ( $return, $cardnumber, $cas_ticket );
1555 if ( $cas && $query->param('PT') ) {
1557 $debug and print STDERR "## check_api_auth - checking CAS\n";
1559 # In case of a CAS authentication, we use the ticket instead of the password
1560 my $PT = $query->param('PT');
1561 ( $return, $cardnumber, $userid, $cas_ticket ) = check_api_auth_cas( $dbh, $PT, $query ); # EXTERNAL AUTH
1564 # User / password auth
1565 unless ( $userid and $password ) {
1567 # caller did something wrong, fail the authenticateion
1568 return ( "failed", undef, undef );
1571 ( $return, $cardnumber, $newuserid, $cas_ticket ) = checkpw( $dbh, $userid, $password, $query );
1574 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1575 my $session = get_session("");
1576 return ( "failed", undef, undef ) unless $session;
1578 my $sessionID = $session->id;
1579 C4::Context->_new_userenv($sessionID);
1580 my $cookie = $query->cookie(
1581 -name => 'CGISESSID',
1582 -value => $sessionID,
1584 -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
1586 if ( $return == 1 ) {
1588 $borrowernumber, $firstname, $surname,
1589 $userflags, $branchcode, $branchname,
1594 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
1596 $sth->execute($userid);
1598 $borrowernumber, $firstname, $surname,
1599 $userflags, $branchcode, $branchname,
1601 ) = $sth->fetchrow if ( $sth->rows );
1603 unless ( $sth->rows ) {
1604 my $sth = $dbh->prepare(
1605 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1607 $sth->execute($cardnumber);
1609 $borrowernumber, $firstname, $surname,
1610 $userflags, $branchcode, $branchname,
1612 ) = $sth->fetchrow if ( $sth->rows );
1614 unless ( $sth->rows ) {
1615 $sth->execute($userid);
1617 $borrowernumber, $firstname, $surname, $userflags,
1618 $branchcode, $branchname, $emailaddress
1619 ) = $sth->fetchrow if ( $sth->rows );
1623 my $ip = $ENV{'REMOTE_ADDR'};
1625 # if they specify at login, use that
1626 if ( $query->param('branch') ) {
1627 $branchcode = $query->param('branch');
1628 my $library = Koha::Libraries->find($branchcode);
1629 $branchname = $library? $library->branchname: '';
1631 my $branches = { map { $_->branchcode => $_->unblessed } Koha::Libraries->search };
1632 foreach my $br ( keys %$branches ) {
1634 # now we work with the treatment of ip
1635 my $domain = $branches->{$br}->{'branchip'};
1636 if ( $domain && $ip =~ /^$domain/ ) {
1637 $branchcode = $branches->{$br}->{'branchcode'};
1639 # new op dev : add the branchname to the cookie
1640 $branchname = $branches->{$br}->{'branchname'};
1643 $session->param( 'number', $borrowernumber );
1644 $session->param( 'id', $userid );
1645 $session->param( 'cardnumber', $cardnumber );
1646 $session->param( 'firstname', $firstname );
1647 $session->param( 'surname', $surname );
1648 $session->param( 'branch', $branchcode );
1649 $session->param( 'branchname', $branchname );
1650 $session->param( 'flags', $userflags );
1651 $session->param( 'emailaddress', $emailaddress );
1652 $session->param( 'ip', $session->remote_addr() );
1653 $session->param( 'lasttime', time() );
1654 $session->param( 'interface', 'api' );
1656 $session->param( 'cas_ticket', $cas_ticket);
1657 C4::Context->set_userenv(
1658 $session->param('number'), $session->param('id'),
1659 $session->param('cardnumber'), $session->param('firstname'),
1660 $session->param('surname'), $session->param('branch'),
1661 $session->param('branchname'), $session->param('flags'),
1662 $session->param('emailaddress'), $session->param('shibboleth'),
1663 $session->param('desk_id'), $session->param('desk_name'),
1664 $session->param('register_id'), $session->param('register_name')
1666 return ( "ok", $cookie, $sessionID );
1668 return ( "failed", undef, undef );
1673 =head2 check_cookie_auth
1675 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1677 Given a CGISESSID cookie set during a previous login to Koha, determine
1678 if the user has the privileges specified by C<$userflags>. C<$userflags>
1679 is passed unaltered into C<haspermission> and as such accepts all options
1680 avaiable to that routine with the one caveat that C<check_api_auth> will
1681 also allow 'undef' to be passed and in such a case the permissions check
1682 will be skipped altogether.
1684 C<check_cookie_auth> is meant for authenticating special services
1685 such as tools/upload-file.pl that are invoked by other pages that
1686 have been authenticated in the usual way.
1688 Possible return values in C<$status> are:
1692 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1694 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1696 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1698 =item "expired -- session cookie has expired; API user should resubmit userid and password
1704 sub check_cookie_auth {
1706 my $flagsrequired = shift;
1709 my $remote_addr = $params->{remote_addr} || $ENV{REMOTE_ADDR};
1710 my $dbh = C4::Context->dbh;
1711 my $timeout = _timeout_syspref();
1713 unless ( C4::Context->preference('Version') ) {
1715 # database has not been installed yet
1716 return ( "maintenance", undef );
1718 my $kohaversion = Koha::version();
1719 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1720 if ( C4::Context->preference('Version') < $kohaversion ) {
1722 # database in need of version update; assume that
1723 # no API should be called while databsae is in
1725 return ( "maintenance", undef );
1728 # FIXME -- most of what follows is a copy-and-paste
1729 # of code from checkauth. There is an obvious need
1730 # for refactoring to separate the various parts of
1731 # the authentication code, but as of 2007-11-23 this
1732 # is deferred so as to not introduce bugs into the
1733 # regular authentication code for Koha 3.0.
1735 # see if we have a valid session cookie already
1736 # however, if a userid parameter is present (i.e., from
1737 # a form submission, assume that any current cookie
1739 unless ( defined $cookie and $cookie ) {
1740 return ( "failed", undef );
1742 my $sessionID = $cookie;
1743 my $session = get_session($sessionID);
1744 C4::Context->_new_userenv($sessionID);
1746 C4::Context->interface($session->param('interface'));
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('shibboleth'),
1753 $session->param('desk_id'), $session->param('desk_name'),
1754 $session->param('register_id'), $session->param('register_name')
1757 my $ip = $session->param('ip');
1758 my $lasttime = $session->param('lasttime');
1759 my $userid = $session->param('id');
1760 if ( $lasttime < time() - $timeout ) {
1765 C4::Context->_unset_userenv($sessionID);
1768 return ("expired", undef);
1769 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $remote_addr ) {
1771 # IP address changed
1774 C4::Context->_unset_userenv($sessionID);
1777 return ( "expired", undef );
1779 $session->param( 'lasttime', time() );
1780 my $flags = defined($flagsrequired) ? haspermission( $userid, $flagsrequired ) : 1;
1782 return ( "ok", $sessionID );
1786 C4::Context->_unset_userenv($sessionID);
1789 return ( "failed", undef );
1793 return ( "expired", undef );
1800 my $session = get_session($sessionID);
1802 Given a session ID, retrieve the CGI::Session object used to store
1803 the session's state. The session object can be used to store
1804 data that needs to be accessed by different scripts during a
1807 If the C<$sessionID> parameter is an empty string, a new session
1812 sub _get_session_params {
1813 my $storage_method = C4::Context->preference('SessionStorage');
1814 if ( $storage_method eq 'mysql' ) {
1815 my $dbh = C4::Context->dbh;
1816 return { dsn => "driver:MySQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1818 elsif ( $storage_method eq 'Pg' ) {
1819 my $dbh = C4::Context->dbh;
1820 return { dsn => "driver:PostgreSQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } };
1822 elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) {
1823 my $memcached = Koha::Caches->get_instance()->memcached_cache;
1824 return { dsn => "driver:memcached;serializer:yaml;id:md5", dsn_args => { Memcached => $memcached } };
1827 # catch all defaults to tmp should work on all systems
1828 my $dir = C4::Context::temporary_directory;
1829 my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1830 return { dsn => "driver:File;serializer:yaml;id:md5", dsn_args => { Directory => "$dir/cgisess_$instance" } };
1835 my $sessionID = shift;
1836 my $params = _get_session_params();
1837 return CGI::Session->new( $params->{dsn}, $sessionID, $params->{dsn_args} );
1841 # FIXME no_set_userenv may be replaced with force_branchcode_for_userenv
1842 # (or something similar)
1843 # Currently it's only passed from C4::SIP::ILS::Patron::check_password, but
1844 # not having a userenv defined could cause a crash.
1846 my ( $dbh, $userid, $password, $query, $type, $no_set_userenv ) = @_;
1847 $type = 'opac' unless $type;
1849 # Get shibboleth login attribute
1850 my $shib = C4::Context->config('useshibboleth') && shib_ok();
1851 my $shib_login = $shib ? get_login_shib() : undef;
1855 if ( defined $userid ){
1856 $patron = Koha::Patrons->find({ userid => $userid });
1857 $patron = Koha::Patrons->find({ cardnumber => $userid }) unless $patron;
1859 my $check_internal_as_fallback = 0;
1861 # Note: checkpw_* routines returns:
1864 # -1 if user bind failed (LDAP only)
1866 if ( $patron and $patron->account_locked ) {
1867 # Nothing to check, account is locked
1868 } elsif ($ldap && defined($password)) {
1869 $debug and print STDERR "## checkpw - checking LDAP\n";
1870 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
1871 if ( $retval == 1 ) {
1872 @return = ( $retval, $retcard, $retuserid );
1875 $check_internal_as_fallback = 1 if $retval == 0;
1877 } elsif ( $cas && $query && $query->param('ticket') ) {
1878 $debug and print STDERR "## checkpw - checking CAS\n";
1880 # In case of a CAS authentication, we use the ticket instead of the password
1881 my $ticket = $query->param('ticket');
1882 $query->delete('ticket'); # remove ticket to come back to original URL
1883 my ( $retval, $retcard, $retuserid, $cas_ticket ) = checkpw_cas( $dbh, $ticket, $query, $type ); # EXTERNAL AUTH
1885 @return = ( $retval, $retcard, $retuserid, $cas_ticket );
1889 $passwd_ok = $retval;
1892 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1893 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1895 elsif ( $shib && $shib_login && !$password ) {
1897 $debug and print STDERR "## checkpw - checking Shibboleth\n";
1899 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1900 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1901 # shibboleth-authenticated user
1903 # Then, we check if it matches a valid koha user
1905 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
1907 @return = ( $retval, $retcard, $retuserid );
1909 $passwd_ok = $retval;
1912 $check_internal_as_fallback = 1;
1916 if ( $check_internal_as_fallback ) {
1917 @return = checkpw_internal( $dbh, $userid, $password, $no_set_userenv);
1918 $passwd_ok = 1 if $return[0] > 0; # 1 or 2
1923 $patron->update({ login_attempts => 0 });
1924 } elsif( !$patron->account_locked ) {
1925 $patron->update({ login_attempts => $patron->login_attempts + 1 });
1929 # Optionally log success or failure
1930 if( $patron && $passwd_ok && C4::Context->preference('AuthSuccessLog') ) {
1931 logaction( 'AUTH', 'SUCCESS', $patron->id, "Valid password for $userid", $type );
1932 } elsif( !$passwd_ok && C4::Context->preference('AuthFailureLog') ) {
1933 logaction( 'AUTH', 'FAILURE', $patron ? $patron->id : 0, "Wrong password for $userid", $type );
1939 sub checkpw_internal {
1940 my ( $dbh, $userid, $password, $no_set_userenv ) = @_;
1942 $password = Encode::encode( 'UTF-8', $password )
1943 if Encode::is_utf8($password);
1947 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1949 $sth->execute($userid);
1951 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1952 $surname, $branchcode, $branchname, $flags )
1955 if ( checkpw_hash( $password, $stored_hash ) ) {
1957 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1958 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1959 return 1, $cardnumber, $userid;
1964 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1966 $sth->execute($userid);
1968 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1969 $surname, $branchcode, $branchname, $flags )
1972 if ( checkpw_hash( $password, $stored_hash ) ) {
1974 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1975 $firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv;
1976 return 1, $cardnumber, $userid;
1983 my ( $password, $stored_hash ) = @_;
1985 return if $stored_hash eq '!';
1987 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1989 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1990 $hash = hash_password( $password, $stored_hash );
1992 $hash = md5_base64($password);
1994 return $hash eq $stored_hash;
1999 my $authflags = getuserflags($flags, $userid, [$dbh]);
2001 Translates integer flags into permissions strings hash.
2003 C<$flags> is the integer userflags value ( borrowers.userflags )
2004 C<$userid> is the members.userid, used for building subpermissions
2005 C<$authflags> is a hashref of permissions
2012 my $dbh = @_ ? shift : C4::Context->dbh;
2015 # I don't want to do this, but if someone logs in as the database
2016 # user, it would be preferable not to spam them to death with
2017 # numeric warnings. So, we make $flags numeric.
2018 no warnings 'numeric';
2021 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
2024 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
2025 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
2026 $userflags->{$flag} = 1;
2029 $userflags->{$flag} = 0;
2033 # get subpermissions and merge with top-level permissions
2034 my $user_subperms = get_user_subpermissions($userid);
2035 foreach my $module ( keys %$user_subperms ) {
2036 next if $userflags->{$module} == 1; # user already has permission for everything in this module
2037 $userflags->{$module} = $user_subperms->{$module};
2043 =head2 get_user_subpermissions
2045 $user_perm_hashref = get_user_subpermissions($userid);
2047 Given the userid (note, not the borrowernumber) of a staff user,
2048 return a hashref of hashrefs of the specific subpermissions
2049 accorded to the user. An example return is
2053 export_catalog => 1,
2054 import_patrons => 1,
2058 The top-level hash-key is a module or function code from
2059 userflags.flag, while the second-level key is a code
2062 The results of this function do not give a complete picture
2063 of the functions that a staff user can access; it is also
2064 necessary to check borrowers.flags.
2068 sub get_user_subpermissions {
2071 my $dbh = C4::Context->dbh;
2072 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
2073 FROM user_permissions
2074 JOIN permissions USING (module_bit, code)
2075 JOIN userflags ON (module_bit = bit)
2076 JOIN borrowers USING (borrowernumber)
2077 WHERE userid = ?" );
2078 $sth->execute($userid);
2080 my $user_perms = {};
2081 while ( my $perm = $sth->fetchrow_hashref ) {
2082 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2087 =head2 get_all_subpermissions
2089 my $perm_hashref = get_all_subpermissions();
2091 Returns a hashref of hashrefs defining all specific
2092 permissions currently defined. The return value
2093 has the same structure as that of C<get_user_subpermissions>,
2094 except that the innermost hash value is the description
2095 of the subpermission.
2099 sub get_all_subpermissions {
2100 my $dbh = C4::Context->dbh;
2101 my $sth = $dbh->prepare( "SELECT flag, code
2103 JOIN userflags ON (module_bit = bit)" );
2107 while ( my $perm = $sth->fetchrow_hashref ) {
2108 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
2113 =head2 haspermission
2115 $flagsrequired = '*'; # Any permission at all
2116 $flagsrequired = 'a_flag'; # a_flag must be satisfied (all subpermissions)
2117 $flagsrequired = [ 'a_flag', 'b_flag' ]; # a_flag OR b_flag must be satisfied
2118 $flagsrequired = { 'a_flag => 1, 'b_flag' => 1 }; # a_flag AND b_flag must be satisfied
2119 $flagsrequired = { 'a_flag' => 'sub_a' }; # sub_a of a_flag must be satisfied
2120 $flagsrequired = { 'a_flag' => [ 'sub_a, 'sub_b' ] }; # sub_a OR sub_b of a_flag must be satisfied
2122 $flags = ($userid, $flagsrequired);
2124 C<$userid> the userid of the member
2125 C<$flags> is a query structure similar to that used by SQL::Abstract that
2126 denotes the combination of flags required. It is a required parameter.
2128 The main logic of this method is that things in arrays are OR'ed, and things
2129 in hashes are AND'ed. The `*` character can be used, at any depth, to denote `ANY`
2131 Returns member's flags or 0 if a permission is not met.
2136 my ($required, $flags) = @_;
2138 my $ref = ref($required);
2140 if ($required eq '*') {
2141 return 0 unless ( $flags or ref( $flags ) );
2143 return 0 unless ( $flags and (!ref( $flags ) || $flags->{$required} ));
2145 } elsif ($ref eq 'HASH') {
2146 foreach my $key (keys %{$required}) {
2147 next if $flags == 1;
2148 my $require = $required->{$key};
2149 my $rflags = $flags->{$key};
2150 return 0 unless _dispatch($require, $rflags);
2152 } elsif ($ref eq 'ARRAY') {
2154 foreach my $require ( @{$required} ) {
2156 ( ref($flags) && !ref($require) && ( $require ne '*' ) )
2157 ? $flags->{$require}
2159 $satisfied++ if _dispatch( $require, $rflags );
2161 return 0 unless $satisfied;
2163 croak "Unexpected structure found: $ref";
2170 my ( $userid, $flagsrequired ) = @_;
2172 #Koha::Exceptions::WrongParameter->throw('$flagsrequired should not be undef')
2173 # unless defined($flagsrequired);
2175 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
2176 $sth->execute($userid);
2177 my $row = $sth->fetchrow();
2178 my $flags = getuserflags( $row, $userid );
2180 return $flags unless defined($flagsrequired);
2181 return $flags if $flags->{superlibrarian};
2182 return _dispatch($flagsrequired, $flags);
2184 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2189 $flags = ($iprange);
2191 C<$iprange> A space separated string describing an IP range. Can include single IPs or ranges
2193 Returns 1 if the remote address is in the provided iprange, or 0 otherwise.
2200 my @allowedipranges = $iprange ? split(' ', $iprange) : ();
2201 if (scalar @allowedipranges > 0) {
2203 eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
2204 eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || ( $ENV{DEBUG} && warn 'cidrlookup failed for ' . join(' ',@rangelist) );
2206 return $result ? 1 : 0;
2209 sub getborrowernumber {
2211 my $userenv = C4::Context->userenv;
2212 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2213 return $userenv->{number};
2215 my $dbh = C4::Context->dbh;
2216 for my $field ( 'userid', 'cardnumber' ) {
2218 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2219 $sth->execute($userid);
2221 my ($bnumber) = $sth->fetchrow;
2228 =head2 track_login_daily
2230 track_login_daily( $userid );
2232 Wraps the call to $patron->track_login, the method used to update borrowers.lastseen. We only call track_login once a day.
2236 sub track_login_daily {
2238 return if !$userid || !C4::Context->preference('TrackLastPatronActivity');
2240 my $cache = Koha::Caches->get_instance();
2241 my $cache_key = "track_login_" . $userid;
2242 my $cached = $cache->get_from_cache($cache_key);
2243 my $today = dt_from_string()->ymd;
2244 return if $cached && $cached eq $today;
2246 my $patron = Koha::Patrons->find({ userid => $userid });
2247 return unless $patron;
2248 $patron->track_login;
2249 $cache->set_in_cache( $cache_key, $today );
2252 END { } # module clean-up code here (global destructor)
2262 Crypt::Eksblowfish::Bcrypt(3)