← Index
Performance Profile   « block view • line view • sub view »
For opac/opac-main.pl
  Run on Mon Aug 24 11:28:47 2009
Reported on Mon Aug 24 11:29:16 2009

File /home/chris/git/koha.git/C4/Auth.pm
Statements Executed 130
Total Time 0.0102744 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111284µs294msC4::Auth::::get_template_and_userC4::Auth::get_template_and_user
111150µs44.1msC4::Auth::::checkauthC4::Auth::checkauth
11135µs1.99msC4::Auth::::_version_checkC4::Auth::_version_check
11128µs10.8msC4::Auth::::get_sessionC4::Auth::get_session
0000s0sC4::Auth::::BEGINC4::Auth::BEGIN
0000s0sC4::Auth::::ENDC4::Auth::END
0000s0sC4::Auth::::_session_logC4::Auth::_session_log
0000s0sC4::Auth::::check_api_authC4::Auth::check_api_auth
0000s0sC4::Auth::::check_cookie_authC4::Auth::check_cookie_auth
0000s0sC4::Auth::::checkpwC4::Auth::checkpw
0000s0sC4::Auth::::get_all_subpermissionsC4::Auth::get_all_subpermissions
0000s0sC4::Auth::::get_user_subpermissionsC4::Auth::get_user_subpermissions
0000s0sC4::Auth::::getborrowernumberC4::Auth::getborrowernumber
0000s0sC4::Auth::::getuserflagsC4::Auth::getuserflags
0000s0sC4::Auth::::haspermissionC4::Auth::haspermission
LineStmts.Exclusive
Time		Avg.Code
1package C4::Auth;
2
3# Copyright 2000-2002 Katipo Communications
4#
5# This file is part of Koha.
6#
7# Koha is free software; you can redistribute it and/or modify it under the
8# terms of the GNU General Public License as published by the Free Software
9# Foundation; either version 2 of the License, or (at your option) any later
10# version.
11#
12# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License along with
17# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18# Suite 330, Boston, MA 02111-1307 USA
19
20336µs12µsuse strict;
# spent 11µs making 1 call to strict::import
213121µs40µsuse Digest::MD5 qw(md5_base64);
# spent 58µs making 1 call to Exporter::import
223125µs42µsuse CGI::Session;
# spent 12µs making 1 call to CGI::Session::import
23
2412µs2µsrequire Exporter;
253242µs81µsuse C4::Context;
# spent 85.1ms making 1 call to C4::Context::import
263257µs86µsuse C4::Output; # to get the template
# spent 150µs making 1 call to Exporter::import
273243µs81µsuse C4::Members;
# spent 415µs making 1 call to Exporter::import
28334µs11µsuse C4::Koha;
# spent 303µs making 1 call to Exporter::import
29328µs9µsuse C4::Branch; # GetBranches
# spent 106µs making 1 call to Exporter::import
303299µs100µsuse C4::VirtualShelves;
# spent 198µs making 1 call to Exporter::import
31340µs13µsuse POSIX qw/strftime/;
# spent 60µs making 1 call to POSIX::import
32
33# use utf8;
343146µs49µsuse vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap);
# spent 89µs making 1 call to vars::import
35
36BEGIN {
371500ns500ns $VERSION = 3.02; # set version for version checking
3811µs1µs $debug = $ENV{DEBUG} || 0 ;
39111µs11µs @ISA = qw(Exporter);
401900ns900ns @EXPORT = qw(&checkauth &get_template_and_user);
4112µs2µs @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &get_all_subpermissions &get_user_subpermissions);
4213µs3µs %EXPORT_TAGS = (EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)]);
43115µs15µs $ldap = C4::Context->config('useldapserver') || 0;
# spent 730µs making 1 call to Memoize::__ANON__[(eval 0)[/usr/share/perl/5.10/Memoize.pm:73]:1]
441500ns500ns if ($ldap) {
45 require C4::Auth_with_ldap; # no import
46 import C4::Auth_with_ldap qw(checkpw_ldap);
47 }
4817.71ms7.71ms}
49
50=head1 NAME
51
52C4::Auth - Authenticates Koha users
53
54=head1 SYNOPSIS
55
56 use CGI;
57 use C4::Auth;
58 use C4::Output;
59
60 my $query = new CGI;
61
62 my ($template, $borrowernumber, $cookie)
63 = get_template_and_user(
64 {
65 template_name => "opac-main.tmpl",
66 query => $query,
67 type => "opac",
68 authnotrequired => 1,
69 flagsrequired => {borrow => 1, catalogue => '*', tools => 'import_patrons' },
70 }
71 );
72
73 output_html_with_http_headers $query, $cookie, $template->output;
74
75=head1 DESCRIPTION
76
77 The main function of this module is to provide
78 authentification. However the get_template_and_user function has
79 been provided so that a users login information is passed along
80 automatically. This gets loaded into the template.
81
82=head1 FUNCTIONS
83
84=over 2
85
86=item get_template_and_user
87
88 my ($template, $borrowernumber, $cookie)
89 = get_template_and_user(
90 {
91 template_name => "opac-main.tmpl",
92 query => $query,
93 type => "opac",
94 authnotrequired => 1,
95 flagsrequired => {borrow => 1, catalogue => '*', tools => 'import_patrons' },
96 }
97 );
98
99 This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
100 to C<&checkauth> (in this module) to perform authentification.
101 See C<&checkauth> for an explanation of these parameters.
102
103 The C<template_name> is then used to find the correct template for
104 the page. The authenticated users details are loaded onto the
105 template in the HTML::Template LOOP variable C<USER_INFO>. Also the
106 C<sessionID> is passed to the template. This can be used in templates
107 if cookies are disabled. It needs to be put as and input to every
108 authenticated page.
109
110 More information on the C<gettemplate> sub can be found in the
111 Output.pm module.
112
113=cut
114
115
# spent 294ms (284µs+294) within C4::Auth::get_template_and_user which was called # once (284µs+294ms) at line 36 of /home/chris/git/koha.git/opac/opac-main.pl
sub get_template_and_user {
11611µs1µs my $in = shift;
117110µs10µs my $template =
# spent 212ms making 1 call to C4::Output::gettemplate
118 gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
119117µs17µs my ( $user, $cookie, $sessionID, $flags ) = checkauth(
# spent 44.1ms making 1 call to C4::Auth::checkauth
120 $in->{'query'},
121 $in->{'authnotrequired'},
122 $in->{'flagsrequired'},
123 $in->{'type'}
124 ) unless ($in->{'template_name'}=~/maintenance/);
125
1261600ns600ns my $borrowernumber;
127111µs11µs my $insecure = C4::Context->preference('insecure');
# spent 588µs making 1 call to Memoize::__ANON__[(eval 0)[/usr/share/perl/5.10/Memoize.pm:73]:1]
1281900ns900ns if ($user or $insecure) {
129
130 # load the template variables for stylesheets and JavaScript
131 $template->param( css_libs => $in->{'css_libs'} );
132 $template->param( css_module => $in->{'css_module'} );
133 $template->param( css_page => $in->{'css_page'} );
134 $template->param( css_widgets => $in->{'css_widgets'} );
135
136 $template->param( js_libs => $in->{'js_libs'} );
137 $template->param( js_module => $in->{'js_module'} );
138 $template->param( js_page => $in->{'js_page'} );
139 $template->param( js_widgets => $in->{'js_widgets'} );
140
141 # user info
142 $template->param( loggedinusername => $user );
143 $template->param( sessionID => $sessionID );
144
145 my ($total, $pubshelves, $barshelves) = C4::Context->get_shelves_userenv();
146 if (defined($pubshelves)) {
147 $template->param( pubshelves => scalar (@$pubshelves),
148 pubshelvesloop => $pubshelves,
149 );
150 $template->param( pubtotal => $total->{'pubtotal'}, ) if ($total->{'pubtotal'} > scalar (@$pubshelves));
151 }
152 if (defined($barshelves)) {
153 $template->param( barshelves => scalar (@$barshelves),
154 barshelvesloop => $barshelves,
155 );
156 $template->param( bartotal => $total->{'bartotal'}, ) if ($total->{'bartotal'} > scalar (@$barshelves));
157 }
158
159 $borrowernumber = getborrowernumber($user);
160 my ( $borr ) = GetMemberDetails( $borrowernumber );
161 my @bordat;
162 $bordat[0] = $borr;
163 $template->param( "USER_INFO" => \@bordat );
164
165 my $all_perms = get_all_subpermissions();
166
167 my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
168 editcatalogue updatecharges management tools editauthorities serials reports);
169 # We are going to use the $flags returned by checkauth
170 # to create the template's parameters that will indicate
171 # which menus the user can access.
172 if (( $flags && $flags->{superlibrarian}==1) or $insecure==1) {
173 $template->param( CAN_user_circulate => 1 );
174 $template->param( CAN_user_catalogue => 1 );
175 $template->param( CAN_user_parameters => 1 );
176 $template->param( CAN_user_borrowers => 1 );
177 $template->param( CAN_user_permissions => 1 );
178 $template->param( CAN_user_reserveforothers => 1 );
179 $template->param( CAN_user_borrow => 1 );
180 $template->param( CAN_user_editcatalogue => 1 );
181 $template->param( CAN_user_updatecharges => 1 );
182 $template->param( CAN_user_acquisition => 1 );
183 $template->param( CAN_user_management => 1 );
184 $template->param( CAN_user_tools => 1 );
185 $template->param( CAN_user_editauthorities => 1 );
186 $template->param( CAN_user_serials => 1 );
187 $template->param( CAN_user_reports => 1 );
188 $template->param( CAN_user_staffaccess => 1 );
189 foreach my $module (keys %$all_perms) {
190 foreach my $subperm (keys %{ $all_perms->{$module} }) {
191 $template->param( "CAN_user_${module}_${subperm}" => 1 );
192 }
193 }
194 }
195
196 if (C4::Context->preference('GranularPermissions')) {
197 if ( $flags ) {
198 foreach my $module (keys %$all_perms) {
199 if ( $flags->{$module} == 1) {
200 foreach my $subperm (keys %{ $all_perms->{$module} }) {
201 $template->param( "CAN_user_${module}_${subperm}" => 1 );
202 }
203 } elsif ( ref($flags->{$module}) ) {
204 foreach my $subperm (keys %{ $flags->{$module} } ) {
205 $template->param( "CAN_user_${module}_${subperm}" => 1 );
206 }
207 }
208 }
209 }
210 } else {
211 foreach my $module (keys %$all_perms) {
212 foreach my $subperm (keys %{ $all_perms->{$module} }) {
213 $template->param( "CAN_user_${module}_${subperm}" => 1 );
214 }
215 }
216 }
217
218 if ($flags) {
219 foreach my $module (keys %$flags) {
220 if ( $flags->{$module} == 1 or ref($flags->{$module}) ) {
221 $template->param( "CAN_user_$module" => 1 );
222 if ($module eq "parameters") {
223 $template->param( CAN_user_management => 1 );
224 }
225 }
226 }
227 }
228 }
229 else { # if this is an anonymous session, setup to display public lists...
230
231 # load the template variables for stylesheets and JavaScript
232112µs12µs $template->param( css_libs => $in->{'css_libs'} );
# spent 19µs making 1 call to HTML::Template::Pro::param
23317µs7µs $template->param( css_module => $in->{'css_module'} );
# spent 10µs making 1 call to HTML::Template::Pro::param
23416µs6µs $template->param( css_page => $in->{'css_page'} );
# spent 10µs making 1 call to HTML::Template::Pro::param
23516µs6µs $template->param( css_widgets => $in->{'css_widgets'} );
# spent 10µs making 1 call to HTML::Template::Pro::param
236
23716µs6µs $template->param( js_libs => $in->{'js_libs'} );
# spent 9µs making 1 call to HTML::Template::Pro::param
23817µs7µs $template->param( js_module => $in->{'js_module'} );
# spent 10µs making 1 call to HTML::Template::Pro::param
23916µs6µs $template->param( js_page => $in->{'js_page'} );
# spent 10µs making 1 call to HTML::Template::Pro::param
24016µs6µs $template->param( js_widgets => $in->{'js_widgets'} );
# spent 10µs making 1 call to HTML::Template::Pro::param
241
24215µs5µs $template->param( sessionID => $sessionID );
# spent 10µs making 1 call to HTML::Template::Pro::param
243
244110µs10µs my ($total, $pubshelves) = C4::Context->get_shelves_userenv(); # an anonymous user has no 'barshelves'...
# spent 14µs making 1 call to C4::Context::get_shelves_userenv
2451900ns900ns if (defined(($pubshelves))) {
24616µs6µs $template->param( pubshelves => scalar (@$pubshelves),
# spent 12µs making 1 call to HTML::Template::Pro::param
247 pubshelvesloop => $pubshelves,
248 );
24912µs2µs $template->param( pubtotal => $total->{'pubtotal'}, ) if ($total->{'pubtotal'} > scalar (@$pubshelves));
250 }
251
252 }
253
254 # these template parameters are set the same regardless of $in->{'type'}
2551177µs177µs $template->param(
# spent 12.5ms making 22 calls to Memoize::__ANON__[(eval 0)[/usr/share/perl/5.10/Memoize.pm:73]:1], avg 569µs/call # spent 67µs making 1 call to HTML::Template::Pro::param # spent 36µs making 6 calls to C4::Context::userenv, avg 6µs/call
256 "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
257 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
258 GoogleJackets => C4::Context->preference("GoogleJackets"),
259 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
260 LoginBranchcode => (C4::Context->userenv?C4::Context->userenv->{"branch"}:"insecure"),
261 LoginFirstname => (C4::Context->userenv?C4::Context->userenv->{"firstname"}:"Bel"),
262 LoginSurname => C4::Context->userenv?C4::Context->userenv->{"surname"}:"Inconnu",
263 TagsEnabled => C4::Context->preference("TagsEnabled"),
264 hide_marc => C4::Context->preference("hide_marc"),
265 dateformat => C4::Context->preference("dateformat"),
266 'item-level_itypes' => C4::Context->preference('item-level_itypes'),
267 patronimages => C4::Context->preference("patronimages"),
268 singleBranchMode => C4::Context->preference("singleBranchMode"),
269 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
270 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
271 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
272 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
273 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
274 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
275 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
276 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
277 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
278 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
279 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
280 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
281 );
282
283127µs27µs if ( $in->{'type'} eq "intranet" ) {
284 $template->param(
285 AmazonEnabled => C4::Context->preference("AmazonEnabled"),
286 AmazonCoverImages => C4::Context->preference("AmazonCoverImages"),
287 AmazonSimilarItems => C4::Context->preference("AmazonSimilarItems"),
288 AutoLocation => C4::Context->preference("AutoLocation"),
289 "BiblioDefaultView".C4::Context->preference("IntranetBiblioDefaultView") => 1,
290 CircAutocompl => C4::Context->preference("CircAutocompl"),
291 FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
292 IndependantBranches => C4::Context->preference("IndependantBranches"),
293 IntranetNav => C4::Context->preference("IntranetNav"),
294 IntranetmainUserblock => C4::Context->preference("IntranetmainUserblock"),
295 LibraryName => C4::Context->preference("LibraryName"),
296 LoginBranchname => (C4::Context->userenv?C4::Context->userenv->{"branchname"}:"insecure"),
297 TemplateEncoding => C4::Context->preference("TemplateEncoding"),
298 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
299 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
300 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
301 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
302 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
303 intranetuserjs => C4::Context->preference("intranetuserjs"),
304 noItemTypeImages => C4::Context->preference("noItemTypeImages"),
305 suggestion => C4::Context->preference("suggestion"),
306 virtualshelves => C4::Context->preference("virtualshelves"),
307 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
308 );
309 }
310 else {
31111µs1µs warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
312 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
31319µs9µs my $LibraryNameTitle = C4::Context->preference("LibraryName");
# spent 548µs making 1 call to Memoize::__ANON__[(eval 0)[/usr/share/perl/5.10/Memoize.pm:73]:1]
3141900ns900ns $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
3151500ns500ns $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
316 # variables passed from CGI: opac_css_override and opac_search_limits.
31712µs2µs my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
3181700ns700ns my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
319112µs12µs my $mylibraryfirst = C4::Context->preference("SearchMyLibraryFirst");
# spent 524µs making 1 call to Memoize::__ANON__[(eval 0)[/usr/share/perl/5.10/Memoize.pm:73]:1]
3201300ns300ns my $opac_name;
3211800ns800ns if($opac_limit_override && ($opac_search_limit =~ /branch:(\w+)/) ){
322 $opac_name = C4::Branch::GetBranchName($1) # opac_search_limit is a branch, so we use it.
323 } elsif($mylibraryfirst){
324 $opac_name = C4::Branch::GetBranchName($mylibraryfirst);
325 }
326 $template->param(
3271299µs299µs AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
# spent 22.6ms making 41 calls to Memoize::__ANON__[(eval 0)[/usr/share/perl/5.10/Memoize.pm:73]:1], avg 552µs/call # spent 283µs making 1 call to CGI::AUTOLOAD # spent 123µs making 1 call to HTML::Template::Pro::param # spent 17µs making 2 calls to C4::Context::userenv, avg 8µs/call # spent 16µs making 1 call to CGI::https
328 AuthorisedValueImages => C4::Context->preference("AuthorisedValueImages"),
329 LibraryName => "" . C4::Context->preference("LibraryName"),
330 LibraryNameTitle => "" . $LibraryNameTitle,
331 LoginBranchname => C4::Context->userenv?C4::Context->userenv->{"branchname"}:"",
332 OPACAmazonEnabled => C4::Context->preference("OPACAmazonEnabled"),
333 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
334 OPACAmazonSimilarItems => "" . C4::Context->preference("OPACAmazonSimilarItems"),
335 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
336 OPACItemHolds => C4::Context->preference("OPACItemHolds"),
337 OPACShelfBrowser => "". C4::Context->preference("OPACShelfBrowser"),
338 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
339 OPACUserCSS => "". C4::Context->preference("OPACUserCSS"),
340 OPACViewOthersSuggestions => "" . C4::Context->preference("OPACViewOthersSuggestions"),
341 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
342 OPACBaseURL => ($in->{'query'}->https() ? "https://" : "http://") . $ENV{'SERVER_NAME'} .
343 ($ENV{'SERVER_PORT'} eq ($in->{'query'}->https() ? "443" : "80") ? '' : ":$ENV{'SERVER_PORT'}"),
344 opac_name => $opac_name,
345 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
346 opac_search_limit => $opac_search_limit,
347 opac_limit_override => $opac_limit_override,
348 OpacBrowser => C4::Context->preference("OpacBrowser"),
349 OpacCloud => C4::Context->preference("OpacCloud"),
350 OpacMainUserBlock => "" . C4::Context->preference("OpacMainUserBlock"),
351 OpacNav => "" . C4::Context->preference("OpacNav"),
352 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
353 OpacTopissue => C4::Context->preference("OpacTopissue"),
354 RequestOnOpac => C4::Context->preference("RequestOnOpac"),
355 TemplateEncoding => "". C4::Context->preference("TemplateEncoding"),
356 'Version' => C4::Context->preference('Version'),
357 XSLTDetailsDisplay => C4::Context->preference("XSLTDetailsDisplay"),
358 XSLTResultsDisplay => C4::Context->preference("XSLTResultsDisplay"),
359 hidelostitems => C4::Context->preference("hidelostitems"),
360 mylibraryfirst => (C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv) ? C4::Context->userenv->{'branch'} : '',
361 opaclayoutstylesheet => "" . C4::Context->preference("opaclayoutstylesheet"),
362 opaccolorstylesheet => "" . C4::Context->preference("opaccolorstylesheet"),
363 opacstylesheet => "" . C4::Context->preference("opacstylesheet"),
364 opacbookbag => "" . C4::Context->preference("opacbookbag"),
365 opaccredits => "" . C4::Context->preference("opaccredits"),
366 opacheader => "" . C4::Context->preference("opacheader"),
367 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
368 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
369 opacsmallimage => "" . C4::Context->preference("opacsmallimage"),
370 opacuserjs => C4::Context->preference("opacuserjs"),
371 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
372 reviewson => C4::Context->preference("reviewson"),
373 suggestion => "" . C4::Context->preference("suggestion"),
374 virtualshelves => "" . C4::Context->preference("virtualshelves"),
375 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
376 );
377 }
37814µs4µs return ( $template, $borrowernumber, $cookie, $flags);
379}
380
381=item checkauth
382
383 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
384
385Verifies that the user is authorized to run this script. If
386the user is authorized, a (userid, cookie, session-id, flags)
387quadruple is returned. If the user is not authorized due to
388insufficent privileges (see $flagsrequired below), it
389displays an error page and exits. Otherwise, it displays the
390login page and exits.
391
392Note that C<&checkauth> will return if and only if the user
393is authorized, so it should be called early on, before any
394unfinished operations (e.g., if you've opened a file, then
395C<&checkauth> won't close it for you).
396
397C<$query> is the CGI object for the script calling C<&checkauth>.
398
399The C<$noauth> argument is optional. If it is set, then no
400authorization is required for the script.
401
402C<&checkauth> fetches user and session information from C<$query> and
403ensures that the user is authorized to run scripts that require
404authorization.
405
406The C<$flagsrequired> argument specifies the required privileges
407the user must have if the username and password are correct.
408It should be specified as a reference-to-hash; keys in the hash
409should be the "flags" for the user, as specified in the Members
410intranet module. Any key specified must correspond to a "flag"
411in the userflags table. E.g., { circulate => 1 } would specify
412that the user must have the "circulate" privilege in order to
413proceed. To make sure that access control is correct, the
414C<$flagsrequired> parameter must be specified correctly.
415
416If the GranularPermissions system preference is ON, the
417value of each key in the C<flagsrequired> hash takes on an additional
418meaning, e.g.,
419
420=item 1
421
422The user must have access to all subfunctions of the module
423specified by the hash key.
424
425=item *
426
427The user must have access to at least one subfunction of the module
428specified by the hash key.
429
430=item specific permission, e.g., 'export_catalog'
431
432The user must have access to the specific subfunction list, which
433must correspond to a row in the permissions table.
434
435The C<$type> argument specifies whether the template should be
436retrieved from the opac or intranet directory tree. "opac" is
437assumed if it is not specified; however, if C<$type> is specified,
438"intranet" is assumed if it is not "opac".
439
440If C<$query> does not have a valid session ID associated with it
441(i.e., the user has not logged in) or if the session has expired,
442C<&checkauth> presents the user with a login page (from the point of
443view of the original script, C<&checkauth> does not return). Once the
444user has authenticated, C<&checkauth> restarts the original script
445(this time, C<&checkauth> returns).
446
447The login page is provided using a HTML::Template, which is set in the
448systempreferences table or at the top of this file. The variable C<$type>
449selects which template to use, either the opac or the intranet
450authentification template.
451
452C<&checkauth> returns a user ID, a cookie, and a session ID. The
453cookie should be sent back to the browser; it verifies that the user
454has authenticated.
455
456=cut
457
458
# spent 1.99ms (35µs+1.96) within C4::Auth::_version_check which was called # once (35µs+1.96ms) by C4::Auth::checkauth at line 526
sub _version_check ($$) {
45911µs1µs my $type = shift;
4601500ns500ns my $query = shift;
4611400ns400ns my $version;
462 # If Version syspref is unavailable, it means Koha is beeing installed,
463 # and so we must redirect to OPAC maintenance page or to the WebInstaller
464 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
46518µs8µs if (C4::Context->preference('OpacMaintenance') && $type eq 'opac') {
# spent 538µs making 1 call to Memoize::__ANON__[(eval 0)[/usr/share/perl/5.10/Memoize.pm:73]:1]
466 warn "OPAC Install required, redirecting to maintenance";
467 print $query->redirect("/cgi-bin/koha/maintenance.pl");
468 }
469110µs10µs unless ($version = C4::Context->preference('Version')) { # assignment, not comparison
# spent 525µs making 1 call to Memoize::__ANON__[(eval 0)[/usr/share/perl/5.10/Memoize.pm:73]:1]
470 if ($type ne 'opac') {
471 warn "Install required, redirecting to Installer";
472 print $query->redirect("/cgi-bin/koha/installer/install.pl");
473 }
474 else {
475 warn "OPAC Install required, redirecting to maintenance";
476 print $query->redirect("/cgi-bin/koha/maintenance.pl");
477 }
478 exit;
479 }
480
481 # check that database and koha version are the same
482 # there is no DB version, it's a fresh install,
483 # go to web installer
484 # there is a DB version, compare it to the code version
48519µs9µs my $kohaversion=C4::Context::KOHAVERSION;
# spent 896µs making 1 call to C4::Context::KOHAVERSION
486 # remove the 3 last . to have a Perl number
487112µs12µs $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
4881500ns500ns $debug and print STDERR "kohaversion : $kohaversion\n";
48914µs4µs if ($version < $kohaversion){
490 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
491 if ($type ne 'opac'){
492 warn sprintf($warning, 'Installer');
493 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
494 } else {
495 warn sprintf("OPAC: " . $warning, 'maintenance');
496 print $query->redirect("/cgi-bin/koha/maintenance.pl");
497 }
498 exit;
499 }
500}
501
502sub _session_log {
503 (@_) or return 0;
504 open L, ">>/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
505 printf L join("\n",@_);
506 close L;
507}
508
509
# spent 44.1ms (150µs+44.0) within C4::Auth::checkauth which was called # once (150µs+44.0ms) by C4::Auth::get_template_and_user at line 119
sub checkauth {
5101800ns800ns my $query = shift;
5111400ns400ns $debug and warn "Checking Auth";
512 # $authnotrequired will be set for scripts which will run without authentication
5131700ns700ns my $authnotrequired = shift;
5141600ns600ns my $flagsrequired = shift;
5151800ns800ns my $type = shift;
5161200ns200ns $type = 'opac' unless $type;
517
51816µs6µs my $dbh = C4::Context->dbh;
# spent 44µs making 1 call to C4::Context::dbh
519111µs11µs my $timeout = C4::Context->preference('timeout');
# spent 714µs making 1 call to Memoize::__ANON__[(eval 0)[/usr/share/perl/5.10/Memoize.pm:73]:1]
520 # days
52114µs4µs if ($timeout =~ /(\d+)[dD]/) {
522 $timeout = $1 * 86400;
523 };
5241400ns400ns $timeout = 600 unless $timeout;
525
526110µs10µs _version_check($type,$query);
# spent 1.99ms making 1 call to C4::Auth::_version_check
527 # state variables
5281800ns800ns my $loggedin = 0;
5291200ns200ns my %info;
5301600ns600ns my ( $userid, $cookie, $sessionID, $flags, $barshelves, $pubshelves );
53119µs9µs my $logout = $query->param('logout.x');
# spent 25µs making 1 call to CGI::param
532
533110µs10µs if ( $userid = $ENV{'REMOTE_USER'} ) {
# spent 55µs making 1 call to CGI::cookie
534 # Using Basic Authentication, no cookies required
535 $cookie = $query->cookie(
536 -name => 'CGISESSID',
537 -value => '',
538 -expires => ''
539 );
540 $loggedin = 1;
541 }
542 elsif ( $sessionID = $query->cookie("CGISESSID")) { # assignment, not comparison
543 my $session = get_session($sessionID);
544 C4::Context->_new_userenv($sessionID);
545 my ($ip, $lasttime, $sessiontype);
546 if ($session){
547 C4::Context::set_userenv(
548 $session->param('number'), $session->param('id'),
549 $session->param('cardnumber'), $session->param('firstname'),
550 $session->param('surname'), $session->param('branch'),
551 $session->param('branchname'), $session->param('flags'),
552 $session->param('emailaddress'), $session->param('branchprinter')
553 );
554 C4::Context::set_shelves_userenv('bar',$session->param('barshelves'));
555 C4::Context::set_shelves_userenv('pub',$session->param('pubshelves'));
556 C4::Context::set_shelves_userenv('tot',$session->param('totshelves'));
557 $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
558 $ip = $session->param('ip');
559 $lasttime = $session->param('lasttime');
560 $userid = $session->param('id');
561 $sessiontype = $session->param('sessiontype');
562 }
563
564 if ( ($query->param('koha_login_context')) && ($query->param('userid') ne $session->param('id')) ) {
565 #if a user enters an id ne to the id in the current session, we need to log them in...
566 #first we need to clear the anonymous session...
567 $debug and warn "query id = " . $query->param('userid') . " but session id = " . $session->param('id');
568 $session->flush;
569 $session->delete();
570 C4::Context->_unset_userenv($sessionID);
571 $sessionID = undef;
572 $userid = undef;
573 }
574 elsif ($logout) {
575 # voluntary logout the user
576 $session->flush;
577 $session->delete();
578 C4::Context->_unset_userenv($sessionID);
579 _session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
580 $sessionID = undef;
581 $userid = undef;
582 }
583 elsif ( $lasttime < time() - $timeout ) {
584 # timed logout
585 $info{'timed_out'} = 1;
586 $session->delete();
587 C4::Context->_unset_userenv($sessionID);
588 _session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
589 $userid = undef;
590 $sessionID = undef;
591 }
592 elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
593 # Different ip than originally logged in from
594 $info{'oldip'} = $ip;
595 $info{'newip'} = $ENV{'REMOTE_ADDR'};
596 $info{'different_ip'} = 1;
597 $session->delete();
598 C4::Context->_unset_userenv($sessionID);
599 _session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
600 $sessionID = undef;
601 $userid = undef;
602 }
603 else {
604 $cookie = $query->cookie( CGISESSID => $session->id );
605 $session->param('lasttime',time());
606 unless ( $sessiontype eq 'anon' ) { #if this is an anonymous session, we want to update the session, but not behave as if they are logged in...
607 $flags = haspermission($userid, $flagsrequired);
608 if ($flags) {
609 $loggedin = 1;
610 } else {
611 $info{'nopermission'} = 1;
612 }
613 }
614 }
615 }
616122µs22µs unless ($userid || $sessionID) {
617 #we initiate a session prior to checking for a username to allow for anonymous sessions...
61819µs9µs my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
# spent 10.8ms making 1 call to C4::Auth::get_session
61918µs8µs my $sessionID = $session->id;
# spent 21µs making 1 call to CGI::Session::id
62018µs8µs C4::Context->_new_userenv($sessionID);
# spent 11µs making 1 call to C4::Context::_new_userenv
62118µs8µs $cookie = $query->cookie(CGISESSID => $sessionID);
# spent 180µs making 1 call to CGI::cookie
622116µs16µs if ( $userid = $query->param('userid') ) {
# spent 19µs making 1 call to CGI::param
623 my $password = $query->param('password');
624 my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
625 if ($return) {
626 _session_log(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime "%c",localtime));
627 if ( $flags = haspermission($userid, $flagsrequired) ) {
628 $loggedin = 1;
629 }
630 else {
631 $info{'nopermission'} = 1;
632 C4::Context->_unset_userenv($sessionID);
633 }
634
635 my ($borrowernumber, $firstname, $surname, $userflags,
636 $branchcode, $branchname, $branchprinter, $emailaddress);
637
638 if ( $return == 1 ) {
639 my $select = "
640 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
641 branches.branchname as branchname,
642 branches.branchprinter as branchprinter,
643 email
644 FROM borrowers
645 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
646 ";
647 my $sth = $dbh->prepare("$select where userid=?");
648 $sth->execute($userid);
649 unless ($sth->rows) {
650 $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
651 $sth = $dbh->prepare("$select where cardnumber=?");
652 $sth->execute($cardnumber);
653 unless ($sth->rows) {
654 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
655 $sth->execute($userid);
656 unless ($sth->rows) {
657 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
658 }
659 }
660 }
661 if ($sth->rows) {
662 ($borrowernumber, $firstname, $surname, $userflags,
663 $branchcode, $branchname, $branchprinter, $emailaddress) = $sth->fetchrow;
664 $debug and print STDERR "AUTH_3 results: " .
665 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
666 } else {
667 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
668 }
669
670# launch a sequence to check if we have a ip for the branch, i
671# if we have one we replace the branchcode of the userenv by the branch bound in the ip.
672
673 my $ip = $ENV{'REMOTE_ADDR'};
674 # if they specify at login, use that
675 if ($query->param('branch')) {
676 $branchcode = $query->param('branch');
677 $branchname = GetBranchName($branchcode);
678 }
679 my $branches = GetBranches();
680 if (C4::Context->boolean_preference('IndependantBranches') && C4::Context->boolean_preference('Autolocation')){
681 # we have to check they are coming from the right ip range
682 my $domain = $branches->{$branchcode}->{'branchip'};
683 if ($ip !~ /^$domain/){
684 $loggedin=0;
685 $info{'wrongip'} = 1;
686 }
687 }
688
689 my @branchesloop;
690 foreach my $br ( keys %$branches ) {
691 # now we work with the treatment of ip
692 my $domain = $branches->{$br}->{'branchip'};
693 if ( $domain && $ip =~ /^$domain/ ) {
694 $branchcode = $branches->{$br}->{'branchcode'};
695
696 # new op dev : add the branchprinter and branchname in the cookie
697 $branchprinter = $branches->{$br}->{'branchprinter'};
698 $branchname = $branches->{$br}->{'branchname'};
699 }
700 }
701 $session->param('number',$borrowernumber);
702 $session->param('id',$userid);
703 $session->param('cardnumber',$cardnumber);
704 $session->param('firstname',$firstname);
705 $session->param('surname',$surname);
706 $session->param('branch',$branchcode);
707 $session->param('branchname',$branchname);
708 $session->param('flags',$userflags);
709 $session->param('emailaddress',$emailaddress);
710 $session->param('ip',$session->remote_addr());
711 $session->param('lasttime',time());
712 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
713 }
714 elsif ( $return == 2 ) {
715 #We suppose the user is the superlibrarian
716 $borrowernumber = 0;
717 $session->param('number',0);
718 $session->param('id',C4::Context->config('user'));
719 $session->param('cardnumber',C4::Context->config('user'));
720 $session->param('firstname',C4::Context->config('user'));
721 $session->param('surname',C4::Context->config('user'));
722 $session->param('branch','NO_LIBRARY_SET');
723 $session->param('branchname','NO_LIBRARY_SET');
724 $session->param('flags',1);
725 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
726 $session->param('ip',$session->remote_addr());
727 $session->param('lasttime',time());
728 }
729 C4::Context::set_userenv(
730 $session->param('number'), $session->param('id'),
731 $session->param('cardnumber'), $session->param('firstname'),
732 $session->param('surname'), $session->param('branch'),
733 $session->param('branchname'), $session->param('flags'),
734 $session->param('emailaddress'), $session->param('branchprinter')
735 );
736
737 # Grab borrower's shelves and public shelves and add them to the session
738 # $row_count determines how many records are returned from the db query
739 # and the number of lists to be displayed of each type in the 'Lists' button drop down
740 my $row_count = 10; # FIXME:This probably should be a syspref
741 my ($total, $totshelves, $barshelves, $pubshelves);
742 ($barshelves, $totshelves) = C4::VirtualShelves::GetRecentShelves(1, $row_count, $borrowernumber);
743 $total->{'bartotal'} = $totshelves;
744 ($pubshelves, $totshelves) = C4::VirtualShelves::GetRecentShelves(2, $row_count, undef);
745 $total->{'pubtotal'} = $totshelves;
746 $session->param('barshelves', $barshelves->[0]);
747 $session->param('pubshelves', $pubshelves->[0]);
748 $session->param('totshelves', $total);
749
750 C4::Context::set_shelves_userenv('bar',$barshelves->[0]);
751 C4::Context::set_shelves_userenv('pub',$pubshelves->[0]);
752 C4::Context::set_shelves_userenv('tot',$total);
753 }
754 else {
755 if ($userid) {
756 $info{'invalid_username_or_password'} = 1;
757 C4::Context->_unset_userenv($sessionID);
758 }
759 }
760 } # END if ( $userid = $query->param('userid') )
761 elsif ($type eq "opac") {
762 # if we are here this is an anonymous session; add public lists to it and a few other items...
763 # anonymous sessions are created only for the OPAC
7641600ns600ns $debug and warn "Initiating an anonymous session...";
765
766 # Grab the public shelves and add to the session...
7671500ns500ns my $row_count = 20; # FIXME:This probably should be a syspref
7681400ns400ns my ($total, $totshelves, $pubshelves);
769110µs10µs ($pubshelves, $totshelves) = C4::VirtualShelves::GetRecentShelves(2, $row_count, undef);
# spent 562µs making 1 call to C4::VirtualShelves::GetRecentShelves
77012µs2µs $total->{'pubtotal'} = $totshelves;
77119µs9µs $session->param('pubshelves', $pubshelves->[0]);
# spent 46µs making 1 call to CGI::Session::param
77215µs5µs $session->param('totshelves', $total);
# spent 30µs making 1 call to CGI::Session::param
77319µs9µs C4::Context::set_shelves_userenv('pub',$pubshelves->[0]);
# spent 18µs making 1 call to C4::Context::set_shelves_userenv
77415µs5µs C4::Context::set_shelves_userenv('tot',$total);
# spent 9µs making 1 call to C4::Context::set_shelves_userenv
775
776 # setting a couple of other session vars...
777112µs12µs $session->param('ip',$session->remote_addr());
# spent 27µs making 1 call to CGI::Session::param # spent 9µs making 1 call to CGI::Session::remote_addr
77816µs6µs $session->param('lasttime',time());
# spent 27µs making 1 call to CGI::Session::param
77916µs6µs $session->param('sessiontype','anon');
# spent 27µs making 1 call to CGI::Session::param
780 }
781 } # END unless ($userid)
782111µs11µs my $insecure = C4::Context->boolean_preference('insecure');
# spent 761µs making 1 call to C4::Context::boolean_preference
783
784 # finished authentification, now respond
7851900ns900ns if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
786 {
787 # successful login
78814µs4µs unless ($cookie) {
789 $cookie = $query->cookie( CGISESSID => '' );
790 }
79113µs3µs return ( $userid, $cookie, $sessionID, $flags );
792 }
793
794#
795#
796# AUTH rejected, show the login/password template, after checking the DB.
797#
798#
799
800 # get the inputs from the incoming query
801 my @inputs = ();
802 foreach my $name ( param $query) {
803 (next) if ( $name eq 'userid' || $name eq 'password' );
804 my $value = $query->param($name);
805 push @inputs, { name => $name, value => $value };
806 }
807 # get the branchloop, which we need for authentication
808 my $branches = GetBranches();
809 my @branch_loop;
810 for my $branch_hash (sort keys %$branches) {
811 push @branch_loop, {branchcode => "$branch_hash", branchname => $branches->{$branch_hash}->{'branchname'}, };
812 }
813
814 my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tmpl' : 'auth.tmpl';
815 my $template = gettemplate( $template_name, $type, $query );
816 $template->param(branchloop => \@branch_loop,);
817 $template->param(
818 login => 1,
819 INPUTS => \@inputs,
820 suggestion => C4::Context->preference("suggestion"),
821 virtualshelves => C4::Context->preference("virtualshelves"),
822 LibraryName => C4::Context->preference("LibraryName"),
823 opacuserlogin => C4::Context->preference("opacuserlogin"),
824 OpacNav => C4::Context->preference("OpacNav"),
825 opaccredits => C4::Context->preference("opaccredits"),
826 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
827 opacsmallimage => C4::Context->preference("opacsmallimage"),
828 opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
829 opaccolorstylesheet => C4::Context->preference("opaccolorstylesheet"),
830 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
831 opacuserjs => C4::Context->preference("opacuserjs"),
832 opacbookbag => "" . C4::Context->preference("opacbookbag"),
833 OpacCloud => C4::Context->preference("OpacCloud"),
834 OpacTopissue => C4::Context->preference("OpacTopissue"),
835 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
836 OpacBrowser => C4::Context->preference("OpacBrowser"),
837 opacheader => C4::Context->preference("opacheader"),
838 TagsEnabled => C4::Context->preference("TagsEnabled"),
839 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
840 intranetcolorstylesheet =>
841 C4::Context->preference("intranetcolorstylesheet"),
842 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
843 IntranetNav => C4::Context->preference("IntranetNav"),
844 intranetuserjs => C4::Context->preference("intranetuserjs"),
845 TemplateEncoding => C4::Context->preference("TemplateEncoding"),
846 IndependantBranches=> C4::Context->preference("IndependantBranches"),
847 AutoLocation => C4::Context->preference("AutoLocation"),
848 wrongip => $info{'wrongip'}
849 );
850
851 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
852
853 my $self_url = $query->url( -absolute => 1 );
854 $template->param(
855 url => $self_url,
856 LibraryName => C4::Context->preference("LibraryName"),
857 );
858 $template->param( \%info );
859# $cookie = $query->cookie(CGISESSID => $session->id
860# );
861 print $query->header(
862 -type => 'text/html',
863 -charset => 'utf-8',
864 -cookie => $cookie
865 ),
866 $template->output;
867 exit;
868}
869
870=item check_api_auth
871
872 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
873
874Given a CGI query containing the parameters 'userid' and 'password' and/or a session
875cookie, determine if the user has the privileges specified by C<$userflags>.
876
877C<check_api_auth> is is meant for authenticating users of web services, and
878consequently will always return and will not attempt to redirect the user
879agent.
880
881If a valid session cookie is already present, check_api_auth will return a status
882of "ok", the cookie, and the Koha session ID.
883
884If no session cookie is present, check_api_auth will check the 'userid' and 'password
885parameters and create a session cookie and Koha session if the supplied credentials
886are OK.
887
888Possible return values in C<$status> are:
889
890=over 4
891
892=item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
893
894=item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
895
896=item "maintenance" -- DB is in maintenance mode; no login possible at the moment
897
898=item "expired -- session cookie has expired; API user should resubmit userid and password
899
900=back
901
902=cut
903
904sub check_api_auth {
905 my $query = shift;
906 my $flagsrequired = shift;
907
908 my $dbh = C4::Context->dbh;
909 my $timeout = C4::Context->preference('timeout');
910 $timeout = 600 unless $timeout;
911
912 unless (C4::Context->preference('Version')) {
913 # database has not been installed yet
914 return ("maintenance", undef, undef);
915 }
916 my $kohaversion=C4::Context::KOHAVERSION;
917 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
918 if (C4::Context->preference('Version') < $kohaversion) {
919 # database in need of version update; assume that
920 # no API should be called while databsae is in
921 # this condition.
922 return ("maintenance", undef, undef);
923 }
924
925 # FIXME -- most of what follows is a copy-and-paste
926 # of code from checkauth. There is an obvious need
927 # for refactoring to separate the various parts of
928 # the authentication code, but as of 2007-11-19 this
929 # is deferred so as to not introduce bugs into the
930 # regular authentication code for Koha 3.0.
931
932 # see if we have a valid session cookie already
933 # however, if a userid parameter is present (i.e., from
934 # a form submission, assume that any current cookie
935 # is to be ignored
936 my $sessionID = undef;
937 unless ($query->param('userid')) {
938 $sessionID = $query->cookie("CGISESSID");
939 }
940 if ($sessionID) {
941 my $session = get_session($sessionID);
942 C4::Context->_new_userenv($sessionID);
943 if ($session) {
944 C4::Context::set_userenv(
945 $session->param('number'), $session->param('id'),
946 $session->param('cardnumber'), $session->param('firstname'),
947 $session->param('surname'), $session->param('branch'),
948 $session->param('branchname'), $session->param('flags'),
949 $session->param('emailaddress'), $session->param('branchprinter')
950 );
951
952 my $ip = $session->param('ip');
953 my $lasttime = $session->param('lasttime');
954 my $userid = $session->param('id');
955 if ( $lasttime < time() - $timeout ) {
956 # time out
957 $session->delete();
958 C4::Context->_unset_userenv($sessionID);
959 $userid = undef;
960 $sessionID = undef;
961 return ("expired", undef, undef);
962 } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
963 # IP address changed
964 $session->delete();
965 C4::Context->_unset_userenv($sessionID);
966 $userid = undef;
967 $sessionID = undef;
968 return ("expired", undef, undef);
969 } else {
970 my $cookie = $query->cookie( CGISESSID => $session->id );
971 $session->param('lasttime',time());
972 my $flags = haspermission($userid, $flagsrequired);
973 if ($flags) {
974 return ("ok", $cookie, $sessionID);
975 } else {
976 $session->delete();
977 C4::Context->_unset_userenv($sessionID);
978 $userid = undef;
979 $sessionID = undef;
980 return ("failed", undef, undef);
981 }
982 }
983 } else {
984 return ("expired", undef, undef);
985 }
986 } else {
987 # new login
988 my $userid = $query->param('userid');
989 my $password = $query->param('password');
990 unless ($userid and $password) {
991 # caller did something wrong, fail the authenticateion
992 return ("failed", undef, undef);
993 }
994 my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
995 if ($return and haspermission($userid, $flagsrequired)) {
996 my $session = get_session("");
997 return ("failed", undef, undef) unless $session;
998
999 my $sessionID = $session->id;
1000 C4::Context->_new_userenv($sessionID);
1001 my $cookie = $query->cookie(CGISESSID => $sessionID);
1002 if ( $return == 1 ) {
1003 my (
1004 $borrowernumber, $firstname, $surname,
1005 $userflags, $branchcode, $branchname,
1006 $branchprinter, $emailaddress
1007 );
1008 my $sth =
1009 $dbh->prepare(
1010"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=?"
1011 );
1012 $sth->execute($userid);
1013 (
1014 $borrowernumber, $firstname, $surname,
1015 $userflags, $branchcode, $branchname,
1016 $branchprinter, $emailaddress
1017 ) = $sth->fetchrow if ( $sth->rows );
1018
1019 unless ($sth->rows ) {
1020 my $sth = $dbh->prepare(
1021"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=?"
1022 );
1023 $sth->execute($cardnumber);
1024 (
1025 $borrowernumber, $firstname, $surname,
1026 $userflags, $branchcode, $branchname,
1027 $branchprinter, $emailaddress
1028 ) = $sth->fetchrow if ( $sth->rows );
1029
1030 unless ( $sth->rows ) {
1031 $sth->execute($userid);
1032 (
1033 $borrowernumber, $firstname, $surname, $userflags,
1034 $branchcode, $branchname, $branchprinter, $emailaddress
1035 ) = $sth->fetchrow if ( $sth->rows );
1036 }
1037 }
1038
1039 my $ip = $ENV{'REMOTE_ADDR'};
1040 # if they specify at login, use that
1041 if ($query->param('branch')) {
1042 $branchcode = $query->param('branch');
1043 $branchname = GetBranchName($branchcode);
1044 }
1045 my $branches = GetBranches();
1046 my @branchesloop;
1047 foreach my $br ( keys %$branches ) {
1048 # now we work with the treatment of ip
1049 my $domain = $branches->{$br}->{'branchip'};
1050 if ( $domain && $ip =~ /^$domain/ ) {
1051 $branchcode = $branches->{$br}->{'branchcode'};
1052
1053 # new op dev : add the branchprinter and branchname in the cookie
1054 $branchprinter = $branches->{$br}->{'branchprinter'};
1055 $branchname = $branches->{$br}->{'branchname'};
1056 }
1057 }
1058 $session->param('number',$borrowernumber);
1059 $session->param('id',$userid);
1060 $session->param('cardnumber',$cardnumber);
1061 $session->param('firstname',$firstname);
1062 $session->param('surname',$surname);
1063 $session->param('branch',$branchcode);
1064 $session->param('branchname',$branchname);
1065 $session->param('flags',$userflags);
1066 $session->param('emailaddress',$emailaddress);
1067 $session->param('ip',$session->remote_addr());
1068 $session->param('lasttime',time());
1069 } elsif ( $return == 2 ) {
1070 #We suppose the user is the superlibrarian
1071 $session->param('number',0);
1072 $session->param('id',C4::Context->config('user'));
1073 $session->param('cardnumber',C4::Context->config('user'));
1074 $session->param('firstname',C4::Context->config('user'));
1075 $session->param('surname',C4::Context->config('user'));
1076 $session->param('branch','NO_LIBRARY_SET');
1077 $session->param('branchname','NO_LIBRARY_SET');
1078 $session->param('flags',1);
1079 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
1080 $session->param('ip',$session->remote_addr());
1081 $session->param('lasttime',time());
1082 }
1083 C4::Context::set_userenv(
1084 $session->param('number'), $session->param('id'),
1085 $session->param('cardnumber'), $session->param('firstname'),
1086 $session->param('surname'), $session->param('branch'),
1087 $session->param('branchname'), $session->param('flags'),
1088 $session->param('emailaddress'), $session->param('branchprinter')
1089 );
1090 return ("ok", $cookie, $sessionID);
1091 } else {
1092 return ("failed", undef, undef);
1093 }
1094 }
1095}
1096
1097=item check_cookie_auth
1098
1099 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1100
1101Given a CGISESSID cookie set during a previous login to Koha, determine
1102if the user has the privileges specified by C<$userflags>.
1103
1104C<check_cookie_auth> is meant for authenticating special services
1105such as tools/upload-file.pl that are invoked by other pages that
1106have been authenticated in the usual way.
1107
1108Possible return values in C<$status> are:
1109
1110=over 4
1111
1112=item "ok" -- user authenticated; C<$sessionID> have valid values.
1113
1114=item "failed" -- credentials are not correct; C<$sessionid> are undef
1115
1116=item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1117
1118=item "expired -- session cookie has expired; API user should resubmit userid and password
1119
1120=back
1121
1122=cut
1123
1124sub check_cookie_auth {
1125 my $cookie = shift;
1126 my $flagsrequired = shift;
1127
1128 my $dbh = C4::Context->dbh;
1129 my $timeout = C4::Context->preference('timeout');
1130 $timeout = 600 unless $timeout;
1131
1132 unless (C4::Context->preference('Version')) {
1133 # database has not been installed yet
1134 return ("maintenance", undef);
1135 }
1136 my $kohaversion=C4::Context::KOHAVERSION;
1137 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1138 if (C4::Context->preference('Version') < $kohaversion) {
1139 # database in need of version update; assume that
1140 # no API should be called while databsae is in
1141 # this condition.
1142 return ("maintenance", undef);
1143 }
1144
1145 # FIXME -- most of what follows is a copy-and-paste
1146 # of code from checkauth. There is an obvious need
1147 # for refactoring to separate the various parts of
1148 # the authentication code, but as of 2007-11-23 this
1149 # is deferred so as to not introduce bugs into the
1150 # regular authentication code for Koha 3.0.
1151
1152 # see if we have a valid session cookie already
1153 # however, if a userid parameter is present (i.e., from
1154 # a form submission, assume that any current cookie
1155 # is to be ignored
1156 unless (defined $cookie and $cookie) {
1157 return ("failed", undef);
1158 }
1159 my $sessionID = $cookie;
1160 my $session = get_session($sessionID);
1161 C4::Context->_new_userenv($sessionID);
1162 if ($session) {
1163 C4::Context::set_userenv(
1164 $session->param('number'), $session->param('id'),
1165 $session->param('cardnumber'), $session->param('firstname'),
1166 $session->param('surname'), $session->param('branch'),
1167 $session->param('branchname'), $session->param('flags'),
1168 $session->param('emailaddress'), $session->param('branchprinter')
1169 );
1170
1171 my $ip = $session->param('ip');
1172 my $lasttime = $session->param('lasttime');
1173 my $userid = $session->param('id');
1174 if ( $lasttime < time() - $timeout ) {
1175 # time out
1176 $session->delete();
1177 C4::Context->_unset_userenv($sessionID);
1178 $userid = undef;
1179 $sessionID = undef;
1180 return ("expired", undef);
1181 } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1182 # IP address changed
1183 $session->delete();
1184 C4::Context->_unset_userenv($sessionID);
1185 $userid = undef;
1186 $sessionID = undef;
1187 return ("expired", undef);
1188 } else {
1189 $session->param('lasttime',time());
1190 my $flags = haspermission($userid, $flagsrequired);
1191 if ($flags) {
1192 return ("ok", $sessionID);
1193 } else {
1194 $session->delete();
1195 C4::Context->_unset_userenv($sessionID);
1196 $userid = undef;
1197 $sessionID = undef;
1198 return ("failed", undef);
1199 }
1200 }
1201 } else {
1202 return ("expired", undef);
1203 }
1204}
1205
1206=item get_session
1207
1208 use CGI::Session;
1209 my $session = get_session($sessionID);
1210
1211Given a session ID, retrieve the CGI::Session object used to store
1212the session's state. The session object can be used to store
1213data that needs to be accessed by different scripts during a
1214user's session.
1215
1216If the C<$sessionID> parameter is an empty string, a new session
1217will be created.
1218
1219=cut
1220
1221
# spent 10.8ms (28µs+10.8) within C4::Auth::get_session which was called # once (28µs+10.8ms) by C4::Auth::checkauth at line 618
sub get_session {
122211µs1µs my $sessionID = shift;
122319µs9µs my $storage_method = C4::Context->preference('SessionStorage');
# spent 570µs making 1 call to Memoize::__ANON__[(eval 0)[/usr/share/perl/5.10/Memoize.pm:73]:1]
122419µs9µs my $dbh = C4::Context->dbh;
# spent 74µs making 1 call to C4::Context::dbh
12251400ns400ns my $session;
1226119µs19µs if ($storage_method eq 'mysql'){
# spent 10.1ms making 1 call to CGI::Session::new
1227 $session = new CGI::Session("driver:MySQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1228 }
1229 elsif ($storage_method eq 'Pg') {
1230 $session = new CGI::Session("driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1231 }
1232 else {
1233 # catch all defaults to tmp should work on all systems
1234 $session = new CGI::Session("driver:File;serializer:yaml;id:md5", $sessionID, {Directory=>'/tmp'});
1235 }
123612µs2µs return $session;
1237}
1238
1239sub checkpw {
1240
1241 my ( $dbh, $userid, $password ) = @_;
1242 if ($ldap) {
1243 $debug and print STDERR "## checkpw - checking LDAP\n";
1244 my ($retval,$retcard) = checkpw_ldap(@_); # EXTERNAL AUTH
1245 ($retval) and return ($retval,$retcard);
1246 }
1247
1248 # INTERNAL AUTH
1249 my $sth =
1250 $dbh->prepare(
1251"select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1252 );
1253 $sth->execute($userid);
1254 if ( $sth->rows ) {
1255 my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1256 $surname, $branchcode, $flags )
1257 = $sth->fetchrow;
1258 if ( md5_base64($password) eq $md5password ) {
1259
1260 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1261 $firstname, $surname, $branchcode, $flags );
1262 return 1, $cardnumber;
1263 }
1264 }
1265 $sth =
1266 $dbh->prepare(
1267"select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1268 );
1269 $sth->execute($userid);
1270 if ( $sth->rows ) {
1271 my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1272 $surname, $branchcode, $flags )
1273 = $sth->fetchrow;
1274 if ( md5_base64($password) eq $md5password ) {
1275
1276 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1277 $firstname, $surname, $branchcode, $flags );
1278 return 1, $userid;
1279 }
1280 }
1281 if ( $userid && $userid eq C4::Context->config('user')
1282 && "$password" eq C4::Context->config('pass') )
1283 {
1284
1285# Koha superuser account
1286# C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1287 return 2;
1288 }
1289 if ( $userid && $userid eq 'demo'
1290 && "$password" eq 'demo'
1291 && C4::Context->config('demo') )
1292 {
1293
1294# DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1295# some features won't be effective : modify systempref, modify MARC structure,
1296 return 2;
1297 }
1298 return 0;
1299}
1300
1301=item getuserflags
1302
1303 my $authflags = getuserflags($flags, $userid, [$dbh]);
1304
1305Translates integer flags into permissions strings hash.
1306
1307C<$flags> is the integer userflags value ( borrowers.userflags )
1308C<$userid> is the members.userid, used for building subpermissions
1309C<$authflags> is a hashref of permissions
1310
1311=cut
1312
1313sub getuserflags {
1314 my $flags = shift;
1315 my $userid = shift;
1316 my $dbh = @_ ? shift : C4::Context->dbh;
1317 my $userflags;
1318 $flags = 0 unless $flags;
1319 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1320 $sth->execute;
1321
1322 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1323 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1324 $userflags->{$flag} = 1;
1325 }
1326 else {
1327 $userflags->{$flag} = 0;
1328 }
1329 }
1330
1331 # get subpermissions and merge with top-level permissions
1332 my $user_subperms = get_user_subpermissions($userid);
1333 foreach my $module (keys %$user_subperms) {
1334 next if $userflags->{$module} == 1; # user already has permission for everything in this module
1335 $userflags->{$module} = $user_subperms->{$module};
1336 }
1337
1338 return $userflags;
1339}
1340
1341=item get_user_subpermissions
1342
1343=over 4
1344
1345my $user_perm_hashref = get_user_subpermissions($userid);
1346
1347=back
1348
1349Given the userid (note, not the borrowernumber) of a staff user,
1350return a hashref of hashrefs of the specific subpermissions
1351accorded to the user. An example return is
1352
1353{
1354 tools => {
1355 export_catalog => 1,
1356 import_patrons => 1,
1357 }
1358}
1359
1360The top-level hash-key is a module or function code from
1361userflags.flag, while the second-level key is a code
1362from permissions.
1363
1364The results of this function do not give a complete picture
1365of the functions that a staff user can access; it is also
1366necessary to check borrowers.flags.
1367
1368=cut
1369
1370sub get_user_subpermissions {
1371 my $userid = shift;
1372
1373 my $dbh = C4::Context->dbh;
1374 my $sth = $dbh->prepare("SELECT flag, user_permissions.code
1375 FROM user_permissions
1376 JOIN permissions USING (module_bit, code)
1377 JOIN userflags ON (module_bit = bit)
1378 JOIN borrowers USING (borrowernumber)
1379 WHERE userid = ?");
1380 $sth->execute($userid);
1381
1382 my $user_perms = {};
1383 while (my $perm = $sth->fetchrow_hashref) {
1384 $user_perms->{$perm->{'flag'}}->{$perm->{'code'}} = 1;
1385 }
1386 return $user_perms;
1387}
1388
1389=item get_all_subpermissions
1390
1391=over 4
1392
1393my $perm_hashref = get_all_subpermissions();
1394
1395=back
1396
1397Returns a hashref of hashrefs defining all specific
1398permissions currently defined. The return value
1399has the same structure as that of C<get_user_subpermissions>,
1400except that the innermost hash value is the description
1401of the subpermission.
1402
1403=cut
1404
1405sub get_all_subpermissions {
1406 my $dbh = C4::Context->dbh;
1407 my $sth = $dbh->prepare("SELECT flag, code, description
1408 FROM permissions
1409 JOIN userflags ON (module_bit = bit)");
1410 $sth->execute();
1411
1412 my $all_perms = {};
1413 while (my $perm = $sth->fetchrow_hashref) {
1414 $all_perms->{$perm->{'flag'}}->{$perm->{'code'}} = $perm->{'description'};
1415 }
1416 return $all_perms;
1417}
1418
1419=item haspermission
1420
1421 $flags = ($userid, $flagsrequired);
1422
1423C<$userid> the userid of the member
1424C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
1425
1426Returns member's flags or 0 if a permission is not met.
1427
1428=cut
1429
1430sub haspermission {
1431 my ($userid, $flagsrequired) = @_;
1432 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1433 $sth->execute($userid);
1434 my $flags = getuserflags( $sth->fetchrow(), $userid );
1435 if ( $userid eq C4::Context->config('user') ) {
1436 # Super User Account from /etc/koha.conf
1437 $flags->{'superlibrarian'} = 1;
1438 }
1439 elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
1440 # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1441 $flags->{'superlibrarian'} = 1;
1442 }
1443 return $flags if $flags->{superlibrarian};
1444 foreach my $module ( keys %$flagsrequired ) {
1445 if (C4::Context->preference('GranularPermissions')) {
1446 my $subperm = $flagsrequired->{$module};
1447 if ($subperm eq '*') {
1448 return 0 unless ( $flags->{$module} == 1 or ref($flags->{$module}) );
1449 } else {
1450 return 0 unless ( $flags->{$module} == 1 or
1451 ( ref($flags->{$module}) and
1452 exists $flags->{$module}->{$subperm} and
1453 $flags->{$module}->{$subperm} == 1
1454 )
1455 );
1456 }
1457 } else {
1458 return 0 unless ( $flags->{$module} );
1459 }
1460 }
1461 return $flags;
1462 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1463}
1464
1465
1466sub getborrowernumber {
1467 my ($userid) = @_;
1468 my $dbh = C4::Context->dbh;
1469 for my $field ( 'userid', 'cardnumber' ) {
1470 my $sth =
1471 $dbh->prepare("select borrowernumber from borrowers where $field=?");
1472 $sth->execute($userid);
1473 if ( $sth->rows ) {
1474 my ($bnumber) = $sth->fetchrow;
1475 return $bnumber;
1476 }
1477 }
1478 return 0;
1479}
1480
14811300ns300nsEND { } # module clean-up code here (global destructor)
148215µs5µs1;
1483__END__
1484
1485=back
1486
1487=head1 SEE ALSO
1488
1489CGI(3)
1490
1491C4::Output(3)
1492
1493Digest::MD5(3)
1494
1495=cut
Report produced by the NYTProf 2.10 Perl profiler, developed by Tim Bunce and Adam Kaplan.