diff --git a/lib/IPC/Run.pm b/lib/IPC/Run.pm index 6de0064..e0d363c 100644 --- a/lib/IPC/Run.pm +++ b/lib/IPC/Run.pm @@ -1273,6 +1273,40 @@ sub _empty($) { !( defined $_[0] && length $_[0] ) } 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}; @@ -2836,6 +2870,11 @@ sub start { $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 ($@) { diff --git a/lib/IPC/Run/Win32IO.pm b/lib/IPC/Run/Win32IO.pm index a62536b..31c18d1 100644 --- a/lib/IPC/Run/Win32IO.pm +++ b/lib/IPC/Run/Win32IO.pm @@ -358,8 +358,11 @@ sub _spawn_pumper { # 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 --git a/t/run.t b/t/run.t index 70b64d0..a57f7a1 100644 --- a/t/run.t +++ b/t/run.t @@ -1028,6 +1028,9 @@ $fd_map = _map_fds; $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 );