diff -Nru libipc-run-perl-0.99/Changes libipc-run-perl-20180523.0/Changes --- libipc-run-perl-0.99/Changes 2018-03-30 22:45:08.000000000 +0000 +++ libipc-run-perl-20180523.0/Changes 2018-05-23 17:14:32.000000000 +0000 @@ -1,5 +1,9 @@ Revision history for Perl extension IPC::Run +20180523.0 Wed May 23 2018 + - #99 - Fix using fd in child process when it happens to be the same number in + the child as it was in the parent. + 0.99 Fri Mar 30 2018 - Fixes for windows unit tests so they skip or pass. t/autoflush.t diff -Nru libipc-run-perl-0.99/debian/changelog libipc-run-perl-20180523.0/debian/changelog --- libipc-run-perl-0.99/debian/changelog 2018-04-02 14:08:50.000000000 +0000 +++ libipc-run-perl-20180523.0/debian/changelog 2018-05-23 19:35:49.000000000 +0000 @@ -1,3 +1,10 @@ +libipc-run-perl (20180523.0-1) unstable; urgency=medium + + * Import upstream version 20180523.0 + * Declare compliance with Debian policy 4.1.4 + + -- Salvatore Bonaccorso Wed, 23 May 2018 21:35:49 +0200 + libipc-run-perl (0.99-1) unstable; urgency=medium * Import upstream version 0.99. diff -Nru libipc-run-perl-0.99/debian/control libipc-run-perl-20180523.0/debian/control --- libipc-run-perl-0.99/debian/control 2018-04-02 14:08:50.000000000 +0000 +++ libipc-run-perl-20180523.0/debian/control 2018-05-23 19:35:49.000000000 +0000 @@ -10,7 +10,7 @@ libreadonly-perl, netbase, perl -Standards-Version: 4.1.3 +Standards-Version: 4.1.4 Vcs-Browser: https://salsa.debian.org/perl-team/modules/packages/libipc-run-perl Vcs-Git: https://salsa.debian.org/perl-team/modules/packages/libipc-run-perl.git Homepage: https://metacpan.org/release/IPC-Run diff -Nru libipc-run-perl-0.99/lib/IPC/Run/Debug.pm libipc-run-perl-20180523.0/lib/IPC/Run/Debug.pm --- libipc-run-perl-0.99/lib/IPC/Run/Debug.pm 2018-03-30 22:45:48.000000000 +0000 +++ libipc-run-perl-20180523.0/lib/IPC/Run/Debug.pm 2018-05-23 17:13:43.000000000 +0000 @@ -71,7 +71,7 @@ use vars qw{$VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS}; BEGIN { - $VERSION = '0.99'; + $VERSION = '20180523.0'; @ISA = qw( Exporter ); @EXPORT = qw( _debug diff -Nru libipc-run-perl-0.99/lib/IPC/Run/IO.pm libipc-run-perl-20180523.0/lib/IPC/Run/IO.pm --- libipc-run-perl-0.99/lib/IPC/Run/IO.pm 2018-03-30 22:45:48.000000000 +0000 +++ libipc-run-perl-20180523.0/lib/IPC/Run/IO.pm 2018-05-23 17:13:43.000000000 +0000 @@ -73,7 +73,7 @@ use vars qw{$VERSION}; BEGIN { - $VERSION = '0.99'; + $VERSION = '20180523.0'; if (Win32_MODE) { eval "use IPC::Run::Win32Helper; require IPC::Run::Win32IO; 1" or ( $@ && die ) diff -Nru libipc-run-perl-0.99/lib/IPC/Run/Timer.pm libipc-run-perl-20180523.0/lib/IPC/Run/Timer.pm --- libipc-run-perl-0.99/lib/IPC/Run/Timer.pm 2018-03-30 22:45:48.000000000 +0000 +++ libipc-run-perl-20180523.0/lib/IPC/Run/Timer.pm 2018-05-23 17:13:43.000000000 +0000 @@ -166,7 +166,7 @@ use vars qw( $VERSION @ISA @EXPORT_OK %EXPORT_TAGS ); BEGIN { - $VERSION = '0.99'; + $VERSION = '20180523.0'; @ISA = qw( Exporter ); @EXPORT_OK = qw( check diff -Nru libipc-run-perl-0.99/lib/IPC/Run/Win32Helper.pm libipc-run-perl-20180523.0/lib/IPC/Run/Win32Helper.pm --- libipc-run-perl-0.99/lib/IPC/Run/Win32Helper.pm 2018-03-30 22:45:48.000000000 +0000 +++ libipc-run-perl-20180523.0/lib/IPC/Run/Win32Helper.pm 2018-05-23 17:13:43.000000000 +0000 @@ -25,7 +25,7 @@ use vars qw{ $VERSION @ISA @EXPORT }; BEGIN { - $VERSION = '0.99'; + $VERSION = '20180523.0'; @ISA = qw( Exporter ); @EXPORT = qw( win32_spawn diff -Nru libipc-run-perl-0.99/lib/IPC/Run/Win32IO.pm libipc-run-perl-20180523.0/lib/IPC/Run/Win32IO.pm --- libipc-run-perl-0.99/lib/IPC/Run/Win32IO.pm 2018-03-30 22:45:48.000000000 +0000 +++ libipc-run-perl-20180523.0/lib/IPC/Run/Win32IO.pm 2018-05-23 17:13:43.000000000 +0000 @@ -32,7 +32,7 @@ use vars qw{$VERSION}; BEGIN { - $VERSION = '0.99'; + $VERSION = '20180523.0'; } use Socket qw( IPPROTO_TCP TCP_NODELAY ); diff -Nru libipc-run-perl-0.99/lib/IPC/Run/Win32Pump.pm libipc-run-perl-20180523.0/lib/IPC/Run/Win32Pump.pm --- libipc-run-perl-0.99/lib/IPC/Run/Win32Pump.pm 2018-03-30 22:45:48.000000000 +0000 +++ libipc-run-perl-20180523.0/lib/IPC/Run/Win32Pump.pm 2018-05-23 17:13:43.000000000 +0000 @@ -30,7 +30,7 @@ use vars qw{$VERSION}; BEGIN { - $VERSION = '0.99'; + $VERSION = '20180523.0'; } use Win32API::File qw( diff -Nru libipc-run-perl-0.99/lib/IPC/Run.pm libipc-run-perl-20180523.0/lib/IPC/Run.pm --- libipc-run-perl-0.99/lib/IPC/Run.pm 2018-03-30 22:45:48.000000000 +0000 +++ libipc-run-perl-20180523.0/lib/IPC/Run.pm 2018-05-23 17:13:43.000000000 +0000 @@ -74,7 +74,7 @@ # Create pipes for you to read / write (like IPC::Open2 & 3). $h = start \@cat, - 'pipe', \*OUT, '2>pipe', \*ERR or die "cat returned $?"; @@ -725,7 +725,7 @@ these operators (and only these). H: \*HANDLE or IO::Handle for caller to open, and close N: "file name". - P: \*HANDLE opened by IPC::Run as the parent end of a pipe, but read + P: \*HANDLE or lexical filehandle opened by IPC::Run as the parent end of a pipe, but read and written to and closed by the caller (like IPC::Open3). =over @@ -1015,7 +1015,7 @@ use vars qw{$VERSION @ISA @FILTER_IMP @FILTERS @API @EXPORT_OK %EXPORT_TAGS}; BEGIN { - $VERSION = '0.99'; + $VERSION = '20180523.0'; @ISA = qw{ Exporter }; ## We use @EXPORT for the end user's convenience: there's only one function @@ -1256,7 +1256,7 @@ croak "$!: dup( $_[0] )" unless defined $r; $r = 0 if $r eq '0 but true'; _debug "dup( $_[0] ) = $r" if _debugging_details; - $fds{$r} = 1; + $fds{$r} = {}; return $r; } @@ -1266,7 +1266,7 @@ croak "$!: dup2( $_[0], $_[1] )" unless defined $r; $r = 0 if $r eq '0 but true'; _debug "dup2( $_[0], $_[1] ) = $r" if _debugging_details; - $fds{$r} = 1; + $fds{$r} = {}; return $r; } @@ -1309,7 +1309,7 @@ croak "$!: open( $_[0], ", sprintf( "0x%03x", $_[1] ), " )" unless defined $r; _debug "open( $_[0], ", sprintf( "0x%03x", $_[1] ), " ) = $r" if _debugging_data; - $fds{$r} = 1; + $fds{$r} = {}; return $r; } @@ -1320,7 +1320,7 @@ my ( $r, $w ) = POSIX::pipe; croak "$!: pipe()" unless defined $r; _debug "pipe() = ( $r, $w ) " if _debugging_details; - $fds{$r} = $fds{$w} = 1; + @fds{$r, $w} = ( {}, {} ); return ( $r, $w ); } @@ -1354,7 +1354,7 @@ $pty->blocking(0) or croak "$!: pty->blocking ( 0 )"; _debug "pty() = ( ", $pty->fileno, ", ", $pty->slave->fileno, " )" if _debugging_details; - $fds{ $pty->fileno } = $fds{ $pty->slave->fileno } = 1; + @fds{ $pty->fileno, $pty->slave->fileno } = ( {}, {} ); return $pty; } @@ -1683,7 +1683,7 @@ @args = ( [@_] ); } else { - @args = @_; + @args = map { !defined $_ ? bless(\$_, 'IPC::Run::Undef') : $_ } @_; } my @errs; # Accum errors, emit them when done. @@ -1913,7 +1913,14 @@ } } - $dest = shift @args; + if ( @args && ref $args[0] eq 'IPC::Run::Undef' ) { + require Symbol; + ${ $args[0] } = $dest = Symbol::gensym(); + shift @args; + } + else { + $dest = shift @args; + } _debug( 'Kid ', $cur_kid->{NUM}, "'s output fd ", $kfd, @@ -2461,9 +2468,10 @@ next unless defined $_->{TFD}; $_->{TFD} = _dup( $_->{TFD} ) if $_->{TFD} == $fd2; } - $self->{DEBUG_FD} = _dup $self->{DEBUG_FD} - if defined $self->{DEBUG_FD} && $self->{DEBUG_FD} == $fd2; - + if ( defined $self->{DEBUG_FD} && $self->{DEBUG_FD} == $fd2 ) { + $self->{DEBUG_FD} = _dup $self->{DEBUG_FD}; + $fds{$self->{DEBUG_FD}}{needed} = 1; + } _dup2_rudely( $fd1, $fd2 ); } @@ -2523,39 +2531,41 @@ ## close parent FD's first so they're out of the way. ## Don't close STDIN, STDOUT, STDERR: they should be inherited or ## overwritten below. - my @needed = $self->{noinherit} ? () : ( 1, 1, 1 ); - $needed[ $self->{SYNC_WRITER_FD} ] = 1; - $needed[ $self->{DEBUG_FD} ] = 1 if defined $self->{DEBUG_FD}; + do { $_->{needed} = 1 for @fds{0..2} } + unless $self->{noinherit}; + + $fds{$self->{SYNC_WRITER_FD}}{needed} = 1; + $fds{$self->{DEBUG_FD}}{needed} = 1 if defined $self->{DEBUG_FD}; + + $fds{$_->{TFD}}{needed} = 1 + foreach grep { defined $_->{TFD} } @{$kid->{OPS} }; - for ( @{ $kid->{OPS} } ) { - $needed[ $_->{TFD} ] = 1 if defined $_->{TFD}; - } ## TODO: use the forthcoming IO::Pty to close the terminal and ## make the first pty for this child the controlling terminal. ## This will also make it so that pty-laden kids don't cause ## other kids to lose stdin/stdout/stderr. - my @closed; + if ( %{ $self->{PTYS} } ) { ## Clean up the parent's fds. for ( keys %{ $self->{PTYS} } ) { _debug "Cleaning up parent's ptty '$_'" if _debugging_details; $self->{PTYS}->{$_}->make_slave_controlling_terminal; my $slave = $self->{PTYS}->{$_}->slave; - $closed[ $self->{PTYS}->{$_}->fileno ] = 1; + delete $fds{$self->{PTYS}->{$_}->fileno}; close $self->{PTYS}->{$_}; $self->{PTYS}->{$_} = $slave; } close_terminal; - $closed[$_] = 1 for ( 0 .. 2 ); + delete @fds{0..2}; } for my $sibling ( @{ $self->{KIDS} } ) { for ( @{ $sibling->{OPS} } ) { if ( $_->{TYPE} =~ /^.pty.$/ ) { $_->{TFD} = $self->{PTYS}->{ $_->{PTY_ID} }->fileno; - $needed[ $_->{TFD} ] = 1; + $fds{$_->{TFD}}{needed} = 1; } # for ( $_->{FD}, ( $sibling != $kid ? $_->{TFD} : () ) ) { @@ -2571,32 +2581,33 @@ ## This is crude: we have no way of keeping track of browsing all open ## fds, so we scan to a fairly high fd. _debug "open fds: ", join " ", keys %fds if _debugging_details; - for ( keys %fds ) { - if ( !$closed[$_] && !$needed[$_] ) { - _close($_); - $closed[$_] = 1; - } - } - ## Lazy closing is so the same fd (ie the same TFD value) can be dup2'ed on - ## several times. - my @lazy_close; + _close( $_ ) foreach grep { ! $fds{$_}{needed} } keys %fds; + for ( @{ $kid->{OPS} } ) { if ( defined $_->{TFD} ) { + + # we're always creating KFD + $fds{$_->{KFD}}{needed} = 1; + unless ( $_->{TFD} == $_->{KFD} ) { $self->_dup2_gently( $kid->{OPS}, $_->{TFD}, $_->{KFD} ); - push @lazy_close, $_->{TFD}; + $fds{$_->{TFD}}{lazy_close} = 1; + } else { + my $fd = _dup($_->{TFD}); + $self->_dup2_gently( $kid->{OPS}, $fd, $_->{KFD} ); + _close($fd); } } elsif ( $_->{TYPE} eq 'dup' ) { $self->_dup2_gently( $kid->{OPS}, $_->{KFD1}, $_->{KFD2} ) unless $_->{KFD1} == $_->{KFD2}; + $fds{$_->{KFD2}}{needed} = 1; } elsif ( $_->{TYPE} eq 'close' ) { for ( $_->{KFD} ) { - if ( !$closed[$_] ) { + if ( $fds{$_} ) { _close($_); - $closed[$_] = 1; $_ = undef; } } @@ -2606,12 +2617,7 @@ } } - for (@lazy_close) { - unless ( $closed[$_] ) { - _close($_); - $closed[$_] = 1; - } - } + _close( $_ ) foreach grep { $fds{$_}{lazy_close} } keys %fds; if ( ref $kid->{VAL} ne 'CODE' ) { open $s1, ">&=$self->{SYNC_WRITER_FD}" diff -Nru libipc-run-perl-0.99/META.json libipc-run-perl-20180523.0/META.json --- libipc-run-perl-0.99/META.json 2018-03-30 22:47:52.000000000 +0000 +++ libipc-run-perl-20180523.0/META.json 2018-05-23 17:22:20.000000000 +0000 @@ -10,7 +10,7 @@ ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", - "version" : "2" + "version" : 2 }, "name" : "IPC-Run", "no_index" : { @@ -55,6 +55,6 @@ "url" : "https://github.com/toddr/IPC-Run" } }, - "version" : "0.99", - "x_serialization_backend" : "JSON::PP version 2.27400_02" + "version" : "20180523.0", + "x_serialization_backend" : "JSON::PP version 2.97001" } diff -Nru libipc-run-perl-0.99/META.yml libipc-run-perl-20180523.0/META.yml --- libipc-run-perl-0.99/META.yml 2018-03-30 22:47:52.000000000 +0000 +++ libipc-run-perl-20180523.0/META.yml 2018-05-23 17:22:20.000000000 +0000 @@ -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: '0.99' +version: '20180523.0' x_serialization_backend: 'CPAN::Meta::YAML version 0.018'