foo_cloexec() under PERL_GLOBAL_STRUCT_PRIVATE

Fix the various Perl_PerlSock_dup2_cloexec() type functions so that
t/porting/liberl.a passes under -DPERL_GLOBAL_STRUCT_PRIVATE builds.

In these builds it is forbidden to have any static variables, but each
of these functions (via convoluted macros) has a static var called
'strategy' which records, for each function, whether a run-time probe
has been done to determine the best way of achieving close-exec
functionality, and the result.

Replace them all with 'global' vars: PL_strategy_dup2 etc.

NB these vars aren't thread-safe but it doesn't really matter, as the
worst that can happen is for a redundant probe or two to be done before
a suitable "don't probe any more" value is written to the var and seen
by all the threads.

diff --git a/doio.c b/doio.c
index 9fe222e..0cc4e55 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -112,11 +112,10 @@ Perl_setfd_cloexec_or_inhexec_by_sysfdness(pTHX_ int fd)
        } 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, \
+enum { CLOEXEC_EXPERIMENT = 0, CLOEXEC_AT_OPEN, CLOEXEC_AFTER_OPEN };
+#  define DO_GENOPEN_EXPERIMENTING_CLOEXEC(strategy, TESTFD, GENOPEN_CLOEXEC, \
                        GENOPEN_NORMAL, GENSETFD_CLOEXEC) \
        do { \
-           static int strategy = CLOEXEC_EXPERIMENT; \
            switch (strategy) { \
                case CLOEXEC_EXPERIMENT: default: { \
                    int res = (GENOPEN_CLOEXEC), eno; \
@@ -149,7 +148,7 @@ enum { CLOEXEC_EXPERIMENT, CLOEXEC_AT_OPEN, CLOEXEC_AFTER_OPEN };
            } \
        } while(0)
 #else
-#  define DO_GENOPEN_EXPERIMENTING_CLOEXEC(TESTFD, GENOPEN_CLOEXEC, \
+#  define DO_GENOPEN_EXPERIMENTING_CLOEXEC(strategy, TESTFD, GENOPEN_CLOEXEC, \
                        GENOPEN_NORMAL, GENSETFD_CLOEXEC) \
        DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSETFD_CLOEXEC)
 #endif
@@ -160,10 +159,13 @@ enum { CLOEXEC_EXPERIMENT, CLOEXEC_AT_OPEN, CLOEXEC_AFTER_OPEN };
            DO_GENOPEN_THEN_CLOEXEC(fd = (ONEOPEN_NORMAL), \
                setfd_cloexec(fd)); \
        } while(0)
-#define DO_ONEOPEN_EXPERIMENTING_CLOEXEC(ONEOPEN_CLOEXEC, ONEOPEN_NORMAL) \
+#define DO_ONEOPEN_EXPERIMENTING_CLOEXEC(strategy, \
+                ONEOPEN_CLOEXEC, ONEOPEN_NORMAL) \
        do { \
            int fd; \
-           DO_GENOPEN_EXPERIMENTING_CLOEXEC(fd, fd = (ONEOPEN_CLOEXEC), \
+           DO_GENOPEN_EXPERIMENTING_CLOEXEC(strategy, \
+                fd, \
+                fd = (ONEOPEN_CLOEXEC), \
                fd = (ONEOPEN_NORMAL), setfd_cloexec(fd)); \
        } while(0)
 
@@ -174,9 +176,10 @@ enum { CLOEXEC_EXPERIMENT, CLOEXEC_AT_OPEN, CLOEXEC_AFTER_OPEN };
        } 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(PIPEFD, PIPEOPEN_CLOEXEC, \
+#define DO_PIPEOPEN_EXPERIMENTING_CLOEXEC(strategy, PIPEFD, PIPEOPEN_CLOEXEC, \
                        PIPEOPEN_NORMAL) \
-       DO_GENOPEN_EXPERIMENTING_CLOEXEC((PIPEFD)[0], PIPEOPEN_CLOEXEC, \
+       DO_GENOPEN_EXPERIMENTING_CLOEXEC(strategy, \
+                (PIPEFD)[0], PIPEOPEN_CLOEXEC, \
            PIPEOPEN_NORMAL, DO_PIPESETFD_CLOEXEC(PIPEFD))
 
 int
@@ -188,7 +191,9 @@ Perl_PerlLIO_dup_cloexec(pTHX_ int oldfd)
      * to extend it, so for the time being this just isn't available on
      * PERL_IMPLICIT_SYS builds.
      */
+    dVAR;
     DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
+        PL_strategy_dup,
        fcntl(oldfd, F_DUPFD_CLOEXEC, 0),
        PerlLIO_dup(oldfd));
 #else
@@ -205,7 +210,9 @@ Perl_PerlLIO_dup2_cloexec(pTHX_ int oldfd, int newfd)
      * to extend it, so for the time being this just isn't available on
      * PERL_IMPLICIT_SYS builds.
      */
+    dVAR;
     DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
+        PL_strategy_dup2,
        dup3(oldfd, newfd, O_CLOEXEC),
        PerlLIO_dup2(oldfd, newfd));
 #else
@@ -216,9 +223,11 @@ Perl_PerlLIO_dup2_cloexec(pTHX_ int oldfd, int newfd)
 int
 Perl_PerlLIO_open_cloexec(pTHX_ const char *file, int flag)
 {
+    dVAR;
     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
@@ -229,9 +238,11 @@ Perl_PerlLIO_open_cloexec(pTHX_ const char *file, int flag)
 int
 Perl_PerlLIO_open3_cloexec(pTHX_ const char *file, int flag, int perm)
 {
+    dVAR;
     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
@@ -242,9 +253,11 @@ Perl_PerlLIO_open3_cloexec(pTHX_ const char *file, int flag, int perm)
 int
 Perl_my_mkstemp_cloexec(char *templte)
 {
+    dVAR;
     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
@@ -256,6 +269,7 @@ Perl_my_mkstemp_cloexec(char *templte)
 int
 Perl_PerlProc_pipe_cloexec(pTHX_ int *pipefd)
 {
+    dVAR;
     PERL_ARGS_ASSERT_PERLPROC_PIPE_CLOEXEC;
     /*
      * struct IPerlProc doesn't cover pipe2(), and there's no clear way
@@ -263,7 +277,7 @@ Perl_PerlProc_pipe_cloexec(pTHX_ int *pipefd)
      * PERL_IMPLICIT_SYS builds.
      */
 #  if !defined(PERL_IMPLICIT_SYS) && defined(HAS_PIPE2) && defined(O_CLOEXEC)
-    DO_PIPEOPEN_EXPERIMENTING_CLOEXEC(pipefd,
+    DO_PIPEOPEN_EXPERIMENTING_CLOEXEC(PL_strategy_pipe, pipefd,
        pipe2(pipefd, O_CLOEXEC),
        PerlProc_pipe(pipefd));
 #  else
@@ -278,7 +292,9 @@ int
 Perl_PerlSock_socket_cloexec(pTHX_ int domain, int type, int protocol)
 {
 #  if defined(SOCK_CLOEXEC)
+    dVAR;
     DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
+        PL_strategy_socket,
        PerlSock_socket(domain, type | SOCK_CLOEXEC, protocol),
        PerlSock_socket(domain, type, protocol));
 #  else
@@ -297,7 +313,9 @@ Perl_PerlSock_accept_cloexec(pTHX_ int listenfd, struct sockaddr *addr,
      * way to extend it, so for the time being this just isn't available
      * on PERL_IMPLICIT_SYS builds.
      */
+    dVAR;
     DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
+        PL_strategy_accept,
        accept4(listenfd, addr, addrlen, SOCK_CLOEXEC),
        PerlSock_accept(listenfd, addr, addrlen));
 #  else
@@ -314,9 +332,10 @@ int
 Perl_PerlSock_socketpair_cloexec(pTHX_ int domain, int type, int protocol,
     int *pairfd)
 {
+    dVAR;
     PERL_ARGS_ASSERT_PERLSOCK_SOCKETPAIR_CLOEXEC;
 #  ifdef SOCK_CLOEXEC
-    DO_PIPEOPEN_EXPERIMENTING_CLOEXEC(pairfd,
+    DO_PIPEOPEN_EXPERIMENTING_CLOEXEC(PL_strategy_socketpair, pairfd,
        PerlSock_socketpair(domain, type | SOCK_CLOEXEC, protocol, pairfd),
        PerlSock_socketpair(domain, type, protocol, pairfd));
 #  else

diff --git a/embedvar.h b/embedvar.h
index 705be5d..37e4ab1 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -460,6 +460,24 @@
 #define PL_Gsig_trapped                (my_vars->Gsig_trapped)
 #define PL_sigfpe_saved                (my_vars->Gsigfpe_saved)
 #define PL_Gsigfpe_saved       (my_vars->Gsigfpe_saved)
+#define PL_strategy_accept     (my_vars->Gstrategy_accept)
+#define PL_Gstrategy_accept    (my_vars->Gstrategy_accept)
+#define PL_strategy_dup                (my_vars->Gstrategy_dup)
+#define PL_Gstrategy_dup       (my_vars->Gstrategy_dup)
+#define PL_strategy_dup2       (my_vars->Gstrategy_dup2)
+#define PL_Gstrategy_dup2      (my_vars->Gstrategy_dup2)
+#define PL_strategy_mkstemp    (my_vars->Gstrategy_mkstemp)
+#define PL_Gstrategy_mkstemp   (my_vars->Gstrategy_mkstemp)
+#define PL_strategy_open       (my_vars->Gstrategy_open)
+#define PL_Gstrategy_open      (my_vars->Gstrategy_open)
+#define PL_strategy_open3      (my_vars->Gstrategy_open3)
+#define PL_Gstrategy_open3     (my_vars->Gstrategy_open3)
+#define PL_strategy_pipe       (my_vars->Gstrategy_pipe)
+#define PL_Gstrategy_pipe      (my_vars->Gstrategy_pipe)
+#define PL_strategy_socket     (my_vars->Gstrategy_socket)
+#define PL_Gstrategy_socket    (my_vars->Gstrategy_socket)
+#define PL_strategy_socketpair (my_vars->Gstrategy_socketpair)
+#define PL_Gstrategy_socketpair        (my_vars->Gstrategy_socketpair)
 #define PL_sv_placeholder      (my_vars->Gsv_placeholder)
 #define PL_Gsv_placeholder     (my_vars->Gsv_placeholder)
 #define PL_thr_key             (my_vars->Gthr_key)

diff --git a/globvar.sym b/globvar.sym
index 476f4ca..dcc65f2 100644 (file)
--- a/globvar.sym
+++ b/globvar.sym
@@ -66,6 +66,15 @@ PL_sig_name
 PL_sig_num
 PL_simple
 PL_simple_bitmask
+PL_strategy_dup
+PL_strategy_dup2
+PL_strategy_open
+PL_strategy_open3
+PL_strategy_mkstemp
+PL_strategy_socket
+PL_strategy_accept
+PL_strategy_pipe
+PL_strategy_socketpair
 PL_strict_utf8_dfa_tab
 PL_subversion
 PL_utf8skip

diff --git a/perlapi.h b/perlapi.h
index f08bd60..6eac8f7 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -207,6 +207,24 @@ END_EXTERN_C
 #define PL_sig_trapped         (*Perl_Gsig_trapped_ptr(NULL))
 #undef  PL_sigfpe_saved
 #define PL_sigfpe_saved                (*Perl_Gsigfpe_saved_ptr(NULL))
+#undef  PL_strategy_accept
+#define PL_strategy_accept     (*Perl_Gstrategy_accept_ptr(NULL))
+#undef  PL_strategy_dup
+#define PL_strategy_dup                (*Perl_Gstrategy_dup_ptr(NULL))
+#undef  PL_strategy_dup2
+#define PL_strategy_dup2       (*Perl_Gstrategy_dup2_ptr(NULL))
+#undef  PL_strategy_mkstemp
+#define PL_strategy_mkstemp    (*Perl_Gstrategy_mkstemp_ptr(NULL))
+#undef  PL_strategy_open
+#define PL_strategy_open       (*Perl_Gstrategy_open_ptr(NULL))
+#undef  PL_strategy_open3
+#define PL_strategy_open3      (*Perl_Gstrategy_open3_ptr(NULL))
+#undef  PL_strategy_pipe
+#define PL_strategy_pipe       (*Perl_Gstrategy_pipe_ptr(NULL))
+#undef  PL_strategy_socket
+#define PL_strategy_socket     (*Perl_Gstrategy_socket_ptr(NULL))
+#undef  PL_strategy_socketpair
+#define PL_strategy_socketpair (*Perl_Gstrategy_socketpair_ptr(NULL))
 #undef  PL_sv_placeholder
 #define PL_sv_placeholder      (*Perl_Gsv_placeholder_ptr(NULL))
 #undef  PL_thr_key

diff --git a/perlvars.h b/perlvars.h
index 51c939e..d8139c0 100644 (file)
--- a/perlvars.h
+++ b/perlvars.h
@@ -321,3 +321,19 @@ PERLVAR(G, user_prop_mutex, perl_mutex)    /* Mutex for manipulating
 /* Everything that folds to a given character, for case insensitivity regex
  * matching */
 PERLVAR(G, utf8_foldclosures, SV *)
+
+/* these record the best way to to perform certain IO operations while
+ * atomically setting FD_CLOEXEC. On the first call, a probe is done
+ * and the result recorded for use by subsequent calls.
+ * In theory these variables aren't thread-safe, but the worst that can
+ * happen is that two treads will both do an initial probe
+ */
+PERLVARI(G, strategy_dup,        int, 0)       /* doio.c */
+PERLVARI(G, strategy_dup2,       int, 0)       /* doio.c */
+PERLVARI(G, strategy_open,       int, 0)       /* doio.c */
+PERLVARI(G, strategy_open3,      int, 0)       /* doio.c */
+PERLVARI(G, strategy_mkstemp,    int, 0)       /* doio.c */
+PERLVARI(G, strategy_socket,     int, 0)       /* doio.c */
+PERLVARI(G, strategy_accept,     int, 0)       /* doio.c */
+PERLVARI(G, strategy_pipe,       int, 0)       /* doio.c */
+PERLVARI(G, strategy_socketpair, int, 0)       /* doio.c */