Filename | /usr/local/lib/perl5/site_perl/IO/Socket/IP.pm |
Statements | Executed 424 statements in 14.1ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
4 | 2 | 1 | 1.29ms | 1.29ms | CORE:gpbyname (opcode) | IO::Socket::IP::
5 | 2 | 1 | 1.26ms | 1.26ms | CORE:regcomp (opcode) | IO::Socket::IP::
3 | 1 | 1 | 884µs | 2.24ms | _io_socket_ip__configure | IO::Socket::IP::
3 | 1 | 1 | 400µs | 868µs | setup | IO::Socket::IP::
3 | 1 | 1 | 273µs | 3.30ms | configure | IO::Socket::IP::
4 | 1 | 1 | 164µs | 788µs | split_addr | IO::Socket::IP::
3 | 1 | 1 | 98µs | 315µs | socket | IO::Socket::IP::
3 | 2 | 1 | 98µs | 4.20ms | new | IO::Socket::IP::
1 | 1 | 1 | 54µs | 54µs | BEGIN@957 | IO::Socket::IP::
1 | 1 | 1 | 49µs | 1.23ms | BEGIN@39 | IO::Socket::IP::
11 | 2 | 1 | 43µs | 43µs | CORE:match (opcode) | IO::Socket::IP::
1 | 1 | 1 | 40µs | 40µs | BEGIN@9 | IO::Socket::IP::
1 | 1 | 1 | 35µs | 60µs | connect | IO::Socket::IP::
1 | 1 | 1 | 30µs | 812µs | BEGIN@19 | IO::Socket::IP::
1 | 1 | 1 | 28µs | 265µs | BEGIN@1158 | IO::Socket::IP::_ForINET::
1 | 1 | 1 | 27µs | 58µs | BEGIN@14 | IO::Socket::IP::
1 | 1 | 1 | 26µs | 34µs | BEGIN@13 | IO::Socket::IP::
1 | 1 | 1 | 25µs | 249µs | BEGIN@36 | IO::Socket::IP::
1 | 1 | 1 | 24µs | 24µs | CORE:connect (opcode) | IO::Socket::IP::
1 | 1 | 1 | 24µs | 235µs | BEGIN@33 | IO::Socket::IP::
1 | 1 | 1 | 24µs | 248µs | BEGIN@17 | IO::Socket::IP::
1 | 1 | 1 | 23µs | 348µs | BEGIN@34 | IO::Socket::IP::
1 | 1 | 1 | 23µs | 282µs | BEGIN@1172 | IO::Socket::IP::_ForINET6::
1 | 1 | 1 | 21µs | 308µs | BEGIN@15 | IO::Socket::IP::
1 | 1 | 1 | 18µs | 18µs | import | IO::Socket::IP::
1 | 1 | 1 | 12µs | 12µs | CORE:qr (opcode) | IO::Socket::IP::
2 | 2 | 1 | 6µs | 6µs | CORE:subst (opcode) | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | CAN_DISABLE_V6ONLY | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | configure | IO::Socket::IP::_ForINET6::
0 | 0 | 0 | 0s | 0s | configure | IO::Socket::IP::_ForINET::
0 | 0 | 0 | 0s | 0s | __ANON__[:966] | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | _get_host_service | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | _unpack_sockaddr | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | accept | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | as_inet | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | connected | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | join_addr | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | peeraddr | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | peerhost | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | peerhost_service | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | peerhostname | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | peerport | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | peerservice | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | sockaddr | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | sockhost | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | sockhost_service | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | sockhostname | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | sockport | IO::Socket::IP::
0 | 0 | 0 | 0s | 0s | sockservice | IO::Socket::IP::
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 40µs within IO::Socket::IP::BEGIN@9 which was called:
# once (40µs+0s) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 11 | ||||
10 | 1 | 10µs | $VERSION = '0.39'; | ||
11 | 1 | 46µs | 1 | 40µs | } # spent 40µs making 1 call to IO::Socket::IP::BEGIN@9 |
12 | |||||
13 | 2 | 71µs | 2 | 43µs | # spent 34µs (26+9) within IO::Socket::IP::BEGIN@13 which was called:
# once (26µs+9µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 13 # spent 34µs making 1 call to IO::Socket::IP::BEGIN@13
# spent 9µs making 1 call to strict::import |
14 | 2 | 56µs | 2 | 90µs | # spent 58µs (27+32) within IO::Socket::IP::BEGIN@14 which was called:
# once (27µs+32µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 14 # spent 58µs making 1 call to IO::Socket::IP::BEGIN@14
# spent 32µs making 1 call to warnings::import |
15 | 2 | 86µs | 2 | 308µs | # spent 308µs (21+287) within IO::Socket::IP::BEGIN@15 which was called:
# once (21µs+287µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 15 # spent 308µs making 1 call to IO::Socket::IP::BEGIN@15
# spent 287µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 287µs |
16 | |||||
17 | 2 | 114µs | 2 | 471µs | # spent 248µs (24+223) within IO::Socket::IP::BEGIN@17 which was called:
# once (24µs+223µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 17 # spent 248µs making 1 call to IO::Socket::IP::BEGIN@17
# spent 223µs making 1 call to Exporter::import |
18 | |||||
19 | 1 | 2µs | # spent 812µs (30+782) within IO::Socket::IP::BEGIN@19 which was called:
# once (30µs+782µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 30 | ||
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 | 146µs | 3 | 1.59ms | ); # spent 812µs making 1 call to IO::Socket::IP::BEGIN@19
# spent 759µs making 1 call to Exporter::import
# spent 23µs making 1 call to version::_VERSION |
31 | 2 | 6µs | my $AF_INET6 = eval { Socket::AF_INET6() }; # may not be defined | ||
32 | 2 | 5µs | my $AI_ADDRCONFIG = eval { Socket::AI_ADDRCONFIG() } || 0; | ||
33 | 2 | 79µs | 2 | 445µs | # spent 235µs (24+210) within IO::Socket::IP::BEGIN@33 which was called:
# once (24µs+210µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 33 # spent 235µs making 1 call to IO::Socket::IP::BEGIN@33
# spent 210µs making 1 call to POSIX::import |
34 | 2 | 86µs | 2 | 672µs | # spent 348µs (23+324) within IO::Socket::IP::BEGIN@34 which was called:
# once (23µs+324µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 34 # spent 348µs making 1 call to IO::Socket::IP::BEGIN@34
# spent 324µs making 1 call to Exporter::import |
35 | |||||
36 | 2 | 84µs | 2 | 474µs | # spent 249µs (25+225) within IO::Socket::IP::BEGIN@36 which was called:
# once (25µs+225µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 36 # spent 249µs making 1 call to IO::Socket::IP::BEGIN@36
# spent 225µs making 1 call to constant::import |
37 | |||||
38 | # At least one OS (Android) is known not to have getprotobyname() | ||||
39 | 3 | 8.00ms | 3 | 2.41ms | # spent 1.23ms (49µs+1.18) within IO::Socket::IP::BEGIN@39 which was called:
# once (49µs+1.18ms) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 39 # spent 1.23ms making 1 call to IO::Socket::IP::BEGIN@39
# spent 934µs making 1 call to IO::Socket::IP::CORE:gpbyname
# spent 246µ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 | 7µ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 | 8µ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 | 28µ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 | 724µs | 2 | 681µs | qr<$IPv6address>xo; # spent 669µs making 1 call to IO::Socket::IP::CORE:regcomp
# spent 12µ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 18µs within IO::Socket::IP::import which was called:
# once (18µ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 | 4µ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 | 3µs | @_ = ( $pkg, @symbols ); | ||
141 | 1 | 16µs | 1 | 6.77ms | goto &IO::Socket::import; # spent 6.77ms 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.20ms (98µs+4.10) within IO::Socket::IP::new which was called 3 times, avg 1.40ms/call:
# 2 times (67µs+2.75ms) by Mail::SpamAssassin::DnsResolver::load_resolver at line 113 of Mail/SpamAssassin/DnsResolver.pm, avg 1.41ms/call
# once (31µs+1.35ms) by Mail::SpamAssassin::DnsResolver::connect_sock at line 420 of Mail/SpamAssassin/DnsResolver.pm | ||
367 | 3 | 8µs | my $class = shift; | ||
368 | 3 | 25µs | my %arg = (@_ == 1) ? (PeerHost => $_[0]) : @_; | ||
369 | 3 | 70µs | 3 | 4.10ms | return $class->SUPER::new(%arg); # spent 4.10ms making 3 calls to IO::Socket::new, avg 1.37ms/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.30ms (273µs+3.02) within IO::Socket::IP::configure which was called 3 times, avg 1.10ms/call:
# 3 times (273µs+3.02ms) by IO::Socket::new at line 49 of IO/Socket.pm, avg 1.10ms/call | ||||
376 | 3 | 7µs | my $self = shift; | ||
377 | 3 | 7µs | my ( $arg ) = @_; | ||
378 | |||||
379 | $arg->{PeerHost} = delete $arg->{PeerAddr} | ||||
380 | 3 | 12µ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 | 8µs | if exists $arg->{LocalPort} && !exists $arg->{LocalService}; | ||
390 | |||||
391 | 3 | 14µs | for my $type (qw(Peer Local)) { | ||
392 | 6 | 16µs | my $host = $type . 'Host'; | ||
393 | 6 | 14µs | my $service = $type . 'Service'; | ||
394 | |||||
395 | 6 | 51µs | if( defined $arg->{$host} ) { | ||
396 | 4 | 39µs | 4 | 788µs | ( $arg->{$host}, my $s ) = $self->split_addr( $arg->{$host} ); # spent 788µs making 4 calls to IO::Socket::IP::split_addr, avg 197µs/call |
397 | # IO::Socket::INET compat - *Host parsed port always takes precedence | ||||
398 | 4 | 9µs | $arg->{$service} = $s if defined $s; | ||
399 | } | ||||
400 | } | ||||
401 | |||||
402 | 3 | 44µs | 3 | 2.24ms | $self->_io_socket_ip__configure( $arg ); # spent 2.24ms making 3 calls to IO::Socket::IP::_io_socket_ip__configure, avg 746µ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.24ms (884µs+1.35) within IO::Socket::IP::_io_socket_ip__configure which was called 3 times, avg 746µs/call:
# 3 times (884µs+1.35ms) by IO::Socket::IP::configure at line 402, avg 746µs/call | ||||
408 | 3 | 7µs | my $self = shift; | ||
409 | 3 | 6µs | my ( $arg ) = @_; | ||
410 | |||||
411 | 3 | 8µs | my %hints; | ||
412 | my @localinfos; | ||||
413 | my @peerinfos; | ||||
414 | |||||
415 | 3 | 9µ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 | 9µ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 | 4µs | $hints{socktype} = $type; | ||
434 | } | ||||
435 | |||||
436 | 3 | 15µs | if( defined( my $proto = $arg->{Proto} ) ) { | ||
437 | 3 | 38µs | 3 | 11µs | unless( $proto =~ m/^\d+$/ ) { # spent 11µs making 3 calls to IO::Socket::IP::CORE:match, avg 4µs/call |
438 | my $protonum = HAVE_GETPROTOBYNAME | ||||
439 | ? getprotobyname( $proto ) | ||||
440 | 3 | 388µs | 3 | 356µs | : eval { Socket->${\"IPPROTO_\U$proto"}() }; # spent 356µs making 3 calls to IO::Socket::IP::CORE:gpbyname, avg 119µs/call |
441 | 3 | 7µs | defined $protonum or croak "Unrecognised protocol $proto"; | ||
442 | 3 | 9µ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 | 11µ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 | 13µs | if( !defined $hints{socktype} and defined $hints{protocol} ) { | ||
458 | 2 | 6µs | $hints{socktype} = SOCK_STREAM if $hints{protocol} == IPPROTO_TCP; | ||
459 | 2 | 9µs | $hints{socktype} = SOCK_DGRAM if $hints{protocol} == IPPROTO_UDP; | ||
460 | } | ||||
461 | |||||
462 | 3 | 17µ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 | 7µs | unless ( defined $host or defined $service ) { | ||
474 | $service = 0; | ||||
475 | } | ||||
476 | |||||
477 | 3 | 11µs | local $1; # Placate a taint-related bug; [perl #67962] | ||
478 | 3 | 24µ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 | 21µs | my %localhints = %hints; | ||
482 | 3 | 14µs | $localhints{flags} |= AI_PASSIVE; | ||
483 | 3 | 142µs | 3 | 102µs | ( my $err, @localinfos ) = getaddrinfo( $host, $service, \%localhints ); # spent 102µs making 3 calls to Socket::getaddrinfo, avg 34µ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 | 12µ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 | 24µs | 1 | 9µs | ( my $err, @peerinfos ) = getaddrinfo( $host, $service, \%hints ); # spent 9µ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 | 7µ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 | 6µ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 | 7µ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 | 7µs | if( defined $arg->{MultiHomed} and !$arg->{MultiHomed} ) { | ||
554 | croak "Cannot disable the MultiHomed parameter"; | ||||
555 | } | ||||
556 | |||||
557 | 3 | 5µs | my @infos; | ||
558 | 3 | 15µ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 | 13µ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 | 33µ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 | 30µs | ${*$self}{io_socket_ip_infos} = \@infos; | ||
611 | |||||
612 | 6 | 21µs | ${*$self}{io_socket_ip_idx} = -1; | ||
613 | |||||
614 | 6 | 22µs | ${*$self}{io_socket_ip_sockopts} = \@sockopts_enabled; | ||
615 | 6 | 21µs | ${*$self}{io_socket_ip_v6only} = $v6only; | ||
616 | 6 | 21µs | ${*$self}{io_socket_ip_listenqueue} = $listenqueue; | ||
617 | 6 | 21µs | ${*$self}{io_socket_ip_blocking} = $blocking; | ||
618 | |||||
619 | 6 | 29µs | ${*$self}{io_socket_ip_errors} = [ undef, undef, undef ]; | ||
620 | |||||
621 | # ->setup is allowed to return false in nonblocking mode | ||||
622 | 3 | 51µs | 3 | 868µs | $self->setup or !$blocking or return undef; # spent 868µs making 3 calls to IO::Socket::IP::setup, avg 289µs/call |
623 | |||||
624 | 1 | 17µs | return $self; | ||
625 | } | ||||
626 | |||||
627 | sub setup | ||||
628 | # spent 868µs (400+468) within IO::Socket::IP::setup which was called 3 times, avg 289µs/call:
# 3 times (400µs+468µs) by IO::Socket::IP::_io_socket_ip__configure at line 622, avg 289µs/call | ||||
629 | 3 | 6µs | my $self = shift; | ||
630 | |||||
631 | 3 | 9µs | while(1) { | ||
632 | 10 | 33µs | ${*$self}{io_socket_ip_idx}++; | ||
633 | 20 | 84µs | last if ${*$self}{io_socket_ip_idx} >= @{ ${*$self}{io_socket_ip_infos} }; | ||
634 | |||||
635 | 9 | 37µs | my $info = ${*$self}{io_socket_ip_infos}->[${*$self}{io_socket_ip_idx}]; | ||
636 | |||||
637 | 3 | 5µs | $self->socket( @{$info}{qw( family socktype protocol )} ) or | ||
638 | 5 | 74µs | 3 | 315µs | ( ${*$self}{io_socket_ip_errors}[2] = $!, next ); # spent 315µs making 3 calls to IO::Socket::IP::socket, avg 105µs/call |
639 | |||||
640 | 2 | 7µs | $self->blocking( 0 ) unless ${*$self}{io_socket_ip_blocking}; | ||
641 | |||||
642 | 3 | 17µ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 | 6µ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 | 18µs | 1 | 93µs | ( ${*$self}{io_socket_ip_errors}[1] = $!, next ); # spent 93µs making 1 call to IO::Socket::bind |
655 | } | ||||
656 | |||||
657 | 2 | 7µ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 | 13µs | 1 | 60µs | if( $self->connect( $addr ) ) { # spent 60µs making 1 call to IO::Socket::IP::connect |
663 | 1 | 4µs | $! = 0; | ||
664 | 1 | 8µ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 | 9µs | $@ = "$!"; | ||
689 | 2 | 18µs | return undef; | ||
690 | } | ||||
691 | |||||
692 | # spent 60µs (35+24) within IO::Socket::IP::connect which was called:
# once (35µs+24µs) by IO::Socket::IP::setup at line 662 | ||||
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 | 2µs | if( @_ ) { | ||
703 | 1 | 3µ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 | 47µs | 1 | 24µs | return connect( $self, $addr ) unless defined $timeout; # spent 24µ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 315µs (98+216) within IO::Socket::IP::socket which was called 3 times, avg 105µs/call:
# 3 times (98µs+216µs) by IO::Socket::IP::setup at line 638, avg 105µs/call | ||||
945 | { | ||||
946 | 3 | 7µs | my $self = shift; | ||
947 | 3 | 82µs | 6 | 216µs | return $self->SUPER::socket(@_) if not defined $self->fileno; # spent 188µs making 3 calls to IO::Socket::socket, avg 63µs/call
# spent 28µs making 3 calls to IO::Handle::fileno, avg 9µ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 54µs within IO::Socket::IP::BEGIN@957 which was called:
# once (54µs+0s) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 968 | ||||
958 | 1 | 46µs | if( eval($IO::Socket::VERSION) < 1.35 ) { # spent 8µ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 | 807µs | 1 | 54µs | } # spent 54µ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 788µs (164+624) within IO::Socket::IP::split_addr which was called 4 times, avg 197µs/call:
# 4 times (164µs+624µs) by IO::Socket::IP::configure at line 396, avg 197µs/call | ||||
1115 | 4 | 8µ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 | 718µs | 12 | 624µs | if( $addr =~ m/\A\[($IPv6_re)\](?::([^\s:]*))?\z/ or # spent 593µs making 4 calls to IO::Socket::IP::CORE:regcomp, avg 148µs/call
# spent 32µ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 | 53µ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 | 184µs | 2 | 265µs | # spent 265µs (28+236) within IO::Socket::IP::_ForINET::BEGIN@1158 which was called:
# once (28µs+236µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 1158 # spent 265µs making 1 call to IO::Socket::IP::_ForINET::BEGIN@1158
# spent 236µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 236µ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 | 293µs | 2 | 282µs | # spent 282µs (23+259) within IO::Socket::IP::_ForINET6::BEGIN@1172 which was called:
# once (23µs+259µs) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 1172 # spent 282µs making 1 call to IO::Socket::IP::_ForINET6::BEGIN@1172
# spent 260µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 260µ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 | 61µs | 0x55AA; | ||
# spent 24µs within IO::Socket::IP::CORE:connect which was called:
# once (24µs+0s) by IO::Socket::IP::connect at line 709 | |||||
sub IO::Socket::IP::CORE:gpbyname; # opcode | |||||
sub IO::Socket::IP::CORE:match; # opcode | |||||
# spent 12µs within IO::Socket::IP::CORE:qr which was called:
# once (12µs+0s) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 62 | |||||
sub IO::Socket::IP::CORE:regcomp; # opcode | |||||
sub IO::Socket::IP::CORE:subst; # opcode |