In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/523d71b314dc75bd212794cc8392eab8267ea744?hp=408956da6c7e0cd9dd2443723d668230c6d6675a>
- Log ----------------------------------------------------------------- commit 523d71b314dc75bd212794cc8392eab8267ea744 Author: Abigail <abig...@abigail.be> Date: Thu Jan 18 17:11:15 2018 +0100 Revert "make PerlIO handle FD_CLOEXEC" This reverts commit 2cdf406af42834c46ef407517daab0734f7066fc. The reason for the revert is that with this commit, perl fails to compile on darwin (or at least, one some versions of it): ./miniperl -Ilib make_ext.pl lib/auto/DB_File/DB_File.bundle MAKE="/Applications/Xcode.app/Contents/Developer/usr/bin/make" LIBPERL_A=libperl.a LINKTYPE=dynamic Parsing config.in... Looks Good. dyld: lazy symbol binding failed: Symbol not found: _mkostemp Referenced from: /private/tmp/perl/cpan/DB_File/../../miniperl Expected in: flat namespace dyld: Symbol not found: _mkostemp Referenced from: /private/tmp/perl/cpan/DB_File/../../miniperl Expected in: flat namespace Unsuccessful Makefile.PL(cpan/DB_File): code=5 at make_ext.pl line 518. make: *** [lib/auto/DB_File/DB_File.bundle] Error 2 ----------------------------------------------------------------------- Summary of changes: doio.c | 50 +++++++++++++++++++++++++---------------------- embed.fnc | 4 +--- embed.h | 2 -- perl.c | 4 +++- perlio.c | 60 +++++++++++++++++++++------------------------------------ pod/perliol.pod | 11 ----------- pp_sys.c | 6 ++++++ proto.h | 6 +++--- toke.c | 5 +++++ util.c | 8 ++++---- 10 files changed, 71 insertions(+), 85 deletions(-) diff --git a/doio.c b/doio.c index 4b8923f77c..d18e335a04 100644 --- a/doio.c +++ b/doio.c @@ -78,14 +78,6 @@ Perl_setfd_inhexec(int fd) #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) { @@ -93,16 +85,6 @@ Perl_setfd_inhexec_for_sysfd(pTHX_ int fd) 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 { \ @@ -718,7 +700,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len, } else { if (dodup) - wanted_fd = PerlLIO_dup_cloexec(wanted_fd); + wanted_fd = PerlLIO_dup(wanted_fd); else was_fdopen = TRUE; if (!(fp = PerlIO_openn(aTHX_ type,mode,wanted_fd,0,0,NULL,num_svs,svp))) { @@ -1009,15 +991,33 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, if (was_fdopen) { /* need to close fp without closing underlying fd */ int ofd = PerlIO_fileno(fp); - int dupfd = ofd >= 0 ? PerlLIO_dup_cloexec(ofd) : -1; + int dupfd = ofd >= 0 ? PerlLIO_dup(ofd) : -1; +#if defined(HAS_FCNTL) && defined(F_SETFD) + /* Assume if we have F_SETFD we have F_GETFD. */ + /* Get a copy of all the fd flags. */ + int fd_flags = ofd >= 0 ? fcntl(ofd, F_GETFD) : -1; + if (fd_flags < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } +#endif if (ofd < 0 || dupfd < 0) { if (dupfd >= 0) PerlLIO_close(dupfd); goto say_false; } PerlIO_close(fp); - PerlLIO_dup2_cloexec(dupfd, ofd); - setfd_inhexec_for_sysfd(ofd); + PerlLIO_dup2(dupfd, ofd); +#if defined(HAS_FCNTL) && defined(F_SETFD) + /* The dup trick has lost close-on-exec on ofd, + * and possibly any other flags, so restore them. */ + if (fcntl(ofd,F_SETFD, fd_flags) < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } +#endif PerlLIO_close(dupfd); } else @@ -1027,6 +1027,10 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, PerlIO_clearerr(fp); fd = PerlIO_fileno(fp); } + if (fd >= 0) { + setfd_cloexec(fd); + setfd_inhexec_for_sysfd(fd); + } IoIFP(io) = fp; IoFLAGS(io) &= ~IOf_NOLINE; @@ -1096,7 +1100,7 @@ S_openindirtemp(pTHX_ GV *gv, SV *orig_name, SV *temp_out_name) { { int old_umask = umask(0177); - fd = Perl_my_mkstemp_cloexec(SvPVX(temp_out_name)); + fd = Perl_my_mkstemp(SvPVX(temp_out_name)); umask(old_umask); } diff --git a/embed.fnc b/embed.fnc index cd654dd1e7..adb4178a20 100644 --- a/embed.fnc +++ b/embed.fnc @@ -466,11 +466,9 @@ Ap |bool |do_open9 |NN GV *gv|NN const char *name|I32 len|int as_raw \ |NN SV *svs|I32 num pn |void |setfd_cloexec|int fd pn |void |setfd_inhexec|int fd -p |void |setfd_cloexec_for_nonsysfd|int fd p |void |setfd_inhexec_for_sysfd|int fd -p |void |setfd_cloexec_or_inhexec_by_sysfdness|int fd pR |int |PerlLIO_dup_cloexec|int oldfd -p |int |PerlLIO_dup2_cloexec|int oldfd|int newfd +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 pnoR |int |my_mkstemp_cloexec|NN char *templte diff --git a/embed.h b/embed.h index c968191616..08d1cc5f4a 100644 --- a/embed.h +++ b/embed.h @@ -1391,8 +1391,6 @@ #define set_numeric_standard() Perl_set_numeric_standard(aTHX) #define set_numeric_underlying() Perl_set_numeric_underlying(aTHX) #define setfd_cloexec Perl_setfd_cloexec -#define setfd_cloexec_for_nonsysfd(a) Perl_setfd_cloexec_for_nonsysfd(aTHX_ a) -#define setfd_cloexec_or_inhexec_by_sysfdness(a) Perl_setfd_cloexec_or_inhexec_by_sysfdness(aTHX_ a) #define setfd_inhexec Perl_setfd_inhexec #define setfd_inhexec_for_sysfd(a) Perl_setfd_inhexec_for_sysfd(aTHX_ a) #define sub_crush_depth(a) Perl_sub_crush_depth(aTHX_ a) diff --git a/perl.c b/perl.c index 5c839f3900..d39bb1b466 100644 --- a/perl.c +++ b/perl.c @@ -842,7 +842,7 @@ perl_destruct(pTHXx) back into Perl_debug_log, as if we never actually closed it */ if(got_fd != debug_fd) { - if (PerlLIO_dup2_cloexec(got_fd, debug_fd) == -1) { + if (dup2(got_fd, debug_fd) == -1) { where = "dup2"; goto abort; } @@ -4075,6 +4075,8 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) CopFILE(PL_curcop), Strerror(errno)); } fd = PerlIO_fileno(rsfp); + if (fd >= 0) + setfd_cloexec(fd); if (fd < 0 || (PerlLIO_fstat(fd, &tmpstatbuf) >= 0 diff --git a/perlio.c b/perlio.c index f5eb4851b6..fa9f54feda 100644 --- a/perlio.c +++ b/perlio.c @@ -245,7 +245,7 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags) return win32_fdupopen(f); # else if (f) { - const int fd = PerlLIO_dup_cloexec(PerlIO_fileno(f)); + const int fd = PerlLIO_dup(PerlIO_fileno(f)); if (fd >= 0) { char mode[8]; # ifdef DJGPP @@ -289,7 +289,7 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, return NULL; if (*mode == IoTYPE_NUMERIC) { - fd = PerlLIO_open3_cloexec(name, imode, perm); + fd = PerlLIO_open3(name, imode, perm); if (fd >= 0) return PerlIO_fdopen(fd, mode + 1); } @@ -2642,7 +2642,6 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args) { - bool known_cloexec = 0; if (PerlIOValid(f)) { if (PerlIOBase(f)->tab && PerlIOBase(f)->flags & PERLIO_F_OPEN) (*PerlIOBase(f)->tab->Close)(aTHX_ f); @@ -2663,15 +2662,10 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, const char *path = SvPV_const(*args, len); if (!IS_SAFE_PATHNAME(path, len, "open")) return NULL; - fd = PerlLIO_open3_cloexec(path, imode, perm); - known_cloexec = 1; + fd = PerlLIO_open3(path, imode, perm); } } if (fd >= 0) { - if (known_cloexec) - setfd_inhexec_for_sysfd(fd); - else - setfd_cloexec_or_inhexec_by_sysfdness(fd); if (*mode == IoTYPE_IMPLICIT) mode++; if (!f) { @@ -2706,9 +2700,7 @@ PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) const PerlIOUnix * const os = PerlIOSelf(o, PerlIOUnix); int fd = os->fd; if (flags & PERLIO_DUP_FD) { - fd = PerlLIO_dup_cloexec(fd); - if (fd >= 0) - setfd_inhexec_for_sysfd(fd); + fd = PerlLIO_dup(fd); } if (fd >= 0) { f = PerlIOBase_dup(aTHX_ f, o, param, flags); @@ -2972,7 +2964,7 @@ PerlIO_importFILE(FILE *stdio, const char *mode) Note that the errno value set by a failing fdopen varies between stdio implementations. */ - const int fd = PerlLIO_dup_cloexec(fd0); + const int fd = PerlLIO_dup(fd0); FILE *f2; if (fd < 0) { return f; @@ -2994,12 +2986,11 @@ PerlIO_importFILE(FILE *stdio, const char *mode) if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)), PERLIO_FUNCS_CAST(&PerlIO_stdio), mode, NULL))) { s = PerlIOSelf(f, PerlIOStdio); s->stdio = stdio; - fd0 = fileno(stdio); - if(fd0 != -1){ - PerlIOUnix_refcnt_inc(fd0); - setfd_cloexec_or_inhexec_by_sysfdness(fd0); - } #ifdef EBCDIC + fd0 = fileno(stdio); + if(fd0 != -1){ + PerlIOUnix_refcnt_inc(fd0); + } else{ rc = fldata(stdio,filename,&fileinfo); if(rc != 0){ @@ -3010,6 +3001,8 @@ PerlIO_importFILE(FILE *stdio, const char *mode) } /*This MVS dataset , OK!*/ } +#else + PerlIOUnix_refcnt_inc(fileno(stdio)); #endif } } @@ -3035,9 +3028,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, if (!s->stdio) return NULL; s->stdio = stdio; - fd = fileno(stdio); - PerlIOUnix_refcnt_inc(fd); - setfd_cloexec_or_inhexec_by_sysfdness(fd); + PerlIOUnix_refcnt_inc(fileno(s->stdio)); return f; } else { @@ -3048,7 +3039,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, return NULL; if (*mode == IoTYPE_NUMERIC) { mode++; - fd = PerlLIO_open3_cloexec(path, imode, perm); + fd = PerlLIO_open3(path, imode, perm); } else { FILE *stdio; @@ -3068,9 +3059,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg); if (f) { PerlIOSelf(f, PerlIOStdio)->stdio = stdio; - fd = fileno(stdio); - PerlIOUnix_refcnt_inc(fd); - setfd_cloexec_or_inhexec_by_sysfdness(fd); + PerlIOUnix_refcnt_inc(fileno(stdio)); } else { PerlSIO_fclose(stdio); } @@ -3111,9 +3100,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, } if ((f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg))) { PerlIOSelf(f, PerlIOStdio)->stdio = stdio; - fd = fileno(stdio); - PerlIOUnix_refcnt_inc(fd); - setfd_cloexec_or_inhexec_by_sysfdness(fd); + PerlIOUnix_refcnt_inc(fileno(stdio)); } return f; } @@ -3134,7 +3121,7 @@ PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) const int fd = fileno(stdio); char mode[8]; if (flags & PERLIO_DUP_FD) { - const int dfd = PerlLIO_dup_cloexec(fileno(stdio)); + const int dfd = PerlLIO_dup(fileno(stdio)); if (dfd >= 0) { stdio = PerlSIO_fdopen(dfd, PerlIO_modestr(o,mode)); goto set_this; @@ -3150,9 +3137,7 @@ PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) set_this: PerlIOSelf(f, PerlIOStdio)->stdio = stdio; if(stdio) { - int fd = fileno(stdio); - PerlIOUnix_refcnt_inc(fd); - setfd_cloexec_or_inhexec_by_sysfdness(fd); + PerlIOUnix_refcnt_inc(fileno(stdio)); } } return f; @@ -3309,7 +3294,7 @@ PerlIOStdio_close(pTHX_ PerlIO *f) SAVE_ERRNO; invalidate = PerlIOStdio_invalidate_fileno(aTHX_ stdio); if (!invalidate) { - dupfd = PerlLIO_dup_cloexec(fd); + dupfd = PerlLIO_dup(fd); #ifdef USE_ITHREADS if (dupfd < 0) { /* Oh cXap. This isn't going to go well. Not sure if we can @@ -3334,8 +3319,7 @@ PerlIOStdio_close(pTHX_ PerlIO *f) result = close(fd); #endif if (dupfd >= 0) { - PerlLIO_dup2_cloexec(dupfd, fd); - setfd_inhexec_for_sysfd(fd); + PerlLIO_dup2(dupfd,fd); PerlLIO_close(dupfd); } MUTEX_UNLOCK(&PL_perlio_mutex); @@ -5055,19 +5039,19 @@ PerlIO_tmpfile(void) /* if TMPDIR is set and not empty, we try that first */ sv = newSVpv(tmpdir, 0); sv_catpv(sv, tempname + 4); - fd = Perl_my_mkstemp_cloexec(SvPVX(sv)); + fd = Perl_my_mkstemp(SvPVX(sv)); } if (fd < 0) { SvREFCNT_dec(sv); sv = NULL; /* else we try /tmp */ - fd = Perl_my_mkstemp_cloexec(tempname); + fd = Perl_my_mkstemp(tempname); } if (fd < 0) { /* Try cwd */ sv = newSVpvs("."); sv_catpv(sv, tempname + 4); - fd = Perl_my_mkstemp_cloexec(SvPVX(sv)); + fd = Perl_my_mkstemp(SvPVX(sv)); } umask(old_umask); if (fd >= 0) { diff --git a/pod/perliol.pod b/pod/perliol.pod index b70a510aad..55aaf147f7 100644 --- a/pod/perliol.pod +++ b/pod/perliol.pod @@ -505,14 +505,6 @@ arguments passed to them, I<n> is the index into that array of the layer being called. The macro C<PerlIOArg> will return a (possibly C<NULL>) SV * for the argument passed to the layer. -Where a layer opens or takes ownership of a file descriptor, that layer is -responsible for getting the file descriptor's close-on-exec flag into the -correct state. The flag should be clear for a file descriptor numbered -less than or equal to C<PL_maxsysfd>, and set for any file descriptor -numbered higher. For thread safety, when a layer opens a new file -descriptor it should if possible open it with the close-on-exec flag -initially set. - The I<mode> string is an "C<fopen()>-like" string which would match the regular expression C</^[I#]?[rwa]\+?[bt]?$/>. @@ -533,9 +525,6 @@ If I<fd> not negative then it is the numeric file descriptor I<fd>, which will be open in a manner compatible with the supplied mode string, the call is thus equivalent to C<PerlIO_fdopen>. In this case I<nargs> will be zero. -The file descriptor may have the close-on-exec flag either set or clear; -it is the responsibility of the layer that takes ownership of it to get -the flag into the correct state. If I<nargs> is greater than zero then it gives the number of arguments passed to C<open>, otherwise it will be 1 if for example diff --git a/pp_sys.c b/pp_sys.c index 5154b9baa8..1556626484 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -692,6 +692,8 @@ PP(pp_pipe_op) 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); @@ -2519,6 +2521,7 @@ PP(pp_socket) 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; @@ -2555,6 +2558,8 @@ PP(pp_sockpair) TAINT_PROPER("socketpair"); 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; @@ -2670,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); diff --git a/proto.h b/proto.h index 8e0c669db7..583d1e3a83 100644 --- a/proto.h +++ b/proto.h @@ -35,7 +35,9 @@ 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); +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__; @@ -2942,8 +2944,6 @@ PERL_CALLCONV void Perl_setdefout(pTHX_ GV* gv); #define PERL_ARGS_ASSERT_SETDEFOUT \ assert(gv) PERL_CALLCONV void Perl_setfd_cloexec(int fd); -PERL_CALLCONV void Perl_setfd_cloexec_for_nonsysfd(pTHX_ int fd); -PERL_CALLCONV void Perl_setfd_cloexec_or_inhexec_by_sysfdness(pTHX_ int fd); PERL_CALLCONV void Perl_setfd_inhexec(int fd); PERL_CALLCONV void Perl_setfd_inhexec_for_sysfd(pTHX_ int fd); PERL_CALLCONV char* Perl_setlocale(int category, const char* locale); diff --git a/toke.c b/toke.c index 6e2742742a..75249430f0 100644 --- a/toke.c +++ b/toke.c @@ -7669,6 +7669,11 @@ Perl_yylex(pTHX) if (!GvIO(gv)) GvIOp(gv) = newIO(); IoIFP(GvIOp(gv)) = PL_rsfp; + { + const int fd = PerlIO_fileno(PL_rsfp); + if (fd >= 3) + setfd_cloexec(fd); + } /* Mark this internal pseudo-handle as clean */ IoFLAGS(GvIOp(gv)) |= IOf_UNTAINT; if ((PerlIO*)PL_rsfp == PerlIO_stdin()) diff --git a/util.c b/util.c index 0fc7af6866..31b4f402bb 100644 --- a/util.c +++ b/util.c @@ -2238,7 +2238,7 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) taint_env(); taint_proper("Insecure %s%s", "EXEC"); } - if (PerlProc_pipe_cloexec(p) < 0) + if (PerlProc_pipe(p) < 0) return NULL; /* Try for another pipe pair for error return */ if (PerlProc_pipe_cloexec(pp) >= 0) @@ -2298,7 +2298,7 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) PerlLIO_close(pp[1]); /* Keep the lower of the two fd numbers */ if (p[that] < p[This]) { - PerlLIO_dup2_cloexec(p[This], p[that]); + PerlLIO_dup2(p[This], p[that]); PerlLIO_close(p[This]); p[This] = p[that]; } @@ -2378,7 +2378,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) taint_env(); taint_proper("Insecure %s%s", "EXEC"); } - if (PerlProc_pipe_cloexec(p) < 0) + if (PerlProc_pipe(p) < 0) return NULL; if (doexec && PerlProc_pipe_cloexec(pp) >= 0) did_pipes = 1; @@ -2450,7 +2450,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) if (did_pipes) PerlLIO_close(pp[1]); if (p[that] < p[This]) { - PerlLIO_dup2_cloexec(p[This], p[that]); + PerlLIO_dup2(p[This], p[that]); PerlLIO_close(p[This]); p[This] = p[that]; } -- Perl5 Master Repository