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>.
22 use Digest::MD5 qw(md5_base64);
24 use JSON qw/encode_json/;
30 use C4::Templates; # to get the template
32 use C4::Branch; # GetBranches
33 use C4::Search::History;
35 use Koha::AuthUtils qw(hash_password);
36 use Koha::LibraryCategories;
38 use POSIX qw/strftime/;
39 use List::MoreUtils qw/ any /;
40 use Encode qw( encode is_utf8);
43 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout $shib $shib_login);
46 sub psgi_env { any { /^psgi\./ } keys %ENV }
49 if (psgi_env) { die 'psgi:exit' }
55 @EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
56 @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash
57 &get_all_subpermissions &get_user_subpermissions
59 %EXPORT_TAGS = ( EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)] );
60 $ldap = C4::Context->config('useldapserver') || 0;
61 $cas = C4::Context->preference('casAuthentication');
62 $shib = C4::Context->config('useshibboleth') || 0;
63 $caslogout = C4::Context->preference('casLogout');
64 require C4::Auth_with_cas; # no import
67 require C4::Auth_with_ldap;
68 import C4::Auth_with_ldap qw(checkpw_ldap);
71 require C4::Auth_with_shibboleth;
72 import C4::Auth_with_shibboleth
73 qw(shib_ok checkpw_shib logout_shib login_shib_url get_login_shib);
75 # Check for good config
78 # Get shibboleth login attribute
79 $shib_login = get_login_shib();
82 # Bad config, disable shibboleth
88 import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url);
95 C4::Auth - Authenticates Koha users
105 my ($template, $borrowernumber, $cookie)
106 = get_template_and_user(
108 template_name => "opac-main.tt",
111 authnotrequired => 0,
112 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
116 output_html_with_http_headers $query, $cookie, $template->output;
120 The main function of this module is to provide
121 authentification. However the get_template_and_user function has
122 been provided so that a users login information is passed along
123 automatically. This gets loaded into the template.
127 =head2 get_template_and_user
129 my ($template, $borrowernumber, $cookie)
130 = get_template_and_user(
132 template_name => "opac-main.tt",
135 authnotrequired => 0,
136 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
140 This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
141 to C<&checkauth> (in this module) to perform authentification.
142 See C<&checkauth> for an explanation of these parameters.
144 The C<template_name> is then used to find the correct template for
145 the page. The authenticated users details are loaded onto the
146 template in the HTML::Template LOOP variable C<USER_INFO>. Also the
147 C<sessionID> is passed to the template. This can be used in templates
148 if cookies are disabled. It needs to be put as and input to every
151 More information on the C<gettemplate> sub can be found in the
156 sub get_template_and_user {
159 my ( $user, $cookie, $sessionID, $flags );
161 C4::Context->interface( $in->{type} );
163 my $safe_chars = 'a-zA-Z0-9_\-\/';
164 die "bad template path" unless $in->{'template_name'} =~ m/^[$safe_chars]+\.tt$/ig; #sanitize input
166 $in->{'authnotrequired'} ||= 0;
167 my $template = C4::Templates::gettemplate(
168 $in->{'template_name'},
174 if ( $in->{'template_name'} !~ m/maintenance/ ) {
175 ( $user, $cookie, $sessionID, $flags ) = checkauth(
177 $in->{'authnotrequired'},
178 $in->{'flagsrequired'},
184 # If the user logged in is the SCO user and he tries to go out the SCO module, log the user out removing the CGISESSID cookie
185 if ( $in->{type} eq 'opac' and $in->{template_name} !~ m|sco/| ) {
186 if ( C4::Context->preference('AutoSelfCheckID') && $user eq C4::Context->preference('AutoSelfCheckID') ) {
187 $template = C4::Templates::gettemplate( 'opac-auth.tt', 'opac', $in->{query} );
188 my $cookie = $in->{query}->cookie(
189 -name => 'CGISESSID',
195 $template->param( loginprompt => 1 );
196 print $in->{query}->header(
197 { type => 'text/html',
200 'X-Frame-Options' => 'SAMEORIGIN'
212 # It's possible for $user to be the borrowernumber if they don't have a
213 # userid defined (and are logging in through some other method, such
214 # as SSL certs against an email address)
216 $borrowernumber = getborrowernumber($user) if defined($user);
217 if ( !defined($borrowernumber) && defined($user) ) {
218 $borrower = C4::Members::GetMember( borrowernumber => $user );
220 $borrowernumber = $user;
222 # A bit of a hack, but I don't know there's a nicer way
224 $user = $borrower->{firstname} . ' ' . $borrower->{surname};
227 $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
231 $template->param( loggedinusername => $user );
232 $template->param( loggedinusernumber => $borrowernumber );
233 $template->param( sessionID => $sessionID );
235 if ( $in->{'type'} eq 'opac' ) {
236 require Koha::Virtualshelves;
237 my $some_private_shelves = Koha::Virtualshelves->get_some_shelves(
239 borrowernumber => $borrowernumber,
243 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
249 some_private_shelves => $some_private_shelves,
250 some_public_shelves => $some_public_shelves,
254 $template->param( "USER_INFO" => $borrower );
256 my $all_perms = get_all_subpermissions();
258 my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
259 editcatalogue updatecharges management tools editauthorities serials reports acquisition);
261 # We are going to use the $flags returned by checkauth
262 # to create the template's parameters that will indicate
263 # which menus the user can access.
264 if ( $flags && $flags->{superlibrarian} == 1 ) {
265 $template->param( CAN_user_circulate => 1 );
266 $template->param( CAN_user_catalogue => 1 );
267 $template->param( CAN_user_parameters => 1 );
268 $template->param( CAN_user_borrowers => 1 );
269 $template->param( CAN_user_permissions => 1 );
270 $template->param( CAN_user_reserveforothers => 1 );
271 $template->param( CAN_user_editcatalogue => 1 );
272 $template->param( CAN_user_updatecharges => 1 );
273 $template->param( CAN_user_acquisition => 1 );
274 $template->param( CAN_user_management => 1 );
275 $template->param( CAN_user_tools => 1 );
276 $template->param( CAN_user_editauthorities => 1 );
277 $template->param( CAN_user_serials => 1 );
278 $template->param( CAN_user_reports => 1 );
279 $template->param( CAN_user_staffaccess => 1 );
280 $template->param( CAN_user_plugins => 1 );
281 $template->param( CAN_user_coursereserves => 1 );
282 foreach my $module ( keys %$all_perms ) {
284 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
285 $template->param( "CAN_user_${module}_${subperm}" => 1 );
291 foreach my $module ( keys %$all_perms ) {
292 if ( defined($flags->{$module}) && $flags->{$module} == 1 ) {
293 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
294 $template->param( "CAN_user_${module}_${subperm}" => 1 );
296 } elsif ( ref( $flags->{$module} ) ) {
297 foreach my $subperm ( keys %{ $flags->{$module} } ) {
298 $template->param( "CAN_user_${module}_${subperm}" => 1 );
305 foreach my $module ( keys %$flags ) {
306 if ( $flags->{$module} == 1 or ref( $flags->{$module} ) ) {
307 $template->param( "CAN_user_$module" => 1 );
308 if ( $module eq "parameters" ) {
309 $template->param( CAN_user_management => 1 );
315 # Logged-in opac search history
316 # If the requested template is an opac one and opac search history is enabled
317 if ( $in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory') ) {
318 my $dbh = C4::Context->dbh;
319 my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
320 my $sth = $dbh->prepare($query);
321 $sth->execute($borrowernumber);
323 # If at least one search has already been performed
324 if ( $sth->fetchrow_array > 0 ) {
326 # We show the link in opac
327 $template->param( EnableOpacSearchHistory => 1 );
330 # And if there are searches performed when the user was not logged in,
331 # we add them to the logged-in search history
332 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
333 if (@recentSearches) {
334 my $dbh = C4::Context->dbh;
336 INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, type, total, time )
337 VALUES (?, ?, ?, ?, ?, ?, ?)
340 my $sth = $dbh->prepare($query);
341 $sth->execute( $borrowernumber,
342 $in->{query}->cookie("CGISESSID"),
345 $_->{type} || 'biblio',
348 ) foreach @recentSearches;
350 # clear out the search history from the session now that
351 # we've saved it to the database
352 C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } );
354 } elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) {
355 $template->param( EnableSearchHistory => 1 );
358 else { # if this is an anonymous session, setup to display public lists...
360 # If shibboleth is enabled, and we're in an anonymous session, we should allow
361 # the user to attempt login via shibboleth.
363 $template->param( shibbolethAuthentication => $shib,
364 shibbolethLoginUrl => login_shib_url( $in->{'query'} ),
367 # If shibboleth is enabled and we have a shibboleth login attribute,
368 # but we are in an anonymous session, then we clearly have an invalid
369 # shibboleth koha account.
371 $template->param( invalidShibLogin => '1' );
375 $template->param( sessionID => $sessionID );
377 if ( $in->{'type'} eq 'opac' ){
378 require Koha::Virtualshelves;
379 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
385 some_public_shelves => $some_public_shelves,
390 # Anonymous opac search history
391 # If opac search history is enabled and at least one search has already been performed
392 if ( C4::Context->preference('EnableOpacSearchHistory') ) {
393 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
394 if (@recentSearches) {
395 $template->param( EnableOpacSearchHistory => 1 );
399 if ( C4::Context->preference('dateformat') ) {
400 $template->param( dateformat => C4::Context->preference('dateformat') );
403 $template->param(auth_forwarded_hash => scalar $in->{'query'}->param('auth_forwarded_hash'));
405 # these template parameters are set the same regardless of $in->{'type'}
407 # Set the using_https variable for templates
408 # FIXME Under Plack the CGI->https method always returns 'OFF'
409 my $https = $in->{query}->https();
410 my $using_https = ( defined $https and $https ne 'OFF' ) ? 1 : 0;
413 "BiblioDefaultView" . C4::Context->preference("BiblioDefaultView") => 1,
414 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
415 GoogleJackets => C4::Context->preference("GoogleJackets"),
416 OpenLibraryCovers => C4::Context->preference("OpenLibraryCovers"),
417 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
418 LoginBranchcode => ( C4::Context->userenv ? C4::Context->userenv->{"branch"} : undef ),
419 LoginFirstname => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
420 LoginSurname => C4::Context->userenv ? C4::Context->userenv->{"surname"} : "Inconnu",
421 emailaddress => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
422 loggedinpersona => C4::Context->userenv ? C4::Context->userenv->{"persona"} : undef,
423 TagsEnabled => C4::Context->preference("TagsEnabled"),
424 hide_marc => C4::Context->preference("hide_marc"),
425 item_level_itypes => C4::Context->preference('item-level_itypes'),
426 patronimages => C4::Context->preference("patronimages"),
427 singleBranchMode => ( Koha::Libraries->search->count == 1 ),
428 XSLTDetailsDisplay => C4::Context->preference("XSLTDetailsDisplay"),
429 XSLTResultsDisplay => C4::Context->preference("XSLTResultsDisplay"),
430 using_https => $using_https,
431 noItemTypeImages => C4::Context->preference("noItemTypeImages"),
432 marcflavour => C4::Context->preference("marcflavour"),
433 persona => C4::Context->preference("persona"),
434 OPACBaseURL => C4::Context->preference('OPACBaseURL'),
436 if ( $in->{'type'} eq "intranet" ) {
438 AmazonCoverImages => C4::Context->preference("AmazonCoverImages"),
439 AutoLocation => C4::Context->preference("AutoLocation"),
440 "BiblioDefaultView" . C4::Context->preference("IntranetBiblioDefaultView") => 1,
441 CircAutocompl => C4::Context->preference("CircAutocompl"),
442 FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
443 IndependentBranches => C4::Context->preference("IndependentBranches"),
444 IntranetNav => C4::Context->preference("IntranetNav"),
445 IntranetmainUserblock => C4::Context->preference("IntranetmainUserblock"),
446 LibraryName => C4::Context->preference("LibraryName"),
447 LoginBranchname => ( C4::Context->userenv ? C4::Context->userenv->{"branchname"} : undef ),
448 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
449 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
450 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
451 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
452 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
453 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
454 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
455 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
456 intranetbookbag => C4::Context->preference("intranetbookbag"),
457 suggestion => C4::Context->preference("suggestion"),
458 virtualshelves => C4::Context->preference("virtualshelves"),
459 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
460 EasyAnalyticalRecords => C4::Context->preference('EasyAnalyticalRecords'),
461 LocalCoverImages => C4::Context->preference('LocalCoverImages'),
462 OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'),
463 AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'),
464 EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'),
465 UseKohaPlugins => C4::Context->preference('UseKohaPlugins'),
466 UseCourseReserves => C4::Context->preference("UseCourseReserves"),
467 useDischarge => C4::Context->preference('useDischarge'),
471 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
473 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
474 my $LibraryNameTitle = C4::Context->preference("LibraryName");
475 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
476 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
478 # clean up the busc param in the session
479 # if the page is not opac-detail and not the "add to list" page
480 # and not the "edit comments" page
481 if ( C4::Context->preference("OpacBrowseResults")
482 && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
484 unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
485 or $pagename =~ /^addbybiblionumber$/
486 or $pagename =~ /^review$/ ) {
487 my $sessionSearch = get_session( $sessionID || $in->{'query'}->cookie("CGISESSID") );
488 $sessionSearch->clear( ["busc"] ) if ( $sessionSearch->param("busc") );
492 # variables passed from CGI: opac_css_override and opac_search_limits.
493 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
494 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
497 ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:(\w+)/ ) ||
498 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:(\w+)/ ) ||
499 ( $in->{'query'}->param('multibranchlimit') && $in->{'query'}->param('multibranchlimit') =~ /multibranchlimit-(\w+)/ )
501 $opac_name = $1; # opac_search_limit is a branch, so we use it.
502 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
503 $opac_name = $in->{'query'}->param('multibranchlimit');
504 } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
505 $opac_name = C4::Context->userenv->{'branch'};
508 my $library_categories = Koha::LibraryCategories->search({categorytype => 'searchdomain', show_in_pulldown => 1}, { order_by => ['categorytype', 'categorycode']});
510 OpacAdditionalStylesheet => C4::Context->preference("OpacAdditionalStylesheet"),
511 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
512 AuthorisedValueImages => C4::Context->preference("AuthorisedValueImages"),
513 BranchesLoop => GetBranchesLoop($opac_name),
514 BranchCategoriesLoop => $library_categories,
515 opac_name => $opac_name,
516 LibraryName => "" . C4::Context->preference("LibraryName"),
517 LibraryNameTitle => "" . $LibraryNameTitle,
518 LoginBranchname => C4::Context->userenv ? C4::Context->userenv->{"branchname"} : "",
519 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
520 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
521 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
522 OPACShelfBrowser => "" . C4::Context->preference("OPACShelfBrowser"),
523 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
524 OPACUserCSS => "" . C4::Context->preference("OPACUserCSS"),
525 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
526 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
527 opac_search_limit => $opac_search_limit,
528 opac_limit_override => $opac_limit_override,
529 OpacBrowser => C4::Context->preference("OpacBrowser"),
530 OpacCloud => C4::Context->preference("OpacCloud"),
531 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
532 OpacMainUserBlock => "" . C4::Context->preference("OpacMainUserBlock"),
533 OpacNav => "" . C4::Context->preference("OpacNav"),
534 OpacNavRight => "" . C4::Context->preference("OpacNavRight"),
535 OpacNavBottom => "" . C4::Context->preference("OpacNavBottom"),
536 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
537 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
538 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
539 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
540 OpacTopissue => C4::Context->preference("OpacTopissue"),
541 RequestOnOpac => C4::Context->preference("RequestOnOpac"),
542 'Version' => C4::Context->preference('Version'),
543 hidelostitems => C4::Context->preference("hidelostitems"),
544 mylibraryfirst => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
545 opaclayoutstylesheet => "" . C4::Context->preference("opaclayoutstylesheet"),
546 opacbookbag => "" . C4::Context->preference("opacbookbag"),
547 opaccredits => "" . C4::Context->preference("opaccredits"),
548 OpacFavicon => C4::Context->preference("OpacFavicon"),
549 opacheader => "" . C4::Context->preference("opacheader"),
550 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
551 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
552 OPACUserJS => C4::Context->preference("OPACUserJS"),
553 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
554 OpenLibrarySearch => C4::Context->preference("OpenLibrarySearch"),
555 ShowReviewer => C4::Context->preference("ShowReviewer"),
556 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
557 suggestion => "" . C4::Context->preference("suggestion"),
558 virtualshelves => "" . C4::Context->preference("virtualshelves"),
559 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
560 OPACXSLTDetailsDisplay => C4::Context->preference("OPACXSLTDetailsDisplay"),
561 OPACXSLTResultsDisplay => C4::Context->preference("OPACXSLTResultsDisplay"),
562 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
563 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
564 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
565 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
566 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
567 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
568 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
569 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
570 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
571 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
572 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
573 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
574 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
575 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
576 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
577 useDischarge => C4::Context->preference('useDischarge'),
580 $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
583 # Check if we were asked using parameters to force a specific language
584 if ( defined $in->{'query'}->param('language') ) {
586 # Extract the language, let C4::Languages::getlanguage choose
588 my $language = C4::Languages::getlanguage( $in->{'query'} );
589 my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
590 if ( ref $cookie eq 'ARRAY' ) {
591 push @{$cookie}, $languagecookie;
593 $cookie = [ $cookie, $languagecookie ];
597 return ( $template, $borrowernumber, $cookie, $flags );
602 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
604 Verifies that the user is authorized to run this script. If
605 the user is authorized, a (userid, cookie, session-id, flags)
606 quadruple is returned. If the user is not authorized but does
607 not have the required privilege (see $flagsrequired below), it
608 displays an error page and exits. Otherwise, it displays the
609 login page and exits.
611 Note that C<&checkauth> will return if and only if the user
612 is authorized, so it should be called early on, before any
613 unfinished operations (e.g., if you've opened a file, then
614 C<&checkauth> won't close it for you).
616 C<$query> is the CGI object for the script calling C<&checkauth>.
618 The C<$noauth> argument is optional. If it is set, then no
619 authorization is required for the script.
621 C<&checkauth> fetches user and session information from C<$query> and
622 ensures that the user is authorized to run scripts that require
625 The C<$flagsrequired> argument specifies the required privileges
626 the user must have if the username and password are correct.
627 It should be specified as a reference-to-hash; keys in the hash
628 should be the "flags" for the user, as specified in the Members
629 intranet module. Any key specified must correspond to a "flag"
630 in the userflags table. E.g., { circulate => 1 } would specify
631 that the user must have the "circulate" privilege in order to
632 proceed. To make sure that access control is correct, the
633 C<$flagsrequired> parameter must be specified correctly.
635 Koha also has a concept of sub-permissions, also known as
636 granular permissions. This makes the value of each key
637 in the C<flagsrequired> hash take on an additional
642 The user must have access to all subfunctions of the module
643 specified by the hash key.
647 The user must have access to at least one subfunction of the module
648 specified by the hash key.
650 specific permission, e.g., 'export_catalog'
652 The user must have access to the specific subfunction list, which
653 must correspond to a row in the permissions table.
655 The C<$type> argument specifies whether the template should be
656 retrieved from the opac or intranet directory tree. "opac" is
657 assumed if it is not specified; however, if C<$type> is specified,
658 "intranet" is assumed if it is not "opac".
660 If C<$query> does not have a valid session ID associated with it
661 (i.e., the user has not logged in) or if the session has expired,
662 C<&checkauth> presents the user with a login page (from the point of
663 view of the original script, C<&checkauth> does not return). Once the
664 user has authenticated, C<&checkauth> restarts the original script
665 (this time, C<&checkauth> returns).
667 The login page is provided using a HTML::Template, which is set in the
668 systempreferences table or at the top of this file. The variable C<$type>
669 selects which template to use, either the opac or the intranet
670 authentification template.
672 C<&checkauth> returns a user ID, a cookie, and a session ID. The
673 cookie should be sent back to the browser; it verifies that the user
683 # If version syspref is unavailable, it means Koha is being installed,
684 # and so we must redirect to OPAC maintenance page or to the WebInstaller
685 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
686 if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
687 warn "OPAC Install required, redirecting to maintenance";
688 print $query->redirect("/cgi-bin/koha/maintenance.pl");
691 unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
692 if ( $type ne 'opac' ) {
693 warn "Install required, redirecting to Installer";
694 print $query->redirect("/cgi-bin/koha/installer/install.pl");
696 warn "OPAC Install required, redirecting to maintenance";
697 print $query->redirect("/cgi-bin/koha/maintenance.pl");
702 # check that database and koha version are the same
703 # there is no DB version, it's a fresh install,
704 # go to web installer
705 # there is a DB version, compare it to the code version
706 my $kohaversion = Koha::version();
708 # remove the 3 last . to have a Perl number
709 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
710 $debug and print STDERR "kohaversion : $kohaversion\n";
711 if ( $version < $kohaversion ) {
712 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
713 if ( $type ne 'opac' ) {
714 warn sprintf( $warning, 'Installer' );
715 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
717 warn sprintf( "OPAC: " . $warning, 'maintenance' );
718 print $query->redirect("/cgi-bin/koha/maintenance.pl");
726 open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
727 printf $fh join( "\n", @_ );
731 sub _timeout_syspref {
732 my $timeout = C4::Context->preference('timeout') || 600;
734 # value in days, convert in seconds
735 if ( $timeout =~ /(\d+)[dD]/ ) {
736 $timeout = $1 * 86400;
743 $debug and warn "Checking Auth";
745 # $authnotrequired will be set for scripts which will run without authentication
746 my $authnotrequired = shift;
747 my $flagsrequired = shift;
750 $type = 'opac' unless $type;
752 my $dbh = C4::Context->dbh;
753 my $timeout = _timeout_syspref();
755 _version_check( $type, $query );
760 my ( $userid, $cookie, $sessionID, $flags );
761 my $logout = $query->param('logout.x');
763 my $anon_search_history;
765 # This parameter is the name of the CAS server we want to authenticate against,
766 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
767 my $casparam = $query->param('cas');
768 my $q_userid = $query->param('userid') // '';
770 # Basic authentication is incompatible with the use of Shibboleth,
771 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
772 # and it may not be the attribute we want to use to match the koha login.
774 # Also, do not consider an empty REMOTE_USER.
776 # Finally, after those tests, we can assume (although if it would be better with
777 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
778 # and we can affect it to $userid.
779 if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
781 # Using Basic Authentication, no cookies required
782 $cookie = $query->cookie(
783 -name => 'CGISESSID',
792 # we don't want to set a session because we are being called by a persona callback
794 elsif ( $sessionID = $query->cookie("CGISESSID") )
795 { # assignment, not comparison
796 my $session = get_session($sessionID);
797 C4::Context->_new_userenv($sessionID);
798 my ( $ip, $lasttime, $sessiontype );
801 $s_userid = $session->param('id') // '';
802 C4::Context->set_userenv(
803 $session->param('number'), $s_userid,
804 $session->param('cardnumber'), $session->param('firstname'),
805 $session->param('surname'), $session->param('branch'),
806 $session->param('branchname'), $session->param('flags'),
807 $session->param('emailaddress'), $session->param('branchprinter'),
808 $session->param('persona'), $session->param('shibboleth')
810 C4::Context::set_shelves_userenv( 'bar', $session->param('barshelves') );
811 C4::Context::set_shelves_userenv( 'pub', $session->param('pubshelves') );
812 C4::Context::set_shelves_userenv( 'tot', $session->param('totshelves') );
813 $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
814 $ip = $session->param('ip');
815 $lasttime = $session->param('lasttime');
817 $sessiontype = $session->param('sessiontype') || '';
819 if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
820 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
821 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
824 #if a user enters an id ne to the id in the current session, we need to log them in...
825 #first we need to clear the anonymous session...
826 $debug and warn "query id = $q_userid but session id = $s_userid";
827 $anon_search_history = $session->param('search_history');
830 C4::Context->_unset_userenv($sessionID);
836 # voluntary logout the user
837 # check wether the user was using their shibboleth session or a local one
838 my $shibSuccess = C4::Context->userenv->{'shibboleth'};
841 C4::Context->_unset_userenv($sessionID);
843 #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
847 if ($cas and $caslogout) {
848 logout_cas($query, $type);
851 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
852 if ( $shib and $shib_login and $shibSuccess and $type eq 'opac' ) {
854 # (Note: $type eq 'opac' condition should be removed when shibboleth authentication for intranet will be implemented)
858 elsif ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
861 $info{'timed_out'} = 1;
866 C4::Context->_unset_userenv($sessionID);
868 #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
872 elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
874 # Different ip than originally logged in from
875 $info{'oldip'} = $ip;
876 $info{'newip'} = $ENV{'REMOTE_ADDR'};
877 $info{'different_ip'} = 1;
880 C4::Context->_unset_userenv($sessionID);
882 #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
887 $cookie = $query->cookie(
888 -name => 'CGISESSID',
889 -value => $session->id,
892 $session->param( 'lasttime', time() );
893 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...
894 $flags = haspermission( $userid, $flagsrequired );
898 $info{'nopermission'} = 1;
903 unless ( $userid || $sessionID ) {
905 #we initiate a session prior to checking for a username to allow for anonymous sessions...
906 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
908 # Save anonymous search history in new session so it can be retrieved
909 # by get_template_and_user to store it in user's search history after
910 # a successful login.
911 if ($anon_search_history) {
912 $session->param( 'search_history', $anon_search_history );
915 my $sessionID = $session->id;
916 C4::Context->_new_userenv($sessionID);
917 $cookie = $query->cookie(
918 -name => 'CGISESSID',
919 -value => $session->id,
923 my $pki_field = C4::Context->preference('AllowPKIAuth');
924 if ( !defined($pki_field) ) {
925 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
928 if ( ( $cas && $query->param('ticket') )
930 || ( $shib && $shib_login )
931 || $pki_field ne 'None'
934 my $password = $query->param('password');
937 my ( $return, $cardnumber );
939 # If shib is enabled and we have a shib login, does the login match a valid koha user
940 if ( $shib && $shib_login && $type eq 'opac' ) {
943 # Do not pass password here, else shib will not be checked in checkpw.
944 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $userid, undef, $query );
945 $userid = $retuserid;
946 $shibSuccess = $return;
947 $info{'invalidShibLogin'} = 1 unless ($return);
950 # If shib login and match were successful, skip further login methods
951 unless ($shibSuccess) {
952 if ( $cas && $query->param('ticket') ) {
954 ( $return, $cardnumber, $retuserid ) =
955 checkpw( $dbh, $userid, $password, $query, $type );
956 $userid = $retuserid;
957 $info{'invalidCasLogin'} = 1 unless ($return);
961 my $value = $persona;
963 # If we're looking up the email, there's a chance that the person
964 # doesn't have a userid. So if there is none, we pass along the
965 # borrower number, and the bits of code that need to know the user
966 # ID will have to be smart enough to handle that.
968 my @users_info = C4::Members::GetBorrowersWithEmail($value);
971 # First the userid, then the borrowernum
972 $value = $users_info[0][1] || $users_info[0][0];
977 $return = $value ? 1 : 0;
982 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
983 || ( $pki_field eq 'emailAddress'
984 && $ENV{'SSL_CLIENT_S_DN_Email'} )
988 if ( $pki_field eq 'Common Name' ) {
989 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
991 elsif ( $pki_field eq 'emailAddress' ) {
992 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
994 # If we're looking up the email, there's a chance that the person
995 # doesn't have a userid. So if there is none, we pass along the
996 # borrower number, and the bits of code that need to know the user
997 # ID will have to be smart enough to handle that.
999 my @users_info = C4::Members::GetBorrowersWithEmail($value);
1002 # First the userid, then the borrowernum
1003 $value = $users_info[0][1] || $users_info[0][0];
1009 $return = $value ? 1 : 0;
1015 ( $return, $cardnumber, $retuserid ) =
1016 checkpw( $dbh, $userid, $password, $query, $type );
1017 $userid = $retuserid if ($retuserid);
1018 $info{'invalid_username_or_password'} = 1 unless ($return);
1022 # $return: 1 = valid user, 2 = superlibrarian
1025 #_session_log(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
1026 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1030 $info{'nopermission'} = 1;
1031 C4::Context->_unset_userenv($sessionID);
1033 my ( $borrowernumber, $firstname, $surname, $userflags,
1034 $branchcode, $branchname, $branchprinter, $emailaddress );
1036 if ( $return == 1 ) {
1038 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1039 branches.branchname as branchname,
1040 branches.branchprinter as branchprinter,
1043 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1045 my $sth = $dbh->prepare("$select where userid=?");
1046 $sth->execute($userid);
1047 unless ( $sth->rows ) {
1048 $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
1049 $sth = $dbh->prepare("$select where cardnumber=?");
1050 $sth->execute($cardnumber);
1052 unless ( $sth->rows ) {
1053 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1054 $sth->execute($userid);
1055 unless ( $sth->rows ) {
1056 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1061 ( $borrowernumber, $firstname, $surname, $userflags,
1062 $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow;
1063 $debug and print STDERR "AUTH_3 results: " .
1064 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1066 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1069 # launch a sequence to check if we have a ip for the branch, i
1070 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1072 my $ip = $ENV{'REMOTE_ADDR'};
1074 # if they specify at login, use that
1075 if ( $query->param('branch') ) {
1076 $branchcode = $query->param('branch');
1077 $branchname = GetBranchName($branchcode);
1079 my $branches = GetBranches();
1080 if ( C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation') ) {
1082 # we have to check they are coming from the right ip range
1083 my $domain = $branches->{$branchcode}->{'branchip'};
1084 if ( $ip !~ /^$domain/ ) {
1086 $info{'wrongip'} = 1;
1091 foreach my $br ( keys %$branches ) {
1093 # now we work with the treatment of ip
1094 my $domain = $branches->{$br}->{'branchip'};
1095 if ( $domain && $ip =~ /^$domain/ ) {
1096 $branchcode = $branches->{$br}->{'branchcode'};
1098 # new op dev : add the branchprinter and branchname in the cookie
1099 $branchprinter = $branches->{$br}->{'branchprinter'};
1100 $branchname = $branches->{$br}->{'branchname'};
1103 $session->param( 'number', $borrowernumber );
1104 $session->param( 'id', $userid );
1105 $session->param( 'cardnumber', $cardnumber );
1106 $session->param( 'firstname', $firstname );
1107 $session->param( 'surname', $surname );
1108 $session->param( 'branch', $branchcode );
1109 $session->param( 'branchname', $branchname );
1110 $session->param( 'flags', $userflags );
1111 $session->param( 'emailaddress', $emailaddress );
1112 $session->param( 'ip', $session->remote_addr() );
1113 $session->param( 'lasttime', time() );
1114 $session->param( 'shibboleth', $shibSuccess );
1115 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1117 elsif ( $return == 2 ) {
1119 #We suppose the user is the superlibrarian
1120 $borrowernumber = 0;
1121 $session->param( 'number', 0 );
1122 $session->param( 'id', C4::Context->config('user') );
1123 $session->param( 'cardnumber', C4::Context->config('user') );
1124 $session->param( 'firstname', C4::Context->config('user') );
1125 $session->param( 'surname', C4::Context->config('user') );
1126 $session->param( 'branch', 'NO_LIBRARY_SET' );
1127 $session->param( 'branchname', 'NO_LIBRARY_SET' );
1128 $session->param( 'flags', 1 );
1129 $session->param( 'emailaddress', C4::Context->preference('KohaAdminEmailAddress') );
1130 $session->param( 'ip', $session->remote_addr() );
1131 $session->param( 'lasttime', time() );
1134 $session->param( 'persona', 1 );
1136 C4::Context->set_userenv(
1137 $session->param('number'), $session->param('id'),
1138 $session->param('cardnumber'), $session->param('firstname'),
1139 $session->param('surname'), $session->param('branch'),
1140 $session->param('branchname'), $session->param('flags'),
1141 $session->param('emailaddress'), $session->param('branchprinter'),
1142 $session->param('persona'), $session->param('shibboleth')
1146 # $return: 0 = invalid user
1147 # reset to anonymous session
1149 $debug and warn "Login failed, resetting anonymous session...";
1151 $info{'invalid_username_or_password'} = 1;
1152 C4::Context->_unset_userenv($sessionID);
1154 $session->param( 'lasttime', time() );
1155 $session->param( 'ip', $session->remote_addr() );
1156 $session->param( 'sessiontype', 'anon' );
1158 } # END if ( $userid = $query->param('userid') )
1159 elsif ( $type eq "opac" ) {
1161 # if we are here this is an anonymous session; add public lists to it and a few other items...
1162 # anonymous sessions are created only for the OPAC
1163 $debug and warn "Initiating an anonymous session...";
1165 # setting a couple of other session vars...
1166 $session->param( 'ip', $session->remote_addr() );
1167 $session->param( 'lasttime', time() );
1168 $session->param( 'sessiontype', 'anon' );
1170 } # END unless ($userid)
1172 # finished authentification, now respond
1173 if ( $loggedin || $authnotrequired )
1177 $cookie = $query->cookie(
1178 -name => 'CGISESSID',
1183 return ( $userid, $cookie, $sessionID, $flags );
1188 # AUTH rejected, show the login/password template, after checking the DB.
1192 # get the inputs from the incoming query
1194 foreach my $name ( param $query) {
1195 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1196 my $value = $query->param($name);
1197 push @inputs, { name => $name, value => $value };
1200 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1201 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1202 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1204 my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1205 my $template = C4::Templates::gettemplate( $template_name, $type, $query );
1207 branchloop => GetBranchesLoop(),
1208 OpacAdditionalStylesheet => C4::Context->preference("OpacAdditionalStylesheet"),
1209 opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
1212 casAuthentication => C4::Context->preference("casAuthentication"),
1213 shibbolethAuthentication => $shib,
1214 SessionRestrictionByIP => C4::Context->preference("SessionRestrictionByIP"),
1215 suggestion => C4::Context->preference("suggestion"),
1216 virtualshelves => C4::Context->preference("virtualshelves"),
1217 LibraryName => "" . C4::Context->preference("LibraryName"),
1218 LibraryNameTitle => "" . $LibraryNameTitle,
1219 opacuserlogin => C4::Context->preference("opacuserlogin"),
1220 OpacNav => C4::Context->preference("OpacNav"),
1221 OpacNavRight => C4::Context->preference("OpacNavRight"),
1222 OpacNavBottom => C4::Context->preference("OpacNavBottom"),
1223 opaccredits => C4::Context->preference("opaccredits"),
1224 OpacFavicon => C4::Context->preference("OpacFavicon"),
1225 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1226 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1227 OPACUserJS => C4::Context->preference("OPACUserJS"),
1228 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1229 OpacCloud => C4::Context->preference("OpacCloud"),
1230 OpacTopissue => C4::Context->preference("OpacTopissue"),
1231 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1232 OpacBrowser => C4::Context->preference("OpacBrowser"),
1233 opacheader => C4::Context->preference("opacheader"),
1234 TagsEnabled => C4::Context->preference("TagsEnabled"),
1235 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1236 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1237 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1238 intranetbookbag => C4::Context->preference("intranetbookbag"),
1239 IntranetNav => C4::Context->preference("IntranetNav"),
1240 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1241 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
1242 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1243 IndependentBranches => C4::Context->preference("IndependentBranches"),
1244 AutoLocation => C4::Context->preference("AutoLocation"),
1245 wrongip => $info{'wrongip'},
1246 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1247 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1248 persona => C4::Context->preference("Persona"),
1249 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1252 $template->param( SCO_login => 1 ) if ( $query->param('sco_user_login') );
1253 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1254 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1256 if ( $type eq 'opac' ) {
1257 require Koha::Virtualshelves;
1258 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1264 some_public_shelves => $some_public_shelves,
1270 # Is authentication against multiple CAS servers enabled?
1271 if ( C4::Auth_with_cas::multipleAuth && !$casparam ) {
1272 my $casservers = C4::Auth_with_cas::getMultipleAuth();
1274 foreach my $key ( keys %$casservers ) {
1275 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1278 casServersLoop => \@tmplservers
1282 casServerUrl => login_cas_url($query, undef, $type),
1287 invalidCasLogin => $info{'invalidCasLogin'}
1293 shibbolethAuthentication => $shib,
1294 shibbolethLoginUrl => login_shib_url($query),
1298 if (C4::Context->preference('GoogleOpenIDConnect')) {
1299 if ($query->param("OpenIDConnectFailed")) {
1300 my $reason = $query->param('OpenIDConnectFailed');
1301 $template->param(invalidGoogleOpenIDConnectLogin => $reason);
1306 LibraryName => C4::Context->preference("LibraryName"),
1308 $template->param(%info);
1310 # $cookie = $query->cookie(CGISESSID => $session->id
1312 print $query->header(
1313 { type => 'text/html',
1316 'X-Frame-Options' => 'SAMEORIGIN'
1323 =head2 check_api_auth
1325 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1327 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1328 cookie, determine if the user has the privileges specified by C<$userflags>.
1330 C<check_api_auth> is is meant for authenticating users of web services, and
1331 consequently will always return and will not attempt to redirect the user
1334 If a valid session cookie is already present, check_api_auth will return a status
1335 of "ok", the cookie, and the Koha session ID.
1337 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1338 parameters and create a session cookie and Koha session if the supplied credentials
1341 Possible return values in C<$status> are:
1345 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1347 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1349 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1351 =item "expired -- session cookie has expired; API user should resubmit userid and password
1357 sub check_api_auth {
1359 my $flagsrequired = shift;
1361 my $dbh = C4::Context->dbh;
1362 my $timeout = _timeout_syspref();
1364 unless ( C4::Context->preference('Version') ) {
1366 # database has not been installed yet
1367 return ( "maintenance", undef, undef );
1369 my $kohaversion = Koha::version();
1370 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1371 if ( C4::Context->preference('Version') < $kohaversion ) {
1373 # database in need of version update; assume that
1374 # no API should be called while databsae is in
1376 return ( "maintenance", undef, undef );
1379 # FIXME -- most of what follows is a copy-and-paste
1380 # of code from checkauth. There is an obvious need
1381 # for refactoring to separate the various parts of
1382 # the authentication code, but as of 2007-11-19 this
1383 # is deferred so as to not introduce bugs into the
1384 # regular authentication code for Koha 3.0.
1386 # see if we have a valid session cookie already
1387 # however, if a userid parameter is present (i.e., from
1388 # a form submission, assume that any current cookie
1390 my $sessionID = undef;
1391 unless ( $query->param('userid') ) {
1392 $sessionID = $query->cookie("CGISESSID");
1394 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1395 my $session = get_session($sessionID);
1396 C4::Context->_new_userenv($sessionID);
1398 C4::Context->set_userenv(
1399 $session->param('number'), $session->param('id'),
1400 $session->param('cardnumber'), $session->param('firstname'),
1401 $session->param('surname'), $session->param('branch'),
1402 $session->param('branchname'), $session->param('flags'),
1403 $session->param('emailaddress'), $session->param('branchprinter')
1406 my $ip = $session->param('ip');
1407 my $lasttime = $session->param('lasttime');
1408 my $userid = $session->param('id');
1409 if ( $lasttime < time() - $timeout ) {
1414 C4::Context->_unset_userenv($sessionID);
1417 return ( "expired", undef, undef );
1418 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1420 # IP address changed
1423 C4::Context->_unset_userenv($sessionID);
1426 return ( "expired", undef, undef );
1428 my $cookie = $query->cookie(
1429 -name => 'CGISESSID',
1430 -value => $session->id,
1433 $session->param( 'lasttime', time() );
1434 my $flags = haspermission( $userid, $flagsrequired );
1436 return ( "ok", $cookie, $sessionID );
1440 C4::Context->_unset_userenv($sessionID);
1443 return ( "failed", undef, undef );
1447 return ( "expired", undef, undef );
1452 my $userid = $query->param('userid');
1453 my $password = $query->param('password');
1454 my ( $return, $cardnumber );
1457 if ( $cas && $query->param('PT') ) {
1459 $debug and print STDERR "## check_api_auth - checking CAS\n";
1461 # In case of a CAS authentication, we use the ticket instead of the password
1462 my $PT = $query->param('PT');
1463 ( $return, $cardnumber, $userid ) = check_api_auth_cas( $dbh, $PT, $query ); # EXTERNAL AUTH
1466 # User / password auth
1467 unless ( $userid and $password ) {
1469 # caller did something wrong, fail the authenticateion
1470 return ( "failed", undef, undef );
1472 ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password, $query );
1475 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1476 my $session = get_session("");
1477 return ( "failed", undef, undef ) unless $session;
1479 my $sessionID = $session->id;
1480 C4::Context->_new_userenv($sessionID);
1481 my $cookie = $query->cookie(
1482 -name => 'CGISESSID',
1483 -value => $sessionID,
1486 if ( $return == 1 ) {
1488 $borrowernumber, $firstname, $surname,
1489 $userflags, $branchcode, $branchname,
1490 $branchprinter, $emailaddress
1494 "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=?"
1496 $sth->execute($userid);
1498 $borrowernumber, $firstname, $surname,
1499 $userflags, $branchcode, $branchname,
1500 $branchprinter, $emailaddress
1501 ) = $sth->fetchrow if ( $sth->rows );
1503 unless ( $sth->rows ) {
1504 my $sth = $dbh->prepare(
1505 "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=?"
1507 $sth->execute($cardnumber);
1509 $borrowernumber, $firstname, $surname,
1510 $userflags, $branchcode, $branchname,
1511 $branchprinter, $emailaddress
1512 ) = $sth->fetchrow if ( $sth->rows );
1514 unless ( $sth->rows ) {
1515 $sth->execute($userid);
1517 $borrowernumber, $firstname, $surname, $userflags,
1518 $branchcode, $branchname, $branchprinter, $emailaddress
1519 ) = $sth->fetchrow if ( $sth->rows );
1523 my $ip = $ENV{'REMOTE_ADDR'};
1525 # if they specify at login, use that
1526 if ( $query->param('branch') ) {
1527 $branchcode = $query->param('branch');
1528 $branchname = GetBranchName($branchcode);
1530 my $branches = GetBranches();
1532 foreach my $br ( keys %$branches ) {
1534 # now we work with the treatment of ip
1535 my $domain = $branches->{$br}->{'branchip'};
1536 if ( $domain && $ip =~ /^$domain/ ) {
1537 $branchcode = $branches->{$br}->{'branchcode'};
1539 # new op dev : add the branchprinter and branchname in the cookie
1540 $branchprinter = $branches->{$br}->{'branchprinter'};
1541 $branchname = $branches->{$br}->{'branchname'};
1544 $session->param( 'number', $borrowernumber );
1545 $session->param( 'id', $userid );
1546 $session->param( 'cardnumber', $cardnumber );
1547 $session->param( 'firstname', $firstname );
1548 $session->param( 'surname', $surname );
1549 $session->param( 'branch', $branchcode );
1550 $session->param( 'branchname', $branchname );
1551 $session->param( 'flags', $userflags );
1552 $session->param( 'emailaddress', $emailaddress );
1553 $session->param( 'ip', $session->remote_addr() );
1554 $session->param( 'lasttime', time() );
1555 } elsif ( $return == 2 ) {
1557 #We suppose the user is the superlibrarian
1558 $session->param( 'number', 0 );
1559 $session->param( 'id', C4::Context->config('user') );
1560 $session->param( 'cardnumber', C4::Context->config('user') );
1561 $session->param( 'firstname', C4::Context->config('user') );
1562 $session->param( 'surname', C4::Context->config('user') );
1563 $session->param( 'branch', 'NO_LIBRARY_SET' );
1564 $session->param( 'branchname', 'NO_LIBRARY_SET' );
1565 $session->param( 'flags', 1 );
1566 $session->param( 'emailaddress', C4::Context->preference('KohaAdminEmailAddress') );
1567 $session->param( 'ip', $session->remote_addr() );
1568 $session->param( 'lasttime', time() );
1570 C4::Context->set_userenv(
1571 $session->param('number'), $session->param('id'),
1572 $session->param('cardnumber'), $session->param('firstname'),
1573 $session->param('surname'), $session->param('branch'),
1574 $session->param('branchname'), $session->param('flags'),
1575 $session->param('emailaddress'), $session->param('branchprinter')
1577 return ( "ok", $cookie, $sessionID );
1579 return ( "failed", undef, undef );
1584 =head2 check_cookie_auth
1586 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1588 Given a CGISESSID cookie set during a previous login to Koha, determine
1589 if the user has the privileges specified by C<$userflags>.
1591 C<check_cookie_auth> is meant for authenticating special services
1592 such as tools/upload-file.pl that are invoked by other pages that
1593 have been authenticated in the usual way.
1595 Possible return values in C<$status> are:
1599 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1601 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1603 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1605 =item "expired -- session cookie has expired; API user should resubmit userid and password
1611 sub check_cookie_auth {
1613 my $flagsrequired = shift;
1615 my $dbh = C4::Context->dbh;
1616 my $timeout = _timeout_syspref();
1618 unless ( C4::Context->preference('Version') ) {
1620 # database has not been installed yet
1621 return ( "maintenance", undef );
1623 my $kohaversion = Koha::version();
1624 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1625 if ( C4::Context->preference('Version') < $kohaversion ) {
1627 # database in need of version update; assume that
1628 # no API should be called while databsae is in
1630 return ( "maintenance", undef );
1633 # FIXME -- most of what follows is a copy-and-paste
1634 # of code from checkauth. There is an obvious need
1635 # for refactoring to separate the various parts of
1636 # the authentication code, but as of 2007-11-23 this
1637 # is deferred so as to not introduce bugs into the
1638 # regular authentication code for Koha 3.0.
1640 # see if we have a valid session cookie already
1641 # however, if a userid parameter is present (i.e., from
1642 # a form submission, assume that any current cookie
1644 unless ( defined $cookie and $cookie ) {
1645 return ( "failed", undef );
1647 my $sessionID = $cookie;
1648 my $session = get_session($sessionID);
1649 C4::Context->_new_userenv($sessionID);
1651 C4::Context->set_userenv(
1652 $session->param('number'), $session->param('id'),
1653 $session->param('cardnumber'), $session->param('firstname'),
1654 $session->param('surname'), $session->param('branch'),
1655 $session->param('branchname'), $session->param('flags'),
1656 $session->param('emailaddress'), $session->param('branchprinter')
1659 my $ip = $session->param('ip');
1660 my $lasttime = $session->param('lasttime');
1661 my $userid = $session->param('id');
1662 if ( $lasttime < time() - $timeout ) {
1667 C4::Context->_unset_userenv($sessionID);
1670 return ("expired", undef);
1671 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1673 # IP address changed
1676 C4::Context->_unset_userenv($sessionID);
1679 return ( "expired", undef );
1681 $session->param( 'lasttime', time() );
1682 my $flags = haspermission( $userid, $flagsrequired );
1684 return ( "ok", $sessionID );
1688 C4::Context->_unset_userenv($sessionID);
1691 return ( "failed", undef );
1695 return ( "expired", undef );
1702 my $session = get_session($sessionID);
1704 Given a session ID, retrieve the CGI::Session object used to store
1705 the session's state. The session object can be used to store
1706 data that needs to be accessed by different scripts during a
1709 If the C<$sessionID> parameter is an empty string, a new session
1715 my $sessionID = shift;
1716 my $storage_method = C4::Context->preference('SessionStorage');
1717 my $dbh = C4::Context->dbh;
1719 if ( $storage_method eq 'mysql' ) {
1720 $session = new CGI::Session( "driver:MySQL;serializer:yaml;id:md5", $sessionID, { Handle => $dbh } );
1722 elsif ( $storage_method eq 'Pg' ) {
1723 $session = new CGI::Session( "driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, { Handle => $dbh } );
1725 elsif ( $storage_method eq 'memcached' && C4::Context->ismemcached ) {
1726 $session = new CGI::Session( "driver:memcached;serializer:yaml;id:md5", $sessionID, { Memcached => C4::Context->memcached } );
1729 # catch all defaults to tmp should work on all systems
1730 my $dir = File::Spec->tmpdir;
1731 my $instance = C4::Context->config( 'database' ); #actually for packages not exactly the instance name, but generally safer to leave it as it is
1732 $session = new CGI::Session( "driver:File;serializer:yaml;id:md5", $sessionID, { Directory => "$dir/cgisess_$instance" } );
1738 my ( $dbh, $userid, $password, $query, $type ) = @_;
1739 $type = 'opac' unless $type;
1741 $debug and print STDERR "## checkpw - checking LDAP\n";
1742 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
1743 return 0 if $retval == -1; # Incorrect password for LDAP login attempt
1744 ($retval) and return ( $retval, $retcard, $retuserid );
1747 if ( $cas && $query && $query->param('ticket') ) {
1748 $debug and print STDERR "## checkpw - checking CAS\n";
1750 # In case of a CAS authentication, we use the ticket instead of the password
1751 my $ticket = $query->param('ticket');
1752 $query->delete('ticket'); # remove ticket to come back to original URL
1753 my ( $retval, $retcard, $retuserid ) = checkpw_cas( $dbh, $ticket, $query, $type ); # EXTERNAL AUTH
1754 ($retval) and return ( $retval, $retcard, $retuserid );
1758 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1759 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1761 if ( $shib && $shib_login && !$password ) {
1763 $debug and print STDERR "## checkpw - checking Shibboleth\n";
1765 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1766 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1767 # shibboleth-authenticated user
1769 # Then, we check if it matches a valid koha user
1771 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
1772 ($retval) and return ( $retval, $retcard, $retuserid );
1778 return checkpw_internal(@_)
1781 sub checkpw_internal {
1782 my ( $dbh, $userid, $password ) = @_;
1784 $password = Encode::encode( 'UTF-8', $password )
1785 if Encode::is_utf8($password);
1787 if ( $userid && $userid eq C4::Context->config('user') ) {
1788 if ( $password && $password eq C4::Context->config('pass') ) {
1790 # Koha superuser account
1791 # C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1801 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1803 $sth->execute($userid);
1805 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1806 $surname, $branchcode, $branchname, $flags )
1809 if ( checkpw_hash( $password, $stored_hash ) ) {
1811 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1812 $firstname, $surname, $branchcode, $branchname, $flags );
1813 return 1, $cardnumber, $userid;
1818 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1820 $sth->execute($userid);
1822 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1823 $surname, $branchcode, $branchname, $flags )
1826 if ( checkpw_hash( $password, $stored_hash ) ) {
1828 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1829 $firstname, $surname, $branchcode, $branchname, $flags );
1830 return 1, $cardnumber, $userid;
1833 if ( $userid && $userid eq 'demo'
1834 && "$password" eq 'demo'
1835 && C4::Context->config('demo') )
1838 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1839 # some features won't be effective : modify systempref, modify MARC structure,
1846 my ( $password, $stored_hash ) = @_;
1848 return if $stored_hash eq '!';
1850 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1852 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1853 $hash = hash_password( $password, $stored_hash );
1855 $hash = md5_base64($password);
1857 return $hash eq $stored_hash;
1862 my $authflags = getuserflags($flags, $userid, [$dbh]);
1864 Translates integer flags into permissions strings hash.
1866 C<$flags> is the integer userflags value ( borrowers.userflags )
1867 C<$userid> is the members.userid, used for building subpermissions
1868 C<$authflags> is a hashref of permissions
1875 my $dbh = @_ ? shift : C4::Context->dbh;
1878 # I don't want to do this, but if someone logs in as the database
1879 # user, it would be preferable not to spam them to death with
1880 # numeric warnings. So, we make $flags numeric.
1881 no warnings 'numeric';
1884 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1887 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1888 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1889 $userflags->{$flag} = 1;
1892 $userflags->{$flag} = 0;
1896 # get subpermissions and merge with top-level permissions
1897 my $user_subperms = get_user_subpermissions($userid);
1898 foreach my $module ( keys %$user_subperms ) {
1899 next if $userflags->{$module} == 1; # user already has permission for everything in this module
1900 $userflags->{$module} = $user_subperms->{$module};
1906 =head2 get_user_subpermissions
1908 $user_perm_hashref = get_user_subpermissions($userid);
1910 Given the userid (note, not the borrowernumber) of a staff user,
1911 return a hashref of hashrefs of the specific subpermissions
1912 accorded to the user. An example return is
1916 export_catalog => 1,
1917 import_patrons => 1,
1921 The top-level hash-key is a module or function code from
1922 userflags.flag, while the second-level key is a code
1925 The results of this function do not give a complete picture
1926 of the functions that a staff user can access; it is also
1927 necessary to check borrowers.flags.
1931 sub get_user_subpermissions {
1934 my $dbh = C4::Context->dbh;
1935 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
1936 FROM user_permissions
1937 JOIN permissions USING (module_bit, code)
1938 JOIN userflags ON (module_bit = bit)
1939 JOIN borrowers USING (borrowernumber)
1940 WHERE userid = ?" );
1941 $sth->execute($userid);
1943 my $user_perms = {};
1944 while ( my $perm = $sth->fetchrow_hashref ) {
1945 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1950 =head2 get_all_subpermissions
1952 my $perm_hashref = get_all_subpermissions();
1954 Returns a hashref of hashrefs defining all specific
1955 permissions currently defined. The return value
1956 has the same structure as that of C<get_user_subpermissions>,
1957 except that the innermost hash value is the description
1958 of the subpermission.
1962 sub get_all_subpermissions {
1963 my $dbh = C4::Context->dbh;
1964 my $sth = $dbh->prepare( "SELECT flag, code
1966 JOIN userflags ON (module_bit = bit)" );
1970 while ( my $perm = $sth->fetchrow_hashref ) {
1971 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1976 =head2 haspermission
1978 $flags = ($userid, $flagsrequired);
1980 C<$userid> the userid of the member
1981 C<$flags> is a hashref of required flags like C<$borrower-<{authflags}>
1983 Returns member's flags or 0 if a permission is not met.
1988 my ( $userid, $flagsrequired ) = @_;
1989 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1990 $sth->execute($userid);
1991 my $row = $sth->fetchrow();
1992 my $flags = getuserflags( $row, $userid );
1993 if ( $userid eq C4::Context->config('user') ) {
1995 # Super User Account from /etc/koha.conf
1996 $flags->{'superlibrarian'} = 1;
1998 elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
2000 # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
2001 $flags->{'superlibrarian'} = 1;
2004 return $flags if $flags->{superlibrarian};
2006 foreach my $module ( keys %$flagsrequired ) {
2007 my $subperm = $flagsrequired->{$module};
2008 if ( $subperm eq '*' ) {
2009 return 0 unless ( $flags->{$module} == 1 or ref( $flags->{$module} ) );
2012 ( defined $flags->{$module} and
2013 $flags->{$module} == 1 )
2015 ( ref( $flags->{$module} ) and
2016 exists $flags->{$module}->{$subperm} and
2017 $flags->{$module}->{$subperm} == 1 )
2023 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2026 sub getborrowernumber {
2028 my $userenv = C4::Context->userenv;
2029 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2030 return $userenv->{number};
2032 my $dbh = C4::Context->dbh;
2033 for my $field ( 'userid', 'cardnumber' ) {
2035 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2036 $sth->execute($userid);
2038 my ($bnumber) = $sth->fetchrow;
2045 END { } # module clean-up code here (global destructor)
2055 Crypt::Eksblowfish::Bcrypt(3)