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