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, 2012-2019 -- leonerd@leonerd.org.uk |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package IO::Async::OS; |
7
|
|
|
|
|
|
|
|
8
|
101
|
|
|
101
|
|
492466
|
use strict; |
|
101
|
|
|
|
|
253
|
|
|
101
|
|
|
|
|
3321
|
|
9
|
101
|
|
|
101
|
|
557
|
use warnings; |
|
101
|
|
|
|
|
196
|
|
|
101
|
|
|
|
|
12027
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = '0.79'; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our @ISA = qw( IO::Async::OS::_Base ); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
if( eval { require "IO/Async/OS/$^O.pm" } ) { |
16
|
|
|
|
|
|
|
@ISA = "IO::Async::OS::$^O"; |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
package # hide from CPAN |
20
|
|
|
|
|
|
|
IO::Async::OS::_Base; |
21
|
|
|
|
|
|
|
|
22
|
101
|
|
|
101
|
|
1277
|
use Carp; |
|
101
|
|
|
|
|
304
|
|
|
101
|
|
|
|
|
8017
|
|
23
|
|
|
|
|
|
|
|
24
|
101
|
|
|
|
|
14622
|
use Socket 1.95 qw( |
25
|
|
|
|
|
|
|
AF_INET AF_INET6 AF_UNIX INADDR_LOOPBACK SOCK_DGRAM SOCK_RAW SOCK_STREAM |
26
|
|
|
|
|
|
|
pack_sockaddr_in inet_aton |
27
|
|
|
|
|
|
|
pack_sockaddr_in6 inet_pton |
28
|
|
|
|
|
|
|
pack_sockaddr_un |
29
|
101
|
|
|
101
|
|
24105
|
); |
|
101
|
|
|
|
|
142474
|
|
30
|
|
|
|
|
|
|
|
31
|
101
|
|
|
101
|
|
8681
|
use POSIX qw( sysconf _SC_OPEN_MAX ); |
|
101
|
|
|
|
|
100089
|
|
|
101
|
|
|
|
|
676
|
|
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# Win32 [and maybe other places] don't have an _SC_OPEN_MAX. About the best we |
34
|
|
|
|
|
|
|
# can do really is just make up some largeish number and hope for the best. |
35
|
101
|
|
50
|
101
|
|
39258
|
use constant OPEN_MAX_FD => eval { sysconf(_SC_OPEN_MAX) } || 1024; |
|
101
|
|
|
|
|
226
|
|
|
101
|
|
|
|
|
202
|
|
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Some constants that define features of the OS |
38
|
|
|
|
|
|
|
|
39
|
101
|
|
|
101
|
|
764
|
use constant HAVE_SOCKADDR_IN6 => defined eval { pack_sockaddr_in6 0, inet_pton( AF_INET6, "2001::1" ) }; |
|
101
|
|
|
|
|
218
|
|
|
101
|
|
|
|
|
191
|
|
|
101
|
|
|
|
|
8845
|
|
40
|
101
|
|
|
101
|
|
690
|
use constant HAVE_SOCKADDR_UN => defined eval { pack_sockaddr_un "/foo" }; |
|
101
|
|
|
|
|
180
|
|
|
101
|
|
|
|
|
175
|
|
|
101
|
|
|
|
|
5331
|
|
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# Do we have to fake S_ISREG() files read/write-ready in select()? |
43
|
101
|
|
|
101
|
|
884
|
use constant HAVE_FAKE_ISREG_READY => 0; |
|
101
|
|
|
|
|
180
|
|
|
101
|
|
|
|
|
4537
|
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# Do we have to select() for for evec to get connect() failures |
46
|
101
|
|
|
101
|
|
556
|
use constant HAVE_SELECT_CONNECT_EVEC => 0; |
|
101
|
|
|
|
|
183
|
|
|
101
|
|
|
|
|
4176
|
|
47
|
|
|
|
|
|
|
# Ditto; do we have to poll() for POLLPRI to get connect() failures |
48
|
101
|
|
|
101
|
|
529
|
use constant HAVE_POLL_CONNECT_POLLPRI => 0; |
|
101
|
|
|
|
|
187
|
|
|
101
|
|
|
|
|
4850
|
|
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# Does connect() yield EWOULDBLOCK for nonblocking in progress? |
51
|
101
|
|
|
101
|
|
550
|
use constant HAVE_CONNECT_EWOULDBLOCK => 0; |
|
101
|
|
|
|
|
168
|
|
|
101
|
|
|
|
|
4070
|
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# Can we rename() files that are open? |
54
|
101
|
|
|
101
|
|
541
|
use constant HAVE_RENAME_OPEN_FILES => 1; |
|
101
|
|
|
|
|
171
|
|
|
101
|
|
|
|
|
4222
|
|
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# Can we reliably watch for POSIX signals, including SIGCHLD to reliably |
57
|
|
|
|
|
|
|
# inform us that a fork()ed child has exit()ed? |
58
|
101
|
|
|
101
|
|
545
|
use constant HAVE_SIGNALS => 1; |
|
101
|
|
|
|
|
182
|
|
|
101
|
|
|
|
|
4896
|
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# Do we support POSIX-style true fork()ed processes at all? |
61
|
101
|
|
|
101
|
|
696
|
use constant HAVE_POSIX_FORK => !$ENV{IO_ASYNC_NO_FORK}; |
|
101
|
|
|
|
|
216
|
|
|
101
|
|
|
|
|
7852
|
|
62
|
|
|
|
|
|
|
# Can we potentially support threads? (would still need to 'require threads') |
63
|
|
|
|
|
|
|
use constant HAVE_THREADS => !$ENV{IO_ASYNC_NO_THREADS} && |
64
|
101
|
|
33
|
101
|
|
649
|
eval { require Config && $Config::Config{useithreads} }; |
|
101
|
|
|
|
|
262
|
|
|
101
|
|
|
|
|
594
|
|
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# Preferred trial order for built-in Loop classes |
67
|
101
|
|
|
101
|
|
725
|
use constant LOOP_BUILTIN_CLASSES => qw( Poll Select ); |
|
101
|
|
|
|
|
319
|
|
|
101
|
|
|
|
|
6078
|
|
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# Should there be any other Loop classes we try before the builtin ones? |
70
|
101
|
|
|
101
|
|
604
|
use constant LOOP_PREFER_CLASSES => (); |
|
101
|
|
|
|
|
322
|
|
|
101
|
|
|
|
|
117645
|
|
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=head1 NAME |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
C - operating system abstractions for C |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=head1 DESCRIPTION |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
This module acts as a class to provide a number of utility methods whose exact |
79
|
|
|
|
|
|
|
behaviour may depend on the type of OS it is running on. It is provided as a |
80
|
|
|
|
|
|
|
class so that specific kinds of operating system can override methods in it. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
As well as these support functions it also provides a number of constants, all |
83
|
|
|
|
|
|
|
with names beginning C which describe various features that may or may |
84
|
|
|
|
|
|
|
not be available on the OS or perl build. Most of these are either hard-coded |
85
|
|
|
|
|
|
|
per OS, or detected at runtime. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
The following constants may be overridden by environment variables. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=over 4 |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=item * HAVE_POSIX_FORK |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
True if the C call has full POSIX semantics (full process separation). |
94
|
|
|
|
|
|
|
This is true on most OSes but false on MSWin32. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
This may be overridden to be false by setting the environment variable |
97
|
|
|
|
|
|
|
C. |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=item * HAVE_THREADS |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
True if C are available, meaning that the C module can be |
102
|
|
|
|
|
|
|
used. This depends on whether perl was built with threading support. |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
This may be overridable to be false by setting the environment variable |
105
|
|
|
|
|
|
|
C. |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=back |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=cut |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=head2 getfamilybyname |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
$family = IO::Async::OS->getfamilybyname( $name ) |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Return a protocol family value based on the given name. If C<$name> looks like |
116
|
|
|
|
|
|
|
a number it will be returned as-is. The string values C, C and |
117
|
|
|
|
|
|
|
C will be converted to the appropriate C constant. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=cut |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub getfamilybyname |
122
|
|
|
|
|
|
|
{ |
123
|
152
|
|
|
152
|
|
273
|
shift; |
124
|
152
|
|
|
|
|
383
|
my ( $name ) = @_; |
125
|
|
|
|
|
|
|
|
126
|
152
|
100
|
|
|
|
616
|
return undef unless defined $name; |
127
|
|
|
|
|
|
|
|
128
|
102
|
100
|
|
|
|
657
|
return $name if $name =~ m/^\d+$/; |
129
|
|
|
|
|
|
|
|
130
|
48
|
100
|
|
|
|
206
|
return AF_INET if $name eq "inet"; |
131
|
7
|
100
|
66
|
|
|
29
|
return AF_INET6() if $name eq "inet6" and defined &AF_INET6; |
132
|
5
|
50
|
|
|
|
17
|
return AF_UNIX if $name eq "unix"; |
133
|
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
0
|
croak "Unrecognised socket family name '$name'"; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=head2 getsocktypebyname |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
$socktype = IO::Async::OS->getsocktypebyname( $name ) |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
Return a socket type value based on the given name. If C<$name> looks like a |
142
|
|
|
|
|
|
|
number it will be returned as-is. The string values C, C and |
143
|
|
|
|
|
|
|
C will be converted to the appropriate C constant. |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=cut |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
sub getsocktypebyname |
148
|
|
|
|
|
|
|
{ |
149
|
163
|
|
|
163
|
|
263
|
shift; |
150
|
163
|
|
|
|
|
303
|
my ( $name ) = @_; |
151
|
|
|
|
|
|
|
|
152
|
163
|
100
|
|
|
|
488
|
return undef unless defined $name; |
153
|
|
|
|
|
|
|
|
154
|
114
|
100
|
|
|
|
514
|
return $name if $name =~ m/^\d+$/; |
155
|
|
|
|
|
|
|
|
156
|
52
|
100
|
|
|
|
173
|
return SOCK_STREAM if $name eq "stream"; |
157
|
18
|
50
|
|
|
|
72
|
return SOCK_DGRAM if $name eq "dgram"; |
158
|
0
|
0
|
|
|
|
0
|
return SOCK_RAW if $name eq "raw"; |
159
|
|
|
|
|
|
|
|
160
|
0
|
|
|
|
|
0
|
croak "Unrecognised socktype name '$name'"; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
# This one isn't documented because it's not really overridable. It's largely |
164
|
|
|
|
|
|
|
# here just for completeness |
165
|
|
|
|
|
|
|
my $HAVE_IO_SOCKET_IP; |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
sub socket |
168
|
|
|
|
|
|
|
{ |
169
|
44
|
|
|
44
|
|
25003
|
my $self = shift; |
170
|
44
|
|
|
|
|
177
|
my ( $family, $socktype, $proto ) = @_; |
171
|
|
|
|
|
|
|
|
172
|
44
|
|
|
|
|
277
|
require IO::Socket; |
173
|
|
|
|
|
|
|
defined $HAVE_IO_SOCKET_IP or |
174
|
44
|
100
|
|
|
|
136
|
$HAVE_IO_SOCKET_IP = defined eval { require IO::Socket::IP }; |
|
12
|
|
|
|
|
8240
|
|
175
|
|
|
|
|
|
|
|
176
|
44
|
50
|
|
|
|
69106
|
croak "Cannot create a new socket without a family" unless $family; |
177
|
|
|
|
|
|
|
# PF_UNSPEC and undef are both false |
178
|
44
|
|
50
|
|
|
165
|
$family = $self->getfamilybyname( $family ) || AF_UNIX; |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
# SOCK_STREAM is the most likely |
181
|
44
|
|
50
|
|
|
136
|
$socktype = $self->getsocktypebyname( $socktype ) || SOCK_STREAM; |
182
|
|
|
|
|
|
|
|
183
|
44
|
100
|
|
|
|
141
|
defined $proto or $proto = 0; |
184
|
|
|
|
|
|
|
|
185
|
44
|
100
|
100
|
|
|
231
|
if( $HAVE_IO_SOCKET_IP and ( $family == AF_INET || $family == AF_INET6() ) ) { |
|
|
|
66
|
|
|
|
|
186
|
42
|
|
|
|
|
244
|
return IO::Socket::IP->new->socket( $family, $socktype, $proto ); |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
2
|
|
|
|
|
5
|
my $sock = eval { |
190
|
2
|
|
|
|
|
24
|
IO::Socket->new( |
191
|
|
|
|
|
|
|
Domain => $family, |
192
|
|
|
|
|
|
|
Type => $socktype, |
193
|
|
|
|
|
|
|
Proto => $proto, |
194
|
|
|
|
|
|
|
); |
195
|
|
|
|
|
|
|
}; |
196
|
2
|
50
|
|
|
|
337
|
return $sock if $sock; |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
# That failed. Most likely because the Domain was unrecognised. This |
199
|
|
|
|
|
|
|
# usually happens if getaddrinfo returns an AF_INET6 address but we don't |
200
|
|
|
|
|
|
|
# have a suitable class loaded. In this case we'll return a generic one. |
201
|
|
|
|
|
|
|
# It won't be in the specific subclass but that's the best we can do. And |
202
|
|
|
|
|
|
|
# it will still work as a generic socket. |
203
|
0
|
|
|
|
|
0
|
return IO::Socket->new->socket( $family, $socktype, $proto ); |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=head2 socketpair |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
( $S1, $S2 ) = IO::Async::OS->socketpair( $family, $socktype, $proto ) |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
An abstraction of the C syscall, where any argument may be |
211
|
|
|
|
|
|
|
missing (or given as C). |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
If C<$family> is not provided, a suitable value will be provided by the OS |
214
|
|
|
|
|
|
|
(likely C on POSIX-based platforms). If C<$socktype> is not provided, |
215
|
|
|
|
|
|
|
then C will be used. |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
Additionally, this method supports building connected C or |
218
|
|
|
|
|
|
|
C pairs in the C family even if the underlying platform's |
219
|
|
|
|
|
|
|
C does not, by connecting two normal sockets together. |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
C<$family> and C<$socktype> may also be given symbolically as defined by |
222
|
|
|
|
|
|
|
C and C. |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=cut |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
sub socketpair |
227
|
|
|
|
|
|
|
{ |
228
|
47
|
|
|
47
|
|
17097
|
my $self = shift; |
229
|
47
|
|
|
|
|
148
|
my ( $family, $socktype, $proto ) = @_; |
230
|
|
|
|
|
|
|
|
231
|
47
|
|
|
|
|
7900
|
require IO::Socket; |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
# PF_UNSPEC and undef are both false |
234
|
47
|
|
100
|
|
|
113690
|
$family = $self->getfamilybyname( $family ) || AF_UNIX; |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
# SOCK_STREAM is the most likely |
237
|
47
|
|
100
|
|
|
238
|
$socktype = $self->getsocktypebyname( $socktype ) || SOCK_STREAM; |
238
|
|
|
|
|
|
|
|
239
|
47
|
|
50
|
|
|
252
|
$proto ||= 0; |
240
|
|
|
|
|
|
|
|
241
|
47
|
|
|
|
|
259
|
my ( $S1, $S2 ) = IO::Socket->new->socketpair( $family, $socktype, $proto ); |
242
|
47
|
100
|
|
|
|
13954
|
return ( $S1, $S2 ) if defined $S1; |
243
|
|
|
|
|
|
|
|
244
|
11
|
50
|
66
|
|
|
200
|
return unless $family == AF_INET and ( $socktype == SOCK_STREAM or $socktype == SOCK_DGRAM ); |
|
|
|
33
|
|
|
|
|
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
# Now lets emulate an AF_INET socketpair call |
247
|
|
|
|
|
|
|
|
248
|
11
|
50
|
|
|
|
139
|
my $Stmp = IO::Async::OS->socket( $family, $socktype ) or return; |
249
|
11
|
50
|
|
|
|
1714
|
$Stmp->bind( pack_sockaddr_in( 0, INADDR_LOOPBACK ) ) or return; |
250
|
|
|
|
|
|
|
|
251
|
11
|
50
|
|
|
|
356
|
$S1 = IO::Async::OS->socket( $family, $socktype ) or return; |
252
|
|
|
|
|
|
|
|
253
|
11
|
100
|
|
|
|
1392
|
if( $socktype == SOCK_STREAM ) { |
254
|
2
|
50
|
|
|
|
20
|
$Stmp->listen( 1 ) or return; |
255
|
2
|
50
|
|
|
|
77
|
$S1->connect( getsockname $Stmp ) or return; |
256
|
2
|
50
|
|
|
|
384
|
$S2 = $Stmp->accept or return; |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
# There's a bug in IO::Socket here, in that $S2 's ->socktype won't |
259
|
|
|
|
|
|
|
# yet be set. We can apply a horribly hacky fix here |
260
|
|
|
|
|
|
|
# defined $S2->socktype and $S2->socktype == $socktype or |
261
|
|
|
|
|
|
|
# ${*$S2}{io_socket_type} = $socktype; |
262
|
|
|
|
|
|
|
# But for now we'll skip the test for it instead |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
else { |
265
|
9
|
|
|
|
|
23
|
$S2 = $Stmp; |
266
|
9
|
50
|
|
|
|
118
|
$S1->connect( getsockname $S2 ) or return; |
267
|
9
|
50
|
|
|
|
342
|
$S2->connect( getsockname $S1 ) or return; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
11
|
|
|
|
|
688
|
return ( $S1, $S2 ); |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=head2 pipepair |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
( $rd, $wr ) = IO::Async::OS->pipepair |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
An abstraction of the C syscall, which returns the two new handles. |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=cut |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
sub pipepair |
282
|
|
|
|
|
|
|
{ |
283
|
801
|
|
|
801
|
|
26896
|
my $self = shift; |
284
|
|
|
|
|
|
|
|
285
|
801
|
50
|
|
|
|
41920
|
pipe( my ( $rd, $wr ) ) or return; |
286
|
801
|
|
|
|
|
7451
|
return ( $rd, $wr ); |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
=head2 pipequad |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
( $rdA, $wrA, $rdB, $wrB ) = IO::Async::OS->pipequad |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
This method is intended for creating two pairs of filehandles that are linked |
294
|
|
|
|
|
|
|
together, suitable for passing as the STDIN/STDOUT pair to a child process. |
295
|
|
|
|
|
|
|
After this function returns, C<$rdA> and C<$wrA> will be a linked pair, as |
296
|
|
|
|
|
|
|
will C<$rdB> and C<$wrB>. |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
On platforms that support C, this implementation will be |
299
|
|
|
|
|
|
|
preferred, in which case C<$rdA> and C<$wrB> will actually be the same |
300
|
|
|
|
|
|
|
filehandle, as will C<$rdB> and C<$wrA>. This saves a file descriptor in the |
301
|
|
|
|
|
|
|
parent process. |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
When creating a L or subclass of it, the C |
304
|
|
|
|
|
|
|
and C parameters should always be used. |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
my ( $childRd, $myWr, $myRd, $childWr ) = IO::Async::OS->pipequad; |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
$loop->open_process( |
309
|
|
|
|
|
|
|
stdin => $childRd, |
310
|
|
|
|
|
|
|
stdout => $childWr, |
311
|
|
|
|
|
|
|
... |
312
|
|
|
|
|
|
|
); |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
my $str = IO::Async::Stream->new( |
315
|
|
|
|
|
|
|
read_handle => $myRd, |
316
|
|
|
|
|
|
|
write_handle => $myWr, |
317
|
|
|
|
|
|
|
... |
318
|
|
|
|
|
|
|
); |
319
|
|
|
|
|
|
|
$loop->add( $str ); |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
=cut |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
sub pipequad |
324
|
|
|
|
|
|
|
{ |
325
|
2
|
|
|
2
|
|
4735
|
my $self = shift; |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
# Prefer socketpair |
328
|
2
|
50
|
|
|
|
37
|
if( my ( $S1, $S2 ) = $self->socketpair ) { |
329
|
2
|
|
|
|
|
16
|
return ( $S1, $S2, $S2, $S1 ); |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
# Can't do that, fallback on pipes |
333
|
0
|
0
|
|
|
|
0
|
my ( $rdA, $wrA ) = $self->pipepair or return; |
334
|
0
|
0
|
|
|
|
0
|
my ( $rdB, $wrB ) = $self->pipepair or return; |
335
|
|
|
|
|
|
|
|
336
|
0
|
|
|
|
|
0
|
return ( $rdA, $wrA, $rdB, $wrB ); |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
=head2 signame2num |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
$signum = IO::Async::OS->signame2num( $signame ) |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
This utility method converts a signal name (such as "TERM") into its system- |
344
|
|
|
|
|
|
|
specific signal number. This may be useful to pass to C or use |
345
|
|
|
|
|
|
|
in other places which use numbers instead of symbolic names. |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
=cut |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
my %sig_num; |
350
|
|
|
|
|
|
|
sub _init_signum |
351
|
|
|
|
|
|
|
{ |
352
|
58
|
|
|
58
|
|
240
|
my $self = shift; |
353
|
|
|
|
|
|
|
# Copypasta from Config.pm's documentation |
354
|
|
|
|
|
|
|
|
355
|
58
|
|
|
|
|
139
|
our %Config; |
356
|
58
|
|
|
|
|
1330
|
require Config; |
357
|
58
|
|
|
|
|
5548
|
Config->import; |
358
|
|
|
|
|
|
|
|
359
|
58
|
50
|
33
|
|
|
18035
|
unless($Config{sig_name} && $Config{sig_num}) { |
360
|
0
|
|
|
|
|
0
|
die "No signals found"; |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
else { |
363
|
58
|
|
|
|
|
2271
|
my @names = split ' ', $Config{sig_name}; |
364
|
58
|
|
|
|
|
5645
|
@sig_num{@names} = split ' ', $Config{sig_num}; |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub signame2num |
369
|
|
|
|
|
|
|
{ |
370
|
213
|
|
|
213
|
|
1659
|
my $self = shift; |
371
|
213
|
|
|
|
|
465
|
my ( $signame ) = @_; |
372
|
|
|
|
|
|
|
|
373
|
213
|
100
|
|
|
|
1946
|
%sig_num or $self->_init_signum; |
374
|
|
|
|
|
|
|
|
375
|
213
|
|
|
|
|
856
|
return $sig_num{$signame}; |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
=head2 extract_addrinfo |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
( $family, $socktype, $protocol, $addr ) = IO::Async::OS->extract_addrinfo( $ai ) |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
Given an ARRAY or HASH reference value containing an addrinfo, returns a |
383
|
|
|
|
|
|
|
family, socktype and protocol argument suitable for a C call and an |
384
|
|
|
|
|
|
|
address suitable for C or C. |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
If given an ARRAY it should be in the following form: |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
[ $family, $socktype, $protocol, $addr ] |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
If given a HASH it should contain the following keys: |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
family socktype protocol addr |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
Each field in the result will be initialised to 0 (or empty string for the |
395
|
|
|
|
|
|
|
address) if not defined in the C<$ai> value. |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
The family type may also be given as a symbolic string as defined by |
398
|
|
|
|
|
|
|
C. |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
The socktype may also be given as a symbolic string; C, C or |
401
|
|
|
|
|
|
|
C; this will be converted to the appropriate C constant. |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
Note that the C field, if provided, must be a packed socket address, |
404
|
|
|
|
|
|
|
such as returned by C or C. |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
If the HASH form is used, rather than passing a packed socket address in the |
407
|
|
|
|
|
|
|
C field, certain other hash keys may be used instead for convenience on |
408
|
|
|
|
|
|
|
certain named families. |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
=over 4 |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
=cut |
413
|
|
|
|
|
|
|
|
414
|
101
|
|
|
101
|
|
986
|
use constant ADDRINFO_FAMILY => 0; |
|
101
|
|
|
|
|
257
|
|
|
101
|
|
|
|
|
6248
|
|
415
|
101
|
|
|
101
|
|
638
|
use constant ADDRINFO_SOCKTYPE => 1; |
|
101
|
|
|
|
|
250
|
|
|
101
|
|
|
|
|
5558
|
|
416
|
101
|
|
|
101
|
|
691
|
use constant ADDRINFO_PROTOCOL => 2; |
|
101
|
|
|
|
|
233
|
|
|
101
|
|
|
|
|
5778
|
|
417
|
101
|
|
|
101
|
|
771
|
use constant ADDRINFO_ADDR => 3; |
|
101
|
|
|
|
|
202
|
|
|
101
|
|
|
|
|
145881
|
|
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
sub extract_addrinfo |
420
|
|
|
|
|
|
|
{ |
421
|
55
|
|
|
55
|
|
1958
|
my $self = shift; |
422
|
55
|
|
|
|
|
116
|
my ( $ai, $argname ) = @_; |
423
|
|
|
|
|
|
|
|
424
|
55
|
|
100
|
|
|
242
|
$argname ||= "addr"; |
425
|
|
|
|
|
|
|
|
426
|
55
|
|
|
|
|
84
|
my @ai; |
427
|
|
|
|
|
|
|
|
428
|
55
|
100
|
|
|
|
212
|
if( ref $ai eq "ARRAY" ) { |
|
|
50
|
|
|
|
|
|
429
|
4
|
|
|
|
|
14
|
@ai = @$ai; |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
elsif( ref $ai eq "HASH" ) { |
432
|
51
|
|
|
|
|
186
|
$ai = { %$ai }; # copy so we can delete from it |
433
|
51
|
|
|
|
|
105
|
@ai = delete @{$ai}{qw( family socktype protocol addr )}; |
|
51
|
|
|
|
|
190
|
|
434
|
|
|
|
|
|
|
|
435
|
51
|
100
|
100
|
|
|
228
|
if( defined $ai[ADDRINFO_FAMILY] and !defined $ai[ADDRINFO_ADDR] ) { |
436
|
15
|
|
|
|
|
25
|
my $family = $ai[ADDRINFO_FAMILY]; |
437
|
15
|
|
|
|
|
35
|
my $method = "_extract_addrinfo_$family"; |
438
|
15
|
100
|
|
|
|
271
|
my $code = $self->can( $method ) or croak "Cannot determine addr for extract_addrinfo on family='$family'"; |
439
|
|
|
|
|
|
|
|
440
|
14
|
|
|
|
|
45
|
$ai[ADDRINFO_ADDR] = $code->( $self, $ai ); |
441
|
|
|
|
|
|
|
|
442
|
14
|
100
|
|
|
|
225
|
keys %$ai and croak "Unrecognised '$family' addrinfo keys: " . join( ", ", keys %$ai ); |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
else { |
446
|
0
|
|
|
|
|
0
|
croak "Expected '$argname' to be an ARRAY or HASH reference"; |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
|
449
|
53
|
|
|
|
|
174
|
$ai[ADDRINFO_FAMILY] = $self->getfamilybyname( $ai[ADDRINFO_FAMILY] ); |
450
|
53
|
|
|
|
|
159
|
$ai[ADDRINFO_SOCKTYPE] = $self->getsocktypebyname( $ai[ADDRINFO_SOCKTYPE] ); |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
# Make sure all fields are defined |
453
|
53
|
|
100
|
|
|
351
|
$ai[$_] ||= 0 for ADDRINFO_FAMILY, ADDRINFO_SOCKTYPE, ADDRINFO_PROTOCOL; |
454
|
53
|
100
|
|
|
|
153
|
$ai[ADDRINFO_ADDR] = "" if !defined $ai[ADDRINFO_ADDR]; |
455
|
|
|
|
|
|
|
|
456
|
53
|
|
|
|
|
270
|
return @ai; |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
=item family => 'inet' |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
Will pack an IP address and port number from keys called C and C. |
462
|
|
|
|
|
|
|
If C is missing it will be set to "0.0.0.0". If C is missing it will |
463
|
|
|
|
|
|
|
be set to 0. |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
=cut |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
sub _extract_addrinfo_inet |
468
|
|
|
|
|
|
|
{ |
469
|
8
|
|
|
8
|
|
14
|
my $self = shift; |
470
|
8
|
|
|
|
|
16
|
my ( $ai ) = @_; |
471
|
|
|
|
|
|
|
|
472
|
8
|
|
100
|
|
|
28
|
my $port = delete $ai->{port} || 0; |
473
|
8
|
|
100
|
|
|
30
|
my $ip = delete $ai->{ip} || "0.0.0.0"; |
474
|
|
|
|
|
|
|
|
475
|
8
|
|
|
|
|
54
|
return pack_sockaddr_in( $port, inet_aton( $ip ) ); |
476
|
|
|
|
|
|
|
} |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
=item family => 'inet6' |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
Will pack an IP address and port number from keys called C and C. |
481
|
|
|
|
|
|
|
If C is missing it will be set to "::". If C is missing it will be |
482
|
|
|
|
|
|
|
set to 0. Optionally will also include values from C and C |
483
|
|
|
|
|
|
|
keys if provided. |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
This will only work if a C function can be found in |
486
|
|
|
|
|
|
|
C |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
=cut |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
sub _extract_addrinfo_inet6 |
491
|
|
|
|
|
|
|
{ |
492
|
1
|
|
|
1
|
|
3
|
my $self = shift; |
493
|
1
|
|
|
|
|
3
|
my ( $ai ) = @_; |
494
|
|
|
|
|
|
|
|
495
|
1
|
|
50
|
|
|
5
|
my $port = delete $ai->{port} || 0; |
496
|
1
|
|
50
|
|
|
4
|
my $ip = delete $ai->{ip} || "::"; |
497
|
1
|
|
50
|
|
|
8
|
my $scopeid = delete $ai->{scopeid} || 0; |
498
|
1
|
|
50
|
|
|
10
|
my $flowinfo = delete $ai->{flowinfo} || 0; |
499
|
|
|
|
|
|
|
|
500
|
1
|
|
|
|
|
2
|
if( HAVE_SOCKADDR_IN6 ) { |
501
|
1
|
|
|
|
|
9
|
return pack_sockaddr_in6( $port, inet_pton( AF_INET6, $ip ), $scopeid, $flowinfo ); |
502
|
|
|
|
|
|
|
} |
503
|
|
|
|
|
|
|
else { |
504
|
|
|
|
|
|
|
croak "Cannot pack_sockaddr_in6"; |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
=item family => 'unix' |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
Will pack a UNIX socket path from a key called C. |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
=cut |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
sub _extract_addrinfo_unix |
515
|
|
|
|
|
|
|
{ |
516
|
5
|
|
|
5
|
|
8
|
my $self = shift; |
517
|
5
|
|
|
|
|
11
|
my ( $ai ) = @_; |
518
|
|
|
|
|
|
|
|
519
|
5
|
50
|
|
|
|
20
|
defined( my $path = delete $ai->{path} ) or croak "Expected 'path' for extract_addrinfo on family='unix'"; |
520
|
|
|
|
|
|
|
|
521
|
5
|
|
|
|
|
23
|
return pack_sockaddr_un( $path ); |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
=pod |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
=back |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
=cut |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
=head2 make_addr_for_peer |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
$connectaddr = IO::Async::OS->make_addr_for_peer( $family, $listenaddr ) |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
Given the C and C of a listening socket. creates an |
535
|
|
|
|
|
|
|
address suitable to C to it. |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
This method will handle specially any C address bound to |
538
|
|
|
|
|
|
|
C or any C address bound to C, as some OSes |
539
|
|
|
|
|
|
|
do not allow Cing to those and would instead insist on receiving |
540
|
|
|
|
|
|
|
C or C respectively. |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
This method is used by the C<< ->connect( peer => $sock ) >> parameter of |
543
|
|
|
|
|
|
|
handle and loop connect methods. |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
=cut |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
sub make_addr_for_peer |
548
|
|
|
|
|
|
|
{ |
549
|
5
|
|
|
5
|
|
2611
|
shift; |
550
|
5
|
|
|
|
|
12
|
my ( $p_family, $p_addr ) = @_; |
551
|
|
|
|
|
|
|
|
552
|
5
|
100
|
|
|
|
15
|
if( $p_family == Socket::AF_INET ) { |
553
|
2
|
|
|
|
|
9
|
my @params = Socket::unpack_sockaddr_in $p_addr; |
554
|
2
|
100
|
|
|
|
8
|
$params[1] = Socket::INADDR_LOOPBACK if $params[1] eq Socket::INADDR_ANY; |
555
|
2
|
|
|
|
|
11
|
return Socket::pack_sockaddr_in @params; |
556
|
|
|
|
|
|
|
} |
557
|
3
|
100
|
|
|
|
8
|
if( HAVE_SOCKADDR_IN6 and $p_family == Socket::AF_INET6 ) { |
558
|
2
|
|
|
|
|
10
|
my @params = Socket::unpack_sockaddr_in6 $p_addr; |
559
|
2
|
100
|
|
|
|
7
|
$params[1] = Socket::IN6ADDR_LOOPBACK if $params[1] eq Socket::IN6ADDR_ANY; |
560
|
2
|
|
|
|
|
13
|
return Socket::pack_sockaddr_in6 @params; |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
# Most other cases should be fine |
564
|
1
|
|
|
|
|
6
|
return $p_addr; |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
=head1 LOOP IMPLEMENTATION METHODS |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
The following methods are provided on C because they are likely |
570
|
|
|
|
|
|
|
to require OS-specific implementations, but are used by L to |
571
|
|
|
|
|
|
|
implement its functionality. It can use the HASH reference C<< $loop->{os} >> |
572
|
|
|
|
|
|
|
to store other data it requires. |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
=cut |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
=head2 loop_watch_signal |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
=head2 loop_unwatch_signal |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
IO::Async::OS->loop_watch_signal( $loop, $signal, $code ) |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
IO::Async::OS->loop_unwatch_signal( $loop, $signal ) |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
Used to implement the C / C Loop pair. |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
=cut |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
sub _setup_sigpipe |
589
|
|
|
|
|
|
|
{ |
590
|
59
|
|
|
59
|
|
187
|
my $self = shift; |
591
|
59
|
|
|
|
|
174
|
my ( $loop ) = @_; |
592
|
|
|
|
|
|
|
|
593
|
59
|
|
|
|
|
20715
|
require IO::Async::Handle; |
594
|
|
|
|
|
|
|
|
595
|
59
|
50
|
|
|
|
822
|
my ( $reader, $sigpipe ) = $self->pipepair or croak "Cannot pipe() - $!"; |
596
|
59
|
|
|
|
|
1662
|
$_->blocking( 0 ) for $reader, $sigpipe; |
597
|
|
|
|
|
|
|
|
598
|
59
|
|
|
|
|
274
|
$loop->{os}{sigpipe} = $sigpipe; |
599
|
|
|
|
|
|
|
|
600
|
59
|
|
|
|
|
183
|
my $sigwatch = $loop->{os}{sigwatch}; |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
$loop->add( $loop->{os}{sigpipe_reader} = IO::Async::Handle->new( |
603
|
|
|
|
|
|
|
notifier_name => "sigpipe", |
604
|
|
|
|
|
|
|
read_handle => $reader, |
605
|
|
|
|
|
|
|
on_read_ready => sub { |
606
|
306
|
50
|
|
306
|
|
6387
|
sysread $reader, my $buffer, 8192 or return; |
607
|
306
|
|
|
|
|
2601
|
foreach my $signum ( unpack "I*", $buffer ) { |
608
|
311
|
50
|
|
|
|
3277
|
$sigwatch->{$signum}->() if $sigwatch->{$signum}; |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
}, |
611
|
59
|
|
|
|
|
2136
|
) ); |
612
|
|
|
|
|
|
|
|
613
|
59
|
|
|
|
|
398
|
return $sigpipe; |
614
|
|
|
|
|
|
|
} |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
sub loop_watch_signal |
617
|
|
|
|
|
|
|
{ |
618
|
70
|
|
|
70
|
|
448
|
my $self = shift; |
619
|
70
|
|
|
|
|
314
|
my ( $loop, $signal, $code ) = @_; |
620
|
|
|
|
|
|
|
|
621
|
70
|
100
|
|
|
|
1018
|
exists $SIG{$signal} or croak "Unrecognised signal name $signal"; |
622
|
67
|
50
|
|
|
|
541
|
ref $code or croak 'Expected $code as a reference'; |
623
|
|
|
|
|
|
|
|
624
|
67
|
|
|
|
|
1913
|
my $signum = $self->signame2num( $signal ); |
625
|
67
|
|
100
|
|
|
1190
|
my $sigwatch = $loop->{os}{sigwatch} ||= {}; # {$num} = $code |
626
|
|
|
|
|
|
|
|
627
|
67
|
|
66
|
|
|
1379
|
my $sigpipe = $loop->{os}{sigpipe} // $self->_setup_sigpipe( $loop ); |
628
|
|
|
|
|
|
|
|
629
|
67
|
|
|
|
|
490
|
my $signum_str = pack "I", $signum; |
630
|
67
|
|
|
315
|
|
1912
|
$SIG{$signal} = sub { syswrite $sigpipe, $signum_str }; |
|
315
|
|
|
|
|
43218
|
|
631
|
|
|
|
|
|
|
|
632
|
67
|
|
|
|
|
580
|
$sigwatch->{$signum} = $code; |
633
|
|
|
|
|
|
|
} |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
sub loop_unwatch_signal |
636
|
|
|
|
|
|
|
{ |
637
|
9
|
|
|
9
|
|
22
|
my $self = shift; |
638
|
9
|
|
|
|
|
21
|
my ( $loop, $signal ) = @_; |
639
|
|
|
|
|
|
|
|
640
|
9
|
|
|
|
|
45
|
my $signum = $self->signame2num( $signal ); |
641
|
9
|
50
|
|
|
|
49
|
my $sigwatch = $loop->{os}{sigwatch} or return; |
642
|
|
|
|
|
|
|
|
643
|
9
|
|
|
|
|
54
|
delete $sigwatch->{$signum}; |
644
|
9
|
|
|
|
|
190
|
undef $SIG{$signal}; |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
=head2 potentially_open_fds |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
@fds = IO::Async::OS->potentially_open_fds |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
Returns a list of filedescriptors which might need closing. By default this |
652
|
|
|
|
|
|
|
will return C<0 .. _SC_OPEN_MAX>. OS-specific subclasses may have a better |
653
|
|
|
|
|
|
|
guess. |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
=cut |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
sub potentially_open_fds |
658
|
|
|
|
|
|
|
{ |
659
|
0
|
|
|
0
|
|
0
|
return 0 .. OPEN_MAX_FD; |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
sub post_fork |
663
|
|
|
|
|
|
|
{ |
664
|
2
|
|
|
2
|
|
4
|
my $self = shift; |
665
|
2
|
|
|
|
|
7
|
my ( $loop ) = @_; |
666
|
|
|
|
|
|
|
|
667
|
2
|
50
|
|
|
|
9
|
if( $loop->{os}{sigpipe} ) { |
668
|
2
|
|
|
|
|
16
|
$loop->remove( $loop->{os}{sigpipe_reader} ); |
669
|
2
|
|
|
|
|
5
|
undef $loop->{os}{sigpipe}; |
670
|
|
|
|
|
|
|
|
671
|
2
|
|
|
|
|
5
|
my $sigwatch = $loop->{os}{sigwatch}; |
672
|
|
|
|
|
|
|
|
673
|
2
|
|
|
|
|
58
|
foreach my $signal ( keys %SIG ) { |
674
|
136
|
50
|
|
|
|
222
|
my $signum = $self->signame2num( $signal ) or next; |
675
|
136
|
100
|
|
|
|
262
|
my $code = $sigwatch->{$signum} or next; |
676
|
|
|
|
|
|
|
|
677
|
2
|
|
|
|
|
7
|
$self->loop_watch_signal( $loop, $signal, $code ); |
678
|
|
|
|
|
|
|
} |
679
|
|
|
|
|
|
|
} |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
=head1 AUTHOR |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
Paul Evans |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=cut |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
0x55AA; |