Profile of C4/Auth_with

Filename	/mnt/catalyst/koha/C4/Auth_with_cas.pm
Statements	Executed 29 statements in 16.6ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	14.7ms	74.5ms	C4::Auth_with_cas::::BEGIN@25C4::Auth_with_cas::BEGIN@25
1	1	1	1.57ms	4.95ms	C4::Auth_with_cas::::BEGIN@27C4::Auth_with_cas::BEGIN@27
1	1	1	1.36ms	1.36ms	C4::Auth_with_cas::::CORE:ftisC4::Auth_with_cas::CORE:ftis (opcode)
1	1	1	413µs	427µs	C4::Auth_with_cas::::BEGIN@20C4::Auth_with_cas::BEGIN@20
1	1	1	11µs	1.37ms	C4::Auth_with_cas::::multipleAuthC4::Auth_with_cas::multipleAuth
1	1	1	11µs	108µs	C4::Auth_with_cas::::BEGIN@30C4::Auth_with_cas::BEGIN@30
1	1	1	11µs	11µs	C4::Auth_with_cas::::BEGIN@32C4::Auth_with_cas::BEGIN@32
1	1	1	10µs	30µs	C4::Auth_with_cas::::BEGIN@26C4::Auth_with_cas::BEGIN@26
1	1	1	10µs	18µs	C4::Auth_with_cas::::BEGIN@21C4::Auth_with_cas::BEGIN@21
1	1	1	9µs	11µs	C4::Auth_with_cas::::BEGIN@24C4::Auth_with_cas::BEGIN@24
1	1	1	8µs	89µs	C4::Auth_with_cas::::BEGIN@23C4::Auth_with_cas::BEGIN@23
0	0	0	0s	0s	C4::Auth_with_cas::_get_cas_and_service
0	0	0	0s	0s	C4::Auth_with_cas::_url_with_get_params
0	0	0	0s	0s	C4::Auth_with_cas::::check_api_auth_casC4::Auth_with_cas::check_api_auth_cas
0	0	0	0s	0s	C4::Auth_with_cas::::checkpw_casC4::Auth_with_cas::checkpw_cas
0	0	0	0s	0s	C4::Auth_with_cas::::getMultipleAuthC4::Auth_with_cas::getMultipleAuth
0	0	0	0s	0s	C4::Auth_with_cas::::login_casC4::Auth_with_cas::login_cas
0	0	0	0s	0s	C4::Auth_with_cas::::login_cas_urlC4::Auth_with_cas::login_cas_url
0	0	0	0s	0s	C4::Auth_with_cas::::logout_casC4::Auth_with_cas::logout_cas

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package C4::Auth_with_cas;
2
3					# Copyright 2009 BibLibre SARL
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
20	2	30µs	2	440µs	# spent 427µs (413+13) within C4::Auth_with_cas::BEGIN@20 which was called: # once (413µs+13µs) by C4::Auth::BEGIN@39 at line 20 use strict; # spent 427µs making 1 call to C4::Auth_with_cas::BEGIN@20 # spent 13µs making 1 call to strict::import
21	2	28µs	2	26µs	# spent 18µs (10+8) within C4::Auth_with_cas::BEGIN@21 which was called: # once (10µs+8µs) by C4::Auth::BEGIN@39 at line 21 use warnings; # spent 18µs making 1 call to C4::Auth_with_cas::BEGIN@21 # spent 8µs making 1 call to warnings::import
22
23	2	26µs	2	170µs	# spent 89µs (8+81) within C4::Auth_with_cas::BEGIN@23 which was called: # once (8µs+81µs) by C4::Auth::BEGIN@39 at line 23 use C4::Debug; # spent 89µs making 1 call to C4::Auth_with_cas::BEGIN@23 # spent 81µs making 1 call to Exporter::import
24	2	25µs	2	14µs	# spent 11µs (9+2) within C4::Auth_with_cas::BEGIN@24 which was called: # once (9µs+2µs) by C4::Auth::BEGIN@39 at line 24 use C4::Context; # spent 11µs making 1 call to C4::Auth_with_cas::BEGIN@24 # spent 2µs making 1 call to C4::Context::import
25	2	13.0ms	1	74.5ms	# spent 74.5ms (14.7+59.8) within C4::Auth_with_cas::BEGIN@25 which was called: # once (14.7ms+59.8ms) by C4::Auth::BEGIN@39 at line 25 use Authen::CAS::Client; # spent 74.5ms making 1 call to C4::Auth_with_cas::BEGIN@25
26	2	25µs	2	51µs	# spent 30µs (10+20) within C4::Auth_with_cas::BEGIN@26 which was called: # once (10µs+20µs) by C4::Auth::BEGIN@39 at line 26 use CGI; # spent 30µs making 1 call to C4::Auth_with_cas::BEGIN@26 # spent 20µs making 1 call to CGI::import
27	2	1.06ms	2	4.96ms	# spent 4.95ms (1.57+3.37) within C4::Auth_with_cas::BEGIN@27 which was called: # once (1.57ms+3.37ms) by C4::Auth::BEGIN@39 at line 27 use FindBin; # spent 4.95ms making 1 call to C4::Auth_with_cas::BEGIN@27 # spent 15µs making 1 call to Exporter::import
28
29
30	2	84µs	2	204µs	# spent 108µs (11+97) within C4::Auth_with_cas::BEGIN@30 which was called: # once (11µs+97µs) by C4::Auth::BEGIN@39 at line 30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug); # spent 108µs making 1 call to C4::Auth_with_cas::BEGIN@30 # spent 97µs making 1 call to vars::import
31
32					# spent 11µs within C4::Auth_with_cas::BEGIN@32 which was called: # once (11µs+0s) by C4::Auth::BEGIN@39 at line 38 BEGIN {
33	1	500ns			require Exporter;
34	1	700ns			$VERSION = 3.07.00.049; # set the version for version checking
35	1	600ns			$debug = $ENV{DEBUG};
36	1	5µs			@ISA = qw(Exporter);
37	1	5µs			@EXPORT = qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url);
38	1	884µs	1	11µs	} # spent 11µs making 1 call to C4::Auth_with_cas::BEGIN@32
39	1	4µs	1	10.4ms	my $context = C4::Context->new() or die 'C4::Context->new failed'; # spent 10.4ms making 1 call to C4::Context::new
40	1	100ns			my $defaultcasserver;
41					my $casservers;
42	1	700ns			my $yamlauthfile = "../C4/Auth_cas_servers.yaml";
43
44
45					# If there's a configuration for multiple cas servers, then we get it
46	1	2µs	1	1.37ms	if (multipleAuth()) { # spent 1.37ms making 1 call to C4::Auth_with_cas::multipleAuth
47					($defaultcasserver, $casservers) = YAML::LoadFile(qq($FindBin::Bin/$yamlauthfile));
48					$defaultcasserver = $defaultcasserver->{'default'};
49					} else {
50					# Else, we fall back to casServerUrl syspref
51	1	500ns			$defaultcasserver = 'default';
52	1	6µs	1	194µs	$casservers = { 'default' => C4::Context->preference('casServerUrl') }; # spent 194µs making 1 call to C4::Context::preference
53					}
54
55					# Is there a configuration file for multiple cas servers?
56					# spent 1.37ms (11µs+1.36) within C4::Auth_with_cas::multipleAuth which was called: # once (11µs+1.36ms) by C4::Auth::BEGIN@39 at line 46 sub multipleAuth {
57	1	1.37ms	1	1.36ms	return (-e qq($FindBin::Bin/$yamlauthfile)); # spent 1.36ms making 1 call to C4::Auth_with_cas::CORE:ftis
58					}
59
60					# Returns configured CAS servers' list if multiple authentication is enabled
61					sub getMultipleAuth {
62					return $casservers;
63					}
64
65					# Logout from CAS
66					sub logout_cas {
67					my ($query) = @_;
68					my ( $cas, $uri ) = _get_cas_and_service($query);
69					print $query->redirect( $cas->logout_url($uri));
70					}
71
72					# Login to CAS
73					sub login_cas {
74					my ($query) = @_;
75					my ( $cas, $uri ) = _get_cas_and_service($query);
76					print $query->redirect( $cas->login_url($uri));
77					}
78
79					# Returns CAS login URL with callback to the requesting URL
80					sub login_cas_url {
81					my ( $query, $key ) = @_;
82					my ( $cas, $uri ) = _get_cas_and_service( $query, $key );
83					return $cas->login_url($uri);
84					}
85
86					# Checks for password correctness
87					# In our case : is there a ticket, is it valid and does it match one of our users ?
88					sub checkpw_cas {
89					$debug and warn "checkpw_cas";
90					my ($dbh, $ticket, $query) = @_;
91					my $retnumber;
92					my ( $cas, $uri ) = _get_cas_and_service($query);
93
94					# If we got a ticket
95					if ($ticket) {
96					$debug and warn "Got ticket : $ticket";
97
98					# We try to validate it
99					my $val = $cas->service_validate($uri, $ticket );
100
101					# If it's valid
102					if ( $val->is_success() ) {
103
104					my $userid = $val->user();
105					$debug and warn "User CAS authenticated as: $userid";
106
107					# Does it match one of our users ?
108					my $sth = $dbh->prepare("select cardnumber from borrowers where userid=?");
109					$sth->execute($userid);
110					if ( $sth->rows ) {
111					$retnumber = $sth->fetchrow;
112					return ( 1, $retnumber, $userid );
113					}
114					$sth = $dbh->prepare("select userid from borrowers where cardnumber=?");
115					$sth->execute($userid);
116					if ( $sth->rows ) {
117					$retnumber = $sth->fetchrow;
118					return ( 1, $retnumber, $userid );
119					}
120
121					# If we reach this point, then the user is a valid CAS user, but not a Koha user
122					$debug and warn "User $userid is not a valid Koha user";
123
124					} else {
125					$debug and warn "Problem when validating ticket : $ticket";
126					$debug and warn "Authen::CAS::Client::Response::Error: " . $val->error() if $val->is_error();
127					$debug and warn "Authen::CAS::Client::Response::Failure: " . $val->message() if $val->is_failure();
128					$debug and warn Data::Dumper::Dumper($@) if $val->is_error() or $val->is_failure();
129					return 0;
130					}
131					}
132					return 0;
133					}
134
135					# Proxy CAS auth
136					sub check_api_auth_cas {
137					$debug and warn "check_api_auth_cas";
138					my ($dbh, $PT, $query) = @_;
139					my $retnumber;
140					my ( $cas, $uri ) = _get_cas_and_service($query);
141
142					# If we have a Proxy Ticket
143					if ($PT) {
144					my $r = $cas->proxy_validate( $uri, $PT );
145
146					# If the PT is valid
147					if ( $r->is_success ) {
148
149					# We've got a username !
150					$debug and warn "User authenticated as: ", $r->user, "\n";
151					$debug and warn "Proxied through:\n";
152					$debug and warn " $_\n" for $r->proxies;
153
154					my $userid = $r->user;
155
156					# Does it match one of our users ?
157					my $sth = $dbh->prepare("select cardnumber from borrowers where userid=?");
158					$sth->execute($userid);
159					if ( $sth->rows ) {
160					$retnumber = $sth->fetchrow;
161					return ( 1, $retnumber, $userid );
162					}
163					$sth = $dbh->prepare("select userid from borrowers where cardnumber=?");
164					return $r->user;
165					$sth->execute($userid);
166					if ( $sth->rows ) {
167					$retnumber = $sth->fetchrow;
168					return ( 1, $retnumber, $userid );
169					}
170
171					# If we reach this point, then the user is a valid CAS user, but not a Koha user
172					$debug and warn "User $userid is not a valid Koha user";
173
174					} else {
175					$debug and warn "Proxy Ticket authentication failed";
176					return 0;
177					}
178					}
179					return 0;
180					}
181
182					# Get CAS handler and service URI
183					sub _get_cas_and_service {
184					my $query = shift;
185					my $key = shift; # optional
186
187					my $uri = _url_with_get_params($query);
188
189					my $casparam = $defaultcasserver;
190					$casparam = $query->param('cas') if defined $query->param('cas');
191					$casparam = $key if defined $key;
192					my $cas = Authen::CAS::Client->new( $casservers->{$casparam} );
193
194					return ( $cas, $uri );
195					}
196
197					# Get the current URL with parameters contained directly into URL (GET params)
198					# This method replaces $query->url() which will give both GET and POST params
199					sub _url_with_get_params {
200					my $query = shift;
201
202					my $uri_base_part = C4::Context->preference('OPACBaseURL') . $query->script_name();
203					my $uri_params_part = '';
204					foreach ( $query->url_param() ) {
205					$uri_params_part .= '&' if $uri_params_part;
206					$uri_params_part .= $_ . '=';
207					$uri_params_part .= URI::Escape::uri_escape( $query->url_param($_) );
208					}
209					$uri_base_part .= '?' if $uri_params_part;
210
211					return $uri_base_part . $uri_params_part;
212					}
213
214	1	36µs			1;
215					__END__

					# spent 1.36ms within C4::Auth_with_cas::CORE:ftis which was called: # once (1.36ms+0s) by C4::Auth_with_cas::multipleAuth at line 57 sub C4::Auth_with_cas::CORE:ftis; # opcode