← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Tue Nov 7 05:38:10 2017
Reported on Tue Nov 7 06:16:02 2017

Filename/usr/local/lib/perl5/site_perl/IO/Socket/INET6.pm
StatementsExecuted 22 statements in 5.54ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11147µs57µsIO::Socket::INET6::::BEGIN@12IO::Socket::INET6::BEGIN@12
11133µs406µsIO::Socket::INET6::::BEGIN@37IO::Socket::INET6::BEGIN@37
11126µs106µsIO::Socket::INET6::::BEGIN@43IO::Socket::INET6::BEGIN@43
11125µs25µsIO::Socket::INET6::::BEGIN@15IO::Socket::INET6::BEGIN@15
11122µs420µsIO::Socket::INET6::::BEGIN@28IO::Socket::INET6::BEGIN@28
11122µs238µsIO::Socket::INET6::::BEGIN@42IO::Socket::INET6::BEGIN@42
11119µs53µsIO::Socket::INET6::::BEGIN@13IO::Socket::INET6::BEGIN@13
11110µs10µsIO::Socket::INET6::::BEGIN@26IO::Socket::INET6::BEGIN@26
0000s0sIO::Socket::INET6::::_errorIO::Socket::INET6::_error
0000s0sIO::Socket::INET6::::_scope_ntohlIO::Socket::INET6::_scope_ntohl
0000s0sIO::Socket::INET6::::_sock_infoIO::Socket::INET6::_sock_info
0000s0sIO::Socket::INET6::::acceptIO::Socket::INET6::accept
0000s0sIO::Socket::INET6::::bindIO::Socket::INET6::bind
0000s0sIO::Socket::INET6::::configureIO::Socket::INET6::configure
0000s0sIO::Socket::INET6::::connectIO::Socket::INET6::connect
0000s0sIO::Socket::INET6::::newIO::Socket::INET6::new
0000s0sIO::Socket::INET6::::peeraddrIO::Socket::INET6::peeraddr
0000s0sIO::Socket::INET6::::peerflowIO::Socket::INET6::peerflow
0000s0sIO::Socket::INET6::::peerhostIO::Socket::INET6::peerhost
0000s0sIO::Socket::INET6::::peerportIO::Socket::INET6::peerport
0000s0sIO::Socket::INET6::::peerscopeIO::Socket::INET6::peerscope
0000s0sIO::Socket::INET6::::sockaddrIO::Socket::INET6::sockaddr
0000s0sIO::Socket::INET6::::sockdomainIO::Socket::INET6::sockdomain
0000s0sIO::Socket::INET6::::sockflowIO::Socket::INET6::sockflow
0000s0sIO::Socket::INET6::::sockhostIO::Socket::INET6::sockhost
0000s0sIO::Socket::INET6::::sockportIO::Socket::INET6::sockport
0000s0sIO::Socket::INET6::::sockscopeIO::Socket::INET6::sockscope
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# IO::Socket::INET6.pm
2#
3# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
4# This program is free software; you can redistribute it and/or
5# modify it under the same terms as Perl itself.
6#
7# Modified by Rafael Martinez-Torres <rafael.martinez@novagnet.com>
8# Euro6IX project (www.euro6ix.org) 2003.
9
10package IO::Socket::INET6;
11
12259µs268µs
# spent 57µs (47+10) within IO::Socket::INET6::BEGIN@12 which was called: # once (47µs+10µs) by Net::DNS::Resolver::Base::BEGIN@33 at line 12
use strict;
# spent 57µs making 1 call to IO::Socket::INET6::BEGIN@12 # spent 10µs making 1 call to strict::import
13271µs287µs
# spent 53µs (19+34) within IO::Socket::INET6::BEGIN@13 which was called: # once (19µs+34µs) by Net::DNS::Resolver::Base::BEGIN@33 at line 13
use warnings;
# spent 53µs making 1 call to IO::Socket::INET6::BEGIN@13 # spent 34µs making 1 call to warnings::import
14
152131µs125µs
# spent 25µs within IO::Socket::INET6::BEGIN@15 which was called: # once (25µs+0s) by Net::DNS::Resolver::Base::BEGIN@33 at line 15
use 5.008;
# spent 25µs making 1 call to IO::Socket::INET6::BEGIN@15
16
17our(@ISA, $VERSION);
18
19# Do it so we won't import any symbols from IO::Socket which it does export
20# by default:
21#
22# <LeoNerd> IO::Socket is stupidstupidstupid beyond belief. Despite being an
23# object class, it has an import method
24# <LeoNerd> So you have to use IO::Socket ();
25# <LeoNerd> Having done that, this test is now clean
262104µs110µs
# spent 10µs within IO::Socket::INET6::BEGIN@26 which was called: # once (10µs+0s) by Net::DNS::Resolver::Base::BEGIN@33 at line 26
use IO::Socket ();
# spent 10µs making 1 call to IO::Socket::INET6::BEGIN@26
27
2812µs
# spent 420µs (22+398) within IO::Socket::INET6::BEGIN@28 which was called: # once (22µs+398µs) by Net::DNS::Resolver::Base::BEGIN@33 at line 33
use Socket (qw(
29 AF_INET6 PF_INET6 SOCK_RAW SOCK_STREAM INADDR_ANY SOCK_DGRAM
30 AF_INET SO_REUSEADDR SO_REUSEPORT AF_UNSPEC SO_BROADCAST
31 sockaddr_in
32 )
33189µs2818µs);
# spent 420µs making 1 call to IO::Socket::INET6::BEGIN@28 # spent 398µs making 1 call to Exporter::import
34
35# IO::Socket and Socket already import stuff here - possibly AF_INET6
36# and PF_INET6 so selectively import things from Socket6.
37
# spent 406µs (33+372) within IO::Socket::INET6::BEGIN@37 which was called: # once (33µs+372µs) by Net::DNS::Resolver::Base::BEGIN@33 at line 40
use Socket6 (
3812µs qw(AI_PASSIVE getaddrinfo
39 sockaddr_in6 unpack_sockaddr_in6_all pack_sockaddr_in6_all in6addr_any)
40164µs2778µs);
# spent 406µs making 1 call to IO::Socket::INET6::BEGIN@37 # spent 372µs making 1 call to Exporter::import
41
42257µs2454µs
# spent 238µs (22+216) within IO::Socket::INET6::BEGIN@42 which was called: # once (22µs+216µs) by Net::DNS::Resolver::Base::BEGIN@33 at line 42
use Carp;
# spent 238µs making 1 call to IO::Socket::INET6::BEGIN@42 # spent 216µs making 1 call to Exporter::import
4324.89ms2187µs
# spent 106µs (26+80) within IO::Socket::INET6::BEGIN@43 which was called: # once (26µs+80µs) by Net::DNS::Resolver::Base::BEGIN@33 at line 43
use Errno;
# spent 106µs making 1 call to IO::Socket::INET6::BEGIN@43 # spent 80µs making 1 call to Exporter::import
44
45119µs@ISA = qw(IO::Socket);
4612µs$VERSION = "2.72";
47#Purpose: allow protocol independent protocol and original interface.
48
4919µsmy $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1;
50
51115µs112µsIO::Socket::INET6->register_domain( AF_INET6 );
# spent 12µs making 1 call to IO::Socket::register_domain
52
53
5415µsmy %socket_type = ( tcp => SOCK_STREAM,
55 udp => SOCK_DGRAM,
56 icmp => SOCK_RAW
57 );
58
59sub new {
60 my $class = shift;
61 unshift(@_, "PeerAddr") if @_ == 1;
62 return $class->SUPER::new(@_);
63}
64
65# Parsing analysis:
66# addr,port,and proto may be syntactically related...
67sub _sock_info {
68 my($addr,$port,$proto) = @_;
69 my $origport = $port;
70 my @proto = ();
71 my @serv = ();
72
73 if (defined $addr) {
74 if (!Socket6::inet_pton(AF_INET6,$addr)) {
75 if($addr =~ s,^\[([\da-fA-F:]+)\]:([\w\(\)/]+)$,$1,) {
76 $port = $2;
77 } elsif($addr =~ s,^\[(::[\da-fA-F.:]+)\]:([\w\(\)/]+)$,$1,) {
78 $port = $2;
79 } elsif($addr =~ s,^\[([\da-fA-F:]+)\],$1,) {
80 $port = $origport;
81 } elsif($addr =~ s,:([\w\(\)/]+)$,,) {
82 $port = $1
83 }
84 }
85 }
86
87 # $proto as "string".
88 if(defined $proto && $proto =~ /\D/) {
89 if(@proto = getprotobyname($proto)) {
90 $proto = $proto[2] || undef;
91 }
92 else {
93 $@ = "Bad protocol '$proto'";
94 return;
95 }
96 }
97
98 if(defined $port) {
99 my $defport = ($port =~ s,\((\d+)\)$,,) ? $1 : undef;
100 my $pnum = ($port =~ m,^(\d+)$,)[0];
101
102 @serv = getservbyname($port, $proto[0] || "")
103 if ($port =~ m,\D,);
104
105 $port = $serv[2] || $defport || $pnum;
106 unless (defined $port) {
107 $@ = "Bad service '$origport'";
108 return;
109 }
110
111 $proto = (getprotobyname($serv[3]))[2] || undef
112 if @serv && !$proto;
113 }
114 #printf "Selected port is $port and proto is $proto \n";
115
116 return ($addr || undef,
117 $port || undef,
118 $proto || undef,
119 );
120
121}
122
123sub _error {
124 my $sock = shift;
125 my $err = shift;
126 {
127 local($!);
128 my $title = ref($sock).": ";
129 $@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_);
130 close($sock)
131 if(defined fileno($sock));
132 }
133 $! = $err;
134 return undef;
135}
136
137sub configure {
138 my($sock,$arg) = @_;
139
140 $arg->{LocalAddr} = $arg->{LocalHost}
141 if exists $arg->{LocalHost} && !exists $arg->{LocalAddr};
142 $arg->{PeerAddr} = $arg->{PeerHost}
143 if exists $arg->{PeerHost} && !exists $arg->{PeerAddr};
144
145 my $family = $arg->{Domain};
146 # in case no local and peer is given we prefer AF_INET6
147 # because we are IO::Socket::INET6
148 $family ||= ! $arg->{LocalAddr} && ! $arg->{PeerAddr} && AF_INET6
149 || AF_UNSPEC;
150
151 # parse Local*
152 my ($laddr,$lport,$proto) = _sock_info(
153 $arg->{LocalAddr},
154 $arg->{LocalPort},
155 $arg->{Proto}
156 ) or return _error($sock, $!, "sock_info: $@");
157 $laddr ||= '';
158 $lport ||= 0;
159 $proto ||= (getprotobyname('tcp'))[2];
160
161
162 # MSWin32 expects at least one of $laddr or $lport to be specified
163 # and does not accept 0 for $lport if $laddr is specified.
164 if ($^O eq 'MSWin32') {
165 if ((!$laddr) && (!$lport)) {
166 $laddr = ($family == AF_INET) ? '0.0.0.0' : '::';
167 $lport = '';
168 } elsif (!$lport) {
169 $lport = '';
170 }
171 }
172
173 my $type = $arg->{Type} || $socket_type{(getprotobynumber($proto))[0]};
174
175 # parse Peer*
176 my($rport,$raddr);
177 unless(exists $arg->{Listen}) {
178 ($raddr,$rport) = _sock_info(
179 $arg->{PeerAddr},
180 $arg->{PeerPort},
181 $proto
182 ) or return _error($sock, $!, "sock_info: $@");
183 }
184
185 # find out all combinations of local and remote addr with
186 # the same family
187 my @lres = getaddrinfo($laddr,$lport,$family,$type,$proto,AI_PASSIVE);
188 return _error($sock, $EINVAL, "getaddrinfo: $lres[0]") if @lres<5;
189 my @rres;
190 if ( defined $raddr ) {
191 @rres = getaddrinfo($raddr,$rport,$family,$type,$proto);
192 return _error($sock, $EINVAL, "getaddrinfo: $rres[0]") if @rres<5;
193 }
194
195 my @flr;
196 if (@rres) {
197 # Collect all combinations with the same family in lres and rres
198 # the order we search should be defined by the order of @rres,
199 # not @lres!
200 for( my $r=0;$r<@rres;$r+=5 ) {
201 for( my $l=0;$l<@lres;$l+=5) {
202 my $fam_listen = $lres[$l];
203 next if $rres[$r] != $fam_listen; # must be same family
204 push @flr,[ $fam_listen,$lres[$l+3],$rres[$r+3] ];
205 }
206 }
207 } else {
208 for( my $l=0;$l<@lres;$l+=5) {
209 my $fam_listen = $lres[$l];
210 my $lsockaddr = $lres[$l+3];
211 # collect only the binding side
212 push @flr,[ $fam_listen,$lsockaddr ];
213 }
214 }
215
216 # try to bind and maybe connect
217 # if multihomed try all combinations until success
218 for my $flr (@flr) {
219 my ($family,$lres,$rres) = @$flr;
220
221 if ( $family == AF_INET6) {
222 if ($arg->{LocalFlow} || $arg->{LocalScope}) {
223 my @sa_in6 = unpack_sockaddr_in6_all($lres);
224 $sa_in6[1] = $arg->{LocalFlow} || 0;
225 $sa_in6[3] = _scope_ntohl($arg->{LocalScope}) || 0;
226 $lres = pack_sockaddr_in6_all(@sa_in6);
227 }
228 }
229
230 $sock->socket($family, $type, $proto) or
231 return _error($sock, $!, "socket: $!");
232
233 if (defined $arg->{Blocking}) {
234 defined $sock->blocking($arg->{Blocking}) or
235 return _error($sock, $!, "sockopt: $!");
236 }
237
238 if ($arg->{Reuse} || $arg->{ReuseAddr}) {
239 $sock->sockopt(SO_REUSEADDR,1) or
240 return _error($sock, $!, "sockopt: $!");
241 }
242
243 if ($arg->{ReusePort}) {
244 $sock->sockopt(SO_REUSEPORT,1) or
245 return _error($sock, $!, "sockopt: $!");
246 }
247
248 if ($arg->{Broadcast}) {
249 $sock->sockopt(SO_BROADCAST,1) or
250 return _error($sock, $!, "sockopt: $!");
251 }
252
253 if ( $family == AF_INET ) {
254 my ($p,$a) = sockaddr_in($lres);
255 $sock->bind($lres) or return _error($sock, $!, "bind: $!")
256 if ($a ne INADDR_ANY or $p!=0);
257 } else {
258 my ($p,$a) = sockaddr_in6($lres);
259 $sock->bind($lres) or return _error($sock, $!, "bind: $!")
260 if ($a ne in6addr_any or $p!=0);
261 }
262
263 if(exists $arg->{Listen}) {
264 $sock->listen($arg->{Listen} || 5) or
265 return _error($sock, $!, "listen: $!");
266 }
267
268 # connect only if PeerAddr and thus $rres is given
269 last if ! $rres;
270
271 if ( $family == AF_INET6) {
272 if ($arg->{PeerFlow} || $arg->{PeerScope}) {
273 my @sa_in6 = unpack_sockaddr_in6_all($rres);
274 $sa_in6[1] = $arg->{PeerFlow} || 0;
275 $sa_in6[3] = _scope_ntohl($arg->{PeerScope}) || 0;
276 $rres = pack_sockaddr_in6_all(@sa_in6);
277 }
278 }
279
280 undef $@;
281 last if $sock->connect($rres);
282
283 return _error($sock, $!, $@ || "Timeout")
284 if ! $arg->{MultiHomed};
285
286 }
287
288 return $sock;
289}
290
291sub _scope_ntohl($)
292{
293 # As of Socket6 0.17 the scope field is incorrectly put into
294 # network byte order when it should be in host byte order
295 # in the sockaddr_in6 structure. We correct for that here.
296
297216µs if ((Socket6->VERSION <= 0.17) && (pack('s', 0x1234) ne pack('n', 0x1234)))
# spent 16µs making 2 calls to main::CORE:pack, avg 8µs/call
298 {
299 unpack('N', pack('V', $_[0]));
300 } else {
301 $_[0];
302 }
303}
304
305sub sockdomain
306{
307 my $sock = shift;
308 $sock->SUPER::sockdomain(@_) || AF_INET6;
309}
310
311sub accept
312{
313 my $sock = shift;
314
315 my ($new, $peer) = $sock->SUPER::accept(@_);
316
317 return unless defined($new);
318
319 ${*$new}{io_socket_domain} = ${*$sock}{io_socket_domain};
320 ${*$new}{io_socket_type} = ${*$sock}{io_socket_type};
321 ${*$new}{io_socket_proto} = ${*$sock}{io_socket_proto};
322
323 return wantarray ? ($new, $peer) : $new;
324}
325
326sub bind {
327 @_ == 2 or
328 croak 'usage: $sock->bind(NAME) ';
329 my $sock = shift;
330 return $sock->SUPER::bind( shift );
331}
332
333sub connect {
334 @_ == 2 or
335 croak 'usage: $sock->connect(NAME) ';
336 my $sock = shift;
337 return $sock->SUPER::connect( shift );
338}
339
340sub sockaddr {
341 @_ == 1 or croak 'usage: $sock->sockaddr()';
342 my ($sock) = @_;
343 return undef unless (my $name = $sock->sockname);
344 ($sock->sockdomain == AF_INET) ? (sockaddr_in($name))[1] : (sockaddr_in6($name))[1];
345}
346
347sub sockport {
348 @_ == 1 or croak 'usage: $sock->sockport()';
349 my($sock) = @_;
350 return undef unless (my $name = $sock->sockname);
351 ($sock->sockdomain == AF_INET) ? (sockaddr_in($name))[0] : (sockaddr_in6($name))[0];
352}
353
354sub sockhost {
355 @_ == 1 or croak 'usage: $sock->sockhost()';
356 my ($sock) = @_;
357 return undef unless (my $addr = $sock->sockaddr);
358 Socket6::inet_ntop($sock->sockdomain, $addr);
359}
360
361sub sockflow
362{
363 @_ == 1 or croak 'usage: $sock->sockflow()';
364 my ($sock) = @_;
365 return undef unless (my $name = $sock->sockname);
366 ($sock->sockdomain == AF_INET6) ? (unpack_sockaddr_in6_all($name))[1] : 0;
367}
368
369sub sockscope
370{
371 @_ == 1 or croak 'usage: $sock->sockscope()';
372 my ($sock) = @_;
373 return undef unless (my $name = $sock->sockname);
374 _scope_ntohl(($sock->sockdomain == AF_INET6) ? (unpack_sockaddr_in6_all($name))[3] : 0);
375}
376
377sub peeraddr {
378 @_ == 1 or croak 'usage: $sock->peeraddr()';
379 my ($sock) = @_;
380 return undef unless (my $name = $sock->peername);
381 ($sock->sockdomain == AF_INET) ? (sockaddr_in($name))[1] : (sockaddr_in6($name))[1];
382}
383
384sub peerport {
385 @_ == 1 or croak 'usage: $sock->peerport()';
386 my($sock) = @_;
387 return undef unless (my $name = $sock->peername);
388 ($sock->sockdomain == AF_INET) ? (sockaddr_in($name))[0] : (sockaddr_in6($name))[0];
389}
390
391sub peerhost {
392 @_ == 1 or croak 'usage: $sock->peerhost()';
393 my ($sock) = @_;
394 return undef unless (my $addr = $sock->peeraddr);
395 Socket6::inet_ntop($sock->sockdomain, $addr);
396}
397
398sub peerflow
399{
400 @_ == 1 or croak 'usage: $sock->peerflow()';
401 my ($sock) = @_;
402 return undef unless (my $name = $sock->peername);
403 _scope_ntohl(($sock->sockdomain == AF_INET6) ? (unpack_sockaddr_in6_all($name))[1] : 0);
404}
405
406sub peerscope
407{
408 @_ == 1 or croak 'usage: $sock->peerscope()';
409 my ($sock) = @_;
410 return undef unless (my $name = $sock->peername);
411 ($sock->sockdomain == AF_INET6) ? (unpack_sockaddr_in6_all($name))[3] : 0;
412}
413
414116µs1;
415
416__END__
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.