129 lines
4.1 KiB
Diff
129 lines
4.1 KiB
Diff
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
|
|
|