From c299a86c9a292375fbfc39fb756883c80adac4b0 Mon Sep 17 00:00:00 2001 From: Noah Misch Date: Tue, 6 Jul 2021 04:35:08 -0700 Subject: [PATCH 1/3] Support executing Win32 batch files. Trivial examples worked, but my commit fbd6d1823c325ad0b708b3c79ff078c93a386afa broke even those. Cover all known cases, subject to assumptions now described in documentation. As a surviving incompatibility compared to the last release, IPC::Run still adds quotation marks to arguments where quotation marks are optional. That is consequential in a batch file running "echo %*", for example. One can argue that it's a good thing, but it is an incompatibility. Discourage executing batch files with arguments, particularly when argument values contain non-alphanumeric characters. IPC::Run now handles them well, but the batch file itself may not. --- Makefile.PL | 1 + lib/IPC/Run.pm | 28 ++++++++ lib/IPC/Run/Win32Helper.pm | 71 +++++++++++++++++-- t/run.t | 139 +++++++++++++++++++++++++++++++++---- t/win32_compile.t | 15 +++- 5 files changed, 232 insertions(+), 22 deletions(-) diff --git a/Makefile.PL b/Makefile.PL index 385eb89..4708e3c 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -16,6 +16,7 @@ if ( $^O ne 'MSWin32' ) { } } else { + $PREREQ_PM{'Win32'} = '0.27'; # for CSIDL_SYSTEM $PREREQ_PM{'Win32::Process'} = '0.14'; $PREREQ_PM{'Win32::ShellQuote'} = 0; $PREREQ_PM{'Win32API::File'} = '0.0901'; diff --git a/lib/IPC/Run.pm b/lib/IPC/Run.pm index a5f0c77..db226d8 100644 --- a/lib/IPC/Run.pm +++ b/lib/IPC/Run.pm @@ -4162,6 +4162,34 @@ High resolution timeouts. =over +=item argument-passing rules are program-specific + +Win32 programs receive all arguments in a single "command line" string. +IPC::Run assembles this string so programs using L +will see an C that matches the array reference specifying the command. +Some programs use different rules to parse their command line. Notable examples +include F, F, and Cygwin programs called from non-Cygwin +programs. Use L, not IPC::Run, to call these and other +nonstandard programs. + +=item batch files + +Properly escaping a batch file argument depends on how the script will use that +argument, because some uses experience multiple levels of caret (escape +character) removal. Avoid calling batch files with arguments, particularly when +the argument values originate outside your program or contain non-alphanumeric +characters. Perl scripts and PowerShell scripts are sound alternatives. If you +do use batch file arguments, IPC::Run escapes them so the batch file can pass +them, unquoted, to a program having standard command line parsing rules. If the +batch file enables delayed environment variable expansion, it must disable that +feature before expanding its arguments. For example, if F contains +C, C will create a Perl process in which +C<@ARGV> matches C<@list>. Prepending a C line +would make the batch file malfunction, silently. Another silent-malfunction +example is C for F containing C. + =item Fails on Win9X If you want Win9X support, you'll have to debug it or fund me because I diff --git a/lib/IPC/Run/Win32Helper.pm b/lib/IPC/Run/Win32Helper.pm index 8475c62..a1298b9 100644 --- a/lib/IPC/Run/Win32Helper.pm +++ b/lib/IPC/Run/Win32Helper.pm @@ -38,7 +38,9 @@ BEGIN { require POSIX; +use File::Spec (); use Text::ParseWords; +use Win32 (); use Win32::Process; use Win32::ShellQuote (); use IPC::Run::Debug; @@ -405,6 +407,67 @@ sub _dup2_gently { sub win32_spawn { my ( $cmd, $ops ) = @_; + my ( $app, $cmd_line ); + my $need_pct = 0; + if ( $cmd->[0] !~ /\.(bat|cmd) *$/i ) { + $app = $cmd->[0]; + $cmd_line = Win32::ShellQuote::quote_native(@$cmd); + } + else { + # Batch file, so follow the batch-specific guidance of + # https://docs.microsoft.com/en-us/windows/win32/api/processthreadsapi/nf-processthreadsapi-createprocessa + # There's no one true way to locate cmd.exe. In the unlikely event that + # %COMSPEC% is missing, fall back on a Windows API. We could search + # %PATH% like _wsystem() does. That would be prone to security bugs, + # and one fallback is enough. + $app = ( + $ENV{COMSPEC} + || File::Spec->catfile( + Win32::GetFolderPath(Win32::CSIDL_SYSTEM), + 'cmd.exe' + ) + ); + + # Win32 rejects attempts to create files with names containing certain + # characters. Ignore most, but reject the subset that might otherwise + # cause us to execute the wrong file instead of failing cleanly. + if ( $cmd->[0] =~ /["\r\n\0]/ ) { + croak "invalid batch file name"; + } + + # Make cmd.exe see the batch file name as quoted. Suppose we instead + # used caret escapes, as we do for arguments. cmd.exe could then "break + # the command token at the first occurrence of , ; or =" + # (https://stackoverflow.com/a/4095133). + my @parts = qq{"$cmd->[0]"}; + + # cmd.exe will strip escapes once when parsing our $cmd_line and again + # where the batch file injects the argument via %*, %1, etc. Compensate + # by adding one extra cmd_escape layer. + if ( @$cmd > 1 ) { + my @q = Win32::ShellQuote::quote_cmd( @{$cmd}[ 1 .. $#{$cmd} ] ); + push @parts, map { Win32::ShellQuote::cmd_escape($_) } @q; + } + + # One can't stop cmd.exe from expanding %var%, so inject each literal % + # via an environment variable. Delete that variable before the real + # child can see it. See + # https://www.dostips.com/forum/viewtopic.php?f=3&t=10131 for more on + # this technique and the limitations of alternatives. + $cmd_line = join ' ', @parts; + if ( $cmd_line =~ s/%/%ipcrunpct%/g ) { + $cmd_line = qq{/c "set "ipcrunpct=" & $cmd_line"}; + $need_pct = 1; + } + else { + $cmd_line = qq{/c "$cmd_line"}; + } + } + _debug "app: ", $app + if _debugging; + _debug "cmd line: ", $cmd_line + if _debugging; + ## NOTE: The debug pipe write handle is passed to pump processes as STDOUT. ## and is not to the "real" child process, since they would not know ## what to do with it...unlike Unix, we have no code executing in the @@ -447,15 +510,11 @@ sub win32_spawn { } } + local $ENV{ipcrunpct} = '%' if $need_pct; my $process; - my $cmd_line = Win32::ShellQuote::quote_native(@$cmd); - - _debug "cmd line: ", $cmd_line - if _debugging; - Win32::Process::Create( $process, - $cmd->[0], + $app, $cmd_line, 1, ## Inherit handles 0, ## Inherit parent priortiy class. Was NORMAL_PRIORITY_CLASS diff --git a/t/run.t b/t/run.t index da18243..578c110 100644 --- a/t/run.t +++ b/t/run.t @@ -38,7 +38,7 @@ sub get_warnings { select STDERR; select STDOUT; -use Test::More tests => 272; +use Test::More tests => 286; use IPC::Run::Debug qw( _map_fds ); use IPC::Run qw( :filters :filter_imp start ); @@ -214,27 +214,136 @@ $fd_map = _map_fds; ## Arguments bearing most bytes, excluding NUL (unsupported) and BEL (noisy and ## not otherwise special). Arguments bearing special sequences of bytes. ## -{ +sub bytes_tests { + my ( $printer, $bytes, $sequences ) = @_; + local $ENV{PERL_UNICODE}; delete $ENV{PERL_UNICODE}; - my @bytes = map { $_ == 7 ? () : pack( 'C', $_ ); } 1 .. 0xFF; - $r = run( - [ $perl, '-e', 'binmode STDOUT; print join "\0", @ARGV', @bytes ], - '>', \$out - ); - eok( $out, join "\0", @bytes ); - - my $sequences = qq{\\"\\az\\\\"\\\\\\}; - foreach my $payload ( join( '', @bytes ), $sequences, "$sequences\n" ) { - $r = run( - [ $perl, '-e', 'binmode STDOUT; print @ARGV', $payload ], - '>', \$out - ); + run( [ @$printer, @$bytes ], '>', \$out ); + eok( $out, join "\0", @$bytes ); + + foreach my $payload ( join( '', @$bytes ), @$sequences ) { + run( [ @$printer, $payload ], '>', \$out ); eok( $out, $payload ); } } +my @bytes = map { $_ == 7 ? () : pack( 'C', $_ ); } 1 .. 0xFF; +my $sequence = qq{\\"\\az\\\\"\\\\\\}; +bytes_tests( + [ $perl, '-e', 'binmode STDOUT; print join "\0", @ARGV' ], + \@bytes, [ $sequence, "$sequence\n" ] +); + +## +## Executing Cygwin Perl (from any Perl) +## +SKIP: { + # It's tempting to enable these automatically when c:/cygwin64/bin/perl + # exists. However, a hostile user could create that file on a system having + # no Cygwin installation. + skip( 'set TEST_CYGWIN_PERL=c:/cygwin64/bin/perl to test executing Cygwin from non-Cygwin', 3 ) + unless $ENV{TEST_CYGWIN_PERL}; + + # Cygwin mishandles arguments containing non-ASCII bytes, even under + # LANG=POSIX. (It might handle them correctly if they're valid utf8 or if + # one installs a non-utf8 locale.) Cygwin also mishandles "\\\\x a" and + # other lpCommandLine fragments with multiple backslashes. (Cygwin programs + # executing other Cygwin programs pass the argv outside lpCommandLine, + # bypassing the problem.) Don't test any of those. + my @cygbytes = map { $_ == 7 ? () : pack( 'C', $_ ); } 1 .. 0x7F; + bytes_tests( + [ + $ENV{TEST_CYGWIN_PERL}, + '-e', 'binmode STDOUT; print join "\0", @ARGV' + ], + \@cygbytes, + [$sequence] + ); +} + +## +## Win32 batch files +## +SKIP: { + if ( !IPC::Run::Win32_MODE() ) { + skip( "batch files are specific to Win32", 11 ); + } + + use Cwd (); + use File::Spec (); + use File::Temp (); + require Win32::ShellQuote; + + my $parent_dir = File::Temp::tempdir( CLEANUP => 1 ); + my $simple = File::Spec->catfile( $parent_dir, 'simple.bat' ); + my $dir = File::Spec->catdir( $parent_dir, 'sub dir' ); + mkdir $dir; + + # List bytes that are valid in file names and potentially interesting to + # test. Exclude the colon, which selects a non-default "file stream". + # Exclude ASCII alphanumeric bytes, which are uninteresting and would make + # the name too long. + my $file_name_bytes = join '', map { + my $chr = pack( 'C', $_ ); + my $chr_file = File::Spec->catfile( $dir, "name_$chr.bat" ); + $chr !~ /[:a-zA-Z0-9]/ && open( my $fh, '>', $chr_file ) ? ($chr) : (); + } 1 .. 0xFF; + my $bat = File::Spec->catfile( $dir, 'SCRIPT FILE.BAT' ); + my $cmd_basename = "SCRIPT ^&%SYSTEMROOT%!ipcrunpct!${file_name_bytes}.cmd "; + my $cmd = File::Spec->catfile( $dir, $cmd_basename ); + my $bat_source = sprintf( + qq{\@echo off\n"%s" -e %s %%*}, + $perl, + Win32::ShellQuote::quote_cmd('binmode STDOUT; print join "\0", @ARGV') + ); + + # Fill batch files and check their handling of trivial arguments. + foreach my $f ( $simple, $bat, $cmd ) { + spit( $f, $bat_source ); + run( [ $f, qw(xyz 1 23) ], '>', \$out ); + eok( $out, join( "\0", qw(xyz 1 23) ) ); + } + + # Zero arguments + run( [$simple], '>', \$out ); + eok( $out, '' ); + + # Forbidden character in batch file argument + eval { run( [ $simple, "foo\nbar" ], '>', \$out ); }; + like( $@, qr/newline/ ); + + # Missing COMSPEC + { + local $ENV{COMSPEC}; + run( [ $simple, 'arg' ], '>', \$out ); + eok( $out, 'arg' ); + } + + # Environment variable collision + { + local $ENV{'somevar^^^'} = 'FAIL'; + run( [ $simple, '%somevar%' ], '>', \$out ); + eok( $out, '%somevar%' ); + } + + ## As above, except that cmd.exe does not cope with \r or \n. + bytes_tests( + [$cmd], + [ grep { $_ ne "\r" && $_ ne "\n" } @bytes ], [$sequence] + ); + + # Relative path doesn't begin with a volume specification, so it exercises + # different cmd.exe behavior. See https://stackoverflow.com/a/4095133. + my $initial_cwd = Cwd::getcwd; + chdir $parent_dir; + my $rel = File::Spec->catfile( 'sub dir', $cmd_basename ); + run( [ $rel, 'arg' ], '>', \$out ); + eok( $out, 'arg' ); + chdir $initial_cwd; +} + ## ## A function ## diff --git a/t/win32_compile.t b/t/win32_compile.t index da90f8b..fc9339d 100644 --- a/t/win32_compile.t +++ b/t/win32_compile.t @@ -36,7 +36,20 @@ BEGIN { } $INC{$_} = 1 for qw( - Win32/Process.pm Win32/ShellQuote.pm Win32API/File.pm ); + Win32.pm Win32/Process.pm Win32/ShellQuote.pm Win32API/File.pm ); + + package Win32; + + use vars qw( @ISA @EXPORT ); + + @ISA = qw( Exporter ); + @EXPORT = qw( + CSIDL_SYSTEM + ); + + eval "sub $_ {}" for @EXPORT; + + use Exporter; package Win32API::File; From 8491dfeb8f2061d529c92f7bf548a0754817316c Mon Sep 17 00:00:00 2001 From: Noah Misch Date: Tue, 6 Jul 2021 05:04:17 -0700 Subject: [PATCH 2/3] Add IPC::Run::Win32Process, for delivering nonstandard command lines. This unblocks general use of programs like cmd.exe and cscript.exe as stages in IPC::Run pipelines. --- MANIFEST | 1 + lib/IPC/Run.pm | 85 ++++++++++++++++++++++--------------- lib/IPC/Run/Win32Helper.pm | 6 ++- lib/IPC/Run/Win32Process.pm | 80 ++++++++++++++++++++++++++++++++++ t/run.t | 32 +++++++++++++- xt/98_pod_coverage.t | 11 ++--- 6 files changed, 173 insertions(+), 42 deletions(-) create mode 100644 lib/IPC/Run/Win32Process.pm diff --git a/MANIFEST b/MANIFEST index ca4b7db..6b1ea64 100644 --- a/MANIFEST +++ b/MANIFEST @@ -16,6 +16,7 @@ lib/IPC/Run/IO.pm lib/IPC/Run/Timer.pm lib/IPC/Run/Win32Helper.pm lib/IPC/Run/Win32IO.pm +lib/IPC/Run/Win32Process.pm lib/IPC/Run/Win32Pump.pm LICENSE Makefile.PL diff --git a/lib/IPC/Run.pm b/lib/IPC/Run.pm index db226d8..4fbb212 100644 --- a/lib/IPC/Run.pm +++ b/lib/IPC/Run.pm @@ -413,8 +413,8 @@ to the systems' shell: or a list of commands, io operations, and/or timers/timeouts to execute. Consecutive commands must be separated by a pipe operator '|' or an '&'. -External commands are passed in as array references, and, on systems -supporting fork(), Perl code may be passed in as subs: +External commands are passed in as array references or L +objects. On systems supporting fork(), Perl code may be passed in as subs: run \@cmd; run \@cmd1, '|', \@cmd2; @@ -1240,6 +1240,33 @@ sub _search_path { croak "Command '$cmd_name' not found in " . join( ", ", @searched_in ); } +# Translate a command or CODE reference (a $kid->{VAL}) to a list of strings +# suitable for passing to _debug(). +sub _debugstrings { + my $operand = shift; + if ( !defined $operand ) { + return ''; + } + + my $ref = ref $operand; + if ( !$ref ) { + return length $operand < 50 + ? "'$operand'" + : join( '', "'", substr( $operand, 0, 10 ), "...'" ); + } + elsif ( $ref eq 'ARRAY' ) { + return ( + '[ ', + join( " ", map /[^\w.-]/ ? "'$_'" : $_, @$operand ), + ' ]' + ); + } + elsif ( UNIVERSAL::isa( $operand, 'IPC::Run::Win32Process' ) ) { + return "$operand"; + } + return $ref; +} + sub _empty($) { !( defined $_[0] && length $_[0] ) } ## 'safe' versions of otherwise fun things to do. See also IPC::Run::Win32Helper. @@ -1375,6 +1402,9 @@ sub _spawn { my IPC::Run $self = shift; my ($kid) = @_; + croak "Can't spawn IPC::Run::Win32Process except on Win32" + if UNIVERSAL::isa( $kid->{VAL}, 'IPC::Run::Win32Process' ); + _debug "opening sync pipe ", $kid->{PID} if _debugging_details; my $sync_reader_fd; ( $sync_reader_fd, $self->{SYNC_WRITER_FD} ) = _pipe; @@ -1730,24 +1760,12 @@ sub harness { for ( shift @args ) { eval { $first_parse = 1; - _debug( - "parsing ", - defined $_ - ? ref $_ eq 'ARRAY' - ? ( '[ ', join( ', ', map "'$_'", @$_ ), ' ]' ) - : ( - ref $_ - || ( - length $_ < 50 - ? "'$_'" - : join( '', "'", substr( $_, 0, 10 ), "...'" ) - ) - ) - : '' - ) if _debugging; + _debug( "parsing ", _debugstrings($_) ) if _debugging; REPARSE: - if ( ref eq 'ARRAY' || ( !$cur_kid && ref eq 'CODE' ) ) { + if ( ref eq 'ARRAY' + || UNIVERSAL::isa( $_, 'IPC::Run::Win32Process' ) + || ( !$cur_kid && ref eq 'CODE' ) ) { croak "Process control symbol ('|', '&') missing" if $cur_kid; croak "Can't spawn a subroutine on Win32" if Win32_MODE && ref eq "CODE"; @@ -2077,7 +2095,7 @@ sub _open_pipes { ## Loop through the kids and their OPS, interpreting any that require ## parent-side actions. for my $kid ( @{ $self->{KIDS} } ) { - unless ( ref $kid->{VAL} eq 'CODE' ) { + if ( ref $kid->{VAL} eq 'ARRAY' ) { $kid->{PATH} = _search_path $kid->{VAL}->[0]; } if ( defined $pipe_read_fd ) { @@ -2789,14 +2807,8 @@ sub start { { my $ofh = select STDERR; my $of = $|; $| = 1; $| = $of; select $ofh; } for my $kid ( @{ $self->{KIDS} } ) { $kid->{RESULT} = undef; - _debug "child: ", - ref( $kid->{VAL} ) eq "CODE" - ? "CODE ref" - : ( - "`", - join( " ", map /[^\w.-]/ ? "'$_'" : $_, @{ $kid->{VAL} } ), - "`" - ) if _debugging_details; + _debug "child: ", _debugstrings( $kid->{VAL} ) + if _debugging_details; eval { croak "simulated failure of fork" if $self->{_simulate_fork_failure}; @@ -2807,17 +2819,20 @@ sub start { ## TODO: Test and debug spawning code. Someday. _debug( 'spawning ', - join( - ' ', - map( "'$_'", - ( $kid->{PATH}, @{ $kid->{VAL} }[ 1 .. $#{ $kid->{VAL} } ] ) ) + _debugstrings( + [ + $kid->{PATH}, + @{ $kid->{VAL} }[ 1 .. $#{ $kid->{VAL} } ] + ] ) - ) if _debugging; + ) if $kid->{PATH} && _debugging; ## The external kid wouldn't know what to do with it anyway. ## This is only used by the "helper" pump processes on Win32. _dont_inherit( $self->{DEBUG_FD} ); ( $kid->{PID}, $kid->{PROCESS} ) = IPC::Run::Win32Helper::win32_spawn( - [ $kid->{PATH}, @{ $kid->{VAL} }[ 1 .. $#{ $kid->{VAL} } ] ], + ref( $kid->{VAL} ) eq "ARRAY" + ? [ $kid->{PATH}, @{ $kid->{VAL} }[ 1 .. $#{ $kid->{VAL} } ] ] + : $kid->{VAL}, $kid->{OPS}, ); _debug "spawn() = ", $kid->{PID} if _debugging; @@ -4170,8 +4185,8 @@ rules|https://docs.microsoft.com/en-us/cpp/cpp/main-function-command-line-args#p will see an C that matches the array reference specifying the command. Some programs use different rules to parse their command line. Notable examples include F, F, and Cygwin programs called from non-Cygwin -programs. Use L, not IPC::Run, to call these and other -nonstandard programs. +programs. Use L to call these and other nonstandard +programs. =item batch files diff --git a/lib/IPC/Run/Win32Helper.pm b/lib/IPC/Run/Win32Helper.pm index a1298b9..0f14847 100644 --- a/lib/IPC/Run/Win32Helper.pm +++ b/lib/IPC/Run/Win32Helper.pm @@ -409,7 +409,11 @@ sub win32_spawn { my ( $app, $cmd_line ); my $need_pct = 0; - if ( $cmd->[0] !~ /\.(bat|cmd) *$/i ) { + if ( UNIVERSAL::isa( $cmd, 'IPC::Run::Win32Process' ) ) { + $app = $cmd->{lpApplicationName}; + $cmd_line = $cmd->{lpCommandLine}; + } + elsif ( $cmd->[0] !~ /\.(bat|cmd) *$/i ) { $app = $cmd->[0]; $cmd_line = Win32::ShellQuote::quote_native(@$cmd); } diff --git a/lib/IPC/Run/Win32Process.pm b/lib/IPC/Run/Win32Process.pm new file mode 100644 index 0000000..407f76f --- /dev/null +++ b/lib/IPC/Run/Win32Process.pm @@ -0,0 +1,80 @@ +package IPC::Run::Win32Process; + +=pod + +=head1 NAME + +IPC::Run::Win32Process -- deliver nonstandard command lines via IPC::Run. + +=head1 SYNOPSIS + + use File::Spec (); + use IPC::Run qw(run); + use IPC::Run::Win32Process (); + use Win32 (); + + $find_exe = File::Spec->catfile(Win32::GetFolderPath(Win32::CSIDL_SYSTEM), + 'find.exe'); + run(IPC::Run::Win32Process->new($ENV{COMSPEC}, q{cmd.exe /c echo ""}), + '|', IPC::Run::Win32Process->new($find_exe, q{find_exe """"""}), + '>', \$out); + +=head1 DESCRIPTION + +This class facilitates executing Windows programs that don't use L. +Notable programs having nonstandard rules include F, F, +and Cygwin programs called from non-Cygwin programs. IPC::Run will use the two +strings, verbatim, as the lpApplicationName and lpCommandLine arguments of +CreateProcessA(). This furnishes unfiltered control over the child process +command line. + +=head1 FUNCTIONS & METHODS + +=over + +=cut + +use strict; +use warnings; +use Carp; + +use overload '""' => sub { + my ($self) = @_; + return join( + '', + 'IPC::Run::Win32Process(', + $self->{lpApplicationName}, + ', ', + $self->{lpCommandLine}, + ')' + ); +}; + +=item new + + IPC::Run::Win32Process->new( $lpApplicationName, $lpCommandLine ); + IPC::Run::Win32Process->new( $ENV{COMSPEC}, q{cmd.exe /c echo ""} ); + +Constructor. + +=back + +=cut + +sub new { + my ( $class, $lpApplicationName, $lpCommandLine ) = @_; + $class = ref $class || $class; + + croak "missing lpApplicationName" if !defined $lpApplicationName; + croak "missing lpCommandLine" if !defined $lpCommandLine; + + my IPC::Run::Win32Process $self = bless {}, $class; + $self->{lpApplicationName} = $lpApplicationName; + $self->{lpCommandLine} = $lpCommandLine; + + return $self; +} + +1; diff --git a/t/run.t b/t/run.t index 578c110..70b64d0 100644 --- a/t/run.t +++ b/t/run.t @@ -38,7 +38,7 @@ sub get_warnings { select STDERR; select STDOUT; -use Test::More tests => 286; +use Test::More tests => 288; use IPC::Run::Debug qw( _map_fds ); use IPC::Run qw( :filters :filter_imp start ); @@ -344,6 +344,36 @@ SKIP: { chdir $initial_cwd; } +## +## IPC::Run::Win32Process +## +SKIP: { + if ( !IPC::Run::Win32_MODE() ) { + skip( "cmd.exe is specific to Win32", 2 ); + } + + use File::Spec (); + require Win32; + require IPC::Run::Win32Process; + + run( + IPC::Run::Win32Process->new( $ENV{COMSPEC}, q{cmd.exe /c echo ""} ), + '>', \$out + ); + eok( $out, qq{""\n} ); + + my $find_exe = File::Spec->catfile( + Win32::GetFolderPath( Win32::CSIDL_SYSTEM() ), + 'find.exe' + ); + run( + IPC::Run::Win32Process->new( $ENV{COMSPEC}, q{cmd.exe /c echo ""} ), + '|', IPC::Run::Win32Process->new( $find_exe, q{find_exe """"""} ), + '>', \$out + ); + eok( $out, qq{""\n} ); +} + ## ## A function ## diff --git a/xt/98_pod_coverage.t b/xt/98_pod_coverage.t index f7adffe..6fbc167 100644 --- a/xt/98_pod_coverage.t +++ b/xt/98_pod_coverage.t @@ -25,15 +25,16 @@ foreach my $MODULE (@MODULES) { : plan( skip_all => "$MODULE not available for testing" ); } } -plan tests => 7; +plan tests => 8; #my $private_subs = { private => [qr/foo_fizz/]}; #pod_coverage_ok('IPC::Run', $private_subs, "Test IPC::Run that all modules are documented."); -pod_coverage_ok( 'IPC::Run', "Test IPC::Run that all modules are documented." ); -pod_coverage_ok( 'IPC::Run::Debug', "Test IPC::Run::Debug that all modules are documented." ); -pod_coverage_ok( 'IPC::Run::IO', "Test IPC::Run::IO that all modules are documented." ); -pod_coverage_ok( 'IPC::Run::Timer', "Test IPC::Run::Timer that all modules are documented." ); +pod_coverage_ok( 'IPC::Run', "Test IPC::Run that all modules are documented." ); +pod_coverage_ok( 'IPC::Run::Debug', "Test IPC::Run::Debug that all modules are documented." ); +pod_coverage_ok( 'IPC::Run::IO', "Test IPC::Run::IO that all modules are documented." ); +pod_coverage_ok( 'IPC::Run::Timer', "Test IPC::Run::Timer that all modules are documented." ); +pod_coverage_ok( 'IPC::Run::Win32Process', "Test IPC::Run::Win32Process that all modules are documented." ); TODO: { local $TODO = "These modules are not fully documented yet."; pod_coverage_ok( 'IPC::Run::Win32Helper', "Test IPC::Run::Win32Helper that all modules are documented." ); From 36ed033ef5ef7bfe94a622d355236939d0808dd1 Mon Sep 17 00:00:00 2001 From: Noah Misch Date: Tue, 6 Jul 2021 05:04:23 -0700 Subject: [PATCH 3/3] Fix reporting of Win32::Process::Create() errors. Per its documentation, it reports via GetLastError(), not $!. --- Makefile.PL | 2 +- lib/IPC/Run/Win32Helper.pm | 7 ++++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/Makefile.PL b/Makefile.PL index 4708e3c..4cdfd52 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -16,7 +16,7 @@ if ( $^O ne 'MSWin32' ) { } } else { - $PREREQ_PM{'Win32'} = '0.27'; # for CSIDL_SYSTEM + $PREREQ_PM{'Win32'} = '0.27'; $PREREQ_PM{'Win32::Process'} = '0.14'; $PREREQ_PM{'Win32::ShellQuote'} = 0; $PREREQ_PM{'Win32API::File'} = '0.0901'; diff --git a/lib/IPC/Run/Win32Helper.pm b/lib/IPC/Run/Win32Helper.pm index 0f14847..29023da 100644 --- a/lib/IPC/Run/Win32Helper.pm +++ b/lib/IPC/Run/Win32Helper.pm @@ -523,7 +523,12 @@ sub win32_spawn { 1, ## Inherit handles 0, ## Inherit parent priortiy class. Was NORMAL_PRIORITY_CLASS ".", - ) or croak "$!: Win32::Process::Create()"; + ) + or do { + my $err = Win32::FormatMessage( Win32::GetLastError() ); + $err =~ s/\r?\n$//s; + croak "$err: Win32::Process::Create()"; + }; for my $orig_fd ( keys %saved ) { IPC::Run::_dup2_rudely( $saved{$orig_fd}, $orig_fd );