← 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:31:36 2016

Filename/home/vagrant/kohaclone/C4/Auth.pm
StatementsExecuted 353 statements in 14.8ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1114.35ms4.77msC4::Auth::::BEGIN@25C4::Auth::BEGIN@25
1112.48ms9.16msC4::Auth::::BEGIN@23C4::Auth::BEGIN@23
1111.99ms1.59sC4::Auth::::BEGIN@43C4::Auth::BEGIN@43
1111.88ms2.26msC4::Auth::::BEGIN@32C4::Auth::BEGIN@32
111768µs264msC4::Auth::::get_template_and_userC4::Auth::get_template_and_user
111414µs857µsC4::Auth::::BEGIN@22C4::Auth::BEGIN@22
111291µs1.62msC4::Auth::::get_all_subpermissionsC4::Auth::get_all_subpermissions
111200µs24.2msC4::Auth::::checkauthC4::Auth::checkauth
111150µs194µsC4::Auth::::BEGIN@1865C4::Auth::BEGIN@1865
111102µs520µsC4::Auth::::getuserflagsC4::Auth::getuserflags
11164µs64µsC4::Auth::::CORE:regcompC4::Auth::CORE:regcomp (opcode)
22250µs14.4msC4::Auth::::get_sessionC4::Auth::get_session
11149µs788µsC4::Auth::::haspermissionC4::Auth::haspermission
11146µs238µsC4::Auth::::get_user_subpermissionsC4::Auth::get_user_subpermissions
11141µs4.04msC4::Auth::::_version_checkC4::Auth::_version_check
11122µs36µsC4::Auth::::BEGIN@20C4::Auth::BEGIN@20
11116µs19µsC4::Auth::::BEGIN@28C4::Auth::BEGIN@28
11115µs2.47msC4::Auth::::_timeout_sysprefC4::Auth::_timeout_syspref
11114µs30µsC4::Auth::::BEGIN@37C4::Auth::BEGIN@37
11113µs38µsC4::Auth::::BEGIN@34C4::Auth::BEGIN@34
33113µs13µsC4::Auth::::CORE:matchC4::Auth::CORE:match (opcode)
11113µs45µsC4::Auth::::BEGIN@24C4::Auth::BEGIN@24
11112µs17µsC4::Auth::::getborrowernumberC4::Auth::getborrowernumber
11112µs61µsC4::Auth::::BEGIN@30C4::Auth::BEGIN@30
11112µs70µsC4::Auth::::BEGIN@31C4::Auth::BEGIN@31
11112µs54µsC4::Auth::::BEGIN@36C4::Auth::BEGIN@36
11111µs20µsC4::Auth::::BEGIN@21C4::Auth::BEGIN@21
11110µs10µsC4::Auth::::BEGIN@33C4::Auth::BEGIN@33
11110µs81µsC4::Auth::::BEGIN@41C4::Auth::BEGIN@41
11110µs17µsC4::Auth::::BEGIN@29C4::Auth::BEGIN@29
1119µs9µsC4::Auth::::BEGIN@35C4::Auth::BEGIN@35
1118µs25µsC4::Auth::::BEGIN@38C4::Auth::BEGIN@38
1115µs5µsC4::Auth::::CORE:substC4::Auth::CORE:subst (opcode)
2112µs2µsC4::Auth::::CORE:substcontC4::Auth::CORE:substcont (opcode)
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::::check_cookie_authC4::Auth::check_cookie_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
20250µs250µs
# spent 36µs (22+14) within C4::Auth::BEGIN@20 which was called: # once (22µs+14µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 20
use strict;
# spent 36µs making 1 call to C4::Auth::BEGIN@20 # spent 14µs making 1 call to strict::import
21243µs230µs
# spent 20µs (11+10) within C4::Auth::BEGIN@21 which was called: # once (11µs+10µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 21
use warnings;
# spent 20µs making 1 call to C4::Auth::BEGIN@21 # spent 10µs making 1 call to warnings::import
222220µs2892µs
# spent 857µs (414+443) within C4::Auth::BEGIN@22 which was called: # once (414µs+443µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 22
use Digest::MD5 qw(md5_base64);
# spent 857µs making 1 call to C4::Auth::BEGIN@22 # spent 36µs making 1 call to Exporter::import
232151µs29.29ms
# spent 9.16ms (2.48+6.68) within C4::Auth::BEGIN@23 which was called: # once (2.48ms+6.68ms) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 23
use JSON qw/encode_json/;
# spent 9.16ms making 1 call to C4::Auth::BEGIN@23 # spent 128µs making 1 call to JSON::import
24265µs278µs
# spent 45µs (13+32) within C4::Auth::BEGIN@24 which was called: # once (13µs+32µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 24
use URI::Escape;
# spent 45µs making 1 call to C4::Auth::BEGIN@24 # spent 32µs making 1 call to Exporter::import
252188µs24.78ms
# spent 4.77ms (4.35+424µs) within C4::Auth::BEGIN@25 which was called: # once (4.35ms+424µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 25
use CGI::Session;
# spent 4.77ms making 1 call to C4::Auth::BEGIN@25 # spent 6µs making 1 call to CGI::Session::import
26
2712µsrequire Exporter;
28237µs222µs
# spent 19µs (16+3) within C4::Auth::BEGIN@28 which was called: # once (16µs+3µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 28
use C4::Context;
# spent 19µs making 1 call to C4::Auth::BEGIN@28 # spent 3µs making 1 call to C4::Context::import
29233µs223µs
# spent 17µs (10+6) within C4::Auth::BEGIN@29 which was called: # once (10µs+6µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 29
use C4::Templates; # to get the template
# spent 17µs making 1 call to C4::Auth::BEGIN@29 # spent 6µs making 1 call to Class::Accessor::import
30282µs2110µs
# spent 61µs (12+49) within C4::Auth::BEGIN@30 which was called: # once (12µs+49µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 30
use C4::Languages;
# spent 61µs making 1 call to C4::Auth::BEGIN@30 # spent 49µs making 1 call to Exporter::import
31288µs2129µs
# spent 70µs (12+59) within C4::Auth::BEGIN@31 which was called: # once (12µs+59µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 31
use C4::Branch; # GetBranches
# spent 70µs making 1 call to C4::Auth::BEGIN@31 # spent 59µs making 1 call to Exporter::import
322629µs12.26ms
# spent 2.26ms (1.88+383µs) within C4::Auth::BEGIN@32 which was called: # once (1.88ms+383µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 32
use C4::Search::History;
# spent 2.26ms making 1 call to C4::Auth::BEGIN@32
33232µs110µs
# spent 10µs within C4::Auth::BEGIN@33 which was called: # once (10µs+0s) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 33
use Koha;
# spent 10µs making 1 call to C4::Auth::BEGIN@33
34258µs263µs
# spent 38µs (13+25) within C4::Auth::BEGIN@34 which was called: # once (13µs+25µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 34
use Koha::AuthUtils qw(hash_password);
# spent 38µs making 1 call to C4::Auth::BEGIN@34 # spent 25µs making 1 call to Exporter::import
35229µs19µs
# spent 9µs within C4::Auth::BEGIN@35 which was called: # once (9µs+0s) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 35
use Koha::LibraryCategories;
# spent 9µs making 1 call to C4::Auth::BEGIN@35
36275µs295µs
# spent 54µs (12+42) within C4::Auth::BEGIN@36 which was called: # once (12µs+42µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 36
use POSIX qw/strftime/;
# spent 54µs making 1 call to C4::Auth::BEGIN@36 # spent 42µs making 1 call to POSIX::import
37252µs246µs
# spent 30µs (14+16) within C4::Auth::BEGIN@37 which was called: # once (14µs+16µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 37
use List::MoreUtils qw/ any /;
# spent 30µs making 1 call to C4::Auth::BEGIN@37 # spent 16µs making 1 call to Exporter::import
38254µs242µs
# spent 25µs (8+17) within C4::Auth::BEGIN@38 which was called: # once (8µs+17µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 38
use Encode qw( encode is_utf8);
# spent 25µs making 1 call to C4::Auth::BEGIN@38 # spent 17µs making 1 call to Exporter::import
39
40# use utf8;
412386µs2152µs
# spent 81µs (10+71) within C4::Auth::BEGIN@41 which was called: # once (10µs+71µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 41
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout $shib $shib_login);
# spent 81µs making 1 call to C4::Auth::BEGIN@41 # spent 71µs making 1 call to vars::import
42
43
# spent 1.59s (1.99ms+1.59) within C4::Auth::BEGIN@43 which was called: # once (1.99ms+1.59s) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 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 }
5011µs $VERSION = 3.07.00.049; # set version for version checking
51
521500ns $debug = $ENV{DEBUG};
5319µs @ISA = qw(Exporter);
541800ns @EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
551800ns @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash
56 &get_all_subpermissions &get_user_subpermissions
57 );
5812µs %EXPORT_TAGS = ( EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)] );
59114µs17µs $ldap = C4::Context->config('useldapserver') || 0;
# spent 7µs making 1 call to C4::Context::config
601872µs11.56s $cas = C4::Context->preference('casAuthentication');
# spent 1.56s making 1 call to C4::Context::preference
61117µs17µs $shib = C4::Context->config('useshibboleth') || 0;
# spent 7µs making 1 call to C4::Context::config
62111µs12.76ms $caslogout = C4::Context->preference('casLogout');
# spent 2.76ms making 1 call to C4::Context::preference
631597µs require C4::Auth_with_cas; # no import
64
651600ns if ($ldap) {
66 require C4::Auth_with_ldap;
67 import C4::Auth_with_ldap qw(checkpw_ldap);
68 }
691500ns 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 }
8617µs if ($cas) {
87 import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url);
88 }
89
9017.80ms11.59s}
# spent 1.59s 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 264ms (768µs+263) within C4::Auth::get_template_and_user which was called: # once (768µs+263ms) 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
1571600ns my $in = shift;
1581600ns my ( $user, $cookie, $sessionID, $flags );
159
160118µs17µs C4::Context->interface( $in->{type} );
# spent 7µs making 1 call to C4::Context::interface
161
1621600ns my $safe_chars = 'a-zA-Z0-9_\-\/';
163185µs270µs die "bad template path" unless $in->{'template_name'} =~ m/^[$safe_chars]+\.tt$/ig; #sanitize input
# spent 64µs making 1 call to C4::Auth::CORE:regcomp # spent 6µs making 1 call to C4::Auth::CORE:match
164
16511µs $in->{'authnotrequired'} ||= 0;
16616µs196.3ms my $template = C4::Templates::gettemplate(
# spent 96.3ms making 1 call to C4::Templates::gettemplate
167 $in->{'template_name'},
168 $in->{'type'},
169 $in->{'query'},
170 $in->{'is_plugin'}
171 );
172
173116µs224.2ms if ( $in->{'template_name'} !~ m/maintenance/ ) {
# spent 24.2ms making 1 call to C4::Auth::checkauth # spent 3µs making 1 call to C4::Auth::CORE:match
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
2051500ns my $borrowernumber;
2061900ns 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)
2121200ns my $borrower;
21313µs117µs $borrowernumber = getborrowernumber($user) if defined($user);
# spent 17µs making 1 call to C4::Auth::getborrowernumber
21411µ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 {
224119µs41.02ms $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
# spent 1.01ms making 1 call to C4::Members::GetMember # spent 6µs making 2 calls to DBI::common::DESTROY, avg 3µs/call # spent 4µs making 1 call to DBD::_mem::common::DESTROY
225 }
226
227 # user info
22814µs110µs $template->param( loggedinusername => $user );
# spent 10µs making 1 call to C4::Templates::param
22911µs13µs $template->param( loggedinusernumber => $borrowernumber );
# spent 3µs making 1 call to C4::Templates::param
23012µs13µs $template->param( sessionID => $sessionID );
# spent 3µs making 1 call to C4::Templates::param
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
25111µs14µs $template->param( "USER_INFO" => $borrower );
# spent 4µs making 1 call to C4::Templates::param
252
25313µs41.62ms my $all_perms = get_all_subpermissions();
# spent 1.62ms making 1 call to C4::Auth::get_all_subpermissions # spent 3µs making 2 calls to DBI::common::DESTROY, avg 1µs/call # spent 1µs making 1 call to DBD::_mem::common::DESTROY
254
25515µ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 ) {
26212µs15µs $template->param( CAN_user_circulate => 1 );
# spent 5µs making 1 call to C4::Templates::param
26312µs14µs $template->param( CAN_user_catalogue => 1 );
# spent 4µs making 1 call to C4::Templates::param
2641900ns12µs $template->param( CAN_user_parameters => 1 );
# spent 2µs making 1 call to C4::Templates::param
26511µs13µs $template->param( CAN_user_borrowers => 1 );
# spent 3µs making 1 call to C4::Templates::param
26611µs12µs $template->param( CAN_user_permissions => 1 );
# spent 2µs making 1 call to C4::Templates::param
26711µs12µs $template->param( CAN_user_reserveforothers => 1 );
# spent 2µs making 1 call to C4::Templates::param
26811µs13µs $template->param( CAN_user_editcatalogue => 1 );
# spent 3µs making 1 call to C4::Templates::param
26911µs13µs $template->param( CAN_user_updatecharges => 1 );
# spent 3µs making 1 call to C4::Templates::param
27012µs12µs $template->param( CAN_user_acquisition => 1 );
# spent 2µs making 1 call to C4::Templates::param
27111µs13µs $template->param( CAN_user_management => 1 );
# spent 3µs making 1 call to C4::Templates::param
27211µs12µs $template->param( CAN_user_tools => 1 );
# spent 2µs making 1 call to C4::Templates::param
27311µs13µs $template->param( CAN_user_editauthorities => 1 );
# spent 3µs making 1 call to C4::Templates::param
2741900ns12µs $template->param( CAN_user_serials => 1 );
# spent 2µs making 1 call to C4::Templates::param
2751900ns12µs $template->param( CAN_user_reports => 1 );
# spent 2µs making 1 call to C4::Templates::param
2761700ns12µs $template->param( CAN_user_staffaccess => 1 );
# spent 2µs making 1 call to C4::Templates::param
27711µs12µs $template->param( CAN_user_plugins => 1 );
# spent 2µs making 1 call to C4::Templates::param
27811µs13µs $template->param( CAN_user_coursereserves => 1 );
# spent 3µs making 1 call to C4::Templates::param
27914µs foreach my $module ( keys %$all_perms ) {
280
2811218µs foreach my $subperm ( keys %{ $all_perms->{$module} } ) {
28276101µs76195µs $template->param( "CAN_user_${module}_${subperm}" => 1 );
# spent 195µs making 76 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 ) {
289126µ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) {
30213µs foreach my $module ( keys %$flags ) {
303197µs if ( $flags->{$module} == 1 or ref( $flags->{$module} ) ) {
30411µs13µs $template->param( "CAN_user_$module" => 1 );
# spent 3µs making 1 call to C4::Templates::param
3051400ns 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
314110µs12.57ms if ( $in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory') ) {
# spent 2.57ms making 1 call to C4::Context::preference
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
389113µs17.59ms if ( C4::Context->preference('EnableOpacSearchHistory') ) {
# spent 7.59ms making 1 call to C4::Context::preference
390123µs34.35ms my @recentSearches = C4::Search::History::get_from_session( { cgi => $in->{'query'} } );
# spent 4.01ms making 1 call to C4::Search::History::get_from_session # spent 282µs making 1 call to CGI::Session::DESTROY # spent 53µs making 1 call to CGI::Session::Driver::DBI::DESTROY
3911600ns if (@recentSearches) {
392 $template->param( EnableOpacSearchHistory => 1 );
393 }
394 }
395
396111µs34.88ms if ( C4::Context->preference('dateformat') ) {
# spent 4.88ms making 2 calls to C4::Context::preference, avg 2.44ms/call # spent 9µs making 1 call to C4::Templates::param
397 $template->param( dateformat => C4::Context->preference('dateformat') );
398 }
399
4001236µs2228µs $template->param(auth_forwarded_hash => $in->{'query'}->param('auth_forwarded_hash'));
# spent 223µs making 1 call to CGI::param # spent 5µs making 1 call to C4::Templates::param
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'
4061260µs1260µs my $https = $in->{query}->https();
# spent 260µs making 1 call to CGI::AUTOLOAD
4071900ns my $using_https = ( defined $https and $https ne 'OFF' ) ? 1 : 0;
408
409115µs2749.9ms $template->param(
# spent 49.8ms making 16 calls to C4::Context::preference, avg 3.11ms/call # spent 42µs making 1 call to C4::Templates::param # spent 17µs making 10 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 );
433116µs3269.8ms if ( $in->{'type'} eq "intranet" ) {
# spent 69.8ms making 29 calls to C4::Context::preference, avg 2.41ms/call # spent 58µs making 1 call to C4::Templates::param # spent 8µs making 2 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
580123µs116µs if ( defined $in->{'query'}->param('language') ) {
# spent 16µs making 1 call to CGI::param
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
593110µ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 4.04ms (41µs+4.00) within C4::Auth::_version_check which was called: # once (41µs+4.00ms) by C4::Auth::checkauth at line 751
sub _version_check {
6751300ns my $type = shift;
6761300ns my $query = shift;
6771200ns 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
682111µs12.08ms if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) {
# spent 2.08ms making 1 call to C4::Context::preference
683 warn "OPAC Install required, redirecting to maintenance";
684 print $query->redirect("/cgi-bin/koha/maintenance.pl");
685 safe_exit;
686 }
68719µs11.90ms unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
# spent 1.90ms making 1 call to C4::Context::preference
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
70218µs12µs my $kohaversion = Koha::version();
# spent 2µs making 1 call to Koha::version
703
704 # remove the 3 last . to have a Perl number
705121µs37µs $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
# spent 5µs making 1 call to C4::Auth::CORE:subst # spent 2µs making 2 calls to C4::Auth::CORE:substcont, avg 1µs/call
7061500ns $debug and print STDERR "kohaversion : $kohaversion\n";
70718µ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 2.47ms (15µs+2.46) within C4::Auth::_timeout_syspref which was called: # once (15µs+2.46ms) by C4::Auth::checkauth at line 749
sub _timeout_syspref {
72817µs12.45ms my $timeout = C4::Context->preference('timeout') || 600;
# spent 2.45ms making 1 call to C4::Context::preference
729
730 # value in days, convert in seconds
73118µs14µs if ( $timeout =~ /(\d+)[dD]/ ) {
# spent 4µs making 1 call to C4::Auth::CORE:match
732 $timeout = $1 * 86400;
733 }
73414µs return $timeout;
735}
736
737
# spent 24.2ms (200µs+24.0) within C4::Auth::checkauth which was called: # once (200µs+24.0ms) by C4::Auth::get_template_and_user at line 173
sub checkauth {
7381300ns my $query = shift;
7391600ns $debug and warn "Checking Auth";
740
741 # $authnotrequired will be set for scripts which will run without authentication
7421300ns my $authnotrequired = shift;
7431200ns my $flagsrequired = shift;
7441600ns my $type = shift;
7451200ns my $persona = shift;
7461200ns $type = 'opac' unless $type;
747
74815µs186µs my $dbh = C4::Context->dbh;
# spent 86µs making 1 call to C4::Context::dbh
74913µs12.47ms my $timeout = _timeout_syspref();
# spent 2.47ms making 1 call to C4::Auth::_timeout_syspref
750
75112µs14.04ms _version_check( $type, $query );
# spent 4.04ms making 1 call to C4::Auth::_version_check
752
753 # state variables
7541600ns my $loggedin = 0;
7551200ns my %info;
7561300ns my ( $userid, $cookie, $sessionID, $flags );
757118µs111µs my $logout = $query->param('logout.x');
# spent 11µs making 1 call to CGI::param
758
7591200ns 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
76316µs13µs my $casparam = $query->param('cas');
# spent 3µs making 1 call to CGI::param
76415µs12µs my $q_userid = $query->param('userid') // '';
# spent 2µs making 1 call to CGI::param
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.
775133µs32.36ms if ( !$shib and defined( $ENV{'REMOTE_USER'} ) and $ENV{'REMOTE_USER'} ne '' and $userid = $ENV{'REMOTE_USER'} ) {
# spent 1.90ms making 1 call to CGI::Session::DESTROY # spent 400µs making 1 call to CGI::cookie # spent 55µs making 1 call to CGI::Session::Driver::DBI::DESTROY
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
79213µs111.2ms my $session = get_session($sessionID);
# spent 11.2ms making 1 call to C4::Auth::get_session
793112µs14µs C4::Context->_new_userenv($sessionID);
# spent 4µs making 1 call to C4::Context::_new_userenv
7941300ns my ( $ip, $lasttime, $sessiontype );
7951500ns my $s_userid = '';
79611µs if ($session) {
79713µs110µs $s_userid = $session->param('id') // '';
# spent 10µs making 1 call to CGI::Session::param
798185µs12259µs C4::Context->set_userenv(
# spent 218µs making 1 call to C4::Context::set_userenv # spent 42µs making 11 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µs210µs C4::Context::set_shelves_userenv( 'bar', $session->param('barshelves') );
# spent 5µs making 1 call to CGI::Session::param # spent 4µs making 1 call to C4::Context::set_shelves_userenv
80717µs27µs C4::Context::set_shelves_userenv( 'pub', $session->param('pubshelves') );
# spent 4µs making 1 call to CGI::Session::param # spent 3µs making 1 call to C4::Context::set_shelves_userenv
808111µs26µs C4::Context::set_shelves_userenv( 'tot', $session->param('totshelves') );
# spent 4µs making 1 call to CGI::Session::param # spent 2µs making 1 call to C4::Context::set_shelves_userenv
8091600ns $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
81012µs15µs $ip = $session->param('ip');
# spent 5µs making 1 call to CGI::Session::param
8111900ns14µs $lasttime = $session->param('lasttime');
# spent 4µs making 1 call to CGI::Session::param
8121400ns $userid = $s_userid;
81312µs13µs $sessiontype = $session->param('sessiontype') || '';
# spent 3µs making 1 call to CGI::Session::param
814 }
815138µs22.51ms if ( ( $query->param('koha_login_context') && ( $q_userid ne $s_userid ) )
# spent 2.49ms making 1 call to C4::Context::preference # spent 11µs making 1 call to CGI::param
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 {
88319µs2177µs $cookie = $query->cookie(
# spent 165µs making 1 call to CGI::cookie # spent 12µs making 1 call to CGI::Session::id
884 -name => 'CGISESSID',
885 -value => $session->id,
886 -HttpOnly => 1
887 );
88814µs129µs $session->param( 'lasttime', time() );
# spent 29µs making 1 call to CGI::Session::param
8891700ns 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...
89013µs4791µs $flags = haspermission( $userid, $flagsrequired );
# spent 788µs making 1 call to C4::Auth::haspermission # spent 3µs making 2 calls to DBI::common::DESTROY, avg 1µs/call # spent 600ns making 1 call to DBD::_mem::common::DESTROY
8911900ns if ($flags) {
892 $loggedin = 1;
893 } else {
894 $info{'nopermission'} = 1;
895 }
896 }
897 }
898 }
8991500ns 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
11691400ns if ( $loggedin || $authnotrequired )
1170 {
1171 # successful login
117215µs176µs unless ($cookie) {
# spent 76µs making 1 call to CGI::Cookie::as_string
1173 $cookie = $query->cookie(
1174 -name => 'CGISESSID',
1175 -value => '',
1176 -HttpOnly => 1
1177 );
1178 }
1179110µ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
1597sub check_cookie_auth {
1598 my $cookie = shift;
1599 my $flagsrequired = shift;
1600
1601 my $dbh = C4::Context->dbh;
1602 my $timeout = _timeout_syspref();
1603
1604 unless ( C4::Context->preference('Version') ) {
1605
1606 # database has not been installed yet
1607 return ( "maintenance", undef );
1608 }
1609 my $kohaversion = Koha::version();
1610 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1611 if ( C4::Context->preference('Version') < $kohaversion ) {
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;
1634 my $session = get_session($sessionID);
1635 C4::Context->_new_userenv($sessionID);
1636 if ($session) {
1637 C4::Context->set_userenv(
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
1645 my $ip = $session->param('ip');
1646 my $lasttime = $session->param('lasttime');
1647 my $userid = $session->param('id');
1648 if ( $lasttime < time() - $timeout ) {
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 {
1667 $session->param( 'lasttime', time() );
1668 my $flags = haspermission( $userid, $flagsrequired );
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 14.4ms (50µs+14.3) within C4::Auth::get_session which was called 2 times, avg 7.19ms/call: # once (29µs+11.1ms) by C4::Auth::checkauth at line 792 # once (21µs+3.19ms) by C4::Search::History::get_from_session at line 203 of C4/Search/History.pm
sub get_session {
17012800ns my $sessionID = shift;
1702223µs28.88ms my $storage_method = C4::Context->preference('SessionStorage');
# spent 8.88ms making 2 calls to C4::Context::preference, avg 4.44ms/call
1703219µs2228µs my $dbh = C4::Context->dbh;
# spent 228µs making 2 calls to C4::Context::dbh, avg 114µs/call
17042700ns my $session;
1705216µs25.23ms if ( $storage_method eq 'mysql' ) {
# spent 5.23ms making 2 calls to CGI::Session::new, avg 2.62ms/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 }
1718210µ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 520µs (102+417) within C4::Auth::getuserflags which was called: # once (102µs+417µs) by C4::Auth::haspermission at line 1976
sub getuserflags {
18571600ns my $flags = shift;
18581400ns my $userid = shift;
185916µs181µs my $dbh = @_ ? shift : C4::Context->dbh;
# spent 81µs making 1 call to C4::Context::dbh
18601200ns 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.
18653879µs2239µs
# spent 194µs (150+45) within C4::Auth::BEGIN@1865 which was called: # once (150µs+45µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@25 at line 1865
no warnings 'numeric';
# spent 194µs making 1 call to C4::Auth::BEGIN@1865 # spent 45µs making 1 call to warnings::unimport
186611µs $flags += 0;
1867 }
186816µs255µs my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
# spent 30µs making 1 call to DBI::db::prepare # spent 25µs making 1 call to DBD::mysql::db::prepare
1869149µs144µs $sth->execute;
# spent 44µs making 1 call to DBI::st::execute
1870
1871174µs2022µs while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
# spent 22µs making 20 calls to DBI::st::fetchrow, avg 1µs/call
1872 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1873 $userflags->{$flag} = 1;
1874 }
1875 else {
18761816µs $userflags->{$flag} = 0;
1877 }
1878 }
1879
1880 # get subpermissions and merge with top-level permissions
188113µs4243µs my $user_subperms = get_user_subpermissions($userid);
# spent 238µs making 1 call to C4::Auth::get_user_subpermissions # spent 4µs making 2 calls to DBI::common::DESTROY, avg 2µs/call # spent 2µs making 1 call to DBD::_mem::common::DESTROY
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
1887116µ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 238µs (46+192) within C4::Auth::get_user_subpermissions which was called: # once (46µs+192µs) by C4::Auth::getuserflags at line 1881
sub get_user_subpermissions {
19161600ns my $userid = shift;
1917
191815µs181µs my $dbh = C4::Context->dbh;
# spent 81µs making 1 call to C4::Context::dbh
191915µs254µs my $sth = $dbh->prepare( "SELECT flag, user_permissions.code
# spent 29µs making 1 call to DBI::db::prepare # spent 25µs making 1 call to DBD::mysql::db::prepare
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 = ?" );
1925146µs140µs $sth->execute($userid);
# spent 40µs making 1 call to DBI::st::execute
1926
19271700ns my $user_perms = {};
1928119µs268µs while ( my $perm = $sth->fetchrow_hashref ) {
# spent 37µs making 1 call to DBI::st::fetchrow_hashref # spent 31µs making 1 call to DBD::mysql::st::__ANON__[DBD/mysql.pm:799]
1929 $user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1;
1930 }
1931123µ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 1.62ms (291µs+1.33) within C4::Auth::get_all_subpermissions which was called: # once (291µs+1.33ms) by C4::Auth::get_template_and_user at line 253
sub get_all_subpermissions {
194717µs1103µs my $dbh = C4::Context->dbh;
# spent 103µs making 1 call to C4::Context::dbh
194817µs266µs my $sth = $dbh->prepare( "SELECT flag, code
# spent 35µs making 1 call to DBI::db::prepare # spent 30µs making 1 call to DBD::mysql::db::prepare
1949 FROM permissions
1950 JOIN userflags ON (module_bit = bit)" );
1951169µs162µs $sth->execute();
# spent 62µs making 1 call to DBI::st::execute
1952
19531800ns my $all_perms = {};
19541394µs1542.06ms while ( my $perm = $sth->fetchrow_hashref ) {
# spent 1.12ms making 77 calls to DBI::st::fetchrow_hashref, avg 15µs/call # spent 933µs making 77 calls to DBD::mysql::st::__ANON__[DBD/mysql.pm:799], avg 12µ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 788µs (49+739) within C4::Auth::haspermission which was called: # once (49µs+739µs) by C4::Auth::checkauth at line 890
sub haspermission {
19721800ns my ( $userid, $flagsrequired ) = @_;
1973115µs3212µs my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
# spent 117µs making 1 call to C4::Context::dbh # spent 50µs making 1 call to DBI::db::prepare # spent 44µs making 1 call to DBD::mysql::db::prepare
1974144µs138µs $sth->execute($userid);
# spent 38µs making 1 call to DBI::st::execute
197519µs14µs my $row = $sth->fetchrow();
# spent 4µs making 1 call to DBI::st::fetchrow
197613µs4522µs my $flags = getuserflags( $row, $userid );
# spent 520µs making 1 call to C4::Auth::getuserflags # spent 2µs making 2 calls to DBI::common::DESTROY, avg 900ns/call # spent 800ns making 1 call to DBD::_mem::common::DESTROY
1977114µs16µs if ( $userid eq C4::Context->config('user') ) {
# spent 6µs making 1 call to C4::Context::config
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
1988116µ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 17µs (12+6) within C4::Auth::getborrowernumber which was called: # once (12µs+6µs) by C4::Auth::get_template_and_user at line 213
sub getborrowernumber {
20111500ns my ($userid) = @_;
2012112µs16µs my $userenv = C4::Context->userenv;
# spent 6µs making 1 call to C4::Context::userenv
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)
203016µs1;
2031__END__
 
# spent 13µs within C4::Auth::CORE:match which was called 3 times, avg 4µs/call: # once (6µs+0s) by C4::Auth::get_template_and_user at line 163 # once (4µs+0s) by C4::Auth::_timeout_syspref at line 731 # once (3µs+0s) by C4::Auth::get_template_and_user at line 173
sub C4::Auth::CORE:match; # opcode
# spent 64µs within C4::Auth::CORE:regcomp which was called: # once (64µs+0s) by C4::Auth::get_template_and_user at line 163
sub C4::Auth::CORE:regcomp; # opcode
# spent 5µs within C4::Auth::CORE:subst which was called: # once (5µs+0s) by C4::Auth::_version_check at line 705
sub C4::Auth::CORE:subst; # opcode
# spent 2µs within C4::Auth::CORE:substcont which was called 2 times, avg 1µs/call: # 2 times (2µs+0s) by C4::Auth::_version_check at line 705, 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.