Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package perl-IPC-Run for openSUSE:Factory checked in at 2022-08-25 15:33:07 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-IPC-Run (Old) and /work/SRC/openSUSE:Factory/.perl-IPC-Run.new.2083 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-IPC-Run" Thu Aug 25 15:33:07 2022 rev:38 rq:998989 version:20220807.0 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-IPC-Run/perl-IPC-Run.changes 2020-05-08 23:06:41.418026321 +0200 +++ /work/SRC/openSUSE:Factory/.perl-IPC-Run.new.2083/perl-IPC-Run.changes 2022-08-25 15:33:10.271934202 +0200 @@ -1,0 +2,32 @@ +Tue Aug 23 13:31:42 UTC 2022 - Tina M??ller <tina.muel...@suse.com> + +- Fix patch IPC-Run-0.89-path.diff (add -p0) + +------------------------------------------------------------------- +Mon Aug 8 03:09:37 UTC 2022 - Tina M??ller <timueller+p...@suse.de> + +- updated to 20220807.0 + see /usr/share/doc/packages/perl-IPC-Run/Changelog + + 20220807.0 Mon Aug 1 2022 + If your applications rely on portability to Windows, see new documentation + sections "argument-passing rules are program-specific" and "batch files". This + release fixes bugs in runs of Windows programs that use standard command line + parsing rules. Runs of non-standard programs may require changes. Notable + non-standard programs include cmd.exe, cscript.exe, and Cygwin programs. + - #140 - skip t/pty.t test on NetBSD too + - Add strict/warnings + - #142 - Follow Windows argument quoting rules + - #146 - allow win32_newlines.t to actually run + - #150 - Make t/pty.t test pass on OpenBSD. + - #148 - Support Win32 commands having nonstandard command line parsing rules + - Support executing Win32 batch files. + - Add IPC::Run::Win32Process, for delivering nonstandard command lines. + - Fix reporting of Win32::Process::Create() errors. + - #156 - On Windows, avoid hang when closing read end of pipe. + - #155 - Ignore known test failure on msys. - t/windows_search_path.t + - Avoid warning with IPCRUNDEBUG, in Windows spawned children. + - Use $^X, not 'perl', in tests. + - Thanks to the New active developer: Noah Misch! + +------------------------------------------------------------------- Old: ---- IPC-Run-20200505.0.tar.gz New: ---- IPC-Run-20220807.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-IPC-Run.spec ++++++ --- /var/tmp/diff_new_pack.7bV5Yb/_old 2022-08-25 15:33:10.767935285 +0200 +++ /var/tmp/diff_new_pack.7bV5Yb/_new 2022-08-25 15:33:10.771935294 +0200 @@ -1,7 +1,7 @@ # # spec file for package perl-IPC-Run # -# Copyright (c) 2020 SUSE LLC +# Copyright (c) 2022 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -16,19 +16,17 @@ # +%define cpan_name IPC-Run Name: perl-IPC-Run -Version: 20200505.0 +Version: 20220807.0 Release: 0 -%define cpan_name IPC-Run -Summary: System() and background procs w/ piping, redirs, ptys (Unix, Win32) License: Artistic-1.0 OR GPL-1.0-or-later -Group: Development/Libraries/Perl +Summary: System() and background procs w/ piping, redirs, ptys (Unix, Win32) URL: https://metacpan.org/release/%{cpan_name} Source0: https://cpan.metacpan.org/authors/id/T/TO/TODDR/%{cpan_name}-%{version}.tar.gz Source1: cpanspec.yml Patch0: IPC-Run-0.89-path.diff BuildArch: noarch -BuildRoot: %{_tmppath}/%{name}-%{version}-build BuildRequires: perl BuildRequires: perl-macros BuildRequires: perl(IO::Pty) >= 1.08 @@ -51,9 +49,8 @@ DOS command lines are provided. %prep -%setup -q -n %{cpan_name}-%{version} +%autosetup -n %{cpan_name}-%{version} -p0 find . -type f ! -path "*/t/*" ! -name "*.pl" ! -path "*/bin/*" ! -path "*/script/*" ! -name "configure" -print0 | xargs -0 chmod 644 -%patch0 # MANUAL BEGIN # run.t sometimes fails with "Resource temporarily unavailable" mv t/run.t t/run.tt @@ -61,7 +58,7 @@ %build perl Makefile.PL INSTALLDIRS=vendor -make %{?_smp_mflags} +%make_build %check make test @@ -72,7 +69,6 @@ %perl_gen_filelist %files -f %{name}.files -%defattr(-,root,root,755) %doc Changelog README.md %license LICENSE ++++++ IPC-Run-20200505.0.tar.gz -> IPC-Run-20220807.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/Changelog new/IPC-Run-20220807.0/Changelog --- old/IPC-Run-20200505.0/Changelog 2020-05-05 22:50:42.000000000 +0200 +++ new/IPC-Run-20220807.0/Changelog 2022-08-07 14:48:02.000000000 +0200 @@ -1,5 +1,25 @@ Revision history for Perl extension IPC::Run +20220807.0 Mon Aug 1 2022 + If your applications rely on portability to Windows, see new documentation + sections "argument-passing rules are program-specific" and "batch files". This + release fixes bugs in runs of Windows programs that use standard command line + parsing rules. Runs of non-standard programs may require changes. Notable + non-standard programs include cmd.exe, cscript.exe, and Cygwin programs. + - #140 - skip t/pty.t test on NetBSD too + - Add strict/warnings + - #142 - Follow Windows argument quoting rules + - #146 - allow win32_newlines.t to actually run + - #150 - Make t/pty.t test pass on OpenBSD. + - #148 - Support Win32 commands having nonstandard command line parsing rules + - Support executing Win32 batch files. + - Add IPC::Run::Win32Process, for delivering nonstandard command lines. + - Fix reporting of Win32::Process::Create() errors. + - #156 - On Windows, avoid hang when closing read end of pipe. + - #155 - Ignore known test failure on msys. - t/windows_search_path.t + - Avoid warning with IPCRUNDEBUG, in Windows spawned children. + - Use $^X, not 'perl', in tests. + - Thanks to the New active developer: Noah Misch! 20200505.0 Tue May 5 2020 - #125 - Fix syntax errors in POD examples diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/MANIFEST new/IPC-Run-20220807.0/MANIFEST --- old/IPC-Run-20200505.0/MANIFEST 2020-05-05 22:52:20.000000000 +0200 +++ new/IPC-Run-20220807.0/MANIFEST 2022-08-07 14:49:27.000000000 +0200 @@ -16,6 +16,7 @@ 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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/META.json new/IPC-Run-20220807.0/META.json --- old/IPC-Run-20200505.0/META.json 2020-05-05 22:52:20.000000000 +0200 +++ new/IPC-Run-20220807.0/META.json 2022-08-07 14:49:27.000000000 +0200 @@ -4,7 +4,7 @@ "Barrie Slaymaker <barr...@slaysys.com>" ], "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", + "generated_by" : "ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], @@ -55,6 +55,6 @@ "url" : "https://github.com/toddr/IPC-Run"; } }, - "version" : "20200505.0", - "x_serialization_backend" : "JSON::PP version 4.02" + "version" : "20220807.0", + "x_serialization_backend" : "JSON::PP version 4.07" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/META.yml new/IPC-Run-20220807.0/META.yml --- old/IPC-Run-20200505.0/META.yml 2020-05-05 22:52:20.000000000 +0200 +++ new/IPC-Run-20220807.0/META.yml 2022-08-07 14:49:27.000000000 +0200 @@ -9,7 +9,7 @@ configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010' +generated_by: 'ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -29,5 +29,5 @@ bugtracker: https://github.com/toddr/IPC-Run/issues license: http://dev.perl.org/licenses/ repository: https://github.com/toddr/IPC-Run -version: '20200505.0' +version: '20220807.0' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/Makefile.PL new/IPC-Run-20220807.0/Makefile.PL --- old/IPC-Run-20200505.0/Makefile.PL 2018-09-25 00:32:51.000000000 +0200 +++ new/IPC-Run-20220807.0/Makefile.PL 2022-08-01 18:37:07.000000000 +0200 @@ -1,3 +1,6 @@ +use strict; +use warnings; + use ExtUtils::MakeMaker; # Calculate the dependencies @@ -13,8 +16,10 @@ } } else { - $PREREQ_PM{'Win32::Process'} = '0.14'; - $PREREQ_PM{'Win32API::File'} = '0.0901'; + $PREREQ_PM{'Win32'} = '0.27'; + $PREREQ_PM{'Win32::Process'} = '0.14'; + $PREREQ_PM{'Win32::ShellQuote'} = 0; + $PREREQ_PM{'Win32API::File'} = '0.0901'; if ( $] >= 5.021006 ) { $PREREQ_PM{'Win32API::File'} = '0.1203'; } @@ -56,7 +61,7 @@ VERSION_FROM => 'lib/IPC/Run.pm', ( $ExtUtils::MakeMaker::VERSION >= 6.3002 ? ( 'LICENSE' => 'perl', ) : () ), PREREQ_PM => { - Test::More => '0.47', + 'Test::More' => '0.47', %PREREQ_PM, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/lib/IPC/Run/Debug.pm new/IPC-Run-20220807.0/lib/IPC/Run/Debug.pm --- old/IPC-Run-20200505.0/lib/IPC/Run/Debug.pm 2020-05-05 22:51:22.000000000 +0200 +++ new/IPC-Run-20220807.0/lib/IPC/Run/Debug.pm 2022-08-07 14:48:02.000000000 +0200 @@ -67,11 +67,12 @@ ## it can be suppressed by "use IPC::Run ();". use strict; +use warnings; use Exporter; use vars qw{$VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS}; BEGIN { - $VERSION = '20200505.0'; + $VERSION = '20220807.0'; @ISA = qw( Exporter ); @EXPORT = qw( _debug @@ -236,7 +237,9 @@ " ", join( "", - defined $IPC::Run::cur_self ? "#$IPC::Run::cur_self->{ID}" : (), + defined $IPC::Run::cur_self && defined $IPC::Run::cur_self->{ID} + ? "#$IPC::Run::cur_self->{ID}" + : (), "($$)", ), defined $debug_name && length $debug_name ? $debug_name : (), diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/lib/IPC/Run/IO.pm new/IPC-Run-20220807.0/lib/IPC/Run/IO.pm --- old/IPC-Run-20200505.0/lib/IPC/Run/IO.pm 2020-05-05 22:51:22.000000000 +0200 +++ new/IPC-Run-20220807.0/lib/IPC/Run/IO.pm 2022-08-07 14:48:02.000000000 +0200 @@ -63,6 +63,7 @@ ## at some point. Don't know how far how fast. use strict; +use warnings; use Carp; use Fcntl; use Symbol; @@ -73,7 +74,7 @@ use vars qw{$VERSION}; BEGIN { - $VERSION = '20200505.0'; + $VERSION = '20220807.0'; if (Win32_MODE) { eval "use IPC::Run::Win32Helper; require IPC::Run::Win32IO; 1" or ( $@ && die ) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/lib/IPC/Run/Timer.pm new/IPC-Run-20220807.0/lib/IPC/Run/Timer.pm --- old/IPC-Run-20200505.0/lib/IPC/Run/Timer.pm 2020-05-05 22:51:22.000000000 +0200 +++ new/IPC-Run-20220807.0/lib/IPC/Run/Timer.pm 2022-08-07 14:48:02.000000000 +0200 @@ -158,6 +158,7 @@ =cut use strict; +use warnings; use Carp; use Fcntl; use Symbol; @@ -166,7 +167,7 @@ use vars qw( $VERSION @ISA @EXPORT_OK %EXPORT_TAGS ); BEGIN { - $VERSION = '20200505.0'; + $VERSION = '20220807.0'; @ISA = qw( Exporter ); @EXPORT_OK = qw( check diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/lib/IPC/Run/Win32Helper.pm new/IPC-Run-20220807.0/lib/IPC/Run/Win32Helper.pm --- old/IPC-Run-20200505.0/lib/IPC/Run/Win32Helper.pm 2020-05-05 22:51:22.000000000 +0200 +++ new/IPC-Run-20220807.0/lib/IPC/Run/Win32Helper.pm 2022-08-07 14:48:02.000000000 +0200 @@ -20,12 +20,13 @@ =cut use strict; +use warnings; use Carp; use IO::Handle; use vars qw{ $VERSION @ISA @EXPORT }; BEGIN { - $VERSION = '20200505.0'; + $VERSION = '20220807.0'; @ISA = qw( Exporter ); @EXPORT = qw( win32_spawn @@ -37,8 +38,11 @@ require POSIX; +use File::Spec (); use Text::ParseWords; +use Win32 (); use Win32::Process; +use Win32::ShellQuote (); use IPC::Run::Debug; use Win32API::File qw( FdGetOsFHandle @@ -322,6 +326,11 @@ that "\" is *not* treated as an escape except when it precedes punctuation, since it's used all over the place in DOS path specs. +TODO: strip caret escapes? + +TODO: use +https://docs.microsoft.com/en-us/cpp/cpp/main-function-command-line-args#parsing-c-command-line-arguments + TODO: globbing? probably not (it's unDOSish). TODO: shebang emulation? Probably, but perhaps that should be part @@ -398,6 +407,71 @@ sub win32_spawn { my ( $cmd, $ops ) = @_; + my ( $app, $cmd_line ); + my $need_pct = 0; + 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); + } + 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 <space> , ; 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 @@ -440,24 +514,21 @@ } } + local $ENV{ipcrunpct} = '%' if $need_pct; my $process; - my $cmd_line = join " ", map { - ( my $s = $_ ) =~ s/"/"""/g; - $s = qq{"$s"} if /[\"\s]|^$/; - $s; - } @$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 ".", - ) 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 ); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/lib/IPC/Run/Win32IO.pm new/IPC-Run-20220807.0/lib/IPC/Run/Win32IO.pm --- old/IPC-Run-20200505.0/lib/IPC/Run/Win32IO.pm 2020-05-05 22:51:22.000000000 +0200 +++ new/IPC-Run-20220807.0/lib/IPC/Run/Win32IO.pm 2022-08-07 14:48:02.000000000 +0200 @@ -24,6 +24,7 @@ =cut use strict; +use warnings; use Carp; use IO::Handle; use Socket; @@ -32,7 +33,7 @@ use vars qw{$VERSION}; BEGIN { - $VERSION = '20200505.0'; + $VERSION = '20220807.0'; } use Socket qw( IPPROTO_TCP TCP_NODELAY ); @@ -357,8 +358,11 @@ # close SAVEOUT or croak "$! closing SAVEOUT"; #### ADD # close SAVEERR or croak "$! closing SAVEERR"; #### ADD - close $stdin or croak "$! closing pumper's stdin in parent"; - close $stdout or croak "$! closing pumper's stdout in parent"; + # In case of a sleep right here, need the IPC::Run::_close() treatment. + IPC::Run::_close fileno($stdin); + close $stdin; + IPC::Run::_close fileno($stdout); + close $stdout; # Don't close $debug_fd, we need it, as do other pumpers. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/lib/IPC/Run/Win32Process.pm new/IPC-Run-20220807.0/lib/IPC/Run/Win32Process.pm --- old/IPC-Run-20200505.0/lib/IPC/Run/Win32Process.pm 1970-01-01 01:00:00.000000000 +0100 +++ new/IPC-Run-20220807.0/lib/IPC/Run/Win32Process.pm 2022-08-07 14:48:02.000000000 +0200 @@ -0,0 +1,86 @@ +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<standard +command line parsing +rules|https://docs.microsoft.com/en-us/cpp/cpp/main-function-command-line-args#parsing-c-command-line-arguments>. +Notable programs having nonstandard rules include F<cmd.exe>, F<cscript.exe>, +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}, + ')' + ); +}; + +use vars qw{$VERSION}; + +BEGIN { + $VERSION = '20220807.0'; +} + +=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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/lib/IPC/Run/Win32Pump.pm new/IPC-Run-20220807.0/lib/IPC/Run/Win32Pump.pm --- old/IPC-Run-20200505.0/lib/IPC/Run/Win32Pump.pm 2020-05-05 22:51:22.000000000 +0200 +++ new/IPC-Run-20220807.0/lib/IPC/Run/Win32Pump.pm 2022-08-07 14:48:02.000000000 +0200 @@ -27,10 +27,11 @@ =cut use strict; +use warnings; use vars qw{$VERSION}; BEGIN { - $VERSION = '20200505.0'; + $VERSION = '20220807.0'; } use Win32API::File qw( diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/lib/IPC/Run.pm new/IPC-Run-20220807.0/lib/IPC/Run.pm --- old/IPC-Run-20200505.0/lib/IPC/Run.pm 2020-05-05 22:51:22.000000000 +0200 +++ new/IPC-Run-20220807.0/lib/IPC/Run.pm 2022-08-07 14:48:02.000000000 +0200 @@ -135,7 +135,7 @@ If you need pty support, IPC::Run should work well enough most of the time, but IO::Pty is being improved, and IPC::Run will be improved to -use IO::Pty's new features when it is release. +use IO::Pty's new features when it is released. The basic problem is that the pty needs to initialize itself before the parent writes to the master pty, or the data written gets lost. So @@ -413,8 +413,8 @@ 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<IPC::Run::Win32Process> +objects. On systems supporting fork(), Perl code may be passed in as subs: run \@cmd; run \@cmd1, '|', \@cmd2; @@ -1011,11 +1011,12 @@ =cut use strict; +use warnings; use Exporter (); use vars qw{$VERSION @ISA @FILTER_IMP @FILTERS @API @EXPORT_OK %EXPORT_TAGS}; BEGIN { - $VERSION = '20200505.0'; + $VERSION = '20220807.0'; @ISA = qw{ Exporter }; ## We use @EXPORT for the end user's convenience: there's only one function @@ -1047,6 +1048,7 @@ } use strict; +use warnings; use IPC::Run::Debug; use Exporter; use Fcntl; @@ -1238,12 +1240,73 @@ 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 '<undef>'; + } + + 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. sub _close { confess 'undef' unless defined $_[0]; my $fd = $_[0] =~ /^\d+$/ ? $_[0] : fileno $_[0]; + if (Win32_MODE) { + + # Perl close() or POSIX::close() on the read end of a pipe hangs if + # another process is in a read attempt on the same pipe + # (https://github.com/Perl/perl5/issues/19963). Since IPC::Run creates + # pipes and shares them with user-defined kids, it's affected. Work + # around that by first using dup2() to replace the FD with a non-pipe. + # Unfortunately, for socket FDs, dup2() closes the SOCKET with + # CloseHandle(). CloseHandle() documentation leaves its behavior + # undefined for sockets. However, tests on Windows Server 2022 did not + # leak memory, leak ports, or reveal any other obvious trouble. + # + # No failure here is fatal. (_close() has worked that way, either due + # to a principle or just due to a history of callers passing closed + # FDs.) croak() on EMFILE would be a bad user experience. Better to + # proceed and hope that $fd is not a being-read pipe. + # + # Since start() and other user-facing methods _close() many FDs, we + # could optimize this by opening and closing the non-pipe FD just once + # per method call. The overhead of this simple approach was in the + # noise, however. + my $nul_fd = POSIX::open 'NUL'; + if ( !defined $nul_fd ) { + _debug "open( NUL ) = ERROR $!" if _debugging_details; + } + else { + my $r = POSIX::dup2( $nul_fd, $fd ); + _debug "dup2( $nul_fd, $fd ) = ERROR $!" + if _debugging_details && !defined $r; + $r = POSIX::close $nul_fd; + _debug "close( $nul_fd (NUL) ) = ERROR $!" + if _debugging_details && !defined $r; + } + } my $r = POSIX::close $fd; $r = $r ? '' : " ERROR $!"; delete $fds{$fd}; @@ -1373,6 +1436,9 @@ 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; @@ -1728,24 +1794,12 @@ for ( shift @args ) { eval { $first_parse = 1; - _debug( - "parsing ", - defined $_ - ? ref $_ eq 'ARRAY' - ? ( '[ ', join( ', ', map "'$_'", @$_ ), ' ]' ) - : ( - ref $_ - || ( - length $_ < 50 - ? "'$_'" - : join( '', "'", substr( $_, 0, 10 ), "...'" ) - ) - ) - : '<undef>' - ) 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"; @@ -2075,7 +2129,7 @@ ## 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 ) { @@ -2787,14 +2841,8 @@ { 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}; @@ -2805,20 +2853,28 @@ ## 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; + if ($self->{_sleep_after_win32_spawn}) { + sleep $self->{_sleep_after_win32_spawn}; + _debug "after sleep $self->{_sleep_after_win32_spawn}" + if _debugging; + } } }; if ($@) { @@ -4160,6 +4216,34 @@ =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<standard command line parsing +rules|https://docs.microsoft.com/en-us/cpp/cpp/main-function-command-line-args#parsing-c-command-line-arguments> +will see an C<argv> that matches the array reference specifying the command. +Some programs use different rules to parse their command line. Notable examples +include F<cmd.exe>, F<cscript.exe>, and Cygwin programs called from non-Cygwin +programs. Use L<IPC::Run::Win32Process> 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<foo.cmd> contains +C<perl %*>, C<run ['foo.cmd', @list]> will create a Perl process in which +C<@ARGV> matches C<@list>. Prepending a C<setlocal enabledelayedexpansion> line +would make the batch file malfunction, silently. Another silent-malfunction +example is C<run ['outer.bat', @list]> for F<outer.bat> containing C<foo.cmd +%*>. + =item Fails on Win9X If you want Win9X support, you'll have to debug it or fund me because I diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/adopt.t new/IPC-Run-20220807.0/t/adopt.t --- old/IPC-Run-20200505.0/t/adopt.t 2018-03-27 03:40:31.000000000 +0200 +++ new/IPC-Run-20220807.0/t/adopt.t 2020-08-07 23:46:05.000000000 +0200 @@ -9,6 +9,7 @@ =cut use strict; +use warnings; BEGIN { $| = 1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/autoflush.t new/IPC-Run-20220807.0/t/autoflush.t --- old/IPC-Run-20200505.0/t/autoflush.t 2018-03-31 00:42:38.000000000 +0200 +++ new/IPC-Run-20220807.0/t/autoflush.t 2022-08-01 18:37:07.000000000 +0200 @@ -9,7 +9,7 @@ my $flush = sprintf( "AUTOFLUSH %s: %d", select, $| ); is( $flush, "AUTOFLUSH main::STDOUT: 1", "Autoflush set" ); - IPC::Run::run( [ 'perl', '-V' ], '1>', "/dev/null", '2>', "/dev/null" ); + IPC::Run::run( [ $^X, '-V' ], '1>', "/dev/null", '2>', "/dev/null" ); $flush = sprintf( "AUTOFLUSH %s: %d", select, $| ); is( $flush, "AUTOFLUSH main::STDOUT: 1", "Autoflush still set" ); @@ -18,7 +18,7 @@ $flush = sprintf( "AUTOFLUSH %s: %d", select, $| ); is( $flush, "AUTOFLUSH main::STDOUT: 0", "Autoflush unset" ); - IPC::Run::run( [ 'perl', '-V' ], '1>', "/dev/null", '2>', "/dev/null" ); + IPC::Run::run( [ $^X, '-V' ], '1>', "/dev/null", '2>', "/dev/null" ); $flush = sprintf( "AUTOFLUSH %s: %d", select, $| ); is( $flush, "AUTOFLUSH main::STDOUT: 0", "Autoflush still unset" ); @@ -27,7 +27,7 @@ my $flush = sprintf( "AUTOFLUSH %s: %d", select, $| ); is( $flush, "AUTOFLUSH main::STDOUT: 1", "Autoflush set" ); - IPC::Run::run( [ 'perl', '-V' ], '1>', "/dev/null", '2>', "/dev/null" ); + IPC::Run::run( [ $^X, '-V' ], '1>', "/dev/null", '2>', "/dev/null" ); $flush = sprintf( "AUTOFLUSH %s: %d", select, $| ); is( $flush, "AUTOFLUSH main::STDOUT: 1", "Autoflush still set" ); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/autovivifyfh.t new/IPC-Run-20220807.0/t/autovivifyfh.t --- old/IPC-Run-20200505.0/t/autovivifyfh.t 2018-04-05 23:26:08.000000000 +0200 +++ new/IPC-Run-20220807.0/t/autovivifyfh.t 2022-08-01 18:37:07.000000000 +0200 @@ -4,7 +4,7 @@ use IPC::Run; use Test::More tests => 3; -my $h = IPC::Run::start( [ 'perl', '-le', 'for (1..10) { print $_ }' ], '>pipe', my $fh ); +my $h = IPC::Run::start( [ $^X, '-le', 'for (1..10) { print $_ }' ], '>pipe', my $fh ); ok $h; my @content = <$fh>; is_deeply \@content, [ map { "$_\n" } (1..10) ]; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/binmode.t new/IPC-Run-20220807.0/t/binmode.t --- old/IPC-Run-20200505.0/t/binmode.t 2018-03-27 03:40:31.000000000 +0200 +++ new/IPC-Run-20220807.0/t/binmode.t 2020-08-07 23:46:05.000000000 +0200 @@ -9,6 +9,7 @@ =cut use strict; +use warnings; BEGIN { $| = 1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/bogus.t new/IPC-Run-20220807.0/t/bogus.t --- old/IPC-Run-20200505.0/t/bogus.t 2018-03-27 03:40:31.000000000 +0200 +++ new/IPC-Run-20220807.0/t/bogus.t 2020-08-07 23:46:05.000000000 +0200 @@ -9,6 +9,7 @@ =cut use strict; +use warnings; BEGIN { $| = 1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/eintr.t new/IPC-Run-20220807.0/t/eintr.t --- old/IPC-Run-20200505.0/t/eintr.t 2018-03-27 03:40:31.000000000 +0200 +++ new/IPC-Run-20220807.0/t/eintr.t 2020-08-07 23:46:05.000000000 +0200 @@ -9,6 +9,7 @@ =cut use strict; +use warnings; BEGIN { $| = 1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/filter.t new/IPC-Run-20220807.0/t/filter.t --- old/IPC-Run-20200505.0/t/filter.t 2018-03-27 03:40:31.000000000 +0200 +++ new/IPC-Run-20220807.0/t/filter.t 2020-08-07 23:46:05.000000000 +0200 @@ -9,6 +9,7 @@ =cut use strict; +use warnings; BEGIN { $| = 1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/harness.t new/IPC-Run-20220807.0/t/harness.t --- old/IPC-Run-20200505.0/t/harness.t 2018-03-27 03:40:31.000000000 +0200 +++ new/IPC-Run-20220807.0/t/harness.t 2020-08-07 23:46:05.000000000 +0200 @@ -9,6 +9,7 @@ =cut use strict; +use warnings; BEGIN { $| = 1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/io.t new/IPC-Run-20220807.0/t/io.t --- old/IPC-Run-20200505.0/t/io.t 2018-03-27 03:40:31.000000000 +0200 +++ new/IPC-Run-20220807.0/t/io.t 2020-08-07 23:46:05.000000000 +0200 @@ -9,6 +9,7 @@ =cut use strict; +use warnings; BEGIN { $| = 1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/kill_kill.t new/IPC-Run-20220807.0/t/kill_kill.t --- old/IPC-Run-20200505.0/t/kill_kill.t 2018-03-27 03:40:31.000000000 +0200 +++ new/IPC-Run-20220807.0/t/kill_kill.t 2020-08-07 23:46:05.000000000 +0200 @@ -19,6 +19,7 @@ } use strict; +use warnings; use Test::More; use IPC::Run (); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/lib/Test.pm new/IPC-Run-20220807.0/t/lib/Test.pm --- old/IPC-Run-20200505.0/t/lib/Test.pm 2018-03-27 03:40:31.000000000 +0200 +++ new/IPC-Run-20220807.0/t/lib/Test.pm 2020-08-07 23:45:59.000000000 +0200 @@ -1,6 +1,7 @@ package IPC::Run::Test; use strict; +use warnings; use Test::More; use Exporter; use IPC::Run qw{ harness }; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/parallel.t new/IPC-Run-20220807.0/t/parallel.t --- old/IPC-Run-20200505.0/t/parallel.t 2018-03-27 03:40:31.000000000 +0200 +++ new/IPC-Run-20220807.0/t/parallel.t 2020-08-07 23:46:05.000000000 +0200 @@ -9,6 +9,7 @@ =cut use strict; +use warnings; BEGIN { $| = 1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/parent_and_child_fds_match.t new/IPC-Run-20220807.0/t/parent_and_child_fds_match.t --- old/IPC-Run-20200505.0/t/parent_and_child_fds_match.t 2020-05-05 22:02:43.000000000 +0200 +++ new/IPC-Run-20220807.0/t/parent_and_child_fds_match.t 2022-08-01 18:37:07.000000000 +0200 @@ -45,7 +45,7 @@ my $fh = tempfile(); ok($fh, 'opened file'); - my @command = ($0, 'child'); + my @command = ($^X, $0, 'child'); my $stdout = sub { note_output("stdout", $_); return; }; my $stderr = sub { note_output("stderr", $_); return; }; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/pty.t new/IPC-Run-20220807.0/t/pty.t --- old/IPC-Run-20200505.0/t/pty.t 2020-05-05 20:23:30.000000000 +0200 +++ new/IPC-Run-20220807.0/t/pty.t 2022-08-01 18:37:07.000000000 +0200 @@ -26,6 +26,7 @@ =cut use strict; +use warnings; BEGIN { $| = 1; @@ -103,7 +104,14 @@ ## Older Perls can't ok( a, qr// ), so I manually do that here. my $exp; -my $platform_skip = $^O =~ /(?:dragonfly|aix|freebsd|openbsd|darwin)/ ? "$^O deadlocks on this test" : ""; +my $platform_skip = $^O =~ /(?:dragonfly|aix|freebsd|openbsd|netbsd|darwin)/ ? "$^O deadlocks on this test" : ""; + +# May force opening /var/lib/sss/mc/group on some systems (see +# https://github.com/toddr/IPC-Run/issues/130) +# OpenBSD libc devname(3) opens /var/run/dev.db and keeps it open. +# As this would confuse open file descriptor checks, open it in +# advance. +{my $pty = IO::Pty->new} ## ## stdin only @@ -113,10 +121,6 @@ skip( $platform_skip, 9 ); } - # May force opening /var/lib/sss/mc/group on some systems (see - # https://github.com/toddr/IPC-Run/issues/130) - {my $pty = IO::Pty->new} - $out = 'REPLACE ME'; $? = 99; $fd_map = _map_fds; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/pump.t new/IPC-Run-20220807.0/t/pump.t --- old/IPC-Run-20200505.0/t/pump.t 2018-03-27 03:40:31.000000000 +0200 +++ new/IPC-Run-20220807.0/t/pump.t 2020-08-07 23:46:05.000000000 +0200 @@ -9,6 +9,7 @@ =cut use strict; +use warnings; BEGIN { $| = 1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/run.t new/IPC-Run-20220807.0/t/run.t --- old/IPC-Run-20200505.0/t/run.t 2018-03-27 03:40:31.000000000 +0200 +++ new/IPC-Run-20220807.0/t/run.t 2022-08-01 18:37:07.000000000 +0200 @@ -9,6 +9,7 @@ =cut use strict; +use warnings; BEGIN { $| = 1; @@ -37,7 +38,7 @@ select STDERR; select STDOUT; -use Test::More tests => 268; +use Test::More tests => 288; use IPC::Run::Debug qw( _map_fds ); use IPC::Run qw( :filters :filter_imp start ); @@ -210,6 +211,170 @@ $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}; + + 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; +} + +## +## 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 ## SKIP: { @@ -863,6 +1028,9 @@ $h = start( [ @perl, '-pe', 'BEGIN { $| = 1 } print STDERR uc($_)' ], \$in, \$out, \$err, + + # hangs w/o fix for https://github.com/toddr/IPC-Run/issues/77 + _sleep_after_win32_spawn => 1, ); isa_ok( $h, 'IPC::Run' ); is( $?, 99 ); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/run_stdin-callback-return-array.t new/IPC-Run-20220807.0/t/run_stdin-callback-return-array.t --- old/IPC-Run-20200505.0/t/run_stdin-callback-return-array.t 2018-03-30 18:13:15.000000000 +0200 +++ new/IPC-Run-20220807.0/t/run_stdin-callback-return-array.t 2022-08-07 14:47:04.000000000 +0200 @@ -10,7 +10,7 @@ my @cmd = ("true"); if ($^O eq 'MSWin32') { - @cmd = ('cmd','/C','echo','y'); + @cmd = ( $^X, '-e', 'exit 0' ); } our ( $i, @i ); my ( $in, @in ); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/signal.t new/IPC-Run-20220807.0/t/signal.t --- old/IPC-Run-20200505.0/t/signal.t 2018-03-27 03:40:31.000000000 +0200 +++ new/IPC-Run-20220807.0/t/signal.t 2020-08-07 23:46:05.000000000 +0200 @@ -9,6 +9,7 @@ =cut use strict; +use warnings; BEGIN { $| = 1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/timeout.t new/IPC-Run-20220807.0/t/timeout.t --- old/IPC-Run-20200505.0/t/timeout.t 2020-05-05 21:12:12.000000000 +0200 +++ new/IPC-Run-20220807.0/t/timeout.t 2020-08-07 23:46:05.000000000 +0200 @@ -9,6 +9,7 @@ =cut use strict; +use warnings; BEGIN { $| = 1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/timer.t new/IPC-Run-20220807.0/t/timer.t --- old/IPC-Run-20200505.0/t/timer.t 2020-05-05 21:12:39.000000000 +0200 +++ new/IPC-Run-20220807.0/t/timer.t 2020-08-07 23:46:05.000000000 +0200 @@ -9,6 +9,7 @@ =cut use strict; +use warnings; BEGIN { $| = 1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/win32_compile.t new/IPC-Run-20220807.0/t/win32_compile.t --- old/IPC-Run-20200505.0/t/win32_compile.t 2018-03-27 03:40:31.000000000 +0200 +++ new/IPC-Run-20220807.0/t/win32_compile.t 2022-08-01 18:37:07.000000000 +0200 @@ -9,6 +9,7 @@ =cut use strict; +use warnings; BEGIN { $| = 1; @@ -34,7 +35,21 @@ plan( skip_all => "android does not support getprotobyname()" ); } - $INC{$_} = 1 for qw( Win32/Process.pm Win32API/File.pm ); + $INC{$_} = 1 for qw( + 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; @@ -82,7 +97,11 @@ use Exporter; } -sub Socket::IPPROTO_TCP() { undef } +{ + use Socket (); + no warnings 'redefine'; + sub Socket::IPPROTO_TCP() { return } +} package main; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/win32_newlines.t new/IPC-Run-20220807.0/t/win32_newlines.t --- old/IPC-Run-20200505.0/t/win32_newlines.t 2020-05-05 22:44:29.000000000 +0200 +++ new/IPC-Run-20220807.0/t/win32_newlines.t 2022-08-01 18:37:07.000000000 +0200 @@ -27,7 +27,7 @@ use IPC::Run 'run'; plan skip_all => 'Skipping on Win32' if $ENV{GITHUB_WINDOWS_TESTING}; -plan skip_all => 'Skipping when not on Win32' unless $^O eq 'Win32'; +plan skip_all => 'Skipping when not on Win32' unless $^O eq 'MSWin32'; plan tests => 10; $ENV{IPC_SUB_PROCESS} = 1; @@ -36,7 +36,7 @@ $ENV{IPC_SUB_INDEX} = $i; for my $report_in ( 1, 0 ) { $ENV{IPC_SUB_PROCESS_REPORT_IN} = $report_in; - run [ "perl", __FILE__ ], "<", \$line, ">", \my $out; + run [ $^X, __FILE__ ], "<", \$line, ">", \my $out; $out = perlstring $out if not $report_in; my $print_line = perlstring $line; is $out, $print_line, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/t/windows_search_path.t new/IPC-Run-20220807.0/t/windows_search_path.t --- old/IPC-Run-20200505.0/t/windows_search_path.t 2018-03-27 03:40:31.000000000 +0200 +++ new/IPC-Run-20220807.0/t/windows_search_path.t 2022-08-01 18:37:07.000000000 +0200 @@ -31,6 +31,10 @@ touch($result); my $got = eval { IPC::Run::_search_path($path) }; + + # see https://github.com/toddr/IPC-Run/pull/155 conversation for details + local $TODO = qq{on msys noacl mounts, "-x $result" is false} + if $result =~ /BAT$/ && !-x $result; is( $@, '', "No error calling _search_path for '$path'" ); is( $got, $result, "Executable $result found" ); unlink $result; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/xt/98_pod.t new/IPC-Run-20220807.0/xt/98_pod.t --- old/IPC-Run-20200505.0/xt/98_pod.t 2020-05-05 19:19:12.000000000 +0200 +++ new/IPC-Run-20220807.0/xt/98_pod.t 2020-08-07 23:46:05.000000000 +0200 @@ -2,6 +2,7 @@ # Test that the syntax of our POD documentation is valid use strict; +use warnings; BEGIN { $| = 1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/xt/98_pod_coverage.t new/IPC-Run-20220807.0/xt/98_pod_coverage.t --- old/IPC-Run-20200505.0/xt/98_pod_coverage.t 2020-05-05 19:19:01.000000000 +0200 +++ new/IPC-Run-20220807.0/xt/98_pod_coverage.t 2022-08-01 18:37:07.000000000 +0200 @@ -2,6 +2,7 @@ # Test that the syntax of our POD documentation is valid use strict; +use warnings; BEGIN { $| = 1; @@ -24,15 +25,16 @@ : 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." ); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPC-Run-20200505.0/xt/99_perl_minimum_version.t new/IPC-Run-20220807.0/xt/99_perl_minimum_version.t --- old/IPC-Run-20200505.0/xt/99_perl_minimum_version.t 2020-05-05 19:19:26.000000000 +0200 +++ new/IPC-Run-20220807.0/xt/99_perl_minimum_version.t 2020-08-07 23:46:05.000000000 +0200 @@ -2,6 +2,7 @@ # Test that our declared minimum Perl version matches our syntax use strict; +use warnings; BEGIN { $| = 1; ++++++ cpanspec.yml ++++++ --- /var/tmp/diff_new_pack.7bV5Yb/_old 2022-08-25 15:33:10.915935608 +0200 +++ /var/tmp/diff_new_pack.7bV5Yb/_new 2022-08-25 15:33:10.919935617 +0200 @@ -6,7 +6,7 @@ # - source2 patches: # PATCH-FIX-OPENSUSE -- Fix intepreter - IPC-Run-0.89-path.diff: + IPC-Run-0.89-path.diff: -p0 preamble: |- BuildRequires: netcfg post_prep: |-
