From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 25 Jun 2005 12:55:09 +0000 (+0000)
Subject: If forking during global destruction, the child needs to close all
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3125a5a42ead64ccadc87f6d7676d933d8d6582c;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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));