diff options
| -rw-r--r-- | doio.c | 15 | ||||
| -rw-r--r-- | embed.fnc | 1 | ||||
| -rw-r--r-- | perlio.c | 26 | ||||
| -rw-r--r-- | perlio.h | 3 | ||||
| -rw-r--r-- | proto.h | 5 | ||||
| -rw-r--r-- | t/io/perlio_open.t | 14 |
6 files changed, 57 insertions, 7 deletions
@@ -265,6 +265,21 @@ Perl_my_mkstemp_cloexec(char *templte) #endif } +int +Perl_my_mkostemp_cloexec(char *templte, int flags) +{ + dVAR; + 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) @@ -543,6 +543,7 @@ p |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 pToR |int |my_mkstemp_cloexec|NN char *templte +pToR |int |my_mkostemp_cloexec|NN char *templte|int flags #ifdef HAS_PIPE pR |int |PerlProc_pipe_cloexec|NN int *pipefd #endif @@ -1490,7 +1490,9 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args) { if (!f && narg == 1 && *args == &PL_sv_undef) { - if ((f = PerlIO_tmpfile())) { + int imode = PerlIOUnix_oflags(mode); + + if (imode != -1 && (f = PerlIO_tmpfile_flags(imode))) { if (!layers || !*layers) layers = Perl_PerlIO_context_layers(aTHX_ mode); if (layers && *layers) @@ -5043,6 +5045,15 @@ PerlIO_stdoutf(const char *fmt, ...) PerlIO * PerlIO_tmpfile(void) { + return PerlIO_tmpfile_flags(0); +} + +#define MKOSTEMP_MODES ( O_RDWR | O_CREAT | O_EXCL ) +#define MKOSTEMP_MODE_MASK ( O_ACCMODE | O_CREAT | O_EXCL | O_TRUNC ) + +PerlIO * +PerlIO_tmpfile_flags(int imode) +{ #ifndef WIN32 dTHX; #endif @@ -5057,27 +5068,32 @@ PerlIO_tmpfile(void) const char * const tmpdir = TAINTING_get ? NULL : PerlEnv_getenv("TMPDIR"); SV * sv = NULL; int old_umask = umask(0177); + imode &= ~MKOSTEMP_MODE_MASK; if (tmpdir && *tmpdir) { /* 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_mkostemp_cloexec(SvPVX(sv), imode); } if (fd < 0) { SvREFCNT_dec(sv); sv = NULL; /* else we try /tmp */ - fd = Perl_my_mkstemp_cloexec(tempname); + fd = Perl_my_mkostemp_cloexec(tempname, imode); } if (fd < 0) { /* Try cwd */ sv = newSVpvs("."); sv_catpv(sv, tempname + 4); - fd = Perl_my_mkstemp_cloexec(SvPVX(sv)); + fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode); } umask(old_umask); if (fd >= 0) { - f = PerlIO_fdopen(fd, "w+"); + /* fdopen() with a numeric mode */ + char mode[8]; + int writing = 1; + (void)PerlIO_intmode2str(imode | MKOSTEMP_MODES, mode, &writing); + f = PerlIO_fdopen(fd, mode); if (f) PerlIOBase(f)->flags |= PERLIO_F_TEMP; PerlLIO_unlink(sv ? SvPVX_const(sv) : tempname); @@ -286,6 +286,9 @@ PERL_CALLCONV SSize_t PerlIO_get_bufsiz(PerlIO *); #ifndef PerlIO_tmpfile PERL_CALLCONV PerlIO *PerlIO_tmpfile(void); #endif +#ifndef PerlIO_tmpfile_flags +PERL_CALLCONV PerlIO *PerlIO_tmpfile_flags(int flags); +#endif #ifndef PerlIO_stdin PERL_CALLCONV PerlIO *PerlIO_stdin(void); #endif @@ -2275,6 +2275,11 @@ PERL_CALLCONV Pid_t Perl_my_fork(void); PERL_CALLCONV I32 Perl_my_lstat(pTHX); #endif PERL_CALLCONV I32 Perl_my_lstat_flags(pTHX_ const U32 flags); +PERL_CALLCONV int Perl_my_mkostemp_cloexec(char *templte, int flags) + __attribute__warn_unused_result__; +#define PERL_ARGS_ASSERT_MY_MKOSTEMP_CLOEXEC \ + assert(templte) + PERL_CALLCONV int Perl_my_mkstemp_cloexec(char *templte) __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT_MY_MKSTEMP_CLOEXEC \ diff --git a/t/io/perlio_open.t b/t/io/perlio_open.t index 99d7e51646..56c354bf67 100644 --- a/t/io/perlio_open.t +++ b/t/io/perlio_open.t @@ -11,7 +11,7 @@ BEGIN { use strict; use warnings; -plan tests => 6; +plan tests => 10; use Fcntl qw(:seek); @@ -31,6 +31,16 @@ use Fcntl qw(:seek); is($data, "the right read stuff", "found the right stuff"); } - +SKIP: +{ + ok((open my $fh, "+>>", undef), "open my \$fh, '+>>', undef") + or skip "can't open temp for append: $!", 3; + print $fh "abc"; + ok(seek($fh, 0, SEEK_SET), "seek to zero"); + print $fh "xyz"; + ok(seek($fh, 0, SEEK_SET), "seek to zero again"); + my $data = <$fh>; + is($data, "abcxyz", "check the second write appended"); +} |