1 package IPC::Run::Win32Helper ;
5 IPC::Run::Win32Helper - helper routines for IPC::Run on Win32 platforms.
9 use IPC::Run::Win32Helper; # Exports all by default
13 IPC::Run needs to use sockets to redirect subprocess I/O so that the select() loop
14 will work on Win32. This seems to only work on WinNT and Win2K at this time, not
15 sure if it will ever work on Win95 or Win98. If you have experience in this area, please
16 contact me at barries@slaysys.com, thanks!.
20 @ISA = qw( Exporter ) ;
35 use Text::ParseWords ;
38 ## REMOVE OSFHandleOpen
39 use Win32API::File qw(
46 ## Takes an fd or a GLOB ref, never never never a Win32 handle.
49 next unless defined $_ ;
51 $fd = fileno $fd if ref $fd ;
52 _debug "disabling inheritance of ", $fd if _debugging_details ;
53 my $osfh = FdGetOsFHandle $fd ;
54 croak $^E if ! defined $osfh || $osfh == INVALID_HANDLE_VALUE ;
56 SetHandleInformation( $osfh, HANDLE_FLAG_INHERIT, 0 ) ;
60 sub _inherit { #### REMOVE
61 for ( @_ ) { #### REMOVE
62 next unless defined $_ ; #### REMOVE
63 my $fd = $_ ; #### REMOVE
64 $fd = fileno $fd if ref $fd ; #### REMOVE
65 _debug "enabling inheritance of ", $fd if _debugging_details ; #### REMOVE
66 my $osfh = FdGetOsFHandle $fd ; #### REMOVE
67 croak $^E if ! defined $osfh || $osfh == INVALID_HANDLE_VALUE ; #### REMOVE
69 SetHandleInformation( $osfh, HANDLE_FLAG_INHERIT, 1 ) ; #### REMOVE
75 # next unless defined $_ ;
76 # my $osfh = GetOsFHandle $_ ;
77 # croak $^E if ! defined $osfh || $osfh == INVALID_HANDLE_VALUE ;
78 # SetHandleInformation( $osfh, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT ) ;
90 Most common incantations of C<run()> (I<not> C<harness()>, C<start()>,
91 or C<finish()>) now use temporary files to redirect input and output
92 instead of pumper processes.
94 Temporary files are used when sending to child processes if input is
95 taken from a scalar with no filter subroutines. This is the only time
96 we can assume that the parent is not interacting with the child's
97 redirected input as it runs.
99 Temporary files are used when receiving from children when output is
100 to a scalar or subroutine with or without filters, but only if
101 the child in question closes its inputs or takes input from
102 unfiltered SCALARs or named files. Normally, a child inherits its STDIN
103 from its parent; to close it, use "0<&-" or the C<noinherit => 1> option.
104 If data is sent to the child from CODE refs, filehandles or from
105 scalars through filters than the child's outputs will not be optimized
106 because C<optimize()> assumes the parent is interacting with the child.
107 It is ok if the output is filtered or handled by a subroutine, however.
109 This assumes that all named files are real files (as opposed to named
110 pipes) and won't change; and that a process is not communicating with
111 the child indirectly (through means not visible to IPC::Run).
112 These can be an invalid assumptions, but are the 99% case.
113 Write me if you need an option to enable or disable optimizations; I
114 suspect it will work like the C<binary()> modifier.
116 To detect cases that you might want to optimize by closing inputs, try
117 setting the C<IPCRUNDEBUG> environment variable to the special C<notopt>
120 C:> set IPCRUNDEBUG=notopt
121 C:> my_app_that_uses_IPC_Run.pl
123 =item optimizer() rationalizations
125 Only for that limited case can we be sure that it's ok to batch all the
126 input in to a temporary file. If STDIN is from a SCALAR or from a named
127 file or filehandle (again, only in C<run()>), then outputs to CODE refs
128 are also assumed to be safe enough to batch through a temp file,
129 otherwise only outputs to SCALAR refs are batched. This can cause a bit
130 of grief if the parent process benefits from or relies on a bit of
131 "early returns" coming in before the child program exits. As long as
132 the output is redirected to a SCALAR ref, this will not be visible.
133 When output is redirected to a subroutine or (deprecated) filters, the
134 subroutine will not get any data until after the child process exits,
135 and it is likely to get bigger chunks of data at once.
137 The reason for the optimization is that, without it, "pumper" processes
138 are used to overcome the inconsistancies of the Win32 API. We need to
139 use anonymous pipes to connect to the child processes' stdin, stdout,
140 and stderr, yet select() does not work on these. select() only works on
141 sockets on Win32. So for each redirected child handle, there is
142 normally a "pumper" process that connects to the parent using a
143 socket--so the parent can select() on that fd--and to the child on an
144 anonymous pipe--so the child can read/write a pipe.
146 Using a socket to connect directly to the child (as at least one MSDN
147 article suggests) seems to cause the trailing output from most children
148 to be lost. I think this is because child processes rarely close their
149 stdout and stderr explicitly, and the winsock dll does not seem to flush
150 output when a process that uses it exits without explicitly closing
153 Because of these pumpers and the inherent slowness of Win32
154 CreateProcess(), child processes with redirects are quite slow to
155 launch; so this routine looks for the very common case of
156 reading/writing to/from scalar references in a run() routine and
157 converts such reads and writes in to temporary file reads and writes.
159 Such files are marked as FILE_ATTRIBUTE_TEMPORARY to increase speed and
160 as FILE_FLAG_DELETE_ON_CLOSE so it will be cleaned up when the child
161 process exits (for input files). The user's default permissions are
162 used for both the temporary files and the directory that contains them,
163 hope your Win32 permissions are secure enough for you. Files are
164 created with the Win32API::File defaults of
165 FILE_SHARE_READ|FILE_SHARE_WRITE.
167 Setting the debug level to "details" or "gory" will give detailed
168 information about the optimization process; setting it to "basic" or
169 higher will tell whether or not a given call is optimized. Setting
170 it to "notopt" will highligh those calls that aren't optimized.
177 my @kids = @{$h->{KIDS}};
181 my ( $ok_to_optimize_outputs, $veto_output_optimization );
183 for my $kid ( @kids ) {
184 ( $ok_to_optimize_outputs, $veto_output_optimization ) = ()
188 "Win32 optimizer: (kid $kid->{NUM}) STDIN piped, carrying over ok of non-SCALAR output optimization"
189 if _debugging_details && $ok_to_optimize_outputs;
191 "Win32 optimizer: (kid $kid->{NUM}) STDIN piped, carrying over veto of non-SCALAR output optimization"
192 if _debugging_details && $veto_output_optimization;
194 if ( $h->{noinherit} && ! $ok_to_optimize_outputs ) {
196 "Win32 optimizer: (kid $kid->{NUM}) STDIN not inherited from parent oking non-SCALAR output optimization"
197 if _debugging_details && $ok_to_optimize_outputs;
198 $ok_to_optimize_outputs = 1;
201 for ( @{$kid->{OPS}} ) {
202 if ( substr( $_->{TYPE}, 0, 1 ) eq "<" ) {
203 if ( $_->{TYPE} eq "<" ) {
204 if ( @{$_->{FILTERS}} > 1 ) {
205 ## Can't assume that the filters are idempotent.
207 elsif ( ref $_->{SOURCE} eq "SCALAR"
208 || ref $_->{SOURCE} eq "GLOB"
209 || UNIVERSAL::isa( $_, "IO::Handle" )
211 if ( $_->{KFD} == 0 ) {
213 "Win32 optimizer: (kid $kid->{NUM}) 0$_->{TYPE}",
215 ", ok to optimize outputs"
216 if _debugging_details;
217 $ok_to_optimize_outputs = 1;
219 $_->{SEND_THROUGH_TEMP_FILE} = 1;
222 elsif ( ! ref $_->{SOURCE} && defined $_->{SOURCE} ) {
223 if ( $_->{KFD} == 0 ) {
225 "Win32 optimizer: (kid $kid->{NUM}) 0<$_->{SOURCE}, ok to optimize outputs",
226 if _debugging_details;
227 $ok_to_optimize_outputs = 1;
233 "Win32 optimizer: (kid $kid->{NUM}) ",
237 ? ref $_->{SOURCE} ? ref $_->{SOURCE}
239 : defined $_->{FILENAME}
242 @{$_->{FILTERS}} > 1 ? " with filters" : (),
243 ", VETOING output opt."
244 if _debugging_details || _debugging_not_optimized;
245 $veto_output_optimization = 1;
247 elsif ( $_->{TYPE} eq "close" && $_->{KFD} == 0 ) {
248 $ok_to_optimize_outputs = 1;
249 _debug "Win32 optimizer: (kid $kid->{NUM}) saw 0<&-, ok to optimize outputs"
250 if _debugging_details;
252 elsif ( $_->{TYPE} eq "dup" && $_->{KFD2} == 0 ) {
253 $veto_output_optimization = 1;
254 _debug "Win32 optimizer: (kid $kid->{NUM}) saw 0<&$_->{KFD2}, VETOING output opt."
255 if _debugging_details || _debugging_not_optimized;
257 elsif ( $_->{TYPE} eq "|" ) {
262 if ( ! $ok_to_optimize_outputs && ! $veto_output_optimization ) {
264 "Win32 optimizer: (kid $kid->{NUM}) child STDIN not redirected, VETOING non-SCALAR output opt."
265 if _debugging_details || _debugging_not_optimized;
266 $veto_output_optimization = 1;
269 if ( $ok_to_optimize_outputs && $veto_output_optimization ) {
270 $ok_to_optimize_outputs = 0;
271 _debug "Win32 optimizer: (kid $kid->{NUM}) non-SCALAR output optimizations VETOed"
272 if _debugging_details || _debugging_not_optimized;
275 ## SOURCE/DEST ARRAY means it's a filter.
276 ## TODO: think about checking to see if the final input/output of
277 ## a filter chain (an ARRAY SOURCE or DEST) is a scalar...but
278 ## we may be deprecating filters.
280 for ( @{$kid->{OPS}} ) {
281 if ( $_->{TYPE} eq ">" ) {
282 if ( ref $_->{DEST} eq "SCALAR"
284 ( @{$_->{FILTERS}} > 1
285 || ref $_->{DEST} eq "CODE"
286 || ref $_->{DEST} eq "ARRAY" ## Filters?
288 && ( $ok_to_optimize_outputs && ! $veto_output_optimization )
291 $_->{RECV_THROUGH_TEMP_FILE} = 1;
295 "Win32 optimizer: NOT optimizing (kid $kid->{NUM}) ",
299 ? ref $_->{DEST} ? ref $_->{DEST}
301 : defined $_->{FILENAME}
304 @{$_->{FILTERS}} ? " with filters" : (),
305 if _debugging_details;
312 =item win32_parse_cmd_line
314 @words = win32_parse_cmd_line( q{foo bar 'baz baz' "bat bat"} ) ;
316 returns 4 words. This parses like the bourne shell (see
317 the bit about shellwords() in L<Text::ParseWords>), assuming we're
318 trying to be a little cross-platform here. The only difference is
319 that "\" is *not* treated as an escape except when it precedes
320 punctuation, since it's used all over the place in DOS path specs.
322 TODO: globbing? probably not (it's unDOSish).
324 TODO: shebang emulation? Probably, but perhaps that should be part
325 of Run.pm so all spawned processes get the benefit.
327 LIMITATIONS: shellwords dies silently on malformed input like
333 sub win32_parse_cmd_line {
335 $line =~ s{(\\[\w\s])}{\\$1}g ;
336 return shellwords $line ;
342 Spawns a child process, possibly with STDIN, STDOUT, and STDERR (file descriptors 0, 1, and 2, respectively) redirected.
346 Cannot redirect higher file descriptors due to lack of support for this in the
349 This can be worked around by marking a handle as inheritable in the
350 parent (or leaving it marked; this is the default in perl), obtaining it's
351 Win32 handle with C<Win32API::GetOSFHandle(FH)> or
352 C<Win32API::FdGetOsFHandle($fd)> and passing it to the child using the command
353 line, the environment, or any other IPC mechanism (it's a plain old integer).
354 The child can then use C<OsFHandleOpen()> or C<OsFHandleOpenFd()> and possibly
355 C<<open FOO ">&BAR">> or C<<open FOO ">&$fd>> as need be. Ach, the pain!
357 Remember to check the Win32 handle against INVALID_HANDLE_VALUE.
362 my ( $saved, $saved_as, $fd ) = @_ ;
364 ## We can only save aside the original fds once.
365 return if exists $saved->{$fd} ;
367 my $saved_fd = IPC::Run::_dup( $fd ) ;
368 _dont_inherit $saved_fd ;
370 $saved->{$fd} = $saved_fd ;
371 $saved_as->{$saved_fd} = $fd ;
373 _dont_inherit $saved->{$fd} ;
377 my ( $saved, $saved_as, $fd1, $fd2 ) = @_ ;
378 _save $saved, $saved_as, $fd2 ;
380 if ( exists $saved_as->{$fd2} ) {
381 ## The target fd is colliding with a saved-as fd, gotta bump
382 ## the saved-as fd to another fd.
383 my $orig_fd = delete $saved_as->{$fd2} ;
384 my $saved_fd = IPC::Run::_dup( $fd2 ) ;
385 _dont_inherit $saved_fd ;
387 $saved->{$orig_fd} = $saved_fd ;
388 $saved_as->{$saved_fd} = $orig_fd ;
390 _debug "moving $fd1 to kid's $fd2" if _debugging_details ;
391 IPC::Run::_dup2_rudely( $fd1, $fd2 ) ;
395 my ( $cmd, $ops) = @_ ;
397 ## NOTE: The debug pipe write handle is passed to pump processes as STDOUT.
398 ## and is not to the "real" child process, since they would not know
399 ## what to do with it...unlike Unix, we have no code executing in the
400 ## child before the "real" child is exec()ed.
402 my %saved ; ## Map of parent's orig fd -> saved fd
403 my %saved_as ; ## Map of parent's saved fd -> orig fd, used to
404 ## detect collisions between a KFD and the fd a
405 ## parent's fd happened to be saved to.
407 for my $op ( @$ops ) {
408 _dont_inherit $op->{FD} if defined $op->{FD} ;
410 if ( defined $op->{KFD} && $op->{KFD} > 2 ) {
411 ## TODO: Detect this in harness()
412 ## TODO: enable temporary redirections if ever necessary, not
413 ## sure why they would be...
414 ## 4>&1 1>/dev/null 1>&4 4>&-
415 croak "Can't redirect fd #", $op->{KFD}, " on Win32" ;
418 ## This is very similar logic to IPC::Run::_do_kid_and_exit().
419 if ( defined $op->{TFD} ) {
420 unless ( $op->{TFD} == $op->{KFD} ) {
421 _dup2_gently \%saved, \%saved_as, $op->{TFD}, $op->{KFD} ;
422 _dont_inherit $op->{TFD} ;
425 elsif ( $op->{TYPE} eq "dup" ) {
426 _dup2_gently \%saved, \%saved_as, $op->{KFD1}, $op->{KFD2}
427 unless $op->{KFD1} == $op->{KFD2} ;
429 elsif ( $op->{TYPE} eq "close" ) {
430 _save \%saved, \%saved_as, $op->{KFD} ;
431 IPC::Run::_close( $op->{KFD} ) ;
433 elsif ( $op->{TYPE} eq "init" ) {
434 ## TODO: detect this in harness()
435 croak "init subs not allowed on Win32" ;
440 my $cmd_line = join " ", map {
441 ( my $s = $_ ) =~ s/"/"""/g;
442 $s = qq{"$s"} if /["\s]/;
446 _debug "cmd line: ", $cmd_line
449 Win32::Process::Create(
453 1, ## Inherit handles
454 NORMAL_PRIORITY_CLASS,
456 ) or croak "$!: Win32::Process::Create()" ;
458 for my $orig_fd ( keys %saved ) {
459 IPC::Run::_dup2_rudely( $saved{$orig_fd}, $orig_fd ) ;
460 IPC::Run::_close( $saved{$orig_fd} ) ;
463 return ( $process->GetProcessID(), $process ) ;
471 Barries Slaymaker <barries@slaysys.com>. Funded by Perforce Software, Inc.
475 Copyright 2001, Barrie Slaymaker, All Rights Reserved.
477 You may use this under the terms of either the GPL 2.0 ir the Artistic License.