set FD_CLOEXEC atomically in easy cases

In many places where a file descriptor is being opened, open it with
FD_CLOEXEC already set if possible.  This commit covers the easy cases,
where the file descriptor arises without the use of PerlIO, pp_open,
or my_popen.

10 files changed, 153 insertions, 74 deletions

diff --git a/MANIFEST b/MANIFEST
index f93b5c0b92..c702237908 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5443,6 +5443,7 @@ t/io/sem.t			See if SysV semaphores work
 t/io/semctl.t			See if SysV semaphore semctl works
 t/io/shm.t			See if SysV shared memory works
 t/io/socket.t			See if socket functions work
+t/io/socketpair.t		See if socketpair function works
 t/io/tell.t			See if file seeking works
 t/io/through.t			See if pipe passes data intact
 t/io/utf8.t			See if file seeking works
diff --git a/doio.c b/doio.c
index 583f6d7148..160adc596a 100644
--- a/doio.c
+++ b/doio.c
@@ -60,22 +60,43 @@
 
 #include <signal.h>
 
+void
+Perl_setfd_cloexec(pTHX_ int fd)
+{
+    assert(fd >= 0);
 #if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
-#  define DO_ONESET_CLOEXEC(fd) ((void) fcntl(fd, F_SETFD, FD_CLOEXEC))
-#else
-#  define DO_ONESET_CLOEXEC(fd) ((void) 0)
+    (void) fcntl(fd, F_SETFD, FD_CLOEXEC);
+#endif
+}
+
+void
+Perl_setfd_inhexec(pTHX_ int fd)
+{
+    assert(fd >= 0);
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
+    (void) fcntl(fd, F_SETFD, 0);
 #endif
-#define DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSET_CLOEXEC) \
+}
+
+void
+Perl_setfd_inhexec_for_sysfd(pTHX_ int fd)
+{
+    assert(fd >= 0);
+    if(fd <= PL_maxsysfd)
+	setfd_inhexec(fd);
+}
+
+#define DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSETFD_CLOEXEC) \
 	do { \
 	    int res = (GENOPEN_NORMAL); \
-	    if(LIKELY(res != -1)) GENSET_CLOEXEC; \
+	    if(LIKELY(res != -1)) GENSETFD_CLOEXEC; \
 	    return res; \
 	} while(0)
 #if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC) && \
 			defined(F_GETFD)
 enum { CLOEXEC_EXPERIMENT, CLOEXEC_AT_OPEN, CLOEXEC_AFTER_OPEN };
 #  define DO_GENOPEN_EXPERIMENTING_CLOEXEC(TESTFD, GENOPEN_CLOEXEC, \
-			GENOPEN_NORMAL, GENSET_CLOEXEC) \
+			GENOPEN_NORMAL, GENSETFD_CLOEXEC) \
 	do { \
 	    static int strategy = CLOEXEC_EXPERIMENT; \
 	    switch (strategy) { \
@@ -88,14 +109,14 @@ enum { CLOEXEC_EXPERIMENT, CLOEXEC_AT_OPEN, CLOEXEC_AFTER_OPEN };
 			    strategy = CLOEXEC_AT_OPEN; \
 			} else { \
 			    strategy = CLOEXEC_AFTER_OPEN; \
-			    GENSET_CLOEXEC; \
+			    GENSETFD_CLOEXEC; \
 			} \
 		    } else if (UNLIKELY((eno = errno) == EINVAL || \
 						eno == ENOSYS)) { \
 			res = (GENOPEN_NORMAL); \
 			if (LIKELY(res != -1)) { \
 			    strategy = CLOEXEC_AFTER_OPEN; \
-			    GENSET_CLOEXEC; \
+			    GENSETFD_CLOEXEC; \
 			} else if (!LIKELY((eno = errno) == EINVAL || \
 						eno == ENOSYS)) { \
 			    strategy = CLOEXEC_AFTER_OPEN; \
@@ -106,39 +127,39 @@ enum { CLOEXEC_EXPERIMENT, CLOEXEC_AT_OPEN, CLOEXEC_AFTER_OPEN };
 		case CLOEXEC_AT_OPEN: \
 		    return (GENOPEN_CLOEXEC); \
 		case CLOEXEC_AFTER_OPEN: \
-		    DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSET_CLOEXEC); \
+		    DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSETFD_CLOEXEC); \
 	    } \
 	} while(0)
 #else
 #  define DO_GENOPEN_EXPERIMENTING_CLOEXEC(TESTFD, GENOPEN_CLOEXEC, \
-			GENOPEN_NORMAL, GENSET_CLOEXEC) \
-	DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSET_CLOEXEC)
+			GENOPEN_NORMAL, GENSETFD_CLOEXEC) \
+	DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSETFD_CLOEXEC)
 #endif
 
 #define DO_ONEOPEN_THEN_CLOEXEC(ONEOPEN_NORMAL) \
 	do { \
 	    int fd; \
 	    DO_GENOPEN_THEN_CLOEXEC(fd = (ONEOPEN_NORMAL), \
-		DO_ONESET_CLOEXEC(fd)); \
+		setfd_cloexec(fd)); \
 	} while(0)
 #define DO_ONEOPEN_EXPERIMENTING_CLOEXEC(ONEOPEN_CLOEXEC, ONEOPEN_NORMAL) \
 	do { \
 	    int fd; \
 	    DO_GENOPEN_EXPERIMENTING_CLOEXEC(fd, fd = (ONEOPEN_CLOEXEC), \
-		fd = (ONEOPEN_NORMAL), DO_ONESET_CLOEXEC(fd)); \
+		fd = (ONEOPEN_NORMAL), setfd_cloexec(fd)); \
 	} while(0)
 
-#define DO_PIPESET_CLOEXEC(PIPEFD) \
+#define DO_PIPESETFD_CLOEXEC(PIPEFD) \
 	do { \
-	    DO_ONESET_CLOEXEC((PIPEFD)[0]); \
-	    DO_ONESET_CLOEXEC((PIPEFD)[1]); \
+	    setfd_cloexec((PIPEFD)[0]); \
+	    setfd_cloexec((PIPEFD)[1]); \
 	} while(0)
 #define DO_PIPEOPEN_THEN_CLOEXEC(PIPEFD, PIPEOPEN_NORMAL) \
-	DO_GENOPEN_THEN_CLOEXEC(PIPEOPEN_NORMAL, DO_PIPESET_CLOEXEC(PIPEFD))
+	DO_GENOPEN_THEN_CLOEXEC(PIPEOPEN_NORMAL, DO_PIPESETFD_CLOEXEC(PIPEFD))
 #define DO_PIPEOPEN_EXPERIMENTING_CLOEXEC(PIPEFD, PIPEOPEN_CLOEXEC, \
 			PIPEOPEN_NORMAL) \
 	DO_GENOPEN_EXPERIMENTING_CLOEXEC((PIPEFD)[0], PIPEOPEN_CLOEXEC, \
-	    PIPEOPEN_NORMAL, DO_PIPESET_CLOEXEC(PIPEFD))
+	    PIPEOPEN_NORMAL, DO_PIPESETFD_CLOEXEC(PIPEFD))
 
 int
 Perl_PerlLIO_dup_cloexec(pTHX_ int oldfd)
diff --git a/embed.fnc b/embed.fnc
index a434bf847e..b768861089 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -464,6 +464,9 @@ Apmb	|bool	|do_open	|NN GV* gv|NN const char* name|I32 len|int as_raw \
 Ap	|bool	|do_open9	|NN GV *gv|NN const char *name|I32 len|int as_raw \
 				|int rawmode|int rawperm|NULLOK PerlIO *supplied_fp \
 				|NN SV *svs|I32 num
+p	|void	|setfd_cloexec|int fd
+p	|void	|setfd_inhexec|int fd
+p	|void	|setfd_inhexec_for_sysfd|int fd
 pR	|int	|PerlLIO_dup_cloexec|int oldfd
 pR	|int	|PerlLIO_dup2_cloexec|int oldfd|int newfd
 pR	|int	|PerlLIO_open_cloexec|NN const char *file|int flag
diff --git a/embed.h b/embed.h
index 53b54b0a44..6441f389f7 100644
--- a/embed.h
+++ b/embed.h
@@ -1382,6 +1382,9 @@
 #define set_caret_X()		Perl_set_caret_X(aTHX)
 #define set_numeric_standard()	Perl_set_numeric_standard(aTHX)
 #define set_numeric_underlying()	Perl_set_numeric_underlying(aTHX)
+#define setfd_cloexec(a)	Perl_setfd_cloexec(aTHX_ a)
+#define setfd_inhexec(a)	Perl_setfd_inhexec(aTHX_ a)
+#define setfd_inhexec_for_sysfd(a)	Perl_setfd_inhexec_for_sysfd(aTHX_ a)
 #define sub_crush_depth(a)	Perl_sub_crush_depth(aTHX_ a)
 #define sv_2num(a)		Perl_sv_2num(aTHX_ a)
 #define sv_clean_all()		Perl_sv_clean_all(aTHX)
diff --git a/pp_sys.c b/pp_sys.c
index 0649794104..c2873b8e08 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -690,8 +690,10 @@ PP(pp_pipe_op)
     if (IoIFP(wstio))
 	do_close(wgv, FALSE);
 
-    if (PerlProc_pipe(fd) < 0)
+    if (PerlProc_pipe_cloexec(fd) < 0)
 	goto badexit;
+    setfd_inhexec_for_sysfd(fd[0]);
+    setfd_inhexec_for_sysfd(fd[1]);
 
     IoIFP(rstio) = PerlIO_fdopen(fd[0], "r" PIPE_OPEN_MODE);
     IoOFP(wstio) = PerlIO_fdopen(fd[1], "w" PIPE_OPEN_MODE);
@@ -711,12 +713,6 @@ PP(pp_pipe_op)
 	    PerlLIO_close(fd[1]);
 	goto badexit;
     }
-#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
-    /* ensure close-on-exec */
-    if ((fd[0] > PL_maxsysfd && fcntl(fd[0], F_SETFD, FD_CLOEXEC) < 0) ||
-        (fd[1] > PL_maxsysfd && fcntl(fd[1], F_SETFD, FD_CLOEXEC) < 0))
-        goto badexit;
-#endif
     RETPUSHYES;
 
   badexit:
@@ -2379,7 +2375,7 @@ PP(pp_truncate)
                  */
                 mode |= O_BINARY;
 #endif
-                tmpfd = PerlLIO_open(name, mode);
+                tmpfd = PerlLIO_open_cloexec(name, mode);
 
 		if (tmpfd < 0) {
 		    result = 0;
@@ -2521,10 +2517,11 @@ PP(pp_socket)
 	do_close(gv, FALSE);
 
     TAINT_PROPER("socket");
-    fd = PerlSock_socket(domain, type, protocol);
+    fd = PerlSock_socket_cloexec(domain, type, protocol);
     if (fd < 0) {
 	RETPUSHUNDEF;
     }
+    setfd_inhexec_for_sysfd(fd);
     IoIFP(io) = PerlIO_fdopen(fd, "r" SOCKET_OPEN_MODE); /* stdio gets confused about sockets */
     IoOFP(io) = PerlIO_fdopen(fd, "w" SOCKET_OPEN_MODE);
     IoTYPE(io) = IoTYPE_SOCKET;
@@ -2534,11 +2531,6 @@ PP(pp_socket)
 	if (!IoIFP(io) && !IoOFP(io)) PerlLIO_close(fd);
 	RETPUSHUNDEF;
     }
-#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
-    /* ensure close-on-exec */
-    if (fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0)
-	RETPUSHUNDEF;
-#endif
 
     RETPUSHYES;
 }
@@ -2564,8 +2556,10 @@ PP(pp_sockpair)
 	do_close(gv2, FALSE);
 
     TAINT_PROPER("socketpair");
-    if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
+    if (PerlSock_socketpair_cloexec(domain, type, protocol, fd) < 0)
 	RETPUSHUNDEF;
+    setfd_inhexec_for_sysfd(fd[0]);
+    setfd_inhexec_for_sysfd(fd[1]);
     IoIFP(io1) = PerlIO_fdopen(fd[0], "r" SOCKET_OPEN_MODE);
     IoOFP(io1) = PerlIO_fdopen(fd[0], "w" SOCKET_OPEN_MODE);
     IoTYPE(io1) = IoTYPE_SOCKET;
@@ -2581,12 +2575,6 @@ PP(pp_sockpair)
 	if (!IoIFP(io2) && !IoOFP(io2)) PerlLIO_close(fd[1]);
 	RETPUSHUNDEF;
     }
-#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
-    /* ensure close-on-exec */
-    if ((fd[0] > PL_maxsysfd && fcntl(fd[0], F_SETFD, FD_CLOEXEC) < 0) ||
-        (fd[1] > PL_maxsysfd && fcntl(fd[1], F_SETFD, FD_CLOEXEC) < 0))
-	RETPUSHUNDEF;
-#endif
 
     RETPUSHYES;
 #else
@@ -2673,7 +2661,7 @@ PP(pp_accept)
 	goto nuts;
 
     nstio = GvIOn(ngv);
-    fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *) namebuf, &len);
+    fd = PerlSock_accept_cloexec(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *) namebuf, &len);
 #if defined(OEMVS)
     if (len == 0) {
 	/* Some platforms indicate zero length when an AF_UNIX client is
@@ -2687,6 +2675,7 @@ PP(pp_accept)
 
     if (fd < 0)
 	goto badexit;
+    setfd_inhexec_for_sysfd(fd);
     if (IoIFP(nstio))
 	do_close(ngv, FALSE);
     IoIFP(nstio) = PerlIO_fdopen(fd, "r" SOCKET_OPEN_MODE);
@@ -2698,11 +2687,6 @@ PP(pp_accept)
 	if (!IoIFP(nstio) && !IoOFP(nstio)) PerlLIO_close(fd);
 	goto badexit;
     }
-#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
-    /* ensure close-on-exec */
-    if (fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0)
-        goto badexit;
-#endif
 
 #ifdef __SCO_VERSION__
     len = sizeof (struct sockaddr_in); /* OpenUNIX 8 somehow truncates info */
@@ -4449,7 +4433,7 @@ PP(pp_system)
 	sigset_t newset, oldset;
 #endif
 
-	if (PerlProc_pipe(pp) >= 0)
+	if (PerlProc_pipe_cloexec(pp) >= 0)
 	    did_pipes = 1;
 #ifdef __amigaos4__
         amigaos_fork_set_userdata(aTHX_
@@ -4546,13 +4530,8 @@ PP(pp_system)
 #ifdef HAS_SIGPROCMASK
 	sigprocmask(SIG_SETMASK, &oldset, NULL);
 #endif
-	if (did_pipes) {
+	if (did_pipes)
 	    PerlLIO_close(pp[0]);
-#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
-	    if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0)
-                RETPUSHUNDEF;
-#endif
-	}
 	if (PL_op->op_flags & OPf_STACKED) {
 	    SV * const really = *++MARK;
 	    value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes);
diff --git a/proto.h b/proto.h
index eca26e9e1e..47e348a6f1 100644
--- a/proto.h
+++ b/proto.h
@@ -2928,6 +2928,9 @@ PERL_CALLCONV void	Perl_set_numeric_underlying(pTHX);
 PERL_CALLCONV void	Perl_setdefout(pTHX_ GV* gv);
 #define PERL_ARGS_ASSERT_SETDEFOUT	\
 	assert(gv)
+PERL_CALLCONV void	Perl_setfd_cloexec(pTHX_ int fd);
+PERL_CALLCONV void	Perl_setfd_inhexec(pTHX_ int fd);
+PERL_CALLCONV void	Perl_setfd_inhexec_for_sysfd(pTHX_ int fd);
 PERL_CALLCONV char*	Perl_setlocale(int category, const char* locale);
 PERL_CALLCONV HEK*	Perl_share_hek(pTHX_ const char* str, SSize_t len, U32 hash);
 #define PERL_ARGS_ASSERT_SHARE_HEK	\
diff --git a/t/io/pipe.t b/t/io/pipe.t
index bec1a662b9..f9ee65afe8 100644
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -10,7 +10,7 @@ if (!$Config{'d_fork'}) {
     skip_all("fork required to pipe");
 }
 else {
-    plan(tests => 24);
+    plan(tests => 25);
 }
 
 my $Perl = which_perl();
@@ -138,6 +138,18 @@ sleep 1;
 next_test;
 pass();
 
+SKIP: {
+    skip "no fcntl", 1 unless $Config{d_fcntl};
+    my($r, $w);
+    pipe($r, $w) || die "pipe: $!";
+    my $fdr = fileno($r);
+    my $fdw = fileno($w);
+    fresh_perl_is(qq(
+	print open(F, "<&=$fdr") ? 1 : 0, "\\n";
+	print open(F, ">&=$fdw") ? 1 : 0, "\\n";
+    ), "0\n0\n", {}, "pipe endpoints not inherited across exec");
+}
+
 # VMS doesn't like spawning subprocesses that are still connected to
 # STDOUT.  Someone should modify these tests to work with VMS.
 
diff --git a/t/io/socket.t b/t/io/socket.t
index bba4e4a705..952ff09742 100644
--- a/t/io/socket.t
+++ b/t/io/socket.t
@@ -46,12 +46,12 @@ my $fork = $Config{d_fork} || $Config{d_pseudofork};
 
 SKIP: {
     # test it all in TCP
-    $local or skip("No localhost", 2);
+    $local or skip("No localhost", 3);
 
     ok(socket(my $serv, PF_INET, SOCK_STREAM, $tcp), "make a tcp socket");
     my $bind_at = pack_sockaddr_in(0, $local);
     ok(bind($serv, $bind_at), "bind works")
-	or skip("Couldn't bind to localhost", 3);
+	or skip("Couldn't bind to localhost", 4);
     my $bind_name = getsockname($serv);
     ok($bind_name, "getsockname() on bound socket");
     my ($bind_port) = unpack_sockaddr_in($bind_name);
@@ -63,7 +63,7 @@ SKIP: {
 	ok(listen($serv, 5), "listen() works")
 	  or diag "listen error: $!";
 
-	$fork or skip("No fork", 1);
+	$fork or skip("No fork", 2);
 	my $pid = fork;
 	my $send_data = "test" x 50_000;
 	if ($pid) {
@@ -73,6 +73,13 @@ SKIP: {
 	    ok(my $addr = accept($accept, $serv), "accept() works")
 		or diag "accept error: $!";
             binmode $accept;
+	    SKIP: {
+		skip "no fcntl", 1 unless $Config{d_fcntl};
+		my $acceptfd = fileno($accept);
+		fresh_perl_is(qq(
+		    print open(F, "+<&=$acceptfd") ? 1 : 0, "\\n";
+		), "0\n", {}, "accepted socket not inherited across exec");
+	    }
 	    my $sent_total = 0;
 	    while ($sent_total < length $send_data) {
 		my $sent = send($accept, substr($send_data, $sent_total), 0);
@@ -91,7 +98,7 @@ SKIP: {
 	    ok($shutdown, "shutdown() works");
 	}
 	elsif (defined $pid) {
-	    curr_test(curr_test()+2);
+	    curr_test(curr_test()+3);
 	    #sleep 1;
 	    # child
 	    ok_child(close($serv), "close server socket in child");
@@ -123,7 +130,7 @@ SKIP: {
 	else {
 	    # failed to fork
 	    diag "fork() failed $!";
-	    skip("fork() failed", 1);
+	    skip("fork() failed", 2);
 	}
     }
 }
@@ -162,6 +169,16 @@ SKIP:
     ok('RT #7614: still alive after accept($sock, $sock)');
 }
 
+SKIP: {
+    skip "no fcntl", 1 unless $Config{d_fcntl};
+    my $sock;
+    socket($sock, PF_INET, SOCK_STREAM, $tcp) or die "socket: $!";
+    my $sockfd = fileno($sock);
+    fresh_perl_is(qq(
+	print open(F, "+<&=$sockfd") ? 1 : 0, "\\n";
+    ), "0\n", {}, "fresh socket not inherited across exec");
+}
+
 done_testing();
 
 my @child_tests;
diff --git a/t/io/socketpair.t b/t/io/socketpair.t
new file mode 100644
index 0000000000..a80e411d7d
--- /dev/null
+++ b/t/io/socketpair.t
@@ -0,0 +1,51 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    require Config; import Config;
+    require './test.pl';
+    set_up_inc('../lib');
+    skip_all_if_miniperl();
+    for my $needed (qw(d_socket)) {
+	if ($Config{$needed} ne 'define') {
+	    skip_all("-- \$Config{$needed} undefined");
+	}
+    }
+    unless ($Config{extensions} =~ /\bSocket\b/) {
+	skip_all('-- Socket not available');
+    }
+}
+
+use strict;
+use IO::Handle;
+use Socket;
+
+{
+    socketpair(my $a, my $b, PF_UNIX, SOCK_STREAM, 0)
+	or skip_all("socketpair() for PF_UNIX failed ($!)");
+}
+
+plan(tests => 8);
+
+{
+    my($a, $b);
+    ok socketpair($a, $b, PF_UNIX, SOCK_STREAM, 0), "create socket pair";
+    ok($a->printflush("aa\n"), "write one way");
+    ok($b->printflush("bb\n"), "write other way");
+    is(readline($b), "aa\n", "read one way");
+    is(readline($a), "bb\n", "read other way");
+    ok(close $a, "close one end");
+    ok(close $b, "close other end");
+}
+
+SKIP: {
+    skip "no fcntl", 1 unless $Config{d_fcntl};
+    my($a, $b);
+    socketpair($a, $b, PF_UNIX, SOCK_STREAM, 0) or die "socketpair: $!";
+    my $fda = fileno($a);
+    my $fdb = fileno($b);
+    fresh_perl_is(qq(
+	print open(F, "+<&=$fda") ? 1 : 0, "\\n";
+	print open(F, "+<&=$fdb") ? 1 : 0, "\\n";
+    ), "0\n0\n", {}, "sockets not inherited across exec");
+}
diff --git a/util.c b/util.c
index d96d53312c..91ef4ec093 100644
--- a/util.c
+++ b/util.c
@@ -2241,7 +2241,7 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args)
     if (PerlProc_pipe(p) < 0)
 	return NULL;
     /* Try for another pipe pair for error return */
-    if (PerlProc_pipe(pp) >= 0)
+    if (PerlProc_pipe_cloexec(pp) >= 0)
 	did_pipes = 1;
     while ((pid = PerlProc_fork()) < 0) {
 	if (errno != EAGAIN) {
@@ -2263,14 +2263,8 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args)
 #define THIS that
 #define THAT This
 	/* Close parent's end of error status pipe (if any) */
-	if (did_pipes) {
+	if (did_pipes)
 	    PerlLIO_close(pp[0]);
-#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
-	    /* Close error pipe automatically if exec works */
-	    if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0)
-                return NULL;
-#endif
-	}
 	/* Now dup our end of _the_ pipe to right position */
 	if (p[THIS] != (*mode == 'r')) {
 	    PerlLIO_dup2(p[THIS], *mode == 'r');
@@ -2386,7 +2380,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
     }
     if (PerlProc_pipe(p) < 0)
 	return NULL;
-    if (doexec && PerlProc_pipe(pp) >= 0)
+    if (doexec && PerlProc_pipe_cloexec(pp) >= 0)
 	did_pipes = 1;
     while ((pid = PerlProc_fork()) < 0) {
 	if (errno != EAGAIN) {
@@ -2409,13 +2403,8 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
 #undef THAT
 #define THIS that
 #define THAT This
-	if (did_pipes) {
+	if (did_pipes)
 	    PerlLIO_close(pp[0]);
-#if defined(HAS_FCNTL) && defined(F_SETFD)
-            if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0)
-                return NULL;
-#endif
-	}
 	if (p[THIS] != (*mode == 'r')) {
 	    PerlLIO_dup2(p[THIS], *mode == 'r');
 	    PerlLIO_close(p[THIS]);
@@ -4443,7 +4432,7 @@ Perl_seed(pTHX)
 #    define PERL_RANDOM_DEVICE "/dev/urandom"
 #  endif
 #endif
-    fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
+    fd = PerlLIO_open_cloexec(PERL_RANDOM_DEVICE, 0);
     if (fd != -1) {
     	if (PerlLIO_read(fd, (void*)&u, sizeof u) != sizeof u)
 	    u = 0;