← Index
NYTProf Performance Profile   « line view »
For starman worker -M FindBin --max-requests 50 --workers 2 --user=kohadev-koha --group kohadev-koha --pid /var/run/koha/kohadev/plack.pid --daemonize --access-log /var/log/koha/kohadev/plack.log --error-log /var/log/koha/kohadev/plack-error.log -E deployment --socket /var/run/koha/kohadev/plack.sock /etc/koha/sites/kohadev/plack.psgi
  Run on Fri Jan 8 14:31:06 2016
Reported on Fri Jan 8 14:33:27 2016

Filename/home/vagrant/kohaclone/C4/Auth.pm
StatementsExecuted 299 statements in 2.20ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1119.43ms9.89msC4::Auth::::BEGIN@32C4::Auth::BEGIN@32
1114.62ms5.13msC4::Auth::::BEGIN@25C4::Auth::BEGIN@25
4224.14ms1.34sC4::Auth::::get_template_and_userC4::Auth::get_template_and_user
1113.24ms24.3msC4::Auth::::BEGIN@23C4::Auth::BEGIN@23
1112.86ms41.1msC4::Auth::::BEGIN@29C4::Auth::BEGIN@29
1112.33ms1.64sC4::Auth::::BEGIN@43C4::Auth::BEGIN@43
4111.41ms9.58msC4::Auth::::get_all_subpermissionsC4::Auth::get_all_subpermissions
411737µs118msC4::Auth::::checkauthC4::Auth::checkauth
511599µs3.05msC4::Auth::::getuserflagsC4::Auth::getuserflags
111496µs978µsC4::Auth::::BEGIN@22C4::Auth::BEGIN@22
932271µs67.8msC4::Auth::::get_sessionC4::Auth::get_session
521224µs6.04msC4::Auth::::haspermissionC4::Auth::haspermission
111220µs18.8msC4::Auth::::check_cookie_authC4::Auth::check_cookie_auth
411198µs29.4msC4::Auth::::_version_checkC4::Auth::_version_check
511152µs1.41msC4::Auth::::get_user_subpermissionsC4::Auth::get_user_subpermissions
133180µs80µsC4::Auth::::CORE:matchC4::Auth::CORE:match (opcode)
52177µs16.0msC4::Auth::::_timeout_sysprefC4::Auth::_timeout_syspref
41174µs74µsC4::Auth::::CORE:regcompC4::Auth::CORE:regcomp (opcode)
11165µs73µsC4::Auth::::BEGIN@1865C4::Auth::BEGIN@1865
41146µs70µsC4::Auth::::getborrowernumberC4::Auth::getborrowernumber
11137µs80µsC4::Auth::::BEGIN@24C4::Auth::BEGIN@24
11137µs52µsC4::Auth::::BEGIN@20C4::Auth::BEGIN@20
52136µs36µsC4::Auth::::CORE:substC4::Auth::CORE:subst (opcode)
11131µs39µsC4::Auth::::BEGIN@28C4::Auth::BEGIN@28
11124µs90µsC4::Auth::::BEGIN@34C4::Auth::BEGIN@34
11124µs24µsC4::Auth::::BEGIN@33C4::Auth::BEGIN@33
11118µs18µsC4::Auth::::BEGIN@35C4::Auth::BEGIN@35
102118µs18µsC4::Auth::::CORE:substcontC4::Auth::CORE:substcont (opcode)
11117µs76µsC4::Auth::::BEGIN@36C4::Auth::BEGIN@36
11114µs102µsC4::Auth::::BEGIN@41C4::Auth::BEGIN@41
11113µs41µsC4::Auth::::BEGIN@38C4::Auth::BEGIN@38
11113µs32µsC4::Auth::::BEGIN@37C4::Auth::BEGIN@37
11113µs69µsC4::Auth::::BEGIN@31C4::Auth::BEGIN@31
11112µs25µsC4::Auth::::BEGIN@21C4::Auth::BEGIN@21
11112µs60µsC4::Auth::::BEGIN@30C4::Auth::BEGIN@30
0000s0sC4::Auth::::ENDC4::Auth::END
0000s0sC4::Auth::::__ANON__[:44]C4::Auth::__ANON__[:44]
0000s0sC4::Auth::::_session_logC4::Auth::_session_log
0000s0sC4::Auth::::check_api_authC4::Auth::check_api_auth
0000s0sC4::Auth::::checkpwC4::Auth::checkpw
0000s0sC4::Auth::::checkpw_hashC4::Auth::checkpw_hash
0000s0sC4::Auth::::checkpw_internalC4::Auth::checkpw_internal
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
8# under the terms of the GNU General Public License as published by
9# the Free Software Foundation; either version 3 of the License, or
10# (at your option) any later version.
11#
12# Koha is distributed in the hope that it will be useful, but
13# WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20268µs
# spent 52µs (37+15) within C4::Auth::BEGIN@20 which was called: # once (37µs+15µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 20
use strict;
# spent 52µs making 1 call to C4::Auth::BEGIN@20 # spent 15µs making 1 call to strict::import
21237µs
# spent 25µs (12+12) within C4::Auth::BEGIN@21 which was called: # once (12µs+12µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 21
use warnings;
# spent 25µs making 1 call to C4::Auth::BEGIN@21 # spent 12µs making 1 call to warnings::import
2221.06ms
# spent 978µs (496+482) within C4::Auth::BEGIN@22 which was called: # once (496µs+482µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 22
use Digest::MD5 qw(md5_base64);
# spent 978µs making 1 call to C4::Auth::BEGIN@22 # spent 81µs making 1 call to Exporter::import
23224.5ms
# spent 24.3ms (3.24+21.1) within C4::Auth::BEGIN@23 which was called: # once (3.24ms+21.1ms) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 23
use JSON qw/encode_json/;
# spent 24.3ms making 1 call to C4::Auth::BEGIN@23 # spent 167µs making 1 call to JSON::import
242123µs
# spent 80µs (37+43) within C4::Auth::BEGIN@24 which was called: # once (37µs+43µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 24
use URI::Escape;
# spent 80µs making 1 call to C4::Auth::BEGIN@24 # spent 43µs making 1 call to Exporter::import
2525.13ms
# spent 5.13ms (4.62+505µs) within C4::Auth::BEGIN@25 which was called: # once (4.62ms+505µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 25
use CGI::Session;
# spent 5.13ms making 1 call to C4::Auth::BEGIN@25 # spent 8µs making 1 call to CGI::Session::import
26
27require Exporter;
28247µs
# spent 39µs (31+8) within C4::Auth::BEGIN@28 which was called: # once (31µs+8µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 28
use C4::Context;
# spent 39µs making 1 call to C4::Auth::BEGIN@28 # spent 8µs making 1 call to C4::Context::import
29241.1ms
# spent 41.1ms (2.86+38.2) within C4::Auth::BEGIN@29 which was called: # once (2.86ms+38.2ms) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 29
use C4::Templates; # to get the template
# spent 41.1ms making 1 call to C4::Auth::BEGIN@29 # spent 7µs making 1 call to Class::Accessor::import
302109µs
# spent 60µs (12+48) within C4::Auth::BEGIN@30 which was called: # once (12µs+48µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 30
use C4::Languages;
# spent 60µs making 1 call to C4::Auth::BEGIN@30 # spent 48µs making 1 call to Exporter::import
312126µs
# spent 69µs (13+57) within C4::Auth::BEGIN@31 which was called: # once (13µs+57µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 31
use C4::Branch; # GetBranches
# spent 69µs making 1 call to C4::Auth::BEGIN@31 # spent 57µs making 1 call to Exporter::import
3219.89ms
# spent 9.89ms (9.43+456µs) within C4::Auth::BEGIN@32 which was called: # once (9.43ms+456µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 32
use C4::Search::History;
# spent 9.89ms making 1 call to C4::Auth::BEGIN@32
33124µs
# spent 24µs within C4::Auth::BEGIN@33 which was called: # once (24µs+0s) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 33
use Koha;
# spent 24µs making 1 call to C4::Auth::BEGIN@33
342155µs
# spent 90µs (24+66) within C4::Auth::BEGIN@34 which was called: # once (24µs+66µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 34
use Koha::AuthUtils qw(hash_password);
# spent 90µs making 1 call to C4::Auth::BEGIN@34 # spent 66µs making 1 call to Exporter::import
35118µs
# spent 18µs within C4::Auth::BEGIN@35 which was called: # once (18µs+0s) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 35
use Koha::LibraryCategories;
# spent 18µs making 1 call to C4::Auth::BEGIN@35
362134µs
# spent 76µs (17+59) within C4::Auth::BEGIN@36 which was called: # once (17µs+59µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 36
use POSIX qw/strftime/;
# spent 76µs making 1 call to C4::Auth::BEGIN@36 # spent 59µs making 1 call to POSIX::import
37250µs
# spent 32µs (13+19) within C4::Auth::BEGIN@37 which was called: # once (13µs+19µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 37
use List::MoreUtils qw/ any /;
# spent 32µs making 1 call to C4::Auth::BEGIN@37 # spent 18µs making 1 call to Exporter::import
38268µs
# spent 41µs (13+27) within C4::Auth::BEGIN@38 which was called: # once (13µs+27µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 38
use Encode qw( encode is_utf8);
# spent 41µs making 1 call to C4::Auth::BEGIN@38 # spent 27µs making 1 call to Exporter::import
39
40# use utf8;
412190µs
# spent 102µs (14+88) within C4::Auth::BEGIN@41 which was called: # once (14µs+88µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 41
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout $shib $shib_login);
# spent 102µs making 1 call to C4::Auth::BEGIN@41 # spent 88µs making 1 call to vars::import
42
43
# spent 1.64s (2.33ms+1.64) within C4::Auth::BEGIN@43 which was called: # once (2.33ms+1.64s) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 90
BEGIN {
44 sub psgi_env { any { /^psgi\./ } keys %ENV }
45
46 sub safe_exit {
47 if (psgi_env) { die 'psgi:exit' }
48 else { exit }
49 }
50 $VERSION = 3.07.00.049; # set version for version checking
51
52 $debug = $ENV{DEBUG};
53 @ISA = qw(Exporter);
54 @EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
55 @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash
56 &get_all_subpermissions &get_user_subpermissions
57 );
58 %EXPORT_TAGS = ( EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)] );
59110µs $ldap = C4::Context->config('useldapserver') || 0;
# spent 10µs making 1 call to C4::Context::config
6011.61s $cas = C4::Context->preference('casAuthentication');
# spent 1.61s making 1 call to C4::Context::preference
6117µs $shib = C4::Context->config('useshibboleth') || 0;
# spent 7µs making 1 call to C4::Context::config
6212.49ms $caslogout = C4::Context->preference('casLogout');
# spent 2.49ms making 1 call to C4::Context::preference
63 require C4::Auth_with_cas; # no import
64
65 if ($ldap) {
66 require C4::Auth_with_ldap;
67 import C4::Auth_with_ldap qw(checkpw_ldap);
68 }
69 if ($shib) {
70 require C4::Auth_with_shibboleth;
71 import C4::Auth_with_shibboleth
72 qw(shib_ok checkpw_shib logout_shib login_shib_url get_login_shib);
73
74 # Check for good config
75 if ( shib_ok() ) {
76
77 # Get shibboleth login attribute
78 $shib_login = get_login_shib();
79 }
80
81 # Bad config, disable shibboleth
82 else {
83 $shib = 0;
84 }
85 }
86 if ($cas) {
87 import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url);
88 }
89
9011.64s}
# spent 1.64s making 1 call to C4::Auth::BEGIN@43
91
92=head1 NAME
93
94C4::Auth - Authenticates Koha users
95
96=head1 SYNOPSIS
97
98 use CGI qw ( -utf8 );
99 use C4::Auth;
100 use C4::Output;
101
102 my $query = new CGI;
103
104 my ($template, $borrowernumber, $cookie)
105 = get_template_and_user(
106 {
107 template_name => "opac-main.tt",
108 query => $query,
109 type => "opac",
110 authnotrequired => 0,
111 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
112 }
113 );
114
115 output_html_with_http_headers $query, $cookie, $template->output;
116
117=head1 DESCRIPTION
118
119The main function of this module is to provide
120authentification. However the get_template_and_user function has
121been provided so that a users login information is passed along
122automatically. This gets loaded into the template.
123
124=head1 FUNCTIONS
125
126=head2 get_template_and_user
127
128 my ($template, $borrowernumber, $cookie)
129 = get_template_and_user(
130 {
131 template_name => "opac-main.tt",
132 query => $query,
133 type => "opac",
134 authnotrequired => 0,
135 flagsrequired => { catalogue => '*', tools => 'import_patrons' },
136 }
137 );
138
139This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
140to C<&checkauth> (in this module) to perform authentification.
141See C<&checkauth> for an explanation of these parameters.
142
143The C<template_name> is then used to find the correct template for
144the page. The authenticated users details are loaded onto the
145template in the HTML::Template LOOP variable C<USER_INFO>. Also the
146C<sessionID> is passed to the template. This can be used in templates
147if cookies are disabled. It needs to be put as and input to every
148authenticated page.
149
150More information on the C<gettemplate> sub can be found in the
151Output.pm module.
152
153=cut
154
155
# spent 1.34s (4.14ms+1.34) within C4::Auth::get_template_and_user which was called 4 times, avg 335ms/call: # 3 times (3.32ms+1.08s) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::__ANON__[/home/vagrant/kohaclone/errors/404.pl:58] at line 28 of errors/404.pl, avg 362ms/call # once (823µs+255ms) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::__ANON__[/home/vagrant/kohaclone/mainpage.pl:107] at line 36 of mainpage.pl
sub get_template_and_user {
156
1571300ns my $in = shift;
15811µs my ( $user, $cookie, $sessionID, $flags );
159
160118µs433µs C4::Context->interface( $in->{type} );
# spent 33µs making 4 calls to C4::Context::interface, avg 8µs/call
161
16212µs my $safe_chars = 'a-zA-Z0-9_\-\/';
163119µs897µs die "bad template path" unless $in->{'template_name'} =~ m/^[$safe_chars]+\.tt$/ig; #sanitize input
# spent 74µs making 4 calls to C4::Auth::CORE:regcomp, avg 18µs/call # spent 23µs making 4 calls to C4::Auth::CORE:match, avg 6µs/call
164
16511µs $in->{'authnotrequired'} ||= 0;
166114µs4482ms my $template = C4::Templates::gettemplate(
# spent 482ms making 4 calls to C4::Templates::gettemplate, avg 120ms/call
167 $in->{'template_name'},
168 $in->{'type'},
169 $in->{'query'},
170 $in->{'is_plugin'}
171 );
172
173124µs8118ms if ( $in->{'template_name'} !~ m/maintenance/ ) {
# spent 118ms making 4 calls to C4::Auth::checkauth, avg 29.5ms/call # spent 18µs making 4 calls to C4::Auth::CORE:match, avg 4µs/call
174 ( $user, $cookie, $sessionID, $flags ) = checkauth(
175 $in->{'query'},
176 $in->{'authnotrequired'},
177 $in->{'flagsrequired'},
178 $in->{'type'}
179 );
180 }
181
182
183 # If the user logged in is the SCO user and he tries to go out the SCO module, log the user out removing the CGISESSID cookie
18412µs if ( $in->{type} eq 'opac' and $in->{template_name} !~ m|sco/| ) {
185 if ( C4::Context->preference('AutoSelfCheckID') && $user eq C4::Context->preference('AutoSelfCheckID') ) {
186 $template = C4::Templates::gettemplate( 'opac-auth.tt', 'opac', $in->{query} );
187 my $cookie = $in->{query}->cookie(
188 -name => 'CGISESSID',
189 -value => '',
190 -expires => '',
191 -HttpOnly => 1,
192 );
193
194 $template->param( loginprompt => 1 );
195 print $in->{query}->header(
196 -type => 'text/html',
197 -charset => 'utf-8',
198 -cookie => $cookie,
199 ),
200 $template->output;
201 safe_exit;
202 }
203 }
204
20513µs my $borrowernumber;
20611µs if ($user) {
20712µs require C4::Members;
208
209 # It's possible for $user to be the borrowernumber if they don't have a
210 # userid defined (and are logging in through some other method, such
211 # as SSL certs against an email address)
2121300ns my $borrower;
21315µs470µs $borrowernumber = getborrowernumber($user) if defined($user);
# spent 70µs making 4 calls to C4::Auth::getborrowernumber, avg 17µs/call
21412µs if ( !defined($borrowernumber) && defined($user) ) {
215 $borrower = C4::Members::GetMember( borrowernumber => $user );
216 if ($borrower) {
217 $borrowernumber = $user;
218
219 # A bit of a hack, but I don't know there's a nicer way
220 # to do it.
221 $user = $borrower->{firstname} . ' ' . $borrower->{surname};
222 }
223 } else {
224123µs169.70ms $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
# spent 9.64ms making 4 calls to C4::Members::GetMember, avg 2.41ms/call # spent 40µs making 8 calls to DBI::common::DESTROY, avg 5µs/call # spent 17µs making 4 calls to DBD::_mem::common::DESTROY, avg 4µs/call
225 }
226
227 # user info
22815µs446µs $template->param( loggedinusername => $user );
# spent 46µs making 4 calls to C4::Templates::param, avg 12µs/call
22912µs413µs $template->param( loggedinusernumber => $borrowernumber );
# spent 13µs making 4 calls to C4::Templates::param, avg 3µs/call
23012µs421µs $template->param( sessionID => $sessionID );
# spent 21µs making 4 calls to C4::Templates::param, avg 5µs/call
231
23211µs if ( $in->{'type'} eq 'opac' ) {
233 require Koha::Virtualshelves;
234 my $some_private_shelves = Koha::Virtualshelves->get_some_shelves(
235 {
236 borrowernumber => $borrowernumber,
237 category => 1,
238 }
239 );
240 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
241 {
242 category => 2,
243 }
244 );
245 $template->param(
246 some_private_shelves => $some_private_shelves,
247 some_public_shelves => $some_public_shelves,
248 );
249 }
250
25112µs427µs $template->param( "USER_INFO" => $borrower );
# spent 27µs making 4 calls to C4::Templates::param, avg 7µs/call
252
25315µs169.60ms my $all_perms = get_all_subpermissions();
# spent 9.58ms making 4 calls to C4::Auth::get_all_subpermissions, avg 2.39ms/call # spent 17µs making 8 calls to DBI::common::DESTROY, avg 2µs/call # spent 8µs making 4 calls to DBD::_mem::common::DESTROY, avg 2µs/call
254
25519µs my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
256 editcatalogue updatecharges management tools editauthorities serials reports acquisition);
257
258 # We are going to use the $flags returned by checkauth
259 # to create the template's parameters that will indicate
260 # which menus the user can access.
26112µs if ( $flags && $flags->{superlibrarian} == 1 ) {
26215µs435µs $template->param( CAN_user_circulate => 1 );
# spent 35µs making 4 calls to C4::Templates::param, avg 9µs/call
26313µs424µs $template->param( CAN_user_catalogue => 1 );
# spent 24µs making 4 calls to C4::Templates::param, avg 6µs/call
26412µs412µs $template->param( CAN_user_parameters => 1 );
# spent 12µs making 4 calls to C4::Templates::param, avg 3µs/call
26511µs413µs $template->param( CAN_user_borrowers => 1 );
# spent 13µs making 4 calls to C4::Templates::param, avg 3µs/call
26611µs413µs $template->param( CAN_user_permissions => 1 );
# spent 13µs making 4 calls to C4::Templates::param, avg 3µs/call
26711µs444µs $template->param( CAN_user_reserveforothers => 1 );
# spent 44µs making 4 calls to C4::Templates::param, avg 11µs/call
26811µs424µs $template->param( CAN_user_editcatalogue => 1 );
# spent 24µs making 4 calls to C4::Templates::param, avg 6µs/call
26911µs413µs $template->param( CAN_user_updatecharges => 1 );
# spent 13µs making 4 calls to C4::Templates::param, avg 3µs/call
27011µs410µs $template->param( CAN_user_acquisition => 1 );
# spent 10µs making 4 calls to C4::Templates::param, avg 3µs/call
27111µs416µs $template->param( CAN_user_management => 1 );
# spent 16µs making 4 calls to C4::Templates::param, avg 4µs/call
27211µs416µs $template->param( CAN_user_tools => 1 );
# spent 16µs making 4 calls to C4::Templates::param, avg 4µs/call
27311µs413µs $template->param( CAN_user_editauthorities => 1 );
# spent 13µs making 4 calls to C4::Templates::param, avg 3µs/call
27411µs411µs $template->param( CAN_user_serials => 1 );
# spent 11µs making 4 calls to C4::Templates::param, avg 3µs/call
27511µs416µs $template->param( CAN_user_reports => 1 );
# spent 16µs making 4 calls to C4::Templates::param, avg 4µs/call
2761900ns414µs $template->param( CAN_user_staffaccess => 1 );
# spent 14µs making 4 calls to C4::Templates::param, avg 4µs/call
2771900ns413µs $template->param( CAN_user_plugins => 1 );
# spent 13µs making 4 calls to C4::Templates::param, avg 3µs/call
27811µs410µs $template->param( CAN_user_coursereserves => 1 );
# spent 10µs making 4 calls to C4::Templates::param, avg 3µs/call
27917µs foreach my $module ( keys %$all_perms ) {
280
2811230µs foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
28276102µs304903µs $template->param( "CAN_user_${module}_${subperm}" => 1 );
# spent 903µs making 304 calls to C4::Templates::param, avg 3µs/call
283 }
284 }
285 }
286
28711µs if ($flags) {
28812µs foreach my $module ( keys %$all_perms ) {
289127µs if ( defined($flags->{$module}) && $flags->{$module} == 1 ) {
290 foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
291 $template->param( "CAN_user_${module}_${subperm}" => 1 );
292 }
293 } elsif ( ref( $flags->{$module} ) ) {
294 foreach my $subperm ( keys %{ $flags->{$module} } ) {
295 $template->param( "CAN_user_${module}_${subperm}" => 1 );
296 }
297 }
298 }
299 }
300
30111µs if ($flags) {
30214µs foreach my $module ( keys %$flags ) {
303197µs if ( $flags->{$module} == 1 or ref( $flags->{$module} ) ) {
30412µs414µs $template->param( "CAN_user_$module" => 1 );
# spent 14µs making 4 calls to C4::Templates::param, avg 3µs/call
3051500ns if ( $module eq "parameters" ) {
306 $template->param( CAN_user_management => 1 );
307 }
308 }
309 }
310 }
311
312 # Logged-in opac search history
313 # If the requested template is an opac one and opac search history is enabled
314121µs421.4ms if ( $in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory') ) {
# spent 21.4ms making 4 calls to C4::Context::preference, avg 5.36ms/call
315 my $dbh = C4::Context->dbh;
316 my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
317 my $sth = $dbh->prepare($query);
318 $sth->execute($borrowernumber);
319
320 # If at least one search has already been performed
321 if ( $sth->fetchrow_array > 0 ) {
322
323 # We show the link in opac
324 $template->param( EnableOpacSearchHistory => 1 );
325 }
326
327 # And if there are searches performed when the user was not logged in,
328 # we add them to the logged-in search history
329 my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
330 if (@recentSearches) {
331 my $dbh = C4::Context->dbh;
332 my $query = q{
333 INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, type, total, time )
334 VALUES (?, ?, ?, ?, ?, ?, ?)
335 };
336
337 my $sth = $dbh->prepare($query);
338 $sth->execute( $borrowernumber,
339 $in->{query}->cookie("CGISESSID"),
340 $_->{query_desc},
341 $_->{query_cgi},
342 $_->{type} || 'biblio',
343 $_->{total},
344 $_->{time},
345 ) foreach @recentSearches;
346
347 # clear out the search history from the session now that
348 # we've saved it to the database
349 C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } );
350 }
351 } elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) {
352 $template->param( EnableSearchHistory => 1 );
353 }
354 }
355 else { # if this is an anonymous session, setup to display public lists...
356
357 # If shibboleth is enabled, and we're in an anonymous session, we should allow
358 # the user to attempt login via shibboleth.
359 if ($shib) {
360 $template->param( shibbolethAuthentication => $shib,
361 shibbolethLoginUrl => login_shib_url( $in->{'query'} ),
362 );
363
364 # If shibboleth is enabled and we have a shibboleth login attribute,
365 # but we are in an anonymous session, then we clearly have an invalid
366 # shibboleth koha account.
367 if ($shib_login) {
368 $template->param( invalidShibLogin => '1' );
369 }
370 }
371
372 $template->param( sessionID => $sessionID );
373
374 if ( $in->{'type'} eq 'opac' ){
375 require Koha::Virtualshelves;
376 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
377 {
378 category => 2,
379 }
380 );
381 $template->param(
382 some_public_shelves => $some_public_shelves,
383 );
384 }
385 }
386
387 # Anonymous opac search history
388 # If opac search history is enabled and at least one search has already been performed
389115µs421.9ms if ( C4::Context->preference('EnableOpacSearchHistory') ) {
# spent 21.9ms making 4 calls to C4::Context::preference, avg 5.47ms/call
390132µs1229.5ms my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
# spent 28.1ms making 4 calls to C4::Search::History::get_from_session, avg 7.02ms/call # spent 1.24ms making 4 calls to CGI::Session::DESTROY, avg 309µs/call # spent 176µs making 4 calls to CGI::Session::Driver::DBI::DESTROY, avg 44µs/call
3911700ns if (@recentSearches) {
392 $template->param( EnableOpacSearchHistory => 1 );
393 }
394 }
395
396112µs1230.3ms if ( C4::Context->preference('dateformat') ) {
# spent 30.2ms making 8 calls to C4::Context::preference, avg 3.78ms/call # spent 69µs making 4 calls to C4::Templates::param, avg 17µs/call
397 $template->param( dateformat => C4::Context->preference('dateformat') );
398 }
399
4001240µs89.21ms $template->param(auth_forwarded_hash => $in->{'query'}->param('auth_forwarded_hash'));
# spent 9.11ms making 4 calls to CGI::param, avg 2.28ms/call # spent 104µs making 4 calls to C4::Templates::param, avg 26µs/call
401
402 # these template parameters are set the same regardless of $in->{'type'}
403
404 # Set the using_https variable for templates
405 # FIXME Under Plack the CGI->https method always returns 'OFF'
40616µs4349µs my $https = $in->{query}->https();
# spent 257µs making 1 call to CGI::AUTOLOAD # spent 92µs making 3 calls to CGI::https, avg 31µs/call
40711µs my $using_https = ( defined $https and $https ne 'OFF' ) ? 1 : 0;
408
409116µs108261ms $template->param(
# spent 261ms making 64 calls to C4::Context::preference, avg 4.07ms/call # spent 214µs making 4 calls to C4::Templates::param, avg 54µs/call # spent 86µs making 40 calls to C4::Context::userenv, avg 2µs/call
410 "BiblioDefaultView" . C4::Context->preference("BiblioDefaultView") => 1,
411 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
412 GoogleJackets => C4::Context->preference("GoogleJackets"),
413 OpenLibraryCovers => C4::Context->preference("OpenLibraryCovers"),
414 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
415 LoginBranchcode => ( C4::Context->userenv ? C4::Context->userenv->{"branch"} : undef ),
416 LoginFirstname => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
417 LoginSurname => C4::Context->userenv ? C4::Context->userenv->{"surname"} : "Inconnu",
418 emailaddress => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
419 loggedinpersona => C4::Context->userenv ? C4::Context->userenv->{"persona"} : undef,
420 TagsEnabled => C4::Context->preference("TagsEnabled"),
421 hide_marc => C4::Context->preference("hide_marc"),
422 item_level_itypes => C4::Context->preference('item-level_itypes'),
423 patronimages => C4::Context->preference("patronimages"),
424 singleBranchMode => C4::Context->preference("singleBranchMode"),
425 XSLTDetailsDisplay => C4::Context->preference("XSLTDetailsDisplay"),
426 XSLTResultsDisplay => C4::Context->preference("XSLTResultsDisplay"),
427 using_https => $using_https,
428 noItemTypeImages => C4::Context->preference("noItemTypeImages"),
429 marcflavour => C4::Context->preference("marcflavour"),
430 persona => C4::Context->preference("persona"),
431 OPACBaseURL => C4::Context->preference('OPACBaseURL'),
432 );
433117µs128344ms if ( $in->{'type'} eq "intranet" ) {
# spent 344ms making 116 calls to C4::Context::preference, avg 2.96ms/call # spent 317µs making 4 calls to C4::Templates::param, avg 79µs/call # spent 31µs making 8 calls to C4::Context::userenv, avg 4µs/call
434 $template->param(
435 AmazonCoverImages => C4::Context->preference("AmazonCoverImages"),
436 AutoLocation => C4::Context->preference("AutoLocation"),
437 "BiblioDefaultView" . C4::Context->preference("IntranetBiblioDefaultView") => 1,
438 CircAutocompl => C4::Context->preference("CircAutocompl"),
439 FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
440 IndependentBranches => C4::Context->preference("IndependentBranches"),
441 IntranetNav => C4::Context->preference("IntranetNav"),
442 IntranetmainUserblock => C4::Context->preference("IntranetmainUserblock"),
443 LibraryName => C4::Context->preference("LibraryName"),
444 LoginBranchname => ( C4::Context->userenv ? C4::Context->userenv->{"branchname"} : undef ),
445 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
446 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
447 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
448 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
449 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
450 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
451 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
452 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
453 intranetbookbag => C4::Context->preference("intranetbookbag"),
454 suggestion => C4::Context->preference("suggestion"),
455 virtualshelves => C4::Context->preference("virtualshelves"),
456 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
457 EasyAnalyticalRecords => C4::Context->preference('EasyAnalyticalRecords'),
458 LocalCoverImages => C4::Context->preference('LocalCoverImages'),
459 OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'),
460 AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'),
461 EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'),
462 UseKohaPlugins => C4::Context->preference('UseKohaPlugins'),
463 UseCourseReserves => C4::Context->preference("UseCourseReserves"),
464 useDischarge => C4::Context->preference('useDischarge'),
465 );
466 }
467 else {
468 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
469
470 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
471 my $LibraryNameTitle = C4::Context->preference("LibraryName");
472 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
473 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
474
475 # clean up the busc param in the session
476 # if the page is not opac-detail and not the "add to list" page
477 # and not the "edit comments" page
478 if ( C4::Context->preference("OpacBrowseResults")
479 && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
480 my $pagename = $1;
481 unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
482 or $pagename =~ /^addbybiblionumber$/
483 or $pagename =~ /^review$/ ) {
484 my $sessionSearch = get_session( $sessionID || $in->{'query'}->cookie("CGISESSID") );
485 $sessionSearch->clear( ["busc"] ) if ( $sessionSearch->param("busc") );
486 }
487 }
488
489 # variables passed from CGI: opac_css_override and opac_search_limits.
490 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
491 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
492 my $opac_name = '';
493 if (
494 ( $opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:(\w+)/ ) ||
495 ( $in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:(\w+)/ ) ||
496 ( $in->{'query'}->param('multibranchlimit') && $in->{'query'}->param('multibranchlimit') =~ /multibranchlimit-(\w+)/ )
497 ) {
498 $opac_name = $1; # opac_search_limit is a branch, so we use it.
499 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
500 $opac_name = $in->{'query'}->param('multibranchlimit');
501 } elsif ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'} ) {
502 $opac_name = C4::Context->userenv->{'branch'};
503 }
504
505 my $library_categories = Koha::LibraryCategories->search({categorytype => 'searchdomain', show_in_pulldown => 1}, { order_by => ['categorytype', 'categorycode']});
506 $template->param(
507 OpacAdditionalStylesheet => C4::Context->preference("OpacAdditionalStylesheet"),
508 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
509 AuthorisedValueImages => C4::Context->preference("AuthorisedValueImages"),
510 BranchesLoop => GetBranchesLoop($opac_name),
511 BranchCategoriesLoop => $library_categories,
512 opac_name => $opac_name,
513 LibraryName => "" . C4::Context->preference("LibraryName"),
514 LibraryNameTitle => "" . $LibraryNameTitle,
515 LoginBranchname => C4::Context->userenv ? C4::Context->userenv->{"branchname"} : "",
516 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
517 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
518 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
519 OPACShelfBrowser => "" . C4::Context->preference("OPACShelfBrowser"),
520 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
521 OPACUserCSS => "" . C4::Context->preference("OPACUserCSS"),
522 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
523 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
524 opac_search_limit => $opac_search_limit,
525 opac_limit_override => $opac_limit_override,
526 OpacBrowser => C4::Context->preference("OpacBrowser"),
527 OpacCloud => C4::Context->preference("OpacCloud"),
528 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
529 OpacMainUserBlock => "" . C4::Context->preference("OpacMainUserBlock"),
530 OpacNav => "" . C4::Context->preference("OpacNav"),
531 OpacNavRight => "" . C4::Context->preference("OpacNavRight"),
532 OpacNavBottom => "" . C4::Context->preference("OpacNavBottom"),
533 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
534 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
535 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
536 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
537 OpacTopissue => C4::Context->preference("OpacTopissue"),
538 RequestOnOpac => C4::Context->preference("RequestOnOpac"),
539 'Version' => C4::Context->preference('Version'),
540 hidelostitems => C4::Context->preference("hidelostitems"),
541 mylibraryfirst => ( C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv ) ? C4::Context->userenv->{'branch'} : '',
542 opaclayoutstylesheet => "" . C4::Context->preference("opaclayoutstylesheet"),
543 opacbookbag => "" . C4::Context->preference("opacbookbag"),
544 opaccredits => "" . C4::Context->preference("opaccredits"),
545 OpacFavicon => C4::Context->preference("OpacFavicon"),
546 opacheader => "" . C4::Context->preference("opacheader"),
547 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
548 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
549 OPACUserJS => C4::Context->preference("OPACUserJS"),
550 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
551 ShowReviewer => C4::Context->preference("ShowReviewer"),
552 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
553 suggestion => "" . C4::Context->preference("suggestion"),
554 virtualshelves => "" . C4::Context->preference("virtualshelves"),
555 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
556 OPACXSLTDetailsDisplay => C4::Context->preference("OPACXSLTDetailsDisplay"),
557 OPACXSLTResultsDisplay => C4::Context->preference("OPACXSLTResultsDisplay"),
558 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
559 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
560 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
561 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
562 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
563 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
564 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
565 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
566 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
567 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
568 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
569 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
570 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
571 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
572 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
573 useDischarge => C4::Context->preference('useDischarge'),
574 );
575
576 $template->param( OpacPublic => '1' ) if ( $user || C4::Context->preference("OpacPublic") );
577 }
578
579 # Check if we were asked using parameters to force a specific language
580121µs459µs if ( defined $in->{'query'}->param('language') ) {
# spent 59µs making 4 calls to CGI::param, avg 15µs/call
581
582 # Extract the language, let C4::Languages::getlanguage choose
583 # what to do
584 my $language = C4::Languages::getlanguage( $in->{'query'} );
585 my $languagecookie = C4::Templates::getlanguagecookie( $in->{'query'}, $language );
586 if ( ref $cookie eq 'ARRAY' ) {
587 push @{$cookie}, $languagecookie;
588 } else {
589 $cookie = [ $cookie, $languagecookie ];
590 }
591 }
592
593111µs return ( $template, $borrowernumber, $cookie, $flags );
594}
595
596=head2 checkauth
597
598 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
599
600Verifies that the user is authorized to run this script. If
601the user is authorized, a (userid, cookie, session-id, flags)
602quadruple is returned. If the user is not authorized but does
603not have the required privilege (see $flagsrequired below), it
604displays an error page and exits. Otherwise, it displays the
605login page and exits.
606
607Note that C<&checkauth> will return if and only if the user
608is authorized, so it should be called early on, before any
609unfinished operations (e.g., if you've opened a file, then
610C<&checkauth> won't close it for you).
611
612C<$query> is the CGI object for the script calling C<&checkauth>.
613
614The C<$noauth> argument is optional. If it is set, then no
615authorization is required for the script.
616
617C<&checkauth> fetches user and session information from C<$query> and
618ensures that the user is authorized to run scripts that require
619authorization.
620
621The C<$flagsrequired> argument specifies the required privileges
622the user must have if the username and password are correct.
623It should be specified as a reference-to-hash; keys in the hash
624should be the "flags" for the user, as specified in the Members
625intranet module. Any key specified must correspond to a "flag"
626in the userflags table. E.g., { circulate => 1 } would specify
627that the user must have the "circulate" privilege in order to
628proceed. To make sure that access control is correct, the
629C<$flagsrequired> parameter must be specified correctly.
630
631Koha also has a concept of sub-permissions, also known as
632granular permissions. This makes the value of each key
633in the C<flagsrequired> hash take on an additional
634meaning, i.e.,
635
636 1
637
638The user must have access to all subfunctions of the module
639specified by the hash key.
640
641 *
642
643The user must have access to at least one subfunction of the module
644specified by the hash key.
645
646 specific permission, e.g., 'export_catalog'
647
648The user must have access to the specific subfunction list, which
649must correspond to a row in the permissions table.
650
651The C<$type> argument specifies whether the template should be
652retrieved from the opac or intranet directory tree. "opac" is
653assumed if it is not specified; however, if C<$type> is specified,
654"intranet" is assumed if it is not "opac".
655
656If C<$query> does not have a valid session ID associated with it
657(i.e., the user has not logged in) or if the session has expired,
658C<&checkauth> presents the user with a login page (from the point of
659view of the original script, C<&checkauth> does not return). Once the
660user has authenticated, C<&checkauth> restarts the original script
661(this time, C<&checkauth> returns).
662
663The login page is provided using a HTML::Template, which is set in the
664systempreferences table or at the top of this file. The variable C<$type>
665selects which template to use, either the opac or the intranet
666authentification template.
667
668C<&checkauth> returns a user ID, a cookie, and a session ID. The
669cookie should be sent back to the browser; it verifies that the user
670has authenticated.
671
672=cut
673
674
# spent 29.4ms (198µs+29.2) within C4::Auth::_version_check which was called 4 times, avg 7.36ms/call: # 4 times (198µs+29.2ms) by C4::Auth::checkauth at line 751, avg 7.36ms/call
sub _version_check {
6751500ns my $type = shift;
6761400ns my $query = shift;
6771100ns my $version;
678
679 # If version syspref is unavailable, it means Koha is being installed,
680 # and so we must redirect to OPAC maintenance page or to the WebInstaller
681 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
682114µs416.5ms if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
# spent 16.5ms making 4 calls to C4::Context::preference, avg 4.13ms/call
683 warn "OPAC Install required, redirecting to maintenance";
684 print $query->redirect("/cgi-bin/koha/maintenance.pl");
685 safe_exit;
686 }
687120µs412.6ms unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
# spent 12.6ms making 4 calls to C4::Context::preference, avg 3.16ms/call
688 if ( $type ne 'opac' ) {
689 warn "Install required, redirecting to Installer";
690 print $query->redirect("/cgi-bin/koha/installer/install.pl");
691 } else {
692 warn "OPAC Install required, redirecting to maintenance";
693 print $query->redirect("/cgi-bin/koha/maintenance.pl");
694 }
695 safe_exit;
696 }
697
698 # check that database and koha version are the same
699 # there is no DB version, it's a fresh install,
700 # go to web installer
701 # there is a DB version, compare it to the code version
70219µs417µs my $kohaversion = Koha::version();
# spent 17µs making 4 calls to Koha::version, avg 4µs/call
703
704 # remove the 3 last . to have a Perl number
705120µs1245µs $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
# spent 30µs making 4 calls to C4::Auth::CORE:subst, avg 8µs/call # spent 15µs making 8 calls to C4::Auth::CORE:substcont, avg 2µs/call
7061700ns $debug and print STDERR "kohaversion : $kohaversion\n";
70717µs if ( $version < $kohaversion ) {
708 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
709 if ( $type ne 'opac' ) {
710 warn sprintf( $warning, 'Installer' );
711 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure");
712 } else {
713 warn sprintf( "OPAC: " . $warning, 'maintenance' );
714 print $query->redirect("/cgi-bin/koha/maintenance.pl");
715 }
716 safe_exit;
717 }
718}
719
720sub _session_log {
721 (@_) or return 0;
722 open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
723 printf $fh join( "\n", @_ );
724 close $fh;
725}
726
727
# spent 16.0ms (77µs+16.0) within C4::Auth::_timeout_syspref which was called 5 times, avg 3.21ms/call: # 4 times (57µs+12.7ms) by C4::Auth::checkauth at line 749, avg 3.20ms/call # once (20µs+3.24ms) by C4::Auth::check_cookie_auth at line 1602
sub _timeout_syspref {
728112µs515.9ms my $timeout = C4::Context->preference('timeout') || 600;
# spent 15.9ms making 5 calls to C4::Context::preference, avg 3.19ms/call
729
730 # value in days, convert in seconds
731114µs540µs if ( $timeout =~ /(\d+)[dD]/ ) {
# spent 40µs making 5 calls to C4::Auth::CORE:match, avg 8µs/call
732 $timeout = $1 * 86400;
733 }
73413µs return $timeout;
735}
736
737
# spent 118ms (737µs+117) within C4::Auth::checkauth which was called 4 times, avg 29.5ms/call: # 4 times (737µs+117ms) by C4::Auth::get_template_and_user at line 173, avg 29.5ms/call
sub checkauth {
7381600ns my $query = shift;
7391600ns $debug and warn "Checking Auth";
740
741 # $authnotrequired will be set for scripts which will run without authentication
7421400ns my $authnotrequired = shift;
7431600ns my $flagsrequired = shift;
7441500ns my $type = shift;
7451300ns my $persona = shift;
7461100ns $type = 'opac' unless $type;
747
748113µs45.42ms my $dbh = C4::Context->dbh;
# spent 5.42ms making 4 calls to C4::Context::dbh, avg 1.36ms/call
74914µs412.8ms my $timeout = _timeout_syspref();
# spent 12.8ms making 4 calls to C4::Auth::_timeout_syspref, avg 3.20ms/call
750
75114µs429.4ms _version_check( $type, $query );
# spent 29.4ms making 4 calls to C4::Auth::_version_check, avg 7.36ms/call
752
753 # state variables
7541600ns my $loggedin = 0;
7551200ns my %info;
7561200ns my ( $userid, $cookie, $sessionID, $flags );
757122µs462µs my $logout = $query->param('logout.x');
# spent 62µs making 4 calls to CGI::param, avg 16µs/call
758
7591100ns my $anon_search_history;
760
761 # This parameter is the name of the CAS server we want to authenticate against,
762 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
76315µs412µs my $casparam = $query->param('cas');
# spent 12µs making 4 calls to CGI::param, avg 3µs/call
76417µs414µs my $q_userid = $query->param('userid') // '';
# spent 14µs making 4 calls to CGI::param, avg 3µs/call
765
766 # Basic authentication is incompatible with the use of Shibboleth,
767 # as Shibboleth may return REMOTE_USER as a Shibboleth attribute,
768 # and it may not be the attribute we want to use to match the koha login.
769 #
770 # Also, do not consider an empty REMOTE_USER.
771 #
772 # Finally, after those tests, we can assume (although if it would be better with
773 # a syspref) that if we get a REMOTE_USER, that's from basic authentication,
774 # and we can affect it to $userid.
775141µs128.92ms if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
# spent 6.46ms making 4 calls to CGI::Session::DESTROY, avg 1.62ms/call # spent 2.20ms making 4 calls to CGI::cookie, avg 550µs/call # spent 255µs making 4 calls to CGI::Session::Driver::DBI::DESTROY, avg 64µs/call
776
777 # Using Basic Authentication, no cookies required
778 $cookie = $query->cookie(
779 -name => 'CGISESSID',
780 -value => '',
781 -expires => '',
782 -HttpOnly => 1,
783 );
784 $loggedin = 1;
785 }
786 elsif ($persona) {
787
788 # we don't want to set a session because we are being called by a persona callback
789 }
790 elsif ( $sessionID = $query->cookie("CGISESSID") )
791 { # assignment, not comparison
79217µs439.5ms my $session = get_session($sessionID);
# spent 39.5ms making 4 calls to C4::Auth::get_session, avg 9.88ms/call
793110µs422µs C4::Context->_new_userenv($sessionID);
# spent 22µs making 4 calls to C4::Context::_new_userenv, avg 6µs/call
7941200ns my ( $ip, $lasttime, $sessiontype );
7951700ns my $s_userid = '';
79611µs if ($session) {
79714µs459µs $s_userid = $session->param('id') // '';
# spent 59µs making 4 calls to CGI::Session::param, avg 15µs/call
7981160µs48861µs C4::Context->set_userenv(
# spent 686µs making 4 calls to C4::Context::set_userenv, avg 171µs/call # spent 176µs making 44 calls to CGI::Session::param, avg 4µs/call
799 $session->param('number'), $s_userid,
800 $session->param('cardnumber'), $session->param('firstname'),
801 $session->param('surname'), $session->param('branch'),
802 $session->param('branchname'), $session->param('flags'),
803 $session->param('emailaddress'), $session->param('branchprinter'),
804 $session->param('persona'), $session->param('shibboleth')
805 );
80619µs840µs C4::Context::set_shelves_userenv( 'bar', $session->param('barshelves') );
# spent 20µs making 4 calls to CGI::Session::param, avg 5µs/call # spent 19µs making 4 calls to C4::Context::set_shelves_userenv, avg 5µs/call
80715µs826µs C4::Context::set_shelves_userenv( 'pub', $session->param('pubshelves') );
# spent 16µs making 4 calls to CGI::Session::param, avg 4µs/call # spent 11µs making 4 calls to C4::Context::set_shelves_userenv, avg 3µs/call
80815µs824µs C4::Context::set_shelves_userenv( 'tot', $session->param('totshelves') );
# spent 15µs making 4 calls to CGI::Session::param, avg 4µs/call # spent 9µs making 4 calls to C4::Context::set_shelves_userenv, avg 2µs/call
8091700ns $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
81011µs416µs $ip = $session->param('ip');
# spent 16µs making 4 calls to CGI::Session::param, avg 4µs/call
81111µs415µs $lasttime = $session->param('lasttime');
# spent 15µs making 4 calls to CGI::Session::param, avg 4µs/call
8121400ns $userid = $s_userid;
81313µs419µs $sessiontype = $session->param('sessiontype') || '';
# spent 19µs making 4 calls to CGI::Session::param, avg 5µs/call
814 }
815131µs813.7ms if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
# spent 13.7ms making 4 calls to C4::Context::preference, avg 3.42ms/call # spent 44µs making 4 calls to CGI::param, avg 11µs/call
816 || ( $cas && $query->param('ticket') && !C4::Context->userenv->{'id'} )
817 || ( $shib && $shib_login && !$logout && !C4::Context->userenv->{'id'} )
818 ) {
819
820 #if a user enters an id ne to the id in the current session, we need to log them in...
821 #first we need to clear the anonymous session...
822 $debug and warn "query id = $q_userid but session id = $s_userid";
823 $anon_search_history = $session->param('search_history');
824 $session->delete();
825 $session->flush;
826 C4::Context->_unset_userenv($sessionID);
827 $sessionID = undef;
828 $userid = undef;
829 }
830 elsif ($logout) {
831
832 # voluntary logout the user
833 # check wether the user was using their shibboleth session or a local one
834 my $shibSuccess = C4::Context->userenv->{'shibboleth'};
835 $session->delete();
836 $session->flush;
837 C4::Context->_unset_userenv($sessionID);
838
839 #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
840 $sessionID = undef;
841 $userid = undef;
842
843 if ($cas and $caslogout) {
844 logout_cas($query, $type);
845 }
846
847 # If we are in a shibboleth session (shibboleth is enabled, a shibboleth match attribute is set and matches koha matchpoint)
848 if ( $shib and $shib_login and $shibSuccess and $type eq 'opac' ) {
849
850 # (Note: $type eq 'opac' condition should be removed when shibboleth authentication for intranet will be implemented)
851 logout_shib($query);
852 }
853 }
854 elsif ( !$lasttime || ( $lasttime < time() - $timeout ) ) {
855
856 # timed logout
857 $info{'timed_out'} = 1;
858 if ($session) {
859 $session->delete();
860 $session->flush;
861 }
862 C4::Context->_unset_userenv($sessionID);
863
864 #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
865 $userid = undef;
866 $sessionID = undef;
867 }
868 elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
869
870 # Different ip than originally logged in from
871 $info{'oldip'} = $ip;
872 $info{'newip'} = $ENV{'REMOTE_ADDR'};
873 $info{'different_ip'} = 1;
874 $session->delete();
875 $session->flush;
876 C4::Context->_unset_userenv($sessionID);
877
878 #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
879 $sessionID = undef;
880 $userid = undef;
881 }
882 else {
883126µs8853µs $cookie = $query->cookie(
# spent 806µs making 4 calls to CGI::cookie, avg 202µs/call # spent 47µs making 4 calls to CGI::Session::id, avg 12µs/call
884 -name => 'CGISESSID',
885 -value => $session->id,
886 -HttpOnly => 1
887 );
88814µs4115µs $session->param( 'lasttime', time() );
# spent 115µs making 4 calls to CGI::Session::param, avg 29µs/call
8891600ns 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...
89016µs165.11ms $flags = haspermission( $userid, $flagsrequired );
# spent 5.09ms making 4 calls to C4::Auth::haspermission, avg 1.27ms/call # spent 14µs making 8 calls to DBI::common::DESTROY, avg 2µs/call # spent 3µs making 4 calls to DBD::_mem::common::DESTROY, avg 750ns/call
8911800ns if ($flags) {
892 $loggedin = 1;
893 } else {
894 $info{'nopermission'} = 1;
895 }
896 }
897 }
898 }
8991600ns unless ( $userid || $sessionID ) {
900
901 #we initiate a session prior to checking for a username to allow for anonymous sessions...
902 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
903
904 # Save anonymous search history in new session so it can be retrieved
905 # by get_template_and_user to store it in user's search history after
906 # a successful login.
907 if ($anon_search_history) {
908 $session->param( 'search_history', $anon_search_history );
909 }
910
911 my $sessionID = $session->id;
912 C4::Context->_new_userenv($sessionID);
913 $cookie = $query->cookie(
914 -name => 'CGISESSID',
915 -value => $session->id,
916 -HttpOnly => 1
917 );
918 $userid = $q_userid;
919 my $pki_field = C4::Context->preference('AllowPKIAuth');
920 if ( !defined($pki_field) ) {
921 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
922 $pki_field = 'None';
923 }
924 if ( ( $cas && $query->param('ticket') )
925 || $userid
926 || ( $shib && $shib_login )
927 || $pki_field ne 'None'
928 || $persona )
929 {
930 my $password = $query->param('password');
931 my $shibSuccess = 0;
932
933 my ( $return, $cardnumber );
934
935 # If shib is enabled and we have a shib login, does the login match a valid koha user
936 if ( $shib && $shib_login && $type eq 'opac' ) {
937 my $retuserid;
938
939 # Do not pass password here, else shib will not be checked in checkpw.
940 ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $userid, undef, $query );
941 $userid = $retuserid;
942 $shibSuccess = $return;
943 $info{'invalidShibLogin'} = 1 unless ($return);
944 }
945
946 # If shib login and match were successful, skip further login methods
947 unless ($shibSuccess) {
948 if ( $cas && $query->param('ticket') ) {
949 my $retuserid;
950 ( $return, $cardnumber, $retuserid ) =
951 checkpw( $dbh, $userid, $password, $query, $type );
952 $userid = $retuserid;
953 $info{'invalidCasLogin'} = 1 unless ($return);
954 }
955
956 elsif ($persona) {
957 my $value = $persona;
958
959 # If we're looking up the email, there's a chance that the person
960 # doesn't have a userid. So if there is none, we pass along the
961 # borrower number, and the bits of code that need to know the user
962 # ID will have to be smart enough to handle that.
963 require C4::Members;
964 my @users_info = C4::Members::GetBorrowersWithEmail($value);
965 if (@users_info) {
966
967 # First the userid, then the borrowernum
968 $value = $users_info[0][1] || $users_info[0][0];
969 }
970 else {
971 undef $value;
972 }
973 $return = $value ? 1 : 0;
974 $userid = $value;
975 }
976
977 elsif (
978 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
979 || ( $pki_field eq 'emailAddress'
980 && $ENV{'SSL_CLIENT_S_DN_Email'} )
981 )
982 {
983 my $value;
984 if ( $pki_field eq 'Common Name' ) {
985 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
986 }
987 elsif ( $pki_field eq 'emailAddress' ) {
988 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
989
990 # If we're looking up the email, there's a chance that the person
991 # doesn't have a userid. So if there is none, we pass along the
992 # borrower number, and the bits of code that need to know the user
993 # ID will have to be smart enough to handle that.
994 require C4::Members;
995 my @users_info = C4::Members::GetBorrowersWithEmail($value);
996 if (@users_info) {
997
998 # First the userid, then the borrowernum
999 $value = $users_info[0][1] || $users_info[0][0];
1000 } else {
1001 undef $value;
1002 }
1003 }
1004
1005 $return = $value ? 1 : 0;
1006 $userid = $value;
1007
1008 }
1009 else {
1010 my $retuserid;
1011 ( $return, $cardnumber, $retuserid ) =
1012 checkpw( $dbh, $userid, $password, $query, $type );
1013 $userid = $retuserid if ($retuserid);
1014 $info{'invalid_username_or_password'} = 1 unless ($return);
1015 }
1016 }
1017
1018 # $return: 1 = valid user, 2 = superlibrarian
1019 if ($return) {
1020
1021 #_session_log(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
1022 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
1023 $loggedin = 1;
1024 }
1025 else {
1026 $info{'nopermission'} = 1;
1027 C4::Context->_unset_userenv($sessionID);
1028 }
1029 my ( $borrowernumber, $firstname, $surname, $userflags,
1030 $branchcode, $branchname, $branchprinter, $emailaddress );
1031
1032 if ( $return == 1 ) {
1033 my $select = "
1034 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
1035 branches.branchname as branchname,
1036 branches.branchprinter as branchprinter,
1037 email
1038 FROM borrowers
1039 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
1040 ";
1041 my $sth = $dbh->prepare("$select where userid=?");
1042 $sth->execute($userid);
1043 unless ( $sth->rows ) {
1044 $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
1045 $sth = $dbh->prepare("$select where cardnumber=?");
1046 $sth->execute($cardnumber);
1047
1048 unless ( $sth->rows ) {
1049 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
1050 $sth->execute($userid);
1051 unless ( $sth->rows ) {
1052 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
1053 }
1054 }
1055 }
1056 if ( $sth->rows ) {
1057 ( $borrowernumber, $firstname, $surname, $userflags,
1058 $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow;
1059 $debug and print STDERR "AUTH_3 results: " .
1060 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
1061 } else {
1062 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
1063 }
1064
1065 # launch a sequence to check if we have a ip for the branch, i
1066 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
1067
1068 my $ip = $ENV{'REMOTE_ADDR'};
1069
1070 # if they specify at login, use that
1071 if ( $query->param('branch') ) {
1072 $branchcode = $query->param('branch');
1073 $branchname = GetBranchName($branchcode);
1074 }
1075 my $branches = GetBranches();
1076 if ( C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation') ) {
1077
1078 # we have to check they are coming from the right ip range
1079 my $domain = $branches->{$branchcode}->{'branchip'};
1080 if ( $ip !~ /^$domain/ ) {
1081 $loggedin = 0;
1082 $info{'wrongip'} = 1;
1083 }
1084 }
1085
1086 my @branchesloop;
1087 foreach my $br ( keys %$branches ) {
1088
1089 # now we work with the treatment of ip
1090 my $domain = $branches->{$br}->{'branchip'};
1091 if ( $domain && $ip =~ /^$domain/ ) {
1092 $branchcode = $branches->{$br}->{'branchcode'};
1093
1094 # new op dev : add the branchprinter and branchname in the cookie
1095 $branchprinter = $branches->{$br}->{'branchprinter'};
1096 $branchname = $branches->{$br}->{'branchname'};
1097 }
1098 }
1099 $session->param( 'number', $borrowernumber );
1100 $session->param( 'id', $userid );
1101 $session->param( 'cardnumber', $cardnumber );
1102 $session->param( 'firstname', $firstname );
1103 $session->param( 'surname', $surname );
1104 $session->param( 'branch', $branchcode );
1105 $session->param( 'branchname', $branchname );
1106 $session->param( 'flags', $userflags );
1107 $session->param( 'emailaddress', $emailaddress );
1108 $session->param( 'ip', $session->remote_addr() );
1109 $session->param( 'lasttime', time() );
1110 $session->param( 'shibboleth', $shibSuccess );
1111 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
1112 }
1113 elsif ( $return == 2 ) {
1114
1115 #We suppose the user is the superlibrarian
1116 $borrowernumber = 0;
1117 $session->param( 'number', 0 );
1118 $session->param( 'id', C4::Context->config('user') );
1119 $session->param( 'cardnumber', C4::Context->config('user') );
1120 $session->param( 'firstname', C4::Context->config('user') );
1121 $session->param( 'surname', C4::Context->config('user') );
1122 $session->param( 'branch', 'NO_LIBRARY_SET' );
1123 $session->param( 'branchname', 'NO_LIBRARY_SET' );
1124 $session->param( 'flags', 1 );
1125 $session->param( 'emailaddress', C4::Context->preference('KohaAdminEmailAddress') );
1126 $session->param( 'ip', $session->remote_addr() );
1127 $session->param( 'lasttime', time() );
1128 }
1129 if ($persona) {
1130 $session->param( 'persona', 1 );
1131 }
1132 C4::Context->set_userenv(
1133 $session->param('number'), $session->param('id'),
1134 $session->param('cardnumber'), $session->param('firstname'),
1135 $session->param('surname'), $session->param('branch'),
1136 $session->param('branchname'), $session->param('flags'),
1137 $session->param('emailaddress'), $session->param('branchprinter'),
1138 $session->param('persona'), $session->param('shibboleth')
1139 );
1140
1141 }
1142 # $return: 0 = invalid user
1143 # reset to anonymous session
1144 else {
1145 $debug and warn "Login failed, resetting anonymous session...";
1146 if ($userid) {
1147 $info{'invalid_username_or_password'} = 1;
1148 C4::Context->_unset_userenv($sessionID);
1149 }
1150 $session->param( 'lasttime', time() );
1151 $session->param( 'ip', $session->remote_addr() );
1152 $session->param( 'sessiontype', 'anon' );
1153 }
1154 } # END if ( $userid = $query->param('userid') )
1155 elsif ( $type eq "opac" ) {
1156
1157 # if we are here this is an anonymous session; add public lists to it and a few other items...
1158 # anonymous sessions are created only for the OPAC
1159 $debug and warn "Initiating an anonymous session...";
1160
1161 # setting a couple of other session vars...
1162 $session->param( 'ip', $session->remote_addr() );
1163 $session->param( 'lasttime', time() );
1164 $session->param( 'sessiontype', 'anon' );
1165 }
1166 } # END unless ($userid)
1167
1168 # finished authentification, now respond
11691500ns if ( $loggedin || $authnotrequired )
1170 {
1171 # successful login
117218µs4341µs unless ($cookie) {
# spent 341µs making 4 calls to CGI::Cookie::as_string, avg 85µs/call
1173 $cookie = $query->cookie(
1174 -name => 'CGISESSID',
1175 -value => '',
1176 -HttpOnly => 1
1177 );
1178 }
117919µs return ( $userid, $cookie, $sessionID, $flags );
1180 }
1181
1182 #
1183 #
1184 # AUTH rejected, show the login/password template, after checking the DB.
1185 #
1186 #
1187
1188 # get the inputs from the incoming query
1189 my @inputs = ();
1190 foreach my $name ( param $query) {
1191 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1192 my $value = $query->param($name);
1193 push @inputs, { name => $name, value => $value };
1194 }
1195
1196 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1197 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1198 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1199
1200 my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
1201 my $template = C4::Templates::gettemplate( $template_name, $type, $query );
1202 $template->param(
1203 branchloop => GetBranchesLoop(),
1204 OpacAdditionalStylesheet => C4::Context->preference("OpacAdditionalStylesheet"),
1205 opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
1206 login => 1,
1207 INPUTS => \@inputs,
1208 casAuthentication => C4::Context->preference("casAuthentication"),
1209 shibbolethAuthentication => $shib,
1210 SessionRestrictionByIP => C4::Context->preference("SessionRestrictionByIP"),
1211 suggestion => C4::Context->preference("suggestion"),
1212 virtualshelves => C4::Context->preference("virtualshelves"),
1213 LibraryName => "" . C4::Context->preference("LibraryName"),
1214 LibraryNameTitle => "" . $LibraryNameTitle,
1215 opacuserlogin => C4::Context->preference("opacuserlogin"),
1216 OpacNav => C4::Context->preference("OpacNav"),
1217 OpacNavRight => C4::Context->preference("OpacNavRight"),
1218 OpacNavBottom => C4::Context->preference("OpacNavBottom"),
1219 opaccredits => C4::Context->preference("opaccredits"),
1220 OpacFavicon => C4::Context->preference("OpacFavicon"),
1221 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1222 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1223 OPACUserJS => C4::Context->preference("OPACUserJS"),
1224 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1225 OpacCloud => C4::Context->preference("OpacCloud"),
1226 OpacTopissue => C4::Context->preference("OpacTopissue"),
1227 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1228 OpacBrowser => C4::Context->preference("OpacBrowser"),
1229 opacheader => C4::Context->preference("opacheader"),
1230 TagsEnabled => C4::Context->preference("TagsEnabled"),
1231 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1232 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1233 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1234 intranetbookbag => C4::Context->preference("intranetbookbag"),
1235 IntranetNav => C4::Context->preference("IntranetNav"),
1236 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1237 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
1238 IntranetUserJS => C4::Context->preference("IntranetUserJS"),
1239 IndependentBranches => C4::Context->preference("IndependentBranches"),
1240 AutoLocation => C4::Context->preference("AutoLocation"),
1241 wrongip => $info{'wrongip'},
1242 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1243 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1244 persona => C4::Context->preference("Persona"),
1245 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1246 );
1247
1248 $template->param( OpacPublic => C4::Context->preference("OpacPublic") );
1249 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1250
1251 if ( $type eq 'opac' ) {
1252 require Koha::Virtualshelves;
1253 my $some_public_shelves = Koha::Virtualshelves->get_some_shelves(
1254 {
1255 category => 2,
1256 }
1257 );
1258 $template->param(
1259 some_public_shelves => $some_public_shelves,
1260 );
1261 }
1262
1263 if ($cas) {
1264
1265 # Is authentication against multiple CAS servers enabled?
1266 if ( C4::Auth_with_cas::multipleAuth && !$casparam ) {
1267 my $casservers = C4::Auth_with_cas::getMultipleAuth();
1268 my @tmplservers;
1269 foreach my $key ( keys %$casservers ) {
1270 push @tmplservers, { name => $key, value => login_cas_url( $query, $key, $type ) . "?cas=$key" };
1271 }
1272 $template->param(
1273 casServersLoop => \@tmplservers
1274 );
1275 } else {
1276 $template->param(
1277 casServerUrl => login_cas_url($query, undef, $type),
1278 );
1279 }
1280
1281 $template->param(
1282 invalidCasLogin => $info{'invalidCasLogin'}
1283 );
1284 }
1285
1286 if ($shib) {
1287 $template->param(
1288 shibbolethAuthentication => $shib,
1289 shibbolethLoginUrl => login_shib_url($query),
1290 );
1291 }
1292
1293 $template->param(
1294 LibraryName => C4::Context->preference("LibraryName"),
1295 );
1296 $template->param(%info);
1297
1298 # $cookie = $query->cookie(CGISESSID => $session->id
1299 # );
1300 print $query->header(
1301 -type => 'text/html',
1302 -charset => 'utf-8',
1303 -cookie => $cookie
1304 ),
1305 $template->output;
1306 safe_exit;
1307}
1308
1309=head2 check_api_auth
1310
1311 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1312
1313Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1314cookie, determine if the user has the privileges specified by C<$userflags>.
1315
1316C<check_api_auth> is is meant for authenticating users of web services, and
1317consequently will always return and will not attempt to redirect the user
1318agent.
1319
1320If a valid session cookie is already present, check_api_auth will return a status
1321of "ok", the cookie, and the Koha session ID.
1322
1323If no session cookie is present, check_api_auth will check the 'userid' and 'password
1324parameters and create a session cookie and Koha session if the supplied credentials
1325are OK.
1326
1327Possible return values in C<$status> are:
1328
1329=over
1330
1331=item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1332
1333=item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1334
1335=item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1336
1337=item "expired -- session cookie has expired; API user should resubmit userid and password
1338
1339=back
1340
1341=cut
1342
1343sub check_api_auth {
1344 my $query = shift;
1345 my $flagsrequired = shift;
1346
1347 my $dbh = C4::Context->dbh;
1348 my $timeout = _timeout_syspref();
1349
1350 unless ( C4::Context->preference('Version') ) {
1351
1352 # database has not been installed yet
1353 return ( "maintenance", undef, undef );
1354 }
1355 my $kohaversion = Koha::version();
1356 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1357 if ( C4::Context->preference('Version') < $kohaversion ) {
1358
1359 # database in need of version update; assume that
1360 # no API should be called while databsae is in
1361 # this condition.
1362 return ( "maintenance", undef, undef );
1363 }
1364
1365 # FIXME -- most of what follows is a copy-and-paste
1366 # of code from checkauth. There is an obvious need
1367 # for refactoring to separate the various parts of
1368 # the authentication code, but as of 2007-11-19 this
1369 # is deferred so as to not introduce bugs into the
1370 # regular authentication code for Koha 3.0.
1371
1372 # see if we have a valid session cookie already
1373 # however, if a userid parameter is present (i.e., from
1374 # a form submission, assume that any current cookie
1375 # is to be ignored
1376 my $sessionID = undef;
1377 unless ( $query->param('userid') ) {
1378 $sessionID = $query->cookie("CGISESSID");
1379 }
1380 if ( $sessionID && not( $cas && $query->param('PT') ) ) {
1381 my $session = get_session($sessionID);
1382 C4::Context->_new_userenv($sessionID);
1383 if ($session) {
1384 C4::Context->set_userenv(
1385 $session->param('number'), $session->param('id'),
1386 $session->param('cardnumber'), $session->param('firstname'),
1387 $session->param('surname'), $session->param('branch'),
1388 $session->param('branchname'), $session->param('flags'),
1389 $session->param('emailaddress'), $session->param('branchprinter')
1390 );
1391
1392 my $ip = $session->param('ip');
1393 my $lasttime = $session->param('lasttime');
1394 my $userid = $session->param('id');
1395 if ( $lasttime < time() - $timeout ) {
1396
1397 # time out
1398 $session->delete();
1399 $session->flush;
1400 C4::Context->_unset_userenv($sessionID);
1401 $userid = undef;
1402 $sessionID = undef;
1403 return ( "expired", undef, undef );
1404 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1405
1406 # IP address changed
1407 $session->delete();
1408 $session->flush;
1409 C4::Context->_unset_userenv($sessionID);
1410 $userid = undef;
1411 $sessionID = undef;
1412 return ( "expired", undef, undef );
1413 } else {
1414 my $cookie = $query->cookie(
1415 -name => 'CGISESSID',
1416 -value => $session->id,
1417 -HttpOnly => 1,
1418 );
1419 $session->param( 'lasttime', time() );
1420 my $flags = haspermission( $userid, $flagsrequired );
1421 if ($flags) {
1422 return ( "ok", $cookie, $sessionID );
1423 } else {
1424 $session->delete();
1425 $session->flush;
1426 C4::Context->_unset_userenv($sessionID);
1427 $userid = undef;
1428 $sessionID = undef;
1429 return ( "failed", undef, undef );
1430 }
1431 }
1432 } else {
1433 return ( "expired", undef, undef );
1434 }
1435 } else {
1436
1437 # new login
1438 my $userid = $query->param('userid');
1439 my $password = $query->param('password');
1440 my ( $return, $cardnumber );
1441
1442 # Proxy CAS auth
1443 if ( $cas && $query->param('PT') ) {
1444 my $retuserid;
1445 $debug and print STDERR "## check_api_auth - checking CAS\n";
1446
1447 # In case of a CAS authentication, we use the ticket instead of the password
1448 my $PT = $query->param('PT');
1449 ( $return, $cardnumber, $userid ) = check_api_auth_cas( $dbh, $PT, $query ); # EXTERNAL AUTH
1450 } else {
1451
1452 # User / password auth
1453 unless ( $userid and $password ) {
1454
1455 # caller did something wrong, fail the authenticateion
1456 return ( "failed", undef, undef );
1457 }
1458 ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password, $query );
1459 }
1460
1461 if ( $return and haspermission( $userid, $flagsrequired ) ) {
1462 my $session = get_session("");
1463 return ( "failed", undef, undef ) unless $session;
1464
1465 my $sessionID = $session->id;
1466 C4::Context->_new_userenv($sessionID);
1467 my $cookie = $query->cookie(
1468 -name => 'CGISESSID',
1469 -value => $sessionID,
1470 -HttpOnly => 1,
1471 );
1472 if ( $return == 1 ) {
1473 my (
1474 $borrowernumber, $firstname, $surname,
1475 $userflags, $branchcode, $branchname,
1476 $branchprinter, $emailaddress
1477 );
1478 my $sth =
1479 $dbh->prepare(
1480"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=?"
1481 );
1482 $sth->execute($userid);
1483 (
1484 $borrowernumber, $firstname, $surname,
1485 $userflags, $branchcode, $branchname,
1486 $branchprinter, $emailaddress
1487 ) = $sth->fetchrow if ( $sth->rows );
1488
1489 unless ( $sth->rows ) {
1490 my $sth = $dbh->prepare(
1491"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=?"
1492 );
1493 $sth->execute($cardnumber);
1494 (
1495 $borrowernumber, $firstname, $surname,
1496 $userflags, $branchcode, $branchname,
1497 $branchprinter, $emailaddress
1498 ) = $sth->fetchrow if ( $sth->rows );
1499
1500 unless ( $sth->rows ) {
1501 $sth->execute($userid);
1502 (
1503 $borrowernumber, $firstname, $surname, $userflags,
1504 $branchcode, $branchname, $branchprinter, $emailaddress
1505 ) = $sth->fetchrow if ( $sth->rows );
1506 }
1507 }
1508
1509 my $ip = $ENV{'REMOTE_ADDR'};
1510
1511 # if they specify at login, use that
1512 if ( $query->param('branch') ) {
1513 $branchcode = $query->param('branch');
1514 $branchname = GetBranchName($branchcode);
1515 }
1516 my $branches = GetBranches();
1517 my @branchesloop;
1518 foreach my $br ( keys %$branches ) {
1519
1520 # now we work with the treatment of ip
1521 my $domain = $branches->{$br}->{'branchip'};
1522 if ( $domain && $ip =~ /^$domain/ ) {
1523 $branchcode = $branches->{$br}->{'branchcode'};
1524
1525 # new op dev : add the branchprinter and branchname in the cookie
1526 $branchprinter = $branches->{$br}->{'branchprinter'};
1527 $branchname = $branches->{$br}->{'branchname'};
1528 }
1529 }
1530 $session->param( 'number', $borrowernumber );
1531 $session->param( 'id', $userid );
1532 $session->param( 'cardnumber', $cardnumber );
1533 $session->param( 'firstname', $firstname );
1534 $session->param( 'surname', $surname );
1535 $session->param( 'branch', $branchcode );
1536 $session->param( 'branchname', $branchname );
1537 $session->param( 'flags', $userflags );
1538 $session->param( 'emailaddress', $emailaddress );
1539 $session->param( 'ip', $session->remote_addr() );
1540 $session->param( 'lasttime', time() );
1541 } elsif ( $return == 2 ) {
1542
1543 #We suppose the user is the superlibrarian
1544 $session->param( 'number', 0 );
1545 $session->param( 'id', C4::Context->config('user') );
1546 $session->param( 'cardnumber', C4::Context->config('user') );
1547 $session->param( 'firstname', C4::Context->config('user') );
1548 $session->param( 'surname', C4::Context->config('user') );
1549 $session->param( 'branch', 'NO_LIBRARY_SET' );
1550 $session->param( 'branchname', 'NO_LIBRARY_SET' );
1551 $session->param( 'flags', 1 );
1552 $session->param( 'emailaddress', C4::Context->preference('KohaAdminEmailAddress') );
1553 $session->param( 'ip', $session->remote_addr() );
1554 $session->param( 'lasttime', time() );
1555 }
1556 C4::Context->set_userenv(
1557 $session->param('number'), $session->param('id'),
1558 $session->param('cardnumber'), $session->param('firstname'),
1559 $session->param('surname'), $session->param('branch'),
1560 $session->param('branchname'), $session->param('flags'),
1561 $session->param('emailaddress'), $session->param('branchprinter')
1562 );
1563 return ( "ok", $cookie, $sessionID );
1564 } else {
1565 return ( "failed", undef, undef );
1566 }
1567 }
1568}
1569
1570=head2 check_cookie_auth
1571
1572 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1573
1574Given a CGISESSID cookie set during a previous login to Koha, determine
1575if the user has the privileges specified by C<$userflags>.
1576
1577C<check_cookie_auth> is meant for authenticating special services
1578such as tools/upload-file.pl that are invoked by other pages that
1579have been authenticated in the usual way.
1580
1581Possible return values in C<$status> are:
1582
1583=over
1584
1585=item "ok" -- user authenticated; C<$sessionID> have valid values.
1586
1587=item "failed" -- credentials are not correct; C<$sessionid> are undef
1588
1589=item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1590
1591=item "expired -- session cookie has expired; API user should resubmit userid and password
1592
1593=back
1594
1595=cut
1596
1597
# spent 18.8ms (220µs+18.6) within C4::Auth::check_cookie_auth which was called: # once (220µs+18.6ms) by CGI::Compile::ROOT::home_vagrant_kohaclone_circ_ysearch_2epl::__ANON__[/home/vagrant/kohaclone/circ/ysearch.pl:115] at line 42 of circ/ysearch.pl
sub check_cookie_auth {
1598 my $cookie = shift;
1599 my $flagsrequired = shift;
1600
16011249µs my $dbh = C4::Context->dbh;
# spent 249µs making 1 call to C4::Context::dbh
160213.26ms my $timeout = _timeout_syspref();
# spent 3.26ms making 1 call to C4::Auth::_timeout_syspref
1603
160412.81ms unless ( C4::Context->preference('Version') ) {
# spent 2.81ms making 1 call to C4::Context::preference
1605
1606 # database has not been installed yet
1607 return ( "maintenance", undef );
1608 }
160914µs my $kohaversion = Koha::version();
# spent 4µs making 1 call to Koha::version
161039µs $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
# spent 6µs making 1 call to C4::Auth::CORE:subst # spent 3µs making 2 calls to C4::Auth::CORE:substcont, avg 1µs/call
161112.55ms if ( C4::Context->preference('Version') < $kohaversion ) {
# spent 2.55ms making 1 call to C4::Context::preference
1612
1613 # database in need of version update; assume that
1614 # no API should be called while databsae is in
1615 # this condition.
1616 return ( "maintenance", undef );
1617 }
1618
1619 # FIXME -- most of what follows is a copy-and-paste
1620 # of code from checkauth. There is an obvious need
1621 # for refactoring to separate the various parts of
1622 # the authentication code, but as of 2007-11-23 this
1623 # is deferred so as to not introduce bugs into the
1624 # regular authentication code for Koha 3.0.
1625
1626 # see if we have a valid session cookie already
1627 # however, if a userid parameter is present (i.e., from
1628 # a form submission, assume that any current cookie
1629 # is to be ignored
1630 unless ( defined $cookie and $cookie ) {
1631 return ( "failed", undef );
1632 }
1633 my $sessionID = $cookie;
163413.78ms my $session = get_session($sessionID);
# spent 3.78ms making 1 call to C4::Auth::get_session
163518µs C4::Context->_new_userenv($sessionID);
# spent 8µs making 1 call to C4::Context::_new_userenv
1636 if ($session) {
163711179µs C4::Context->set_userenv(
# spent 130µs making 1 call to C4::Context::set_userenv # spent 49µs making 10 calls to CGI::Session::param, avg 5µs/call
1638 $session->param('number'), $session->param('id'),
1639 $session->param('cardnumber'), $session->param('firstname'),
1640 $session->param('surname'), $session->param('branch'),
1641 $session->param('branchname'), $session->param('flags'),
1642 $session->param('emailaddress'), $session->param('branchprinter')
1643 );
1644
164515µs my $ip = $session->param('ip');
# spent 5µs making 1 call to CGI::Session::param
164614µs my $lasttime = $session->param('lasttime');
# spent 4µs making 1 call to CGI::Session::param
164714µs my $userid = $session->param('id');
# spent 4µs making 1 call to CGI::Session::param
164812.98ms if ( $lasttime < time() - $timeout ) {
# spent 2.98ms making 1 call to C4::Context::preference
1649
1650 # time out
1651 $session->delete();
1652 $session->flush;
1653 C4::Context->_unset_userenv($sessionID);
1654 $userid = undef;
1655 $sessionID = undef;
1656 return ("expired", undef);
1657 } elsif ( C4::Context->preference('SessionRestrictionByIP') && $ip ne $ENV{'REMOTE_ADDR'} ) {
1658
1659 # IP address changed
1660 $session->delete();
1661 $session->flush;
1662 C4::Context->_unset_userenv($sessionID);
1663 $userid = undef;
1664 $sessionID = undef;
1665 return ( "expired", undef );
1666 } else {
1667137µs $session->param( 'lasttime', time() );
# spent 37µs making 1 call to CGI::Session::param
16684960µs my $flags = haspermission( $userid, $flagsrequired );
# spent 954µs making 1 call to C4::Auth::haspermission # spent 5µs making 2 calls to DBI::common::DESTROY, avg 2µs/call # spent 900ns making 1 call to DBD::_mem::common::DESTROY
1669 if ($flags) {
1670 return ( "ok", $sessionID );
1671 } else {
1672 $session->delete();
1673 $session->flush;
1674 C4::Context->_unset_userenv($sessionID);
1675 $userid = undef;
1676 $sessionID = undef;
1677 return ( "failed", undef );
1678 }
1679 }
1680 } else {
1681 return ( "expired", undef );
1682 }
1683}
1684
1685=head2 get_session
1686
1687 use CGI::Session;
1688 my $session = get_session($sessionID);
1689
1690Given a session ID, retrieve the CGI::Session object used to store
1691the session's state. The session object can be used to store
1692data that needs to be accessed by different scripts during a
1693user's session.
1694
1695If the C<$sessionID> parameter is an empty string, a new session
1696will be created.
1697
1698=cut
1699
1700
# spent 67.8ms (271µs+67.5) within C4::Auth::get_session which was called 9 times, avg 7.53ms/call: # 4 times (145µs+39.4ms) by C4::Auth::checkauth at line 792, avg 9.88ms/call # 4 times (92µs+24.4ms) by C4::Search::History::get_from_session at line 203 of C4/Search/History.pm, avg 6.12ms/call # once (34µs+3.75ms) by C4::Auth::check_cookie_auth at line 1634
sub get_session {
17012800ns my $sessionID = shift;
1702229µs953.8ms my $storage_method = C4::Context->preference('SessionStorage');
# spent 53.8ms making 9 calls to C4::Context::preference, avg 5.98ms/call
1703223µs92.84ms my $dbh = C4::Context->dbh;
# spent 2.84ms making 9 calls to C4::Context::dbh, avg 315µs/call
17042400ns my $session;
1705239µs910.8ms if ( $storage_method eq 'mysql' ) {
# spent 10.8ms making 9 calls to CGI::Session::new, avg 1.21ms/call
1706 $session = new CGI::Session( "driver:MySQL;serializer:yaml;id:md5", $sessionID, { Handle => $dbh } );
1707 }
1708 elsif ( $storage_method eq 'Pg' ) {
1709 $session = new CGI::Session( "driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, { Handle => $dbh } );
1710 }
1711 elsif ( $storage_method eq 'memcached' && C4::Context->ismemcached ) {
1712 $session = new CGI::Session( "driver:memcached;serializer:yaml;id:md5", $sessionID, { Memcached => C4::Context->memcached } );
1713 }
1714 else {
1715 # catch all defaults to tmp should work on all systems
1716 $session = new CGI::Session( "driver:File;serializer:yaml;id:md5", $sessionID, { Directory => '/tmp' } );
1717 }
171827µs return $session;
1719}
1720
1721sub checkpw {
1722 my ( $dbh, $userid, $password, $query, $type ) = @_;
1723 $type = 'opac' unless $type;
1724 if ($ldap) {
1725 $debug and print STDERR "## checkpw - checking LDAP\n";
1726 my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
1727 return 0 if $retval == -1; # Incorrect password for LDAP login attempt
1728 ($retval) and return ( $retval, $retcard, $retuserid );
1729 }
1730
1731 if ( $cas && $query && $query->param('ticket') ) {
1732 $debug and print STDERR "## checkpw - checking CAS\n";
1733
1734 # In case of a CAS authentication, we use the ticket instead of the password
1735 my $ticket = $query->param('ticket');
1736 $query->delete('ticket'); # remove ticket to come back to original URL
1737 my ( $retval, $retcard, $retuserid ) = checkpw_cas( $dbh, $ticket, $query, $type ); # EXTERNAL AUTH
1738 ($retval) and return ( $retval, $retcard, $retuserid );
1739 return 0;
1740 }
1741
1742 # If we are in a shibboleth session (shibboleth is enabled, and a shibboleth match attribute is present)
1743 # Check for password to asertain whether we want to be testing against shibboleth or another method this
1744 # time around.
1745 if ( $shib && $shib_login && !$password ) {
1746
1747 $debug and print STDERR "## checkpw - checking Shibboleth\n";
1748
1749 # In case of a Shibboleth authentication, we expect a shibboleth user attribute
1750 # (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
1751 # shibboleth-authenticated user
1752
1753 # Then, we check if it matches a valid koha user
1754 if ($shib_login) {
1755 my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib($shib_login); # EXTERNAL AUTH
1756 ($retval) and return ( $retval, $retcard, $retuserid );
1757 return 0;
1758 }
1759 }
1760
1761 # INTERNAL AUTH
1762 return checkpw_internal(@_)
1763}
1764
1765sub checkpw_internal {
1766 my ( $dbh, $userid, $password ) = @_;
1767
1768 $password = Encode::encode( 'UTF-8', $password )
1769 if Encode::is_utf8($password);
1770
1771 if ( $userid && $userid eq C4::Context->config('user') ) {
1772 if ( $password && $password eq C4::Context->config('pass') ) {
1773
1774 # Koha superuser account
1775 # C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1776 return 2;
1777 }
1778 else {
1779 return 0;
1780 }
1781 }
1782
1783 my $sth =
1784 $dbh->prepare(
1785 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?"
1786 );
1787 $sth->execute($userid);
1788 if ( $sth->rows ) {
1789 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1790 $surname, $branchcode, $branchname, $flags )
1791 = $sth->fetchrow;
1792
1793 if ( checkpw_hash( $password, $stored_hash ) ) {
1794
1795 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1796 $firstname, $surname, $branchcode, $branchname, $flags );
1797 return 1, $cardnumber, $userid;
1798 }
1799 }
1800 $sth =
1801 $dbh->prepare(
1802 "select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
1803 );
1804 $sth->execute($userid);
1805 if ( $sth->rows ) {
1806 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1807 $surname, $branchcode, $branchname, $flags )
1808 = $sth->fetchrow;
1809
1810 if ( checkpw_hash( $password, $stored_hash ) ) {
1811
1812 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1813 $firstname, $surname, $branchcode, $branchname, $flags );
1814 return 1, $cardnumber, $userid;
1815 }
1816 }
1817 if ( $userid && $userid eq 'demo'
1818 && "$password" eq 'demo'
1819 && C4::Context->config('demo') )
1820 {
1821
1822 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1823 # some features won't be effective : modify systempref, modify MARC structure,
1824 return 2;
1825 }
1826 return 0;
1827}
1828
1829sub checkpw_hash {
1830 my ( $password, $stored_hash ) = @_;
1831
1832 return if $stored_hash eq '!';
1833
1834 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1835 my $hash;
1836 if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
1837 $hash = hash_password( $password, $stored_hash );
1838 } else {
1839 $hash = md5_base64($password);
1840 }
1841 return $hash eq $stored_hash;
1842}
1843
1844=head2 getuserflags
1845
1846 my $authflags = getuserflags($flags, $userid, [$dbh]);
1847
1848Translates integer flags into permissions strings hash.
1849
1850C<$flags> is the integer userflags value ( borrowers.userflags )
1851C<$userid> is the members.userid, used for building subpermissions
1852C<$authflags> is a hashref of permissions
1853
1854=cut
1855
1856
# spent 3.05ms (599µs+2.45) within C4::Auth::getuserflags which was called 5 times, avg 609µs/call: # 5 times (599µs+2.45ms) by C4::Auth::haspermission at line 1976, avg 609µs/call
sub getuserflags {
18571500ns my $flags = shift;
18581200ns my $userid = shift;
185916µs5482µs my $dbh = @_ ? shift : C4::Context->dbh;
# spent 482µs making 5 calls to C4::Context::dbh, avg 96µs/call
18601400ns my $userflags;
1861 {
1862 # I don't want to do this, but if someone logs in as the database
1863 # user, it would be preferable not to spam them to death with
1864 # numeric warnings. So, we make $flags numeric.
18651400ns282µs
# spent 73µs (65+9) within C4::Auth::BEGIN@1865 which was called: # once (65µs+9µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_errors_404_2epl::BEGIN@22 at line 1865
no warnings 'numeric';
# spent 73µs making 1 call to C4::Auth::BEGIN@1865 # spent 8µs making 1 call to warnings::unimport
186611µs $flags += 0;
1867 }
186815µs10315µs my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
# spent 171µs making 5 calls to DBI::db::prepare, avg 34µs/call # spent 144µs making 5 calls to DBD::mysql::db::prepare, avg 29µs/call
1869156µs5237µs $sth->execute;
# spent 237µs making 5 calls to DBI::st::execute, avg 47µs/call
1870
1871179µs100132µs while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
# spent 132µs making 100 calls to DBI::st::fetchrow, avg 1µs/call
1872 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1873 $userflags->{$flag} = 1;
1874 }
1875 else {
18761821µs $userflags->{$flag} = 0;
1877 }
1878 }
1879
1880 # get subpermissions and merge with top-level permissions
188112µs201.43ms my $user_subperms = get_user_subpermissions($userid);
# spent 1.41ms making 5 calls to C4::Auth::get_user_subpermissions, avg 281µs/call # spent 18µs making 10 calls to DBI::common::DESTROY, avg 2µs/call # spent 9µs making 5 calls to DBD::_mem::common::DESTROY, avg 2µs/call
188213µs foreach my $module ( keys %$user_subperms ) {
1883 next if $userflags->{$module} == 1; # user already has permission for everything in this module
1884 $userflags->{$module} = $user_subperms->{$module};
1885 }
1886
1887112µs return $userflags;
1888}
1889
1890=head2 get_user_subpermissions
1891
1892 $user_perm_hashref = get_user_subpermissions($userid);
1893
1894Given the userid (note, not the borrowernumber) of a staff user,
1895return a hashref of hashrefs of the specific subpermissions
1896accorded to the user. An example return is
1897
1898 {
1899 tools => {
1900 export_catalog => 1,
1901 import_patrons => 1,
1902 }
1903 }
1904
1905The top-level hash-key is a module or function code from
1906userflags.flag, while the second-level key is a code
1907from permissions.
1908
1909The results of this function do not give a complete picture
1910of the functions that a staff user can access; it is also
1911necessary to check borrowers.flags.
1912
1913=cut
1914
1915
# spent 1.41ms (152µs+1.25) within C4::Auth::get_user_subpermissions which was called 5 times, avg 281µs/call: # 5 times (152µs+1.25ms) by C4::Auth::getuserflags at line 1881, avg 281µs/call
sub get_user_subpermissions {
19161500ns my $userid = shift;
1917
191815µs5431µs my $dbh = C4::Context->dbh;
# spent 431µs making 5 calls to C4::Context::dbh, avg 86µs/call
191914µs10296µs my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
# spent 156µs making 5 calls to DBI::db::prepare, avg 31µs/call # spent 140µs making 5 calls to DBD::mysql::db::prepare, avg 28µs/call
1920 FROM user_permissions
1921 JOIN permissions USING (module_bit, code)
1922 JOIN userflags ON (module_bit = bit)
1923 JOIN borrowers USING (borrowernumber)
1924 WHERE userid = ?" );
1925143µs5458µs $sth->execute($userid);
# spent 458µs making 5 calls to DBI::st::execute, avg 92µs/call
1926
19271900ns my $user_perms = {};
192817µs10337µs while ( my $perm = $sth->fetchrow_hashref ) {
# spent 182µs making 5 calls to DBI::st::fetchrow_hashref, avg 36µs/call # spent 156µs making 5 calls to DBD::mysql::st::__ANON__[DBD/mysql.pm:799], avg 31µs/call
1929 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1930 }
1931118µs return $user_perms;
1932}
1933
1934=head2 get_all_subpermissions
1935
1936 my $perm_hashref = get_all_subpermissions();
1937
1938Returns a hashref of hashrefs defining all specific
1939permissions currently defined. The return value
1940has the same structure as that of C<get_user_subpermissions>,
1941except that the innermost hash value is the description
1942of the subpermission.
1943
1944=cut
1945
1946
# spent 9.58ms (1.41+8.17) within C4::Auth::get_all_subpermissions which was called 4 times, avg 2.39ms/call: # 4 times (1.41ms+8.17ms) by C4::Auth::get_template_and_user at line 253, avg 2.39ms/call
sub get_all_subpermissions {
194719µs42.67ms my $dbh = C4::Context->dbh;
# spent 2.67ms making 4 calls to C4::Context::dbh, avg 667µs/call
194815µs8415µs my $sth = $dbh->prepare( "SELECT flag, code
# spent 219µs making 4 calls to DBI::db::prepare, avg 55µs/call # spent 196µs making 4 calls to DBD::mysql::db::prepare, avg 49µs/call
1949 FROM permissions
1950 JOIN userflags ON (module_bit = bit)" );
1951154µs4271µs $sth->execute();
# spent 271µs making 4 calls to DBI::st::execute, avg 68µs/call
1952
19531900ns my $all_perms = {};
19541409µs6169.26ms while ( my $perm = $sth->fetchrow_hashref ) {
# spent 4.99ms making 308 calls to DBI::st::fetchrow_hashref, avg 16µs/call # spent 4.27ms making 308 calls to DBD::mysql::st::__ANON__[DBD/mysql.pm:799], avg 14µs/call
1955 $all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1956 }
1957121µs return $all_perms;
1958}
1959
1960=head2 haspermission
1961
1962 $flags = ($userid, $flagsrequired);
1963
1964C<$userid> the userid of the member
1965C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
1966
1967Returns member's flags or 0 if a permission is not met.
1968
1969=cut
1970
1971
# spent 6.04ms (224µs+5.82) within C4::Auth::haspermission which was called 5 times, avg 1.21ms/call: # 4 times (177µs+4.91ms) by C4::Auth::checkauth at line 890, avg 1.27ms/call # once (47µs+907µs) by C4::Auth::check_cookie_auth at line 1668
sub haspermission {
19721900ns my ( $userid, $flagsrequired ) = @_;
1973114µs152.72ms my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
# spent 2.18ms making 5 calls to C4::Context::dbh, avg 435µs/call # spent 286µs making 5 calls to DBI::db::prepare, avg 57µs/call # spent 262µs making 5 calls to DBD::mysql::db::prepare, avg 52µs/call
1974145µs5223µs $sth->execute($userid);
# spent 223µs making 5 calls to DBI::st::execute, avg 45µs/call
197518µs520µs my $row = $sth->fetchrow();
# spent 20µs making 5 calls to DBI::st::fetchrow, avg 4µs/call
197613µs203.07ms my $flags = getuserflags( $row, $userid );
# spent 3.05ms making 5 calls to C4::Auth::getuserflags, avg 609µs/call # spent 14µs making 10 calls to DBI::common::DESTROY, avg 1µs/call # spent 8µs making 5 calls to DBD::_mem::common::DESTROY, avg 2µs/call
1977115µs545µs if ( $userid eq C4::Context->config('user') ) {
# spent 45µs making 5 calls to C4::Context::config, avg 9µs/call
1978
1979 # Super User Account from /etc/koha.conf
1980 $flags->{'superlibrarian'} = 1;
1981 }
1982 elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
1983
1984 # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1985 $flags->{'superlibrarian'} = 1;
1986 }
1987
1988115µs return $flags if $flags->{superlibrarian};
1989
1990 foreach my $module ( keys %$flagsrequired ) {
1991 my $subperm = $flagsrequired->{$module};
1992 if ( $subperm eq '*' ) {
1993 return 0 unless ( $flags->{$module} == 1 or ref( $flags->{$module} ) );
1994 } else {
1995 return 0 unless (
1996 ( defined $flags->{$module} and
1997 $flags->{$module} == 1 )
1998 or
1999 ( ref( $flags->{$module} ) and
2000 exists $flags->{$module}->{$subperm} and
2001 $flags->{$module}->{$subperm} == 1 )
2002 );
2003 }
2004 }
2005 return $flags;
2006
2007 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
2008}
2009
2010
# spent 70µs (46+23) within C4::Auth::getborrowernumber which was called 4 times, avg 17µs/call: # 4 times (46µs+23µs) by C4::Auth::get_template_and_user at line 213, avg 17µs/call
sub getborrowernumber {
20111500ns my ($userid) = @_;
2012112µs423µs my $userenv = C4::Context->userenv;
# spent 23µs making 4 calls to C4::Context::userenv, avg 6µs/call
201316µs if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) {
2014 return $userenv->{number};
2015 }
2016 my $dbh = C4::Context->dbh;
2017 for my $field ( 'userid', 'cardnumber' ) {
2018 my $sth =
2019 $dbh->prepare("select borrowernumber from borrowers where $field=?");
2020 $sth->execute($userid);
2021 if ( $sth->rows ) {
2022 my ($bnumber) = $sth->fetchrow;
2023 return $bnumber;
2024 }
2025 }
2026 return 0;
2027}
2028
2029END { } # module clean-up code here (global destructor)
20301;
2031__END__
 
# spent 80µs within C4::Auth::CORE:match which was called 13 times, avg 6µs/call: # 5 times (40µs+0s) by C4::Auth::_timeout_syspref at line 731, avg 8µs/call # 4 times (23µs+0s) by C4::Auth::get_template_and_user at line 163, avg 6µs/call # 4 times (18µs+0s) by C4::Auth::get_template_and_user at line 173, avg 4µs/call
sub C4::Auth::CORE:match; # opcode
# spent 74µs within C4::Auth::CORE:regcomp which was called 4 times, avg 18µs/call: # 4 times (74µs+0s) by C4::Auth::get_template_and_user at line 163, avg 18µs/call
sub C4::Auth::CORE:regcomp; # opcode
# spent 36µs within C4::Auth::CORE:subst which was called 5 times, avg 7µs/call: # 4 times (30µs+0s) by C4::Auth::_version_check at line 705, avg 8µs/call # once (6µs+0s) by C4::Auth::check_cookie_auth at line 1610
sub C4::Auth::CORE:subst; # opcode
# spent 18µs within C4::Auth::CORE:substcont which was called 10 times, avg 2µs/call: # 8 times (15µs+0s) by C4::Auth::_version_check at line 705, avg 2µs/call # 2 times (3µs+0s) by C4::Auth::check_cookie_auth at line 1610, avg 1µs/call
sub C4::Auth::CORE:substcont; # opcode
Report produced by the NYTProf 6.02 Perl profiler, developed by Tim Bunce and Adam Kaplan.