If forking during global destruction, the child needs to close all

unused file descriptors, else it can cause other processes to hang
because it accidentally holds open pipes and sockets.

p4raw-id: //depot/perl@24979

diff --git a/perl.c b/perl.c
index 1d2ab24..c87be80 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -505,10 +505,33 @@ perl_destruct(pTHXx)
            abort();
        }
        if (!child) {
-           int sock = fd[1];
            /* We are the child */
+
+           const int sock = fd[1];
+           const int debug_fd = PerlIO_fileno(Perl_debug_log);
+           int f;
+
            close(fd[0]);
 
+           /* We need to close all other file descriptors otherwise we end up
+              with interesting hangs, where the parent closes its end of a
+              pipe, and sits waiting for (another) child to terminate. Only
+              that child never terminates, because it never gets EOF, because
+              we also have the far end of the pipe open.  */
+
+           f = sysconf(_SC_OPEN_MAX);
+           if(f < 0) {
+               perror("Debug leaking scalars sysconf failed");
+               abort();
+           }
+           while (f--) {
+               if (f == sock)
+                   continue;
+               if (f == debug_fd)
+                   continue;
+               close(f);
+           }
+
            while (1) {
                SV *target;
                ssize_t got = read(sock, &target, sizeof(target));