line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package POSIX::Open3; |
2
|
|
|
|
|
|
|
|
3
|
13
|
|
|
13
|
|
729687
|
use strict; |
|
13
|
|
|
|
|
38
|
|
|
13
|
|
|
|
|
636
|
|
4
|
13
|
|
|
13
|
|
90
|
no strict 'refs'; # because users pass me bareword filehandles |
|
13
|
|
|
|
|
37
|
|
|
13
|
|
|
|
|
741
|
|
5
|
|
|
|
|
|
|
our ($VERSION, @ISA, @EXPORT); |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
require Exporter; |
8
|
|
|
|
|
|
|
|
9
|
13
|
|
|
13
|
|
78
|
use Carp; |
|
13
|
|
|
|
|
42
|
|
|
13
|
|
|
|
|
930
|
|
10
|
13
|
|
|
13
|
|
1198
|
use Symbol qw(gensym qualify); |
|
13
|
|
|
|
|
1258
|
|
|
13
|
|
|
|
|
745
|
|
11
|
13
|
|
|
13
|
|
12876
|
use POSIX (); |
|
13
|
|
|
|
|
131903
|
|
|
13
|
|
|
|
|
7219
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# $VERSION = 1.08; |
14
|
|
|
|
|
|
|
$VERSION = '0.01'; |
15
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
16
|
|
|
|
|
|
|
@EXPORT = qw(open3); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 NAME |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
POSIX::Open3 - open a process for reading, writing, and error handling using open3() |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 SYNOPSIS |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
$pid = open3(\*CHLD_IN, \*CHLD_OUT, \*CHLD_ERR, |
25
|
|
|
|
|
|
|
'some cmd and args', 'optarg', ...); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my($wtr, $rdr, $err); |
28
|
|
|
|
|
|
|
use Symbol 'gensym'; $err = gensym; |
29
|
|
|
|
|
|
|
$pid = open3($wtr, $rdr, $err, |
30
|
|
|
|
|
|
|
'some cmd and args', 'optarg', ...); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
waitpid( $pid, 0 ); |
33
|
|
|
|
|
|
|
my $child_exit_status = $? >> 8; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head1 DISCLAIMER |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
This is a copy of the Perl core code for C patched to use |
38
|
|
|
|
|
|
|
POSIX calls, that fixes some bugs when using C under some web |
39
|
|
|
|
|
|
|
frameworks like C or C. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
The bug (or part of it) is described in this RT ticket: |
42
|
|
|
|
|
|
|
L |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
Hopefully, this module will no longer exists as soon as that bug is |
45
|
|
|
|
|
|
|
fixed and a stable Perl release is done. |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
Follows the documentation from C. |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head2 Windows |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
Under windows the code run with this module is almost the same as the |
52
|
|
|
|
|
|
|
one available with IPC::Open3. We just force the standard output and |
53
|
|
|
|
|
|
|
standard error re-opening to the default file handles in the child |
54
|
|
|
|
|
|
|
process. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=head1 DESCRIPTION |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
Extremely similar to open2(), open3() spawns the given $cmd and |
59
|
|
|
|
|
|
|
connects CHLD_OUT for reading from the child, CHLD_IN for writing to |
60
|
|
|
|
|
|
|
the child, and CHLD_ERR for errors. If CHLD_ERR is false, or the |
61
|
|
|
|
|
|
|
same file descriptor as CHLD_OUT, then STDOUT and STDERR of the child |
62
|
|
|
|
|
|
|
are on the same filehandle (this means that an autovivified lexical |
63
|
|
|
|
|
|
|
cannot be used for the STDERR filehandle, see SYNOPSIS). The CHLD_IN |
64
|
|
|
|
|
|
|
will have autoflush turned on. |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
If CHLD_IN begins with C<< <& >>, then CHLD_IN will be closed in the |
67
|
|
|
|
|
|
|
parent, and the child will read from it directly. If CHLD_OUT or |
68
|
|
|
|
|
|
|
CHLD_ERR begins with C<< >& >>, then the child will send output |
69
|
|
|
|
|
|
|
directly to that filehandle. In both cases, there will be a dup(2) |
70
|
|
|
|
|
|
|
instead of a pipe(2) made. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
If either reader or writer is the null string, this will be replaced |
73
|
|
|
|
|
|
|
by an autogenerated filehandle. If so, you must pass a valid lvalue |
74
|
|
|
|
|
|
|
in the parameter slot so it can be overwritten in the caller, or |
75
|
|
|
|
|
|
|
an exception will be raised. |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
The filehandles may also be integers, in which case they are understood |
78
|
|
|
|
|
|
|
as file descriptors. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
open3() returns the process ID of the child process. It doesn't return on |
81
|
|
|
|
|
|
|
failure: it just raises an exception matching C^open3:/>. However, |
82
|
|
|
|
|
|
|
C failures in the child (such as no such file or permission denied), |
83
|
|
|
|
|
|
|
are just reported to CHLD_ERR, as it is not possible to trap them. |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
If the child process dies for any reason, the next write to CHLD_IN is |
86
|
|
|
|
|
|
|
likely to generate a SIGPIPE in the parent, which is fatal by default. |
87
|
|
|
|
|
|
|
So you may wish to handle this signal. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Note if you specify C<-> as the command, in an analogous fashion to |
90
|
|
|
|
|
|
|
C the child process will just be the forked Perl |
91
|
|
|
|
|
|
|
process rather than an external command. This feature isn't yet |
92
|
|
|
|
|
|
|
supported on Win32 platforms. |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
open3() does not wait for and reap the child process after it exits. |
95
|
|
|
|
|
|
|
Except for short programs where it's acceptable to let the operating system |
96
|
|
|
|
|
|
|
take care of this, you need to do this yourself. This is normally as |
97
|
|
|
|
|
|
|
simple as calling C when you're done with the process. |
98
|
|
|
|
|
|
|
Failing to do this can result in an accumulation of defunct or "zombie" |
99
|
|
|
|
|
|
|
processes. See L for more information. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
If you try to read from the child's stdout writer and their stderr |
102
|
|
|
|
|
|
|
writer, you'll have problems with blocking, which means you'll want |
103
|
|
|
|
|
|
|
to use select() or the IO::Select, which means you'd best use |
104
|
|
|
|
|
|
|
sysread() instead of readline() for normal stuff. |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
This is very dangerous, as you may block forever. It assumes it's |
107
|
|
|
|
|
|
|
going to talk to something like B, both writing to it and reading |
108
|
|
|
|
|
|
|
from it. This is presumably safe because you "know" that commands |
109
|
|
|
|
|
|
|
like B will read a line at a time and output a line at a time. |
110
|
|
|
|
|
|
|
Programs like B that read their entire input stream first, |
111
|
|
|
|
|
|
|
however, are quite apt to cause deadlock. |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
The big problem with this approach is that if you don't have control |
114
|
|
|
|
|
|
|
over source code being run in the child process, you can't control |
115
|
|
|
|
|
|
|
what it does with pipe buffering. Thus you can't just open a pipe to |
116
|
|
|
|
|
|
|
C and continually read and write a line from it. |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=head1 See Also |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=over 4 |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=item L |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
Like Open3 but without STDERR catpure. |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=item L |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
This is a CPAN module that has better error handling and more facilities |
129
|
|
|
|
|
|
|
than Open3. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=back |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=head1 WARNING |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
The order of arguments differs from that of open2(). |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=cut |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# &open3: Marc Horowitz |
140
|
|
|
|
|
|
|
# derived mostly from &open2 by tom christiansen, |
141
|
|
|
|
|
|
|
# fixed for 5.001 by Ulrich Kunitz |
142
|
|
|
|
|
|
|
# ported to Win32 by Ron Schmidt, Merrill Lynch almost ended my career |
143
|
|
|
|
|
|
|
# fixed for autovivving FHs, tchrist again |
144
|
|
|
|
|
|
|
# allow fd numbers to be used, by Frank Tobin |
145
|
|
|
|
|
|
|
# allow '-' as command (c.f. open "-|"), by Adam Spiers |
146
|
|
|
|
|
|
|
# |
147
|
|
|
|
|
|
|
# usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...); |
148
|
|
|
|
|
|
|
# |
149
|
|
|
|
|
|
|
# spawn the given $cmd and connect rdr for |
150
|
|
|
|
|
|
|
# reading, wtr for writing, and err for errors. |
151
|
|
|
|
|
|
|
# if err is '', or the same as rdr, then stdout and |
152
|
|
|
|
|
|
|
# stderr of the child are on the same fh. returns pid |
153
|
|
|
|
|
|
|
# of child (or dies on failure). |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# if wtr begins with '<&', then wtr will be closed in the parent, and |
157
|
|
|
|
|
|
|
# the child will read from it directly. if rdr or err begins with |
158
|
|
|
|
|
|
|
# '>&', then the child will send output directly to that fd. In both |
159
|
|
|
|
|
|
|
# cases, there will be a dup() instead of a pipe() made. |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
# WARNING: this is dangerous, as you may block forever |
163
|
|
|
|
|
|
|
# unless you are very careful. |
164
|
|
|
|
|
|
|
# |
165
|
|
|
|
|
|
|
# $wtr is left unbuffered. |
166
|
|
|
|
|
|
|
# |
167
|
|
|
|
|
|
|
# abort program if |
168
|
|
|
|
|
|
|
# rdr or wtr are null |
169
|
|
|
|
|
|
|
# a system call fails |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
our $Me = 'open3 (bug)'; # you should never see this, it's always localized |
172
|
|
|
|
|
|
|
|
173
|
44
|
|
|
44
|
0
|
2521
|
sub under_windows() { $^O eq "MSWin32" } |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# Fatal.pm needs to be fixed WRT prototypes. |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
sub xfork { |
178
|
77
|
|
|
77
|
0
|
180776
|
my $pid = fork; |
179
|
77
|
50
|
|
|
|
3121
|
defined $pid or croak "$Me: fork failed: $!"; |
180
|
77
|
|
|
|
|
6891
|
return $pid; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
sub xpipe { |
184
|
226
|
50
|
|
226
|
0
|
11700
|
pipe $_[0], $_[1] or croak "$Me: pipe($_[0], $_[1]) failed: $!"; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
sub xpipe_anon { |
188
|
0
|
0
|
|
0
|
0
|
0
|
pipe $_[0], $_[1] or croak "$Me: pipe failed: $!"; |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
sub xclose_on_exec { |
192
|
11
|
|
|
11
|
0
|
1627
|
require Fcntl; |
193
|
11
|
50
|
|
|
|
437
|
my $flags = fcntl($_[0], &Fcntl::F_GETFD, 0) |
194
|
|
|
|
|
|
|
or croak "$Me: fcntl failed: $!"; |
195
|
11
|
50
|
|
|
|
405
|
fcntl($_[0], &Fcntl::F_SETFD, $flags|&Fcntl::FD_CLOEXEC) |
196
|
|
|
|
|
|
|
or croak "$Me: fcntl failed: $!"; |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
# I tried using a * prototype character for the filehandle but it still |
200
|
|
|
|
|
|
|
# disallows a bearword while compiling under strict subs. |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub xopen { |
203
|
1
|
50
|
|
1
|
0
|
89
|
open $_[0], $_[1] or croak "$Me: open($_[0], $_[1]) failed: $!"; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub xclose { |
207
|
151
|
50
|
|
151
|
0
|
4670
|
$_[0] =~ /\A=?(\d+)\z/ ? eval { require POSIX; POSIX::close($1); } : close $_[0] |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
sub fh_is_fd { |
211
|
231
|
|
|
231
|
0
|
5517
|
return $_[0] =~ /\A=?(\d+)\z/; |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
sub xfileno { |
215
|
9
|
50
|
|
9
|
0
|
341
|
return $1 if $_[0] =~ /\A=?(\d+)\z/; # deal with fh just being an fd |
216
|
9
|
|
|
|
|
429
|
return fileno $_[0]; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
13
|
|
33
|
13
|
|
109
|
use constant DO_SPAWN => $^O eq 'os2' || $^O eq 'MSWin32'; |
|
13
|
|
|
|
|
26
|
|
|
13
|
|
|
|
|
27312
|
|
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
sub _open3 { |
222
|
77
|
|
|
77
|
|
202
|
local $Me = shift; |
223
|
77
|
|
|
|
|
713
|
my($package, $dad_wtr, $dad_rdr, $dad_err, @cmd) = @_; |
224
|
77
|
|
|
|
|
369
|
my($dup_wtr, $dup_rdr, $dup_err, $kidpid); |
225
|
|
|
|
|
|
|
|
226
|
77
|
50
|
66
|
|
|
2235
|
if (@cmd > 1 and $cmd[0] eq '-') { |
227
|
0
|
|
|
|
|
0
|
croak "Arguments don't make sense when the command is '-'" |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
# simulate autovivification of filehandles because |
231
|
|
|
|
|
|
|
# it's too ugly to use @_ throughout to make perl do it for us |
232
|
|
|
|
|
|
|
# tchrist 5-Mar-00 |
233
|
|
|
|
|
|
|
|
234
|
77
|
50
|
|
|
|
329
|
unless (eval { |
235
|
77
|
50
|
33
|
|
|
1047
|
$dad_wtr = $_[1] = gensym unless defined $dad_wtr && length $dad_wtr; |
236
|
77
|
50
|
33
|
|
|
1219
|
$dad_rdr = $_[2] = gensym unless defined $dad_rdr && length $dad_rdr; |
237
|
77
|
|
|
|
|
295
|
1; }) |
238
|
|
|
|
|
|
|
{ |
239
|
|
|
|
|
|
|
# must strip crud for croak to add back, or looks ugly |
240
|
0
|
|
|
|
|
0
|
$@ =~ s/(?<=value attempted) at .*//s; |
241
|
0
|
|
|
|
|
0
|
croak "$Me: $@"; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
77
|
|
66
|
|
|
577
|
$dad_err ||= $dad_rdr; |
245
|
|
|
|
|
|
|
|
246
|
77
|
|
|
|
|
483
|
$dup_wtr = ($dad_wtr =~ s/^[<>]&//); |
247
|
77
|
|
|
|
|
825
|
$dup_rdr = ($dad_rdr =~ s/^[<>]&//); |
248
|
77
|
|
|
|
|
264
|
$dup_err = ($dad_err =~ s/^[<>]&//); |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
# force unqualified filehandles into caller's package |
251
|
77
|
50
|
|
|
|
294
|
$dad_wtr = qualify $dad_wtr, $package unless fh_is_fd($dad_wtr); |
252
|
77
|
50
|
|
|
|
3711
|
$dad_rdr = qualify $dad_rdr, $package unless fh_is_fd($dad_rdr); |
253
|
77
|
50
|
|
|
|
1077
|
$dad_err = qualify $dad_err, $package unless fh_is_fd($dad_err); |
254
|
|
|
|
|
|
|
|
255
|
77
|
|
|
|
|
1277
|
my $kid_rdr = gensym; |
256
|
77
|
|
|
|
|
2404
|
my $kid_wtr = gensym; |
257
|
77
|
|
|
|
|
883
|
my $kid_err = gensym; |
258
|
|
|
|
|
|
|
|
259
|
77
|
100
|
|
|
|
1342
|
xpipe $kid_rdr, $dad_wtr if !$dup_wtr; |
260
|
77
|
100
|
|
|
|
374
|
xpipe $dad_rdr, $kid_wtr if !$dup_rdr; |
261
|
77
|
100
|
100
|
|
|
734
|
xpipe $dad_err, $kid_err if !$dup_err && $dad_err ne $dad_rdr; |
262
|
|
|
|
|
|
|
|
263
|
77
|
|
|
|
|
127
|
if (!DO_SPAWN) { |
264
|
|
|
|
|
|
|
# Used to communicate exec failures. |
265
|
77
|
|
|
|
|
242
|
xpipe my $stat_r, my $stat_w; |
266
|
|
|
|
|
|
|
|
267
|
77
|
|
|
|
|
267
|
$kidpid = xfork; |
268
|
77
|
100
|
|
|
|
1931
|
if ($kidpid == 0) { # Kid |
269
|
11
|
|
|
|
|
947
|
eval { |
270
|
|
|
|
|
|
|
# A tie in the parent should not be allowed to cause problems. |
271
|
11
|
|
|
|
|
434
|
untie *STDIN; |
272
|
11
|
|
|
|
|
179
|
untie *STDOUT; |
273
|
|
|
|
|
|
|
|
274
|
11
|
50
|
|
|
|
537
|
if (under_windows()) { ## Non Standard |
275
|
0
|
|
|
|
|
0
|
open(STDOUT, ">&=1"); |
276
|
0
|
|
|
|
|
0
|
open(STDERR, ">&=2"); |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
11
|
|
|
|
|
654
|
close $stat_r; |
280
|
11
|
|
|
|
|
438
|
xclose_on_exec $stat_w; |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
# If she wants to dup the kid's stderr onto her stdout I need to |
283
|
|
|
|
|
|
|
# save a copy of her stdout before I put something else there. |
284
|
11
|
100
|
100
|
|
|
487
|
if ($dad_rdr ne $dad_err && $dup_err |
|
|
|
66
|
|
|
|
|
285
|
|
|
|
|
|
|
&& xfileno($dad_err) == fileno(STDOUT)) { |
286
|
1
|
|
|
|
|
50
|
my $tmp = gensym; |
287
|
1
|
|
|
|
|
191
|
xopen($tmp, ">&$dad_err"); |
288
|
1
|
|
|
|
|
3
|
$dad_err = $tmp; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
11
|
100
|
|
|
|
367
|
if ($dup_wtr) { |
292
|
1
|
50
|
|
|
|
3
|
if (under_windows()) { |
293
|
0
|
0
|
|
|
|
0
|
xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != xfileno($dad_wtr); |
294
|
|
|
|
|
|
|
} else { |
295
|
1
|
50
|
|
|
|
114
|
POSIX::dup2(xfileno($dad_wtr), 0) if 0 != xfileno($dad_wtr); |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
} else { |
299
|
10
|
|
|
|
|
176
|
xclose $dad_wtr; |
300
|
10
|
50
|
|
|
|
41
|
if (under_windows()) { |
301
|
0
|
|
|
|
|
0
|
xopen \*STDIN, "<&=" . fileno $kid_rdr; |
302
|
|
|
|
|
|
|
} else { |
303
|
10
|
|
|
|
|
267
|
POSIX::dup2(fileno($kid_rdr), 0); |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
} |
306
|
11
|
100
|
|
|
|
85
|
if ($dup_rdr) { |
307
|
4
|
50
|
|
|
|
10
|
if (under_windows()) { |
308
|
0
|
0
|
|
|
|
0
|
xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != xfileno($dad_rdr); |
309
|
|
|
|
|
|
|
} else { |
310
|
4
|
50
|
|
|
|
161
|
POSIX::dup2(xfileno($dad_rdr), 1) if 1 != xfileno($dad_rdr); |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
} else { |
313
|
7
|
|
|
|
|
31
|
xclose $dad_rdr; |
314
|
7
|
50
|
|
|
|
1885
|
if (under_windows()) { |
315
|
0
|
|
|
|
|
0
|
xopen \*STDOUT, ">&=" . fileno $kid_wtr; |
316
|
|
|
|
|
|
|
} else { |
317
|
7
|
|
|
|
|
125
|
POSIX::dup2(fileno($kid_wtr), 1); |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
} |
320
|
11
|
100
|
|
|
|
172
|
if ($dad_rdr ne $dad_err) { |
321
|
5
|
100
|
|
|
|
2824
|
if ($dup_err) { |
322
|
|
|
|
|
|
|
# I have to use a fileno here because in this one case |
323
|
|
|
|
|
|
|
# I'm doing a dup but the filehandle might be a reference |
324
|
|
|
|
|
|
|
# (from the special case above). |
325
|
1
|
50
|
|
|
|
3
|
if (under_windows()) { |
326
|
0
|
0
|
|
|
|
0
|
xopen \*STDERR, ">&" . xfileno($dad_err) |
327
|
|
|
|
|
|
|
if fileno(STDERR) != xfileno($dad_err); |
328
|
|
|
|
|
|
|
} else { |
329
|
1
|
50
|
|
|
|
19
|
POSIX::dup2(xfileno($dad_err), 2) |
330
|
|
|
|
|
|
|
if 2 != xfileno($dad_err); |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
} else { |
333
|
4
|
|
|
|
|
10
|
xclose $dad_err; |
334
|
4
|
50
|
|
|
|
10
|
if (under_windows()) { |
335
|
0
|
|
|
|
|
0
|
xopen \*STDERR, ">&=" . fileno $kid_err; |
336
|
|
|
|
|
|
|
} else { |
337
|
4
|
|
|
|
|
51
|
POSIX::dup2(fileno($kid_err), 2); |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
} else { |
341
|
6
|
50
|
|
|
|
222
|
if (fileno(STDERR) != fileno(STDOUT)) { |
342
|
6
|
50
|
|
|
|
114
|
if (under_windows()) { |
343
|
0
|
|
|
|
|
0
|
xopen \*STDERR, ">&STDOUT"; |
344
|
|
|
|
|
|
|
} else { |
345
|
6
|
|
|
|
|
38
|
POSIX::dup2(1, 2); |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
} |
349
|
11
|
50
|
|
|
|
81
|
return 0 if ($cmd[0] eq '-'); |
350
|
11
|
0
|
|
|
|
0
|
exec @cmd or do { |
351
|
0
|
|
|
|
|
0
|
local($")=(" "); |
352
|
0
|
|
|
|
|
0
|
croak "$Me: exec of @cmd failed"; |
353
|
|
|
|
|
|
|
}; |
354
|
|
|
|
|
|
|
}; |
355
|
|
|
|
|
|
|
|
356
|
0
|
|
|
|
|
0
|
my $bang = 0+$!; |
357
|
0
|
|
|
|
|
0
|
my $err = $@; |
358
|
0
|
0
|
|
|
|
0
|
utf8::encode $err if $] >= 5.008; |
359
|
0
|
|
|
|
|
0
|
print $stat_w pack('IIa*', $bang, length($err), $err); |
360
|
0
|
|
|
|
|
0
|
close $stat_w; |
361
|
|
|
|
|
|
|
|
362
|
0
|
|
|
|
|
0
|
eval { require POSIX; POSIX::_exit(255); }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
363
|
0
|
|
|
|
|
0
|
exit 255; |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
else { # Parent |
366
|
66
|
|
|
|
|
3928
|
close $stat_w; |
367
|
66
|
|
|
|
|
1920
|
my $to_read = length(pack('I', 0)) * 2; |
368
|
66
|
|
|
|
|
37238985
|
my $bytes_read = read($stat_r, my $buf = '', $to_read); |
369
|
66
|
100
|
|
|
|
6064
|
if ($bytes_read) { |
370
|
2
|
|
|
|
|
42
|
(my $bang, $to_read) = unpack('II', $buf); |
371
|
2
|
|
|
|
|
32
|
read($stat_r, my $err = '', $to_read); |
372
|
2
|
50
|
|
|
|
28
|
if ($err) { |
373
|
2
|
50
|
|
|
|
60
|
utf8::decode $err if $] >= 5.008; |
374
|
|
|
|
|
|
|
} else { |
375
|
0
|
|
|
|
|
0
|
$err = "$Me: " . ($! = $bang); |
376
|
|
|
|
|
|
|
} |
377
|
2
|
|
|
|
|
22
|
$! = $bang; |
378
|
2
|
|
|
|
|
244
|
die($err); |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
else { # DO_SPAWN |
383
|
|
|
|
|
|
|
# All the bookkeeping of coincidence between handles is |
384
|
|
|
|
|
|
|
# handled in spawn_with_handles. |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
my @close; |
387
|
|
|
|
|
|
|
if ($dup_wtr) { |
388
|
|
|
|
|
|
|
$kid_rdr = \*{$dad_wtr}; |
389
|
|
|
|
|
|
|
push @close, $kid_rdr; |
390
|
|
|
|
|
|
|
} else { |
391
|
|
|
|
|
|
|
push @close, \*{$dad_wtr}, $kid_rdr; |
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
if ($dup_rdr) { |
394
|
|
|
|
|
|
|
$kid_wtr = \*{$dad_rdr}; |
395
|
|
|
|
|
|
|
push @close, $kid_wtr; |
396
|
|
|
|
|
|
|
} else { |
397
|
|
|
|
|
|
|
push @close, \*{$dad_rdr}, $kid_wtr; |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
if ($dad_rdr ne $dad_err) { |
400
|
|
|
|
|
|
|
if ($dup_err) { |
401
|
|
|
|
|
|
|
$kid_err = \*{$dad_err}; |
402
|
|
|
|
|
|
|
push @close, $kid_err; |
403
|
|
|
|
|
|
|
} else { |
404
|
|
|
|
|
|
|
push @close, \*{$dad_err}, $kid_err; |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
} else { |
407
|
|
|
|
|
|
|
$kid_err = $kid_wtr; |
408
|
|
|
|
|
|
|
} |
409
|
|
|
|
|
|
|
require IO::Pipe; |
410
|
|
|
|
|
|
|
$kidpid = eval { |
411
|
|
|
|
|
|
|
spawn_with_handles( [ { mode => 'r', |
412
|
|
|
|
|
|
|
open_as => $kid_rdr, |
413
|
|
|
|
|
|
|
handle => \*STDIN }, |
414
|
|
|
|
|
|
|
{ mode => 'w', |
415
|
|
|
|
|
|
|
open_as => $kid_wtr, |
416
|
|
|
|
|
|
|
handle => \*STDOUT }, |
417
|
|
|
|
|
|
|
{ mode => 'w', |
418
|
|
|
|
|
|
|
open_as => $kid_err, |
419
|
|
|
|
|
|
|
handle => \*STDERR }, |
420
|
|
|
|
|
|
|
], \@close, @cmd); |
421
|
|
|
|
|
|
|
}; |
422
|
|
|
|
|
|
|
die "$Me: $@" if $@; |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
|
425
|
64
|
100
|
|
|
|
1021
|
xclose $kid_rdr if !$dup_wtr; |
426
|
64
|
100
|
|
|
|
465
|
xclose $kid_wtr if !$dup_rdr; |
427
|
64
|
100
|
100
|
|
|
1163
|
xclose $kid_err if !$dup_err && $dad_rdr ne $dad_err; |
428
|
|
|
|
|
|
|
# If the write handle is a dup give it away entirely, close my copy |
429
|
|
|
|
|
|
|
# of it. |
430
|
64
|
100
|
|
|
|
371
|
xclose $dad_wtr if $dup_wtr; |
431
|
|
|
|
|
|
|
|
432
|
64
|
|
|
|
|
7536
|
select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe |
433
|
64
|
|
|
|
|
3359
|
$kidpid; |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
sub open3 { |
437
|
77
|
50
|
|
77
|
0
|
477899
|
if (@_ < 4) { |
438
|
0
|
|
|
|
|
0
|
local $" = ', '; |
439
|
0
|
|
|
|
|
0
|
croak "open3(@_): not enough arguments"; |
440
|
|
|
|
|
|
|
} |
441
|
77
|
|
|
|
|
677
|
return _open3 'open3', scalar caller, @_ |
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
sub spawn_with_handles { |
445
|
0
|
|
|
0
|
0
|
|
my $fds = shift; # Fields: handle, mode, open_as |
446
|
0
|
|
|
|
|
|
my $close_in_child = shift; |
447
|
0
|
|
|
|
|
|
my ($fd, $pid, @saved_fh, $saved, %saved, @errs); |
448
|
0
|
|
|
|
|
|
require Fcntl; |
449
|
|
|
|
|
|
|
|
450
|
0
|
|
|
|
|
|
foreach $fd (@$fds) { |
451
|
0
|
|
|
|
|
|
$fd->{tmp_copy} = IO::Handle->new_from_fd($fd->{handle}, $fd->{mode}); |
452
|
0
|
|
|
|
|
|
$saved{fileno $fd->{handle}} = $fd->{tmp_copy}; |
453
|
|
|
|
|
|
|
} |
454
|
0
|
|
|
|
|
|
foreach $fd (@$fds) { |
455
|
|
|
|
|
|
|
bless $fd->{handle}, 'IO::Handle' |
456
|
0
|
0
|
|
|
|
|
unless eval { $fd->{handle}->isa('IO::Handle') } ; |
|
0
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
# If some of handles to redirect-to coincide with handles to |
458
|
|
|
|
|
|
|
# redirect, we need to use saved variants: |
459
|
0
|
|
0
|
|
|
|
$fd->{handle}->fdopen($saved{fileno $fd->{open_as}} || $fd->{open_as}, |
460
|
|
|
|
|
|
|
$fd->{mode}); |
461
|
|
|
|
|
|
|
} |
462
|
0
|
0
|
|
|
|
|
unless (under_windows()) { |
463
|
|
|
|
|
|
|
# Stderr may be redirected below, so we save the err text: |
464
|
0
|
|
|
|
|
|
foreach $fd (@$close_in_child) { |
465
|
0
|
0
|
0
|
|
|
|
fcntl($fd, Fcntl::F_SETFD(), 1) or push @errs, "fcntl $fd: $!" |
466
|
|
|
|
|
|
|
unless $saved{fileno $fd}; # Do not close what we redirect! |
467
|
|
|
|
|
|
|
} |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
|
470
|
0
|
0
|
|
|
|
|
unless (@errs) { |
471
|
0
|
|
|
|
|
|
$pid = eval { system 1, @_ }; # 1 == P_NOWAIT |
|
0
|
|
|
|
|
|
|
472
|
0
|
0
|
0
|
|
|
|
push @errs, "IO::Pipe: Can't spawn-NOWAIT: $!" if !$pid || $pid < 0; |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
|
475
|
0
|
|
|
|
|
|
foreach $fd (@$fds) { |
476
|
0
|
|
|
|
|
|
$fd->{handle}->fdopen($fd->{tmp_copy}, $fd->{mode}); |
477
|
0
|
0
|
|
|
|
|
$fd->{tmp_copy}->close or croak "Can't close: $!"; |
478
|
|
|
|
|
|
|
} |
479
|
0
|
0
|
|
|
|
|
croak join "\n", @errs if @errs; |
480
|
0
|
|
|
|
|
|
return $pid; |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
69; # so require is happy |