Profile of C4/Auth_with

Filename	/home/vagrant/kohaclone/C4/Auth_with_cas.pm
Statements	Executed 0 statements in 0s

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	1.69ms	12.7ms	C4::Auth_with_cas::::BEGIN@25C4::Auth_with_cas::BEGIN@25
1	1	1	29µs	42µs	C4::Auth_with_cas::::BEGIN@20C4::Auth_with_cas::BEGIN@20
1	1	1	21µs	21µs	C4::Auth_with_cas::::CORE:ftisC4::Auth_with_cas::CORE:ftis (opcode)
1	1	1	20µs	68µs	C4::Auth_with_cas::::BEGIN@31C4::Auth_with_cas::BEGIN@31
1	1	1	18µs	104µs	C4::Auth_with_cas::::BEGIN@23C4::Auth_with_cas::BEGIN@23
1	1	1	15µs	39µs	C4::Auth_with_cas::::BEGIN@27C4::Auth_with_cas::BEGIN@27
1	1	1	15µs	45µs	C4::Auth_with_cas::::BEGIN@26C4::Auth_with_cas::BEGIN@26
1	1	1	14µs	44µs	C4::Auth_with_cas::::BEGIN@28C4::Auth_with_cas::BEGIN@28
1	1	1	14µs	14µs	C4::Auth_with_cas::::BEGIN@33C4::Auth_with_cas::BEGIN@33
1	1	1	12µs	21µs	C4::Auth_with_cas::::BEGIN@21C4::Auth_with_cas::BEGIN@21
1	1	1	10µs	12µs	C4::Auth_with_cas::::BEGIN@24C4::Auth_with_cas::BEGIN@24
1	1	1	9µs	30µs	C4::Auth_with_cas::::multipleAuthC4::Auth_with_cas::multipleAuth
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	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
8			# under the terms of the GNU General Public License as published by
9			# the Free Software Foundation; either version 3 of the License, or
10			# (at your option) any later version.
11			#
12			# Koha is distributed in the hope that it will be useful, but
13			# WITHOUT ANY WARRANTY; without even the implied warranty of
14			# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15			# GNU General Public License for more details.
16			#
17			# You should have received a copy of the GNU General Public License
18			# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20	2	55µs	# spent 42µs (29+13) within C4::Auth_with_cas::BEGIN@20 which was called: # once (29µs+13µs) by C4::Auth::BEGIN@43 at line 20 use strict; # spent 42µs making 1 call to C4::Auth_with_cas::BEGIN@20 # spent 13µs making 1 call to strict::import
21	2	30µs	# spent 21µs (12+9) within C4::Auth_with_cas::BEGIN@21 which was called: # once (12µs+9µs) by C4::Auth::BEGIN@43 at line 21 use warnings; # spent 21µs making 1 call to C4::Auth_with_cas::BEGIN@21 # spent 9µs making 1 call to warnings::import
22
23	2	190µs	# spent 104µs (18+86) within C4::Auth_with_cas::BEGIN@23 which was called: # once (18µs+86µs) by C4::Auth::BEGIN@43 at line 23 use C4::Debug; # spent 104µs making 1 call to C4::Auth_with_cas::BEGIN@23 # spent 86µs making 1 call to Exporter::import
24	2	15µs	# spent 12µs (10+2) within C4::Auth_with_cas::BEGIN@24 which was called: # once (10µs+2µs) by C4::Auth::BEGIN@43 at line 24 use C4::Context; # spent 12µs making 1 call to C4::Auth_with_cas::BEGIN@24 # spent 2µs making 1 call to C4::Context::import
25	1	12.7ms	# spent 12.7ms (1.69+11.0) within C4::Auth_with_cas::BEGIN@25 which was called: # once (1.69ms+11.0ms) by C4::Auth::BEGIN@43 at line 25 use Authen::CAS::Client; # spent 12.7ms making 1 call to C4::Auth_with_cas::BEGIN@25
26	2	76µs	# spent 45µs (15+31) within C4::Auth_with_cas::BEGIN@26 which was called: # once (15µs+31µs) by C4::Auth::BEGIN@43 at line 26 use CGI qw ( -utf8 ); # spent 45µs making 1 call to C4::Auth_with_cas::BEGIN@26 # spent 31µs making 1 call to CGI::import
27	2	63µs	# spent 39µs (15+24) within C4::Auth_with_cas::BEGIN@27 which was called: # once (15µs+24µs) by C4::Auth::BEGIN@43 at line 27 use FindBin; # spent 39µs making 1 call to C4::Auth_with_cas::BEGIN@27 # spent 24µs making 1 call to Exporter::import
28	2	73µs	# spent 44µs (14+30) within C4::Auth_with_cas::BEGIN@28 which was called: # once (14µs+30µs) by C4::Auth::BEGIN@43 at line 28 use YAML; # spent 44µs making 1 call to C4::Auth_with_cas::BEGIN@28 # spent 30µs making 1 call to Exporter::import
29
30
31	2	116µs	# spent 68µs (20+48) within C4::Auth_with_cas::BEGIN@31 which was called: # once (20µs+48µs) by C4::Auth::BEGIN@43 at line 31 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug); # spent 68µs making 1 call to C4::Auth_with_cas::BEGIN@31 # spent 48µs making 1 call to vars::import
32
33			# spent 14µs within C4::Auth_with_cas::BEGIN@33 which was called: # once (14µs+0s) by C4::Auth::BEGIN@43 at line 39 BEGIN {
34			require Exporter;
35			$VERSION = 3.07.00.049; # set the version for version checking
36			$debug = $ENV{DEBUG};
37			@ISA = qw(Exporter);
38			@EXPORT = qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url);
39	1	14µs	} # spent 14µs making 1 call to C4::Auth_with_cas::BEGIN@33
40	1	11.2ms	my $context = C4::Context->new() or die 'C4::Context->new failed'; # spent 11.2ms making 1 call to C4::Context::new
41			my $defaultcasserver;
42			my $casservers;
43	1	3µs	my $yamlauthfile = C4::Context->config('intranetdir') . "/C4/Auth_cas_servers.yaml"; # spent 3µs making 1 call to C4::Context::config
44
45
46			# If there's a configuration for multiple cas servers, then we get it
47	1	30µs	if (multipleAuth()) { # spent 30µs making 1 call to C4::Auth_with_cas::multipleAuth
48			($defaultcasserver, $casservers) = YAML::LoadFile($yamlauthfile);
49			$defaultcasserver = $defaultcasserver->{'default'};
50			} else {
51			# Else, we fall back to casServerUrl syspref
52			$defaultcasserver = 'default';
53	1	2.67ms	$casservers = { 'default' => C4::Context->preference('casServerUrl') }; # spent 2.67ms making 1 call to C4::Context::preference
54			}
55
56			# Is there a configuration file for multiple cas servers?
57			# spent 30µs (9+21) within C4::Auth_with_cas::multipleAuth which was called: # once (9µs+21µs) by C4::Auth::BEGIN@43 at line 47 sub multipleAuth {
58	1	21µs	return (-e qq($yamlauthfile)); # spent 21µs making 1 call to C4::Auth_with_cas::CORE:ftis
59			}
60
61			# Returns configured CAS servers' list if multiple authentication is enabled
62			sub getMultipleAuth {
63			return $casservers;
64			}
65
66			# Logout from CAS
67			sub logout_cas {
68			my ($query, $type) = @_;
69			my ( $cas, $uri ) = _get_cas_and_service($query, undef, $type);
70			print $query->redirect( $cas->logout_url($uri));
71			print $query->redirect( $cas->logout_url(url => $uri));
72			}
73
74			# Login to CAS
75			sub login_cas {
76			my ($query, $type) = @_;
77			my ( $cas, $uri ) = _get_cas_and_service($query, undef, $type);
78			print $query->redirect( $cas->login_url($uri));
79			}
80
81			# Returns CAS login URL with callback to the requesting URL
82			sub login_cas_url {
83			my ( $query, $key, $type ) = @_;
84			my ( $cas, $uri ) = _get_cas_and_service( $query, $key, $type );
85			return $cas->login_url($uri);
86			}
87
88			# Checks for password correctness
89			# In our case : is there a ticket, is it valid and does it match one of our users ?
90			sub checkpw_cas {
91			$debug and warn "checkpw_cas";
92			my ($dbh, $ticket, $query, $type) = @_;
93			my $retnumber;
94			my ( $cas, $uri ) = _get_cas_and_service($query, undef, $type);
95
96			# If we got a ticket
97			if ($ticket) {
98			$debug and warn "Got ticket : $ticket";
99
100			# We try to validate it
101			my $val = $cas->service_validate($uri, $ticket );
102
103			# If it's valid
104			if ( $val->is_success() ) {
105
106			my $userid = $val->user();
107			$debug and warn "User CAS authenticated as: $userid";
108
109			# Does it match one of our users ?
110			my $sth = $dbh->prepare("select cardnumber from borrowers where userid=?");
111			$sth->execute($userid);
112			if ( $sth->rows ) {
113			$retnumber = $sth->fetchrow;
114			return ( 1, $retnumber, $userid );
115			}
116			$sth = $dbh->prepare("select userid from borrowers where cardnumber=?");
117			$sth->execute($userid);
118			if ( $sth->rows ) {
119			$retnumber = $sth->fetchrow;
120			return ( 1, $retnumber, $userid );
121			}
122
123			# If we reach this point, then the user is a valid CAS user, but not a Koha user
124			$debug and warn "User $userid is not a valid Koha user";
125
126			} else {
127			$debug and warn "Problem when validating ticket : $ticket";
128			$debug and warn "Authen::CAS::Client::Response::Error: " . $val->error() if $val->is_error();
129			$debug and warn "Authen::CAS::Client::Response::Failure: " . $val->message() if $val->is_failure();
130			$debug and warn Data::Dumper::Dumper($@) if $val->is_error() or $val->is_failure();
131			return 0;
132			}
133			}
134			return 0;
135			}
136
137			# Proxy CAS auth
138			sub check_api_auth_cas {
139			$debug and warn "check_api_auth_cas";
140			my ($dbh, $PT, $query, $type) = @_;
141			my $retnumber;
142			my ( $cas, $uri ) = _get_cas_and_service($query, undef, $type);
143
144			# If we have a Proxy Ticket
145			if ($PT) {
146			my $r = $cas->proxy_validate( $uri, $PT );
147
148			# If the PT is valid
149			if ( $r->is_success ) {
150
151			# We've got a username !
152			$debug and warn "User authenticated as: ", $r->user, "\n";
153			$debug and warn "Proxied through:\n";
154			$debug and warn " $_\n" for $r->proxies;
155
156			my $userid = $r->user;
157
158			# Does it match one of our users ?
159			my $sth = $dbh->prepare("select cardnumber from borrowers where userid=?");
160			$sth->execute($userid);
161			if ( $sth->rows ) {
162			$retnumber = $sth->fetchrow;
163			return ( 1, $retnumber, $userid );
164			}
165			$sth = $dbh->prepare("select userid from borrowers where cardnumber=?");
166			return $r->user;
167			$sth->execute($userid);
168			if ( $sth->rows ) {
169			$retnumber = $sth->fetchrow;
170			return ( 1, $retnumber, $userid );
171			}
172
173			# If we reach this point, then the user is a valid CAS user, but not a Koha user
174			$debug and warn "User $userid is not a valid Koha user";
175
176			} else {
177			$debug and warn "Proxy Ticket authentication failed";
178			return 0;
179			}
180			}
181			return 0;
182			}
183
184			# Get CAS handler and service URI
185			sub _get_cas_and_service {
186			my $query = shift;
187			my $key = shift; # optional
188			my $type = shift;
189
190			my $uri = _url_with_get_params($query, $type);
191
192			my $casparam = $defaultcasserver;
193			$casparam = $query->param('cas') if defined $query->param('cas');
194			$casparam = $key if defined $key;
195			my $cas = Authen::CAS::Client->new( $casservers->{$casparam} );
196
197			return ( $cas, $uri );
198			}
199
200			# Get the current URL with parameters contained directly into URL (GET params)
201			# This method replaces $query->url() which will give both GET and POST params
202			sub _url_with_get_params {
203			my $query = shift;
204			my $type = shift;
205
206			my $uri_base_part = ($type eq 'opac') ?
207			C4::Context->preference('OPACBaseURL') . $query->script_name():
208			C4::Context->preference('staffClientBaseURL');
209
210			my $uri_params_part = '';
211			foreach my $param ( $query->url_param() ) {
212			# url_param() always returns parameters that were deleted by delete()
213			# This additional check ensure that parameter was not deleted.
214			my $uriPiece = $query->param($param);
215			if ($uriPiece) {
216			$uri_params_part .= '&' if $uri_params_part;
217			$uri_params_part .= $param . '=';
218			$uri_params_part .= URI::Escape::uri_escape( $uriPiece );
219			}
220			}
221			$uri_base_part .= '?' if $uri_params_part;
222
223			return $uri_base_part . $uri_params_part;
224			}
225
226			1;
227			__END__

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