From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 26 Oct 2008 18:37:35 +0000 (+0000)
Subject: Cope with brain damage in PerlIO::via, which will let you fclose() the
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d8723f436e1dd34e1353ad7e3538918033d31d15;p=p5sagit%2Fp5-mst-13.2.git

Cope with brain damage in PerlIO::via, which will let you fclose() the
same FILE * twice, thanks to it calling out to Perl space inside the
close call tree, with the underlying PerlIO * already closed, but not
unlinked.

p4raw-id: //depot/perl@34596
---

diff --git a/perlio.c b/perlio.c
index 466dd13..faf8147 100644
--- a/perlio.c
+++ b/perlio.c
@@ -3144,8 +3144,15 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
 	if (getsockopt(fd, SOL_SOCKET, SO_TYPE, (void *) &optval, &optlen) == 0)
 	    invalidate = 1;
 #endif
-	if (PerlIOUnix_refcnt_dec(fd) > 0) /* File descriptor still in use */
+	/* Test for -1, as *BSD stdio (at least) on fclose sets the FILE* such
+	   that a subsequent fileno() on it returns -1. Don't want to croak()
+	   from within PerlIOUnix_refcnt_dec() if some buggy caller code is
+	   trying to close an already closed handle which somehow it still has
+	   a reference to. (via.xs, I'm looking at you).  */
+	if (fd != -1 && PerlIOUnix_refcnt_dec(fd) > 0) {
+	    /* File descriptor still in use */
 	    invalidate = 1;
+	}
 	if (invalidate) {
 	    /* For STD* handles, don't close stdio, since we shared the FILE *, too. */
 	    if (stdio == stdin) /* Some stdios are buggy fflush-ing inputs */