set FD_CLOEXEC atomically in easy cases
authorZefram <zefram@fysh.org>
Tue, 19 Dec 2017 16:53:39 +0000 (16:53 +0000)
committerZefram <zefram@fysh.org>
Fri, 22 Dec 2017 16:13:23 +0000 (16:13 +0000)
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.

MANIFEST
doio.c
embed.fnc
embed.h
pp_sys.c
proto.h
t/io/pipe.t
t/io/socket.t
t/io/socketpair.t [new file with mode: 0644]
util.c

index f93b5c0..c702237 100644 (file)
--- 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 583f6d7..160adc5 100644 (file)
--- a/doio.c
+++ b/doio.c
 
 #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)
index a434bf8..b768861 100644 (file)
--- 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 53b54b0..6441f38 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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)
index 0649794..c2873b8 100644 (file)
--- 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 eca26e9..47e348a 100644 (file)
--- 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     \
index bec1a66..f9ee65a 100644 (file)
@@ -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.
 
index bba4e4a..952ff09 100644 (file)
@@ -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 (file)
index 0000000..a80e411
--- /dev/null
@@ -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 d96d533..91ef4ec 100644 (file)
--- 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;