(perl #127663) add our own mkstemp() implementation

Needed to generate temp files for safer in-place editing.

Not based on any particular implementation, the BSD implementations
tend to be wrappers around a megafunction that also does a few variations
of mkstemp() and mkdtemp(), which we don't need (yet.)

This might also be useful as a replacement for broken mkstemp()
implementations that use a mode of 0666 when creating the file, though
we'd need to add Configure probing for that.

diff --git a/embed.fnc b/embed.fnc
index 44d8d40..46fdf46 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -3053,6 +3053,10 @@ Apnod    |Size_t |my_strlcat     |NULLOK char *dst|NULLOK const char *src|Size_t size
 Apnod  |Size_t |my_strlcpy     |NULLOK char *dst|NULLOK const char *src|Size_t size
 #endif
 
+#ifndef HAS_MKSTEMP
+pno    |int    |my_mkstemp     |NN char *templte
+#endif
+
 APpdn  |bool   |isinfnan       |NV nv
 p      |bool   |isinfnansv     |NN SV *sv
 

diff --git a/proto.h b/proto.h
index 637b3c9..6bb89e5 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3856,6 +3856,11 @@ STATIC int       S_dooneliner(pTHX_ const char *cmd, const char *filename)
 
 #  endif
 #endif
+#if !defined(HAS_MKSTEMP)
+PERL_CALLCONV int      Perl_my_mkstemp(char *templte);
+#define PERL_ARGS_ASSERT_MY_MKSTEMP    \
+       assert(templte)
+#endif
 #if !defined(HAS_RENAME)
 PERL_CALLCONV I32      Perl_same_dirent(pTHX_ const char* a, const char* b);
 #define PERL_ARGS_ASSERT_SAME_DIRENT   \

diff --git a/util.c b/util.c
index 136e4ca..e2feb7f 100644 (file)
--- a/util.c
+++ b/util.c
@@ -5789,6 +5789,40 @@ Perl_my_dirfd(DIR * dir) {
 #endif 
 }
 
+#ifndef HAS_MKSTEMP
+
+#define TEMP_FILE_CH "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvxyz0123456789"
+#define TEMP_FILE_CH_COUNT (sizeof(TEMP_FILE_CH)-1)
+
+int
+Perl_my_mkstemp(char *templte) {
+    dTHX;
+    STRLEN len = strlen(templte);
+    int fd;
+    int attempts = 0;
+
+    PERL_ARGS_ASSERT_MY_MKSTEMP;
+
+    if (len < 6 ||
+        templte[len-1] != 'X' || templte[len-2] != 'X' || templte[len-3] != 'X' ||
+        templte[len-4] != 'X' || templte[len-5] != 'X' || templte[len-6] != 'X') {
+        errno = EINVAL;
+        return -1;
+    }
+
+    do {
+        int i;
+        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, 0600);
+    } while (fd == -1 && errno == EEXIST && ++attempts <= 100);
+
+    return fd;
+}
+
+#endif
+
 REGEXP *
 Perl_get_re_arg(pTHX_ SV *sv) {
 

diff --git a/util.h b/util.h
index 4589808..6b63d90 100644 (file)
--- a/util.h
+++ b/util.h
@@ -246,6 +246,10 @@ means arg not present, 1 is empty string/null byte */
             ((char *) memmem(big, bigend - big, little, lend - little))
 #endif
 
+#if defined(HAS_MKSTEMP) && defined(PERL_CORE)
+#   define Perl_my_mkstemp(templte) mkstemp(templte)
+#endif
+
 #endif /* PERL_UTIL_H_ */
 
 /*