← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:12:27 2013

Filename/usr/share/koha/lib/C4/Auth.pm
StatementsExecuted 159 statements in 16.0ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1114.72ms855msC4::Auth::::BEGIN@39C4::Auth::BEGIN@39
1114.63ms5.13msC4::Auth::::BEGIN@25C4::Auth::BEGIN@25
1113.01ms3.85msC4::Auth::::BEGIN@31C4::Auth::BEGIN@31
1112.50ms3.00msC4::Auth::::BEGIN@30C4::Auth::BEGIN@30
1111.88ms19.5msC4::Auth::::BEGIN@23C4::Auth::BEGIN@23
1111.34ms39.5msC4::Auth::::BEGIN@34C4::Auth::BEGIN@34
1111.25ms317msC4::Auth::::get_template_and_userC4::Auth::get_template_and_user
111916µs1.41msC4::Auth::::BEGIN@22C4::Auth::BEGIN@22
111254µs26.4msC4::Auth::::checkauthC4::Auth::checkauth
332145µs12.2msC4::Auth::::get_sessionC4::Auth::get_session
11172µs4.75msC4::Auth::::_version_checkC4::Auth::_version_check
11150µs131µsC4::Auth::::BEGIN@24C4::Auth::BEGIN@24
11131µs38µsC4::Auth::::BEGIN@28C4::Auth::BEGIN@28
11131µs63µsC4::Auth::::BEGIN@1630C4::Auth::BEGIN@1630
43130µs30µsC4::Auth::::CORE:matchC4::Auth::CORE:match (opcode)
11127µs2.01msC4::Auth::::_timeout_sysprefC4::Auth::_timeout_syspref
22226µs181µsC4::Auth::::ParseSearchHistoryCookieC4::Auth::ParseSearchHistoryCookie
11124µs440µsC4::Auth::::BEGIN@37C4::Auth::BEGIN@37
11124µs36µsC4::Auth::::BEGIN@29C4::Auth::BEGIN@29
11120µs27µsC4::Auth::::BEGIN@20C4::Auth::BEGIN@20
11118µs86µsC4::Auth::::BEGIN@32C4::Auth::BEGIN@32
11118µs52µsC4::Auth::::BEGIN@33C4::Auth::BEGIN@33
33116µs16µsC4::Auth::::CORE:substC4::Auth::CORE:subst (opcode)
11112µs12µsDBI::::BEGIN@600 DBI::BEGIN@600
11112µs33µsC4::Auth::::BEGIN@21C4::Auth::BEGIN@21
1117µs7µsC4::Auth::::ENDC4::Auth::END
2113µs3µsC4::Auth::::CORE:substcontC4::Auth::CORE:substcont (opcode)
0000s0sC4::Auth::::__ANON__[:40]C4::Auth::__ANON__[:40]
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
0000s0sC4::Auth::::psgi_envC4::Auth::psgi_env
0000s0sC4::Auth::::safe_exitC4::Auth::safe_exit
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 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
17# with Koha; if not, write to the Free Software Foundation, Inc.,
18# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20330µs233µs
# spent 27µs (20+6) within C4::Auth::BEGIN@20 which was called: # once (20µs+6µs) by main::BEGIN@46 at line 20
use strict;
# spent 27µs making 1 call to C4::Auth::BEGIN@20 # spent 6µs making 1 call to strict::import
21332µs254µs
# spent 33µs (12+21) within C4::Auth::BEGIN@21 which was called: # once (12µs+21µs) by main::BEGIN@46 at line 21
use warnings;
# spent 33µs making 1 call to C4::Auth::BEGIN@21 # spent 21µs making 1 call to warnings::import
223138µs21.48ms
# spent 1.41ms (916µs+497µs) within C4::Auth::BEGIN@22 which was called: # once (916µs+497µs) by main::BEGIN@46 at line 22
use Digest::MD5 qw(md5_base64);
# spent 1.41ms making 1 call to C4::Auth::BEGIN@22 # spent 63µs making 1 call to Exporter::import
233146µs219.7ms
# spent 19.5ms (1.88+17.6) within C4::Auth::BEGIN@23 which was called: # once (1.88ms+17.6ms) by main::BEGIN@46 at line 23
use JSON qw/encode_json decode_json/;
# spent 19.5ms making 1 call to C4::Auth::BEGIN@23 # spent 232µs making 1 call to JSON::import
24363µs2212µs
# spent 131µs (50+81) within C4::Auth::BEGIN@24 which was called: # once (50µs+81µs) by main::BEGIN@46 at line 24
use URI::Escape;
# spent 131µs making 1 call to C4::Auth::BEGIN@24 # spent 81µs making 1 call to Exporter::import
253179µs25.14ms
# spent 5.13ms (4.63+500µs) within C4::Auth::BEGIN@25 which was called: # once (4.63ms+500µs) by main::BEGIN@46 at line 25
use CGI::Session;
# spent 5.13ms making 1 call to C4::Auth::BEGIN@25 # spent 7µs making 1 call to CGI::Session::import
26
2713µsrequire Exporter;
28353µs245µs
# spent 38µs (31+7) within C4::Auth::BEGIN@28 which was called: # once (31µs+7µs) by main::BEGIN@46 at line 28
use C4::Context;
# spent 38µs making 1 call to C4::Auth::BEGIN@28 # spent 7µs making 1 call to C4::Context::import
29337µs248µs
# spent 36µs (24+12) within C4::Auth::BEGIN@29 which was called: # once (24µs+12µs) by main::BEGIN@46 at line 29
use C4::Templates; # to get the template
# spent 36µs making 1 call to C4::Auth::BEGIN@29 # spent 12µs making 1 call to Class::Accessor::import
303174µs23.31ms
# spent 3.00ms (2.50+497µs) within C4::Auth::BEGIN@30 which was called: # once (2.50ms+497µs) by main::BEGIN@46 at line 30
use C4::Branch; # GetBranches
# spent 3.00ms making 1 call to C4::Auth::BEGIN@30 # spent 311µs making 1 call to Exporter::import
313210µs24.10ms
# spent 3.85ms (3.01+845µs) within C4::Auth::BEGIN@31 which was called: # once (3.01ms+845µs) by main::BEGIN@46 at line 31
use C4::VirtualShelves;
# spent 3.85ms making 1 call to C4::Auth::BEGIN@31 # spent 251µs making 1 call to Exporter::import
32342µs2153µs
# spent 86µs (18+67) within C4::Auth::BEGIN@32 which was called: # once (18µs+67µs) by main::BEGIN@46 at line 32
use POSIX qw/strftime/;
# spent 86µs making 1 call to C4::Auth::BEGIN@32 # spent 67µs making 1 call to POSIX::import
33338µs286µs
# spent 52µs (18+34) within C4::Auth::BEGIN@33 which was called: # once (18µs+34µs) by main::BEGIN@46 at line 33
use List::MoreUtils qw/ any /;
# spent 52µs making 1 call to C4::Auth::BEGIN@33 # spent 34µs making 1 call to Exporter::import
343207µs240.1ms
# spent 39.5ms (1.34+38.2) within C4::Auth::BEGIN@34 which was called: # once (1.34ms+38.2ms) by main::BEGIN@46 at line 34
use LWP::Simple qw(get $ua);
# spent 39.5ms making 1 call to C4::Auth::BEGIN@34 # spent 595µs making 1 call to LWP::Simple::import
35
36# use utf8;
373445µs2855µs
# spent 440µs (24+416) within C4::Auth::BEGIN@37 which was called: # once (24µs+416µs) by main::BEGIN@46 at line 37
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout);
# spent 440µs making 1 call to C4::Auth::BEGIN@37 # spent 415µs making 1 call to vars::import
38
39
# spent 855ms (4.72+851) within C4::Auth::BEGIN@39 which was called: # once (4.72ms+851ms) by main::BEGIN@46 at line 65
BEGIN {
40 sub psgi_env { any { /^psgi\./ } keys %ENV }
41 sub safe_exit {
42 if ( psgi_env ) { die 'psgi:exit' }
43 else { exit }
44 }
4513µs $VERSION = 3.08.01.002; # set version for version checking
4612µs $debug = $ENV{DEBUG};
47117µs @ISA = qw(Exporter);
4813µs @EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
4913µs @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &get_all_subpermissions &get_user_subpermissions
50 ParseSearchHistoryCookie
51 );
5214µs %EXPORT_TAGS = ( EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)] );
5319µs131µs $ldap = C4::Context->config('useldapserver') || 0;
# spent 31µs making 1 call to C4::Context::config
5417µs174.5ms $cas = C4::Context->preference('casAuthentication');
# spent 74.5ms making 1 call to C4::Context::preference
5516µs12.36ms $caslogout = C4::Context->preference('casLogout');
# spent 2.36ms making 1 call to C4::Context::preference
561197µs140µs require C4::Auth_with_cas; # no import
# spent 40µs making 1 call to C4::Context::AUTOLOAD
5712µs if ($ldap) {
581133µs120µs require C4::Auth_with_ldap;
# spent 20µs making 1 call to C4::Context::AUTOLOAD
59111µs159µs import C4::Auth_with_ldap qw(checkpw_ldap);
# spent 59µs making 1 call to Exporter::import
60 }
6117µs if ($cas) {
62 import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url);
63 }
64
65111.5ms2855ms}
# spent 855ms making 1 call to C4::Auth::BEGIN@39 # spent 12µs making 1 call to DBI::BEGIN@600
66
67=head1 NAME
68
- -
13013µsmy $SEARCH_HISTORY_INSERT_SQL =<<EOQ;
131INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time )
132VALUES ( ?, ?, ?, ?, ?, FROM_UNIXTIME(?))
133EOQ
134
135
# spent 317ms (1.25+315) within C4::Auth::get_template_and_user which was called: # once (1.25ms+315ms) by main::RUNTIME at line 116 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
sub get_template_and_user {
13612µs my $in = shift;
137116µs130.7ms my $template =
# spent 30.7ms making 1 call to C4::Templates::gettemplate
138 C4::Templates::gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'}, $in->{'is_plugin'} );
13913µs my ( $user, $cookie, $sessionID, $flags );
140125µs226.4ms if ( $in->{'template_name'} !~m/maintenance/ ) {
# spent 26.4ms making 1 call to C4::Auth::checkauth # spent 3µs making 1 call to C4::Auth::CORE:match
141 ( $user, $cookie, $sessionID, $flags ) = checkauth(
142 $in->{'query'},
143 $in->{'authnotrequired'},
144 $in->{'flagsrequired'},
145 $in->{'type'}
146 );
147 }
148
1491700ns my $borrowernumber;
15011µs if ($user) {
151 require C4::Members;
152 # It's possible for $user to be the borrowernumber if they don't have a
153 # userid defined (and are logging in through some other method, such
154 # as SSL certs against an email address)
155 $borrowernumber = getborrowernumber($user) if defined($user);
156 if (!defined($borrowernumber) && defined($user)) {
157 my $borrower = C4::Members::GetMember(borrowernumber => $user);
158 if ($borrower) {
159 $borrowernumber = $user;
160 # A bit of a hack, but I don't know there's a nicer way
161 # to do it.
162 $user = $borrower->{firstname} . ' ' . $borrower->{surname};
163 }
164 }
165
166 # user info
167 $template->param( loggedinusername => $user );
168 $template->param( sessionID => $sessionID );
169
170 my ($total, $pubshelves, $barshelves) = C4::VirtualShelves::GetSomeShelfNames($borrowernumber, 'MASTHEAD');
171 $template->param(
172 pubshelves => $total->{pubtotal},
173 pubshelvesloop => $pubshelves,
174 barshelves => $total->{bartotal},
175 barshelvesloop => $barshelves,
176 );
177
178 my ( $borr ) = C4::Members::GetMemberDetails( $borrowernumber );
179 my @bordat;
180 $bordat[0] = $borr;
181 $template->param( "USER_INFO" => \@bordat );
182
183 my $all_perms = get_all_subpermissions();
184
185 my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
186 editcatalogue updatecharges management tools editauthorities serials reports acquisition);
187 # We are going to use the $flags returned by checkauth
188 # to create the template's parameters that will indicate
189 # which menus the user can access.
190 if ( $flags && $flags->{superlibrarian}==1 ) {
191 $template->param( CAN_user_circulate => 1 );
192 $template->param( CAN_user_catalogue => 1 );
193 $template->param( CAN_user_parameters => 1 );
194 $template->param( CAN_user_borrowers => 1 );
195 $template->param( CAN_user_permissions => 1 );
196 $template->param( CAN_user_reserveforothers => 1 );
197 $template->param( CAN_user_borrow => 1 );
198 $template->param( CAN_user_editcatalogue => 1 );
199 $template->param( CAN_user_updatecharges => 1 );
200 $template->param( CAN_user_acquisition => 1 );
201 $template->param( CAN_user_management => 1 );
202 $template->param( CAN_user_tools => 1 );
203 $template->param( CAN_user_editauthorities => 1 );
204 $template->param( CAN_user_serials => 1 );
205 $template->param( CAN_user_reports => 1 );
206 $template->param( CAN_user_staffaccess => 1 );
207 $template->param( CAN_user_plugins => 1 );
208 foreach my $module (keys %$all_perms) {
209 foreach my $subperm (keys %{ $all_perms->{$module} }) {
210 $template->param( "CAN_user_${module}_${subperm}" => 1 );
211 }
212 }
213 }
214
215 if ( $flags ) {
216 foreach my $module (keys %$all_perms) {
217 if ( $flags->{$module} == 1) {
218 foreach my $subperm (keys %{ $all_perms->{$module} }) {
219 $template->param( "CAN_user_${module}_${subperm}" => 1 );
220 }
221 } elsif ( ref($flags->{$module}) ) {
222 foreach my $subperm (keys %{ $flags->{$module} } ) {
223 $template->param( "CAN_user_${module}_${subperm}" => 1 );
224 }
225 }
226 }
227 }
228
229 if ($flags) {
230 foreach my $module (keys %$flags) {
231 if ( $flags->{$module} == 1 or ref($flags->{$module}) ) {
232 $template->param( "CAN_user_$module" => 1 );
233 if ($module eq "parameters") {
234 $template->param( CAN_user_management => 1 );
235 }
236 }
237 }
238 }
239 # Logged-in opac search history
240 # If the requested template is an opac one and opac search history is enabled
241 if ($in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory')) {
242 my $dbh = C4::Context->dbh;
243 my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
244 my $sth = $dbh->prepare($query);
245 $sth->execute($borrowernumber);
246
247 # If at least one search has already been performed
248 if ($sth->fetchrow_array > 0) {
249 # We show the link in opac
250 $template->param(ShowOpacRecentSearchLink => 1);
251 }
252
253 # And if there's a cookie with searches performed when the user was not logged in,
254 # we add them to the logged-in search history
255 my @recentSearches = ParseSearchHistoryCookie($in->{'query'});
256 if (@recentSearches) {
257 my $sth = $dbh->prepare($SEARCH_HISTORY_INSERT_SQL);
258 $sth->execute( $borrowernumber,
259 $in->{'query'}->cookie("CGISESSID"),
260 $_->{'query_desc'},
261 $_->{'query_cgi'},
262 $_->{'total'},
263 $_->{'time'},
264 ) foreach @recentSearches;
265
266 # And then, delete the cookie's content
267 my $newsearchcookie = $in->{'query'}->cookie(
268 -name => 'KohaOpacRecentSearches',
269 -value => encode_json([]),
270 -HttpOnly => 1,
271 -expires => ''
272 );
273 $cookie = [$cookie, $newsearchcookie];
274 }
275 }
276 }
277
278 else { # if this is an anonymous session, setup to display public lists...
279
28018µs112µs $template->param( sessionID => $sessionID );
# spent 12µs making 1 call to C4::Templates::param
281
28217µs12.23ms my ($total, $pubshelves) = C4::VirtualShelves::GetSomeShelfNames(undef, 'MASTHEAD');
# spent 2.23ms making 1 call to C4::VirtualShelves::GetSomeShelfNames
28315µs111µs $template->param(
# spent 11µs making 1 call to C4::Templates::param
284 pubshelves => $total->{pubtotal},
285 pubshelvesloop => $pubshelves,
286 );
287 }
288 # Anonymous opac search history
289 # If opac search history is enabled and at least one search has already been performed
29016µs12.04ms if (C4::Context->preference('EnableOpacSearchHistory')) {
# spent 2.04ms making 1 call to C4::Context::preference
29118µs190µs my @recentSearches = ParseSearchHistoryCookie($in->{'query'});
# spent 90µs making 1 call to C4::Auth::ParseSearchHistoryCookie
2921600ns if (@recentSearches) {
293 $template->param(ShowOpacRecentSearchLink => 1);
294 }
295 }
296
297111µs32.28ms if(C4::Context->preference('dateformat')){
# spent 2.27ms making 2 calls to C4::Context::preference, avg 1.14ms/call # spent 9µs making 1 call to C4::Templates::param
298 $template->param(dateformat => C4::Context->preference('dateformat'))
299 }
300
301 # these template parameters are set the same regardless of $in->{'type'}
302 $template->param(
3031140µs2231.7ms "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
# spent 31.2ms making 15 calls to C4::Context::preference, avg 2.08ms/call # spent 457µs making 1 call to CGI::AUTOLOAD # spent 83µs making 1 call to C4::Templates::param # spent 17µs making 5 calls to C4::Context::userenv, avg 3µs/call
304 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
305 GoogleJackets => C4::Context->preference("GoogleJackets"),
306 OpenLibraryCovers => C4::Context->preference("OpenLibraryCovers"),
307 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
308 LoginBranchcode => (C4::Context->userenv?C4::Context->userenv->{"branch"}:undef),
309 LoginFirstname => (C4::Context->userenv?C4::Context->userenv->{"firstname"}:"Bel"),
310 LoginSurname => C4::Context->userenv?C4::Context->userenv->{"surname"}:"Inconnu",
311 emailaddress => C4::Context->userenv?C4::Context->userenv->{"emailaddress"}:undef,
312 loggedinpersona => C4::Context->userenv?C4::Context->userenv->{"persona"}:undef,
313 TagsEnabled => C4::Context->preference("TagsEnabled"),
314 hide_marc => C4::Context->preference("hide_marc"),
315 item_level_itypes => C4::Context->preference('item-level_itypes'),
316 patronimages => C4::Context->preference("patronimages"),
317 singleBranchMode => C4::Context->preference("singleBranchMode"),
318 XSLTDetailsDisplay => C4::Context->preference("XSLTDetailsDisplay"),
319 XSLTResultsDisplay => C4::Context->preference("XSLTResultsDisplay"),
320 using_https => $in->{'query'}->https() ? 1 : 0,
321 noItemTypeImages => C4::Context->preference("noItemTypeImages"),
322 marcflavour => C4::Context->preference("marcflavour"),
323 persona => C4::Context->preference("persona"),
324 );
32514µs if ( $in->{'type'} eq "intranet" ) {
326 $template->param(
327 AmazonCoverImages => C4::Context->preference("AmazonCoverImages"),
328 AutoLocation => C4::Context->preference("AutoLocation"),
329 "BiblioDefaultView".C4::Context->preference("IntranetBiblioDefaultView") => 1,
330 CalendarFirstDayOfWeek => (C4::Context->preference("CalendarFirstDayOfWeek") eq "Sunday")?0:1,
331 CircAutocompl => C4::Context->preference("CircAutocompl"),
332 FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
333 IndependantBranches => C4::Context->preference("IndependantBranches"),
334 IntranetNav => C4::Context->preference("IntranetNav"),
335 IntranetmainUserblock => C4::Context->preference("IntranetmainUserblock"),
336 LibraryName => C4::Context->preference("LibraryName"),
337 LoginBranchname => (C4::Context->userenv?C4::Context->userenv->{"branchname"}:undef),
338 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
339 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
340 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
341 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
342 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
343 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
344 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
345 intranetuserjs => C4::Context->preference("intranetuserjs"),
346 intranetbookbag => C4::Context->preference("intranetbookbag"),
347 suggestion => C4::Context->preference("suggestion"),
348 virtualshelves => C4::Context->preference("virtualshelves"),
349 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
350 EasyAnalyticalRecords => C4::Context->preference('EasyAnalyticalRecords'),
351 LocalCoverImages => C4::Context->preference('LocalCoverImages'),
352 OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'),
353 AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'),
354 EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'),
355 UseKohaPlugins => C4::Context->preference('UseKohaPlugins'),
356 );
357 }
358 else {
35912µs warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
360 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
36116µs11.99ms my $LibraryNameTitle = C4::Context->preference("LibraryName");
# spent 1.99ms making 1 call to C4::Context::preference
362115µs15µs $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
# spent 5µs making 1 call to C4::Auth::CORE:subst
36317µs12µs $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
# spent 2µs making 1 call to C4::Auth::CORE:subst
364 # clean up the busc param in the session if the page is not opac-detail
365179µs636.1ms if (C4::Context->preference("OpacBrowseResults") && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ && $1 !~ /^(?:MARC|ISBD)?detail$/) {
# spent 33.2ms making 1 call to CGI::Session::DESTROY # spent 1.86ms making 1 call to C4::Context::preference # spent 977µs making 1 call to CGI::Session::Driver::DBI::DESTROY # spent 17µs making 2 calls to C4::Auth::CORE:match, avg 8µs/call # spent 6µs making 1 call to CGI::DESTROY
366115µs22.53ms my $sessionSearch = get_session($sessionID || $in->{'query'}->cookie("CGISESSID"));
# spent 2.38ms making 1 call to C4::Auth::get_session # spent 153µs making 1 call to CGI::cookie
367118µs126µs $sessionSearch->clear(["busc"]) if ($sessionSearch->param("busc"));
# spent 26µs making 1 call to CGI::Session::param
368 }
369 # variables passed from CGI: opac_css_override and opac_search_limits.
37013µs my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
37111µs my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
37211µs my $opac_name = '';
373133µs32.32ms if (($opac_search_limit && $opac_search_limit =~ /branch:(\w+)/ && $opac_limit_override) || ($in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:(\w+)/)){
# spent 2.26ms making 1 call to C4::Context::preference # spent 63µs making 2 calls to CGI::param, avg 31µs/call
374 $opac_name = $1; # opac_search_limit is a branch, so we use it.
375 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
376 $opac_name = $in->{'query'}->param('multibranchlimit');
377 } elsif (C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'}) {
378 $opac_name = C4::Context->userenv->{'branch'};
379 }
380 $template->param(
3811550µs78177ms opaccolorstylesheet => C4::Context->preference("opaccolorstylesheet"),
# spent 152ms making 69 calls to C4::Context::preference, avg 2.20ms/call # spent 22.3ms making 1 call to C4::Branch::GetBranchesLoop # spent 2.25ms making 1 call to C4::Branch::GetBranchCategories # spent 359µs making 1 call to C4::Templates::param # spent 65µs making 2 calls to CGI::https, avg 32µs/call # spent 17µs making 1 call to C4::Context::userenv # spent 9µs making 2 calls to DBI::common::DESTROY, avg 5µs/call # spent 2µs making 1 call to DBD::_mem::common::DESTROY
382 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
383 AuthorisedValueImages => C4::Context->preference("AuthorisedValueImages"),
384 BranchesLoop => GetBranchesLoop($opac_name),
385 BranchCategoriesLoop => GetBranchCategories( undef, undef, 1, $opac_name ),
386 CalendarFirstDayOfWeek => (C4::Context->preference("CalendarFirstDayOfWeek") eq "Sunday")?0:1,
387 LibraryName => "" . C4::Context->preference("LibraryName"),
388 LibraryNameTitle => "" . $LibraryNameTitle,
389 LoginBranchname => C4::Context->userenv?C4::Context->userenv->{"branchname"}:"",
390 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
391 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
392 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
393 OPACItemHolds => C4::Context->preference("OPACItemHolds"),
394 OPACShelfBrowser => "". C4::Context->preference("OPACShelfBrowser"),
395 OpacShowRecentComments => C4::Context->preference("OpacShowRecentComments"),
396 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
397 OPACUserCSS => "". C4::Context->preference("OPACUserCSS"),
398 OPACMobileUserCSS => "". C4::Context->preference("OPACMobileUserCSS"),
399 OPACViewOthersSuggestions => "" . C4::Context->preference("OPACViewOthersSuggestions"),
400 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
401 OPACBaseURL => ($in->{'query'}->https() ? "https://" : "http://") . $ENV{'SERVER_NAME'} .
402 ($ENV{'SERVER_PORT'} eq ($in->{'query'}->https() ? "443" : "80") ? '' : ":$ENV{'SERVER_PORT'}"),
403 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
404 opac_search_limit => $opac_search_limit,
405 opac_limit_override => $opac_limit_override,
406 OpacBrowser => C4::Context->preference("OpacBrowser"),
407 OpacCloud => C4::Context->preference("OpacCloud"),
408 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
409 OpacMainUserBlock => "" . C4::Context->preference("OpacMainUserBlock"),
410 OpacMainUserBlockMobile => "" . C4::Context->preference("OpacMainUserBlockMobile"),
411 OpacShowFiltersPulldownMobile => C4::Context->preference("OpacShowFiltersPulldownMobile"),
412 OpacShowLibrariesPulldownMobile => C4::Context->preference("OpacShowLibrariesPulldownMobile"),
413 OpacNav => "" . C4::Context->preference("OpacNav"),
414 OpacNavRight => "" . C4::Context->preference("OpacNavRight"),
415 OpacNavBottom => "" . C4::Context->preference("OpacNavBottom"),
416 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
417 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
418 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
419 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
420 OpacTopissue => C4::Context->preference("OpacTopissue"),
421 RequestOnOpac => C4::Context->preference("RequestOnOpac"),
422 'Version' => C4::Context->preference('Version'),
423 hidelostitems => C4::Context->preference("hidelostitems"),
424 mylibraryfirst => (C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv) ? C4::Context->userenv->{'branch'} : '',
425 opaclayoutstylesheet => "" . C4::Context->preference("opaclayoutstylesheet"),
426 opacbookbag => "" . C4::Context->preference("opacbookbag"),
427 opaccredits => "" . C4::Context->preference("opaccredits"),
428 OpacFavicon => C4::Context->preference("OpacFavicon"),
429 opacheader => "" . C4::Context->preference("opacheader"),
430 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
431 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
432 opacsmallimage => "" . C4::Context->preference("opacsmallimage"),
433 opacuserjs => C4::Context->preference("opacuserjs"),
434 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
435 reviewson => C4::Context->preference("reviewson"),
436 ShowReviewer => C4::Context->preference("ShowReviewer"),
437 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
438 suggestion => "" . C4::Context->preference("suggestion"),
439 virtualshelves => "" . C4::Context->preference("virtualshelves"),
440 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
441 OpacAddMastheadLibraryPulldown => C4::Context->preference("OpacAddMastheadLibraryPulldown"),
442 OPACXSLTDetailsDisplay => C4::Context->preference("OPACXSLTDetailsDisplay"),
443 OPACXSLTResultsDisplay => C4::Context->preference("OPACXSLTResultsDisplay"),
444 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
445 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
446 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
447 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
448 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
449 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
450 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
451 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
452 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
453 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
454 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
455 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
456 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
457 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
458 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
459 );
460
461118µs216µs $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic"));
# spent 8µs making 1 call to C4::Templates::param # spent 8µs making 1 call to C4::Context::preference
462 }
463117µs return ( $template, $borrowernumber, $cookie, $flags);
464}
465
466=head2 checkauth
467
- -
544
# spent 4.75ms (72µs+4.68) within C4::Auth::_version_check which was called: # once (72µs+4.68ms) by C4::Auth::checkauth at line 617
sub _version_check {
54512µs my $type = shift;
5461900ns my $query = shift;
5471700ns my $version;
548 # If Version syspref is unavailable, it means Koha is beeing installed,
549 # and so we must redirect to OPAC maintenance page or to the WebInstaller
550 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
55116µs11.80ms if (C4::Context->preference('OpacMaintenance') && $type eq 'opac') {
# spent 1.80ms making 1 call to C4::Context::preference
552 warn "OPAC Install required, redirecting to maintenance";
553 print $query->redirect("/cgi-bin/koha/maintenance.pl");
554 safe_exit;
555 }
55617µs12.51ms unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
# spent 2.51ms making 1 call to C4::Context::preference
557 if ( $type ne 'opac' ) {
558 warn "Install required, redirecting to Installer";
559 print $query->redirect("/cgi-bin/koha/installer/install.pl");
560 } else {
561 warn "OPAC Install required, redirecting to maintenance";
562 print $query->redirect("/cgi-bin/koha/maintenance.pl");
563 }
564 safe_exit;
565 }
566
567 # check that database and koha version are the same
568 # there is no DB version, it's a fresh install,
569 # go to web installer
570 # there is a DB version, compare it to the code version
57116µs1362µs my $kohaversion=C4::Context::KOHAVERSION;
# spent 362µs making 1 call to C4::Context::KOHAVERSION
572 # remove the 3 last . to have a Perl number
573134µs311µs $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
# spent 8µs making 1 call to C4::Auth::CORE:subst # spent 3µs making 2 calls to C4::Auth::CORE:substcont, avg 2µs/call
5741800ns $debug and print STDERR "kohaversion : $kohaversion\n";
575110µs if ($version < $kohaversion){
576 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
577 if ($type ne 'opac'){
578 warn sprintf($warning, 'Installer');
579 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
580 } else {
581 warn sprintf("OPAC: " . $warning, 'maintenance');
582 print $query->redirect("/cgi-bin/koha/maintenance.pl");
583 }
584 safe_exit;
585 }
586}
587
588sub _session_log {
589 (@_) or return 0;
590 open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
591 printf $fh join("\n",@_);
592 close $fh;
593}
594
595
# spent 2.01ms (27µs+1.99) within C4::Auth::_timeout_syspref which was called: # once (27µs+1.99ms) by C4::Auth::checkauth at line 615
sub _timeout_syspref {
596110µs11.98ms my $timeout = C4::Context->preference('timeout') || 600;
# spent 1.98ms making 1 call to C4::Context::preference
597 # value in days, convert in seconds
598116µs111µs if ($timeout =~ /(\d+)[dD]/) {
# spent 11µs making 1 call to C4::Auth::CORE:match
599 $timeout = $1 * 86400;
600
# spent 12µs within DBI::BEGIN@600 which was called: # once (12µs+0s) by DBI::CORE:subst at line 65
};
60117µs return $timeout;
602}
603
604
# spent 26.4ms (254µs+26.1) within C4::Auth::checkauth which was called: # once (254µs+26.1ms) by C4::Auth::get_template_and_user at line 140
sub checkauth {
6051700ns my $query = shift;
6061800ns $debug and warn "Checking Auth";
607 # $authnotrequired will be set for scripts which will run without authentication
6081600ns my $authnotrequired = shift;
60911µs my $flagsrequired = shift;
6101700ns my $type = shift;
61111µs my $persona = shift;
6121300ns $type = 'opac' unless $type;
613
61418µs11.04ms my $dbh = C4::Context->dbh;
# spent 1.04ms making 1 call to C4::Context::dbh
61518µs12.01ms my $timeout = _timeout_syspref();
# spent 2.01ms making 1 call to C4::Auth::_timeout_syspref
6161900ns my $loggedin = 0;
61715µs14.75ms _version_check($type,$query);
# spent 4.75ms making 1 call to C4::Auth::_version_check
618
619 # state variables
62012µs my ( $userid, $cookie, $sessionID, $flags, $barshelves, $pubshelves );
621
622
623 # Drupal stuffs
62415µs12.35ms if ( C4::Context->preference('DrupalAuth') && $type eq 'opac' ) {
# spent 2.35ms making 1 call to C4::Context::preference
625 require XML::Simple;
626 import XML::Simple;
627 my $url = C4::Context->preference('DrupalUrl');
628 my $currenturl = $query->url(-query=>1);
629 my @cookies = $query->cookie();
630 my $drupalcookie;
631
632 foreach my $cookie (@cookies) {
633 # Drupal cookies start with 'SSESS' for secure, or just SESS for
634 # normal.
635 if ( $cookie =~ /^S?SESS.*/ ) {
636 $drupalcookie = $query->cookie($cookie);
637 }
638 }
639 $ua->agent('Koha_session_check');
640 my $content = get("$url/koha-auth/$drupalcookie");
641 my $drupalinfo;
642 eval { $drupalinfo = XMLin($content); };
643
644 if ($@) {
645 print $query->redirect("$url/user/?referer=$currenturl");
646 exit;
647 }
648 elsif ( $drupalinfo->{'username'} ) {
649
650 # checkusername exists
651 $loggedin = 1;
652 $userid = $drupalinfo->{'username'};
653 $sessionID = $query->cookie("CGISESSID");
654 my $session;
655 if ( !$sessionID ) {
656 $session = get_session("")
657 or die "Auth ERROR: Cannot get_session()";
658 $sessionID = $session->id;
659 C4::Context->_new_userenv($sessionID);
660 $cookie = $query->cookie( CGISESSID => $sessionID );
661 }
662 else {
663 $session = get_session($sessionID);
664 }
665 if ( $query->param('logout.x') ) {
666 $session->flush;
667 $session->delete();
668 C4::Context->_unset_userenv($sessionID);
669
670 $sessionID = undef;
671 $userid = undef;
672 $cookie = $query->cookie( CGISESSID => '' );
673 print $query->redirect(-uri => "$url/user/logout/",
674 -cookie => $cookie);
675 exit;
676 }
677 else {
678 my $select = "SELECT borrowernumber
679 FROM borrowers WHERE userid = ?";
680 my $sth = $dbh->prepare($select);
681 $sth->execute($userid);
682 my ($borrowernumber) = $sth->fetchrow();
683 $session->param( 'number', $borrowernumber );
684 $session->param( 'lasttime', time() );
685 $session->param( 'ip', $session->remote_addr() );
686
687 return ( $userid, $cookie, $sessionID, $flags );
688 }
689 }
690 else {
691 print $query->redirect("$url/user/?referer=$currenturl");
692 exit;
693 }
694 } #end drupal stuffs
695
696
697 # state variables
6981800ns my %info;
69917µs130µs my $logout = $query->param('logout.x');
# spent 30µs making 1 call to CGI::param
700
701 # This parameter is the name of the CAS server we want to authenticate against,
702 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
70314µs114µs my $casparam = $query->param('cas');
# spent 14µs making 1 call to CGI::param
704
705 # If you have httpauth protecting the OPAC from unwanted users, this
706 # will just make everything get upset, so it's turned off until it
707 # can be fixed properly.
70817µs182µs if ( 0 && ($userid = $ENV{'REMOTE_USER'}) ) {
# spent 82µs making 1 call to CGI::cookie
709 # Using Basic Authentication, no cookies required
710 $cookie = $query->cookie(
711 -name => 'CGISESSID',
712 -value => '',
713 -expires => '',
714 -HttpOnly => 1,
715 );
716 $loggedin = 1;
717 }
718 elsif ( $persona ){
719 # we dont want to set a session because we are being called by a persona callback
720 }
721 elsif ( $sessionID = $query->cookie("CGISESSID") )
722 { # assignment, not comparison
723 my $session = get_session($sessionID);
724 C4::Context->_new_userenv($sessionID);
725 my ($ip, $lasttime, $sessiontype);
726 if ($session){
727 C4::Context::set_userenv(
728 $session->param('number'), $session->param('id'),
729 $session->param('cardnumber'), $session->param('firstname'),
730 $session->param('surname'), $session->param('branch'),
731 $session->param('branchname'), $session->param('flags'),
732 $session->param('emailaddress'), $session->param('branchprinter'),
733 $session->param('persona')
734 );
735 C4::Context::set_shelves_userenv('bar',$session->param('barshelves'));
736 C4::Context::set_shelves_userenv('pub',$session->param('pubshelves'));
737 C4::Context::set_shelves_userenv('tot',$session->param('totshelves'));
738 $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
739 $ip = $session->param('ip');
740 $lasttime = $session->param('lasttime');
741 $userid = $session->param('id');
742 $sessiontype = $session->param('sessiontype') || '';
743 }
744 if ( ( ($query->param('koha_login_context')) && ($query->param('userid') ne $session->param('id')) )
745 || ( $cas && $query->param('ticket') ) ) {
746 #if a user enters an id ne to the id in the current session, we need to log them in...
747 #first we need to clear the anonymous session...
748 $debug and warn "query id = " . $query->param('userid') . " but session id = " . $session->param('id');
749 $session->flush;
750 $session->delete();
751 C4::Context->_unset_userenv($sessionID);
752 $sessionID = undef;
753 $userid = undef;
754 }
755 elsif ($logout) {
756 # voluntary logout the user
757 $session->flush;
758 $session->delete();
759 C4::Context->_unset_userenv($sessionID);
760 #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
761 $sessionID = undef;
762 $userid = undef;
763
764 if ($cas and $caslogout) {
765 logout_cas($query);
766 }
767 }
768 elsif ( $lasttime < time() - $timeout ) {
769 # timed logout
770 $info{'timed_out'} = 1;
771 $session->delete() if $session;
772 C4::Context->_unset_userenv($sessionID);
773 #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
774 $userid = undef;
775 $sessionID = undef;
776 }
777 elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
778 # Different ip than originally logged in from
779 $info{'oldip'} = $ip;
780 $info{'newip'} = $ENV{'REMOTE_ADDR'};
781 $info{'different_ip'} = 1;
782 $session->delete();
783 C4::Context->_unset_userenv($sessionID);
784 #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
785 $sessionID = undef;
786 $userid = undef;
787 }
788 else {
789 $cookie = $query->cookie(
790 -name => 'CGISESSID',
791 -value => $session->id,
792 -HttpOnly => 1
793 );
794 $session->param( 'lasttime', time() );
795 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...
796 $flags = haspermission($userid, $flagsrequired);
797 if ($flags) {
798 $loggedin = 1;
799 } else {
800 $info{'nopermission'} = 1;
801 }
802 }
803 }
804 }
805130µs25.09ms unless ($userid || $sessionID) {
# spent 4.06ms making 1 call to CGI::Session::DESTROY # spent 1.03ms making 1 call to CGI::Session::Driver::DBI::DESTROY
806
807 #we initiate a session prior to checking for a username to allow for anonymous sessions...
80816µs17.87ms my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
# spent 7.87ms making 1 call to C4::Auth::get_session
80914µs116µs my $sessionID = $session->id;
# spent 16µs making 1 call to CGI::Session::id
81018µs112µs C4::Context->_new_userenv($sessionID);
# spent 12µs making 1 call to C4::Context::_new_userenv
811114µs2308µs $cookie = $query->cookie(
# spent 288µs making 1 call to CGI::cookie # spent 19µs making 1 call to CGI::Session::id
812 -name => 'CGISESSID',
813 -value => $session->id,
814 -HttpOnly => 1
815 );
81614µs115µs $userid = $query->param('userid');
# spent 15µs making 1 call to CGI::param
817120µs12.14ms if ( ( $cas && $query->param('ticket') )
# spent 2.14ms making 1 call to C4::Context::preference
818 || $userid
819 || ( my $pki_field = C4::Context->preference('AllowPKIAuth') ) ne
820 'None' || $persona )
821 {
822 my $password = $query->param('password');
823
824 my ( $return, $cardnumber );
825 if ( $cas && $query->param('ticket') ) {
826 my $retuserid;
827 ( $return, $cardnumber, $retuserid ) =
828 checkpw( $dbh, $userid, $password, $query );
829 $userid = $retuserid;
830 $info{'invalidCasLogin'} = 1 unless ($return);
831 }
832
833 elsif ($persona) {
834 my $value = $persona;
835
836 # If we're looking up the email, there's a chance that the person
837 # doesn't have a userid. So if there is none, we pass along the
838 # borrower number, and the bits of code that need to know the user
839 # ID will have to be smart enough to handle that.
840 require C4::Members;
841 my @users_info = C4::Members::GetBorrowersWithEmail($value);
842 if (@users_info) {
843
844 # First the userid, then the borrowernum
845 $value = $users_info[0][1] || $users_info[0][0];
846 }
847 else {
848 undef $value;
849 }
850 $return = $value ? 1 : 0;
851 $userid = $value;
852 }
853
854 elsif (
855 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
856 || ( $pki_field eq 'emailAddress'
857 && $ENV{'SSL_CLIENT_S_DN_Email'} )
858 )
859 {
860 my $value;
861 if ( $pki_field eq 'Common Name' ) {
862 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
863 }
864 elsif ( $pki_field eq 'emailAddress' ) {
865 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
866
867 # If we're looking up the email, there's a chance that the person
868 # doesn't have a userid. So if there is none, we pass along the
869 # borrower number, and the bits of code that need to know the user
870 # ID will have to be smart enough to handle that.
871 require C4::Members;
872 my @users_info = C4::Members::GetBorrowersWithEmail($value);
873 if (@users_info) {
874
875 # First the userid, then the borrowernum
876 $value = $users_info[0][1] || $users_info[0][0];
877 } else {
878 undef $value;
879 }
880 }
881
882
883 $return = $value ? 1 : 0;
884 $userid = $value;
885
886 }
887 else {
888 my $retuserid;
889 ( $return, $cardnumber, $retuserid ) =
890 checkpw( $dbh, $userid, $password, $query );
891 $userid = $retuserid if ( $retuserid ne '' );
892 }
893 if ($return) {
894 #_session_log(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
895 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
896 $loggedin = 1;
897 }
898 else {
899 $info{'nopermission'} = 1;
900 C4::Context->_unset_userenv($sessionID);
901 }
902 my ($borrowernumber, $firstname, $surname, $userflags,
903 $branchcode, $branchname, $branchprinter, $emailaddress);
904
905 if ( $return == 1 ) {
906 my $select = "
907 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
908 branches.branchname as branchname,
909 branches.branchprinter as branchprinter,
910 email
911 FROM borrowers
912 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
913 ";
914 my $sth = $dbh->prepare("$select where userid=?");
915 $sth->execute($userid);
916 unless ($sth->rows) {
917 $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
918 $sth = $dbh->prepare("$select where cardnumber=?");
919 $sth->execute($cardnumber);
920
921 unless ($sth->rows) {
922 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
923 $sth->execute($userid);
924 unless ($sth->rows) {
925 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
926 }
927 }
928 }
929 if ($sth->rows) {
930 ($borrowernumber, $firstname, $surname, $userflags,
931 $branchcode, $branchname, $branchprinter, $emailaddress) = $sth->fetchrow;
932 $debug and print STDERR "AUTH_3 results: " .
933 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
934 } else {
935 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
936 }
937
938# launch a sequence to check if we have a ip for the branch, i
939# if we have one we replace the branchcode of the userenv by the branch bound in the ip.
940
941 my $ip = $ENV{'REMOTE_ADDR'};
942 # if they specify at login, use that
943 if ($query->param('branch')) {
944 $branchcode = $query->param('branch');
945 $branchname = GetBranchName($branchcode);
946 }
947 my $branches = GetBranches();
948 if (C4::Context->boolean_preference('IndependantBranches') && C4::Context->boolean_preference('Autolocation')){
949 # we have to check they are coming from the right ip range
950 my $domain = $branches->{$branchcode}->{'branchip'};
951 if ($ip !~ /^$domain/){
952 $loggedin=0;
953 $info{'wrongip'} = 1;
954 }
955 }
956
957 my @branchesloop;
958 foreach my $br ( keys %$branches ) {
959 # now we work with the treatment of ip
960 my $domain = $branches->{$br}->{'branchip'};
961 if ( $domain && $ip =~ /^$domain/ ) {
962 $branchcode = $branches->{$br}->{'branchcode'};
963
964 # new op dev : add the branchprinter and branchname in the cookie
965 $branchprinter = $branches->{$br}->{'branchprinter'};
966 $branchname = $branches->{$br}->{'branchname'};
967 }
968 }
969 $session->param('number',$borrowernumber);
970 $session->param('id',$userid);
971 $session->param('cardnumber',$cardnumber);
972 $session->param('firstname',$firstname);
973 $session->param('surname',$surname);
974 $session->param('branch',$branchcode);
975 $session->param('branchname',$branchname);
976 $session->param('flags',$userflags);
977 $session->param('emailaddress',$emailaddress);
978 $session->param('ip',$session->remote_addr());
979 $session->param('lasttime',time());
980 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
981 }
982 elsif ( $return == 2 ) {
983 #We suppose the user is the superlibrarian
984 $borrowernumber = 0;
985 $session->param('number',0);
986 $session->param('id',C4::Context->config('user'));
987 $session->param('cardnumber',C4::Context->config('user'));
988 $session->param('firstname',C4::Context->config('user'));
989 $session->param('surname',C4::Context->config('user'));
990 $session->param('branch','NO_LIBRARY_SET');
991 $session->param('branchname','NO_LIBRARY_SET');
992 $session->param('flags',1);
993 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
994 $session->param('ip',$session->remote_addr());
995 $session->param('lasttime',time());
996 }
997 if ($persona){
998 $session->param('persona',1);
999 }
1000 C4::Context::set_userenv(
1001 $session->param('number'), $session->param('id'),
1002 $session->param('cardnumber'), $session->param('firstname'),
1003 $session->param('surname'), $session->param('branch'),
1004 $session->param('branchname'), $session->param('flags'),
1005 $session->param('emailaddress'), $session->param('branchprinter'),
1006 $session->param('persona')
1007 );
1008
1009 }
1010 else {
1011 if ($userid) {
1012 $info{'invalid_username_or_password'} = 1;
1013 C4::Context->_unset_userenv($sessionID);
1014 }
1015 }
1016 } # END if ( $userid = $query->param('userid') )
1017 elsif ($type eq "opac") {
1018 # if we are here this is an anonymous session; add public lists to it and a few other items...
1019 # anonymous sessions are created only for the OPAC
102011µs $debug and warn "Initiating an anonymous session...";
1021
1022 # setting a couple of other session vars...
1023112µs277µs $session->param('ip',$session->remote_addr());
# spent 70µs making 1 call to CGI::Session::param # spent 7µs making 1 call to CGI::Session::remote_addr
102415µs165µs $session->param('lasttime',time());
# spent 65µs making 1 call to CGI::Session::param
102518µs179µs $session->param('sessiontype','anon');
# spent 79µs making 1 call to CGI::Session::param
1026 }
1027 } # END unless ($userid)
1028
1029 # finished authentification, now respond
103011µs if ( $loggedin || $authnotrequired )
1031 {
1032 # successful login
103318µs1160µs unless ($cookie) {
# spent 160µs making 1 call to CGI::Cookie::as_string
1034 $cookie = $query->cookie(
1035 -name => 'CGISESSID',
1036 -value => '',
1037 -HttpOnly => 1
1038 );
1039 }
104019µs return ( $userid, $cookie, $sessionID, $flags );
1041 }
1042
1043#
1044#
1045# AUTH rejected, show the login/password template, after checking the DB.
1046#
1047#
1048
1049 # get the inputs from the incoming query
1050 my @inputs = ();
1051 foreach my $name ( param $query) {
1052 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1053 my $value = $query->param($name);
1054 push @inputs, { name => $name, value => $value };
1055 }
1056
1057 my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tmpl' : 'auth.tmpl';
1058 my $template = C4::Templates::gettemplate($template_name, $type, $query );
1059 $template->param(
1060 branchloop => GetBranchesLoop(),
1061 opaccolorstylesheet => C4::Context->preference("opaccolorstylesheet"),
1062 opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
1063 login => 1,
1064 INPUTS => \@inputs,
1065 casAuthentication => C4::Context->preference("casAuthentication"),
1066 suggestion => C4::Context->preference("suggestion"),
1067 virtualshelves => C4::Context->preference("virtualshelves"),
1068 LibraryName => C4::Context->preference("LibraryName"),
1069
1070 opacuserlogin => C4::Context->preference("opacuserlogin"),
1071 OpacNav => C4::Context->preference("OpacNav"),
1072 OpacNavRight => C4::Context->preference("OpacNavRight"),
1073 OpacNavBottom => C4::Context->preference("OpacNavBottom"),
1074 opaccredits => C4::Context->preference("opaccredits"),
1075 OpacFavicon => C4::Context->preference("OpacFavicon"),
1076 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1077 opacsmallimage => C4::Context->preference("opacsmallimage"),
1078 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1079 opacuserjs => C4::Context->preference("opacuserjs"),
1080 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1081 OpacCloud => C4::Context->preference("OpacCloud"),
1082 OpacTopissue => C4::Context->preference("OpacTopissue"),
1083 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1084 OpacBrowser => C4::Context->preference("OpacBrowser"),
1085 opacheader => C4::Context->preference("opacheader"),
1086 TagsEnabled => C4::Context->preference("TagsEnabled"),
1087 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1088 opacstylesheet => C4::Context->preference("opacstylesheet"),
1089 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1090 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1091 intranetbookbag => C4::Context->preference("intranetbookbag"),
1092 IntranetNav => C4::Context->preference("IntranetNav"),
1093 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1094 intranetuserjs => C4::Context->preference("intranetuserjs"),
1095 IndependantBranches=> C4::Context->preference("IndependantBranches"),
1096 AutoLocation => C4::Context->preference("AutoLocation"),
1097 wrongip => $info{'wrongip'},
1098 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1099 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1100 persona => C4::Context->preference("Persona"),
1101 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1102 );
1103
1104 $template->param( OpacPublic => C4::Context->preference("OpacPublic"));
1105 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1106
1107 if ($cas) {
1108
1109 # Is authentication against multiple CAS servers enabled?
1110 if (C4::Auth_with_cas::multipleAuth && !$casparam) {
1111 my $casservers = C4::Auth_with_cas::getMultipleAuth();
1112 my @tmplservers;
1113 foreach my $key (keys %$casservers) {
1114 push @tmplservers, {name => $key, value => login_cas_url($query, $key) . "?cas=$key" };
1115 }
1116 $template->param(
1117 casServersLoop => \@tmplservers
1118 );
1119 } else {
1120 $template->param(
1121 casServerUrl => login_cas_url($query),
1122 );
1123 }
1124
1125 $template->param(
1126 invalidCasLogin => $info{'invalidCasLogin'}
1127 );
1128 }
1129
1130 my $self_url = $query->url( -absolute => 1 );
1131 $template->param(
1132 url => $self_url,
1133 LibraryName => C4::Context->preference("LibraryName"),
1134 );
1135 $template->param( %info );
1136# $cookie = $query->cookie(CGISESSID => $session->id
1137# );
1138 print $query->header(
1139 -type => 'text/html',
1140 -charset => 'utf-8',
1141 -cookie => $cookie
1142 ),
1143 $template->output;
1144 safe_exit;
1145}
1146
1147=head2 check_api_auth
1148
- -
1181sub check_api_auth {
1182 my $query = shift;
1183 my $flagsrequired = shift;
1184
1185 my $dbh = C4::Context->dbh;
1186 my $timeout = _timeout_syspref();
1187
1188 unless (C4::Context->preference('Version')) {
1189 # database has not been installed yet
1190 return ("maintenance", undef, undef);
1191 }
1192 my $kohaversion=C4::Context::KOHAVERSION;
1193 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1194 if (C4::Context->preference('Version') < $kohaversion) {
1195 # database in need of version update; assume that
1196 # no API should be called while databsae is in
1197 # this condition.
1198 return ("maintenance", undef, undef);
1199 }
1200
1201 # FIXME -- most of what follows is a copy-and-paste
1202 # of code from checkauth. There is an obvious need
1203 # for refactoring to separate the various parts of
1204 # the authentication code, but as of 2007-11-19 this
1205 # is deferred so as to not introduce bugs into the
1206 # regular authentication code for Koha 3.0.
1207
1208 # see if we have a valid session cookie already
1209 # however, if a userid parameter is present (i.e., from
1210 # a form submission, assume that any current cookie
1211 # is to be ignored
1212 my $sessionID = undef;
1213 unless ($query->param('userid')) {
1214 $sessionID = $query->cookie("CGISESSID");
1215 }
1216 if ($sessionID && not ($cas && $query->param('PT')) ) {
1217 my $session = get_session($sessionID);
1218 C4::Context->_new_userenv($sessionID);
1219 if ($session) {
1220 C4::Context::set_userenv(
1221 $session->param('number'), $session->param('id'),
1222 $session->param('cardnumber'), $session->param('firstname'),
1223 $session->param('surname'), $session->param('branch'),
1224 $session->param('branchname'), $session->param('flags'),
1225 $session->param('emailaddress'), $session->param('branchprinter')
1226 );
1227
1228 my $ip = $session->param('ip');
1229 my $lasttime = $session->param('lasttime');
1230 my $userid = $session->param('id');
1231 if ( $lasttime < time() - $timeout ) {
1232 # time out
1233 $session->delete();
1234 C4::Context->_unset_userenv($sessionID);
1235 $userid = undef;
1236 $sessionID = undef;
1237 return ("expired", undef, undef);
1238 } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1239 # IP address changed
1240 $session->delete();
1241 C4::Context->_unset_userenv($sessionID);
1242 $userid = undef;
1243 $sessionID = undef;
1244 return ("expired", undef, undef);
1245 } else {
1246 my $cookie = $query->cookie(
1247 -name => 'CGISESSID',
1248 -value => $session->id,
1249 -HttpOnly => 1,
1250 );
1251 $session->param('lasttime',time());
1252 my $flags = haspermission($userid, $flagsrequired);
1253 if ($flags) {
1254 return ("ok", $cookie, $sessionID);
1255 } else {
1256 $session->delete();
1257 C4::Context->_unset_userenv($sessionID);
1258 $userid = undef;
1259 $sessionID = undef;
1260 return ("failed", undef, undef);
1261 }
1262 }
1263 } else {
1264 return ("expired", undef, undef);
1265 }
1266 } else {
1267 # new login
1268 my $userid = $query->param('userid');
1269 my $password = $query->param('password');
1270 my ($return, $cardnumber);
1271
1272 # Proxy CAS auth
1273 if ($cas && $query->param('PT')) {
1274 my $retuserid;
1275 $debug and print STDERR "## check_api_auth - checking CAS\n";
1276 # In case of a CAS authentication, we use the ticket instead of the password
1277 my $PT = $query->param('PT');
1278 ($return,$cardnumber,$userid) = check_api_auth_cas($dbh, $PT, $query); # EXTERNAL AUTH
1279 } else {
1280 # User / password auth
1281 unless ($userid and $password) {
1282 # caller did something wrong, fail the authenticateion
1283 return ("failed", undef, undef);
1284 }
1285 ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password, $query );
1286 }
1287
1288 if ($return and haspermission( $userid, $flagsrequired)) {
1289 my $session = get_session("");
1290 return ("failed", undef, undef) unless $session;
1291
1292 my $sessionID = $session->id;
1293 C4::Context->_new_userenv($sessionID);
1294 my $cookie = $query->cookie(
1295 -name => 'CGISESSID',
1296 -value => $sessionID,
1297 -HttpOnly => 1,
1298 );
1299 if ( $return == 1 ) {
1300 my (
1301 $borrowernumber, $firstname, $surname,
1302 $userflags, $branchcode, $branchname,
1303 $branchprinter, $emailaddress
1304 );
1305 my $sth =
1306 $dbh->prepare(
1307"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=?"
1308 );
1309 $sth->execute($userid);
1310 (
1311 $borrowernumber, $firstname, $surname,
1312 $userflags, $branchcode, $branchname,
1313 $branchprinter, $emailaddress
1314 ) = $sth->fetchrow if ( $sth->rows );
1315
1316 unless ($sth->rows ) {
1317 my $sth = $dbh->prepare(
1318"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=?"
1319 );
1320 $sth->execute($cardnumber);
1321 (
1322 $borrowernumber, $firstname, $surname,
1323 $userflags, $branchcode, $branchname,
1324 $branchprinter, $emailaddress
1325 ) = $sth->fetchrow if ( $sth->rows );
1326
1327 unless ( $sth->rows ) {
1328 $sth->execute($userid);
1329 (
1330 $borrowernumber, $firstname, $surname, $userflags,
1331 $branchcode, $branchname, $branchprinter, $emailaddress
1332 ) = $sth->fetchrow if ( $sth->rows );
1333 }
1334 }
1335
1336 my $ip = $ENV{'REMOTE_ADDR'};
1337 # if they specify at login, use that
1338 if ($query->param('branch')) {
1339 $branchcode = $query->param('branch');
1340 $branchname = GetBranchName($branchcode);
1341 }
1342 my $branches = GetBranches();
1343 my @branchesloop;
1344 foreach my $br ( keys %$branches ) {
1345 # now we work with the treatment of ip
1346 my $domain = $branches->{$br}->{'branchip'};
1347 if ( $domain && $ip =~ /^$domain/ ) {
1348 $branchcode = $branches->{$br}->{'branchcode'};
1349
1350 # new op dev : add the branchprinter and branchname in the cookie
1351 $branchprinter = $branches->{$br}->{'branchprinter'};
1352 $branchname = $branches->{$br}->{'branchname'};
1353 }
1354 }
1355 $session->param('number',$borrowernumber);
1356 $session->param('id',$userid);
1357 $session->param('cardnumber',$cardnumber);
1358 $session->param('firstname',$firstname);
1359 $session->param('surname',$surname);
1360 $session->param('branch',$branchcode);
1361 $session->param('branchname',$branchname);
1362 $session->param('flags',$userflags);
1363 $session->param('emailaddress',$emailaddress);
1364 $session->param('ip',$session->remote_addr());
1365 $session->param('lasttime',time());
1366 } elsif ( $return == 2 ) {
1367 #We suppose the user is the superlibrarian
1368 $session->param('number',0);
1369 $session->param('id',C4::Context->config('user'));
1370 $session->param('cardnumber',C4::Context->config('user'));
1371 $session->param('firstname',C4::Context->config('user'));
1372 $session->param('surname',C4::Context->config('user'));
1373 $session->param('branch','NO_LIBRARY_SET');
1374 $session->param('branchname','NO_LIBRARY_SET');
1375 $session->param('flags',1);
1376 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
1377 $session->param('ip',$session->remote_addr());
1378 $session->param('lasttime',time());
1379 }
1380 C4::Context::set_userenv(
1381 $session->param('number'), $session->param('id'),
1382 $session->param('cardnumber'), $session->param('firstname'),
1383 $session->param('surname'), $session->param('branch'),
1384 $session->param('branchname'), $session->param('flags'),
1385 $session->param('emailaddress'), $session->param('branchprinter')
1386 );
1387 return ("ok", $cookie, $sessionID);
1388 } else {
1389 return ("failed", undef, undef);
1390 }
1391 }
1392}
1393
1394=head2 check_cookie_auth
1395
- -
1421sub check_cookie_auth {
1422 my $cookie = shift;
1423 my $flagsrequired = shift;
1424
1425 my $dbh = C4::Context->dbh;
1426 my $timeout = _timeout_syspref();
1427
1428 unless (C4::Context->preference('Version')) {
1429 # database has not been installed yet
1430 return ("maintenance", undef);
1431 }
1432 my $kohaversion=C4::Context::KOHAVERSION;
1433 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1434 if (C4::Context->preference('Version') < $kohaversion) {
1435 # database in need of version update; assume that
1436 # no API should be called while databsae is in
1437 # this condition.
1438 return ("maintenance", undef);
1439 }
1440
1441 # FIXME -- most of what follows is a copy-and-paste
1442 # of code from checkauth. There is an obvious need
1443 # for refactoring to separate the various parts of
1444 # the authentication code, but as of 2007-11-23 this
1445 # is deferred so as to not introduce bugs into the
1446 # regular authentication code for Koha 3.0.
1447
1448 # see if we have a valid session cookie already
1449 # however, if a userid parameter is present (i.e., from
1450 # a form submission, assume that any current cookie
1451 # is to be ignored
1452 unless (defined $cookie and $cookie) {
1453 return ("failed", undef);
1454 }
1455 my $sessionID = $cookie;
1456 my $session = get_session($sessionID);
1457 C4::Context->_new_userenv($sessionID);
1458 if ($session) {
1459 C4::Context::set_userenv(
1460 $session->param('number'), $session->param('id'),
1461 $session->param('cardnumber'), $session->param('firstname'),
1462 $session->param('surname'), $session->param('branch'),
1463 $session->param('branchname'), $session->param('flags'),
1464 $session->param('emailaddress'), $session->param('branchprinter')
1465 );
1466
1467 my $ip = $session->param('ip');
1468 my $lasttime = $session->param('lasttime');
1469 my $userid = $session->param('id');
1470 if ( $lasttime < time() - $timeout ) {
1471 # time out
1472 $session->delete();
1473 C4::Context->_unset_userenv($sessionID);
1474 $userid = undef;
1475 $sessionID = undef;
1476 return ("expired", undef);
1477 } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1478 # IP address changed
1479 $session->delete();
1480 C4::Context->_unset_userenv($sessionID);
1481 $userid = undef;
1482 $sessionID = undef;
1483 return ("expired", undef);
1484 } else {
1485 $session->param('lasttime',time());
1486 my $flags = haspermission($userid, $flagsrequired);
1487 if ($flags) {
1488 return ("ok", $sessionID);
1489 } else {
1490 $session->delete();
1491 C4::Context->_unset_userenv($sessionID);
1492 $userid = undef;
1493 $sessionID = undef;
1494 return ("failed", undef);
1495 }
1496 }
1497 } else {
1498 return ("expired", undef);
1499 }
1500}
1501
1502=head2 get_session
1503
- -
1517
# spent 12.2ms (145µs+12.0) within C4::Auth::get_session which was called 3 times, avg 4.05ms/call: # once (61µs+7.81ms) by C4::Auth::checkauth at line 808 # once (43µs+2.33ms) by C4::Auth::get_template_and_user at line 366 # once (41µs+1.86ms) by main::RUNTIME at line 691 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
sub get_session {
151833µs my $sessionID = shift;
1519317µs31.89ms my $storage_method = C4::Context->preference('SessionStorage');
# spent 1.89ms making 3 calls to C4::Context::preference, avg 632µs/call
1520317µs32.85ms my $dbh = C4::Context->dbh;
# spent 2.85ms making 3 calls to C4::Context::dbh, avg 951µs/call
152132µs my $session;
1522366µs37.26ms if ($storage_method eq 'mysql'){
# spent 7.26ms making 3 calls to CGI::Session::new, avg 2.42ms/call
1523 $session = new CGI::Session("driver:MySQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1524 }
1525 elsif ($storage_method eq 'Pg') {
1526 $session = new CGI::Session("driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1527 }
1528 elsif ($storage_method eq 'memcached' && C4::Context->ismemcached){
1529 $session = new CGI::Session("driver:memcached;serializer:yaml;id:md5", $sessionID, { Memcached => C4::Context->memcached } );
1530 }
1531 else {
1532 # catch all defaults to tmp should work on all systems
1533 $session = new CGI::Session("driver:File;serializer:yaml;id:md5", $sessionID, {Directory=>'/tmp'});
1534 }
1535320µs return $session;
1536}
1537
1538sub checkpw {
1539
1540 my ( $dbh, $userid, $password, $query ) = @_;
1541 if ($ldap) {
1542 $debug and print STDERR "## checkpw - checking LDAP\n";
1543 my ($retval,$retcard,$retuserid) = checkpw_ldap(@_); # EXTERNAL AUTH
1544 ($retval) and return ($retval,$retcard,$retuserid);
1545 }
1546
1547 if ($cas && $query && $query->param('ticket')) {
1548 $debug and print STDERR "## checkpw - checking CAS\n";
1549 # In case of a CAS authentication, we use the ticket instead of the password
1550 my $ticket = $query->param('ticket');
1551 my ($retval,$retcard,$retuserid) = checkpw_cas($dbh, $ticket, $query); # EXTERNAL AUTH
1552 ($retval) and return ($retval,$retcard,$retuserid);
1553 return 0;
1554 }
1555
1556 # INTERNAL AUTH
1557 my $sth =
1558 $dbh->prepare(
1559"select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1560 );
1561 $sth->execute($userid);
1562 if ( $sth->rows ) {
1563 my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1564 $surname, $branchcode, $flags )
1565 = $sth->fetchrow;
1566 if ( md5_base64($password) eq $md5password and $md5password ne "!") {
1567
1568 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1569 $firstname, $surname, $branchcode, $flags );
1570 return 1, $cardnumber, $userid;
1571 }
1572 }
1573 $sth =
1574 $dbh->prepare(
1575"select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1576 );
1577 $sth->execute($userid);
1578 if ( $sth->rows ) {
1579 my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1580 $surname, $branchcode, $flags )
1581 = $sth->fetchrow;
1582 if ( md5_base64($password) eq $md5password ) {
1583
1584 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1585 $firstname, $surname, $branchcode, $flags );
1586 return 1, $cardnumber, $userid;
1587 }
1588 }
1589 if ( $userid && $userid eq C4::Context->config('user')
1590 && "$password" eq C4::Context->config('pass') )
1591 {
1592
1593# Koha superuser account
1594# C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1595 return 2;
1596 }
1597 if ( $userid && $userid eq 'demo'
1598 && "$password" eq 'demo'
1599 && C4::Context->config('demo') )
1600 {
1601
1602# DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1603# some features won't be effective : modify systempref, modify MARC structure,
1604 return 2;
1605 }
1606 return 0;
1607}
1608
1609=head2 getuserflags
1610
- -
1621sub getuserflags {
1622 my $flags = shift;
1623 my $userid = shift;
1624 my $dbh = @_ ? shift : C4::Context->dbh;
1625 my $userflags;
1626 {
1627 # I don't want to do this, but if someone logs in as the database
1628 # user, it would be preferable not to spam them to death with
1629 # numeric warnings. So, we make $flags numeric.
16303795µs294µs
# spent 63µs (31+31) within C4::Auth::BEGIN@1630 which was called: # once (31µs+31µs) by main::BEGIN@46 at line 1630
no warnings 'numeric';
# spent 63µs making 1 call to C4::Auth::BEGIN@1630 # spent 31µs making 1 call to warnings::unimport
1631 $flags += 0;
1632 }
1633 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1634 $sth->execute;
1635
1636 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1637 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1638 $userflags->{$flag} = 1;
1639 }
1640 else {
1641 $userflags->{$flag} = 0;
1642 }
1643 }
1644
1645 # get subpermissions and merge with top-level permissions
1646 my $user_subperms = get_user_subpermissions($userid);
1647 foreach my $module (keys %$user_subperms) {
1648 next if $userflags->{$module} == 1; # user already has permission for everything in this module
1649 $userflags->{$module} = $user_subperms->{$module};
1650 }
1651
1652 return $userflags;
1653}
1654
1655=head2 get_user_subpermissions
1656
- -
1680sub get_user_subpermissions {
1681 my $userid = shift;
1682
1683 my $dbh = C4::Context->dbh;
1684 my $sth = $dbh->prepare("SELECT flag, user_permissions.code
1685 FROM user_permissions
1686 JOIN permissions USING (module_bit, code)
1687 JOIN userflags ON (module_bit = bit)
1688 JOIN borrowers USING (borrowernumber)
1689 WHERE userid = ?");
1690 $sth->execute($userid);
1691
1692 my $user_perms = {};
1693 while (my $perm = $sth->fetchrow_hashref) {
1694 $user_perms->{$perm->{'flag'}}->{$perm->{'code'}} = 1;
1695 }
1696 return $user_perms;
1697}
1698
1699=head2 get_all_subpermissions
1700
- -
1711sub get_all_subpermissions {
1712 my $dbh = C4::Context->dbh;
1713 my $sth = $dbh->prepare("SELECT flag, code, description
1714 FROM permissions
1715 JOIN userflags ON (module_bit = bit)");
1716 $sth->execute();
1717
1718 my $all_perms = {};
1719 while (my $perm = $sth->fetchrow_hashref) {
1720 $all_perms->{$perm->{'flag'}}->{$perm->{'code'}} = $perm->{'description'};
1721 }
1722 return $all_perms;
1723}
1724
1725=head2 haspermission
1726
- -
1736sub haspermission {
1737 my ($userid, $flagsrequired) = @_;
1738 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1739 $sth->execute($userid);
1740 my $flags = getuserflags($sth->fetchrow(), $userid);
1741 if ( $userid eq C4::Context->config('user') ) {
1742 # Super User Account from /etc/koha.conf
1743 $flags->{'superlibrarian'} = 1;
1744 }
1745 elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
1746 # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1747 $flags->{'superlibrarian'} = 1;
1748 }
1749
1750 return $flags if $flags->{superlibrarian};
1751
1752 foreach my $module ( keys %$flagsrequired ) {
1753 my $subperm = $flagsrequired->{$module};
1754 if ($subperm eq '*') {
1755 return 0 unless ( $flags->{$module} == 1 or ref($flags->{$module}) );
1756 } else {
1757 return 0 unless ( $flags->{$module} == 1 or
1758 ( ref($flags->{$module}) and
1759 exists $flags->{$module}->{$subperm} and
1760 $flags->{$module}->{$subperm} == 1
1761 )
1762 );
1763 }
1764 }
1765 return $flags;
1766 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1767}
1768
1769
1770sub getborrowernumber {
1771 my ($userid) = @_;
1772 my $userenv = C4::Context->userenv;
1773 if ( defined( $userenv ) && ref( $userenv ) eq 'HASH' && $userenv->{number} ) {
1774 return $userenv->{number};
1775 }
1776 my $dbh = C4::Context->dbh;
1777 for my $field ( 'userid', 'cardnumber' ) {
1778 my $sth =
1779 $dbh->prepare("select borrowernumber from borrowers where $field=?");
1780 $sth->execute($userid);
1781 if ( $sth->rows ) {
1782 my ($bnumber) = $sth->fetchrow;
1783 return $bnumber;
1784 }
1785 }
1786 return 0;
1787}
1788
1789
# spent 181µs (26+155) within C4::Auth::ParseSearchHistoryCookie which was called 2 times, avg 90µs/call: # once (13µs+78µs) by main::RUNTIME at line 625 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl # once (13µs+77µs) by C4::Auth::get_template_and_user at line 291
sub ParseSearchHistoryCookie {
179022µs my $input = shift;
1791213µs2155µs my $search_cookie = $input->cookie('KohaOpacRecentSearches');
# spent 155µs making 2 calls to CGI::cookie, avg 77µs/call
1792211µs return () unless $search_cookie;
1793 my $obj = eval { decode_json(uri_unescape($search_cookie)) };
1794 return () unless defined $obj;
1795 return () unless ref $obj eq 'ARRAY';
1796 return @{ $obj };
1797}
1798
1799110µs
# spent 7µs within C4::Auth::END which was called: # once (7µs+0s) by main::RUNTIME at line 0 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
END { } # module clean-up code here (global destructor)
1800114µs1;
1801__END__
 
# spent 30µs within C4::Auth::CORE:match which was called 4 times, avg 8µs/call: # 2 times (17µs+0s) by C4::Auth::get_template_and_user at line 365, avg 8µs/call # once (11µs+0s) by C4::Auth::_timeout_syspref at line 598 # once (3µs+0s) by C4::Auth::get_template_and_user at line 140
sub C4::Auth::CORE:match; # opcode
# spent 16µs within C4::Auth::CORE:subst which was called 3 times, avg 5µs/call: # once (8µs+0s) by C4::Auth::_version_check at line 573 # once (5µs+0s) by C4::Auth::get_template_and_user at line 362 # once (2µs+0s) by C4::Auth::get_template_and_user at line 363
sub C4::Auth::CORE:subst; # opcode
# spent 3µs within C4::Auth::CORE:substcont which was called 2 times, avg 2µs/call: # 2 times (3µs+0s) by C4::Auth::_version_check at line 573, avg 2µs/call
sub C4::Auth::CORE:substcont; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.