+void
+Perl_setfd_cloexec(int fd)
+{
+ assert(fd >= 0);
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
+ (void) fcntl(fd, F_SETFD, FD_CLOEXEC);
+#endif
+}
+
+void
+Perl_setfd_inhexec(int fd)
+{
+ assert(fd >= 0);
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
+ (void) fcntl(fd, F_SETFD, 0);
+#endif
+}
+
+void
+Perl_setfd_cloexec_for_nonsysfd(pTHX_ int fd)
+{
+ assert(fd >= 0);
+ if(fd > PL_maxsysfd)
+ setfd_cloexec(fd);
+}
+
+void
+Perl_setfd_inhexec_for_sysfd(pTHX_ int fd)
+{
+ assert(fd >= 0);
+ if(fd <= PL_maxsysfd)
+ setfd_inhexec(fd);
+}
+void
+Perl_setfd_cloexec_or_inhexec_by_sysfdness(pTHX_ int fd)
+{
+ assert(fd >= 0);
+ if(fd <= PL_maxsysfd)
+ setfd_inhexec(fd);
+ else
+ setfd_cloexec(fd);
+}
+
+
+#define DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSETFD_CLOEXEC) \
+ do { \
+ int res = (GENOPEN_NORMAL); \
+ 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 = 0, CLOEXEC_AT_OPEN, CLOEXEC_AFTER_OPEN };
+# define DO_GENOPEN_EXPERIMENTING_CLOEXEC(strategy, TESTFD, GENOPEN_CLOEXEC, \
+ GENOPEN_NORMAL, GENSETFD_CLOEXEC) \
+ do { \
+ 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; \
+ GENSETFD_CLOEXEC; \
+ } \
+ } else if (UNLIKELY((eno = errno) == EINVAL || \
+ eno == ENOSYS)) { \
+ res = (GENOPEN_NORMAL); \
+ if (LIKELY(res != -1)) { \
+ strategy = CLOEXEC_AFTER_OPEN; \
+ GENSETFD_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, GENSETFD_CLOEXEC); \
+ } \
+ } while(0)
+#else
+# define DO_GENOPEN_EXPERIMENTING_CLOEXEC(strategy, TESTFD, GENOPEN_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), \
+ setfd_cloexec(fd)); \
+ } while(0)
+#define DO_ONEOPEN_EXPERIMENTING_CLOEXEC(strategy, \
+ ONEOPEN_CLOEXEC, ONEOPEN_NORMAL) \
+ do { \
+ int fd; \
+ DO_GENOPEN_EXPERIMENTING_CLOEXEC(strategy, \
+ fd, \
+ fd = (ONEOPEN_CLOEXEC), \
+ fd = (ONEOPEN_NORMAL), setfd_cloexec(fd)); \
+ } while(0)
+
+#define DO_PIPESETFD_CLOEXEC(PIPEFD) \
+ do { \
+ 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_PIPESETFD_CLOEXEC(PIPEFD))
+#define DO_PIPEOPEN_EXPERIMENTING_CLOEXEC(strategy, PIPEFD, PIPEOPEN_CLOEXEC, \
+ PIPEOPEN_NORMAL) \
+ DO_GENOPEN_EXPERIMENTING_CLOEXEC(strategy, \
+ (PIPEFD)[0], PIPEOPEN_CLOEXEC, \
+ PIPEOPEN_NORMAL, DO_PIPESETFD_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(
+ PL_strategy_dup,
+ 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(
+ PL_strategy_dup2,
+ dup3(oldfd, newfd, O_CLOEXEC),
+ PerlLIO_dup2(oldfd, newfd));
+#else
+ DO_ONEOPEN_THEN_CLOEXEC(PerlLIO_dup2(oldfd, newfd));
+#endif
+}
+
+#if defined(OEMVS)
+ #if (__CHARSET_LIB == 1)
+# include <stdio.h>
+# include <stdlib.h>
+
+ static int setccsid(int fd, int ccsid)
+ {
+ attrib_t attr;
+ int rc;
+
+ memset(&attr, 0, sizeof(attr));
+ attr.att_filetagchg = 1;
+ attr.att_filetag.ft_ccsid = ccsid;
+ attr.att_filetag.ft_txtflag = 1;
+
+ rc = __fchattr(fd, &attr, sizeof(attr));
+ return rc;
+ }
+
+ static void updateccsid(int fd, const char* path, int oflag, int perm)
+ {
+ int rc;
+ if (oflag & O_CREAT) {
+ rc = setccsid(fd, 819);
+ }
+ }
+
+ int asciiopen(const char* path, int oflag)
+ {
+ int rc;
+ int fd = open(path, oflag);
+ if (fd == -1) {
+ return fd;
+ }
+ updateccsid(fd, path, oflag, -1);
+ return fd;
+ }
+
+ int asciiopen3(const char* path, int oflag, int perm)
+ {
+ int rc;
+ int fd = open(path, oflag, perm);
+ if (fd == -1) {
+ return fd;
+ }
+ updateccsid(fd, path, oflag, perm);
+ return fd;
+ }
+ #endif
+#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(
+ PL_strategy_open,
+ 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(
+ PL_strategy_open3,
+ PerlLIO_open3(file, flag | O_CLOEXEC, perm),
+ PerlLIO_open3(file, flag, perm));
+#else
+ DO_ONEOPEN_THEN_CLOEXEC(PerlLIO_open3(file, flag, perm));
+#endif
+}
+
+#if defined(OEMVS)
+ #if (__CHARSET_LIB == 1)
+ #define TEMP_CCSID 819
+ #endif
+static int Internal_Perl_my_mkstemp_cloexec(char *templte)
+{
+ PERL_ARGS_ASSERT_MY_MKSTEMP_CLOEXEC;
+# if defined(O_CLOEXEC)
+ DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
+ PL_strategy_mkstemp,
+ Perl_my_mkostemp(templte, O_CLOEXEC),
+ Perl_my_mkstemp(templte));
+# else
+ DO_ONEOPEN_THEN_CLOEXEC(Perl_my_mkstemp(templte));
+# endif
+}
+int
+Perl_my_mkstemp_cloexec(char *templte)
+{
+ int tempfd = Internal_Perl_my_mkstemp_cloexec(templte);
+# if defined(TEMP_CCSID)
+ setccsid(tempfd, TEMP_CCSID);
+# endif
+ return tempfd;
+}
+
+# else /* Below is ! OEMVS */
+int
+Perl_my_mkstemp_cloexec(char *templte)
+{
+ PERL_ARGS_ASSERT_MY_MKSTEMP_CLOEXEC;
+# if defined(O_CLOEXEC)
+ DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
+ PL_strategy_mkstemp,
+ Perl_my_mkostemp(templte, O_CLOEXEC),
+ Perl_my_mkstemp(templte));
+# else
+ DO_ONEOPEN_THEN_CLOEXEC(Perl_my_mkstemp(templte));
+# endif
+}
+#endif
+
+int
+Perl_my_mkostemp_cloexec(char *templte, int flags)
+{
+ PERL_ARGS_ASSERT_MY_MKOSTEMP_CLOEXEC;
+#if defined(O_CLOEXEC)
+ DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
+ PL_strategy_mkstemp,
+ Perl_my_mkostemp(templte, flags | O_CLOEXEC),
+ Perl_my_mkostemp(templte, flags));
+#else
+ DO_ONEOPEN_THEN_CLOEXEC(Perl_my_mkostemp(templte, flags));
+#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(PL_strategy_pipe, 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(
+ PL_strategy_socket,
+ 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(
+ PL_strategy_accept,
+ 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(PL_strategy_socketpair, 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
+
https://perl5.git.perl.org / perl5.git / blobdiff