Profile of C4/Auth_with

Filename	/home/vagrant/kohaclone/C4/Auth_with_cas.pm
Statements	Executed 31 statements in 12.8ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	1.67ms	12.5ms	C4::Auth_with_cas::::BEGIN@25C4::Auth_with_cas::BEGIN@25
1	1	1	34µs	80µs	C4::Auth_with_cas::::BEGIN@26C4::Auth_with_cas::BEGIN@26
1	1	1	28µ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	18µs	105µs	C4::Auth_with_cas::::BEGIN@23C4::Auth_with_cas::BEGIN@23
1	1	1	14µs	36µs	C4::Auth_with_cas::::BEGIN@27C4::Auth_with_cas::BEGIN@27
1	1	1	14µs	45µ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	22µs	C4::Auth_with_cas::::BEGIN@21C4::Auth_with_cas::BEGIN@21
1	1	1	11µs	13µs	C4::Auth_with_cas::::BEGIN@24C4::Auth_with_cas::BEGIN@24
1	1	1	10µs	32µs	C4::Auth_with_cas::::multipleAuthC4::Auth_with_cas::multipleAuth
1	1	1	10µs	53µs	C4::Auth_with_cas::::BEGIN@31C4::Auth_with_cas::BEGIN@31
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
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	59µs	2	55µs	# spent 42µs (28+14) within C4::Auth_with_cas::BEGIN@20 which was called: # once (28µs+14µ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 14µs making 1 call to strict::import
21	2	43µs	2	32µs	# spent 22µs (12+10) within C4::Auth_with_cas::BEGIN@21 which was called: # once (12µs+10µs) by C4::Auth::BEGIN@43 at line 21 use warnings; # spent 22µs making 1 call to C4::Auth_with_cas::BEGIN@21 # spent 10µs making 1 call to warnings::import
22
23	2	128µs	2	192µs	# spent 105µs (18+87) within C4::Auth_with_cas::BEGIN@23 which was called: # once (18µs+87µs) by C4::Auth::BEGIN@43 at line 23 use C4::Debug; # spent 105µs making 1 call to C4::Auth_with_cas::BEGIN@23 # spent 87µs making 1 call to Exporter::import
24	2	37µs	2	16µs	# spent 13µs (11+3) within C4::Auth_with_cas::BEGIN@24 which was called: # once (11µs+3µs) by C4::Auth::BEGIN@43 at line 24 use C4::Context; # spent 13µs making 1 call to C4::Auth_with_cas::BEGIN@24 # spent 3µs making 1 call to C4::Context::import
25	2	246µs	1	12.5ms	# spent 12.5ms (1.67+10.8) within C4::Auth_with_cas::BEGIN@25 which was called: # once (1.67ms+10.8ms) by C4::Auth::BEGIN@43 at line 25 use Authen::CAS::Client; # spent 12.5ms making 1 call to C4::Auth_with_cas::BEGIN@25
26	2	85µs	2	125µs	# spent 80µs (34+46) within C4::Auth_with_cas::BEGIN@26 which was called: # once (34µs+46µs) by C4::Auth::BEGIN@43 at line 26 use CGI qw ( -utf8 ); # spent 80µs making 1 call to C4::Auth_with_cas::BEGIN@26 # spent 46µs making 1 call to CGI::import
27	2	56µs	2	57µs	# spent 36µs (14+21) within C4::Auth_with_cas::BEGIN@27 which was called: # once (14µs+21µs) by C4::Auth::BEGIN@43 at line 27 use FindBin; # spent 36µs making 1 call to C4::Auth_with_cas::BEGIN@27 # spent 21µs making 1 call to Exporter::import
28	2	72µs	2	75µs	# spent 45µ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 45µs making 1 call to C4::Auth_with_cas::BEGIN@28 # spent 30µs making 1 call to Exporter::import
29
30
31	2	106µs	2	97µs	# spent 53µs (10+44) within C4::Auth_with_cas::BEGIN@31 which was called: # once (10µs+44µs) by C4::Auth::BEGIN@43 at line 31 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug); # spent 53µs making 1 call to C4::Auth_with_cas::BEGIN@31 # spent 44µ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	1	900ns			require Exporter;
35	1	900ns			$VERSION = 3.07.00.049; # set the version for version checking
36	1	800ns			$debug = $ENV{DEBUG};
37	1	6µs			@ISA = qw(Exporter);
38	1	4µs			@EXPORT = qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url);
39	1	978µs	1	14µs	} # spent 14µs making 1 call to C4::Auth_with_cas::BEGIN@33
40	1	10.8ms	1	10.8ms	my $context = C4::Context->new() or die 'C4::Context->new failed'; # spent 10.8ms making 1 call to C4::Context::new
41	1	300ns			my $defaultcasserver;
42					my $casservers;
43	1	10µs	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	3µs	1	32µs	if (multipleAuth()) { # spent 32µ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	1	500ns			$defaultcasserver = 'default';
53	1	15µs	1	2.62ms	$casservers = { 'default' => C4::Context->preference('casServerUrl') }; # spent 2.62ms making 1 call to C4::Context::preference
54					}
55
56					# Is there a configuration file for multiple cas servers?
57					# spent 32µs (10+21) within C4::Auth_with_cas::multipleAuth which was called: # once (10µs+21µs) by C4::Auth::BEGIN@43 at line 47 sub multipleAuth {
58	1	32µs	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	60µs			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