Bug 12176: Remove HTML from additem.pl
[koha.git] / C4 / Auth.pm
blob544bf7ec9c063ea96d8d8a4412ea346d3c1d6788
1 package C4::Auth;
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>.
20 use strict;
21 use warnings;
22 use Digest::MD5 qw(md5_base64);
23 use JSON qw/encode_json/;
24 use URI::Escape;
25 use CGI::Session;
27 require Exporter;
28 use C4::Context;
29 use C4::Templates; # to get the template
30 use C4::Languages;
31 use C4::Branch; # GetBranches
32 use C4::Search::History;
33 use Koha;
34 use Koha::AuthUtils qw(hash_password);
35 use POSIX qw/strftime/;
36 use List::MoreUtils qw/ any /;
37 use Encode qw( encode is_utf8);
39 # use utf8;
40 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout $shib $shib_login);
42 BEGIN {
43 sub psgi_env { any { /^psgi\./ } keys %ENV }
45 sub safe_exit {
46 if (psgi_env) { die 'psgi:exit' }
47 else { exit }
49 $VERSION = 3.07.00.049; # set version for version checking
51 $debug = $ENV{DEBUG};
52 @ISA = qw(Exporter);
53 @EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
54 @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash
55 &get_all_subpermissions &get_user_subpermissions
57 %EXPORT_TAGS = ( EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)] );
58 $ldap = C4::Context->config('useldapserver') || 0;
59 $cas = C4::Context->preference('casAuthentication');
60 $shib = C4::Context->config('useshibboleth') || 0;
61 $caslogout = C4::Context->preference('casLogout');
62 require C4::Auth_with_cas; # no import
64 if ($ldap) {
65 require C4::Auth_with_ldap;
66 import C4::Auth_with_ldap qw(checkpw_ldap);
68 if ($shib) {
69 require C4::Auth_with_shibboleth;
70 import C4::Auth_with_shibboleth
71 qw(shib_ok checkpw_shib logout_shib login_shib_url get_login_shib);
73 # Check for good config
74 if ( shib_ok() ) {
76 # Get shibboleth login attribute
77 $shib_login = get_login_shib();
80 # Bad config, disable shibboleth
81 else {
82 $shib = 0;
85 if ($cas) {
86 import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url);
91 =head1 NAME
93 C4::Auth - Authenticates Koha users
95 =head1 SYNOPSIS
97 use CGI qw ( -utf8 );
98 use C4::Auth;
99 use C4::Output;
101 my $query = new CGI;
103 my ($template, $borrowernumber, $cookie)
104 = get_template_and_user(
106 template_name => "opac-main.tt",
107 query => $query,
108 type => "opac",
109 authnotrequired => 0,
110 flagsrequired => {borrow => 1, catalogue => '*', tools => 'import_patrons' },
114 output_html_with_http_headers $query, $cookie, $template->output;
116 =head1 DESCRIPTION
118 The main function of this module is to provide
119 authentification. However the get_template_and_user function has
120 been provided so that a users login information is passed along
121 automatically. This gets loaded into the template.
123 =head1 FUNCTIONS
125 =head2 get_template_and_user
127 my ($template, $borrowernumber, $cookie)
128 = get_template_and_user(
130 template_name => "opac-main.tt",
131 query => $query,
132 type => "opac",
133 authnotrequired => 0,
134 flagsrequired => {borrow => 1, catalogue => '*', tools => 'import_patrons' },
138 This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
139 to C<&checkauth> (in this module) to perform authentification.
140 See C<&checkauth> for an explanation of these parameters.
142 The C<template_name> is then used to find the correct template for
143 the page. The authenticated users details are loaded onto the
144 template in the HTML::Template LOOP variable C<USER_INFO>. Also the
145 C<sessionID> is passed to the template. This can be used in templates
146 if cookies are disabled. It needs to be put as and input to every
147 authenticated page.
149 More information on the C<gettemplate> sub can be found in the
150 Output.pm module.
152 =cut
154 sub get_template_and_user {
156 my $in = shift;
157 my ( $user, $cookie, $sessionID, $flags );
159 C4::Context->interface( $in->{type} );
161 $in->{'authnotrequired'} ||= 0;
162 my $template = C4::Templates::gettemplate(
163 $in->{'template_name'},
164 $in->{'type'},
165 $in->{'query'},
166 $in->{'is_plugin'}
169 if ( $in->{'template_name'} !~ m/maintenance/ ) {
170 ( $user, $cookie, $sessionID, $flags ) = checkauth(
171 $in->{'query'},
172 $in->{'authnotrequired'},
173 $in->{'flagsrequired'},
174 $in->{'type'}
178 my $borrowernumber;
179 if ($user) {
180 require C4::Members;
182 # It's possible for $user to be the borrowernumber if they don't have a
183 # userid defined (and are logging in through some other method, such
184 # as SSL certs against an email address)
185 $borrowernumber = getborrowernumber($user) if defined($user);
186 if ( !defined($borrowernumber) && defined($user) ) {
187 my $borrower = C4::Members::GetMember( borrowernumber => $user );
188 if ($borrower) {
189 $borrowernumber = $user;
191 # A bit of a hack, but I don't know there's a nicer way
192 # to do it.
193 $user = $borrower->{firstname} . ' ' . $borrower->{surname};
197 # user info
198 $template->param( loggedinusername => $user );
199 $template->param( loggedinusernumber => $borrowernumber );
200 $template->param( sessionID => $sessionID );
202 if ( $in->{'type'} eq 'opac' ) {
203 require C4::VirtualShelves;
204 my ( $total, $pubshelves, $barshelves ) = C4::VirtualShelves::GetSomeShelfNames( $borrowernumber, 'MASTHEAD' );
205 $template->param(
206 pubshelves => $total->{pubtotal},
207 pubshelvesloop => $pubshelves,
208 barshelves => $total->{bartotal},
209 barshelvesloop => $barshelves,
213 my ($borr) = C4::Members::GetMemberDetails($borrowernumber);
214 my @bordat;
215 $bordat[0] = $borr;
216 $template->param( "USER_INFO" => \@bordat );
218 my $all_perms = get_all_subpermissions();
220 my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
221 editcatalogue updatecharges management tools editauthorities serials reports acquisition);
223 # We are going to use the $flags returned by checkauth
224 # to create the template's parameters that will indicate
225 # which menus the user can access.
226 if ( $flags && $flags->{superlibrarian} == 1 ) {
227 $template->param( CAN_user_circulate => 1 );
228 $template->param( CAN_user_catalogue => 1 );
229 $template->param( CAN_user_parameters => 1 );
230 $template->param( CAN_user_borrowers => 1 );
231 $template->param( CAN_user_permissions => 1 );
232 $template->param( CAN_user_reserveforothers => 1 );
233 $template->param( CAN_user_borrow => 1 );
234 $template->param( CAN_user_editcatalogue => 1 );
235 $template->param( CAN_user_updatecharges => 1 );
236 $template->param( CAN_user_acquisition => 1 );
237 $template->param( CAN_user_management => 1 );
238 $template->param( CAN_user_tools => 1 );
239 $template->param( CAN_user_editauthorities => 1 );
240 $template->param( CAN_user_serials => 1 );
241 $template->param( CAN_user_reports => 1 );
242 $template->param( CAN_user_staffaccess => 1 );
243 $template->param( CAN_user_plugins => 1 );
244 $template->param( CAN_user_coursereserves => 1 );
245 foreach my $module ( keys %$all_perms ) {
247 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
248 $template->param( "CAN_user_${module}_${subperm}" => 1 );
253 if ($flags) {
254 foreach my $module ( keys %$all_perms ) {
255 if ( $flags->{$module} == 1 ) {
256 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
257 $template->param( "CAN_user_${module}_${subperm}" => 1 );
259 } elsif ( ref( $flags->{$module} ) ) {
260 foreach my $subperm ( keys %{ $flags->{$module} } ) {
261 $template->param( "CAN_user_${module}_${subperm}" => 1 );
267 if ($flags) {
268 foreach my $module ( keys %$flags ) {
269 if ( $flags->{$module} == 1 or ref( $flags->{$module} ) ) {
270 $template->param( "CAN_user_$module" => 1 );
271 if ( $module eq "parameters" ) {
272 $template->param( CAN_user_management => 1 );
278 # Logged-in opac search history
279 # If the requested template is an opac one and opac search history is enabled
280 if ( $in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory') ) {
281 my $dbh = C4::Context->dbh;
282 my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
283 my $sth = $dbh->prepare($query);
284 $sth->execute($borrowernumber);
286 # If at least one search has already been performed
287 if ( $sth->fetchrow_array > 0 ) {
289 # We show the link in opac
290 $template->param( EnableOpacSearchHistory => 1 );
293 # And if there are searches performed when the user was not logged in,
294 # we add them to the logged-in search history
295 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
296 if (@recentSearches) {
297 my $dbh = C4::Context->dbh;
298 my $query = q{
299 INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, type, total, time )
300 VALUES (?, ?, ?, ?, ?, ?, ?)
303 my $sth = $dbh->prepare($query);
304 $sth->execute( $borrowernumber,
305 $in->{query}->cookie("CGISESSID"),
306 $_->{query_desc},
307 $_->{query_cgi},
308 $_->{type} || 'biblio',
309 $_->{total},
310 $_->{time},
311 ) foreach @recentSearches;
313 # clear out the search history from the session now that
314 # we've saved it to the database
315 C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } );
317 } elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) {
318 $template->param( EnableSearchHistory => 1 );
321 else { # if this is an anonymous session, setup to display public lists...
323 # If shibboleth is enabled, and we're in an anonymous session, we should allow
324 # the user to attemp login via shibboleth.
325 if ($shib) {
326 $template->param( shibbolethAuthentication => $shib,
327 shibbolethLoginUrl => login_shib_url( $in->{'query'} ),
330 # If shibboleth is enabled and we have a shibboleth login attribute,
331 # but we are in an anonymous session, then we clearly have an invalid
332 # shibboleth koha account.
333 if ($shib_login) {
334 $template->param( invalidShibLogin => '1' );
338 $template->param( sessionID => $sessionID );
340 if ( $in->{'type'} eq 'opac' ){
341 require C4::VirtualShelves;
342 my ( $total, $pubshelves ) = C4::VirtualShelves::GetSomeShelfNames( undef, 'MASTHEAD' );
343 $template->param(
344 pubshelves => $total->{pubtotal},
345 pubshelvesloop => $pubshelves,
350 # Anonymous opac search history
351 # If opac search history is enabled and at least one search has already been performed
352 if ( C4::Context->preference('EnableOpacSearchHistory') ) {
353 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
354 if (@recentSearches) {
355 $template->param( EnableOpacSearchHistory => 1 );
359 if ( C4::Context->preference('dateformat') ) {
360 $template->param( dateformat => C4::Context->preference('dateformat') );
363 # these template parameters are set the same regardless of $in->{'type'}
365 # Set the using_https variable for templates
366 # FIXME Under Plack the CGI->https method always returns 'OFF'
367 my $https = $in->{query}->https();
368 my $using_https = ( defined $https and $https ne 'OFF' ) ? 1 : 0;
370 $template->param(
371 "BiblioDefaultView" . C4::Context->preference("BiblioDefaultView") => 1,
372 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
373 GoogleJackets => C4::Context->preference("GoogleJackets"),
374 OpenLibraryCovers => C4::Context->preference("OpenLibraryCovers"),
375 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
376 LoginBranchcode => ( C4::Context->userenv ? C4::Context->userenv->{"branch"} : undef ),
377 LoginFirstname => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
378 LoginSurname => C4::Context->userenv ? C4::Context->userenv->{"surname"} : "Inconnu",
379 emailaddress => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
380 loggedinpersona => C4::Context->userenv ? C4::Context->userenv->{"persona"} : undef,
381 TagsEnabled => C4::Context->preference("TagsEnabled"),
382 hide_marc => C4::Context->preference("hide_marc"),
383 item_level_itypes => C4::Context->preference('item-level_itypes'),
384 patronimages => C4::Context->preference("patronimages"),
385 singleBranchMode => C4::Context->preference("singleBranchMode"),
386 XSLTDetailsDisplay => C4::Context->preference("XSLTDetailsDisplay"),
387 XSLTResultsDisplay => C4::Context->preference("XSLTResultsDisplay"),
388 using_https => $using_https,
389 noItemTypeImages => C4::Context->preference("noItemTypeImages"),
390 marcflavour => C4::Context->preference("marcflavour"),
391 persona => C4::Context->preference("persona"),
393 if ( $in->{'type'} eq "intranet" ) {
394 $template->param(
395 AmazonCoverImages => C4::Context->preference("AmazonCoverImages"),
396 AutoLocation => C4::Context->preference("AutoLocation"),
397 "BiblioDefaultView" . C4::Context->preference("IntranetBiblioDefaultView") => 1,
398 CalendarFirstDayOfWeek => ( C4::Context->preference("CalendarFirstDayOfWeek") eq "Sunday" ) ? 0 : 1,
399 CircAutocompl => C4::Context->preference("CircAutocompl"),
400 FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
401 IndependentBranches => C4::Context->preference("IndependentBranches"),
402 IntranetNav => C4::Context->preference("IntranetNav"),
403 IntranetmainUserblock => C4::Context->preference("IntranetmainUserblock"),
404 LibraryName => C4::Context->preference("LibraryName"),
405 LoginBranchname => ( C4::Context->userenv ? C4::Context->userenv->{"branchname"} : undef ),
406 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
407 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
408 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
409 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
410 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
411 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
412 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
413 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
414 intranetbookbag => C4::Context->preference("intranetbookbag"),
415 suggestion => C4::Context->preference("suggestion"),
416 virtualshelves => C4::Context->preference("virtualshelves"),
417 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
418 EasyAnalyticalRecords => C4::Context->preference('EasyAnalyticalRecords'),
419 LocalCoverImages => C4::Context->preference('LocalCoverImages'),
420 OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'),
421 AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'),
422 EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'),
423 UseKohaPlugins => C4::Context->preference('UseKohaPlugins'),
424 UseCourseReserves => C4::Context->preference("UseCourseReserves"),
425 useDischarge => C4::Context->preference('useDischarge'),
428 else {
429 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
431 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
432 my $LibraryNameTitle = C4::Context->preference("LibraryName");
433 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
434 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
436 # clean up the busc param in the session if the page is not opac-detail and not the "add to list" page
437 if ( C4::Context->preference("OpacBrowseResults")
438 && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
439 my $pagename = $1;
440 unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
441 or $pagename =~ /^addbybiblionumber$/ ) {
442 my $sessionSearch = get_session( $sessionID || $in->{'query'}->cookie("CGISESSID") );
443 $sessionSearch->clear( ["busc"] ) if ( $sessionSearch->param("busc") );
447 # variables passed from CGI: opac_css_override and opac_search_limits.
448 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
449 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
450 my $opac_name = '';
451 if (
452 ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:(\w+)/ ) ||
453 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:(\w+)/ ) ||
454 ( $in->{'query'}->param('multibranchlimit') && $in->{'query'}->param('multibranchlimit') =~ /multibranchlimit-(\w+)/ )
456 $opac_name = $1; # opac_search_limit is a branch, so we use it.
457 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
458 $opac_name = $in->{'query'}->param('multibranchlimit');
459 } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
460 $opac_name = C4::Context->userenv->{'branch'};
463 # FIXME Under Plack the CGI->https method always returns 'OFF' ($using_https will be set to 0 in this case)
464 my $opac_base_url = C4::Context->preference("OPACBaseURL"); #FIXME uses $using_https below as well
465 if ( !$opac_base_url ) {
466 $opac_base_url = $ENV{'SERVER_NAME'} . ( $ENV{'SERVER_PORT'} eq ( $using_https ? "443" : "80" ) ? '' : ":$ENV{'SERVER_PORT'}" );
468 $template->param(
469 OpacAdditionalStylesheet => C4::Context->preference("OpacAdditionalStylesheet"),
470 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
471 AuthorisedValueImages => C4::Context->preference("AuthorisedValueImages"),
472 BranchesLoop => GetBranchesLoop($opac_name),
473 BranchCategoriesLoop => GetBranchCategories( 'searchdomain', 1, $opac_name ),
474 CalendarFirstDayOfWeek => ( C4::Context->preference("CalendarFirstDayOfWeek") eq "Sunday" ) ? 0 : 1,
475 LibraryName => "" . C4::Context->preference("LibraryName"),
476 LibraryNameTitle => "" . $LibraryNameTitle,
477 LoginBranchname => C4::Context->userenv ? C4::Context->userenv->{"branchname"} : "",
478 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
479 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
480 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
481 OPACShelfBrowser => "" . C4::Context->preference("OPACShelfBrowser"),
482 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
483 OPACUserCSS => "" . C4::Context->preference("OPACUserCSS"),
484 OPACViewOthersSuggestions => "" . C4::Context->preference("OPACViewOthersSuggestions"),
485 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
486 OPACBaseURL => ( $using_https ? "https://" : "http://" ) . $opac_base_url,
487 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
488 opac_search_limit => $opac_search_limit,
489 opac_limit_override => $opac_limit_override,
490 OpacBrowser => C4::Context->preference("OpacBrowser"),
491 OpacCloud => C4::Context->preference("OpacCloud"),
492 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
493 OpacMainUserBlock => "" . C4::Context->preference("OpacMainUserBlock"),
494 OpacNav => "" . C4::Context->preference("OpacNav"),
495 OpacNavRight => "" . C4::Context->preference("OpacNavRight"),
496 OpacNavBottom => "" . C4::Context->preference("OpacNavBottom"),
497 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
498 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
499 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
500 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
501 OpacTopissue => C4::Context->preference("OpacTopissue"),
502 RequestOnOpac => C4::Context->preference("RequestOnOpac"),
503 'Version' => C4::Context->preference('Version'),
504 hidelostitems => C4::Context->preference("hidelostitems"),
505 mylibraryfirst => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
506 opaclayoutstylesheet => "" . C4::Context->preference("opaclayoutstylesheet"),
507 opacbookbag => "" . C4::Context->preference("opacbookbag"),
508 opaccredits => "" . C4::Context->preference("opaccredits"),
509 OpacFavicon => C4::Context->preference("OpacFavicon"),
510 opacheader => "" . C4::Context->preference("opacheader"),
511 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
512 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
513 OPACUserJS => C4::Context->preference("OPACUserJS"),
514 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
515 ShowReviewer => C4::Context->preference("ShowReviewer"),
516 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
517 suggestion => "" . C4::Context->preference("suggestion"),
518 virtualshelves => "" . C4::Context->preference("virtualshelves"),
519 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
520 OPACXSLTDetailsDisplay => C4::Context->preference("OPACXSLTDetailsDisplay"),
521 OPACXSLTResultsDisplay => C4::Context->preference("OPACXSLTResultsDisplay"),
522 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
523 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
524 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
525 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
526 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
527 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
528 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
529 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
530 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
531 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
532 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
533 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
534 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
535 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
536 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
537 useDischarge => C4::Context->preference('useDischarge'),
540 $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
543 # Check if we were asked using parameters to force a specific language
544 if ( defined $in->{'query'}->param('language') ) {
546 # Extract the language, let C4::Languages::getlanguage choose
547 # what to do
548 my $language = C4::Languages::getlanguage( $in->{'query'} );
549 my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
550 if ( ref $cookie eq 'ARRAY' ) {
551 push @{$cookie}, $languagecookie;
552 } else {
553 $cookie = [ $cookie, $languagecookie ];
557 return ( $template, $borrowernumber, $cookie, $flags );
560 =head2 checkauth
562 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
564 Verifies that the user is authorized to run this script. If
565 the user is authorized, a (userid, cookie, session-id, flags)
566 quadruple is returned. If the user is not authorized but does
567 not have the required privilege (see $flagsrequired below), it
568 displays an error page and exits. Otherwise, it displays the
569 login page and exits.
571 Note that C<&checkauth> will return if and only if the user
572 is authorized, so it should be called early on, before any
573 unfinished operations (e.g., if you've opened a file, then
574 C<&checkauth> won't close it for you).
576 C<$query> is the CGI object for the script calling C<&checkauth>.
578 The C<$noauth> argument is optional. If it is set, then no
579 authorization is required for the script.
581 C<&checkauth> fetches user and session information from C<$query> and
582 ensures that the user is authorized to run scripts that require
583 authorization.
585 The C<$flagsrequired> argument specifies the required privileges
586 the user must have if the username and password are correct.
587 It should be specified as a reference-to-hash; keys in the hash
588 should be the "flags" for the user, as specified in the Members
589 intranet module. Any key specified must correspond to a "flag"
590 in the userflags table. E.g., { circulate => 1 } would specify
591 that the user must have the "circulate" privilege in order to
592 proceed. To make sure that access control is correct, the
593 C<$flagsrequired> parameter must be specified correctly.
595 Koha also has a concept of sub-permissions, also known as
596 granular permissions. This makes the value of each key
597 in the C<flagsrequired> hash take on an additional
598 meaning, i.e.,
602 The user must have access to all subfunctions of the module
603 specified by the hash key.
607 The user must have access to at least one subfunction of the module
608 specified by the hash key.
610 specific permission, e.g., 'export_catalog'
612 The user must have access to the specific subfunction list, which
613 must correspond to a row in the permissions table.
615 The C<$type> argument specifies whether the template should be
616 retrieved from the opac or intranet directory tree. "opac" is
617 assumed if it is not specified; however, if C<$type> is specified,
618 "intranet" is assumed if it is not "opac".
620 If C<$query> does not have a valid session ID associated with it
621 (i.e., the user has not logged in) or if the session has expired,
622 C<&checkauth> presents the user with a login page (from the point of
623 view of the original script, C<&checkauth> does not return). Once the
624 user has authenticated, C<&checkauth> restarts the original script
625 (this time, C<&checkauth> returns).
627 The login page is provided using a HTML::Template, which is set in the
628 systempreferences table or at the top of this file. The variable C<$type>
629 selects which template to use, either the opac or the intranet
630 authentification template.
632 C<&checkauth> returns a user ID, a cookie, and a session ID. The
633 cookie should be sent back to the browser; it verifies that the user
634 has authenticated.
636 =cut
638 sub _version_check {
639 my $type = shift;
640 my $query = shift;
641 my $version;
643 # If Version syspref is unavailable, it means Koha is beeing installed,
644 # and so we must redirect to OPAC maintenance page or to the WebInstaller
645 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
646 if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
647 warn "OPAC Install required, redirecting to maintenance";
648 print $query->redirect("/cgi-bin/koha/maintenance.pl");
649 safe_exit;
651 unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
652 if ( $type ne 'opac' ) {
653 warn "Install required, redirecting to Installer";
654 print $query->redirect("/cgi-bin/koha/installer/install.pl");
655 } else {
656 warn "OPAC Install required, redirecting to maintenance";
657 print $query->redirect("/cgi-bin/koha/maintenance.pl");
659 safe_exit;
662 # check that database and koha version are the same
663 # there is no DB version, it's a fresh install,
664 # go to web installer
665 # there is a DB version, compare it to the code version
666 my $kohaversion = Koha::version();
668 # remove the 3 last . to have a Perl number
669 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
670 $debug and print STDERR "kohaversion : $kohaversion\n";
671 if ( $version < $kohaversion ) {
672 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
673 if ( $type ne 'opac' ) {
674 warn sprintf( $warning, 'Installer' );
675 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
676 } else {
677 warn sprintf( "OPAC: " . $warning, 'maintenance' );
678 print $query->redirect("/cgi-bin/koha/maintenance.pl");
680 safe_exit;
684 sub _session_log {
685 (@_) or return 0;
686 open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
687 printf $fh join( "\n", @_ );
688 close $fh;
691 sub _timeout_syspref {
692 my $timeout = C4::Context->preference('timeout') || 600;
694 # value in days, convert in seconds
695 if ( $timeout =~ /(\d+)[dD]/ ) {
696 $timeout = $1 * 86400;
698 return $timeout;
701 sub checkauth {
702 my $query = shift;
703 $debug and warn "Checking Auth";
705 # $authnotrequired will be set for scripts which will run without authentication
706 my $authnotrequired = shift;
707 my $flagsrequired = shift;
708 my $type = shift;
709 my $persona = shift;
710 $type = 'opac' unless $type;
712 my $dbh = C4::Context->dbh;
713 my $timeout = _timeout_syspref();
715 _version_check( $type, $query );
717 # state variables
718 my $loggedin = 0;
719 my %info;
720 my ( $userid, $cookie, $sessionID, $flags, $barshelves, $pubshelves );
721 my $logout = $query->param('logout.x');
723 my $anon_search_history;
725 # This parameter is the name of the CAS server we want to authenticate against,
726 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
727 my $casparam = $query->param('cas');
728 my $q_userid = $query->param('userid') // '';
730 # Basic authentication is incompatible with the use of Shibboleth,
731 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
732 # and it may not be the attribute we want to use to match the koha login.
734 # Also, do not consider an empty REMOTE_USER.
736 # Finally, after those tests, we can assume (although if it would be better with
737 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
738 # and we can affect it to $userid.
739 if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
741 # Using Basic Authentication, no cookies required
742 $cookie = $query->cookie(
743 -name => 'CGISESSID',
744 -value => '',
745 -expires => '',
746 -HttpOnly => 1,
748 $loggedin = 1;
750 elsif ($persona) {
752 # we dont want to set a session because we are being called by a persona callback
754 elsif ( $sessionID = $query->cookie("CGISESSID") )
755 { # assignment, not comparison
756 my $session = get_session($sessionID);
757 C4::Context->_new_userenv($sessionID);
758 my ( $ip, $lasttime, $sessiontype );
759 my $s_userid = '';
760 if ($session) {
761 $s_userid = $session->param('id') // '';
762 C4::Context->set_userenv(
763 $session->param('number'), $s_userid,
764 $session->param('cardnumber'), $session->param('firstname'),
765 $session->param('surname'), $session->param('branch'),
766 $session->param('branchname'), $session->param('flags'),
767 $session->param('emailaddress'), $session->param('branchprinter'),
768 $session->param('persona'), $session->param('shibboleth')
770 C4::Context::set_shelves_userenv( 'bar', $session->param('barshelves') );
771 C4::Context::set_shelves_userenv( 'pub', $session->param('pubshelves') );
772 C4::Context::set_shelves_userenv( 'tot', $session->param('totshelves') );
773 $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
774 $ip = $session->param('ip');
775 $lasttime = $session->param('lasttime');
776 $userid = $s_userid;
777 $sessiontype = $session->param('sessiontype') || '';
779 if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
780 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} ) || ( $shib && $shib_login && !$logout ) ) {
782 #if a user enters an id ne to the id in the current session, we need to log them in...
783 #first we need to clear the anonymous session...
784 $debug and warn "query id = $q_userid but session id = $s_userid";
785 $anon_search_history = $session->param('search_history');
786 $session->delete();
787 $session->flush;
788 C4::Context->_unset_userenv($sessionID);
789 $sessionID = undef;
790 $userid = undef;
792 elsif ($logout) {
794 # voluntary logout the user
795 # check wether the user was using their shibboleth session or a local one
796 my $shibSuccess = C4::Context->userenv->{'shibboleth'};
797 $session->delete();
798 $session->flush;
799 C4::Context->_unset_userenv($sessionID);
801 #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
802 $sessionID = undef;
803 $userid = undef;
805 if ($cas and $caslogout) {
806 logout_cas($query, $type);
809 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
810 if ( $shib and $shib_login and $shibSuccess and $type eq 'opac' ) {
812 # (Note: $type eq 'opac' condition should be removed when shibboleth authentication for intranet will be implemented)
813 logout_shib($query);
816 elsif ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
818 # timed logout
819 $info{'timed_out'} = 1;
820 if ($session) {
821 $session->delete();
822 $session->flush;
824 C4::Context->_unset_userenv($sessionID);
826 #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
827 $userid = undef;
828 $sessionID = undef;
830 elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
832 # Different ip than originally logged in from
833 $info{'oldip'} = $ip;
834 $info{'newip'} = $ENV{'REMOTE_ADDR'};
835 $info{'different_ip'} = 1;
836 $session->delete();
837 $session->flush;
838 C4::Context->_unset_userenv($sessionID);
840 #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
841 $sessionID = undef;
842 $userid = undef;
844 else {
845 $cookie = $query->cookie(
846 -name => 'CGISESSID',
847 -value => $session->id,
848 -HttpOnly => 1
850 $session->param( 'lasttime', time() );
851 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...
852 $flags = haspermission( $userid, $flagsrequired );
853 if ($flags) {
854 $loggedin = 1;
855 } else {
856 $info{'nopermission'} = 1;
861 unless ( $userid || $sessionID ) {
863 #we initiate a session prior to checking for a username to allow for anonymous sessions...
864 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
866 # Save anonymous search history in new session so it can be retrieved
867 # by get_template_and_user to store it in user's search history after
868 # a successful login.
869 if ($anon_search_history) {
870 $session->param( 'search_history', $anon_search_history );
873 my $sessionID = $session->id;
874 C4::Context->_new_userenv($sessionID);
875 $cookie = $query->cookie(
876 -name => 'CGISESSID',
877 -value => $session->id,
878 -HttpOnly => 1
880 $userid = $q_userid;
881 my $pki_field = C4::Context->preference('AllowPKIAuth');
882 if ( !defined($pki_field) ) {
883 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
884 $pki_field = 'None';
886 if ( ( $cas && $query->param('ticket') )
887 || $userid
888 || ( $shib && $shib_login )
889 || $pki_field ne 'None'
890 || $persona )
892 my $password = $query->param('password');
893 my $shibSuccess = 0;
895 my ( $return, $cardnumber );
897 # If shib is enabled and we have a shib login, does the login match a valid koha user
898 if ( $shib && $shib_login && $type eq 'opac' ) {
899 my $retuserid;
901 # Do not pass password here, else shib will not be checked in checkpw.
902 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $userid, undef, $query );
903 $userid = $retuserid;
904 $shibSuccess = $return;
905 $info{'invalidShibLogin'} = 1 unless ($return);
908 # If shib login and match were successfull, skip further login methods
909 unless ($shibSuccess) {
910 if ( $cas && $query->param('ticket') ) {
911 my $retuserid;
912 ( $return, $cardnumber, $retuserid ) =
913 checkpw( $dbh, $userid, $password, $query, $type );
914 $userid = $retuserid;
915 $info{'invalidCasLogin'} = 1 unless ($return);
918 elsif ($persona) {
919 my $value = $persona;
921 # If we're looking up the email, there's a chance that the person
922 # doesn't have a userid. So if there is none, we pass along the
923 # borrower number, and the bits of code that need to know the user
924 # ID will have to be smart enough to handle that.
925 require C4::Members;
926 my @users_info = C4::Members::GetBorrowersWithEmail($value);
927 if (@users_info) {
929 # First the userid, then the borrowernum
930 $value = $users_info[0][1] || $users_info[0][0];
932 else {
933 undef $value;
935 $return = $value ? 1 : 0;
936 $userid = $value;
939 elsif (
940 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
941 || ( $pki_field eq 'emailAddress'
942 && $ENV{'SSL_CLIENT_S_DN_Email'} )
945 my $value;
946 if ( $pki_field eq 'Common Name' ) {
947 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
949 elsif ( $pki_field eq 'emailAddress' ) {
950 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
952 # If we're looking up the email, there's a chance that the person
953 # doesn't have a userid. So if there is none, we pass along the
954 # borrower number, and the bits of code that need to know the user
955 # ID will have to be smart enough to handle that.
956 require C4::Members;
957 my @users_info = C4::Members::GetBorrowersWithEmail($value);
958 if (@users_info) {
960 # First the userid, then the borrowernum
961 $value = $users_info[0][1] || $users_info[0][0];
962 } else {
963 undef $value;
967 $return = $value ? 1 : 0;
968 $userid = $value;
971 else {
972 my $retuserid;
973 ( $return, $cardnumber, $retuserid ) =
974 checkpw( $dbh, $userid, $password, $query, $type );
975 $userid = $retuserid if ($retuserid);
976 $info{'invalid_username_or_password'} = 1 unless ($return);
980 # $return: 1 = valid user, 2 = superlibrarian
981 if ($return) {
983 #_session_log(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
984 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
985 $loggedin = 1;
987 else {
988 $info{'nopermission'} = 1;
989 C4::Context->_unset_userenv($sessionID);
991 my ( $borrowernumber, $firstname, $surname, $userflags,
992 $branchcode, $branchname, $branchprinter, $emailaddress );
994 if ( $return == 1 ) {
995 my $select = "
996 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
997 branches.branchname as branchname,
998 branches.branchprinter as branchprinter,
999 email
1000 FROM borrowers
1001 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1003 my $sth = $dbh->prepare("$select where userid=?");
1004 $sth->execute($userid);
1005 unless ( $sth->rows ) {
1006 $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
1007 $sth = $dbh->prepare("$select where cardnumber=?");
1008 $sth->execute($cardnumber);
1010 unless ( $sth->rows ) {
1011 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1012 $sth->execute($userid);
1013 unless ( $sth->rows ) {
1014 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1018 if ( $sth->rows ) {
1019 ( $borrowernumber, $firstname, $surname, $userflags,
1020 $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow;
1021 $debug and print STDERR "AUTH_3 results: " .
1022 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1023 } else {
1024 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1027 # launch a sequence to check if we have a ip for the branch, i
1028 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1030 my $ip = $ENV{'REMOTE_ADDR'};
1032 # if they specify at login, use that
1033 if ( $query->param('branch') ) {
1034 $branchcode = $query->param('branch');
1035 $branchname = GetBranchName($branchcode);
1037 my $branches = GetBranches();
1038 if ( C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation') ) {
1040 # we have to check they are coming from the right ip range
1041 my $domain = $branches->{$branchcode}->{'branchip'};
1042 if ( $ip !~ /^$domain/ ) {
1043 $loggedin = 0;
1044 $info{'wrongip'} = 1;
1048 my @branchesloop;
1049 foreach my $br ( keys %$branches ) {
1051 # now we work with the treatment of ip
1052 my $domain = $branches->{$br}->{'branchip'};
1053 if ( $domain && $ip =~ /^$domain/ ) {
1054 $branchcode = $branches->{$br}->{'branchcode'};
1056 # new op dev : add the branchprinter and branchname in the cookie
1057 $branchprinter = $branches->{$br}->{'branchprinter'};
1058 $branchname = $branches->{$br}->{'branchname'};
1061 $session->param( 'number', $borrowernumber );
1062 $session->param( 'id', $userid );
1063 $session->param( 'cardnumber', $cardnumber );
1064 $session->param( 'firstname', $firstname );
1065 $session->param( 'surname', $surname );
1066 $session->param( 'branch', $branchcode );
1067 $session->param( 'branchname', $branchname );
1068 $session->param( 'flags', $userflags );
1069 $session->param( 'emailaddress', $emailaddress );
1070 $session->param( 'ip', $session->remote_addr() );
1071 $session->param( 'lasttime', time() );
1072 $session->param( 'shibboleth', $shibSuccess );
1073 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1075 elsif ( $return == 2 ) {
1077 #We suppose the user is the superlibrarian
1078 $borrowernumber = 0;
1079 $session->param( 'number', 0 );
1080 $session->param( 'id', C4::Context->config('user') );
1081 $session->param( 'cardnumber', C4::Context->config('user') );
1082 $session->param( 'firstname', C4::Context->config('user') );
1083 $session->param( 'surname', C4::Context->config('user') );
1084 $session->param( 'branch', 'NO_LIBRARY_SET' );
1085 $session->param( 'branchname', 'NO_LIBRARY_SET' );
1086 $session->param( 'flags', 1 );
1087 $session->param( 'emailaddress', C4::Context->preference('KohaAdminEmailAddress') );
1088 $session->param( 'ip', $session->remote_addr() );
1089 $session->param( 'lasttime', time() );
1091 if ($persona) {
1092 $session->param( 'persona', 1 );
1094 C4::Context->set_userenv(
1095 $session->param('number'), $session->param('id'),
1096 $session->param('cardnumber'), $session->param('firstname'),
1097 $session->param('surname'), $session->param('branch'),
1098 $session->param('branchname'), $session->param('flags'),
1099 $session->param('emailaddress'), $session->param('branchprinter'),
1100 $session->param('persona'), $session->param('shibboleth')
1104 # $return: 0 = invalid user
1105 # reset to anonymous session
1106 else {
1107 $debug and warn "Login failed, resetting anonymous session...";
1108 if ($userid) {
1109 $info{'invalid_username_or_password'} = 1;
1110 C4::Context->_unset_userenv($sessionID);
1112 $session->param( 'lasttime', time() );
1113 $session->param( 'ip', $session->remote_addr() );
1114 $session->param( 'sessiontype', 'anon' );
1116 } # END if ( $userid = $query->param('userid') )
1117 elsif ( $type eq "opac" ) {
1119 # if we are here this is an anonymous session; add public lists to it and a few other items...
1120 # anonymous sessions are created only for the OPAC
1121 $debug and warn "Initiating an anonymous session...";
1123 # setting a couple of other session vars...
1124 $session->param( 'ip', $session->remote_addr() );
1125 $session->param( 'lasttime', time() );
1126 $session->param( 'sessiontype', 'anon' );
1128 } # END unless ($userid)
1130 # finished authentification, now respond
1131 if ( $loggedin || $authnotrequired )
1133 # successful login
1134 unless ($cookie) {
1135 $cookie = $query->cookie(
1136 -name => 'CGISESSID',
1137 -value => '',
1138 -HttpOnly => 1
1141 return ( $userid, $cookie, $sessionID, $flags );
1146 # AUTH rejected, show the login/password template, after checking the DB.
1150 # get the inputs from the incoming query
1151 my @inputs = ();
1152 foreach my $name ( param $query) {
1153 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1154 my $value = $query->param($name);
1155 push @inputs, { name => $name, value => $value };
1158 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1159 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1160 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1162 my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1163 my $template = C4::Templates::gettemplate( $template_name, $type, $query );
1164 $template->param(
1165 branchloop => GetBranchesLoop(),
1166 OpacAdditionalStylesheet => C4::Context->preference("OpacAdditionalStylesheet"),
1167 opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
1168 login => 1,
1169 INPUTS => \@inputs,
1170 casAuthentication => C4::Context->preference("casAuthentication"),
1171 shibbolethAuthentication => $shib,
1172 SessionRestrictionByIP => C4::Context->preference("SessionRestrictionByIP"),
1173 suggestion => C4::Context->preference("suggestion"),
1174 virtualshelves => C4::Context->preference("virtualshelves"),
1175 LibraryName => "" . C4::Context->preference("LibraryName"),
1176 LibraryNameTitle => "" . $LibraryNameTitle,
1177 opacuserlogin => C4::Context->preference("opacuserlogin"),
1178 OpacNav => C4::Context->preference("OpacNav"),
1179 OpacNavRight => C4::Context->preference("OpacNavRight"),
1180 OpacNavBottom => C4::Context->preference("OpacNavBottom"),
1181 opaccredits => C4::Context->preference("opaccredits"),
1182 OpacFavicon => C4::Context->preference("OpacFavicon"),
1183 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1184 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1185 OPACUserJS => C4::Context->preference("OPACUserJS"),
1186 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1187 OpacCloud => C4::Context->preference("OpacCloud"),
1188 OpacTopissue => C4::Context->preference("OpacTopissue"),
1189 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1190 OpacBrowser => C4::Context->preference("OpacBrowser"),
1191 opacheader => C4::Context->preference("opacheader"),
1192 TagsEnabled => C4::Context->preference("TagsEnabled"),
1193 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1194 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1195 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1196 intranetbookbag => C4::Context->preference("intranetbookbag"),
1197 IntranetNav => C4::Context->preference("IntranetNav"),
1198 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1199 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1200 IndependentBranches => C4::Context->preference("IndependentBranches"),
1201 AutoLocation => C4::Context->preference("AutoLocation"),
1202 wrongip => $info{'wrongip'},
1203 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1204 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1205 persona => C4::Context->preference("Persona"),
1206 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1209 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1210 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1212 if ( $type eq 'opac' ) {
1213 require C4::VirtualShelves;
1214 my ( $total, $pubshelves ) = C4::VirtualShelves::GetSomeShelfNames( undef, 'MASTHEAD' );
1215 $template->param(
1216 pubshelves => $total->{pubtotal},
1217 pubshelvesloop => $pubshelves,
1221 if ($cas) {
1223 # Is authentication against multiple CAS servers enabled?
1224 if ( C4::Auth_with_cas::multipleAuth && !$casparam ) {
1225 my $casservers = C4::Auth_with_cas::getMultipleAuth();
1226 my @tmplservers;
1227 foreach my $key ( keys %$casservers ) {
1228 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1230 $template->param(
1231 casServersLoop => \@tmplservers
1233 } else {
1234 $template->param(
1235 casServerUrl => login_cas_url($query, undef, $type),
1239 $template->param(
1240 invalidCasLogin => $info{'invalidCasLogin'}
1244 if ($shib) {
1245 $template->param(
1246 shibbolethAuthentication => $shib,
1247 shibbolethLoginUrl => login_shib_url($query),
1251 my $self_url = $query->url( -absolute => 1 );
1252 $template->param(
1253 url => $self_url,
1254 LibraryName => C4::Context->preference("LibraryName"),
1256 $template->param(%info);
1258 # $cookie = $query->cookie(CGISESSID => $session->id
1259 # );
1260 print $query->header(
1261 -type => 'text/html',
1262 -charset => 'utf-8',
1263 -cookie => $cookie
1265 $template->output;
1266 safe_exit;
1269 =head2 check_api_auth
1271 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1273 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1274 cookie, determine if the user has the privileges specified by C<$userflags>.
1276 C<check_api_auth> is is meant for authenticating users of web services, and
1277 consequently will always return and will not attempt to redirect the user
1278 agent.
1280 If a valid session cookie is already present, check_api_auth will return a status
1281 of "ok", the cookie, and the Koha session ID.
1283 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1284 parameters and create a session cookie and Koha session if the supplied credentials
1285 are OK.
1287 Possible return values in C<$status> are:
1289 =over
1291 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1293 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1295 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1297 =item "expired -- session cookie has expired; API user should resubmit userid and password
1299 =back
1301 =cut
1303 sub check_api_auth {
1304 my $query = shift;
1305 my $flagsrequired = shift;
1307 my $dbh = C4::Context->dbh;
1308 my $timeout = _timeout_syspref();
1310 unless ( C4::Context->preference('Version') ) {
1312 # database has not been installed yet
1313 return ( "maintenance", undef, undef );
1315 my $kohaversion = Koha::version();
1316 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1317 if ( C4::Context->preference('Version') < $kohaversion ) {
1319 # database in need of version update; assume that
1320 # no API should be called while databsae is in
1321 # this condition.
1322 return ( "maintenance", undef, undef );
1325 # FIXME -- most of what follows is a copy-and-paste
1326 # of code from checkauth. There is an obvious need
1327 # for refactoring to separate the various parts of
1328 # the authentication code, but as of 2007-11-19 this
1329 # is deferred so as to not introduce bugs into the
1330 # regular authentication code for Koha 3.0.
1332 # see if we have a valid session cookie already
1333 # however, if a userid parameter is present (i.e., from
1334 # a form submission, assume that any current cookie
1335 # is to be ignored
1336 my $sessionID = undef;
1337 unless ( $query->param('userid') ) {
1338 $sessionID = $query->cookie("CGISESSID");
1340 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1341 my $session = get_session($sessionID);
1342 C4::Context->_new_userenv($sessionID);
1343 if ($session) {
1344 C4::Context->set_userenv(
1345 $session->param('number'), $session->param('id'),
1346 $session->param('cardnumber'), $session->param('firstname'),
1347 $session->param('surname'), $session->param('branch'),
1348 $session->param('branchname'), $session->param('flags'),
1349 $session->param('emailaddress'), $session->param('branchprinter')
1352 my $ip = $session->param('ip');
1353 my $lasttime = $session->param('lasttime');
1354 my $userid = $session->param('id');
1355 if ( $lasttime < time() - $timeout ) {
1357 # time out
1358 $session->delete();
1359 $session->flush;
1360 C4::Context->_unset_userenv($sessionID);
1361 $userid = undef;
1362 $sessionID = undef;
1363 return ( "expired", undef, undef );
1364 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1366 # IP address changed
1367 $session->delete();
1368 $session->flush;
1369 C4::Context->_unset_userenv($sessionID);
1370 $userid = undef;
1371 $sessionID = undef;
1372 return ( "expired", undef, undef );
1373 } else {
1374 my $cookie = $query->cookie(
1375 -name => 'CGISESSID',
1376 -value => $session->id,
1377 -HttpOnly => 1,
1379 $session->param( 'lasttime', time() );
1380 my $flags = haspermission( $userid, $flagsrequired );
1381 if ($flags) {
1382 return ( "ok", $cookie, $sessionID );
1383 } else {
1384 $session->delete();
1385 $session->flush;
1386 C4::Context->_unset_userenv($sessionID);
1387 $userid = undef;
1388 $sessionID = undef;
1389 return ( "failed", undef, undef );
1392 } else {
1393 return ( "expired", undef, undef );
1395 } else {
1397 # new login
1398 my $userid = $query->param('userid');
1399 my $password = $query->param('password');
1400 my ( $return, $cardnumber );
1402 # Proxy CAS auth
1403 if ( $cas && $query->param('PT') ) {
1404 my $retuserid;
1405 $debug and print STDERR "## check_api_auth - checking CAS\n";
1407 # In case of a CAS authentication, we use the ticket instead of the password
1408 my $PT = $query->param('PT');
1409 ( $return, $cardnumber, $userid ) = check_api_auth_cas( $dbh, $PT, $query ); # EXTERNAL AUTH
1410 } else {
1412 # User / password auth
1413 unless ( $userid and $password ) {
1415 # caller did something wrong, fail the authenticateion
1416 return ( "failed", undef, undef );
1418 ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password, $query );
1421 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1422 my $session = get_session("");
1423 return ( "failed", undef, undef ) unless $session;
1425 my $sessionID = $session->id;
1426 C4::Context->_new_userenv($sessionID);
1427 my $cookie = $query->cookie(
1428 -name => 'CGISESSID',
1429 -value => $sessionID,
1430 -HttpOnly => 1,
1432 if ( $return == 1 ) {
1433 my (
1434 $borrowernumber, $firstname, $surname,
1435 $userflags, $branchcode, $branchname,
1436 $branchprinter, $emailaddress
1438 my $sth =
1439 $dbh->prepare(
1440 "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=?"
1442 $sth->execute($userid);
1444 $borrowernumber, $firstname, $surname,
1445 $userflags, $branchcode, $branchname,
1446 $branchprinter, $emailaddress
1447 ) = $sth->fetchrow if ( $sth->rows );
1449 unless ( $sth->rows ) {
1450 my $sth = $dbh->prepare(
1451 "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=?"
1453 $sth->execute($cardnumber);
1455 $borrowernumber, $firstname, $surname,
1456 $userflags, $branchcode, $branchname,
1457 $branchprinter, $emailaddress
1458 ) = $sth->fetchrow if ( $sth->rows );
1460 unless ( $sth->rows ) {
1461 $sth->execute($userid);
1463 $borrowernumber, $firstname, $surname, $userflags,
1464 $branchcode, $branchname, $branchprinter, $emailaddress
1465 ) = $sth->fetchrow if ( $sth->rows );
1469 my $ip = $ENV{'REMOTE_ADDR'};
1471 # if they specify at login, use that
1472 if ( $query->param('branch') ) {
1473 $branchcode = $query->param('branch');
1474 $branchname = GetBranchName($branchcode);
1476 my $branches = GetBranches();
1477 my @branchesloop;
1478 foreach my $br ( keys %$branches ) {
1480 # now we work with the treatment of ip
1481 my $domain = $branches->{$br}->{'branchip'};
1482 if ( $domain && $ip =~ /^$domain/ ) {
1483 $branchcode = $branches->{$br}->{'branchcode'};
1485 # new op dev : add the branchprinter and branchname in the cookie
1486 $branchprinter = $branches->{$br}->{'branchprinter'};
1487 $branchname = $branches->{$br}->{'branchname'};
1490 $session->param( 'number', $borrowernumber );
1491 $session->param( 'id', $userid );
1492 $session->param( 'cardnumber', $cardnumber );
1493 $session->param( 'firstname', $firstname );
1494 $session->param( 'surname', $surname );
1495 $session->param( 'branch', $branchcode );
1496 $session->param( 'branchname', $branchname );
1497 $session->param( 'flags', $userflags );
1498 $session->param( 'emailaddress', $emailaddress );
1499 $session->param( 'ip', $session->remote_addr() );
1500 $session->param( 'lasttime', time() );
1501 } elsif ( $return == 2 ) {
1503 #We suppose the user is the superlibrarian
1504 $session->param( 'number', 0 );
1505 $session->param( 'id', C4::Context->config('user') );
1506 $session->param( 'cardnumber', C4::Context->config('user') );
1507 $session->param( 'firstname', C4::Context->config('user') );
1508 $session->param( 'surname', C4::Context->config('user') );
1509 $session->param( 'branch', 'NO_LIBRARY_SET' );
1510 $session->param( 'branchname', 'NO_LIBRARY_SET' );
1511 $session->param( 'flags', 1 );
1512 $session->param( 'emailaddress', C4::Context->preference('KohaAdminEmailAddress') );
1513 $session->param( 'ip', $session->remote_addr() );
1514 $session->param( 'lasttime', time() );
1516 C4::Context->set_userenv(
1517 $session->param('number'), $session->param('id'),
1518 $session->param('cardnumber'), $session->param('firstname'),
1519 $session->param('surname'), $session->param('branch'),
1520 $session->param('branchname'), $session->param('flags'),
1521 $session->param('emailaddress'), $session->param('branchprinter')
1523 return ( "ok", $cookie, $sessionID );
1524 } else {
1525 return ( "failed", undef, undef );
1530 =head2 check_cookie_auth
1532 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1534 Given a CGISESSID cookie set during a previous login to Koha, determine
1535 if the user has the privileges specified by C<$userflags>.
1537 C<check_cookie_auth> is meant for authenticating special services
1538 such as tools/upload-file.pl that are invoked by other pages that
1539 have been authenticated in the usual way.
1541 Possible return values in C<$status> are:
1543 =over
1545 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1547 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1549 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1551 =item "expired -- session cookie has expired; API user should resubmit userid and password
1553 =back
1555 =cut
1557 sub check_cookie_auth {
1558 my $cookie = shift;
1559 my $flagsrequired = shift;
1561 my $dbh = C4::Context->dbh;
1562 my $timeout = _timeout_syspref();
1564 unless ( C4::Context->preference('Version') ) {
1566 # database has not been installed yet
1567 return ( "maintenance", undef );
1569 my $kohaversion = Koha::version();
1570 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1571 if ( C4::Context->preference('Version') < $kohaversion ) {
1573 # database in need of version update; assume that
1574 # no API should be called while databsae is in
1575 # this condition.
1576 return ( "maintenance", undef );
1579 # FIXME -- most of what follows is a copy-and-paste
1580 # of code from checkauth. There is an obvious need
1581 # for refactoring to separate the various parts of
1582 # the authentication code, but as of 2007-11-23 this
1583 # is deferred so as to not introduce bugs into the
1584 # regular authentication code for Koha 3.0.
1586 # see if we have a valid session cookie already
1587 # however, if a userid parameter is present (i.e., from
1588 # a form submission, assume that any current cookie
1589 # is to be ignored
1590 unless ( defined $cookie and $cookie ) {
1591 return ( "failed", undef );
1593 my $sessionID = $cookie;
1594 my $session = get_session($sessionID);
1595 C4::Context->_new_userenv($sessionID);
1596 if ($session) {
1597 C4::Context->set_userenv(
1598 $session->param('number'), $session->param('id'),
1599 $session->param('cardnumber'), $session->param('firstname'),
1600 $session->param('surname'), $session->param('branch'),
1601 $session->param('branchname'), $session->param('flags'),
1602 $session->param('emailaddress'), $session->param('branchprinter')
1605 my $ip = $session->param('ip');
1606 my $lasttime = $session->param('lasttime');
1607 my $userid = $session->param('id');
1608 if ( $lasttime < time() - $timeout ) {
1610 # time out
1611 $session->delete();
1612 $session->flush;
1613 C4::Context->_unset_userenv($sessionID);
1614 $userid = undef;
1615 $sessionID = undef;
1616 return ("expired", undef);
1617 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1619 # IP address changed
1620 $session->delete();
1621 $session->flush;
1622 C4::Context->_unset_userenv($sessionID);
1623 $userid = undef;
1624 $sessionID = undef;
1625 return ( "expired", undef );
1626 } else {
1627 $session->param( 'lasttime', time() );
1628 my $flags = haspermission( $userid, $flagsrequired );
1629 if ($flags) {
1630 return ( "ok", $sessionID );
1631 } else {
1632 $session->delete();
1633 $session->flush;
1634 C4::Context->_unset_userenv($sessionID);
1635 $userid = undef;
1636 $sessionID = undef;
1637 return ( "failed", undef );
1640 } else {
1641 return ( "expired", undef );
1645 =head2 get_session
1647 use CGI::Session;
1648 my $session = get_session($sessionID);
1650 Given a session ID, retrieve the CGI::Session object used to store
1651 the session's state. The session object can be used to store
1652 data that needs to be accessed by different scripts during a
1653 user's session.
1655 If the C<$sessionID> parameter is an empty string, a new session
1656 will be created.
1658 =cut
1660 sub get_session {
1661 my $sessionID = shift;
1662 my $storage_method = C4::Context->preference('SessionStorage');
1663 my $dbh = C4::Context->dbh;
1664 my $session;
1665 if ( $storage_method eq 'mysql' ) {
1666 $session = new CGI::Session( "driver:MySQL;serializer:yaml;id:md5", $sessionID, { Handle => $dbh } );
1668 elsif ( $storage_method eq 'Pg' ) {
1669 $session = new CGI::Session( "driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, { Handle => $dbh } );
1671 elsif ( $storage_method eq 'memcached' && C4::Context->ismemcached ) {
1672 $session = new CGI::Session( "driver:memcached;serializer:yaml;id:md5", $sessionID, { Memcached => C4::Context->memcached } );
1674 else {
1675 # catch all defaults to tmp should work on all systems
1676 $session = new CGI::Session( "driver:File;serializer:yaml;id:md5", $sessionID, { Directory => '/tmp' } );
1678 return $session;
1681 sub checkpw {
1682 my ( $dbh, $userid, $password, $query, $type ) = @_;
1683 $type = 'opac' unless $type;
1684 if ($ldap) {
1685 $debug and print STDERR "## checkpw - checking LDAP\n";
1686 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
1687 return 0 if $retval == -1; # Incorrect password for LDAP login attempt
1688 ($retval) and return ( $retval, $retcard, $retuserid );
1691 if ( $cas && $query && $query->param('ticket') ) {
1692 $debug and print STDERR "## checkpw - checking CAS\n";
1694 # In case of a CAS authentication, we use the ticket instead of the password
1695 my $ticket = $query->param('ticket');
1696 $query->delete('ticket'); # remove ticket to come back to original URL
1697 my ( $retval, $retcard, $retuserid ) = checkpw_cas( $dbh, $ticket, $query, $type ); # EXTERNAL AUTH
1698 ($retval) and return ( $retval, $retcard, $retuserid );
1699 return 0;
1702 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1703 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1704 # time around.
1705 if ( $shib && $shib_login && !$password ) {
1707 $debug and print STDERR "## checkpw - checking Shibboleth\n";
1709 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1710 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1711 # shibboleth-authenticated user
1713 # Then, we check if it matches a valid koha user
1714 if ($shib_login) {
1715 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
1716 ($retval) and return ( $retval, $retcard, $retuserid );
1717 return 0;
1721 # INTERNAL AUTH
1722 return checkpw_internal(@_)
1725 sub checkpw_internal {
1726 my ( $dbh, $userid, $password ) = @_;
1728 $password = Encode::encode( 'UTF-8', $password )
1729 if Encode::is_utf8($password);
1731 if ( $userid && $userid eq C4::Context->config('user') ) {
1732 if ( $password && $password eq C4::Context->config('pass') ) {
1734 # Koha superuser account
1735 # C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1736 return 2;
1738 else {
1739 return 0;
1743 my $sth =
1744 $dbh->prepare(
1745 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1747 $sth->execute($userid);
1748 if ( $sth->rows ) {
1749 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1750 $surname, $branchcode, $branchname, $flags )
1751 = $sth->fetchrow;
1753 if ( checkpw_hash( $password, $stored_hash ) ) {
1755 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1756 $firstname, $surname, $branchcode, $branchname, $flags );
1757 return 1, $cardnumber, $userid;
1760 $sth =
1761 $dbh->prepare(
1762 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1764 $sth->execute($userid);
1765 if ( $sth->rows ) {
1766 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1767 $surname, $branchcode, $branchname, $flags )
1768 = $sth->fetchrow;
1770 if ( checkpw_hash( $password, $stored_hash ) ) {
1772 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1773 $firstname, $surname, $branchcode, $branchname, $flags );
1774 return 1, $cardnumber, $userid;
1777 if ( $userid && $userid eq 'demo'
1778 && "$password" eq 'demo'
1779 && C4::Context->config('demo') )
1782 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1783 # some features won't be effective : modify systempref, modify MARC structure,
1784 return 2;
1786 return 0;
1789 sub checkpw_hash {
1790 my ( $password, $stored_hash ) = @_;
1792 return if $stored_hash eq '!';
1794 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1795 my $hash;
1796 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1797 $hash = hash_password( $password, $stored_hash );
1798 } else {
1799 $hash = md5_base64($password);
1801 return $hash eq $stored_hash;
1804 =head2 getuserflags
1806 my $authflags = getuserflags($flags, $userid, [$dbh]);
1808 Translates integer flags into permissions strings hash.
1810 C<$flags> is the integer userflags value ( borrowers.userflags )
1811 C<$userid> is the members.userid, used for building subpermissions
1812 C<$authflags> is a hashref of permissions
1814 =cut
1816 sub getuserflags {
1817 my $flags = shift;
1818 my $userid = shift;
1819 my $dbh = @_ ? shift : C4::Context->dbh;
1820 my $userflags;
1822 # I don't want to do this, but if someone logs in as the database
1823 # user, it would be preferable not to spam them to death with
1824 # numeric warnings. So, we make $flags numeric.
1825 no warnings 'numeric';
1826 $flags += 0;
1828 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1829 $sth->execute;
1831 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1832 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1833 $userflags->{$flag} = 1;
1835 else {
1836 $userflags->{$flag} = 0;
1840 # get subpermissions and merge with top-level permissions
1841 my $user_subperms = get_user_subpermissions($userid);
1842 foreach my $module ( keys %$user_subperms ) {
1843 next if $userflags->{$module} == 1; # user already has permission for everything in this module
1844 $userflags->{$module} = $user_subperms->{$module};
1847 return $userflags;
1850 =head2 get_user_subpermissions
1852 $user_perm_hashref = get_user_subpermissions($userid);
1854 Given the userid (note, not the borrowernumber) of a staff user,
1855 return a hashref of hashrefs of the specific subpermissions
1856 accorded to the user. An example return is
1859 tools => {
1860 export_catalog => 1,
1861 import_patrons => 1,
1865 The top-level hash-key is a module or function code from
1866 userflags.flag, while the second-level key is a code
1867 from permissions.
1869 The results of this function do not give a complete picture
1870 of the functions that a staff user can access; it is also
1871 necessary to check borrowers.flags.
1873 =cut
1875 sub get_user_subpermissions {
1876 my $userid = shift;
1878 my $dbh = C4::Context->dbh;
1879 my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
1880 FROM user_permissions
1881 JOIN permissions USING (module_bit, code)
1882 JOIN userflags ON (module_bit = bit)
1883 JOIN borrowers USING (borrowernumber)
1884 WHERE userid = ?" );
1885 $sth->execute($userid);
1887 my $user_perms = {};
1888 while ( my $perm = $sth->fetchrow_hashref ) {
1889 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1891 return $user_perms;
1894 =head2 get_all_subpermissions
1896 my $perm_hashref = get_all_subpermissions();
1898 Returns a hashref of hashrefs defining all specific
1899 permissions currently defined. The return value
1900 has the same structure as that of C<get_user_subpermissions>,
1901 except that the innermost hash value is the description
1902 of the subpermission.
1904 =cut
1906 sub get_all_subpermissions {
1907 my $dbh = C4::Context->dbh;
1908 my $sth = $dbh->prepare( "SELECT flag, code, description
1909 FROM permissions
1910 JOIN userflags ON (module_bit = bit)" );
1911 $sth->execute();
1913 my $all_perms = {};
1914 while ( my $perm = $sth->fetchrow_hashref ) {
1915 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = $perm->{'description'};
1917 return $all_perms;
1920 =head2 haspermission
1922 $flags = ($userid, $flagsrequired);
1924 C<$userid> the userid of the member
1925 C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
1927 Returns member's flags or 0 if a permission is not met.
1929 =cut
1931 sub haspermission {
1932 my ( $userid, $flagsrequired ) = @_;
1933 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1934 $sth->execute($userid);
1935 my $row = $sth->fetchrow();
1936 my $flags = getuserflags( $row, $userid );
1937 if ( $userid eq C4::Context->config('user') ) {
1939 # Super User Account from /etc/koha.conf
1940 $flags->{'superlibrarian'} = 1;
1942 elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
1944 # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1945 $flags->{'superlibrarian'} = 1;
1948 return $flags if $flags->{superlibrarian};
1950 foreach my $module ( keys %$flagsrequired ) {
1951 my $subperm = $flagsrequired->{$module};
1952 if ( $subperm eq '*' ) {
1953 return 0 unless ( $flags->{$module} == 1 or ref( $flags->{$module} ) );
1954 } else {
1955 return 0 unless (
1956 ( defined $flags->{$module} and
1957 $flags->{$module} == 1 )
1959 ( ref( $flags->{$module} ) and
1960 exists $flags->{$module}->{$subperm} and
1961 $flags->{$module}->{$subperm} == 1 )
1965 return $flags;
1967 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1970 sub getborrowernumber {
1971 my ($userid) = @_;
1972 my $userenv = C4::Context->userenv;
1973 if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
1974 return $userenv->{number};
1976 my $dbh = C4::Context->dbh;
1977 for my $field ( 'userid', 'cardnumber' ) {
1978 my $sth =
1979 $dbh->prepare("select borrowernumber from borrowers where $field=?");
1980 $sth->execute($userid);
1981 if ( $sth->rows ) {
1982 my ($bnumber) = $sth->fetchrow;
1983 return $bnumber;
1986 return 0;
1989 END { } # module clean-up code here (global destructor)
1991 __END__
1993 =head1 SEE ALSO
1995 CGI(3)
1997 C4::Output(3)
1999 Crypt::Eksblowfish::Bcrypt(3)
2001 Digest::MD5(3)
2003 =cut