← 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 11:58:52 2013
Reported on Tue Oct 15 12:01:04 2013

Filename/usr/share/koha/lib/C4/Auth.pm
StatementsExecuted 160 statements in 13.5ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1115.45ms876msC4::Auth::::BEGIN@39C4::Auth::BEGIN@39
1113.87ms4.33msC4::Auth::::BEGIN@25C4::Auth::BEGIN@25
1113.16ms4.00msC4::Auth::::BEGIN@31C4::Auth::BEGIN@31
1112.21ms2.78msC4::Auth::::BEGIN@30C4::Auth::BEGIN@30
1111.78ms19.3msC4::Auth::::BEGIN@23C4::Auth::BEGIN@23
1111.32ms361msC4::Auth::::get_template_and_userC4::Auth::get_template_and_user
111914µs1.41msC4::Auth::::BEGIN@22C4::Auth::BEGIN@22
111850µs34.4msC4::Auth::::BEGIN@34C4::Auth::BEGIN@34
111298µs28.6msC4::Auth::::checkauthC4::Auth::checkauth
332171µs15.0msC4::Auth::::get_sessionC4::Auth::get_session
11179µs4.42msC4::Auth::::_version_checkC4::Auth::_version_check
22241µs304µsC4::Auth::::ParseSearchHistoryCookieC4::Auth::ParseSearchHistoryCookie
11140µs76µsC4::Auth::::BEGIN@1631C4::Auth::BEGIN@1631
43129µs29µsC4::Auth::::CORE:matchC4::Auth::CORE:match (opcode)
11126µs2.00msC4::Auth::::_timeout_sysprefC4::Auth::_timeout_syspref
11122µs28µsC4::Auth::::BEGIN@20C4::Auth::BEGIN@20
11120µs24µsC4::Auth::::BEGIN@28C4::Auth::BEGIN@28
33117µs17µsC4::Auth::::CORE:substC4::Auth::CORE:subst (opcode)
11116µs50µsC4::Auth::::BEGIN@33C4::Auth::BEGIN@33
11116µs83µsC4::Auth::::BEGIN@24C4::Auth::BEGIN@24
11116µs81µsC4::Auth::::BEGIN@32C4::Auth::BEGIN@32
11115µs28µsC4::Auth::::BEGIN@29C4::Auth::BEGIN@29
11114µs36µsC4::Auth::::BEGIN@21C4::Auth::BEGIN@21
11112µs135µsC4::Auth::::BEGIN@37C4::Auth::BEGIN@37
1115µs5µsC4::Auth::::ENDC4::Auth::END
2114µs4µ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
20333µs234µs
# spent 28µs (22+6) within C4::Auth::BEGIN@20 which was called: # once (22µs+6µs) by main::BEGIN@46 at line 20
use strict;
# spent 28µs making 1 call to C4::Auth::BEGIN@20 # spent 6µs making 1 call to strict::import
21333µs259µs
# spent 36µs (14+22) within C4::Auth::BEGIN@21 which was called: # once (14µs+22µs) by main::BEGIN@46 at line 21
use warnings;
# spent 36µs making 1 call to C4::Auth::BEGIN@21 # spent 22µs making 1 call to warnings::import
223196µs21.47ms
# spent 1.41ms (914µs+491µs) within C4::Auth::BEGIN@22 which was called: # once (914µs+491µ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 67µs making 1 call to Exporter::import
233140µs219.6ms
# spent 19.3ms (1.78+17.5) within C4::Auth::BEGIN@23 which was called: # once (1.78ms+17.5ms) by main::BEGIN@46 at line 23
use JSON qw/encode_json decode_json/;
# spent 19.3ms making 1 call to C4::Auth::BEGIN@23 # spent 276µs making 1 call to JSON::import
24337µs2150µs
# spent 83µs (16+67) within C4::Auth::BEGIN@24 which was called: # once (16µs+67µs) by main::BEGIN@46 at line 24
use URI::Escape;
# spent 83µs making 1 call to C4::Auth::BEGIN@24 # spent 67µs making 1 call to Exporter::import
253181µs24.34ms
# spent 4.33ms (3.87+464µs) within C4::Auth::BEGIN@25 which was called: # once (3.87ms+464µs) by main::BEGIN@46 at line 25
use CGI::Session;
# spent 4.33ms making 1 call to C4::Auth::BEGIN@25 # spent 9µs making 1 call to CGI::Session::import
26
2712µsrequire Exporter;
28335µs229µs
# spent 24µs (20+5) within C4::Auth::BEGIN@28 which was called: # once (20µs+5µs) by main::BEGIN@46 at line 28
use C4::Context;
# spent 24µs making 1 call to C4::Auth::BEGIN@28 # spent 4µs making 1 call to C4::Context::import
29333µs240µs
# spent 28µs (15+12) within C4::Auth::BEGIN@29 which was called: # once (15µs+12µs) by main::BEGIN@46 at line 29
use C4::Templates; # to get the template
# spent 28µs making 1 call to C4::Auth::BEGIN@29 # spent 12µs making 1 call to Class::Accessor::import
303191µs23.11ms
# spent 2.78ms (2.21+573µs) within C4::Auth::BEGIN@30 which was called: # once (2.21ms+573µs) by main::BEGIN@46 at line 30
use C4::Branch; # GetBranches
# spent 2.78ms making 1 call to C4::Auth::BEGIN@30 # spent 328µs making 1 call to Exporter::import
313163µs24.25ms
# spent 4.00ms (3.16+847µs) within C4::Auth::BEGIN@31 which was called: # once (3.16ms+847µs) by main::BEGIN@46 at line 31
use C4::VirtualShelves;
# spent 4.00ms making 1 call to C4::Auth::BEGIN@31 # spent 247µs making 1 call to Exporter::import
32340µs2146µs
# spent 81µs (16+65) within C4::Auth::BEGIN@32 which was called: # once (16µs+65µs) by main::BEGIN@46 at line 32
use POSIX qw/strftime/;
# spent 81µs making 1 call to C4::Auth::BEGIN@32 # spent 66µs making 1 call to POSIX::import
33337µs284µs
# spent 50µs (16+34) within C4::Auth::BEGIN@33 which was called: # once (16µs+34µs) by main::BEGIN@46 at line 33
use List::MoreUtils qw/ any /;
# spent 50µs making 1 call to C4::Auth::BEGIN@33 # spent 34µs making 1 call to Exporter::import
343203µs234.7ms
# spent 34.4ms (850µs+33.5) within C4::Auth::BEGIN@34 which was called: # once (850µs+33.5ms) by main::BEGIN@46 at line 34
use LWP::Simple qw(get $ua);
# spent 34.4ms making 1 call to C4::Auth::BEGIN@34 # spent 354µs making 1 call to LWP::Simple::import
35
36# use utf8;
373230µs2258µs
# spent 135µs (12+123) within C4::Auth::BEGIN@37 which was called: # once (12µs+123µs) by main::BEGIN@46 at line 37
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout);
# spent 135µs making 1 call to C4::Auth::BEGIN@37 # spent 123µs making 1 call to vars::import
38
39
# spent 876ms (5.45+871) within C4::Auth::BEGIN@39 which was called: # once (5.45ms+871ms) 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 }
4514415µs $VERSION = 3.08.01.002; # set version for version checking
46 $debug = $ENV{DEBUG};
47 @ISA = qw(Exporter);
48 @EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
49 @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &get_all_subpermissions &get_user_subpermissions
50 ParseSearchHistoryCookie
51 );
52 %EXPORT_TAGS = ( EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)] );
53122µs $ldap = C4::Context->config('useldapserver') || 0;
# spent 22µs making 1 call to C4::Context::config
54155.8ms $cas = C4::Context->preference('casAuthentication');
# spent 55.8ms making 1 call to C4::Context::preference
5512.33ms $caslogout = C4::Context->preference('casLogout');
# spent 2.33ms making 1 call to C4::Context::preference
56176µs145µs require C4::Auth_with_cas; # no import
# spent 45µs making 1 call to C4::Context::AUTOLOAD
57 if ($ldap) {
58168µs142µs require C4::Auth_with_ldap;
# spent 42µs making 1 call to C4::Context::AUTOLOAD
59185µs import C4::Auth_with_ldap qw(checkpw_ldap);
# spent 85µs making 1 call to Exporter::import
60 }
61 if ($cas) {
62 import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url);
63 }
64
6518.96ms1876ms}
# spent 876ms making 1 call to C4::Auth::BEGIN@39
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 361ms (1.32+359) within C4::Auth::get_template_and_user which was called: # once (1.32ms+359ms) by main::RUNTIME at line 116 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
sub get_template_and_user {
136291.05ms my $in = shift;
1371129ms my $template =
# spent 129ms making 1 call to C4::Templates::gettemplate
138 C4::Templates::gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'}, $in->{'is_plugin'} );
139 my ( $user, $cookie, $sessionID, $flags );
140228.6ms if ( $in->{'template_name'} !~m/maintenance/ ) {
# spent 28.6ms making 1 call to C4::Auth::checkauth # spent 4µ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
149 my $borrowernumber;
150 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
280119µs $template->param( sessionID => $sessionID );
# spent 19µs making 1 call to C4::Templates::param
281
28212.43ms my ($total, $pubshelves) = C4::VirtualShelves::GetSomeShelfNames(undef, 'MASTHEAD');
# spent 2.43ms making 1 call to C4::VirtualShelves::GetSomeShelfNames
283117µs $template->param(
# spent 17µ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
29012.25ms if (C4::Context->preference('EnableOpacSearchHistory')) {
# spent 2.25ms making 1 call to C4::Context::preference
2911136µs my @recentSearches = ParseSearchHistoryCookie($in->{'query'});
# spent 136µs making 1 call to C4::Auth::ParseSearchHistoryCookie
292 if (@recentSearches) {
293 $template->param(ShowOpacRecentSearchLink => 1);
294 }
295 }
296
29732.06ms if(C4::Context->preference('dateformat')){
# spent 2.04ms making 2 calls to C4::Context::preference, avg 1.02ms/call # spent 18µ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(
3032233.4ms "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
# spent 33.0ms making 15 calls to C4::Context::preference, avg 2.20ms/call # spent 285µs making 1 call to CGI::AUTOLOAD # spent 126µs making 1 call to C4::Templates::param # spent 31µs making 5 calls to C4::Context::userenv, avg 6µ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 );
325 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 {
359 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
36111.95ms my $LibraryNameTitle = C4::Context->preference("LibraryName");
# spent 1.95ms making 1 call to C4::Context::preference
36214µs $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
# spent 4µs making 1 call to C4::Auth::CORE:subst
36312µ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
365134µs66.27ms if (C4::Context->preference("OpacBrowseResults") && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ && $1 !~ /^(?:MARC|ISBD)?detail$/) {
# spent 3.44ms making 1 call to CGI::Session::DESTROY # spent 1.87ms making 1 call to C4::Context::preference # spent 932µs making 1 call to CGI::Session::Driver::DBI::DESTROY # spent 20µs making 2 calls to C4::Auth::CORE:match, avg 10µs/call # spent 5µs making 1 call to CGI::DESTROY
36622.30ms my $sessionSearch = get_session($sessionID || $in->{'query'}->cookie("CGISESSID"));
# spent 2.19ms making 1 call to C4::Auth::get_session # spent 114µs making 1 call to CGI::cookie
367123µs $sessionSearch->clear(["busc"]) if ($sessionSearch->param("busc"));
# spent 23µs making 1 call to CGI::Session::param
368 }
369 # variables passed from CGI: opac_css_override and opac_search_limits.
370 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
371 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
372 my $opac_name = '';
37332.36ms if (($opac_search_limit && $opac_search_limit =~ /branch:(\w+)/ && $opac_limit_override) || ($in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:(\w+)/)){
# spent 2.32ms making 1 call to C4::Context::preference # spent 33µs making 2 calls to CGI::param, avg 16µ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(
38178148ms opaccolorstylesheet => C4::Context->preference("opaccolorstylesheet"),
# spent 132ms making 69 calls to C4::Context::preference, avg 1.92ms/call # spent 13.4ms making 1 call to C4::Branch::GetBranchesLoop # spent 2.05ms making 1 call to C4::Branch::GetBranchCategories # spent 290µs making 1 call to C4::Templates::param # spent 84µs making 2 calls to CGI::https, avg 42µs/call # spent 14µs making 2 calls to DBI::common::DESTROY, avg 7µs/call # spent 8µs making 1 call to C4::Context::userenv # spent 3µ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
461217µs $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic"));
# spent 11µs making 1 call to C4::Context::preference # spent 7µs making 1 call to C4::Templates::param
462 }
463 return ( $template, $borrowernumber, $cookie, $flags);
464}
465
466=head2 checkauth
467
- -
544
# spent 4.42ms (79µs+4.34) within C4::Auth::_version_check which was called: # once (79µs+4.34ms) by C4::Auth::checkauth at line 617
sub _version_check {
545983µs my $type = shift;
546 my $query = shift;
547 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
55111.83ms if (C4::Context->preference('OpacMaintenance') && $type eq 'opac') {
# spent 1.83ms 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 }
55611.99ms unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
# spent 1.99ms 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
5711517µs my $kohaversion=C4::Context::KOHAVERSION;
# spent 517µs making 1 call to C4::Context::KOHAVERSION
572 # remove the 3 last . to have a Perl number
573315µs $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
# spent 11µs making 1 call to C4::Auth::CORE:subst # spent 4µs making 2 calls to C4::Auth::CORE:substcont, avg 2µs/call
574 $debug and print STDERR "kohaversion : $kohaversion\n";
575 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.00ms (26µs+1.97) within C4::Auth::_timeout_syspref which was called: # once (26µs+1.97ms) by C4::Auth::checkauth at line 615
sub _timeout_syspref {
596328µs11.97ms my $timeout = C4::Context->preference('timeout') || 600;
# spent 1.97ms making 1 call to C4::Context::preference
597 # value in days, convert in seconds
59815µs if ($timeout =~ /(\d+)[dD]/) {
# spent 5µs making 1 call to C4::Auth::CORE:match
599 $timeout = $1 * 86400;
600 };
601 return $timeout;
602}
603
604
# spent 28.6ms (298µs+28.3) within C4::Auth::checkauth which was called: # once (298µs+28.3ms) by C4::Auth::get_template_and_user at line 140
sub checkauth {
60532181µs my $query = shift;
606 $debug and warn "Checking Auth";
607 # $authnotrequired will be set for scripts which will run without authentication
608 my $authnotrequired = shift;
609 my $flagsrequired = shift;
610 my $type = shift;
611 my $persona = shift;
612 $type = 'opac' unless $type;
613
6141805µs my $dbh = C4::Context->dbh;
# spent 805µs making 1 call to C4::Context::dbh
61512.00ms my $timeout = _timeout_syspref();
# spent 2.00ms making 1 call to C4::Auth::_timeout_syspref
616 my $loggedin = 0;
61714.42ms _version_check($type,$query);
# spent 4.42ms making 1 call to C4::Auth::_version_check
618
619 # state variables
620 my %info;
621 my ( $userid, $cookie, $sessionID, $flags, $barshelves, $pubshelves );
622
623
624 # Drupal stuffs
62512.25ms if ( C4::Context->preference('DrupalAuth') && $type eq 'opac' ) {
# spent 2.25ms making 1 call to C4::Context::preference
626 require XML::Simple;
627 import XML::Simple;
628 my $url = C4::Context->preference('DrupalUrl');
629 my $currenturl = $query->url(-query=>1);
630 my @cookies = $query->cookie();
631 my $drupalcookie;
632
633 foreach my $cookie (@cookies) {
634 # Drupal cookies start with 'SSESS' for secure, or just SESS for
635 # normal.
636 if ( $cookie =~ /^S?SESS.*/ ) {
637 $drupalcookie = $query->cookie($cookie);
638 }
639 }
640 $ua->agent('Koha_session_check');
641 my $content = get("$url/koha-auth/$drupalcookie");
642 my $drupalinfo;
643 eval { $drupalinfo = XMLin($content); };
644
645 if ($@) {
646 print $query->redirect("$url/user/?referer=$currenturl");
647 exit;
648 }
649 elsif ( $drupalinfo->{'username'} ) {
650
651 # checkusername exists
652 $loggedin = 1;
653 $userid = $drupalinfo->{'username'};
654 $sessionID = $query->cookie("CGISESSID");
655 my $session;
656 if ( !$sessionID ) {
657 $session = get_session("")
658 or die "Auth ERROR: Cannot get_session()";
659 $sessionID = $session->id;
660 C4::Context->_new_userenv($sessionID);
661 $cookie = $query->cookie( CGISESSID => $sessionID );
662 }
663 else {
664 $session = get_session($sessionID);
665 }
666 if ( $query->param('logout.x') ) {
667 $session->flush;
668 $session->delete();
669 C4::Context->_unset_userenv($sessionID);
670
671 $sessionID = undef;
672 $userid = undef;
673 $cookie = $query->cookie( CGISESSID => '' );
674 print $query->redirect(-uri => "$url/user/logout/",
675 -cookie => $cookie);
676 exit;
677 }
678 else {
679 my $select = "SELECT borrowernumber
680 FROM borrowers WHERE userid = ?";
681 my $sth = $dbh->prepare($select);
682 $sth->execute($userid);
683 my ($borrowernumber) = $sth->fetchrow();
684 $session->param( 'number', $borrowernumber );
685 $session->param( 'lasttime', time() );
686 $session->param( 'ip', $session->remote_addr() );
687
688 return ( $userid, $cookie, $sessionID, $flags );
689 }
690 }
691 else {
692 print $query->redirect("$url/user/?referer=$currenturl");
693 exit;
694 }
695 } #end drupal stuffs
696
697
698 # state variables
699 my %info;
700133µs my $logout = $query->param('logout.x');
# spent 33µs making 1 call to CGI::param
701
702 # This parameter is the name of the CAS server we want to authenticate against,
703 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
704113µs my $casparam = $query->param('cas');
# spent 13µs making 1 call to CGI::param
705
706 # If you have httpauth protecting the OPAC from unwanted users, this
707 # will just make everything get upset, so it's turned off until it
708 # can be fixed properly.
709185µs if ( 0 && ($userid = $ENV{'REMOTE_USER'}) ) {
# spent 85µs making 1 call to CGI::cookie
710 # Using Basic Authentication, no cookies required
711 $cookie = $query->cookie(
712 -name => 'CGISESSID',
713 -value => '',
714 -expires => '',
715 -HttpOnly => 1,
716 );
717 $loggedin = 1;
718 }
719 elsif ( $persona ){
720 # we dont want to set a session because we are being called by a persona callback
721 }
722 elsif ( $sessionID = $query->cookie("CGISESSID") )
723 { # assignment, not comparison
724 my $session = get_session($sessionID);
725 C4::Context->_new_userenv($sessionID);
726 my ($ip, $lasttime, $sessiontype);
727 if ($session){
728 C4::Context::set_userenv(
729 $session->param('number'), $session->param('id'),
730 $session->param('cardnumber'), $session->param('firstname'),
731 $session->param('surname'), $session->param('branch'),
732 $session->param('branchname'), $session->param('flags'),
733 $session->param('emailaddress'), $session->param('branchprinter'),
734 $session->param('persona')
735 );
736 C4::Context::set_shelves_userenv('bar',$session->param('barshelves'));
737 C4::Context::set_shelves_userenv('pub',$session->param('pubshelves'));
738 C4::Context::set_shelves_userenv('tot',$session->param('totshelves'));
739 $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
740 $ip = $session->param('ip');
741 $lasttime = $session->param('lasttime');
742 $userid = $session->param('id');
743 $sessiontype = $session->param('sessiontype') || '';
744 }
745 if ( ( ($query->param('koha_login_context')) && ($query->param('userid') ne $session->param('id')) )
746 || ( $cas && $query->param('ticket') ) ) {
747 #if a user enters an id ne to the id in the current session, we need to log them in...
748 #first we need to clear the anonymous session...
749 $debug and warn "query id = " . $query->param('userid') . " but session id = " . $session->param('id');
750 $session->flush;
751 $session->delete();
752 C4::Context->_unset_userenv($sessionID);
753 $sessionID = undef;
754 $userid = undef;
755 }
756 elsif ($logout) {
757 # voluntary logout the user
758 $session->flush;
759 $session->delete();
760 C4::Context->_unset_userenv($sessionID);
761 #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
762 $sessionID = undef;
763 $userid = undef;
764
765 if ($cas and $caslogout) {
766 logout_cas($query);
767 }
768 }
769 elsif ( $lasttime < time() - $timeout ) {
770 # timed logout
771 $info{'timed_out'} = 1;
772 $session->delete() if $session;
773 C4::Context->_unset_userenv($sessionID);
774 #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
775 $userid = undef;
776 $sessionID = undef;
777 }
778 elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
779 # Different ip than originally logged in from
780 $info{'oldip'} = $ip;
781 $info{'newip'} = $ENV{'REMOTE_ADDR'};
782 $info{'different_ip'} = 1;
783 $session->delete();
784 C4::Context->_unset_userenv($sessionID);
785 #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
786 $sessionID = undef;
787 $userid = undef;
788 }
789 else {
790 $cookie = $query->cookie(
791 -name => 'CGISESSID',
792 -value => $session->id,
793 -HttpOnly => 1
794 );
795 $session->param( 'lasttime', time() );
796 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...
797 $flags = haspermission($userid, $flagsrequired);
798 if ($flags) {
799 $loggedin = 1;
800 } else {
801 $info{'nopermission'} = 1;
802 }
803 }
804 }
805 }
806140µs25.22ms unless ($userid || $sessionID) {
# spent 4.27ms making 1 call to CGI::Session::DESTROY # spent 949µs making 1 call to CGI::Session::Driver::DBI::DESTROY
807
808 #we initiate a session prior to checking for a username to allow for anonymous sessions...
809110.2ms my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
# spent 10.2ms making 1 call to C4::Auth::get_session
810131µs my $sessionID = $session->id;
# spent 31µs making 1 call to CGI::Session::id
811112µs C4::Context->_new_userenv($sessionID);
# spent 12µs making 1 call to C4::Context::_new_userenv
8122452µs $cookie = $query->cookie(
# spent 437µs making 1 call to CGI::cookie # spent 16µs making 1 call to CGI::Session::id
813 -name => 'CGISESSID',
814 -value => $session->id,
815 -HttpOnly => 1
816 );
817135µs $userid = $query->param('userid');
# spent 35µs making 1 call to CGI::param
81812.31ms if ( ( $cas && $query->param('ticket') )
# spent 2.31ms making 1 call to C4::Context::preference
819 || $userid
820 || ( my $pki_field = C4::Context->preference('AllowPKIAuth') ) ne
821 'None' || $persona )
822 {
823 my $password = $query->param('password');
824
825 my ( $return, $cardnumber );
826 if ( $cas && $query->param('ticket') ) {
827 my $retuserid;
828 ( $return, $cardnumber, $retuserid ) =
829 checkpw( $dbh, $userid, $password, $query );
830 $userid = $retuserid;
831 $info{'invalidCasLogin'} = 1 unless ($return);
832 }
833
834 elsif ($persona) {
835 my $value = $persona;
836
837 # If we're looking up the email, there's a chance that the person
838 # doesn't have a userid. So if there is none, we pass along the
839 # borrower number, and the bits of code that need to know the user
840 # ID will have to be smart enough to handle that.
841 require C4::Members;
842 my @users_info = C4::Members::GetBorrowersWithEmail($value);
843 if (@users_info) {
844
845 # First the userid, then the borrowernum
846 $value = $users_info[0][1] || $users_info[0][0];
847 }
848 else {
849 undef $value;
850 }
851 $return = $value ? 1 : 0;
852 $userid = $value;
853 }
854
855 elsif (
856 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
857 || ( $pki_field eq 'emailAddress'
858 && $ENV{'SSL_CLIENT_S_DN_Email'} )
859 )
860 {
861 my $value;
862 if ( $pki_field eq 'Common Name' ) {
863 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
864 }
865 elsif ( $pki_field eq 'emailAddress' ) {
866 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
867
868 # If we're looking up the email, there's a chance that the person
869 # doesn't have a userid. So if there is none, we pass along the
870 # borrower number, and the bits of code that need to know the user
871 # ID will have to be smart enough to handle that.
872 require C4::Members;
873 my @users_info = C4::Members::GetBorrowersWithEmail($value);
874 if (@users_info) {
875
876 # First the userid, then the borrowernum
877 $value = $users_info[0][1] || $users_info[0][0];
878 } else {
879 undef $value;
880 }
881 }
882
883
884 $return = $value ? 1 : 0;
885 $userid = $value;
886
887 }
888 else {
889 my $retuserid;
890 ( $return, $cardnumber, $retuserid ) =
891 checkpw( $dbh, $userid, $password, $query );
892 $userid = $retuserid if ( $retuserid ne '' );
893 }
894 if ($return) {
895 #_session_log(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
896 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
897 $loggedin = 1;
898 }
899 else {
900 $info{'nopermission'} = 1;
901 C4::Context->_unset_userenv($sessionID);
902 }
903 my ($borrowernumber, $firstname, $surname, $userflags,
904 $branchcode, $branchname, $branchprinter, $emailaddress);
905
906 if ( $return == 1 ) {
907 my $select = "
908 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
909 branches.branchname as branchname,
910 branches.branchprinter as branchprinter,
911 email
912 FROM borrowers
913 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
914 ";
915 my $sth = $dbh->prepare("$select where userid=?");
916 $sth->execute($userid);
917 unless ($sth->rows) {
918 $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
919 $sth = $dbh->prepare("$select where cardnumber=?");
920 $sth->execute($cardnumber);
921
922 unless ($sth->rows) {
923 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
924 $sth->execute($userid);
925 unless ($sth->rows) {
926 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
927 }
928 }
929 }
930 if ($sth->rows) {
931 ($borrowernumber, $firstname, $surname, $userflags,
932 $branchcode, $branchname, $branchprinter, $emailaddress) = $sth->fetchrow;
933 $debug and print STDERR "AUTH_3 results: " .
934 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
935 } else {
936 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
937 }
938
939# launch a sequence to check if we have a ip for the branch, i
940# if we have one we replace the branchcode of the userenv by the branch bound in the ip.
941
942 my $ip = $ENV{'REMOTE_ADDR'};
943 # if they specify at login, use that
944 if ($query->param('branch')) {
945 $branchcode = $query->param('branch');
946 $branchname = GetBranchName($branchcode);
947 }
948 my $branches = GetBranches();
949 if (C4::Context->boolean_preference('IndependantBranches') && C4::Context->boolean_preference('Autolocation')){
950 # we have to check they are coming from the right ip range
951 my $domain = $branches->{$branchcode}->{'branchip'};
952 if ($ip !~ /^$domain/){
953 $loggedin=0;
954 $info{'wrongip'} = 1;
955 }
956 }
957
958 my @branchesloop;
959 foreach my $br ( keys %$branches ) {
960 # now we work with the treatment of ip
961 my $domain = $branches->{$br}->{'branchip'};
962 if ( $domain && $ip =~ /^$domain/ ) {
963 $branchcode = $branches->{$br}->{'branchcode'};
964
965 # new op dev : add the branchprinter and branchname in the cookie
966 $branchprinter = $branches->{$br}->{'branchprinter'};
967 $branchname = $branches->{$br}->{'branchname'};
968 }
969 }
970 $session->param('number',$borrowernumber);
971 $session->param('id',$userid);
972 $session->param('cardnumber',$cardnumber);
973 $session->param('firstname',$firstname);
974 $session->param('surname',$surname);
975 $session->param('branch',$branchcode);
976 $session->param('branchname',$branchname);
977 $session->param('flags',$userflags);
978 $session->param('emailaddress',$emailaddress);
979 $session->param('ip',$session->remote_addr());
980 $session->param('lasttime',time());
981 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
982 }
983 elsif ( $return == 2 ) {
984 #We suppose the user is the superlibrarian
985 $borrowernumber = 0;
986 $session->param('number',0);
987 $session->param('id',C4::Context->config('user'));
988 $session->param('cardnumber',C4::Context->config('user'));
989 $session->param('firstname',C4::Context->config('user'));
990 $session->param('surname',C4::Context->config('user'));
991 $session->param('branch','NO_LIBRARY_SET');
992 $session->param('branchname','NO_LIBRARY_SET');
993 $session->param('flags',1);
994 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
995 $session->param('ip',$session->remote_addr());
996 $session->param('lasttime',time());
997 }
998 if ($persona){
999 $session->param('persona',1);
1000 }
1001 C4::Context::set_userenv(
1002 $session->param('number'), $session->param('id'),
1003 $session->param('cardnumber'), $session->param('firstname'),
1004 $session->param('surname'), $session->param('branch'),
1005 $session->param('branchname'), $session->param('flags'),
1006 $session->param('emailaddress'), $session->param('branchprinter'),
1007 $session->param('persona')
1008 );
1009
1010 }
1011 else {
1012 if ($userid) {
1013 $info{'invalid_username_or_password'} = 1;
1014 C4::Context->_unset_userenv($sessionID);
1015 }
1016 }
1017 } # END if ( $userid = $query->param('userid') )
1018 elsif ($type eq "opac") {
1019 # if we are here this is an anonymous session; add public lists to it and a few other items...
1020 # anonymous sessions are created only for the OPAC
1021 $debug and warn "Initiating an anonymous session...";
1022
1023 # setting a couple of other session vars...
1024288µs $session->param('ip',$session->remote_addr());
# spent 81µs making 1 call to CGI::Session::param # spent 7µs making 1 call to CGI::Session::remote_addr
1025138µs $session->param('lasttime',time());
# spent 38µs making 1 call to CGI::Session::param
1026152µs $session->param('sessiontype','anon');
# spent 52µs making 1 call to CGI::Session::param
1027 }
1028 } # END unless ($userid)
1029
1030 # finished authentification, now respond
1031 if ( $loggedin || $authnotrequired )
1032 {
1033 # successful login
103411µs1243µs unless ($cookie) {
# spent 243µs making 1 call to CGI::Cookie::as_string
1035 $cookie = $query->cookie(
1036 -name => 'CGISESSID',
1037 -value => '',
1038 -HttpOnly => 1
1039 );
1040 }
1041 return ( $userid, $cookie, $sessionID, $flags );
1042 }
1043
1044#
1045#
1046# AUTH rejected, show the login/password template, after checking the DB.
1047#
1048#
1049
1050 # get the inputs from the incoming query
1051 my @inputs = ();
1052 foreach my $name ( param $query) {
1053 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1054 my $value = $query->param($name);
1055 push @inputs, { name => $name, value => $value };
1056 }
1057
1058 my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tmpl' : 'auth.tmpl';
1059 my $template = C4::Templates::gettemplate($template_name, $type, $query );
1060 $template->param(
1061 branchloop => GetBranchesLoop(),
1062 opaccolorstylesheet => C4::Context->preference("opaccolorstylesheet"),
1063 opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
1064 login => 1,
1065 INPUTS => \@inputs,
1066 casAuthentication => C4::Context->preference("casAuthentication"),
1067 suggestion => C4::Context->preference("suggestion"),
1068 virtualshelves => C4::Context->preference("virtualshelves"),
1069 LibraryName => C4::Context->preference("LibraryName"),
1070
1071 opacuserlogin => C4::Context->preference("opacuserlogin"),
1072 OpacNav => C4::Context->preference("OpacNav"),
1073 OpacNavRight => C4::Context->preference("OpacNavRight"),
1074 OpacNavBottom => C4::Context->preference("OpacNavBottom"),
1075 opaccredits => C4::Context->preference("opaccredits"),
1076 OpacFavicon => C4::Context->preference("OpacFavicon"),
1077 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1078 opacsmallimage => C4::Context->preference("opacsmallimage"),
1079 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1080 opacuserjs => C4::Context->preference("opacuserjs"),
1081 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1082 OpacCloud => C4::Context->preference("OpacCloud"),
1083 OpacTopissue => C4::Context->preference("OpacTopissue"),
1084 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1085 OpacBrowser => C4::Context->preference("OpacBrowser"),
1086 opacheader => C4::Context->preference("opacheader"),
1087 TagsEnabled => C4::Context->preference("TagsEnabled"),
1088 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1089 opacstylesheet => C4::Context->preference("opacstylesheet"),
1090 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1091 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1092 intranetbookbag => C4::Context->preference("intranetbookbag"),
1093 IntranetNav => C4::Context->preference("IntranetNav"),
1094 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1095 intranetuserjs => C4::Context->preference("intranetuserjs"),
1096 IndependantBranches=> C4::Context->preference("IndependantBranches"),
1097 AutoLocation => C4::Context->preference("AutoLocation"),
1098 wrongip => $info{'wrongip'},
1099 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1100 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1101 persona => C4::Context->preference("Persona"),
1102 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1103 );
1104
1105 $template->param( OpacPublic => C4::Context->preference("OpacPublic"));
1106 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1107
1108 if ($cas) {
1109
1110 # Is authentication against multiple CAS servers enabled?
1111 if (C4::Auth_with_cas::multipleAuth && !$casparam) {
1112 my $casservers = C4::Auth_with_cas::getMultipleAuth();
1113 my @tmplservers;
1114 foreach my $key (keys %$casservers) {
1115 push @tmplservers, {name => $key, value => login_cas_url($query, $key) . "?cas=$key" };
1116 }
1117 $template->param(
1118 casServersLoop => \@tmplservers
1119 );
1120 } else {
1121 $template->param(
1122 casServerUrl => login_cas_url($query),
1123 );
1124 }
1125
1126 $template->param(
1127 invalidCasLogin => $info{'invalidCasLogin'}
1128 );
1129 }
1130
1131 my $self_url = $query->url( -absolute => 1 );
1132 $template->param(
1133 url => $self_url,
1134 LibraryName => C4::Context->preference("LibraryName"),
1135 );
1136 $template->param( %info );
1137# $cookie = $query->cookie(CGISESSID => $session->id
1138# );
1139 print $query->header(
1140 -type => 'text/html',
1141 -charset => 'utf-8',
1142 -cookie => $cookie
1143 ),
1144 $template->output;
1145 safe_exit;
1146}
1147
1148=head2 check_api_auth
1149
- -
1182sub check_api_auth {
1183 my $query = shift;
1184 my $flagsrequired = shift;
1185
1186 my $dbh = C4::Context->dbh;
1187 my $timeout = _timeout_syspref();
1188
1189 unless (C4::Context->preference('Version')) {
1190 # database has not been installed yet
1191 return ("maintenance", undef, undef);
1192 }
1193 my $kohaversion=C4::Context::KOHAVERSION;
1194 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1195 if (C4::Context->preference('Version') < $kohaversion) {
1196 # database in need of version update; assume that
1197 # no API should be called while databsae is in
1198 # this condition.
1199 return ("maintenance", undef, undef);
1200 }
1201
1202 # FIXME -- most of what follows is a copy-and-paste
1203 # of code from checkauth. There is an obvious need
1204 # for refactoring to separate the various parts of
1205 # the authentication code, but as of 2007-11-19 this
1206 # is deferred so as to not introduce bugs into the
1207 # regular authentication code for Koha 3.0.
1208
1209 # see if we have a valid session cookie already
1210 # however, if a userid parameter is present (i.e., from
1211 # a form submission, assume that any current cookie
1212 # is to be ignored
1213 my $sessionID = undef;
1214 unless ($query->param('userid')) {
1215 $sessionID = $query->cookie("CGISESSID");
1216 }
1217 if ($sessionID && not ($cas && $query->param('PT')) ) {
1218 my $session = get_session($sessionID);
1219 C4::Context->_new_userenv($sessionID);
1220 if ($session) {
1221 C4::Context::set_userenv(
1222 $session->param('number'), $session->param('id'),
1223 $session->param('cardnumber'), $session->param('firstname'),
1224 $session->param('surname'), $session->param('branch'),
1225 $session->param('branchname'), $session->param('flags'),
1226 $session->param('emailaddress'), $session->param('branchprinter')
1227 );
1228
1229 my $ip = $session->param('ip');
1230 my $lasttime = $session->param('lasttime');
1231 my $userid = $session->param('id');
1232 if ( $lasttime < time() - $timeout ) {
1233 # time out
1234 $session->delete();
1235 C4::Context->_unset_userenv($sessionID);
1236 $userid = undef;
1237 $sessionID = undef;
1238 return ("expired", undef, undef);
1239 } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1240 # IP address changed
1241 $session->delete();
1242 C4::Context->_unset_userenv($sessionID);
1243 $userid = undef;
1244 $sessionID = undef;
1245 return ("expired", undef, undef);
1246 } else {
1247 my $cookie = $query->cookie(
1248 -name => 'CGISESSID',
1249 -value => $session->id,
1250 -HttpOnly => 1,
1251 );
1252 $session->param('lasttime',time());
1253 my $flags = haspermission($userid, $flagsrequired);
1254 if ($flags) {
1255 return ("ok", $cookie, $sessionID);
1256 } else {
1257 $session->delete();
1258 C4::Context->_unset_userenv($sessionID);
1259 $userid = undef;
1260 $sessionID = undef;
1261 return ("failed", undef, undef);
1262 }
1263 }
1264 } else {
1265 return ("expired", undef, undef);
1266 }
1267 } else {
1268 # new login
1269 my $userid = $query->param('userid');
1270 my $password = $query->param('password');
1271 my ($return, $cardnumber);
1272
1273 # Proxy CAS auth
1274 if ($cas && $query->param('PT')) {
1275 my $retuserid;
1276 $debug and print STDERR "## check_api_auth - checking CAS\n";
1277 # In case of a CAS authentication, we use the ticket instead of the password
1278 my $PT = $query->param('PT');
1279 ($return,$cardnumber,$userid) = check_api_auth_cas($dbh, $PT, $query); # EXTERNAL AUTH
1280 } else {
1281 # User / password auth
1282 unless ($userid and $password) {
1283 # caller did something wrong, fail the authenticateion
1284 return ("failed", undef, undef);
1285 }
1286 ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password, $query );
1287 }
1288
1289 if ($return and haspermission( $userid, $flagsrequired)) {
1290 my $session = get_session("");
1291 return ("failed", undef, undef) unless $session;
1292
1293 my $sessionID = $session->id;
1294 C4::Context->_new_userenv($sessionID);
1295 my $cookie = $query->cookie(
1296 -name => 'CGISESSID',
1297 -value => $sessionID,
1298 -HttpOnly => 1,
1299 );
1300 if ( $return == 1 ) {
1301 my (
1302 $borrowernumber, $firstname, $surname,
1303 $userflags, $branchcode, $branchname,
1304 $branchprinter, $emailaddress
1305 );
1306 my $sth =
1307 $dbh->prepare(
1308"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=?"
1309 );
1310 $sth->execute($userid);
1311 (
1312 $borrowernumber, $firstname, $surname,
1313 $userflags, $branchcode, $branchname,
1314 $branchprinter, $emailaddress
1315 ) = $sth->fetchrow if ( $sth->rows );
1316
1317 unless ($sth->rows ) {
1318 my $sth = $dbh->prepare(
1319"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=?"
1320 );
1321 $sth->execute($cardnumber);
1322 (
1323 $borrowernumber, $firstname, $surname,
1324 $userflags, $branchcode, $branchname,
1325 $branchprinter, $emailaddress
1326 ) = $sth->fetchrow if ( $sth->rows );
1327
1328 unless ( $sth->rows ) {
1329 $sth->execute($userid);
1330 (
1331 $borrowernumber, $firstname, $surname, $userflags,
1332 $branchcode, $branchname, $branchprinter, $emailaddress
1333 ) = $sth->fetchrow if ( $sth->rows );
1334 }
1335 }
1336
1337 my $ip = $ENV{'REMOTE_ADDR'};
1338 # if they specify at login, use that
1339 if ($query->param('branch')) {
1340 $branchcode = $query->param('branch');
1341 $branchname = GetBranchName($branchcode);
1342 }
1343 my $branches = GetBranches();
1344 my @branchesloop;
1345 foreach my $br ( keys %$branches ) {
1346 # now we work with the treatment of ip
1347 my $domain = $branches->{$br}->{'branchip'};
1348 if ( $domain && $ip =~ /^$domain/ ) {
1349 $branchcode = $branches->{$br}->{'branchcode'};
1350
1351 # new op dev : add the branchprinter and branchname in the cookie
1352 $branchprinter = $branches->{$br}->{'branchprinter'};
1353 $branchname = $branches->{$br}->{'branchname'};
1354 }
1355 }
1356 $session->param('number',$borrowernumber);
1357 $session->param('id',$userid);
1358 $session->param('cardnumber',$cardnumber);
1359 $session->param('firstname',$firstname);
1360 $session->param('surname',$surname);
1361 $session->param('branch',$branchcode);
1362 $session->param('branchname',$branchname);
1363 $session->param('flags',$userflags);
1364 $session->param('emailaddress',$emailaddress);
1365 $session->param('ip',$session->remote_addr());
1366 $session->param('lasttime',time());
1367 } elsif ( $return == 2 ) {
1368 #We suppose the user is the superlibrarian
1369 $session->param('number',0);
1370 $session->param('id',C4::Context->config('user'));
1371 $session->param('cardnumber',C4::Context->config('user'));
1372 $session->param('firstname',C4::Context->config('user'));
1373 $session->param('surname',C4::Context->config('user'));
1374 $session->param('branch','NO_LIBRARY_SET');
1375 $session->param('branchname','NO_LIBRARY_SET');
1376 $session->param('flags',1);
1377 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
1378 $session->param('ip',$session->remote_addr());
1379 $session->param('lasttime',time());
1380 }
1381 C4::Context::set_userenv(
1382 $session->param('number'), $session->param('id'),
1383 $session->param('cardnumber'), $session->param('firstname'),
1384 $session->param('surname'), $session->param('branch'),
1385 $session->param('branchname'), $session->param('flags'),
1386 $session->param('emailaddress'), $session->param('branchprinter')
1387 );
1388 return ("ok", $cookie, $sessionID);
1389 } else {
1390 return ("failed", undef, undef);
1391 }
1392 }
1393}
1394
1395=head2 check_cookie_auth
1396
- -
1422sub check_cookie_auth {
1423 my $cookie = shift;
1424 my $flagsrequired = shift;
1425
1426 my $dbh = C4::Context->dbh;
1427 my $timeout = _timeout_syspref();
1428
1429 unless (C4::Context->preference('Version')) {
1430 # database has not been installed yet
1431 return ("maintenance", undef);
1432 }
1433 my $kohaversion=C4::Context::KOHAVERSION;
1434 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1435 if (C4::Context->preference('Version') < $kohaversion) {
1436 # database in need of version update; assume that
1437 # no API should be called while databsae is in
1438 # this condition.
1439 return ("maintenance", undef);
1440 }
1441
1442 # FIXME -- most of what follows is a copy-and-paste
1443 # of code from checkauth. There is an obvious need
1444 # for refactoring to separate the various parts of
1445 # the authentication code, but as of 2007-11-23 this
1446 # is deferred so as to not introduce bugs into the
1447 # regular authentication code for Koha 3.0.
1448
1449 # see if we have a valid session cookie already
1450 # however, if a userid parameter is present (i.e., from
1451 # a form submission, assume that any current cookie
1452 # is to be ignored
1453 unless (defined $cookie and $cookie) {
1454 return ("failed", undef);
1455 }
1456 my $sessionID = $cookie;
1457 my $session = get_session($sessionID);
1458 C4::Context->_new_userenv($sessionID);
1459 if ($session) {
1460 C4::Context::set_userenv(
1461 $session->param('number'), $session->param('id'),
1462 $session->param('cardnumber'), $session->param('firstname'),
1463 $session->param('surname'), $session->param('branch'),
1464 $session->param('branchname'), $session->param('flags'),
1465 $session->param('emailaddress'), $session->param('branchprinter')
1466 );
1467
1468 my $ip = $session->param('ip');
1469 my $lasttime = $session->param('lasttime');
1470 my $userid = $session->param('id');
1471 if ( $lasttime < time() - $timeout ) {
1472 # time out
1473 $session->delete();
1474 C4::Context->_unset_userenv($sessionID);
1475 $userid = undef;
1476 $sessionID = undef;
1477 return ("expired", undef);
1478 } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1479 # IP address changed
1480 $session->delete();
1481 C4::Context->_unset_userenv($sessionID);
1482 $userid = undef;
1483 $sessionID = undef;
1484 return ("expired", undef);
1485 } else {
1486 $session->param('lasttime',time());
1487 my $flags = haspermission($userid, $flagsrequired);
1488 if ($flags) {
1489 return ("ok", $sessionID);
1490 } else {
1491 $session->delete();
1492 C4::Context->_unset_userenv($sessionID);
1493 $userid = undef;
1494 $sessionID = undef;
1495 return ("failed", undef);
1496 }
1497 }
1498 } else {
1499 return ("expired", undef);
1500 }
1501}
1502
1503=head2 get_session
1504
- -
1518
# spent 15.0ms (171µs+14.8) within C4::Auth::get_session which was called 3 times, avg 4.99ms/call: # once (63µs+10.1ms) by C4::Auth::checkauth at line 809 # once (68µs+2.54ms) by main::RUNTIME at line 691 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl # once (40µs+2.15ms) by C4::Auth::get_template_and_user at line 366
sub get_session {
151918150µs my $sessionID = shift;
152032.09ms my $storage_method = C4::Context->preference('SessionStorage');
# spent 2.09ms making 3 calls to C4::Context::preference, avg 698µs/call
152133.14ms my $dbh = C4::Context->dbh;
# spent 3.14ms making 3 calls to C4::Context::dbh, avg 1.05ms/call
1522 my $session;
152339.57ms if ($storage_method eq 'mysql'){
# spent 9.57ms making 3 calls to CGI::Session::new, avg 3.19ms/call
1524 $session = new CGI::Session("driver:MySQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1525 }
1526 elsif ($storage_method eq 'Pg') {
1527 $session = new CGI::Session("driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1528 }
1529 elsif ($storage_method eq 'memcached' && C4::Context->ismemcached){
1530 $session = new CGI::Session("driver:memcached;serializer:yaml;id:md5", $sessionID, { Memcached => C4::Context->memcached } );
1531 }
1532 else {
1533 # catch all defaults to tmp should work on all systems
1534 $session = new CGI::Session("driver:File;serializer:yaml;id:md5", $sessionID, {Directory=>'/tmp'});
1535 }
1536 return $session;
1537}
1538
1539sub checkpw {
1540
1541 my ( $dbh, $userid, $password, $query ) = @_;
1542 if ($ldap) {
1543 $debug and print STDERR "## checkpw - checking LDAP\n";
1544 my ($retval,$retcard,$retuserid) = checkpw_ldap(@_); # EXTERNAL AUTH
1545 ($retval) and return ($retval,$retcard,$retuserid);
1546 }
1547
1548 if ($cas && $query && $query->param('ticket')) {
1549 $debug and print STDERR "## checkpw - checking CAS\n";
1550 # In case of a CAS authentication, we use the ticket instead of the password
1551 my $ticket = $query->param('ticket');
1552 my ($retval,$retcard,$retuserid) = checkpw_cas($dbh, $ticket, $query); # EXTERNAL AUTH
1553 ($retval) and return ($retval,$retcard,$retuserid);
1554 return 0;
1555 }
1556
1557 # INTERNAL AUTH
1558 my $sth =
1559 $dbh->prepare(
1560"select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1561 );
1562 $sth->execute($userid);
1563 if ( $sth->rows ) {
1564 my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1565 $surname, $branchcode, $flags )
1566 = $sth->fetchrow;
1567 if ( md5_base64($password) eq $md5password and $md5password ne "!") {
1568
1569 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1570 $firstname, $surname, $branchcode, $flags );
1571 return 1, $cardnumber, $userid;
1572 }
1573 }
1574 $sth =
1575 $dbh->prepare(
1576"select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1577 );
1578 $sth->execute($userid);
1579 if ( $sth->rows ) {
1580 my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1581 $surname, $branchcode, $flags )
1582 = $sth->fetchrow;
1583 if ( md5_base64($password) eq $md5password ) {
1584
1585 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1586 $firstname, $surname, $branchcode, $flags );
1587 return 1, $cardnumber, $userid;
1588 }
1589 }
1590 if ( $userid && $userid eq C4::Context->config('user')
1591 && "$password" eq C4::Context->config('pass') )
1592 {
1593
1594# Koha superuser account
1595# C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1596 return 2;
1597 }
1598 if ( $userid && $userid eq 'demo'
1599 && "$password" eq 'demo'
1600 && C4::Context->config('demo') )
1601 {
1602
1603# DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1604# some features won't be effective : modify systempref, modify MARC structure,
1605 return 2;
1606 }
1607 return 0;
1608}
1609
1610=head2 getuserflags
1611
- -
1622sub getuserflags {
1623 my $flags = shift;
1624 my $userid = shift;
1625 my $dbh = @_ ? shift : C4::Context->dbh;
1626 my $userflags;
1627 {
1628 # I don't want to do this, but if someone logs in as the database
1629 # user, it would be preferable not to spam them to death with
1630 # numeric warnings. So, we make $flags numeric.
16313755µs2113µs
# spent 76µs (40+37) within C4::Auth::BEGIN@1631 which was called: # once (40µs+37µs) by main::BEGIN@46 at line 1631
no warnings 'numeric';
# spent 76µs making 1 call to C4::Auth::BEGIN@1631 # spent 37µs making 1 call to warnings::unimport
1632 $flags += 0;
1633 }
1634 my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1635 $sth->execute;
1636
1637 while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1638 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1639 $userflags->{$flag} = 1;
1640 }
1641 else {
1642 $userflags->{$flag} = 0;
1643 }
1644 }
1645
1646 # get subpermissions and merge with top-level permissions
1647 my $user_subperms = get_user_subpermissions($userid);
1648 foreach my $module (keys %$user_subperms) {
1649 next if $userflags->{$module} == 1; # user already has permission for everything in this module
1650 $userflags->{$module} = $user_subperms->{$module};
1651 }
1652
1653 return $userflags;
1654}
1655
1656=head2 get_user_subpermissions
1657
- -
1681sub get_user_subpermissions {
1682 my $userid = shift;
1683
1684 my $dbh = C4::Context->dbh;
1685 my $sth = $dbh->prepare("SELECT flag, user_permissions.code
1686 FROM user_permissions
1687 JOIN permissions USING (module_bit, code)
1688 JOIN userflags ON (module_bit = bit)
1689 JOIN borrowers USING (borrowernumber)
1690 WHERE userid = ?");
1691 $sth->execute($userid);
1692
1693 my $user_perms = {};
1694 while (my $perm = $sth->fetchrow_hashref) {
1695 $user_perms->{$perm->{'flag'}}->{$perm->{'code'}} = 1;
1696 }
1697 return $user_perms;
1698}
1699
1700=head2 get_all_subpermissions
1701
- -
1712sub get_all_subpermissions {
1713 my $dbh = C4::Context->dbh;
1714 my $sth = $dbh->prepare("SELECT flag, code, description
1715 FROM permissions
1716 JOIN userflags ON (module_bit = bit)");
1717 $sth->execute();
1718
1719 my $all_perms = {};
1720 while (my $perm = $sth->fetchrow_hashref) {
1721 $all_perms->{$perm->{'flag'}}->{$perm->{'code'}} = $perm->{'description'};
1722 }
1723 return $all_perms;
1724}
1725
1726=head2 haspermission
1727
- -
1737sub haspermission {
1738 my ($userid, $flagsrequired) = @_;
1739 my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1740 $sth->execute($userid);
1741 my $flags = getuserflags($sth->fetchrow(), $userid);
1742 if ( $userid eq C4::Context->config('user') ) {
1743 # Super User Account from /etc/koha.conf
1744 $flags->{'superlibrarian'} = 1;
1745 }
1746 elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
1747 # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1748 $flags->{'superlibrarian'} = 1;
1749 }
1750
1751 return $flags if $flags->{superlibrarian};
1752
1753 foreach my $module ( keys %$flagsrequired ) {
1754 my $subperm = $flagsrequired->{$module};
1755 if ($subperm eq '*') {
1756 return 0 unless ( $flags->{$module} == 1 or ref($flags->{$module}) );
1757 } else {
1758 return 0 unless ( $flags->{$module} == 1 or
1759 ( ref($flags->{$module}) and
1760 exists $flags->{$module}->{$subperm} and
1761 $flags->{$module}->{$subperm} == 1
1762 )
1763 );
1764 }
1765 }
1766 return $flags;
1767 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1768}
1769
1770
1771sub getborrowernumber {
1772 my ($userid) = @_;
1773 my $userenv = C4::Context->userenv;
1774 if ( defined( $userenv ) && ref( $userenv ) eq 'HASH' && $userenv->{number} ) {
1775 return $userenv->{number};
1776 }
1777 my $dbh = C4::Context->dbh;
1778 for my $field ( 'userid', 'cardnumber' ) {
1779 my $sth =
1780 $dbh->prepare("select borrowernumber from borrowers where $field=?");
1781 $sth->execute($userid);
1782 if ( $sth->rows ) {
1783 my ($bnumber) = $sth->fetchrow;
1784 return $bnumber;
1785 }
1786 }
1787 return 0;
1788}
1789
1790
# spent 304µs (41+263) within C4::Auth::ParseSearchHistoryCookie which was called 2 times, avg 152µs/call: # once (20µs+148µs) by main::RUNTIME at line 625 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl # once (21µs+115µs) by C4::Auth::get_template_and_user at line 291
sub ParseSearchHistoryCookie {
1791643µs my $input = shift;
17922263µs my $search_cookie = $input->cookie('KohaOpacRecentSearches');
# spent 263µs making 2 calls to CGI::cookie, avg 132µs/call
1793 return () unless $search_cookie;
1794 my $obj = eval { decode_json(uri_unescape($search_cookie)) };
1795 return () unless defined $obj;
1796 return () unless ref $obj eq 'ARRAY';
1797 return @{ $obj };
1798}
1799
180016µs
# spent 5µs within C4::Auth::END which was called: # once (5µ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)
1801110µs1;
1802__END__
 
# spent 29µs within C4::Auth::CORE:match which was called 4 times, avg 7µs/call: # 2 times (20µs+0s) by C4::Auth::get_template_and_user at line 365, avg 10µs/call # once (5µs+0s) by C4::Auth::_timeout_syspref at line 598 # once (4µs+0s) by C4::Auth::get_template_and_user at line 140
sub C4::Auth::CORE:match; # opcode
# spent 17µs within C4::Auth::CORE:subst which was called 3 times, avg 6µs/call: # once (11µs+0s) by C4::Auth::_version_check at line 573 # once (4µ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 4µs within C4::Auth::CORE:substcont which was called 2 times, avg 2µs/call: # 2 times (4µ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.