Profile of IO/Socket/IP.pm

Filename	/usr/local/lib/perl5/site_perl/IO/Socket/IP.pm
Statements	Executed 424 statements in 14.3ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
4	2	1	1.39ms	1.39ms	IO::Socket::IP::::CORE:gpbyname IO::Socket::IP::CORE:gpbyname (opcode)
5	2	1	1.36ms	1.36ms	IO::Socket::IP::::CORE:regcomp IO::Socket::IP::CORE:regcomp (opcode)
3	1	1	880µs	2.34ms	IO::Socket::IP::_io_socket_ip__configure
3	1	1	418µs	926µs	IO::Socket::IP::::setup IO::Socket::IP::setup
3	1	1	301µs	3.49ms	IO::Socket::IP::::configure IO::Socket::IP::configure
4	1	1	165µs	851µs	IO::Socket::IP::::split_addr IO::Socket::IP::split_addr
3	2	1	107µs	4.47ms	IO::Socket::IP::::new IO::Socket::IP::new
3	1	1	96µs	341µs	IO::Socket::IP::::socket IO::Socket::IP::socket
1	1	1	51µs	51µs	IO::Socket::IP::::BEGIN@957 IO::Socket::IP::BEGIN@957
1	1	1	49µs	1.26ms	IO::Socket::IP::::BEGIN@39 IO::Socket::IP::BEGIN@39
11	2	1	41µs	41µs	IO::Socket::IP::::CORE:match IO::Socket::IP::CORE:match (opcode)
1	1	1	34µs	63µs	IO::Socket::IP::::connect IO::Socket::IP::connect
1	1	1	31µs	31µs	IO::Socket::IP::::import IO::Socket::IP::import
1	1	1	30µs	30µs	IO::Socket::IP::::BEGIN@9 IO::Socket::IP::BEGIN@9
1	1	1	30µs	844µs	IO::Socket::IP::::BEGIN@19 IO::Socket::IP::BEGIN@19
1	1	1	29µs	29µs	IO::Socket::IP::::CORE:connect IO::Socket::IP::CORE:connect (opcode)
1	1	1	27µs	364µs	IO::Socket::IP::::BEGIN@34 IO::Socket::IP::BEGIN@34
1	1	1	26µs	264µs	IO::Socket::IP::_ForINET::::BEGIN@1158 IO::Socket::IP::_ForINET::BEGIN@1158
1	1	1	25µs	39µs	IO::Socket::IP::::BEGIN@13 IO::Socket::IP::BEGIN@13
1	1	1	24µs	195µs	IO::Socket::IP::::BEGIN@33 IO::Socket::IP::BEGIN@33
1	1	1	21µs	245µs	IO::Socket::IP::::BEGIN@36 IO::Socket::IP::BEGIN@36
1	1	1	21µs	268µs	IO::Socket::IP::_ForINET6::::BEGIN@1172IO::Socket::IP::_ForINET6::BEGIN@1172
1	1	1	20µs	250µs	IO::Socket::IP::::BEGIN@17 IO::Socket::IP::BEGIN@17
1	1	1	20µs	337µs	IO::Socket::IP::::BEGIN@15 IO::Socket::IP::BEGIN@15
1	1	1	18µs	42µs	IO::Socket::IP::::BEGIN@14 IO::Socket::IP::BEGIN@14
1	1	1	11µs	11µs	IO::Socket::IP::::CORE:qr IO::Socket::IP::CORE:qr (opcode)
2	2	1	7µs	7µs	IO::Socket::IP::::CORE:subst IO::Socket::IP::CORE:subst (opcode)
0	0	0	0s	0s	IO::Socket::IP::::CAN_DISABLE_V6ONLY IO::Socket::IP::CAN_DISABLE_V6ONLY
0	0	0	0s	0s	IO::Socket::IP::_ForINET6::::configureIO::Socket::IP::_ForINET6::configure
0	0	0	0s	0s	IO::Socket::IP::_ForINET::::configure IO::Socket::IP::_ForINET::configure
0	0	0	0s	0s	IO::Socket::IP::::__ANON__[:966] IO::Socket::IP::__ANON__[:966]
0	0	0	0s	0s	IO::Socket::IP::::_get_host_service IO::Socket::IP::_get_host_service
0	0	0	0s	0s	IO::Socket::IP::::_unpack_sockaddr IO::Socket::IP::_unpack_sockaddr
0	0	0	0s	0s	IO::Socket::IP::::accept IO::Socket::IP::accept
0	0	0	0s	0s	IO::Socket::IP::::as_inet IO::Socket::IP::as_inet
0	0	0	0s	0s	IO::Socket::IP::::connected IO::Socket::IP::connected
0	0	0	0s	0s	IO::Socket::IP::::join_addr IO::Socket::IP::join_addr
0	0	0	0s	0s	IO::Socket::IP::::peeraddr IO::Socket::IP::peeraddr
0	0	0	0s	0s	IO::Socket::IP::::peerhost IO::Socket::IP::peerhost
0	0	0	0s	0s	IO::Socket::IP::::peerhost_service IO::Socket::IP::peerhost_service
0	0	0	0s	0s	IO::Socket::IP::::peerhostname IO::Socket::IP::peerhostname
0	0	0	0s	0s	IO::Socket::IP::::peerport IO::Socket::IP::peerport
0	0	0	0s	0s	IO::Socket::IP::::peerservice IO::Socket::IP::peerservice
0	0	0	0s	0s	IO::Socket::IP::::sockaddr IO::Socket::IP::sockaddr
0	0	0	0s	0s	IO::Socket::IP::::sockhost IO::Socket::IP::sockhost
0	0	0	0s	0s	IO::Socket::IP::::sockhost_service IO::Socket::IP::sockhost_service
0	0	0	0s	0s	IO::Socket::IP::::sockhostname IO::Socket::IP::sockhostname
0	0	0	0s	0s	IO::Socket::IP::::sockport IO::Socket::IP::sockport
0	0	0	0s	0s	IO::Socket::IP::::sockservice IO::Socket::IP::sockservice

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

Line	State ments	Time on line	Calls	Time in subs	Code
1					# You may distribute under the terms of either the GNU General Public License
2					# or the Artistic License (the same terms as Perl itself)
3					#
4					# (C) Paul Evans, 2010-2015 -- leonerd@leonerd.org.uk
5
6					package IO::Socket::IP;
7					# $VERSION needs to be set before use base 'IO::Socket'
8					# - https://rt.cpan.org/Ticket/Display.html?id=92107
9					# spent 30µs within IO::Socket::IP::BEGIN@9 which was called: # once (30µs+0s) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 11 BEGIN {
10	1	11µs			$VERSION = '0.39';
11	1	42µs	1	30µs	} # spent 30µs making 1 call to IO::Socket::IP::BEGIN@9
12
13	2	70µs	2	53µs	# spent 39µs (25+14) within IO::Socket::IP::BEGIN@13 which was called: # once (25µs+14µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 13 use strict; # spent 39µs making 1 call to IO::Socket::IP::BEGIN@13 # spent 14µs making 1 call to strict::import
14	2	61µs	2	65µs	# spent 42µs (18+23) within IO::Socket::IP::BEGIN@14 which was called: # once (18µs+23µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 14 use warnings; # spent 42µs making 1 call to IO::Socket::IP::BEGIN@14 # spent 23µs making 1 call to warnings::import
15	2	74µs	2	337µs	# spent 337µs (20+318) within IO::Socket::IP::BEGIN@15 which was called: # once (20µs+318µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 15 use base qw( IO::Socket ); # spent 337µs making 1 call to IO::Socket::IP::BEGIN@15 # spent 318µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 318µs
16
17	2	121µs	2	480µs	# spent 250µs (20+230) within IO::Socket::IP::BEGIN@17 which was called: # once (20µs+230µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 17 use Carp; # spent 250µs making 1 call to IO::Socket::IP::BEGIN@17 # spent 230µs making 1 call to Exporter::import
18
19	1	2µs			# spent 844µs (30+814) within IO::Socket::IP::BEGIN@19 which was called: # once (30µs+814µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 30 use Socket 1.97 qw(
20					getaddrinfo getnameinfo
21					sockaddr_family
22					AF_INET
23					AI_PASSIVE
24					IPPROTO_TCP IPPROTO_UDP
25					IPPROTO_IPV6 IPV6_V6ONLY
26					NI_DGRAM NI_NUMERICHOST NI_NUMERICSERV NIx_NOHOST NIx_NOSERV
27					SO_REUSEADDR SO_REUSEPORT SO_BROADCAST SO_ERROR
28					SOCK_DGRAM SOCK_STREAM
29					SOL_SOCKET
30	2	172µs	3	1.66ms	); # spent 844µs making 1 call to IO::Socket::IP::BEGIN@19 # spent 780µs making 1 call to Exporter::import # spent 34µs making 1 call to version::_VERSION
31	2	6µs			my $AF_INET6 = eval { Socket::AF_INET6() }; # may not be defined
32	2	4µs			my $AI_ADDRCONFIG = eval { Socket::AI_ADDRCONFIG() } \|\| 0;
33	2	80µs	2	366µs	# spent 195µs (24+171) within IO::Socket::IP::BEGIN@33 which was called: # once (24µs+171µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 33 use POSIX qw( dup2 ); # spent 195µs making 1 call to IO::Socket::IP::BEGIN@33 # spent 171µs making 1 call to POSIX::import
34	2	71µs	2	701µs	# spent 364µs (27+337) within IO::Socket::IP::BEGIN@34 which was called: # once (27µs+337µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 34 use Errno qw( EINVAL EINPROGRESS EISCONN ENOTCONN ETIMEDOUT EWOULDBLOCK EOPNOTSUPP ); # spent 364µs making 1 call to IO::Socket::IP::BEGIN@34 # spent 337µs making 1 call to Exporter::import
35
36	2	85µs	2	469µs	# spent 245µs (21+224) within IO::Socket::IP::BEGIN@36 which was called: # once (21µs+224µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 36 use constant HAVE_MSWIN32 => ( $^O eq "MSWin32" ); # spent 245µs making 1 call to IO::Socket::IP::BEGIN@36 # spent 224µs making 1 call to constant::import
37
38					# At least one OS (Android) is known not to have getprotobyname()
39	3	8.01ms	3	2.47ms	# spent 1.26ms (49µs+1.21) within IO::Socket::IP::BEGIN@39 which was called: # once (49µs+1.21ms) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 39 use constant HAVE_GETPROTOBYNAME => defined eval { getprotobyname( "tcp" ) }; # spent 1.26ms making 1 call to IO::Socket::IP::BEGIN@39 # spent 999µs making 1 call to IO::Socket::IP::CORE:gpbyname # spent 210µs making 1 call to constant::import
40
41	1	19µs			my $IPv6_re = do {
42					# translation of RFC 3986 3.2.2 ABNF to re
43	1	3µs			my $IPv4address = do {
44	1	2µs			my $dec_octet = q<(?:[0-9]\|[1-9][0-9]\|1[0-9][0-9]\|2[0-4][0-9]\|25[0-5])>;
45	1	3µs			qq<$dec_octet(?: \\. $dec_octet){3}>;
46					};
47	1	3µs			my $IPv6address = do {
48	1	2µs			my $h16 = qq<[0-9A-Fa-f]{1,4}>;
49	1	4µs			my $ls32 = qq<(?: $h16 : $h16 \| $IPv4address)>;
50	1	26µs			qq<(?:
51					(?: $h16 : ){6} $ls32
52					\| :: (?: $h16 : ){5} $ls32
53					\| (?: $h16 )? :: (?: $h16 : ){4} $ls32
54					\| (?: (?: $h16 : ){0,1} $h16 )? :: (?: $h16 : ){3} $ls32
55					\| (?: (?: $h16 : ){0,2} $h16 )? :: (?: $h16 : ){2} $ls32
56					\| (?: (?: $h16 : ){0,3} $h16 )? :: $h16 : $ls32
57					\| (?: (?: $h16 : ){0,4} $h16 )? :: $ls32
58					\| (?: (?: $h16 : ){0,5} $h16 )? :: $h16
59					\| (?: (?: $h16 : ){0,6} $h16 )? ::
60					)>
61					};
62	1	753µs	2	710µs	qr<$IPv6address>xo; # spent 700µs making 1 call to IO::Socket::IP::CORE:regcomp # spent 11µs making 1 call to IO::Socket::IP::CORE:qr
63					};
64
65					=head1 NAME
66
67					C<IO::Socket::IP> - Family-neutral IP socket supporting both IPv4 and IPv6
68
69					=head1 SYNOPSIS
70
71					use IO::Socket::IP;
72
73					my $sock = IO::Socket::IP->new(
74					PeerHost => "www.google.com",
75					PeerPort => "http",
76					Type => SOCK_STREAM,
77					) or die "Cannot construct socket - $@";
78
79					my $familyname = ( $sock->sockdomain == PF_INET6 ) ? "IPv6" :
80					( $sock->sockdomain == PF_INET ) ? "IPv4" :
81					"unknown";
82
83					printf "Connected to google via %s\n", $familyname;
84
85					=head1 DESCRIPTION
86
87					This module provides a protocol-independent way to use IPv4 and IPv6 sockets,
88					intended as a replacement for L<IO::Socket::INET>. Most constructor arguments
89					and methods are provided in a backward-compatible way. For a list of known
90					differences, see the C<IO::Socket::INET> INCOMPATIBILITES section below.
91
92					It uses the C<getaddrinfo(3)> function to convert hostnames and service names
93					or port numbers into sets of possible addresses to connect to or listen on.
94					This allows it to work for IPv6 where the system supports it, while still
95					falling back to IPv4-only on systems which don't.
96
97					=head1 REPLACING C<IO::Socket> DEFAULT BEHAVIOUR
98
99					By placing C<-register> in the import list, L<IO::Socket> uses
100					C<IO::Socket::IP> rather than C<IO::Socket::INET> as the class that handles
101					C<PF_INET>. C<IO::Socket> will also use C<IO::Socket::IP> rather than
102					C<IO::Socket::INET6> to handle C<PF_INET6>, provided that the C<AF_INET6>
103					constant is available.
104
105					Changing C<IO::Socket>'s default behaviour means that calling the
106					C<IO::Socket> constructor with either C<PF_INET> or C<PF_INET6> as the
107					C<Domain> parameter will yield an C<IO::Socket::IP> object.
108
109					use IO::Socket::IP -register;
110
111					my $sock = IO::Socket->new(
112					Domain => PF_INET6,
113					LocalHost => "::1",
114					Listen => 1,
115					) or die "Cannot create socket - $@\n";
116
117					print "Created a socket of type " . ref($sock) . "\n";
118
119					Note that C<-register> is a global setting that applies to the entire program;
120					it cannot be applied only for certain callers, removed, or limited by lexical
121					scope.
122
123					=cut
124
125					sub import
126					# spent 31µs within IO::Socket::IP::import which was called: # once (31µs+0s) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 1 of (eval 16)[Net/DNS/Resolver/Base.pm:29] {
127	1	2µs			my $pkg = shift;
128	1	2µs			my @symbols;
129
130	1	13µs			foreach ( @_ ) {
131					if( $_ eq "-register" ) {
132					IO::Socket::IP::_ForINET->register_domain( AF_INET );
133					IO::Socket::IP::_ForINET6->register_domain( $AF_INET6 ) if defined $AF_INET6;
134					}
135					else {
136					push @symbols, $_;
137					}
138					}
139
140	1	6µs			@_ = ( $pkg, @symbols );
141	1	16µs	1	6.80ms	goto &IO::Socket::import; # spent 6.80ms making 1 call to IO::Socket::import
142					}
143
144					# Convenient capability test function
145					{
146	1	2µs			my $can_disable_v6only;
147					sub CAN_DISABLE_V6ONLY
148					{
149					return $can_disable_v6only if defined $can_disable_v6only;
150
151					socket my $testsock, Socket::PF_INET6(), SOCK_STREAM, 0 or
152					die "Cannot socket(PF_INET6) - $!";
153
154					if( setsockopt $testsock, IPPROTO_IPV6, IPV6_V6ONLY, 0 ) {
155					return $can_disable_v6only = 1;
156					}
157					elsif( $! == EINVAL \|\| $! == EOPNOTSUPP ) {
158					return $can_disable_v6only = 0;
159					}
160					else {
161					die "Cannot setsockopt() - $!";
162					}
163					}
164					}
165
166					=head1 CONSTRUCTORS
167
168					=cut
169
170					=head2 $sock = IO::Socket::IP->new( %args )
171
172					Creates a new C<IO::Socket::IP> object, containing a newly created socket
173					handle according to the named arguments passed. The recognised arguments are:
174
175					=over 8
176
177					=item PeerHost => STRING
178
179					=item PeerService => STRING
180
181					Hostname and service name for the peer to C<connect()> to. The service name
182					may be given as a port number, as a decimal string.
183
184					=item PeerAddr => STRING
185
186					=item PeerPort => STRING
187
188					For symmetry with the accessor methods and compatibility with
189					C<IO::Socket::INET>, these are accepted as synonyms for C<PeerHost> and
190					C<PeerService> respectively.
191
192					=item PeerAddrInfo => ARRAY
193
194					Alternate form of specifying the peer to C<connect()> to. This should be an
195					array of the form returned by C<Socket::getaddrinfo>.
196
197					This parameter takes precedence over the C<Peer*>, C<Family>, C<Type> and
198					C<Proto> arguments.
199
200					=item LocalHost => STRING
201
202					=item LocalService => STRING
203
204					Hostname and service name for the local address to C<bind()> to.
205
206					=item LocalAddr => STRING
207
208					=item LocalPort => STRING
209
210					For symmetry with the accessor methods and compatibility with
211					C<IO::Socket::INET>, these are accepted as synonyms for C<LocalHost> and
212					C<LocalService> respectively.
213
214					=item LocalAddrInfo => ARRAY
215
216					Alternate form of specifying the local address to C<bind()> to. This should be
217					an array of the form returned by C<Socket::getaddrinfo>.
218
219					This parameter takes precedence over the C<Local*>, C<Family>, C<Type> and
220					C<Proto> arguments.
221
222					=item Family => INT
223
224					The address family to pass to C<getaddrinfo> (e.g. C<AF_INET>, C<AF_INET6>).
225					Normally this will be left undefined, and C<getaddrinfo> will search using any
226					address family supported by the system.
227
228					=item Type => INT
229
230					The socket type to pass to C<getaddrinfo> (e.g. C<SOCK_STREAM>,
231					C<SOCK_DGRAM>). Normally defined by the caller; if left undefined
232					C<getaddrinfo> may attempt to infer the type from the service name.
233
234					=item Proto => STRING or INT
235
236					The IP protocol to use for the socket (e.g. C<'tcp'>, C<IPPROTO_TCP>,
237					C<'udp'>,C<IPPROTO_UDP>). Normally this will be left undefined, and either
238					C<getaddrinfo> or the kernel will choose an appropriate value. May be given
239					either in string name or numeric form.
240
241					=item GetAddrInfoFlags => INT
242
243					More flags to pass to the C<getaddrinfo()> function. If not supplied, a
244					default of C<AI_ADDRCONFIG> will be used.
245
246					These flags will be combined with C<AI_PASSIVE> if the C<Listen> argument is
247					given. For more information see the documentation about C<getaddrinfo()> in
248					the L<Socket> module.
249
250					=item Listen => INT
251
252					If defined, puts the socket into listening mode where new connections can be
253					accepted using the C<accept> method. The value given is used as the
254					C<listen(2)> queue size.
255
256					=item ReuseAddr => BOOL
257
258					If true, set the C<SO_REUSEADDR> sockopt
259
260					=item ReusePort => BOOL
261
262					If true, set the C<SO_REUSEPORT> sockopt (not all OSes implement this sockopt)
263
264					=item Broadcast => BOOL
265
266					If true, set the C<SO_BROADCAST> sockopt
267
268					=item Sockopts => ARRAY
269
270					An optional array of other socket options to apply after the three listed
271					above. The value is an ARRAY containing 2- or 3-element ARRAYrefs. Each inner
272					array relates to a single option, giving the level and option name, and an
273					optional value. If the value element is missing, it will be given the value of
274					a platform-sized integer 1 constant (i.e. suitable to enable most of the
275					common boolean options).
276
277					For example, both options given below are equivalent to setting C<ReuseAddr>.
278
279					Sockopts => [
280					[ SOL_SOCKET, SO_REUSEADDR ],
281					[ SOL_SOCKET, SO_REUSEADDR, pack( "i", 1 ) ],
282					]
283
284					=item V6Only => BOOL
285
286					If defined, set the C<IPV6_V6ONLY> sockopt when creating C<PF_INET6> sockets
287					to the given value. If true, a listening-mode socket will only listen on the
288					C<AF_INET6> addresses; if false it will also accept connections from
289					C<AF_INET> addresses.
290
291					If not defined, the socket option will not be changed, and default value set
292					by the operating system will apply. For repeatable behaviour across platforms
293					it is recommended this value always be defined for listening-mode sockets.
294
295					Note that not all platforms support disabling this option. Some, at least
296					OpenBSD and MirBSD, will fail with C<EINVAL> if you attempt to disable it.
297					To determine whether it is possible to disable, you may use the class method
298
299					if( IO::Socket::IP->CAN_DISABLE_V6ONLY ) {
300					...
301					}
302					else {
303					...
304					}
305
306					If your platform does not support disabling this option but you still want to
307					listen for both C<AF_INET> and C<AF_INET6> connections you will have to create
308					two listening sockets, one bound to each protocol.
309
310					=item MultiHomed
311
312					This C<IO::Socket::INET>-style argument is ignored, except if it is defined
313					but false. See the C<IO::Socket::INET> INCOMPATIBILITES section below.
314
315					However, the behaviour it enables is always performed by C<IO::Socket::IP>.
316
317					=item Blocking => BOOL
318
319					If defined but false, the socket will be set to non-blocking mode. Otherwise
320					it will default to blocking mode. See the NON-BLOCKING section below for more
321					detail.
322
323					=item Timeout => NUM
324
325					If defined, gives a maximum time in seconds to block per C<connect()> call
326					when in blocking mode. If missing, no timeout is applied other than that
327					provided by the underlying operating system. When in non-blocking mode this
328					parameter is ignored.
329
330					Note that if the hostname resolves to multiple address candidates, the same
331					timeout will apply to each connection attempt individually, rather than to the
332					operation as a whole. Further note that the timeout does not apply to the
333					initial hostname resolve operation, if connecting by hostname.
334
335					This behviour is copied inspired by C<IO::Socket::INET>; for more fine grained
336					control over connection timeouts, consider performing a nonblocking connect
337					directly.
338
339					=back
340
341					If neither C<Type> nor C<Proto> hints are provided, a default of
342					C<SOCK_STREAM> and C<IPPROTO_TCP> respectively will be set, to maintain
343					compatibility with C<IO::Socket::INET>. Other named arguments that are not
344					recognised are ignored.
345
346					If neither C<Family> nor any hosts or addresses are passed, nor any
347					C<*AddrInfo>, then the constructor has no information on which to decide a
348					socket family to create. In this case, it performs a C<getaddinfo> call with
349					the C<AI_ADDRCONFIG> flag, no host name, and a service name of C<"0">, and
350					uses the family of the first returned result.
351
352					If the constructor fails, it will set C<$@> to an appropriate error message;
353					this may be from C<$!> or it may be some other string; not every failure
354					necessarily has an associated C<errno> value.
355
356					=head2 $sock = IO::Socket::IP->new( $peeraddr )
357
358					As a special case, if the constructor is passed a single argument (as
359					opposed to an even-sized list of key/value pairs), it is taken to be the value
360					of the C<PeerAddr> parameter. This is parsed in the same way, according to the
361					behaviour given in the C<PeerHost> AND C<LocalHost> PARSING section below.
362
363					=cut
364
365					sub new
366	1	3µs			# spent 4.47ms (107µs+4.36) within IO::Socket::IP::new which was called 3 times, avg 1.49ms/call: # 2 times (74µs+2.93ms) by Mail::SpamAssassin::DnsResolver::load_resolver at line 113 of Mail/SpamAssassin/DnsResolver.pm, avg 1.50ms/call # once (33µs+1.43ms) by Mail::SpamAssassin::DnsResolver::connect_sock at line 420 of Mail/SpamAssassin/DnsResolver.pm {
367	3	12µs			my $class = shift;
368	3	25µs			my %arg = (@_ == 1) ? (PeerHost => $_[0]) : @_;
369	3	73µs	3	4.36ms	return $class->SUPER::new(%arg); # spent 4.36ms making 3 calls to IO::Socket::new, avg 1.45ms/call
370					}
371
372					# IO::Socket may call this one; neaten up the arguments from IO::Socket::INET
373					# before calling our real _configure method
374					sub configure
375					# spent 3.49ms (301µs+3.19) within IO::Socket::IP::configure which was called 3 times, avg 1.16ms/call: # 3 times (301µs+3.19ms) by IO::Socket::new at line 49 of IO/Socket.pm, avg 1.16ms/call {
376	3	7µs			my $self = shift;
377	3	7µs			my ( $arg ) = @_;
378
379					$arg->{PeerHost} = delete $arg->{PeerAddr}
380	3	13µs			if exists $arg->{PeerAddr} && !exists $arg->{PeerHost};
381
382					$arg->{PeerService} = delete $arg->{PeerPort}
383	3	10µs			if exists $arg->{PeerPort} && !exists $arg->{PeerService};
384
385					$arg->{LocalHost} = delete $arg->{LocalAddr}
386	3	16µs			if exists $arg->{LocalAddr} && !exists $arg->{LocalHost};
387
388					$arg->{LocalService} = delete $arg->{LocalPort}
389	3	9µs			if exists $arg->{LocalPort} && !exists $arg->{LocalService};
390
391	3	15µs			for my $type (qw(Peer Local)) {
392	6	24µs			my $host = $type . 'Host';
393	6	15µs			my $service = $type . 'Service';
394
395	6	71µs			if( defined $arg->{$host} ) {
396	4	46µs	4	851µs	( $arg->{$host}, my $s ) = $self->split_addr( $arg->{$host} ); # spent 851µs making 4 calls to IO::Socket::IP::split_addr, avg 213µs/call
397					# IO::Socket::INET compat - *Host parsed port always takes precedence
398	4	10µs			$arg->{$service} = $s if defined $s;
399					}
400					}
401
402	3	48µs	3	2.34ms	$self->_io_socket_ip__configure( $arg ); # spent 2.34ms making 3 calls to IO::Socket::IP::_io_socket_ip__configure, avg 780µs/call
403					}
404
405					# Avoid simply calling it _configure, as some subclasses of IO::Socket::INET on CPAN already take that
406					sub _io_socket_ip__configure
407					# spent 2.34ms (880µs+1.46) within IO::Socket::IP::_io_socket_ip__configure which was called 3 times, avg 780µs/call: # 3 times (880µs+1.46ms) by IO::Socket::IP::configure at line 402, avg 780µs/call {
408	3	7µs			my $self = shift;
409	3	6µs			my ( $arg ) = @_;
410
411	3	7µs			my %hints;
412					my @localinfos;
413					my @peerinfos;
414
415	3	10µs			my $listenqueue = $arg->{Listen};
416	3	6µs			if( defined $listenqueue and
417					( defined $arg->{PeerHost} \|\| defined $arg->{PeerService} \|\| defined $arg->{PeerAddrInfo} ) ) {
418					croak "Cannot Listen with a peer address";
419					}
420
421	3	14µs			if( defined $arg->{GetAddrInfoFlags} ) {
422					$hints{flags} = $arg->{GetAddrInfoFlags};
423					}
424					else {
425	3	12µs			$hints{flags} = $AI_ADDRCONFIG;
426					}
427
428	3	8µs			if( defined( my $family = $arg->{Family} ) ) {
429					$hints{family} = $family;
430					}
431
432	3	10µs			if( defined( my $type = $arg->{Type} ) ) {
433	1	3µs			$hints{socktype} = $type;
434					}
435
436	3	14µs			if( defined( my $proto = $arg->{Proto} ) ) {
437	3	37µs	3	12µs	unless( $proto =~ m/^\d+$/ ) { # spent 12µs making 3 calls to IO::Socket::IP::CORE:match, avg 4µs/call
438					my $protonum = HAVE_GETPROTOBYNAME
439					? getprotobyname( $proto )
440	3	425µs	3	393µs	: eval { Socket->${\"IPPROTO_\U$proto"}() }; # spent 393µs making 3 calls to IO::Socket::IP::CORE:gpbyname, avg 131µs/call
441	3	7µs			defined $protonum or croak "Unrecognised protocol $proto";
442	3	8µs			$proto = $protonum;
443					}
444
445	3	12µs			$hints{protocol} = $proto;
446					}
447
448					# To maintain compatibility with IO::Socket::INET, imply a default of
449					# SOCK_STREAM + IPPROTO_TCP if neither hint is given
450	3	10µs			if( !defined $hints{socktype} and !defined $hints{protocol} ) {
451					$hints{socktype} = SOCK_STREAM;
452					$hints{protocol} = IPPROTO_TCP;
453					}
454
455					# Some OSes (NetBSD) don't seem to like just a protocol hint without a
456					# socktype hint as well. We'll set a couple of common ones
457	3	12µs			if( !defined $hints{socktype} and defined $hints{protocol} ) {
458	2	6µs			$hints{socktype} = SOCK_STREAM if $hints{protocol} == IPPROTO_TCP;
459	2	7µs			$hints{socktype} = SOCK_DGRAM if $hints{protocol} == IPPROTO_UDP;
460					}
461
462	3	16µs			if( my $info = $arg->{LocalAddrInfo} ) {
463					ref $info eq "ARRAY" or croak "Expected 'LocalAddrInfo' to be an ARRAY ref";
464					@localinfos = @$info;
465					}
466					elsif( defined $arg->{LocalHost} or
467					defined $arg->{LocalService} or
468					HAVE_MSWIN32 and $arg->{Listen} ) {
469					# Either may be undef
470	3	9µs			my $host = $arg->{LocalHost};
471	3	8µs			my $service = $arg->{LocalService};
472
473	3	6µs			unless ( defined $host or defined $service ) {
474					$service = 0;
475					}
476
477	3	10µs			local $1; # Placate a taint-related bug; [perl #67962]
478	3	23µs	1	4µs	defined $service and $service =~ s/$(\d+)$$// and # spent 4µs making 1 call to IO::Socket::IP::CORE:subst
479					my $fallback_port = $1;
480
481	3	20µs			my %localhints = %hints;
482	3	9µs			$localhints{flags} \|= AI_PASSIVE;
483	3	154µs	3	114µs	( my $err, @localinfos ) = getaddrinfo( $host, $service, \%localhints ); # spent 114µs making 3 calls to Socket::getaddrinfo, avg 38µs/call
484
485	3	6µs			if( $err and defined $fallback_port ) {
486					( $err, @localinfos ) = getaddrinfo( $host, $fallback_port, \%localhints );
487					}
488
489	3	16µs			if( $err ) {
490					$@ = "$err";
491					$! = EINVAL;
492					return;
493					}
494					}
495
496	3	15µs			if( my $info = $arg->{PeerAddrInfo} ) {
497					ref $info eq "ARRAY" or croak "Expected 'PeerAddrInfo' to be an ARRAY ref";
498					@peerinfos = @$info;
499					}
500					elsif( defined $arg->{PeerHost} or defined $arg->{PeerService} ) {
501	1	3µs			defined( my $host = $arg->{PeerHost} ) or
502					croak "Expected 'PeerHost'";
503	1	4µs			defined( my $service = $arg->{PeerService} ) or
504					croak "Expected 'PeerService'";
505
506	1	3µs			local $1; # Placate a taint-related bug; [perl #67962]
507	1	12µs	1	2µs	defined $service and $service =~ s/$(\d+)$$// and # spent 2µs making 1 call to IO::Socket::IP::CORE:subst
508					my $fallback_port = $1;
509
510	1	22µs	1	10µs	( my $err, @peerinfos ) = getaddrinfo( $host, $service, \%hints ); # spent 10µs making 1 call to Socket::getaddrinfo
511
512	1	2µs			if( $err and defined $fallback_port ) {
513					( $err, @peerinfos ) = getaddrinfo( $host, $fallback_port, \%hints );
514					}
515
516	1	3µs			if( $err ) {
517					$@ = "$err";
518					$! = EINVAL;
519					return;
520					}
521					}
522
523	3	9µs	1	8µs	my $INT_1 = pack "i", 1; # spent 8µs making 1 call to main::CORE:pack
524
525	3	6µs			my @sockopts_enabled;
526	3	8µs			push @sockopts_enabled, [ SOL_SOCKET, SO_REUSEADDR, $INT_1 ] if $arg->{ReuseAddr};
527	3	7µs			push @sockopts_enabled, [ SOL_SOCKET, SO_REUSEPORT, $INT_1 ] if $arg->{ReusePort};
528	3	7µs			push @sockopts_enabled, [ SOL_SOCKET, SO_BROADCAST, $INT_1 ] if $arg->{Broadcast};
529
530	3	8µs			if( my $sockopts = $arg->{Sockopts} ) {
531					ref $sockopts eq "ARRAY" or croak "Expected 'Sockopts' to be an ARRAY ref";
532					foreach ( @$sockopts ) {
533					ref $_ eq "ARRAY" or croak "Bad Sockopts item - expected ARRAYref";
534					@$_ >= 2 and @$_ <= 3 or
535					croak "Bad Sockopts item - expected 2 or 3 elements";
536
537					my ( $level, $optname, $value ) = @$_;
538					# TODO: consider more sanity checking on argument values
539
540					defined $value or $value = $INT_1;
541					push @sockopts_enabled, [ $level, $optname, $value ];
542					}
543					}
544
545	3	8µs			my $blocking = $arg->{Blocking};
546	3	9µs			defined $blocking or $blocking = 1;
547
548	3	8µs			my $v6only = $arg->{V6Only};
549
550					# IO::Socket::INET defines this key. IO::Socket::IP always implements the
551					# behaviour it requests, so we can ignore it, unless the caller is for some
552					# reason asking to disable it.
553	3	8µs			if( defined $arg->{MultiHomed} and !$arg->{MultiHomed} ) {
554					croak "Cannot disable the MultiHomed parameter";
555					}
556
557	3	6µs			my @infos;
558	3	16µs			foreach my $local ( @localinfos ? @localinfos : {} ) {
559	3	23µs			foreach my $peer ( @peerinfos ? @peerinfos : {} ) {
560					next if defined $local->{family} and defined $peer->{family} and
561	3	12µs			$local->{family} != $peer->{family};
562					next if defined $local->{socktype} and defined $peer->{socktype} and
563	3	10µs			$local->{socktype} != $peer->{socktype};
564					next if defined $local->{protocol} and defined $peer->{protocol} and
565	3	11µs			$local->{protocol} != $peer->{protocol};
566
567	3	9µs			my $family = $local->{family} \|\| $peer->{family} or next;
568	3	8µs			my $socktype = $local->{socktype} \|\| $peer->{socktype} or next;
569	3	8µs			my $protocol = $local->{protocol} \|\| $peer->{protocol} \|\| 0;
570
571					push @infos, {
572					family => $family,
573					socktype => $socktype,
574					protocol => $protocol,
575					localaddr => $local->{addr},
576					peeraddr => $peer->{addr},
577	3	36µs			};
578					}
579					}
580
581	3	7µs			if( !@infos ) {
582					# If there was a Family hint then create a plain unbound, unconnected socket
583					if( defined $hints{family} ) {
584					@infos = ( {
585					family => $hints{family},
586					socktype => $hints{socktype},
587					protocol => $hints{protocol},
588					} );
589					}
590					# If there wasn't, use getaddrinfo()'s AI_ADDRCONFIG side-effect to guess a
591					# suitable family first.
592					else {
593					( my $err, @infos ) = getaddrinfo( "", "0", \%hints );
594					if( $err ) {
595					$@ = "$err";
596					$! = EINVAL;
597					return;
598					}
599
600					# We'll take all the @infos anyway, because some OSes (HPUX) are known to
601					# ignore the AI_ADDRCONFIG hint and return AF_INET6 even if they don't
602					# support them
603					}
604					}
605
606					# In the nonblocking case, caller will be calling ->setup multiple times.
607					# Store configuration in the object for the ->setup method
608					# Yes, these are messy. Sorry, I can't help that...
609
610	6	29µs			${*$self}{io_socket_ip_infos} = \@infos;
611
612	6	22µs			${*$self}{io_socket_ip_idx} = -1;
613
614	6	20µs			${*$self}{io_socket_ip_sockopts} = \@sockopts_enabled;
615	6	22µs			${*$self}{io_socket_ip_v6only} = $v6only;
616	6	20µs			${*$self}{io_socket_ip_listenqueue} = $listenqueue;
617	6	19µs			${*$self}{io_socket_ip_blocking} = $blocking;
618
619	6	28µs			${*$self}{io_socket_ip_errors} = [ undef, undef, undef ];
620
621					# ->setup is allowed to return false in nonblocking mode
622	3	56µs	3	926µs	$self->setup or !$blocking or return undef; # spent 926µs making 3 calls to IO::Socket::IP::setup, avg 309µs/call
623
624	1	14µs			return $self;
625					}
626
627					sub setup
628					# spent 926µs (418+508) within IO::Socket::IP::setup which was called 3 times, avg 309µs/call: # 3 times (418µs+508µs) by IO::Socket::IP::_io_socket_ip__configure at line 622, avg 309µs/call {
629	3	7µs			my $self = shift;
630
631	3	9µs			while(1) {
632	10	34µs			${*$self}{io_socket_ip_idx}++;
633	20	96µs			last if ${$self}{io_socket_ip_idx} >= @{ ${$self}{io_socket_ip_infos} };
634
635	9	38µs			my $info = ${$self}{io_socket_ip_infos}->[${$self}{io_socket_ip_idx}];
636
637	3	6µs			$self->socket( @{$info}{qw( family socktype protocol )} ) or
638	5	76µs	3	341µs	( ${*$self}{io_socket_ip_errors}[2] = $!, next ); # spent 341µs making 3 calls to IO::Socket::IP::socket, avg 114µs/call
639
640	2	8µs			$self->blocking( 0 ) unless ${*$self}{io_socket_ip_blocking};
641
642	3	14µs			foreach my $sockopt ( @{ ${*$self}{io_socket_ip_sockopts} } ) {
643					my ( $level, $optname, $value ) = @$sockopt;
644					$self->setsockopt( $level, $optname, $value ) or ( $@ = "$!", return undef );
645					}
646
647	2	8µs			if( defined ${*$self}{io_socket_ip_v6only} and defined $AF_INET6 and $info->{family} == $AF_INET6 ) {
648					my $v6only = ${*$self}{io_socket_ip_v6only};
649					$self->setsockopt( IPPROTO_IPV6, IPV6_V6ONLY, pack "i", $v6only ) or ( $@ = "$!", return undef );
650					}
651
652	1	5µs			if( defined( my $addr = $info->{localaddr} ) ) {
653					$self->bind( $addr ) or
654	1	19µs	1	104µs	( ${*$self}{io_socket_ip_errors}[1] = $!, next ); # spent 104µs making 1 call to IO::Socket::bind
655					}
656
657	2	9µs			if( defined( my $listenqueue = ${*$self}{io_socket_ip_listenqueue} ) ) {
658					$self->listen( $listenqueue ) or ( $@ = "$!", return undef );
659					}
660
661	1	3µs			if( defined( my $addr = $info->{peeraddr} ) ) {
662	1	10µs	1	63µs	if( $self->connect( $addr ) ) { # spent 63µs making 1 call to IO::Socket::IP::connect
663	1	4µs			$! = 0;
664	1	9µs			return 1;
665					}
666
667					if( $! == EINPROGRESS or $! == EWOULDBLOCK ) {
668					${*$self}{io_socket_ip_connect_in_progress} = 1;
669					return 0;
670					}
671
672					# If connect failed but we have no system error there must be an error
673					# at the application layer, like a bad certificate with
674					# IO::Socket::SSL.
675					# In this case don't continue IP based multi-homing because the problem
676					# cannot be solved at the IP layer.
677					return 0 if ! $!;
678
679					${*$self}{io_socket_ip_errors}[0] = $!;
680					next;
681					}
682
683					return 1;
684					}
685
686					# Pick the most appropriate error, stringified
687	6	34µs			$! = ( grep defined, @{ ${*$self}{io_socket_ip_errors}} )[0];
688	2	10µs			$@ = "$!";
689	2	18µs			return undef;
690					}
691
692					# spent 63µs (34+29) within IO::Socket::IP::connect which was called: # once (34µs+29µs) by IO::Socket::IP::setup at line 662 sub connect :method
693					{
694	1	2µs			my $self = shift;
695
696					# It seems that IO::Socket hides EINPROGRESS errors, making them look like
697					# a success. This is annoying here.
698					# Instead of putting up with its frankly-irritating intentional breakage of
699					# useful APIs I'm just going to end-run around it and call core's connect()
700					# directly
701
702	1	3µs			if( @_ ) {
703	1	2µs			my ( $addr ) = @_;
704
705					# Annoyingly IO::Socket's connect() is where the timeout logic is
706					# implemented, so we'll have to reinvent it here
707	2	8µs			my $timeout = ${*$self}{'io_socket_timeout'};
708
709	1	51µs	1	29µs	return connect( $self, $addr ) unless defined $timeout; # spent 29µs making 1 call to IO::Socket::IP::CORE:connect
710
711					my $was_blocking = $self->blocking( 0 );
712
713					my $err = defined connect( $self, $addr ) ? 0 : $!+0;
714
715					if( !$err ) {
716					# All happy
717					$self->blocking( $was_blocking );
718					return 1;
719					}
720					elsif( not( $err == EINPROGRESS or $err == EWOULDBLOCK ) ) {
721					# Failed for some other reason
722					$self->blocking( $was_blocking );
723					return undef;
724					}
725					elsif( !$was_blocking ) {
726					# We shouldn't block anyway
727					return undef;
728					}
729
730					my $vec = ''; vec( $vec, $self->fileno, 1 ) = 1;
731					if( !select( undef, $vec, $vec, $timeout ) ) {
732					$self->blocking( $was_blocking );
733					$! = ETIMEDOUT;
734					return undef;
735					}
736
737					# Hoist the error by connect()ing a second time
738					$err = $self->getsockopt( SOL_SOCKET, SO_ERROR );
739					$err = 0 if $err == EISCONN; # Some OSes give EISCONN
740
741					$self->blocking( $was_blocking );
742
743					$! = $err, return undef if $err;
744					return 1;
745					}
746
747					return 1 if !${*$self}{io_socket_ip_connect_in_progress};
748
749					# See if a connect attempt has just failed with an error
750					if( my $errno = $self->getsockopt( SOL_SOCKET, SO_ERROR ) ) {
751					delete ${*$self}{io_socket_ip_connect_in_progress};
752					${*$self}{io_socket_ip_errors}[0] = $! = $errno;
753					return $self->setup;
754					}
755
756					# No error, so either connect is still in progress, or has completed
757					# successfully. We can tell by trying to connect() again; either it will
758					# succeed or we'll get EISCONN (connected successfully), or EALREADY
759					# (still in progress). This even works on MSWin32.
760					my $addr = ${$self}{io_socket_ip_infos}[${$self}{io_socket_ip_idx}]{peeraddr};
761
762					if( connect( $self, $addr ) or $! == EISCONN ) {
763					delete ${*$self}{io_socket_ip_connect_in_progress};
764					$! = 0;
765					return 1;
766					}
767					else {
768					$! = EINPROGRESS;
769					return 0;
770					}
771					}
772
773					sub connected
774					{
775					my $self = shift;
776					return defined $self->fileno &&
777					!${*$self}{io_socket_ip_connect_in_progress} &&
778					defined getpeername( $self ); # ->peername caches, we need to detect disconnection
779					}
780
781					=head1 METHODS
782
783					As well as the following methods, this class inherits all the methods in
784					L<IO::Socket> and L<IO::Handle>.
785
786					=cut
787
788					sub _get_host_service
789					{
790					my $self = shift;
791					my ( $addr, $flags, $xflags ) = @_;
792
793					defined $addr or
794					$! = ENOTCONN, return;
795
796					$flags \|= NI_DGRAM if $self->socktype == SOCK_DGRAM;
797
798					my ( $err, $host, $service ) = getnameinfo( $addr, $flags, $xflags \|\| 0 );
799					croak "getnameinfo - $err" if $err;
800
801					return ( $host, $service );
802					}
803
804					sub _unpack_sockaddr
805					{
806					my ( $addr ) = @_;
807					my $family = sockaddr_family $addr;
808
809					if( $family == AF_INET ) {
810					return ( Socket::unpack_sockaddr_in( $addr ) )[1];
811					}
812					elsif( defined $AF_INET6 and $family == $AF_INET6 ) {
813					return ( Socket::unpack_sockaddr_in6( $addr ) )[1];
814					}
815					else {
816					croak "Unrecognised address family $family";
817					}
818					}
819
820					=head2 ( $host, $service ) = $sock->sockhost_service( $numeric )
821
822					Returns the hostname and service name of the local address (that is, the
823					socket address given by the C<sockname> method).
824
825					If C<$numeric> is true, these will be given in numeric form rather than being
826					resolved into names.
827
828					The following four convenience wrappers may be used to obtain one of the two
829					values returned here. If both host and service names are required, this method
830					is preferable to the following wrappers, because it will call
831					C<getnameinfo(3)> only once.
832
833					=cut
834
835					sub sockhost_service
836					{
837					my $self = shift;
838					my ( $numeric ) = @_;
839
840					$self->_get_host_service( $self->sockname, $numeric ? NI_NUMERICHOST\|NI_NUMERICSERV : 0 );
841					}
842
843					=head2 $addr = $sock->sockhost
844
845					Return the numeric form of the local address as a textual representation
846
847					=head2 $port = $sock->sockport
848
849					Return the numeric form of the local port number
850
851					=head2 $host = $sock->sockhostname
852
853					Return the resolved name of the local address
854
855					=head2 $service = $sock->sockservice
856
857					Return the resolved name of the local port number
858
859					=cut
860
861					sub sockhost { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, NI_NUMERICHOST, NIx_NOSERV ) )[0] }
862					sub sockport { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, NI_NUMERICSERV, NIx_NOHOST ) )[1] }
863
864					sub sockhostname { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, 0, NIx_NOSERV ) )[0] }
865					sub sockservice { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, 0, NIx_NOHOST ) )[1] }
866
867					=head2 $addr = $sock->sockaddr
868
869					Return the local address as a binary octet string
870
871					=cut
872
873					sub sockaddr { my $self = shift; _unpack_sockaddr $self->sockname }
874
875					=head2 ( $host, $service ) = $sock->peerhost_service( $numeric )
876
877					Returns the hostname and service name of the peer address (that is, the
878					socket address given by the C<peername> method), similar to the
879					C<sockhost_service> method.
880
881					The following four convenience wrappers may be used to obtain one of the two
882					values returned here. If both host and service names are required, this method
883					is preferable to the following wrappers, because it will call
884					C<getnameinfo(3)> only once.
885
886					=cut
887
888					sub peerhost_service
889					{
890					my $self = shift;
891					my ( $numeric ) = @_;
892
893					$self->_get_host_service( $self->peername, $numeric ? NI_NUMERICHOST\|NI_NUMERICSERV : 0 );
894					}
895
896					=head2 $addr = $sock->peerhost
897
898					Return the numeric form of the peer address as a textual representation
899
900					=head2 $port = $sock->peerport
901
902					Return the numeric form of the peer port number
903
904					=head2 $host = $sock->peerhostname
905
906					Return the resolved name of the peer address
907
908					=head2 $service = $sock->peerservice
909
910					Return the resolved name of the peer port number
911
912					=cut
913
914					sub peerhost { my $self = shift; scalar +( $self->_get_host_service( $self->peername, NI_NUMERICHOST, NIx_NOSERV ) )[0] }
915					sub peerport { my $self = shift; scalar +( $self->_get_host_service( $self->peername, NI_NUMERICSERV, NIx_NOHOST ) )[1] }
916
917					sub peerhostname { my $self = shift; scalar +( $self->_get_host_service( $self->peername, 0, NIx_NOSERV ) )[0] }
918					sub peerservice { my $self = shift; scalar +( $self->_get_host_service( $self->peername, 0, NIx_NOHOST ) )[1] }
919
920					=head2 $addr = $peer->peeraddr
921
922					Return the peer address as a binary octet string
923
924					=cut
925
926					sub peeraddr { my $self = shift; _unpack_sockaddr $self->peername }
927
928					# This unbelievably dodgy hack works around the bug that IO::Socket doesn't do
929					# it
930					# https://rt.cpan.org/Ticket/Display.html?id=61577
931					sub accept
932					{
933					my $self = shift;
934					my ( $new, $peer ) = $self->SUPER::accept( @_ ) or return;
935
936					${$new}{$_} = ${$self}{$_} for qw( io_socket_domain io_socket_type io_socket_proto );
937
938					return wantarray ? ( $new, $peer )
939					: $new;
940					}
941
942					# This second unbelievably dodgy hack guarantees that $self->fileno doesn't
943					# change, which is useful during nonblocking connect
944					# spent 341µs (96+246) within IO::Socket::IP::socket which was called 3 times, avg 114µs/call: # 3 times (96µs+246µs) by IO::Socket::IP::setup at line 638, avg 114µs/call sub socket :method
945					{
946	3	6µs			my $self = shift;
947	3	83µs	6	246µs	return $self->SUPER::socket(@_) if not defined $self->fileno; # spent 216µs making 3 calls to IO::Socket::socket, avg 72µs/call # spent 30µs making 3 calls to IO::Handle::fileno, avg 10µs/call
948
949					# I hate core prototypes sometimes...
950					socket( my $tmph, $_[0], $_[1], $_[2] ) or return undef;
951
952					dup2( $tmph->fileno, $self->fileno ) or die "Unable to dup2 $tmph onto $self - $!";
953					}
954
955					# Versions of IO::Socket before 1.35 may leave socktype undef if from, say, an
956					# ->fdopen call. In this case we'll apply a fix
957					# spent 51µs within IO::Socket::IP::BEGIN@957 which was called: # once (51µs+0s) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 968 BEGIN {
958	1	43µs			if( eval($IO::Socket::VERSION) < 1.35 ) { # spent 7µs executing statements in string eval
959					*socktype = sub {
960					my $self = shift;
961					my $type = $self->SUPER::socktype;
962					if( !defined $type ) {
963					$type = $self->sockopt( Socket::SO_TYPE() );
964					}
965					return $type;
966					};
967					}
968	1	808µs	1	51µs	} # spent 51µs making 1 call to IO::Socket::IP::BEGIN@957
969
970					=head2 $inet = $sock->as_inet
971
972					Returns a new L<IO::Socket::INET> instance wrapping the same filehandle. This
973					may be useful in cases where it is required, for backward-compatibility, to
974					have a real object of C<IO::Socket::INET> type instead of C<IO::Socket::IP>.
975					The new object will wrap the same underlying socket filehandle as the
976					original, so care should be taken not to continue to use both objects
977					concurrently. Ideally the original C<$sock> should be discarded after this
978					method is called.
979
980					This method checks that the socket domain is C<PF_INET> and will throw an
981					exception if it isn't.
982
983					=cut
984
985					sub as_inet
986					{
987					my $self = shift;
988					croak "Cannot downgrade a non-PF_INET socket to IO::Socket::INET" unless $self->sockdomain == AF_INET;
989					return IO::Socket::INET->new_from_fd( $self->fileno, "r+" );
990					}
991
992					=head1 NON-BLOCKING
993
994					If the constructor is passed a defined but false value for the C<Blocking>
995					argument then the socket is put into non-blocking mode. When in non-blocking
996					mode, the socket will not be set up by the time the constructor returns,
997					because the underlying C<connect(2)> syscall would otherwise have to block.
998
999					The non-blocking behaviour is an extension of the C<IO::Socket::INET> API,
1000					unique to C<IO::Socket::IP>, because the former does not support multi-homed
1001					non-blocking connect.
1002
1003					When using non-blocking mode, the caller must repeatedly check for
1004					writeability on the filehandle (for instance using C<select> or C<IO::Poll>).
1005					Each time the filehandle is ready to write, the C<connect> method must be
1006					called, with no arguments. Note that some operating systems, most notably
1007					C<MSWin32> do not report a C<connect()> failure using write-ready; so you must
1008					also C<select()> for exceptional status.
1009
1010					While C<connect> returns false, the value of C<$!> indicates whether it should
1011					be tried again (by being set to the value C<EINPROGRESS>, or C<EWOULDBLOCK> on
1012					MSWin32), or whether a permanent error has occurred (e.g. C<ECONNREFUSED>).
1013
1014					Once the socket has been connected to the peer, C<connect> will return true
1015					and the socket will now be ready to use.
1016
1017					Note that calls to the platform's underlying C<getaddrinfo(3)> function may
1018					block. If C<IO::Socket::IP> has to perform this lookup, the constructor will
1019					block even when in non-blocking mode.
1020
1021					To avoid this blocking behaviour, the caller should pass in the result of such
1022					a lookup using the C<PeerAddrInfo> or C<LocalAddrInfo> arguments. This can be
1023					achieved by using L<Net::LibAsyncNS>, or the C<getaddrinfo(3)> function can be
1024					called in a child process.
1025
1026					use IO::Socket::IP;
1027					use Errno qw( EINPROGRESS EWOULDBLOCK );
1028
1029					my @peeraddrinfo = ... # Caller must obtain the getaddinfo result here
1030
1031					my $socket = IO::Socket::IP->new(
1032					PeerAddrInfo => \@peeraddrinfo,
1033					Blocking => 0,
1034					) or die "Cannot construct socket - $@";
1035
1036					while( !$socket->connect and ( $! == EINPROGRESS \|\| $! == EWOULDBLOCK ) ) {
1037					my $wvec = '';
1038					vec( $wvec, fileno $socket, 1 ) = 1;
1039					my $evec = '';
1040					vec( $evec, fileno $socket, 1 ) = 1;
1041
1042					select( undef, $wvec, $evec, undef ) or die "Cannot select - $!";
1043					}
1044
1045					die "Cannot connect - $!" if $!;
1046
1047					...
1048
1049					The example above uses C<select()>, but any similar mechanism should work
1050					analogously. C<IO::Socket::IP> takes care when creating new socket filehandles
1051					to preserve the actual file descriptor number, so such techniques as C<poll>
1052					or C<epoll> should be transparent to its reallocation of a different socket
1053					underneath, perhaps in order to switch protocol family between C<PF_INET> and
1054					C<PF_INET6>.
1055
1056					For another example using C<IO::Poll> and C<Net::LibAsyncNS>, see the
1057					F<examples/nonblocking_libasyncns.pl> file in the module distribution.
1058
1059					=cut
1060
1061					=head1 C<PeerHost> AND C<LocalHost> PARSING
1062
1063					To support the C<IO::Socket::INET> API, the host and port information may be
1064					passed in a single string rather than as two separate arguments.
1065
1066					If either C<LocalHost> or C<PeerHost> (or their C<...Addr> synonyms) have any
1067					of the following special forms then special parsing is applied.
1068
1069					The value of the C<...Host> argument will be split to give both the hostname
1070					and port (or service name):
1071
1072					hostname.example.org:http # Host name
1073					192.0.2.1:80 # IPv4 address
1074					[2001:db8::1]:80 # IPv6 address
1075
1076					In each case, the port or service name (e.g. C<80>) is passed as the
1077					C<LocalService> or C<PeerService> argument.
1078
1079					Either of C<LocalService> or C<PeerService> (or their C<...Port> synonyms) can
1080					be either a service name, a decimal number, or a string containing both a
1081					service name and number, in a form such as
1082
1083					http(80)
1084
1085					In this case, the name (C<http>) will be tried first, but if the resolver does
1086					not understand it then the port number (C<80>) will be used instead.
1087
1088					If the C<...Host> argument is in this special form and the corresponding
1089					C<...Service> or C<...Port> argument is also defined, the one parsed from
1090					the C<...Host> argument will take precedence and the other will be ignored.
1091
1092					=head2 ( $host, $port ) = IO::Socket::IP->split_addr( $addr )
1093
1094					Utility method that provides the parsing functionality described above.
1095					Returns a 2-element list, containing either the split hostname and port
1096					description if it could be parsed, or the given address and C<undef> if it was
1097					not recognised.
1098
1099					IO::Socket::IP->split_addr( "hostname:http" )
1100					# ( "hostname", "http" )
1101
1102					IO::Socket::IP->split_addr( "192.0.2.1:80" )
1103					# ( "192.0.2.1", "80" )
1104
1105					IO::Socket::IP->split_addr( "[2001:db8::1]:80" )
1106					# ( "2001:db8::1", "80" )
1107
1108					IO::Socket::IP->split_addr( "something.else" )
1109					# ( "something.else", undef )
1110
1111					=cut
1112
1113					sub split_addr
1114					# spent 851µs (165+686) within IO::Socket::IP::split_addr which was called 4 times, avg 213µs/call: # 4 times (165µs+686µs) by IO::Socket::IP::configure at line 396, avg 213µs/call {
1115	4	7µs			shift;
1116	4	10µs			my ( $addr ) = @_;
1117
1118	4	19µs			local ( $1, $2 ); # Placate a taint-related bug; [perl #67962]
1119	4	782µs	12	686µs	if( $addr =~ m/\A\[($IPv6_re)\](?::([^\s:]*))?\z/ or # spent 656µs making 4 calls to IO::Socket::IP::CORE:regcomp, avg 164µs/call # spent 30µs making 8 calls to IO::Socket::IP::CORE:match, avg 4µs/call
1120					$addr =~ m/\A([^\s:]):([^\s:])\z/ ) {
1121					return ( $1, $2 ) if defined $2 and length $2;
1122					return ( $1, undef );
1123					}
1124
1125	4	40µs			return ( $addr, undef );
1126					}
1127
1128					=head2 $addr = IO::Socket::IP->join_addr( $host, $port )
1129
1130					Utility method that performs the reverse of C<split_addr>, returning a string
1131					formed by joining the specified host address and port number. The host address
1132					will be wrapped in C<[]> brackets if required (because it is a raw IPv6
1133					numeric address).
1134
1135					This can be especially useful when combined with the C<sockhost_service> or
1136					C<peerhost_service> methods.
1137
1138					say "Connected to ", IO::Socket::IP->join_addr( $sock->peerhost_service );
1139
1140					=cut
1141
1142					sub join_addr
1143					{
1144					shift;
1145					my ( $host, $port ) = @_;
1146
1147					$host = "[$host]" if $host =~ m/:/;
1148
1149					return join ":", $host, $port if defined $port;
1150					return $host;
1151					}
1152
1153					# Since IO::Socket->new( Domain => ... ) will delete the Domain parameter
1154					# before calling ->configure, we need to keep track of which it was
1155
1156					package # hide from indexer
1157					IO::Socket::IP::_ForINET;
1158	2	200µs	2	264µs	# spent 264µs (26+237) within IO::Socket::IP::_ForINET::BEGIN@1158 which was called: # once (26µs+237µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 1158 use base qw( IO::Socket::IP ); # spent 264µs making 1 call to IO::Socket::IP::_ForINET::BEGIN@1158 # spent 237µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 237µs
1159
1160					sub configure
1161					{
1162					# This is evil
1163					my $self = shift;
1164					my ( $arg ) = @_;
1165
1166					bless $self, "IO::Socket::IP";
1167					$self->configure( { %$arg, Family => Socket::AF_INET() } );
1168					}
1169
1170					package # hide from indexer
1171					IO::Socket::IP::_ForINET6;
1172	2	298µs	2	268µs	# spent 268µs (21+247) within IO::Socket::IP::_ForINET6::BEGIN@1172 which was called: # once (21µs+247µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 1172 use base qw( IO::Socket::IP ); # spent 268µs making 1 call to IO::Socket::IP::_ForINET6::BEGIN@1172 # spent 247µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 247µs
1173
1174					sub configure
1175					{
1176					# This is evil
1177					my $self = shift;
1178					my ( $arg ) = @_;
1179
1180					bless $self, "IO::Socket::IP";
1181					$self->configure( { %$arg, Family => Socket::AF_INET6() } );
1182					}
1183
1184					=head1 C<IO::Socket::INET> INCOMPATIBILITES
1185
1186					=over 4
1187
1188					=item *
1189
1190					The behaviour enabled by C<MultiHomed> is in fact implemented by
1191					C<IO::Socket::IP> as it is required to correctly support searching for a
1192					useable address from the results of the C<getaddrinfo(3)> call. The
1193					constructor will ignore the value of this argument, except if it is defined
1194					but false. An exception is thrown in this case, because that would request it
1195					disable the C<getaddrinfo(3)> search behaviour in the first place.
1196
1197					=item *
1198
1199					C<IO::Socket::IP> implements both the C<Blocking> and C<Timeout> parameters,
1200					but it implements the interaction of both in a different way.
1201
1202					In C<::INET>, supplying a timeout overrides the non-blocking behaviour,
1203					meaning that the C<connect()> operation will still block despite that the
1204					caller asked for a non-blocking socket. This is not explicitly specified in
1205					its documentation, nor does this author believe that is a useful behaviour -
1206					it appears to come from a quirk of implementation.
1207
1208					In C<::IP> therefore, the C<Blocking> parameter takes precedence - if a
1209					non-blocking socket is requested, no operation will block. The C<Timeout>
1210					parameter here simply defines the maximum time that a blocking C<connect()>
1211					call will wait, if it blocks at all.
1212
1213					In order to specifically obtain the "blocking connect then non-blocking send
1214					and receive" behaviour of specifying this combination of options to C<::INET>
1215					when using C<::IP>, perform first a blocking connect, then afterwards turn the
1216					socket into nonblocking mode.
1217
1218					my $sock = IO::Socket::IP->new(
1219					PeerHost => $peer,
1220					Timeout => 20,
1221					) or die "Cannot connect - $@";
1222
1223					$sock->blocking( 0 );
1224
1225					This code will behave identically under both C<IO::Socket::INET> and
1226					C<IO::Socket::IP>.
1227
1228					=back
1229
1230					=cut
1231
1232					=head1 TODO
1233
1234					=over 4
1235
1236					=item *
1237
1238					Investigate whether C<POSIX::dup2> upsets BSD's C<kqueue> watchers, and if so,
1239					consider what possible workarounds might be applied.
1240
1241					=back
1242
1243					=head1 AUTHOR
1244
1245					Paul Evans <leonerd@leonerd.org.uk>
1246
1247					=cut
1248
1249	1	62µs			0x55AA;

					# spent 29µs within IO::Socket::IP::CORE:connect which was called: # once (29µs+0s) by IO::Socket::IP::connect at line 709 sub IO::Socket::IP::CORE:connect; # opcode
					# spent 1.39ms within IO::Socket::IP::CORE:gpbyname which was called 4 times, avg 348µs/call: # 3 times (393µs+0s) by IO::Socket::IP::_io_socket_ip__configure at line 440, avg 131µs/call # once (999µs+0s) by IO::Socket::IP::BEGIN@39 at line 39 sub IO::Socket::IP::CORE:gpbyname; # opcode
					# spent 41µs within IO::Socket::IP::CORE:match which was called 11 times, avg 4µs/call: # 8 times (30µs+0s) by IO::Socket::IP::split_addr at line 1119, avg 4µs/call # 3 times (12µs+0s) by IO::Socket::IP::_io_socket_ip__configure at line 437, avg 4µs/call sub IO::Socket::IP::CORE:match; # opcode
					# spent 11µs within IO::Socket::IP::CORE:qr which was called: # once (11µs+0s) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 62 sub IO::Socket::IP::CORE:qr; # opcode
					# spent 1.36ms within IO::Socket::IP::CORE:regcomp which was called 5 times, avg 271µs/call: # 4 times (656µs+0s) by IO::Socket::IP::split_addr at line 1119, avg 164µs/call # once (700µs+0s) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 62 sub IO::Socket::IP::CORE:regcomp; # opcode
					# spent 7µs within IO::Socket::IP::CORE:subst which was called 2 times, avg 3µs/call: # once (4µs+0s) by IO::Socket::IP::_io_socket_ip__configure at line 478 # once (2µs+0s) by IO::Socket::IP::_io_socket_ip__configure at line 507 sub IO::Socket::IP::CORE:subst; # opcode