From 8b21adb20c0f3f7df01bfad7abb72ec206eac700 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= Date: Wed, 17 Jul 2019 14:26:48 +0200 Subject: [PATCH] Preserve append mode when opening anonymous files --- ...support-append-mode-for-open-.-undef.patch | 191 ++++++++++++++++++ ...ort-O_APPEND-for-open-.-undef-on-VMS.patch | 128 ++++++++++++ ...ort-append-mode-temp-files-on-Win32-.patch | 76 +++++++ perl.spec | 13 ++ 4 files changed, 408 insertions(+) create mode 100644 perl-5.30.0-perl-134221-support-append-mode-for-open-.-undef.patch create mode 100644 perl-5.31.1-perl-134221-support-O_APPEND-for-open-.-undef-on-VMS.patch create mode 100644 perl-5.31.1-perl-134221-support-append-mode-temp-files-on-Win32-.patch diff --git a/perl-5.30.0-perl-134221-support-append-mode-for-open-.-undef.patch b/perl-5.30.0-perl-134221-support-append-mode-for-open-.-undef.patch new file mode 100644 index 0000000..e954285 --- /dev/null +++ b/perl-5.30.0-perl-134221-support-append-mode-for-open-.-undef.patch @@ -0,0 +1,191 @@ +From 8e9cf86aa69cb79c91edf5ff0586f87bfe4c91bd Mon Sep 17 00:00:00 2001 +From: Tony Cook +Date: Tue, 2 Jul 2019 14:16:35 +1000 +Subject: [PATCH] (perl #134221) support append mode for open .. undef +MIME-Version: 1.0 +Content-Type: text/plain; charset=UTF-8 +Content-Transfer-Encoding: 8bit + +Petr Písař: Ported to 5.30.0 from +45b29440d38be155c5177c8d6f9a5d4e7c2c098c. + +Signed-off-by: Petr Písař +--- + doio.c | 15 +++++++++++++++ + embed.fnc | 1 + + perlio.c | 26 +++++++++++++++++++++----- + perlio.h | 3 +++ + proto.h | 5 +++++ + t/io/perlio_open.t | 14 ++++++++++++-- + 6 files changed, 57 insertions(+), 7 deletions(-) + +diff --git a/doio.c b/doio.c +index 05a0696..424e0e3 100644 +--- a/doio.c ++++ b/doio.c +@@ -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) +diff --git a/embed.fnc b/embed.fnc +index 259affd..c977d39 100644 +--- a/embed.fnc ++++ b/embed.fnc +@@ -476,6 +476,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 + pnoR |int |my_mkstemp_cloexec|NN char *templte ++pnoR |int |my_mkostemp_cloexec|NN char *templte|int flags + #ifdef HAS_PIPE + pR |int |PerlProc_pipe_cloexec|NN int *pipefd + #endif +diff --git a/perlio.c b/perlio.c +index 904d47a..5a0cd36 100644 +--- a/perlio.c ++++ b/perlio.c +@@ -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) +@@ -5048,6 +5050,15 @@ PerlIO_stdoutf(const char *fmt, ...) + #undef PerlIO_tmpfile + 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; +@@ -5063,27 +5074,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); +diff --git a/perlio.h b/perlio.h +index d515020..ee16ab8 100644 +--- a/perlio.h ++++ b/perlio.h +@@ -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 +diff --git a/proto.h b/proto.h +index 74a8e46..e0ea55b 100644 +--- a/proto.h ++++ b/proto.h +@@ -2270,6 +2270,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 99d7e51..56c354b 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"); ++} + + +-- +2.20.1 + diff --git a/perl-5.31.1-perl-134221-support-O_APPEND-for-open-.-undef-on-VMS.patch b/perl-5.31.1-perl-134221-support-O_APPEND-for-open-.-undef-on-VMS.patch new file mode 100644 index 0000000..6bed38d --- /dev/null +++ b/perl-5.31.1-perl-134221-support-O_APPEND-for-open-.-undef-on-VMS.patch @@ -0,0 +1,128 @@ +From 74b421cc877e412c4eda06757396a1e19fc756ba Mon Sep 17 00:00:00 2001 +From: Tony Cook +Date: Mon, 15 Jul 2019 11:53:23 +1000 +Subject: [PATCH 3/3] (perl #134221) support O_APPEND for open ..., undef on + VMS +MIME-Version: 1.0 +Content-Type: text/plain; charset=UTF-8 +Content-Transfer-Encoding: 8bit + +VMS doesn't allow you to delete an open file like POSIXish systems +do, but you can mark a file to be deleted once it's closed, but +only when you open it. + +Since VMS doesn't (yet) have mkostemp() we can add our own flag to +our mkostemp() emulation to pass the necessary magic to open() call +to delete the file on close. + +Signed-off-by: Petr Písař +--- + perlio.c | 10 ++++++---- + util.c | 15 ++++++++++++++- + util.h | 11 +++++++++++ + 3 files changed, 31 insertions(+), 5 deletions(-) + +diff --git a/perlio.c b/perlio.c +index 81ebc156ad..805959f840 100644 +--- a/perlio.c ++++ b/perlio.c +@@ -5062,7 +5062,7 @@ PerlIO_tmpfile_flags(int imode) + const int fd = win32_tmpfd_mode(imode); + if (fd >= 0) + f = PerlIO_fdopen(fd, "w+b"); +-#elif ! defined(VMS) && ! defined(OS2) ++#elif ! defined(OS2) + int fd = -1; + char tempname[] = "/tmp/PerlIO_XXXXXX"; + const char * const tmpdir = TAINTING_get ? NULL : PerlEnv_getenv("TMPDIR"); +@@ -5073,19 +5073,19 @@ PerlIO_tmpfile_flags(int imode) + /* if TMPDIR is set and not empty, we try that first */ + sv = newSVpv(tmpdir, 0); + sv_catpv(sv, tempname + 4); +- fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode); ++ fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode | O_VMS_DELETEONCLOSE); + } + if (fd < 0) { + SvREFCNT_dec(sv); + sv = NULL; + /* else we try /tmp */ +- fd = Perl_my_mkostemp_cloexec(tempname, imode); ++ fd = Perl_my_mkostemp_cloexec(tempname, imode | O_VMS_DELETEONCLOSE); + } + if (fd < 0) { + /* Try cwd */ + sv = newSVpvs("."); + sv_catpv(sv, tempname + 4); +- fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode); ++ fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode | O_VMS_DELETEONCLOSE); + } + umask(old_umask); + if (fd >= 0) { +@@ -5096,7 +5096,9 @@ PerlIO_tmpfile_flags(int imode) + f = PerlIO_fdopen(fd, mode); + if (f) + PerlIOBase(f)->flags |= PERLIO_F_TEMP; ++# ifndef VMS + PerlLIO_unlink(sv ? SvPVX_const(sv) : tempname); ++# endif + } + SvREFCNT_dec(sv); + #else /* !HAS_MKSTEMP, fallback to stdio tmpfile(). */ +diff --git a/util.c b/util.c +index e6863f6dfe..165d13a39e 100644 +--- a/util.c ++++ b/util.c +@@ -5712,6 +5712,11 @@ S_my_mkostemp(char *templte, int flags) { + STRLEN len = strlen(templte); + int fd; + int attempts = 0; ++#ifdef VMS ++ int delete_on_close = flags & O_VMS_DELETEONCLOSE; ++ ++ flags &= ~O_VMS_DELETEONCLOSE; ++#endif + + if (len < 6 || + templte[len-1] != 'X' || templte[len-2] != 'X' || templte[len-3] != 'X' || +@@ -5725,7 +5730,15 @@ S_my_mkostemp(char *templte, int flags) { + for (i = 1; i <= 6; ++i) { + templte[len-i] = TEMP_FILE_CH[(int)(Perl_internal_drand48() * TEMP_FILE_CH_COUNT)]; + } +- fd = PerlLIO_open3(templte, O_RDWR | O_CREAT | O_EXCL | flags, 0600); ++#ifdef VMS ++ if (delete_on_close) { ++ fd = open(templte, O_RDWR | O_CREAT | O_EXCL | flags, 0600, "fop=dlt"); ++ } ++ else ++#endif ++ { ++ fd = PerlLIO_open3(templte, O_RDWR | O_CREAT | O_EXCL | flags, 0600); ++ } + } while (fd == -1 && errno == EEXIST && ++attempts <= 100); + + return fd; +diff --git a/util.h b/util.h +index d8fa3e8396..d9df7b39c6 100644 +--- a/util.h ++++ b/util.h +@@ -248,6 +248,17 @@ means arg not present, 1 is empty string/null byte */ + int mkstemp(char*); + #endif + ++#ifdef PERL_CORE ++# if defined(VMS) ++/* only useful for calls to our mkostemp() emulation */ ++# define O_VMS_DELETEONCLOSE 0x40000000 ++# ifdef HAS_MKOSTEMP ++# error 134221 will need a new solution for VMS ++# endif ++# else ++# define O_VMS_DELETEONCLOSE 0 ++# endif ++#endif + #if defined(HAS_MKOSTEMP) && defined(PERL_CORE) + # define Perl_my_mkostemp(templte, flags) mkostemp(templte, flags) + #endif +-- +2.20.1 + diff --git a/perl-5.31.1-perl-134221-support-append-mode-temp-files-on-Win32-.patch b/perl-5.31.1-perl-134221-support-append-mode-temp-files-on-Win32-.patch new file mode 100644 index 0000000..21306c1 --- /dev/null +++ b/perl-5.31.1-perl-134221-support-append-mode-temp-files-on-Win32-.patch @@ -0,0 +1,76 @@ +From 0424723402ef153af8ee44222315d9b6a818d1ba Mon Sep 17 00:00:00 2001 +From: Tony Cook +Date: Tue, 2 Jul 2019 15:22:26 +1000 +Subject: [PATCH 2/3] (perl #134221) support append mode temp files on Win32 + too +MIME-Version: 1.0 +Content-Type: text/plain; charset=UTF-8 +Content-Transfer-Encoding: 8bit + +Signed-off-by: Petr Písař +--- + perlio.c | 2 +- + win32/win32.c | 10 +++++++++- + win32/win32iop.h | 1 + + 3 files changed, 11 insertions(+), 2 deletions(-) + +diff --git a/perlio.c b/perlio.c +index a737e79e02..81ebc156ad 100644 +--- a/perlio.c ++++ b/perlio.c +@@ -5059,7 +5059,7 @@ PerlIO_tmpfile_flags(int imode) + #endif + PerlIO *f = NULL; + #ifdef WIN32 +- const int fd = win32_tmpfd(); ++ const int fd = win32_tmpfd_mode(imode); + if (fd >= 0) + f = PerlIO_fdopen(fd, "w+b"); + #elif ! defined(VMS) && ! defined(OS2) +diff --git a/win32/win32.c b/win32/win32.c +index 8104d864c2..91fdffe09b 100644 +--- a/win32/win32.c ++++ b/win32/win32.c +@@ -2907,10 +2907,18 @@ win32_rewind(FILE *pf) + + DllExport int + win32_tmpfd(void) ++{ ++ return win32_tmpfd_mode(0); ++} ++ ++DllExport int ++win32_tmpfd_mode(int mode) + { + char prefix[MAX_PATH+1]; + char filename[MAX_PATH+1]; + DWORD len = GetTempPath(MAX_PATH, prefix); ++ mode &= ~( O_ACCMODE | O_CREAT | O_EXCL ); ++ mode |= O_RDWR; + if (len && len < MAX_PATH) { + if (GetTempFileName(prefix, "plx", 0, filename)) { + HANDLE fh = CreateFile(filename, +@@ -2922,7 +2930,7 @@ win32_tmpfd(void) + | FILE_FLAG_DELETE_ON_CLOSE, + NULL); + if (fh != INVALID_HANDLE_VALUE) { +- int fd = win32_open_osfhandle((intptr_t)fh, 0); ++ int fd = win32_open_osfhandle((intptr_t)fh, mode); + if (fd >= 0) { + PERL_DEB(dTHX;) + DEBUG_p(PerlIO_printf(Perl_debug_log, +diff --git a/win32/win32iop.h b/win32/win32iop.h +index 53330e5951..559e1f9cd2 100644 +--- a/win32/win32iop.h ++++ b/win32/win32iop.h +@@ -64,6 +64,7 @@ DllExport int win32_fgetpos(FILE *pf,fpos_t *p); + DllExport int win32_fsetpos(FILE *pf,const fpos_t *p); + DllExport void win32_rewind(FILE *pf); + DllExport int win32_tmpfd(void); ++DllExport int win32_tmpfd_mode(int mode); + DllExport FILE* win32_tmpfile(void); + DllExport void win32_abort(void); + DllExport int win32_fstat(int fd,Stat_t *sbufptr); +-- +2.20.1 + diff --git a/perl.spec b/perl.spec index 8374819..e6e66fa 100644 --- a/perl.spec +++ b/perl.spec @@ -223,6 +223,12 @@ Patch40: perl-5.31.1-perl-122112-make-sure-SIGPIPE-is-delivered-if-we-tes # RT#134275, fixed after 5.31.1 Patch41: perl-5.31.1-avoid-SEGV-with-uninit-warning-with-multideref.patch +# Preserve append mode when opening anonymous files, RT#134221, +# fixed after 5.31.1 +Patch42: perl-5.30.0-perl-134221-support-append-mode-for-open-.-undef.patch +Patch43: perl-5.31.1-perl-134221-support-append-mode-temp-files-on-Win32-.patch +Patch44: perl-5.31.1-perl-134221-support-O_APPEND-for-open-.-undef-on-VMS.patch + # Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048 Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch @@ -2782,6 +2788,9 @@ Perl extension for Version Objects %patch39 -p1 %patch40 -p1 %patch41 -p1 +%patch42 -p1 +%patch43 -p1 +%patch44 -p1 %patch200 -p1 %patch201 -p1 @@ -2830,6 +2839,9 @@ perl -x patchlevel.h \ 'Fedora Patch39: Fix %%{^CAPTURE} value when used after @{^CAPTURE} (RT#134193)' \ 'Fedora Patch40: Fix a test for a crash in SIGALARM handler when waiting on a child process to be closed (RT#122112)' \ 'Fedora Patch41: Fix a crash on an uninitialized warning when processing a multideref node (RT#134275)' \ + 'Fedora Patch42: Preserve append mode when opening anonymous files (RT#134221)' \ + 'Fedora Patch43: Preserve append mode when opening anonymous files (RT#134221)' \ + 'Fedora Patch44: Preserve append mode when opening anonymous files (RT#134221)' \ 'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \ 'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \ %{nil} @@ -5080,6 +5092,7 @@ popd be closed (RT#122112) - Fix a crash on an uninitialized warning when processing a multideref node (RT#134275) +- Preserve append mode when opening anonymous files (RT#134221) * Tue Jun 25 2019 Petr Pisar - 4:5.30.0-440 - Fix an out-of-buffer read while parsing a Unicode property name (RT#134134)