← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:51 2015

Filename/mnt/catalyst/koha/C4/Auth.pm
StatementsExecuted 122 statements in 42.3ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11113.8ms13.9msC4::Auth::::BEGIN@24C4::Auth::BEGIN@24
11112.1ms12.5msC4::Auth::::BEGIN@22C4::Auth::BEGIN@22
1114.08ms44.8msC4::Auth::::BEGIN@29C4::Auth::BEGIN@29
1113.89ms8.49msC4::Auth::::BEGIN@25C4::Auth::BEGIN@25
1113.76ms4.73msC4::Auth::::BEGIN@31C4::Auth::BEGIN@31
1113.58ms132msC4::Auth::::BEGIN@39C4::Auth::BEGIN@39
1112.33ms28.3msC4::Auth::::BEGIN@23C4::Auth::BEGIN@23
111541µs560µsC4::Auth::::BEGIN@20C4::Auth::BEGIN@20
111180µs21.7msC4::Auth::::check_api_authC4::Auth::check_api_auth
111159µs632µsC4::Auth::::getuserflagsC4::Auth::getuserflags
11182µs926µsC4::Auth::::haspermissionC4::Auth::haspermission
11151µs287µsC4::Auth::::get_user_subpermissionsC4::Auth::get_user_subpermissions
11120µs11.8msC4::Auth::::get_sessionC4::Auth::get_session
11118µs52µsC4::Auth::::BEGIN@32C4::Auth::BEGIN@32
11116µs48µsC4::Auth::::BEGIN@34C4::Auth::BEGIN@34
11114µs26µsC4::Auth::::BEGIN@21C4::Auth::BEGIN@21
11114µs69µsC4::Auth::::BEGIN@33C4::Auth::BEGIN@33
11112µs32µsC4::Auth::::BEGIN@1637C4::Auth::BEGIN@1637
11112µs15µsC4::Auth::::BEGIN@28C4::Auth::BEGIN@28
11111µs84µsC4::Auth::::BEGIN@30C4::Auth::BEGIN@30
11111µs154µsC4::Auth::::BEGIN@37C4::Auth::BEGIN@37
11110µs180µsC4::Auth::::_timeout_sysprefC4::Auth::_timeout_syspref
1115µs5µsC4::Auth::::CORE:substC4::Auth::CORE:subst (opcode)
1113µs3µsC4::Auth::::CORE:matchC4::Auth::CORE:match (opcode)
2112µs2µsC4::Auth::::CORE:substcontC4::Auth::CORE:substcont (opcode)
1112µs2µsC4::Auth::::ENDC4::Auth::END
0000s0sC4::Auth::::ParseSearchHistorySessionC4::Auth::ParseSearchHistorySession
0000s0sC4::Auth::::SetSearchHistorySessionC4::Auth::SetSearchHistorySession
0000s0sC4::Auth::::__ANON__[:40]C4::Auth::__ANON__[:40]
0000s0sC4::Auth::::_session_logC4::Auth::_session_log
0000s0sC4::Auth::::_version_checkC4::Auth::_version_check
0000s0sC4::Auth::::check_cookie_authC4::Auth::check_cookie_auth
0000s0sC4::Auth::::checkauthC4::Auth::checkauth
0000s0sC4::Auth::::checkpwC4::Auth::checkpw
0000s0sC4::Auth::::checkpw_hashC4::Auth::checkpw_hash
0000s0sC4::Auth::::checkpw_internalC4::Auth::checkpw_internal
0000s0sC4::Auth::::get_all_subpermissionsC4::Auth::get_all_subpermissions
0000s0sC4::Auth::::get_template_and_userC4::Auth::get_template_and_user
0000s0sC4::Auth::::getborrowernumberC4::Auth::getborrowernumber
0000s0sC4::Auth::::psgi_envC4::Auth::psgi_env
0000s0sC4::Auth::::safe_exitC4::Auth::safe_exit
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package C4::Auth;
2
3# Copyright 2000-2002 Katipo Communications
4#
5# This file is part of Koha.
6#
7# Koha is free software; you can redistribute it and/or modify it under the
8# terms of the GNU General Public License as published by the Free Software
9# Foundation; either version 2 of the License, or (at your option) any later
10# version.
11#
12# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License along
17# with Koha; if not, write to the Free Software Foundation, Inc.,
18# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20240µs2579µs
# spent 560µs (541+19) within C4::Auth::BEGIN@20 which was called: # once (541µs+19µs) by C4::Service::BEGIN@49 at line 20
use strict;
# spent 560µs making 1 call to C4::Auth::BEGIN@20 # spent 19µs making 1 call to strict::import
21241µs237µs
# spent 26µs (14+11) within C4::Auth::BEGIN@21 which was called: # once (14µs+11µs) by C4::Service::BEGIN@49 at line 21
use warnings;
# spent 26µs making 1 call to C4::Auth::BEGIN@21 # spent 11µs making 1 call to warnings::import
22210.8ms212.5ms
# spent 12.5ms (12.1+399µs) within C4::Auth::BEGIN@22 which was called: # once (12.1ms+399µs) by C4::Service::BEGIN@49 at line 22
use Digest::MD5 qw(md5_base64);
# spent 12.5ms making 1 call to C4::Auth::BEGIN@22 # spent 43µs making 1 call to Exporter::import
232734µs228.4ms
# spent 28.3ms (2.33+25.9) within C4::Auth::BEGIN@23 which was called: # once (2.33ms+25.9ms) by C4::Service::BEGIN@49 at line 23
use JSON qw/encode_json decode_json/;
# spent 28.3ms making 1 call to C4::Auth::BEGIN@23 # spent 135µs making 1 call to JSON::import
24213.0ms213.9ms
# spent 13.9ms (13.8+114µs) within C4::Auth::BEGIN@24 which was called: # once (13.8ms+114µs) by C4::Service::BEGIN@49 at line 24
use URI::Escape;
# spent 13.9ms making 1 call to C4::Auth::BEGIN@24 # spent 39µs making 1 call to Exporter::import
252778µs28.49ms
# spent 8.49ms (3.89+4.60) within C4::Auth::BEGIN@25 which was called: # once (3.89ms+4.60ms) by C4::Service::BEGIN@49 at line 25
use CGI::Session;
# spent 8.49ms making 1 call to C4::Auth::BEGIN@25 # spent 2µs making 1 call to CGI::Session::import
26
2711µsrequire Exporter;
28224µs218µs
# spent 15µs (12+3) within C4::Auth::BEGIN@28 which was called: # once (12µs+3µs) by C4::Service::BEGIN@49 at line 28
use C4::Context;
# spent 15µs making 1 call to C4::Auth::BEGIN@28 # spent 3µs making 1 call to C4::Context::import
2922.87ms244.8ms
# spent 44.8ms (4.08+40.7) within C4::Auth::BEGIN@29 which was called: # once (4.08ms+40.7ms) by C4::Service::BEGIN@49 at line 29
use C4::Templates; # to get the template
# spent 44.8ms making 1 call to C4::Auth::BEGIN@29 # spent 4µs making 1 call to Class::Accessor::import
30226µs2158µs
# spent 84µs (11+73) within C4::Auth::BEGIN@30 which was called: # once (11µs+73µs) by C4::Service::BEGIN@49 at line 30
use C4::Branch; # GetBranches
# spent 84µs making 1 call to C4::Auth::BEGIN@30 # spent 73µs making 1 call to Exporter::import
3122.34ms24.94ms
# spent 4.73ms (3.76+971µs) within C4::Auth::BEGIN@31 which was called: # once (3.76ms+971µs) by C4::Service::BEGIN@49 at line 31
use C4::VirtualShelves;
# spent 4.73ms making 1 call to C4::Auth::BEGIN@31 # spent 210µs making 1 call to Exporter::import
32245µs286µs
# spent 52µs (18+34) within C4::Auth::BEGIN@32 which was called: # once (18µs+34µs) by C4::Service::BEGIN@49 at line 32
use Koha::AuthUtils qw(hash_password);
# spent 52µs making 1 call to C4::Auth::BEGIN@32 # spent 34µs making 1 call to Exporter::import
33245µs2124µs
# spent 69µs (14+55) within C4::Auth::BEGIN@33 which was called: # once (14µs+55µs) by C4::Service::BEGIN@49 at line 33
use POSIX qw/strftime/;
# spent 69µs making 1 call to C4::Auth::BEGIN@33 # spent 55µs making 1 call to POSIX::import
34248µs280µs
# spent 48µs (16+32) within C4::Auth::BEGIN@34 which was called: # once (16µs+32µs) by C4::Service::BEGIN@49 at line 34
use List::MoreUtils qw/ any /;
# spent 48µs making 1 call to C4::Auth::BEGIN@34 # spent 32µs making 1 call to Exporter::import
35
36# use utf8;
372304µs2296µs
# spent 154µs (11+143) within C4::Auth::BEGIN@37 which was called: # once (11µs+143µs) by C4::Service::BEGIN@49 at line 37
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout);
# spent 154µs making 1 call to C4::Auth::BEGIN@37 # spent 143µs making 1 call to vars::import
38
39
# spent 132ms (3.58+129) within C4::Auth::BEGIN@39 which was called: # once (3.58ms+129ms) by C4::Service::BEGIN@49 at line 67
BEGIN {
40 sub psgi_env { any { /^psgi\./ } keys %ENV }
41 sub safe_exit {
42 if ( psgi_env ) { die 'psgi:exit' }
43 else { exit }
44 }
4511µs $VERSION = 3.07.00.049; # set version for version checking
46
471600ns $debug = $ENV{DEBUG};
4817µs @ISA = qw(Exporter);
4911µs @EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
5011µs @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash
51 &get_all_subpermissions &get_user_subpermissions
52 ParseSearchHistorySession SetSearchHistorySession
53 );
5412µs %EXPORT_TAGS = ( EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)] );
5514µs115µs $ldap = C4::Context->config('useldapserver') || 0;
# spent 15µs making 1 call to C4::Context::config
5614µs136.3ms $cas = C4::Context->preference('casAuthentication');
# spent 36.3ms making 1 call to C4::Context::preference
5714µs1154µs $caslogout = C4::Context->preference('casLogout');
# spent 154µs making 1 call to C4::Context::preference
5812.75ms require C4::Auth_with_cas; # no import
591600ns if ($ldap) {
60 require C4::Auth_with_ldap;
61 import C4::Auth_with_ldap qw(checkpw_ldap);
62 }
6315µs if ($cas) {
64 import C4::Auth_with_cas qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url);
65 }
66
6716.57ms1132ms}
# spent 132ms making 1 call to C4::Auth::BEGIN@39
68
69=head1 NAME
70
71C4::Auth - Authenticates Koha users
72
73=head1 SYNOPSIS
74
75 use CGI;
76 use C4::Auth;
77 use C4::Output;
78
79 my $query = new CGI;
80
81 my ($template, $borrowernumber, $cookie)
82 = get_template_and_user(
83 {
84 template_name => "opac-main.tmpl",
85 query => $query,
86 type => "opac",
87 authnotrequired => 0,
88 flagsrequired => {borrow => 1, catalogue => '*', tools => 'import_patrons' },
89 }
90 );
91
92 output_html_with_http_headers $query, $cookie, $template->output;
93
94=head1 DESCRIPTION
95
96The main function of this module is to provide
97authentification. However the get_template_and_user function has
98been provided so that a users login information is passed along
99automatically. This gets loaded into the template.
100
101=head1 FUNCTIONS
102
103=head2 get_template_and_user
104
105 my ($template, $borrowernumber, $cookie)
106 = get_template_and_user(
107 {
108 template_name => "opac-main.tmpl",
109 query => $query,
110 type => "opac",
111 authnotrequired => 0,
112 flagsrequired => {borrow => 1, catalogue => '*', tools => 'import_patrons' },
113 }
114 );
115
116This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
117to C<&checkauth> (in this module) to perform authentification.
118See C<&checkauth> for an explanation of these parameters.
119
120The C<template_name> is then used to find the correct template for
121the page. The authenticated users details are loaded onto the
122template in the HTML::Template LOOP variable C<USER_INFO>. Also the
123C<sessionID> is passed to the template. This can be used in templates
124if cookies are disabled. It needs to be put as and input to every
125authenticated page.
126
127More information on the C<gettemplate> sub can be found in the
128Output.pm module.
129
130=cut
131
1321700nsmy $SEARCH_HISTORY_INSERT_SQL =<<EOQ;
133INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time )
134VALUES ( ?, ?, ?, ?, ?, FROM_UNIXTIME(?))
135EOQ
136
137sub get_template_and_user {
138
139 my $in = shift;
140 my ( $user, $cookie, $sessionID, $flags );
141
142 $in->{'authnotrequired'} ||= 0;
143 my $template = C4::Templates::gettemplate(
144 $in->{'template_name'},
145 $in->{'type'},
146 $in->{'query'},
147 $in->{'is_plugin'}
148 );
149
150 if ( $in->{'template_name'} !~m/maintenance/ ) {
151 ( $user, $cookie, $sessionID, $flags ) = checkauth(
152 $in->{'query'},
153 $in->{'authnotrequired'},
154 $in->{'flagsrequired'},
155 $in->{'type'}
156 );
157 }
158
159 my $borrowernumber;
160 if ($user) {
161 require C4::Members;
162 # It's possible for $user to be the borrowernumber if they don't have a
163 # userid defined (and are logging in through some other method, such
164 # as SSL certs against an email address)
165 $borrowernumber = getborrowernumber($user) if defined($user);
166 if (!defined($borrowernumber) && defined($user)) {
167 my $borrower = C4::Members::GetMember(borrowernumber => $user);
168 if ($borrower) {
169 $borrowernumber = $user;
170 # A bit of a hack, but I don't know there's a nicer way
171 # to do it.
172 $user = $borrower->{firstname} . ' ' . $borrower->{surname};
173 }
174 }
175
176 # user info
177 $template->param( loggedinusername => $user );
178 $template->param( sessionID => $sessionID );
179
180 my ($total, $pubshelves, $barshelves) = C4::VirtualShelves::GetSomeShelfNames($borrowernumber, 'MASTHEAD');
181 $template->param(
182 pubshelves => $total->{pubtotal},
183 pubshelvesloop => $pubshelves,
184 barshelves => $total->{bartotal},
185 barshelvesloop => $barshelves,
186 );
187
188 my ( $borr ) = C4::Members::GetMemberDetails( $borrowernumber );
189 my @bordat;
190 $bordat[0] = $borr;
191 $template->param( "USER_INFO" => \@bordat );
192
193 my $all_perms = get_all_subpermissions();
194
195 my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
196 editcatalogue updatecharges management tools editauthorities serials reports acquisition);
197 # We are going to use the $flags returned by checkauth
198 # to create the template's parameters that will indicate
199 # which menus the user can access.
200 if ( $flags && $flags->{superlibrarian}==1 ) {
201 $template->param( CAN_user_circulate => 1 );
202 $template->param( CAN_user_catalogue => 1 );
203 $template->param( CAN_user_parameters => 1 );
204 $template->param( CAN_user_borrowers => 1 );
205 $template->param( CAN_user_permissions => 1 );
206 $template->param( CAN_user_reserveforothers => 1 );
207 $template->param( CAN_user_borrow => 1 );
208 $template->param( CAN_user_editcatalogue => 1 );
209 $template->param( CAN_user_updatecharges => 1 );
210 $template->param( CAN_user_acquisition => 1 );
211 $template->param( CAN_user_management => 1 );
212 $template->param( CAN_user_tools => 1 );
213 $template->param( CAN_user_editauthorities => 1 );
214 $template->param( CAN_user_serials => 1 );
215 $template->param( CAN_user_reports => 1 );
216 $template->param( CAN_user_staffaccess => 1 );
217 $template->param( CAN_user_plugins => 1 );
218 $template->param( CAN_user_coursereserves => 1 );
219 foreach my $module (keys %$all_perms) {
220 foreach my $subperm (keys %{ $all_perms->{$module} }) {
221 $template->param( "CAN_user_${module}_${subperm}" => 1 );
222 }
223 }
224 }
225
226 if ( $flags ) {
227 foreach my $module (keys %$all_perms) {
228 if ( $flags->{$module} == 1) {
229 foreach my $subperm (keys %{ $all_perms->{$module} }) {
230 $template->param( "CAN_user_${module}_${subperm}" => 1 );
231 }
232 } elsif ( ref($flags->{$module}) ) {
233 foreach my $subperm (keys %{ $flags->{$module} } ) {
234 $template->param( "CAN_user_${module}_${subperm}" => 1 );
235 }
236 }
237 }
238 }
239
240 if ($flags) {
241 foreach my $module (keys %$flags) {
242 if ( $flags->{$module} == 1 or ref($flags->{$module}) ) {
243 $template->param( "CAN_user_$module" => 1 );
244 if ($module eq "parameters") {
245 $template->param( CAN_user_management => 1 );
246 }
247 }
248 }
249 }
250 # Logged-in opac search history
251 # If the requested template is an opac one and opac search history is enabled
252 if ($in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory')) {
253 my $dbh = C4::Context->dbh;
254 my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
255 my $sth = $dbh->prepare($query);
256 $sth->execute($borrowernumber);
257
258 # If at least one search has already been performed
259 if ($sth->fetchrow_array > 0) {
260 # We show the link in opac
261 $template->param(ShowOpacRecentSearchLink => 1);
262 }
263
264 # And if there are searches performed when the user was not logged in,
265 # we add them to the logged-in search history
266 my @recentSearches = ParseSearchHistorySession($in->{'query'});
267 if (@recentSearches) {
268 my $sth = $dbh->prepare($SEARCH_HISTORY_INSERT_SQL);
269 $sth->execute( $borrowernumber,
270 $in->{'query'}->cookie("CGISESSID"),
271 $_->{'query_desc'},
272 $_->{'query_cgi'},
273 $_->{'total'},
274 $_->{'time'},
275 ) foreach @recentSearches;
276
277 # clear out the search history from the session now that
278 # we've saved it to the database
279 SetSearchHistorySession($in->{'query'}, []);
280 }
281 }
282 }
283 else { # if this is an anonymous session, setup to display public lists...
284
285 $template->param( sessionID => $sessionID );
286
287 my ($total, $pubshelves) = C4::VirtualShelves::GetSomeShelfNames(undef, 'MASTHEAD');
288 $template->param(
289 pubshelves => $total->{pubtotal},
290 pubshelvesloop => $pubshelves,
291 );
292 }
293 # Anonymous opac search history
294 # If opac search history is enabled and at least one search has already been performed
295 if (C4::Context->preference('EnableOpacSearchHistory')) {
296 my @recentSearches = ParseSearchHistorySession($in->{'query'});
297 if (@recentSearches) {
298 $template->param(ShowOpacRecentSearchLink => 1);
299 }
300 }
301
302 if(C4::Context->preference('dateformat')){
303 $template->param(dateformat => C4::Context->preference('dateformat'))
304 }
305
306 # these template parameters are set the same regardless of $in->{'type'}
307 $template->param(
308 "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
309 EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
310 GoogleJackets => C4::Context->preference("GoogleJackets"),
311 OpenLibraryCovers => C4::Context->preference("OpenLibraryCovers"),
312 KohaAdminEmailAddress => "" . C4::Context->preference("KohaAdminEmailAddress"),
313 LoginBranchcode => (C4::Context->userenv?C4::Context->userenv->{"branch"}:undef),
314 LoginFirstname => (C4::Context->userenv?C4::Context->userenv->{"firstname"}:"Bel"),
315 LoginSurname => C4::Context->userenv?C4::Context->userenv->{"surname"}:"Inconnu",
316 emailaddress => C4::Context->userenv?C4::Context->userenv->{"emailaddress"}:undef,
317 loggedinpersona => C4::Context->userenv?C4::Context->userenv->{"persona"}:undef,
318 TagsEnabled => C4::Context->preference("TagsEnabled"),
319 hide_marc => C4::Context->preference("hide_marc"),
320 item_level_itypes => C4::Context->preference('item-level_itypes'),
321 patronimages => C4::Context->preference("patronimages"),
322 singleBranchMode => C4::Context->preference("singleBranchMode"),
323 XSLTDetailsDisplay => C4::Context->preference("XSLTDetailsDisplay"),
324 XSLTResultsDisplay => C4::Context->preference("XSLTResultsDisplay"),
325 using_https => $in->{'query'}->https() ? 1 : 0,
326 noItemTypeImages => C4::Context->preference("noItemTypeImages"),
327 marcflavour => C4::Context->preference("marcflavour"),
328 persona => C4::Context->preference("persona"),
329 );
330 if ( $in->{'type'} eq "intranet" ) {
331 $template->param(
332 AmazonCoverImages => C4::Context->preference("AmazonCoverImages"),
333 AutoLocation => C4::Context->preference("AutoLocation"),
334 "BiblioDefaultView".C4::Context->preference("IntranetBiblioDefaultView") => 1,
335 CalendarFirstDayOfWeek => (C4::Context->preference("CalendarFirstDayOfWeek") eq "Sunday")?0:1,
336 CircAutocompl => C4::Context->preference("CircAutocompl"),
337 FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
338 IndependentBranches => C4::Context->preference("IndependentBranches"),
339 IntranetNav => C4::Context->preference("IntranetNav"),
340 IntranetmainUserblock => C4::Context->preference("IntranetmainUserblock"),
341 LibraryName => C4::Context->preference("LibraryName"),
342 LoginBranchname => (C4::Context->userenv?C4::Context->userenv->{"branchname"}:undef),
343 advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
344 canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
345 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
346 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
347 intranetreadinghistory => C4::Context->preference("intranetreadinghistory"),
348 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
349 IntranetUserCSS => C4::Context->preference("IntranetUserCSS"),
350 intranetuserjs => C4::Context->preference("intranetuserjs"),
351 intranetbookbag => C4::Context->preference("intranetbookbag"),
352 suggestion => C4::Context->preference("suggestion"),
353 virtualshelves => C4::Context->preference("virtualshelves"),
354 StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
355 EasyAnalyticalRecords => C4::Context->preference('EasyAnalyticalRecords'),
356 LocalCoverImages => C4::Context->preference('LocalCoverImages'),
357 OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'),
358 AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'),
359 EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'),
360 UseKohaPlugins => C4::Context->preference('UseKohaPlugins'),
361 UseCourseReserves => C4::Context->preference("UseCourseReserves"),
362 );
363 }
364 else {
365 warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
366 #TODO : replace LibraryName syspref with 'system name', and remove this html processing
367 my $LibraryNameTitle = C4::Context->preference("LibraryName");
368 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
369 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
370 # clean up the busc param in the session if the page is not opac-detail and not the "add to list" page
371 if ( C4::Context->preference("OpacBrowseResults")
372 && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
373 my $pagename = $1;
374 unless ( $pagename =~ /^(?:MARC|ISBD)?detail$/
375 or $pagename =~ /^addbybiblionumber$/ ) {
376 my $sessionSearch = get_session($sessionID || $in->{'query'}->cookie("CGISESSID"));
377 $sessionSearch->clear(["busc"]) if ($sessionSearch->param("busc"));
378 }
379 }
380 # variables passed from CGI: opac_css_override and opac_search_limits.
381 my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
382 my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
383 my $opac_name = '';
384 if (($opac_search_limit && $opac_search_limit =~ /branch:(\w+)/ && $opac_limit_override) || ($in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:(\w+)/)){
385 $opac_name = $1; # opac_search_limit is a branch, so we use it.
386 } elsif ( $in->{'query'}->param('multibranchlimit') ) {
387 $opac_name = $in->{'query'}->param('multibranchlimit');
388 } elsif (C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'}) {
389 $opac_name = C4::Context->userenv->{'branch'};
390 }
391 $template->param(
392 opaccolorstylesheet => C4::Context->preference("opaccolorstylesheet"),
393 AnonSuggestions => "" . C4::Context->preference("AnonSuggestions"),
394 AuthorisedValueImages => C4::Context->preference("AuthorisedValueImages"),
395 BranchesLoop => GetBranchesLoop($opac_name),
396 BranchCategoriesLoop => GetBranchCategories( 'searchdomain', 1, $opac_name ),
397 CalendarFirstDayOfWeek => (C4::Context->preference("CalendarFirstDayOfWeek") eq "Sunday")?0:1,
398 LibraryName => "" . C4::Context->preference("LibraryName"),
399 LibraryNameTitle => "" . $LibraryNameTitle,
400 LoginBranchname => C4::Context->userenv?C4::Context->userenv->{"branchname"}:"",
401 OPACAmazonCoverImages => C4::Context->preference("OPACAmazonCoverImages"),
402 OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
403 OpacHighlightedWords => C4::Context->preference("OpacHighlightedWords"),
404 OPACItemHolds => C4::Context->preference("OPACItemHolds"),
405 OPACShelfBrowser => "". C4::Context->preference("OPACShelfBrowser"),
406 OPACURLOpenInNewWindow => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
407 OPACUserCSS => "". C4::Context->preference("OPACUserCSS"),
408 OPACMobileUserCSS => "". C4::Context->preference("OPACMobileUserCSS"),
409 OPACViewOthersSuggestions => "" . C4::Context->preference("OPACViewOthersSuggestions"),
410 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
411 OPACBaseURL => ($in->{'query'}->https() ? "https://" : "http://") . $ENV{'SERVER_NAME'} .
412 ($ENV{'SERVER_PORT'} eq ($in->{'query'}->https() ? "443" : "80") ? '' : ":$ENV{'SERVER_PORT'}"),
413 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
414 opac_search_limit => $opac_search_limit,
415 opac_limit_override => $opac_limit_override,
416 OpacBrowser => C4::Context->preference("OpacBrowser"),
417 OpacCloud => C4::Context->preference("OpacCloud"),
418 OpacKohaUrl => C4::Context->preference("OpacKohaUrl"),
419 OpacMainUserBlock => "" . C4::Context->preference("OpacMainUserBlock"),
420 OpacMainUserBlockMobile => "" . C4::Context->preference("OpacMainUserBlockMobile"),
421 OpacShowFiltersPulldownMobile => C4::Context->preference("OpacShowFiltersPulldownMobile"),
422 OpacShowLibrariesPulldownMobile => C4::Context->preference("OpacShowLibrariesPulldownMobile"),
423 OpacNav => "" . C4::Context->preference("OpacNav"),
424 OpacNavRight => "" . C4::Context->preference("OpacNavRight"),
425 OpacNavBottom => "" . C4::Context->preference("OpacNavBottom"),
426 OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
427 OPACPatronDetails => C4::Context->preference("OPACPatronDetails"),
428 OPACPrivacy => C4::Context->preference("OPACPrivacy"),
429 OPACFinesTab => C4::Context->preference("OPACFinesTab"),
430 OpacTopissue => C4::Context->preference("OpacTopissue"),
431 RequestOnOpac => C4::Context->preference("RequestOnOpac"),
432 'Version' => C4::Context->preference('Version'),
433 hidelostitems => C4::Context->preference("hidelostitems"),
434 mylibraryfirst => (C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv) ? C4::Context->userenv->{'branch'} : '',
435 opaclayoutstylesheet => "" . C4::Context->preference("opaclayoutstylesheet"),
436 opacbookbag => "" . C4::Context->preference("opacbookbag"),
437 opaccredits => "" . C4::Context->preference("opaccredits"),
438 OpacFavicon => C4::Context->preference("OpacFavicon"),
439 opacheader => "" . C4::Context->preference("opacheader"),
440 opaclanguagesdisplay => "" . C4::Context->preference("opaclanguagesdisplay"),
441 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
442 opacsmallimage => "" . C4::Context->preference("opacsmallimage"),
443 opacuserjs => C4::Context->preference("opacuserjs"),
444 opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
445 ShowReviewer => C4::Context->preference("ShowReviewer"),
446 ShowReviewerPhoto => C4::Context->preference("ShowReviewerPhoto"),
447 suggestion => "" . C4::Context->preference("suggestion"),
448 virtualshelves => "" . C4::Context->preference("virtualshelves"),
449 OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
450 OPACXSLTDetailsDisplay => C4::Context->preference("OPACXSLTDetailsDisplay"),
451 OPACXSLTResultsDisplay => C4::Context->preference("OPACXSLTResultsDisplay"),
452 SyndeticsClientCode => C4::Context->preference("SyndeticsClientCode"),
453 SyndeticsEnabled => C4::Context->preference("SyndeticsEnabled"),
454 SyndeticsCoverImages => C4::Context->preference("SyndeticsCoverImages"),
455 SyndeticsTOC => C4::Context->preference("SyndeticsTOC"),
456 SyndeticsSummary => C4::Context->preference("SyndeticsSummary"),
457 SyndeticsEditions => C4::Context->preference("SyndeticsEditions"),
458 SyndeticsExcerpt => C4::Context->preference("SyndeticsExcerpt"),
459 SyndeticsReviews => C4::Context->preference("SyndeticsReviews"),
460 SyndeticsAuthorNotes => C4::Context->preference("SyndeticsAuthorNotes"),
461 SyndeticsAwards => C4::Context->preference("SyndeticsAwards"),
462 SyndeticsSeries => C4::Context->preference("SyndeticsSeries"),
463 SyndeticsCoverImageSize => C4::Context->preference("SyndeticsCoverImageSize"),
464 OPACLocalCoverImages => C4::Context->preference("OPACLocalCoverImages"),
465 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
466 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
467 );
468
469 $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic"));
470 }
471
472 # Check if we were asked using parameters to force a specific language
473 if ( defined $in->{'query'}->param('language') ) {
474 # Extract the language, let C4::Templates::getlanguage choose
475 # what to do
476 my $language = C4::Templates::getlanguage($in->{'query'},$in->{'type'});
477 my $languagecookie = C4::Templates::getlanguagecookie($in->{'query'},$language);
478 if ( ref $cookie eq 'ARRAY' ) {
479 push @{ $cookie }, $languagecookie;
480 } else {
481 $cookie = [$cookie, $languagecookie];
482 }
483 }
484
485 return ( $template, $borrowernumber, $cookie, $flags);
486}
487
488=head2 checkauth
489
490 ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
491
492Verifies that the user is authorized to run this script. If
493the user is authorized, a (userid, cookie, session-id, flags)
494quadruple is returned. If the user is not authorized but does
495not have the required privilege (see $flagsrequired below), it
496displays an error page and exits. Otherwise, it displays the
497login page and exits.
498
499Note that C<&checkauth> will return if and only if the user
500is authorized, so it should be called early on, before any
501unfinished operations (e.g., if you've opened a file, then
502C<&checkauth> won't close it for you).
503
504C<$query> is the CGI object for the script calling C<&checkauth>.
505
506The C<$noauth> argument is optional. If it is set, then no
507authorization is required for the script.
508
509C<&checkauth> fetches user and session information from C<$query> and
510ensures that the user is authorized to run scripts that require
511authorization.
512
513The C<$flagsrequired> argument specifies the required privileges
514the user must have if the username and password are correct.
515It should be specified as a reference-to-hash; keys in the hash
516should be the "flags" for the user, as specified in the Members
517intranet module. Any key specified must correspond to a "flag"
518in the userflags table. E.g., { circulate => 1 } would specify
519that the user must have the "circulate" privilege in order to
520proceed. To make sure that access control is correct, the
521C<$flagsrequired> parameter must be specified correctly.
522
523Koha also has a concept of sub-permissions, also known as
524granular permissions. This makes the value of each key
525in the C<flagsrequired> hash take on an additional
526meaning, i.e.,
527
528 1
529
530The user must have access to all subfunctions of the module
531specified by the hash key.
532
533 *
534
535The user must have access to at least one subfunction of the module
536specified by the hash key.
537
538 specific permission, e.g., 'export_catalog'
539
540The user must have access to the specific subfunction list, which
541must correspond to a row in the permissions table.
542
543The C<$type> argument specifies whether the template should be
544retrieved from the opac or intranet directory tree. "opac" is
545assumed if it is not specified; however, if C<$type> is specified,
546"intranet" is assumed if it is not "opac".
547
548If C<$query> does not have a valid session ID associated with it
549(i.e., the user has not logged in) or if the session has expired,
550C<&checkauth> presents the user with a login page (from the point of
551view of the original script, C<&checkauth> does not return). Once the
552user has authenticated, C<&checkauth> restarts the original script
553(this time, C<&checkauth> returns).
554
555The login page is provided using a HTML::Template, which is set in the
556systempreferences table or at the top of this file. The variable C<$type>
557selects which template to use, either the opac or the intranet
558authentification template.
559
560C<&checkauth> returns a user ID, a cookie, and a session ID. The
561cookie should be sent back to the browser; it verifies that the user
562has authenticated.
563
564=cut
565
566sub _version_check {
567 my $type = shift;
568 my $query = shift;
569 my $version;
570 # If Version syspref is unavailable, it means Koha is beeing installed,
571 # and so we must redirect to OPAC maintenance page or to the WebInstaller
572 # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
573 if (C4::Context->preference('OpacMaintenance') && $type eq 'opac') {
574 warn "OPAC Install required, redirecting to maintenance";
575 print $query->redirect("/cgi-bin/koha/maintenance.pl");
576 safe_exit;
577 }
578 unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison
579 if ( $type ne 'opac' ) {
580 warn "Install required, redirecting to Installer";
581 print $query->redirect("/cgi-bin/koha/installer/install.pl");
582 } else {
583 warn "OPAC Install required, redirecting to maintenance";
584 print $query->redirect("/cgi-bin/koha/maintenance.pl");
585 }
586 safe_exit;
587 }
588
589 # check that database and koha version are the same
590 # there is no DB version, it's a fresh install,
591 # go to web installer
592 # there is a DB version, compare it to the code version
593 my $kohaversion=C4::Context::KOHAVERSION;
594 # remove the 3 last . to have a Perl number
595 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
596 $debug and print STDERR "kohaversion : $kohaversion\n";
597 if ($version < $kohaversion){
598 my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
599 if ($type ne 'opac'){
600 warn sprintf($warning, 'Installer');
601 print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
602 } else {
603 warn sprintf("OPAC: " . $warning, 'maintenance');
604 print $query->redirect("/cgi-bin/koha/maintenance.pl");
605 }
606 safe_exit;
607 }
608}
609
610sub _session_log {
611 (@_) or return 0;
612 open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
613 printf $fh join("\n",@_);
614 close $fh;
615}
616
617
# spent 180µs (10+170) within C4::Auth::_timeout_syspref which was called: # once (10µs+170µs) by C4::Auth::check_api_auth at line 1164
sub _timeout_syspref {
61813µs1167µs my $timeout = C4::Context->preference('timeout') || 600;
# spent 167µs making 1 call to C4::Context::preference
619 # value in days, convert in seconds
62017µs13µs if ($timeout =~ /(\d+)[dD]/) {
# spent 3µs making 1 call to C4::Auth::CORE:match
621 $timeout = $1 * 86400;
622 };
62313µs return $timeout;
624}
625
626sub checkauth {
627 my $query = shift;
628 $debug and warn "Checking Auth";
629 # $authnotrequired will be set for scripts which will run without authentication
630 my $authnotrequired = shift;
631 my $flagsrequired = shift;
632 my $type = shift;
633 my $persona = shift;
634 $type = 'opac' unless $type;
635
636 my $dbh = C4::Context->dbh;
637 my $timeout = _timeout_syspref();
638
639 _version_check($type,$query);
640 # state variables
641 my $loggedin = 0;
642 my %info;
643 my ( $userid, $cookie, $sessionID, $flags, $barshelves, $pubshelves );
644 my $logout = $query->param('logout.x');
645
646 my $anon_search_history;
647
648 # This parameter is the name of the CAS server we want to authenticate against,
649 # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
650 my $casparam = $query->param('cas');
651 my $q_userid = $query->param('userid') // '';
652
653 if ( $userid = $ENV{'REMOTE_USER'} ) {
654 # Using Basic Authentication, no cookies required
655 $cookie = $query->cookie(
656 -name => 'CGISESSID',
657 -value => '',
658 -expires => '',
659 -HttpOnly => 1,
660 );
661 $loggedin = 1;
662 }
663 elsif ( $persona ){
664 # we dont want to set a session because we are being called by a persona callback
665 }
666 elsif ( $sessionID = $query->cookie("CGISESSID") )
667 { # assignment, not comparison
668 my $session = get_session($sessionID);
669 C4::Context->_new_userenv($sessionID);
670 my ($ip, $lasttime, $sessiontype);
671 my $s_userid = '';
672 if ($session){
673 $s_userid = $session->param('id') // '';
674 C4::Context::set_userenv(
675 $session->param('number'), $s_userid,
676 $session->param('cardnumber'), $session->param('firstname'),
677 $session->param('surname'), $session->param('branch'),
678 $session->param('branchname'), $session->param('flags'),
679 $session->param('emailaddress'), $session->param('branchprinter'),
680 $session->param('persona')
681 );
682 C4::Context::set_shelves_userenv('bar',$session->param('barshelves'));
683 C4::Context::set_shelves_userenv('pub',$session->param('pubshelves'));
684 C4::Context::set_shelves_userenv('tot',$session->param('totshelves'));
685 $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
686 $ip = $session->param('ip');
687 $lasttime = $session->param('lasttime');
688 $userid = $s_userid;
689 $sessiontype = $session->param('sessiontype') || '';
690 }
691 if ( ( $query->param('koha_login_context') && ($q_userid ne $s_userid) )
692 || ( $cas && $query->param('ticket') ) ) {
693 #if a user enters an id ne to the id in the current session, we need to log them in...
694 #first we need to clear the anonymous session...
695 $debug and warn "query id = $q_userid but session id = $s_userid";
696 $anon_search_history = $session->param('search_history');
697 $session->delete();
698 $session->flush;
699 C4::Context->_unset_userenv($sessionID);
700 $sessionID = undef;
701 $userid = undef;
702 }
703 elsif ($logout) {
704 # voluntary logout the user
705 $session->delete();
706 $session->flush;
707 C4::Context->_unset_userenv($sessionID);
708 #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
709 $sessionID = undef;
710 $userid = undef;
711
712 if ($cas and $caslogout) {
713 logout_cas($query);
714 }
715 }
716 elsif ( !$lasttime || ($lasttime < time() - $timeout) ) {
717 # timed logout
718 $info{'timed_out'} = 1;
719 if ($session) {
720 $session->delete();
721 $session->flush;
722 }
723 C4::Context->_unset_userenv($sessionID);
724 #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
725 $userid = undef;
726 $sessionID = undef;
727 }
728 elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
729 # Different ip than originally logged in from
730 $info{'oldip'} = $ip;
731 $info{'newip'} = $ENV{'REMOTE_ADDR'};
732 $info{'different_ip'} = 1;
733 $session->delete();
734 $session->flush;
735 C4::Context->_unset_userenv($sessionID);
736 #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
737 $sessionID = undef;
738 $userid = undef;
739 }
740 else {
741 $cookie = $query->cookie(
742 -name => 'CGISESSID',
743 -value => $session->id,
744 -HttpOnly => 1
745 );
746 $session->param( 'lasttime', time() );
747 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...
748 $flags = haspermission($userid, $flagsrequired);
749 if ($flags) {
750 $loggedin = 1;
751 } else {
752 $info{'nopermission'} = 1;
753 }
754 }
755 }
756 }
757 unless ($userid || $sessionID) {
758
759 #we initiate a session prior to checking for a username to allow for anonymous sessions...
760 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
761
762 # Save anonymous search history in new session so it can be retrieved
763 # by get_template_and_user to store it in user's search history after
764 # a successful login.
765 if ($anon_search_history) {
766 $session->param('search_history', $anon_search_history);
767 }
768
769 my $sessionID = $session->id;
770 C4::Context->_new_userenv($sessionID);
771 $cookie = $query->cookie(
772 -name => 'CGISESSID',
773 -value => $session->id,
774 -HttpOnly => 1
775 );
776 $userid = $q_userid;
777 my $pki_field = C4::Context->preference('AllowPKIAuth');
778 if (! defined($pki_field) ) {
779 print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
780 $pki_field = 'None';
781 }
782 if ( ( $cas && $query->param('ticket') )
783 || $userid
784 || $pki_field ne 'None'
785 || $persona )
786 {
787 my $password = $query->param('password');
788
789 my ( $return, $cardnumber );
790 if ( $cas && $query->param('ticket') ) {
791 my $retuserid;
792 ( $return, $cardnumber, $retuserid ) =
793 checkpw( $dbh, $userid, $password, $query );
794 $userid = $retuserid;
795 $info{'invalidCasLogin'} = 1 unless ($return);
796 }
797
798 elsif ($persona) {
799 my $value = $persona;
800
801 # If we're looking up the email, there's a chance that the person
802 # doesn't have a userid. So if there is none, we pass along the
803 # borrower number, and the bits of code that need to know the user
804 # ID will have to be smart enough to handle that.
805 require C4::Members;
806 my @users_info = C4::Members::GetBorrowersWithEmail($value);
807 if (@users_info) {
808
809 # First the userid, then the borrowernum
810 $value = $users_info[0][1] || $users_info[0][0];
811 }
812 else {
813 undef $value;
814 }
815 $return = $value ? 1 : 0;
816 $userid = $value;
817 }
818
819 elsif (
820 ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
821 || ( $pki_field eq 'emailAddress'
822 && $ENV{'SSL_CLIENT_S_DN_Email'} )
823 )
824 {
825 my $value;
826 if ( $pki_field eq 'Common Name' ) {
827 $value = $ENV{'SSL_CLIENT_S_DN_CN'};
828 }
829 elsif ( $pki_field eq 'emailAddress' ) {
830 $value = $ENV{'SSL_CLIENT_S_DN_Email'};
831
832 # If we're looking up the email, there's a chance that the person
833 # doesn't have a userid. So if there is none, we pass along the
834 # borrower number, and the bits of code that need to know the user
835 # ID will have to be smart enough to handle that.
836 require C4::Members;
837 my @users_info = C4::Members::GetBorrowersWithEmail($value);
838 if (@users_info) {
839
840 # First the userid, then the borrowernum
841 $value = $users_info[0][1] || $users_info[0][0];
842 } else {
843 undef $value;
844 }
845 }
846
847
848 $return = $value ? 1 : 0;
849 $userid = $value;
850
851 }
852 else {
853 my $retuserid;
854 ( $return, $cardnumber, $retuserid ) =
855 checkpw( $dbh, $userid, $password, $query );
856 $userid = $retuserid if ( $retuserid );
857 }
858 if ($return) {
859 #_session_log(sprintf "%20s from %16s logged in at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
860 if ( $flags = haspermission( $userid, $flagsrequired ) ) {
861 $loggedin = 1;
862 }
863 else {
864 $info{'nopermission'} = 1;
865 C4::Context->_unset_userenv($sessionID);
866 }
867 my ($borrowernumber, $firstname, $surname, $userflags,
868 $branchcode, $branchname, $branchprinter, $emailaddress);
869
870 if ( $return == 1 ) {
871 my $select = "
872 SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
873 branches.branchname as branchname,
874 branches.branchprinter as branchprinter,
875 email
876 FROM borrowers
877 LEFT JOIN branches on borrowers.branchcode=branches.branchcode
878 ";
879 my $sth = $dbh->prepare("$select where userid=?");
880 $sth->execute($userid);
881 unless ($sth->rows) {
882 $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
883 $sth = $dbh->prepare("$select where cardnumber=?");
884 $sth->execute($cardnumber);
885
886 unless ($sth->rows) {
887 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
888 $sth->execute($userid);
889 unless ($sth->rows) {
890 $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
891 }
892 }
893 }
894 if ($sth->rows) {
895 ($borrowernumber, $firstname, $surname, $userflags,
896 $branchcode, $branchname, $branchprinter, $emailaddress) = $sth->fetchrow;
897 $debug and print STDERR "AUTH_3 results: " .
898 "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
899 } else {
900 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
901 }
902
903# launch a sequence to check if we have a ip for the branch, i
904# if we have one we replace the branchcode of the userenv by the branch bound in the ip.
905
906 my $ip = $ENV{'REMOTE_ADDR'};
907 # if they specify at login, use that
908 if ($query->param('branch')) {
909 $branchcode = $query->param('branch');
910 $branchname = GetBranchName($branchcode);
911 }
912 my $branches = GetBranches();
913 if (C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation')){
914 # we have to check they are coming from the right ip range
915 my $domain = $branches->{$branchcode}->{'branchip'};
916 if ($ip !~ /^$domain/){
917 $loggedin=0;
918 $info{'wrongip'} = 1;
919 }
920 }
921
922 my @branchesloop;
923 foreach my $br ( keys %$branches ) {
924 # now we work with the treatment of ip
925 my $domain = $branches->{$br}->{'branchip'};
926 if ( $domain && $ip =~ /^$domain/ ) {
927 $branchcode = $branches->{$br}->{'branchcode'};
928
929 # new op dev : add the branchprinter and branchname in the cookie
930 $branchprinter = $branches->{$br}->{'branchprinter'};
931 $branchname = $branches->{$br}->{'branchname'};
932 }
933 }
934 $session->param('number',$borrowernumber);
935 $session->param('id',$userid);
936 $session->param('cardnumber',$cardnumber);
937 $session->param('firstname',$firstname);
938 $session->param('surname',$surname);
939 $session->param('branch',$branchcode);
940 $session->param('branchname',$branchname);
941 $session->param('flags',$userflags);
942 $session->param('emailaddress',$emailaddress);
943 $session->param('ip',$session->remote_addr());
944 $session->param('lasttime',time());
945 $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
946 }
947 elsif ( $return == 2 ) {
948 #We suppose the user is the superlibrarian
949 $borrowernumber = 0;
950 $session->param('number',0);
951 $session->param('id',C4::Context->config('user'));
952 $session->param('cardnumber',C4::Context->config('user'));
953 $session->param('firstname',C4::Context->config('user'));
954 $session->param('surname',C4::Context->config('user'));
955 $session->param('branch','NO_LIBRARY_SET');
956 $session->param('branchname','NO_LIBRARY_SET');
957 $session->param('flags',1);
958 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
959 $session->param('ip',$session->remote_addr());
960 $session->param('lasttime',time());
961 }
962 if ($persona){
963 $session->param('persona',1);
964 }
965 C4::Context::set_userenv(
966 $session->param('number'), $session->param('id'),
967 $session->param('cardnumber'), $session->param('firstname'),
968 $session->param('surname'), $session->param('branch'),
969 $session->param('branchname'), $session->param('flags'),
970 $session->param('emailaddress'), $session->param('branchprinter'),
971 $session->param('persona')
972 );
973
974 }
975 else {
976 if ($userid) {
977 $info{'invalid_username_or_password'} = 1;
978 C4::Context->_unset_userenv($sessionID);
979 }
980 $session->param('lasttime',time());
981 $session->param('ip',$session->remote_addr());
982 }
983 } # END if ( $userid = $query->param('userid') )
984 elsif ($type eq "opac") {
985 # if we are here this is an anonymous session; add public lists to it and a few other items...
986 # anonymous sessions are created only for the OPAC
987 $debug and warn "Initiating an anonymous session...";
988
989 # setting a couple of other session vars...
990 $session->param('ip',$session->remote_addr());
991 $session->param('lasttime',time());
992 $session->param('sessiontype','anon');
993 }
994 } # END unless ($userid)
995
996 # finished authentification, now respond
997 if ( $loggedin || $authnotrequired )
998 {
999 # successful login
1000 unless ($cookie) {
1001 $cookie = $query->cookie(
1002 -name => 'CGISESSID',
1003 -value => '',
1004 -HttpOnly => 1
1005 );
1006 }
1007 return ( $userid, $cookie, $sessionID, $flags );
1008 }
1009
1010#
1011#
1012# AUTH rejected, show the login/password template, after checking the DB.
1013#
1014#
1015
1016 # get the inputs from the incoming query
1017 my @inputs = ();
1018 foreach my $name ( param $query) {
1019 (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1020 my $value = $query->param($name);
1021 push @inputs, { name => $name, value => $value };
1022 }
1023
1024 my $LibraryNameTitle = C4::Context->preference("LibraryName");
1025 $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
1026 $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
1027
1028 my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tmpl' : 'auth.tmpl';
1029 my $template = C4::Templates::gettemplate($template_name, $type, $query );
1030 $template->param(
1031 branchloop => GetBranchesLoop(),
1032 opaccolorstylesheet => C4::Context->preference("opaccolorstylesheet"),
1033 opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
1034 login => 1,
1035 INPUTS => \@inputs,
1036 casAuthentication => C4::Context->preference("casAuthentication"),
1037 suggestion => C4::Context->preference("suggestion"),
1038 virtualshelves => C4::Context->preference("virtualshelves"),
1039 LibraryName => "" . C4::Context->preference("LibraryName"),
1040 LibraryNameTitle => "" . $LibraryNameTitle,
1041 opacuserlogin => C4::Context->preference("opacuserlogin"),
1042 OpacNav => C4::Context->preference("OpacNav"),
1043 OpacNavRight => C4::Context->preference("OpacNavRight"),
1044 OpacNavBottom => C4::Context->preference("OpacNavBottom"),
1045 opaccredits => C4::Context->preference("opaccredits"),
1046 OpacFavicon => C4::Context->preference("OpacFavicon"),
1047 opacreadinghistory => C4::Context->preference("opacreadinghistory"),
1048 opacsmallimage => C4::Context->preference("opacsmallimage"),
1049 opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1050 opacuserjs => C4::Context->preference("opacuserjs"),
1051 opacbookbag => "" . C4::Context->preference("opacbookbag"),
1052 OpacCloud => C4::Context->preference("OpacCloud"),
1053 OpacTopissue => C4::Context->preference("OpacTopissue"),
1054 OpacAuthorities => C4::Context->preference("OpacAuthorities"),
1055 OpacBrowser => C4::Context->preference("OpacBrowser"),
1056 opacheader => C4::Context->preference("opacheader"),
1057 TagsEnabled => C4::Context->preference("TagsEnabled"),
1058 OPACUserCSS => C4::Context->preference("OPACUserCSS"),
1059 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
1060 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1061 intranetbookbag => C4::Context->preference("intranetbookbag"),
1062 IntranetNav => C4::Context->preference("IntranetNav"),
1063 IntranetFavicon => C4::Context->preference("IntranetFavicon"),
1064 intranetuserjs => C4::Context->preference("intranetuserjs"),
1065 IndependentBranches=> C4::Context->preference("IndependentBranches"),
1066 AutoLocation => C4::Context->preference("AutoLocation"),
1067 wrongip => $info{'wrongip'},
1068 PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"),
1069 PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"),
1070 persona => C4::Context->preference("Persona"),
1071 opac_css_override => $ENV{'OPAC_CSS_OVERRIDE'},
1072 );
1073
1074 $template->param( OpacPublic => C4::Context->preference("OpacPublic"));
1075 $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1076
1077 if($type eq 'opac'){
1078 my ($total, $pubshelves) = C4::VirtualShelves::GetSomeShelfNames(undef, 'MASTHEAD');
1079 $template->param(
1080 pubshelves => $total->{pubtotal},
1081 pubshelvesloop => $pubshelves,
1082 );
1083 }
1084
1085 if ($cas) {
1086
1087 # Is authentication against multiple CAS servers enabled?
1088 if (C4::Auth_with_cas::multipleAuth && !$casparam) {
1089 my $casservers = C4::Auth_with_cas::getMultipleAuth();
1090 my @tmplservers;
1091 foreach my $key (keys %$casservers) {
1092 push @tmplservers, {name => $key, value => login_cas_url($query, $key) . "?cas=$key" };
1093 }
1094 $template->param(
1095 casServersLoop => \@tmplservers
1096 );
1097 } else {
1098 $template->param(
1099 casServerUrl => login_cas_url($query),
1100 );
1101 }
1102
1103 $template->param(
1104 invalidCasLogin => $info{'invalidCasLogin'}
1105 );
1106 }
1107
1108 my $self_url = $query->url( -absolute => 1 );
1109 $template->param(
1110 url => $self_url,
1111 LibraryName => C4::Context->preference("LibraryName"),
1112 );
1113 $template->param( %info );
1114# $cookie = $query->cookie(CGISESSID => $session->id
1115# );
1116 print $query->header(
1117 -type => 'text/html',
1118 -charset => 'utf-8',
1119 -cookie => $cookie
1120 ),
1121 $template->output;
1122 safe_exit;
1123}
1124
1125=head2 check_api_auth
1126
1127 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1128
1129Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1130cookie, determine if the user has the privileges specified by C<$userflags>.
1131
1132C<check_api_auth> is is meant for authenticating users of web services, and
1133consequently will always return and will not attempt to redirect the user
1134agent.
1135
1136If a valid session cookie is already present, check_api_auth will return a status
1137of "ok", the cookie, and the Koha session ID.
1138
1139If no session cookie is present, check_api_auth will check the 'userid' and 'password
1140parameters and create a session cookie and Koha session if the supplied credentials
1141are OK.
1142
1143Possible return values in C<$status> are:
1144
1145=over
1146
1147=item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1148
1149=item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1150
1151=item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1152
1153=item "expired -- session cookie has expired; API user should resubmit userid and password
1154
1155=back
1156
1157=cut
1158
1159
# spent 21.7ms (180µs+21.5) within C4::Auth::check_api_auth which was called: # once (180µs+21.5ms) by C4::Service::new at line 87 of C4/Service.pm
sub check_api_auth {
11601400ns my $query = shift;
11611200ns my $flagsrequired = shift;
1162
116313µs16µs my $dbh = C4::Context->dbh;
# spent 6µs making 1 call to C4::Context::dbh
116411µs1180µs my $timeout = _timeout_syspref();
# spent 180µs making 1 call to C4::Auth::_timeout_syspref
1165
116612µs1104µs unless (C4::Context->preference('Version')) {
# spent 104µs making 1 call to C4::Context::preference
1167 # database has not been installed yet
1168 return ("maintenance", undef, undef);
1169 }
117013µs11.96ms my $kohaversion=C4::Context::KOHAVERSION;
# spent 1.96ms making 1 call to C4::Context::KOHAVERSION
1171135µ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
117214µs14µs if (C4::Context->preference('Version') < $kohaversion) {
# spent 4µs making 1 call to C4::Context::preference
1173 # database in need of version update; assume that
1174 # no API should be called while databsae is in
1175 # this condition.
1176 return ("maintenance", undef, undef);
1177 }
1178
1179 # FIXME -- most of what follows is a copy-and-paste
1180 # of code from checkauth. There is an obvious need
1181 # for refactoring to separate the various parts of
1182 # the authentication code, but as of 2007-11-19 this
1183 # is deferred so as to not introduce bugs into the
1184 # regular authentication code for Koha 3.0.
1185
1186 # see if we have a valid session cookie already
1187 # however, if a userid parameter is present (i.e., from
1188 # a form submission, assume that any current cookie
1189 # is to be ignored
11901400ns my $sessionID = undef;
119117µs2213µs unless ($query->param('userid')) {
# spent 205µs making 1 call to CGI::AUTOLOAD # spent 8µs making 1 call to CGI::param
1192 $sessionID = $query->cookie("CGISESSID");
1193 }
11941900ns if ($sessionID && not ($cas && $query->param('PT')) ) {
119513µs111.8ms my $session = get_session($sessionID);
# spent 11.8ms making 1 call to C4::Auth::get_session
119615µs16µs C4::Context->_new_userenv($sessionID);
# spent 6µs making 1 call to C4::Context::_new_userenv
11971700ns if ($session) {
1198123µs11104µs C4::Context::set_userenv(
# spent 85µs making 10 calls to CGI::Session::param, avg 9µs/call # spent 19µs making 1 call to C4::Context::set_userenv
1199 $session->param('number'), $session->param('id'),
1200 $session->param('cardnumber'), $session->param('firstname'),
1201 $session->param('surname'), $session->param('branch'),
1202 $session->param('branchname'), $session->param('flags'),
1203 $session->param('emailaddress'), $session->param('branchprinter')
1204 );
1205
120613µs17µs my $ip = $session->param('ip');
# spent 7µs making 1 call to CGI::Session::param
120712µs16µs my $lasttime = $session->param('lasttime');
# spent 6µs making 1 call to CGI::Session::param
120812µs16µs my $userid = $session->param('id');
# spent 6µs making 1 call to CGI::Session::param
120915µs if ( $lasttime < time() - $timeout ) {
1210 # time out
1211 $session->delete();
1212 $session->flush;
1213 C4::Context->_unset_userenv($sessionID);
1214 $userid = undef;
1215 $sessionID = undef;
1216 return ("expired", undef, undef);
1217 } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1218 # IP address changed
1219 $session->delete();
1220 $session->flush;
1221 C4::Context->_unset_userenv($sessionID);
1222 $userid = undef;
1223 $sessionID = undef;
1224 return ("expired", undef, undef);
1225 } else {
1226110µs2269µs my $cookie = $query->cookie(
# spent 254µs making 1 call to CGI::cookie # spent 15µs making 1 call to CGI::Session::id
1227 -name => 'CGISESSID',
1228 -value => $session->id,
1229 -HttpOnly => 1,
1230 );
123113µs137µs $session->param('lasttime',time());
# spent 37µs making 1 call to CGI::Session::param
123214µs4945µs my $flags = haspermission($userid, $flagsrequired);
# spent 926µs making 1 call to C4::Auth::haspermission # spent 18µs making 2 calls to DBI::common::DESTROY, avg 9µs/call # spent 1µs making 1 call to DBD::_mem::common::DESTROY
123319µs if ($flags) {
1234 return ("ok", $cookie, $sessionID);
1235 } else {
1236 $session->delete();
1237 $session->flush;
1238 C4::Context->_unset_userenv($sessionID);
1239 $userid = undef;
1240 $sessionID = undef;
1241 return ("failed", undef, undef);
1242 }
1243 }
1244 } else {
1245 return ("expired", undef, undef);
1246 }
1247 } else {
1248 # new login
1249 my $userid = $query->param('userid');
1250 my $password = $query->param('password');
1251 my ($return, $cardnumber);
1252
1253 # Proxy CAS auth
1254 if ($cas && $query->param('PT')) {
1255 my $retuserid;
1256 $debug and print STDERR "## check_api_auth - checking CAS\n";
1257 # In case of a CAS authentication, we use the ticket instead of the password
1258 my $PT = $query->param('PT');
1259 ($return,$cardnumber,$userid) = check_api_auth_cas($dbh, $PT, $query); # EXTERNAL AUTH
1260 } else {
1261 # User / password auth
1262 unless ($userid and $password) {
1263 # caller did something wrong, fail the authenticateion
1264 return ("failed", undef, undef);
1265 }
1266 ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password, $query );
1267 }
1268
1269 if ($return and haspermission( $userid, $flagsrequired)) {
1270 my $session = get_session("");
1271 return ("failed", undef, undef) unless $session;
1272
1273 my $sessionID = $session->id;
1274 C4::Context->_new_userenv($sessionID);
1275 my $cookie = $query->cookie(
1276 -name => 'CGISESSID',
1277 -value => $sessionID,
1278 -HttpOnly => 1,
1279 );
1280 if ( $return == 1 ) {
1281 my (
1282 $borrowernumber, $firstname, $surname,
1283 $userflags, $branchcode, $branchname,
1284 $branchprinter, $emailaddress
1285 );
1286 my $sth =
1287 $dbh->prepare(
1288"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=?"
1289 );
1290 $sth->execute($userid);
1291 (
1292 $borrowernumber, $firstname, $surname,
1293 $userflags, $branchcode, $branchname,
1294 $branchprinter, $emailaddress
1295 ) = $sth->fetchrow if ( $sth->rows );
1296
1297 unless ($sth->rows ) {
1298 my $sth = $dbh->prepare(
1299"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=?"
1300 );
1301 $sth->execute($cardnumber);
1302 (
1303 $borrowernumber, $firstname, $surname,
1304 $userflags, $branchcode, $branchname,
1305 $branchprinter, $emailaddress
1306 ) = $sth->fetchrow if ( $sth->rows );
1307
1308 unless ( $sth->rows ) {
1309 $sth->execute($userid);
1310 (
1311 $borrowernumber, $firstname, $surname, $userflags,
1312 $branchcode, $branchname, $branchprinter, $emailaddress
1313 ) = $sth->fetchrow if ( $sth->rows );
1314 }
1315 }
1316
1317 my $ip = $ENV{'REMOTE_ADDR'};
1318 # if they specify at login, use that
1319 if ($query->param('branch')) {
1320 $branchcode = $query->param('branch');
1321 $branchname = GetBranchName($branchcode);
1322 }
1323 my $branches = GetBranches();
1324 my @branchesloop;
1325 foreach my $br ( keys %$branches ) {
1326 # now we work with the treatment of ip
1327 my $domain = $branches->{$br}->{'branchip'};
1328 if ( $domain && $ip =~ /^$domain/ ) {
1329 $branchcode = $branches->{$br}->{'branchcode'};
1330
1331 # new op dev : add the branchprinter and branchname in the cookie
1332 $branchprinter = $branches->{$br}->{'branchprinter'};
1333 $branchname = $branches->{$br}->{'branchname'};
1334 }
1335 }
1336 $session->param('number',$borrowernumber);
1337 $session->param('id',$userid);
1338 $session->param('cardnumber',$cardnumber);
1339 $session->param('firstname',$firstname);
1340 $session->param('surname',$surname);
1341 $session->param('branch',$branchcode);
1342 $session->param('branchname',$branchname);
1343 $session->param('flags',$userflags);
1344 $session->param('emailaddress',$emailaddress);
1345 $session->param('ip',$session->remote_addr());
1346 $session->param('lasttime',time());
1347 } elsif ( $return == 2 ) {
1348 #We suppose the user is the superlibrarian
1349 $session->param('number',0);
1350 $session->param('id',C4::Context->config('user'));
1351 $session->param('cardnumber',C4::Context->config('user'));
1352 $session->param('firstname',C4::Context->config('user'));
1353 $session->param('surname',C4::Context->config('user'));
1354 $session->param('branch','NO_LIBRARY_SET');
1355 $session->param('branchname','NO_LIBRARY_SET');
1356 $session->param('flags',1);
1357 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
1358 $session->param('ip',$session->remote_addr());
1359 $session->param('lasttime',time());
1360 }
1361 C4::Context::set_userenv(
1362 $session->param('number'), $session->param('id'),
1363 $session->param('cardnumber'), $session->param('firstname'),
1364 $session->param('surname'), $session->param('branch'),
1365 $session->param('branchname'), $session->param('flags'),
1366 $session->param('emailaddress'), $session->param('branchprinter')
1367 );
1368 return ("ok", $cookie, $sessionID);
1369 } else {
1370 return ("failed", undef, undef);
1371 }
1372 }
1373}
1374
1375=head2 check_cookie_auth
1376
1377 ($status, $sessionId) = check_api_auth($cookie, $userflags);
1378
1379Given a CGISESSID cookie set during a previous login to Koha, determine
1380if the user has the privileges specified by C<$userflags>.
1381
1382C<check_cookie_auth> is meant for authenticating special services
1383such as tools/upload-file.pl that are invoked by other pages that
1384have been authenticated in the usual way.
1385
1386Possible return values in C<$status> are:
1387
1388=over
1389
1390=item "ok" -- user authenticated; C<$sessionID> have valid values.
1391
1392=item "failed" -- credentials are not correct; C<$sessionid> are undef
1393
1394=item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1395
1396=item "expired -- session cookie has expired; API user should resubmit userid and password
1397
1398=back
1399
1400=cut
1401
1402sub check_cookie_auth {
1403 my $cookie = shift;
1404 my $flagsrequired = shift;
1405
1406 my $dbh = C4::Context->dbh;
1407 my $timeout = _timeout_syspref();
1408
1409 unless (C4::Context->preference('Version')) {
1410 # database has not been installed yet
1411 return ("maintenance", undef);
1412 }
1413 my $kohaversion=C4::Context::KOHAVERSION;
1414 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1415 if (C4::Context->preference('Version') < $kohaversion) {
1416 # database in need of version update; assume that
1417 # no API should be called while databsae is in
1418 # this condition.
1419 return ("maintenance", undef);
1420 }
1421
1422 # FIXME -- most of what follows is a copy-and-paste
1423 # of code from checkauth. There is an obvious need
1424 # for refactoring to separate the various parts of
1425 # the authentication code, but as of 2007-11-23 this
1426 # is deferred so as to not introduce bugs into the
1427 # regular authentication code for Koha 3.0.
1428
1429 # see if we have a valid session cookie already
1430 # however, if a userid parameter is present (i.e., from
1431 # a form submission, assume that any current cookie
1432 # is to be ignored
1433 unless (defined $cookie and $cookie) {
1434 return ("failed", undef);
1435 }
1436 my $sessionID = $cookie;
1437 my $session = get_session($sessionID);
1438 C4::Context->_new_userenv($sessionID);
1439 if ($session) {
1440 C4::Context::set_userenv(
1441 $session->param('number'), $session->param('id'),
1442 $session->param('cardnumber'), $session->param('firstname'),
1443 $session->param('surname'), $session->param('branch'),
1444 $session->param('branchname'), $session->param('flags'),
1445 $session->param('emailaddress'), $session->param('branchprinter')
1446 );
1447
1448 my $ip = $session->param('ip');
1449 my $lasttime = $session->param('lasttime');
1450 my $userid = $session->param('id');
1451 if ( $lasttime < time() - $timeout ) {
1452 # time out
1453 $session->delete();
1454 $session->flush;
1455 C4::Context->_unset_userenv($sessionID);
1456 $userid = undef;
1457 $sessionID = undef;
1458 return ("expired", undef);
1459 } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1460 # IP address changed
1461 $session->delete();
1462 $session->flush;
1463 C4::Context->_unset_userenv($sessionID);
1464 $userid = undef;
1465 $sessionID = undef;
1466 return ("expired", undef);
1467 } else {
1468 $session->param('lasttime',time());
1469 my $flags = haspermission($userid, $flagsrequired);
1470 if ($flags) {
1471 return ("ok", $sessionID);
1472 } else {
1473 $session->delete();
1474 $session->flush;
1475 C4::Context->_unset_userenv($sessionID);
1476 $userid = undef;
1477 $sessionID = undef;
1478 return ("failed", undef);
1479 }
1480 }
1481 } else {
1482 return ("expired", undef);
1483 }
1484}
1485
1486=head2 get_session
1487
1488 use CGI::Session;
1489 my $session = get_session($sessionID);
1490
1491Given a session ID, retrieve the CGI::Session object used to store
1492the session's state. The session object can be used to store
1493data that needs to be accessed by different scripts during a
1494user's session.
1495
1496If the C<$sessionID> parameter is an empty string, a new session
1497will be created.
1498
1499=cut
1500
1501
# spent 11.8ms (20µs+11.8) within C4::Auth::get_session which was called: # once (20µs+11.8ms) by C4::Auth::check_api_auth at line 1195
sub get_session {
15021300ns my $sessionID = shift;
150312µs1121µs my $storage_method = C4::Context->preference('SessionStorage');
# spent 121µs making 1 call to C4::Context::preference
150412µs14µs my $dbh = C4::Context->dbh;
# spent 4µs making 1 call to C4::Context::dbh
15051300ns my $session;
150616µs111.6ms if ($storage_method eq 'mysql'){
# spent 11.6ms making 1 call to CGI::Session::new
1507 $session = new CGI::Session("driver:MySQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1508 }
1509 elsif ($storage_method eq 'Pg') {
1510 $session = new CGI::Session("driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1511 }
1512 elsif ($storage_method eq 'memcached' && C4::Context->ismemcached){
1513 $session = new CGI::Session("driver:memcached;serializer:yaml;id:md5", $sessionID, { Memcached => C4::Context->memcached } );
1514 }
1515 else {
1516 # catch all defaults to tmp should work on all systems
1517 $session = new CGI::Session("driver:File;serializer:yaml;id:md5", $sessionID, {Directory=>'/tmp'});
1518 }
151917µs return $session;
1520}
1521
1522sub checkpw {
1523 my ( $dbh, $userid, $password, $query ) = @_;
1524
1525 if ($ldap) {
1526 $debug and print STDERR "## checkpw - checking LDAP\n";
1527 my ($retval,$retcard,$retuserid) = checkpw_ldap(@_); # EXTERNAL AUTH
1528 ($retval) and return ($retval,$retcard,$retuserid);
1529 }
1530
1531 if ($cas && $query && $query->param('ticket')) {
1532 $debug and print STDERR "## checkpw - checking CAS\n";
1533 # In case of a CAS authentication, we use the ticket instead of the password
1534 my $ticket = $query->param('ticket');
1535 $query->delete('ticket'); # remove ticket to come back to original URL
1536 my ($retval,$retcard,$retuserid) = checkpw_cas($dbh, $ticket, $query); # EXTERNAL AUTH
1537 ($retval) and return ($retval,$retcard,$retuserid);
1538 return 0;
1539 }
1540
1541 return checkpw_internal(@_)
1542}
1543
1544sub checkpw_internal {
1545 my ( $dbh, $userid, $password ) = @_;
1546
1547 my $sth =
1548 $dbh->prepare(
1549"select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1550 );
1551 $sth->execute($userid);
1552 if ( $sth->rows ) {
1553 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1554 $surname, $branchcode, $flags )
1555 = $sth->fetchrow;
1556
1557 if ( checkpw_hash($password, $stored_hash) ) {
1558
1559 C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1560 $firstname, $surname, $branchcode, $flags );
1561 return 1, $cardnumber, $userid;
1562 }
1563 }
1564 $sth =
1565 $dbh->prepare(
1566"select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1567 );
1568 $sth->execute($userid);
1569 if ( $sth->rows ) {
1570 my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname,
1571 $surname, $branchcode, $flags )
1572 = $sth->fetchrow;
1573
1574 if ( checkpw_hash($password, $stored_hash) ) {
1575
1576 C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1577 $firstname, $surname, $branchcode, $flags );
1578 return 1, $cardnumber, $userid;
1579 }
1580 }
1581 if ( $userid && $userid eq C4::Context->config('user')
1582 && "$password" eq C4::Context->config('pass') )
1583 {
1584
1585# Koha superuser account
1586# C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1587 return 2;
1588 }
1589 if ( $userid && $userid eq 'demo'
1590 && "$password" eq 'demo'
1591 && C4::Context->config('demo') )
1592 {
1593
1594# DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1595# some features won't be effective : modify systempref, modify MARC structure,
1596 return 2;
1597 }
1598 return 0;
1599}
1600
1601sub checkpw_hash {
1602 my ( $password, $stored_hash ) = @_;
1603
1604 return if $stored_hash eq '!';
1605
1606 # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
1607 my $hash;
1608 if ( substr($stored_hash,0,2) eq '$2') {
1609 $hash = hash_password($password, $stored_hash);
1610 } else {
1611 $hash = md5_base64($password);
1612 }
1613 return $hash eq $stored_hash;
1614}
1615
1616=head2 getuserflags
1617
1618 my $authflags = getuserflags($flags, $userid, [$dbh]);
1619
1620Translates integer flags into permissions strings hash.
1621
1622C<$flags> is the integer userflags value ( borrowers.userflags )
1623C<$userid> is the members.userid, used for building subpermissions
1624C<$authflags> is a hashref of permissions
1625
1626=cut
1627
1628
# spent 632µs (159+473) within C4::Auth::getuserflags which was called: # once (159µs+473µs) by C4::Auth::haspermission at line 1747
sub getuserflags {
16291500ns my $flags = shift;
16301500ns my $userid = shift;
163115µs19µs my $dbh = @_ ? shift : C4::Context->dbh;
# spent 9µs making 1 call to C4::Context::dbh
16321300ns my $userflags;
1633 {
1634 # I don't want to do this, but if someone logs in as the database
1635 # user, it would be preferable not to spam them to death with
1636 # numeric warnings. So, we make $flags numeric.
163731.12ms252µs
# spent 32µs (12+20) within C4::Auth::BEGIN@1637 which was called: # once (12µs+20µs) by C4::Service::BEGIN@49 at line 1637
no warnings 'numeric';
# spent 32µs making 1 call to C4::Auth::BEGIN@1637 # spent 20µs making 1 call to warnings::unimport
163811µs $flags += 0;
1639 }
1640111µs2122µs my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
# spent 65µs making 1 call to DBI::db::prepare # spent 56µs making 1 call to DBD::mysql::db::prepare
1641167µs160µs $sth->execute;
# spent 60µs making 1 call to DBI::st::execute
1642
16431133µs2047µs while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
# spent 47µs making 20 calls to DBI::st::fetchrow, avg 2µs/call
1644 if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1645 $userflags->{$flag} = 1;
1646 }
1647 else {
16481821µs $userflags->{$flag} = 0;
1649 }
1650 }
1651 # get subpermissions and merge with top-level permissions
165214µs4294µs my $user_subperms = get_user_subpermissions($userid);
# spent 287µs making 1 call to C4::Auth::get_user_subpermissions # spent 6µs making 2 calls to DBI::common::DESTROY, avg 3µs/call # spent 2µs making 1 call to DBD::_mem::common::DESTROY
165313µs foreach my $module (keys %$user_subperms) {
1654 next if $userflags->{$module} == 1; # user already has permission for everything in this module
1655 $userflags->{$module} = $user_subperms->{$module};
1656 }
1657
1658127µs return $userflags;
1659}
1660
1661=head2 get_user_subpermissions
1662
1663 $user_perm_hashref = get_user_subpermissions($userid);
1664
1665Given the userid (note, not the borrowernumber) of a staff user,
1666return a hashref of hashrefs of the specific subpermissions
1667accorded to the user. An example return is
1668
1669 {
1670 tools => {
1671 export_catalog => 1,
1672 import_patrons => 1,
1673 }
1674 }
1675
1676The top-level hash-key is a module or function code from
1677userflags.flag, while the second-level key is a code
1678from permissions.
1679
1680The results of this function do not give a complete picture
1681of the functions that a staff user can access; it is also
1682necessary to check borrowers.flags.
1683
1684=cut
1685
1686
# spent 287µs (51+236) within C4::Auth::get_user_subpermissions which was called: # once (51µs+236µs) by C4::Auth::getuserflags at line 1652
sub get_user_subpermissions {
16871700ns my $userid = shift;
1688
168914µs19µs my $dbh = C4::Context->dbh;
# spent 9µs making 1 call to C4::Context::dbh
1690111µs2121µs my $sth = $dbh->prepare("SELECT flag, user_permissions.code
# spent 65µs making 1 call to DBI::db::prepare # spent 56µs making 1 call to DBD::mysql::db::prepare
1691 FROM user_permissions
1692 JOIN permissions USING (module_bit, code)
1693 JOIN userflags ON (module_bit = bit)
1694 JOIN borrowers USING (borrowernumber)
1695 WHERE userid = ?");
1696172µs164µs $sth->execute($userid);
# spent 64µs making 1 call to DBI::st::execute
1697
16981800ns my $user_perms = {};
1699114µs2172µs while (my $perm = $sth->fetchrow_hashref) {
# spent 90µs making 1 call to DBI::st::fetchrow_hashref # spent 81µs making 1 call to DBD::mysql::st::__ANON__[DBD/mysql.pm:799]
1700 $user_perms->{$perm->{'flag'}}->{$perm->{'code'}} = 1;
1701 }
1702129µs return $user_perms;
1703}
1704
1705=head2 get_all_subpermissions
1706
1707 my $perm_hashref = get_all_subpermissions();
1708
1709Returns a hashref of hashrefs defining all specific
1710permissions currently defined. The return value
1711has the same structure as that of C<get_user_subpermissions>,
1712except that the innermost hash value is the description
1713of the subpermission.
1714
1715=cut
1716
1717sub get_all_subpermissions {
1718 my $dbh = C4::Context->dbh;
1719 my $sth = $dbh->prepare("SELECT flag, code, description
1720 FROM permissions
1721 JOIN userflags ON (module_bit = bit)");
1722 $sth->execute();
1723
1724 my $all_perms = {};
1725 while (my $perm = $sth->fetchrow_hashref) {
1726 $all_perms->{$perm->{'flag'}}->{$perm->{'code'}} = $perm->{'description'};
1727 }
1728 return $all_perms;
1729}
1730
1731=head2 haspermission
1732
1733 $flags = ($userid, $flagsrequired);
1734
1735C<$userid> the userid of the member
1736C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
1737
1738Returns member's flags or 0 if a permission is not met.
1739
1740=cut
1741
1742
# spent 926µs (82+844) within C4::Auth::haspermission which was called: # once (82µs+844µs) by C4::Auth::check_api_auth at line 1232
sub haspermission {
17431800ns my ($userid, $flagsrequired) = @_;
1744128µs3140µs my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
# spent 68µs making 1 call to DBI::db::prepare # spent 57µs making 1 call to DBD::mysql::db::prepare # spent 15µs making 1 call to C4::Context::dbh
1745179µs167µs $sth->execute($userid);
# spent 67µs making 1 call to DBI::st::execute
1746123µs113µs my $row = $sth->fetchrow();
# spent 13µs making 1 call to DBI::st::fetchrow
174714µs4638µs my $flags = getuserflags($row, $userid);
# spent 632µs making 1 call to C4::Auth::getuserflags # 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
174817µs129µs if ( $userid eq C4::Context->config('user') ) {
# spent 29µs making 1 call to C4::Context::config
1749 # Super User Account from /etc/koha.conf
1750 $flags->{'superlibrarian'} = 1;
1751 }
1752 elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
1753 # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1754 $flags->{'superlibrarian'} = 1;
1755 }
1756
1757136µs return $flags if $flags->{superlibrarian};
1758
1759 foreach my $module ( keys %$flagsrequired ) {
1760 my $subperm = $flagsrequired->{$module};
1761 if ($subperm eq '*') {
1762 return 0 unless ( $flags->{$module} == 1 or ref($flags->{$module}) );
1763 } else {
1764 return 0 unless ( $flags->{$module} == 1 or
1765 ( ref($flags->{$module}) and
1766 exists $flags->{$module}->{$subperm} and
1767 $flags->{$module}->{$subperm} == 1
1768 )
1769 );
1770 }
1771 }
1772 return $flags;
1773 #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1774}
1775
1776
1777sub getborrowernumber {
1778 my ($userid) = @_;
1779 my $userenv = C4::Context->userenv;
1780 if ( defined( $userenv ) && ref( $userenv ) eq 'HASH' && $userenv->{number} ) {
1781 return $userenv->{number};
1782 }
1783 my $dbh = C4::Context->dbh;
1784 for my $field ( 'userid', 'cardnumber' ) {
1785 my $sth =
1786 $dbh->prepare("select borrowernumber from borrowers where $field=?");
1787 $sth->execute($userid);
1788 if ( $sth->rows ) {
1789 my ($bnumber) = $sth->fetchrow;
1790 return $bnumber;
1791 }
1792 }
1793 return 0;
1794}
1795
1796sub ParseSearchHistorySession {
1797 my $cgi = shift;
1798 my $sessionID = $cgi->cookie('CGISESSID');
1799 return () unless $sessionID;
1800 my $session = get_session($sessionID);
1801 return () unless $session and $session->param('search_history');
1802 my $obj = eval { decode_json(uri_unescape($session->param('search_history'))) };
1803 return () unless defined $obj;
1804 return () unless ref $obj eq 'ARRAY';
1805 return @{ $obj };
1806}
1807
1808sub SetSearchHistorySession {
1809 my ($cgi, $search_history) = @_;
1810 my $sessionID = $cgi->cookie('CGISESSID');
1811 return () unless $sessionID;
1812 my $session = get_session($sessionID);
1813 return () unless $session;
1814 $session->param('search_history', uri_escape(encode_json($search_history)));
1815}
1816
181712µs
# spent 2µs within C4::Auth::END which was called: # once (2µs+0s) by main::RUNTIME at line 131 of C4/Service.pm
END { } # module clean-up code here (global destructor)
181814µs1;
1819__END__
 
# spent 3µs within C4::Auth::CORE:match which was called: # once (3µs+0s) by C4::Auth::_timeout_syspref at line 620
sub C4::Auth::CORE:match; # opcode
# spent 5µs within C4::Auth::CORE:subst which was called: # once (5µs+0s) by C4::Auth::check_api_auth at line 1171
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::check_api_auth at line 1171, avg 1µs/call
sub C4::Auth::CORE:substcont; # opcode
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.