This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
*_cloexec() I/O functions
authorZefram <zefram@fysh.org>
Tue, 19 Dec 2017 09:38:37 +0000 (09:38 +0000)
committerZefram <zefram@fysh.org>
Fri, 22 Dec 2017 16:05:33 +0000 (16:05 +0000)
New functions PerlLIO_dup_cloexec(), PerlLIO_dup2_cloexec(),
PerlLIO_open_cloexec(), PerlLIO_open3_cloexec(), PerlProc_pipe_cloexec(),
PerlSock_socket_cloexec(), PerlSock_accept_cloexec(), and
PerlSock_socketpair_cloexec() each do the same thing as their
"_cloexec"-less counterpart, but return with the FD_CLOEXEC flag set on
each new file descriptor.  They set the flag atomically as part of the
file descriptor creation syscall where possible, but will fall back to
setting it separately from creation where necessary.

In all cases, setting the flag atomically depends not only on the correct
syscall interface being defined, but on it being actually implemented
in the runtime kernel.  Each function will experiment to see whether
the atomic flag setting actually works, and is prepared for the flag to
cause EINVAL or ENOSYS or to be ignored.

doio.c
embed.fnc
embed.h
metaconfig.h
proto.h

diff --git a/doio.c b/doio.c
index 8a47ad3..583f6d7 100644 (file)
--- a/doio.c
+++ b/doio.c
 
 #include <signal.h>
 
+#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)
+#endif
+#define DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSET_CLOEXEC) \
+       do { \
+           int res = (GENOPEN_NORMAL); \
+           if(LIKELY(res != -1)) GENSET_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) \
+       do { \
+           static int strategy = CLOEXEC_EXPERIMENT; \
+           switch (strategy) { \
+               case CLOEXEC_EXPERIMENT: default: { \
+                   int res = (GENOPEN_CLOEXEC), eno; \
+                   if (LIKELY(res != -1)) { \
+                       int fdflags = fcntl((TESTFD), F_GETFD); \
+                       if (LIKELY(fdflags != -1) && \
+                               LIKELY(fdflags & FD_CLOEXEC)) { \
+                           strategy = CLOEXEC_AT_OPEN; \
+                       } else { \
+                           strategy = CLOEXEC_AFTER_OPEN; \
+                           GENSET_CLOEXEC; \
+                       } \
+                   } else if (UNLIKELY((eno = errno) == EINVAL || \
+                                               eno == ENOSYS)) { \
+                       res = (GENOPEN_NORMAL); \
+                       if (LIKELY(res != -1)) { \
+                           strategy = CLOEXEC_AFTER_OPEN; \
+                           GENSET_CLOEXEC; \
+                       } else if (!LIKELY((eno = errno) == EINVAL || \
+                                               eno == ENOSYS)) { \
+                           strategy = CLOEXEC_AFTER_OPEN; \
+                       } \
+                   } \
+                   return res; \
+               } \
+               case CLOEXEC_AT_OPEN: \
+                   return (GENOPEN_CLOEXEC); \
+               case CLOEXEC_AFTER_OPEN: \
+                   DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSET_CLOEXEC); \
+           } \
+       } while(0)
+#else
+#  define DO_GENOPEN_EXPERIMENTING_CLOEXEC(TESTFD, GENOPEN_CLOEXEC, \
+                       GENOPEN_NORMAL, GENSET_CLOEXEC) \
+       DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSET_CLOEXEC)
+#endif
+
+#define DO_ONEOPEN_THEN_CLOEXEC(ONEOPEN_NORMAL) \
+       do { \
+           int fd; \
+           DO_GENOPEN_THEN_CLOEXEC(fd = (ONEOPEN_NORMAL), \
+               DO_ONESET_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)); \
+       } while(0)
+
+#define DO_PIPESET_CLOEXEC(PIPEFD) \
+       do { \
+           DO_ONESET_CLOEXEC((PIPEFD)[0]); \
+           DO_ONESET_CLOEXEC((PIPEFD)[1]); \
+       } while(0)
+#define DO_PIPEOPEN_THEN_CLOEXEC(PIPEFD, PIPEOPEN_NORMAL) \
+       DO_GENOPEN_THEN_CLOEXEC(PIPEOPEN_NORMAL, DO_PIPESET_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))
+
+int
+Perl_PerlLIO_dup_cloexec(pTHX_ int oldfd)
+{
+#if !defined(PERL_IMPLICIT_SYS) && defined(F_DUPFD_CLOEXEC)
+    /*
+     * struct IPerlLIO doesn't cover fcntl(), and there's no clear way
+     * to extend it, so for the time being this just isn't available on
+     * PERL_IMPLICIT_SYS builds.
+     */
+    DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
+       fcntl(oldfd, F_DUPFD_CLOEXEC, 0),
+       PerlLIO_dup(oldfd));
+#else
+    DO_ONEOPEN_THEN_CLOEXEC(PerlLIO_dup(oldfd));
+#endif
+}
+
+int
+Perl_PerlLIO_dup2_cloexec(pTHX_ int oldfd, int newfd)
+{
+#if !defined(PERL_IMPLICIT_SYS) && defined(HAS_DUP3) && defined(O_CLOEXEC)
+    /*
+     * struct IPerlLIO doesn't cover dup3(), and there's no clear way
+     * to extend it, so for the time being this just isn't available on
+     * PERL_IMPLICIT_SYS builds.
+     */
+    DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
+       dup3(oldfd, newfd, O_CLOEXEC),
+       PerlLIO_dup2(oldfd, newfd));
+#else
+    DO_ONEOPEN_THEN_CLOEXEC(PerlLIO_dup2(oldfd, newfd));
+#endif
+}
+
+int
+Perl_PerlLIO_open_cloexec(pTHX_ const char *file, int flag)
+{
+    PERL_ARGS_ASSERT_PERLLIO_OPEN_CLOEXEC;
+#if defined(O_CLOEXEC)
+    DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
+       PerlLIO_open(file, flag | O_CLOEXEC),
+       PerlLIO_open(file, flag));
+#else
+    DO_ONEOPEN_THEN_CLOEXEC(PerlLIO_open(file, flag));
+#endif
+}
+
+int
+Perl_PerlLIO_open3_cloexec(pTHX_ const char *file, int flag, int perm)
+{
+    PERL_ARGS_ASSERT_PERLLIO_OPEN3_CLOEXEC;
+#if defined(O_CLOEXEC)
+    DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
+       PerlLIO_open3(file, flag | O_CLOEXEC, perm),
+       PerlLIO_open3(file, flag, perm));
+#else
+    DO_ONEOPEN_THEN_CLOEXEC(PerlLIO_open3(file, flag, perm));
+#endif
+}
+
+#ifdef HAS_PIPE
+int
+Perl_PerlProc_pipe_cloexec(pTHX_ int *pipefd)
+{
+    PERL_ARGS_ASSERT_PERLPROC_PIPE_CLOEXEC;
+    /*
+     * struct IPerlProc doesn't cover pipe2(), and there's no clear way
+     * to extend it, so for the time being this just isn't available on
+     * PERL_IMPLICIT_SYS builds.
+     */
+#  if !defined(PERL_IMPLICIT_SYS) && defined(HAS_PIPE2) && defined(O_CLOEXEC)
+    DO_PIPEOPEN_EXPERIMENTING_CLOEXEC(pipefd,
+       pipe2(pipefd, O_CLOEXEC),
+       PerlProc_pipe(pipefd));
+#  else
+    DO_PIPEOPEN_THEN_CLOEXEC(pipefd, PerlProc_pipe(pipefd));
+#  endif
+}
+#endif
+
+#ifdef HAS_SOCKET
+
+int
+Perl_PerlSock_socket_cloexec(pTHX_ int domain, int type, int protocol)
+{
+#  if defined(SOCK_CLOEXEC)
+    DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
+       PerlSock_socket(domain, type | SOCK_CLOEXEC, protocol),
+       PerlSock_socket(domain, type, protocol));
+#  else
+    DO_ONEOPEN_THEN_CLOEXEC(PerlSock_socket(domain, type, protocol));
+#  endif
+}
+
+int
+Perl_PerlSock_accept_cloexec(pTHX_ int listenfd, struct sockaddr *addr,
+    Sock_size_t *addrlen)
+{
+#  if !defined(PERL_IMPLICIT_SYS) && \
+       defined(HAS_ACCEPT4) && defined(SOCK_CLOEXEC)
+    /*
+     * struct IPerlSock doesn't cover accept4(), and there's no clear
+     * way to extend it, so for the time being this just isn't available
+     * on PERL_IMPLICIT_SYS builds.
+     */
+    DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
+       accept4(listenfd, addr, addrlen, SOCK_CLOEXEC),
+       PerlSock_accept(listenfd, addr, addrlen));
+#  else
+    DO_ONEOPEN_THEN_CLOEXEC(PerlSock_accept(listenfd, addr, addrlen));
+#  endif
+}
+
+#endif
+
+#if defined (HAS_SOCKETPAIR) || \
+    (defined (HAS_SOCKET) && defined(SOCK_DGRAM) && \
+       defined(AF_INET) && defined(PF_INET))
+int
+Perl_PerlSock_socketpair_cloexec(pTHX_ int domain, int type, int protocol,
+    int *pairfd)
+{
+    PERL_ARGS_ASSERT_PERLSOCK_SOCKETPAIR_CLOEXEC;
+#  ifdef SOCK_CLOEXEC
+    DO_PIPEOPEN_EXPERIMENTING_CLOEXEC(pairfd,
+       PerlSock_socketpair(domain, type | SOCK_CLOEXEC, protocol, pairfd),
+       PerlSock_socketpair(domain, type, protocol, pairfd));
+#  else
+    DO_PIPEOPEN_THEN_CLOEXEC(pairfd,
+       PerlSock_socketpair(domain, type, protocol, pairfd));
+#  endif
+}
+#endif
+
 static IO *
 S_openn_setup(pTHX_ GV *gv, char *mode, PerlIO **saveifp, PerlIO **saveofp,
               int *savefd,  char *savetype)
index b7d34d6..a434bf8 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -464,6 +464,25 @@ 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
+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
+pR     |int    |PerlLIO_open3_cloexec|NN const char *file|int flag|int perm
+#ifdef HAS_PIPE
+pR     |int    |PerlProc_pipe_cloexec|NN int *pipefd
+#endif
+#ifdef HAS_SOCKET
+pR     |int    |PerlSock_socket_cloexec|int domain|int type|int protocol
+pR     |int    |PerlSock_accept_cloexec|int listenfd \
+                               |NULLOK struct sockaddr *addr \
+                               |NULLOK Sock_size_t *addrlen
+#endif
+#if defined (HAS_SOCKETPAIR) || \
+    (defined (HAS_SOCKET) && defined(SOCK_DGRAM) && \
+       defined(AF_INET) && defined(PF_INET))
+pR     |int    |PerlSock_socketpair_cloexec|int domain|int type|int protocol \
+                               |NN int *pairfd
+#endif
 #if defined(PERL_IN_DOIO_C)
 s      |IO *   |openn_setup    |NN GV *gv|NN char *mode|NN PerlIO **saveifp \
                                |NN PerlIO **saveofp|NN int *savefd \
diff --git a/embed.h b/embed.h
index c2542c3..53b54b0 100644 (file)
--- a/embed.h
+++ b/embed.h
 #  endif
 #endif
 #ifdef PERL_CORE
+#define PerlLIO_dup2_cloexec(a,b)      Perl_PerlLIO_dup2_cloexec(aTHX_ a,b)
+#define PerlLIO_dup_cloexec(a) Perl_PerlLIO_dup_cloexec(aTHX_ a)
+#define PerlLIO_open3_cloexec(a,b,c)   Perl_PerlLIO_open3_cloexec(aTHX_ a,b,c)
+#define PerlLIO_open_cloexec(a,b)      Perl_PerlLIO_open_cloexec(aTHX_ a,b)
 #define Slab_Alloc(a)          Perl_Slab_Alloc(aTHX_ a)
 #define Slab_Free(a)           Perl_Slab_Free(aTHX_ a)
 #define _is_in_locale_category(a,b)    Perl__is_in_locale_category(aTHX_ a,b)
 #  if !defined(WIN32)
 #define do_exec3(a,b,c)                Perl_do_exec3(aTHX_ a,b,c)
 #  endif
+#  if defined (HAS_SOCKETPAIR) ||     (defined (HAS_SOCKET) && defined(SOCK_DGRAM) &&  defined(AF_INET) && defined(PF_INET))
+#define PerlSock_socketpair_cloexec(a,b,c,d)   Perl_PerlSock_socketpair_cloexec(aTHX_ a,b,c,d)
+#  endif
 #  if defined(DEBUGGING)
 #define get_debug_opts(a,b)    Perl_get_debug_opts(aTHX_ a,b)
 #define set_padlist            Perl_set_padlist
 #define my_nl_langinfo         S_my_nl_langinfo
 #    endif
 #  endif
+#  if defined(HAS_PIPE)
+#define PerlProc_pipe_cloexec(a)       Perl_PerlProc_pipe_cloexec(aTHX_ a)
+#  endif
 #  if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
 #define sighandler             Perl_sighandler
 #  endif
+#  if defined(HAS_SOCKET)
+#define PerlSock_accept_cloexec(a,b,c) Perl_PerlSock_accept_cloexec(aTHX_ a,b,c)
+#define PerlSock_socket_cloexec(a,b,c) Perl_PerlSock_socket_cloexec(aTHX_ a,b,c)
+#  endif
 #  if defined(MYMALLOC)
 #define malloc_good_size       Perl_malloc_good_size
 #define malloced_size          Perl_malloced_size
index a9af3c2..ba8ee4a 100644 (file)
@@ -22,7 +22,4 @@
  * HAS_NANOSLEEP
  * HAS_STRTOLD_L
  * I_WCHAR
- * HAS_ACCEPT4
- * HAS_DUP3
- * HAS_PIPE2
  */
diff --git a/proto.h b/proto.h
index e464a94..eca26e9 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -35,6 +35,22 @@ PERL_CALLCONV UV     NATIVE_TO_NEED(const UV enc, const UV ch)
 #endif
 
 PERL_CALLCONV const char *     Perl_PerlIO_context_layers(pTHX_ const char *mode);
+PERL_CALLCONV int      Perl_PerlLIO_dup2_cloexec(pTHX_ int oldfd, int newfd)
+                       __attribute__warn_unused_result__;
+
+PERL_CALLCONV int      Perl_PerlLIO_dup_cloexec(pTHX_ int oldfd)
+                       __attribute__warn_unused_result__;
+
+PERL_CALLCONV int      Perl_PerlLIO_open3_cloexec(pTHX_ const char *file, int flag, int perm)
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_PERLLIO_OPEN3_CLOEXEC \
+       assert(file)
+
+PERL_CALLCONV int      Perl_PerlLIO_open_cloexec(pTHX_ const char *file, int flag)
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_PERLLIO_OPEN_CLOEXEC  \
+       assert(file)
+
 PERL_CALLCONV void*    Perl_Slab_Alloc(pTHX_ size_t sz)
                        __attribute__warn_unused_result__;
 
@@ -4080,6 +4096,13 @@ PERL_CALLCONV bool       Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 #define PERL_ARGS_ASSERT_DO_EXEC3      \
        assert(incmd)
 #endif
+#if defined (HAS_SOCKETPAIR) ||     (defined (HAS_SOCKET) && defined(SOCK_DGRAM) &&    defined(AF_INET) && defined(PF_INET))
+PERL_CALLCONV int      Perl_PerlSock_socketpair_cloexec(pTHX_ int domain, int type, int protocol, int *pairfd)
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_PERLSOCK_SOCKETPAIR_CLOEXEC   \
+       assert(pairfd)
+
+#endif
 #if defined(DEBUGGING)
 PERL_CALLCONV int      Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
                        __attribute__warn_unused_result__;
@@ -4226,10 +4249,25 @@ STATIC const char*      S_my_nl_langinfo(const nl_item item, bool toggle);
 #if defined(HAS_NL_LANGINFO) && defined(PERL_LANGINFO_H)
 PERL_CALLCONV const char*      Perl_langinfo(const nl_item item);
 #endif
+#if defined(HAS_PIPE)
+PERL_CALLCONV int      Perl_PerlProc_pipe_cloexec(pTHX_ int *pipefd)
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_PERLPROC_PIPE_CLOEXEC \
+       assert(pipefd)
+
+#endif
 #if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
 PERL_CALLCONV Signal_t Perl_csighandler(int sig, siginfo_t *info, void *uap);
 PERL_CALLCONV Signal_t Perl_sighandler(int sig, siginfo_t *info, void *uap);
 #endif
+#if defined(HAS_SOCKET)
+PERL_CALLCONV int      Perl_PerlSock_accept_cloexec(pTHX_ int listenfd, struct sockaddr *addr, Sock_size_t *addrlen)
+                       __attribute__warn_unused_result__;
+
+PERL_CALLCONV int      Perl_PerlSock_socket_cloexec(pTHX_ int domain, int type, int protocol)
+                       __attribute__warn_unused_result__;
+
+#endif
 #if defined(HAVE_INTERP_INTERN)
 PERL_CALLCONV void     Perl_sys_intern_clear(pTHX);
 PERL_CALLCONV void     Perl_sys_intern_init(pTHX);