1 package IPC::Run::Win32Helper;
7 IPC::Run::Win32Helper - helper routines for IPC::Run on Win32 platforms.
11 use IPC::Run::Win32Helper; # Exports all by default
15 IPC::Run needs to use sockets to redirect subprocess I/O so that the select() loop
16 will work on Win32. This seems to only work on WinNT and Win2K at this time, not
17 sure if it will ever work on Win95 or Win98. If you have experience in this area, please
18 contact me at barries@slaysys.com, thanks!.
25 use vars qw{ $VERSION @ISA @EXPORT };
28 @ISA = qw( Exporter );
42 use IPC::Win32APIFile qw(
49 ## Takes an fd or a GLOB ref, never never never a Win32 handle.
52 next unless defined $_;
54 $fd = fileno $fd if ref $fd;
55 _debug "disabling inheritance of ", $fd if _debugging_details;
56 my $osfh = FdGetOsFHandle $fd;
57 croak $^E if ! defined $osfh || $osfh == INVALID_HANDLE_VALUE;
59 SetHandleInformation( $osfh, HANDLE_FLAG_INHERIT, 0 );
63 sub _inherit { #### REMOVE
64 for ( @_ ) { #### REMOVE
65 next unless defined $_; #### REMOVE
66 my $fd = $_; #### REMOVE
67 $fd = fileno $fd if ref $fd; #### REMOVE
68 _debug "enabling inheritance of ", $fd if _debugging_details; #### REMOVE
69 my $osfh = FdGetOsFHandle $fd; #### REMOVE
70 croak $^E if ! defined $osfh || $osfh == INVALID_HANDLE_VALUE; #### REMOVE
72 SetHandleInformation( $osfh, HANDLE_FLAG_INHERIT, 1 ); #### REMOVE
78 # next unless defined $_;
79 # my $osfh = GetOsFHandle $_;
80 # croak $^E if ! defined $osfh || $osfh == INVALID_HANDLE_VALUE;
81 # SetHandleInformation( $osfh, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT );
93 Most common incantations of C<run()> (I<not> C<harness()>, C<start()>,
94 or C<finish()>) now use temporary files to redirect input and output
95 instead of pumper processes.
97 Temporary files are used when sending to child processes if input is
98 taken from a scalar with no filter subroutines. This is the only time
99 we can assume that the parent is not interacting with the child's
100 redirected input as it runs.
102 Temporary files are used when receiving from children when output is
103 to a scalar or subroutine with or without filters, but only if
104 the child in question closes its inputs or takes input from
105 unfiltered SCALARs or named files. Normally, a child inherits its STDIN
106 from its parent; to close it, use "0<&-" or the C<< noinherit => 1 >> option.
107 If data is sent to the child from CODE refs, filehandles or from
108 scalars through filters than the child's outputs will not be optimized
109 because C<optimize()> assumes the parent is interacting with the child.
110 It is ok if the output is filtered or handled by a subroutine, however.
112 This assumes that all named files are real files (as opposed to named
113 pipes) and won't change; and that a process is not communicating with
114 the child indirectly (through means not visible to IPC::Run).
115 These can be an invalid assumptions, but are the 99% case.
116 Write me if you need an option to enable or disable optimizations; I
117 suspect it will work like the C<binary()> modifier.
119 To detect cases that you might want to optimize by closing inputs, try
120 setting the C<IPCRUNDEBUG> environment variable to the special C<notopt>
123 C:> set IPCRUNDEBUG=notopt
124 C:> my_app_that_uses_IPC_Run.pl
126 =item optimizer() rationalizations
128 Only for that limited case can we be sure that it's ok to batch all the
129 input in to a temporary file. If STDIN is from a SCALAR or from a named
130 file or filehandle (again, only in C<run()>), then outputs to CODE refs
131 are also assumed to be safe enough to batch through a temp file,
132 otherwise only outputs to SCALAR refs are batched. This can cause a bit
133 of grief if the parent process benefits from or relies on a bit of
134 "early returns" coming in before the child program exits. As long as
135 the output is redirected to a SCALAR ref, this will not be visible.
136 When output is redirected to a subroutine or (deprecated) filters, the
137 subroutine will not get any data until after the child process exits,
138 and it is likely to get bigger chunks of data at once.
140 The reason for the optimization is that, without it, "pumper" processes
141 are used to overcome the inconsistencies of the Win32 API. We need to
142 use anonymous pipes to connect to the child processes' stdin, stdout,
143 and stderr, yet select() does not work on these. select() only works on
144 sockets on Win32. So for each redirected child handle, there is
145 normally a "pumper" process that connects to the parent using a
146 socket--so the parent can select() on that fd--and to the child on an
147 anonymous pipe--so the child can read/write a pipe.
149 Using a socket to connect directly to the child (as at least one MSDN
150 article suggests) seems to cause the trailing output from most children
151 to be lost. I think this is because child processes rarely close their
152 stdout and stderr explicitly, and the winsock dll does not seem to flush
153 output when a process that uses it exits without explicitly closing
156 Because of these pumpers and the inherent slowness of Win32
157 CreateProcess(), child processes with redirects are quite slow to
158 launch; so this routine looks for the very common case of
159 reading/writing to/from scalar references in a run() routine and
160 converts such reads and writes in to temporary file reads and writes.
162 Such files are marked as FILE_ATTRIBUTE_TEMPORARY to increase speed and
163 as FILE_FLAG_DELETE_ON_CLOSE so it will be cleaned up when the child
164 process exits (for input files). The user's default permissions are
165 used for both the temporary files and the directory that contains them,
166 hope your Win32 permissions are secure enough for you. Files are
167 created with the Win32API::File defaults of
168 FILE_SHARE_READ|FILE_SHARE_WRITE.
170 Setting the debug level to "details" or "gory" will give detailed
171 information about the optimization process; setting it to "basic" or
172 higher will tell whether or not a given call is optimized. Setting
173 it to "notopt" will highlight those calls that aren't optimized.
180 my @kids = @{$h->{KIDS}};
184 my ( $ok_to_optimize_outputs, $veto_output_optimization );
186 for my $kid ( @kids ) {
187 ( $ok_to_optimize_outputs, $veto_output_optimization ) = ()
191 "Win32 optimizer: (kid $kid->{NUM}) STDIN piped, carrying over ok of non-SCALAR output optimization"
192 if _debugging_details && $ok_to_optimize_outputs;
194 "Win32 optimizer: (kid $kid->{NUM}) STDIN piped, carrying over veto of non-SCALAR output optimization"
195 if _debugging_details && $veto_output_optimization;
197 if ( $h->{noinherit} && ! $ok_to_optimize_outputs ) {
199 "Win32 optimizer: (kid $kid->{NUM}) STDIN not inherited from parent oking non-SCALAR output optimization"
200 if _debugging_details && $ok_to_optimize_outputs;
201 $ok_to_optimize_outputs = 1;
204 for ( @{$kid->{OPS}} ) {
205 if ( substr( $_->{TYPE}, 0, 1 ) eq "<" ) {
206 if ( $_->{TYPE} eq "<" ) {
207 if ( @{$_->{FILTERS}} > 1 ) {
208 ## Can't assume that the filters are idempotent.
210 elsif ( ref $_->{SOURCE} eq "SCALAR"
211 || ref $_->{SOURCE} eq "GLOB"
212 || UNIVERSAL::isa( $_, "IO::Handle" )
214 if ( $_->{KFD} == 0 ) {
216 "Win32 optimizer: (kid $kid->{NUM}) 0$_->{TYPE}",
218 ", ok to optimize outputs"
219 if _debugging_details;
220 $ok_to_optimize_outputs = 1;
222 $_->{SEND_THROUGH_TEMP_FILE} = 1;
225 elsif ( ! ref $_->{SOURCE} && defined $_->{SOURCE} ) {
226 if ( $_->{KFD} == 0 ) {
228 "Win32 optimizer: (kid $kid->{NUM}) 0<$_->{SOURCE}, ok to optimize outputs",
229 if _debugging_details;
230 $ok_to_optimize_outputs = 1;
236 "Win32 optimizer: (kid $kid->{NUM}) ",
240 ? ref $_->{SOURCE} ? ref $_->{SOURCE}
242 : defined $_->{FILENAME}
245 @{$_->{FILTERS}} > 1 ? " with filters" : (),
246 ", VETOING output opt."
247 if _debugging_details || _debugging_not_optimized;
248 $veto_output_optimization = 1;
250 elsif ( $_->{TYPE} eq "close" && $_->{KFD} == 0 ) {
251 $ok_to_optimize_outputs = 1;
252 _debug "Win32 optimizer: (kid $kid->{NUM}) saw 0<&-, ok to optimize outputs"
253 if _debugging_details;
255 elsif ( $_->{TYPE} eq "dup" && $_->{KFD2} == 0 ) {
256 $veto_output_optimization = 1;
257 _debug "Win32 optimizer: (kid $kid->{NUM}) saw 0<&$_->{KFD2}, VETOING output opt."
258 if _debugging_details || _debugging_not_optimized;
260 elsif ( $_->{TYPE} eq "|" ) {
265 if ( ! $ok_to_optimize_outputs && ! $veto_output_optimization ) {
267 "Win32 optimizer: (kid $kid->{NUM}) child STDIN not redirected, VETOING non-SCALAR output opt."
268 if _debugging_details || _debugging_not_optimized;
269 $veto_output_optimization = 1;
272 if ( $ok_to_optimize_outputs && $veto_output_optimization ) {
273 $ok_to_optimize_outputs = 0;
274 _debug "Win32 optimizer: (kid $kid->{NUM}) non-SCALAR output optimizations VETOed"
275 if _debugging_details || _debugging_not_optimized;
278 ## SOURCE/DEST ARRAY means it's a filter.
279 ## TODO: think about checking to see if the final input/output of
280 ## a filter chain (an ARRAY SOURCE or DEST) is a scalar...but
281 ## we may be deprecating filters.
283 for ( @{$kid->{OPS}} ) {
284 if ( $_->{TYPE} eq ">" ) {
285 if ( ref $_->{DEST} eq "SCALAR"
287 ( @{$_->{FILTERS}} > 1
288 || ref $_->{DEST} eq "CODE"
289 || ref $_->{DEST} eq "ARRAY" ## Filters?
291 && ( $ok_to_optimize_outputs && ! $veto_output_optimization )
294 $_->{RECV_THROUGH_TEMP_FILE} = 1;
298 "Win32 optimizer: NOT optimizing (kid $kid->{NUM}) ",
302 ? ref $_->{DEST} ? ref $_->{DEST}
304 : defined $_->{FILENAME}
307 @{$_->{FILTERS}} ? " with filters" : (),
308 if _debugging_details;
317 =item win32_parse_cmd_line
319 @words = win32_parse_cmd_line( q{foo bar 'baz baz' "bat bat"} );
321 returns 4 words. This parses like the bourne shell (see
322 the bit about shellwords() in L<Text::ParseWords>), assuming we're
323 trying to be a little cross-platform here. The only difference is
324 that "\" is *not* treated as an escape except when it precedes
325 punctuation, since it's used all over the place in DOS path specs.
327 TODO: globbing? probably not (it's unDOSish).
329 TODO: shebang emulation? Probably, but perhaps that should be part
330 of Run.pm so all spawned processes get the benefit.
332 LIMITATIONS: shellwords dies silently on malformed input like
338 sub win32_parse_cmd_line {
340 $line =~ s{(\\[\w\s])}{\\$1}g;
341 return shellwords $line;
348 Spawns a child process, possibly with STDIN, STDOUT, and STDERR (file descriptors 0, 1, and 2, respectively) redirected.
352 Cannot redirect higher file descriptors due to lack of support for this in the
355 This can be worked around by marking a handle as inheritable in the
356 parent (or leaving it marked; this is the default in perl), obtaining it's
357 Win32 handle with C<Win32API::GetOSFHandle(FH)> or
358 C<Win32API::FdGetOsFHandle($fd)> and passing it to the child using the command
359 line, the environment, or any other IPC mechanism (it's a plain old integer).
360 The child can then use C<OsFHandleOpen()> or C<OsFHandleOpenFd()> and possibly
361 C<<open FOO ">&BAR">> or C<<open FOO ">&$fd>> as need be. Ach, the pain!
363 Remember to check the Win32 handle against INVALID_HANDLE_VALUE.
368 my ( $saved, $saved_as, $fd ) = @_;
370 ## We can only save aside the original fds once.
371 return if exists $saved->{$fd};
373 my $saved_fd = IPC::Run::_dup( $fd );
374 _dont_inherit $saved_fd;
376 $saved->{$fd} = $saved_fd;
377 $saved_as->{$saved_fd} = $fd;
379 _dont_inherit $saved->{$fd};
383 my ( $saved, $saved_as, $fd1, $fd2 ) = @_;
384 _save $saved, $saved_as, $fd2;
386 if ( exists $saved_as->{$fd2} ) {
387 ## The target fd is colliding with a saved-as fd, gotta bump
388 ## the saved-as fd to another fd.
389 my $orig_fd = delete $saved_as->{$fd2};
390 my $saved_fd = IPC::Run::_dup( $fd2 );
391 _dont_inherit $saved_fd;
393 $saved->{$orig_fd} = $saved_fd;
394 $saved_as->{$saved_fd} = $orig_fd;
396 _debug "moving $fd1 to kid's $fd2" if _debugging_details;
397 IPC::Run::_dup2_rudely( $fd1, $fd2 );
401 my ( $cmd, $ops) = @_;
403 ## NOTE: The debug pipe write handle is passed to pump processes as STDOUT.
404 ## and is not to the "real" child process, since they would not know
405 ## what to do with it...unlike Unix, we have no code executing in the
406 ## child before the "real" child is exec()ed.
408 my %saved; ## Map of parent's orig fd -> saved fd
409 my %saved_as; ## Map of parent's saved fd -> orig fd, used to
410 ## detect collisions between a KFD and the fd a
411 ## parent's fd happened to be saved to.
413 for my $op ( @$ops ) {
414 _dont_inherit $op->{FD} if defined $op->{FD};
416 if ( defined $op->{KFD} && $op->{KFD} > 2 ) {
417 ## TODO: Detect this in harness()
418 ## TODO: enable temporary redirections if ever necessary, not
419 ## sure why they would be...
420 ## 4>&1 1>/dev/null 1>&4 4>&-
421 croak "Can't redirect fd #", $op->{KFD}, " on Win32";
424 ## This is very similar logic to IPC::Run::_do_kid_and_exit().
425 if ( defined $op->{TFD} ) {
426 unless ( $op->{TFD} == $op->{KFD} ) {
427 _dup2_gently \%saved, \%saved_as, $op->{TFD}, $op->{KFD};
428 _dont_inherit $op->{TFD};
431 elsif ( $op->{TYPE} eq "dup" ) {
432 _dup2_gently \%saved, \%saved_as, $op->{KFD1}, $op->{KFD2}
433 unless $op->{KFD1} == $op->{KFD2};
435 elsif ( $op->{TYPE} eq "close" ) {
436 _save \%saved, \%saved_as, $op->{KFD};
437 IPC::Run::_close( $op->{KFD} );
439 elsif ( $op->{TYPE} eq "init" ) {
440 ## TODO: detect this in harness()
441 croak "init subs not allowed on Win32";
446 my $cmd_line = join " ", map {
447 ( my $s = $_ ) =~ s/"/"""/g;
448 $s = qq{"$s"} if /[\"\s]|^$/;
452 _debug "cmd line: ", $cmd_line
455 Win32::Process::Create(
459 1, ## Inherit handles
460 NORMAL_PRIORITY_CLASS,
462 ) or croak "$!: Win32::Process::Create()";
464 for my $orig_fd ( keys %saved ) {
465 IPC::Run::_dup2_rudely( $saved{$orig_fd}, $orig_fd );
466 IPC::Run::_close( $saved{$orig_fd} );
469 return ( $process->GetProcessID(), $process );
481 Barries Slaymaker <barries@slaysys.com>. Funded by Perforce Software, Inc.
485 Copyright 2001, Barrie Slaymaker, All Rights Reserved.
487 You may use this under the terms of either the GPL 2.0 or the Artistic License.