rpms/perl
5
0
Fork 0
Code Issues Pull Requests Releases Activity

Preserve append mode when opening anonymous files

Browse Source
This commit is contained in:
Petr Písař 2019-07-17 14:26:48 +02:00
parent 9040dc1ebc
commit 8b21adb20c
4 changed files with 408 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

191
perl-5.30.0-perl-134221-support-append-mode-for-open-.-undef.patch Normal file
View File

@ -0,0 +1,191 @@
From 8e9cf86aa69cb79c91edf5ff0586f87bfe4c91bd Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
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ř <ppisar@redhat.com>
---
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

128
perl-5.31.1-perl-134221-support-O_APPEND-for-open-.-undef-on-VMS.patch Normal file
View File

@ -0,0 +1,128 @@
From 74b421cc877e412c4eda06757396a1e19fc756ba Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
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ř <ppisar@redhat.com>
---
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

76
perl-5.31.1-perl-134221-support-append-mode-temp-files-on-Win32-.patch Normal file
View File

@ -0,0 +1,76 @@
From 0424723402ef153af8ee44222315d9b6a818d1ba Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
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ř <ppisar@redhat.com>
---
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

13
perl.spec
View File

@ -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 <ppisar@redhat.com> - 4:5.30.0-440
- Fix an out-of-buffer read while parsing a Unicode property name (RT#134134)