[PATCH] New procedure mkdtemp to create unique directory names

[Mike Gran via "Developers list for Guile, the GNU extensibility library" <guile-devel@gnu.org>]

* configure.ac (AC_CHECK_FUNCS): search mkdtemp
* doc/ref/posix.texi: document mkdtemp
* libguile/filesys.c (scm_mkdtemp) [HAVE_MKDTEMP]: new procedure
* libguile/filesys.h: declaration of scm_mkdtemp
* test-suite/tests/filesys.test: new tests 'mkdtemp: number arg',
    'mkdtemp: directory name template' and 'mkdtemp: directory created'
---
 configure.ac                  | 20 ++++++++++----------
 doc/ref/posix.texi            | 15 +++++++++++++++
 libguile/filesys.c            | 34 ++++++++++++++++++++++++++++++++++
 libguile/filesys.h            |  1 +
 test-suite/tests/filesys.test | 31 +++++++++++++++++++++++++++++++
 5 files changed, 91 insertions(+), 10 deletions(-)

diff --git a/configure.ac b/configure.ac
index 3e96094f6..743a4c7e7 100644
--- a/configure.ac
+++ b/configure.ac
@@ -484,16 +484,16 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
 #   sendfile - non-POSIX, found in glibc
 #
-AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid		\
-  fesetround ftime ftruncate fchown fchmod getcwd geteuid getsid	\
-  gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mknod nice	\
-  readlink rename rmdir setegid seteuid		                        \
-  setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64	\
-  strptime symlink sync sysconf tcgetpgrp tcsetpgrp uname waitpid	\
-  strdup system usleep atexit on_exit chown link fcntl ttyname getpwent	\
-  getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp	\
-  index bcopy memcpy rindex truncate isblank _NSGetEnviron		\
-  strcoll strcoll_l strtod_l strtol_l newlocale uselocale utimensat	\
+AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid         \
+  fesetround ftime ftruncate fchown fchmod getcwd geteuid getsid        \
+  gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
+  nice readlink rename rmdir setegid seteuid                            \
+  setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64  \
+  strptime symlink sync sysconf tcgetpgrp tcsetpgrp uname waitpid       \
+  strdup system usleep atexit on_exit chown link fcntl ttyname getpwent \
+  getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp  \
+  index bcopy memcpy rindex truncate isblank _NSGetEnviron              \
+  strcoll strcoll_l strtod_l strtol_l newlocale uselocale utimensat     \
   sched_getaffinity sched_setaffinity sendfile])
 
 # The newlib C library uses _NL_ prefixed locale langinfo constants.
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index f34c5222d..9cb0be038 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -1020,6 +1020,21 @@ The file is automatically deleted when the port is closed
 or the program terminates.
 @end deffn
 
+@deffn {Scheme Procedure} mkdtemp tmpl
+@deffnx {C Function} scm_mkdtemp (tmpl)
+@cindex temporary file
+Create a new unique directory in the file system and return
+its path.
+
+@var{tmpl} is a string specifying where the file should be created: it
+must end with @samp{XXXXXX}.  The return value is a string in which
+those @samp{X}s will be changed to reflect the name of the directory
+created.
+
+The directory mode will be @code{#o700}, as adjusted by the current
+@code{umask}.
+@end deffn
+
 @deffn {Scheme Procedure} dirname filename
 @deffnx {C Function} scm_dirname (filename)
 Return the directory name component of the file name
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 39bfd38cc..50f76c5a1 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1544,6 +1544,40 @@ scm_mkstemp (SCM tmpl)
   return scm_i_mkstemp (tmpl, SCM_UNDEFINED);
 }
 
+#if HAVE_MKDTEMP
+SCM_DEFINE (scm_mkdtemp, "mkdtemp", 1, 0, 0,
+	    (SCM tmpl),
+	    "Create a new unique directory in the file system and return\n"
+	    "its path.\n"
+	    "\n"
+	    "@var{tmpl} is a string specifying where the file should be\n"
+	    "created: it must end with @samp{XXXXXX}.  The return value is\n"
+            "a string that is the name of the directory created.\n"
+	    "\n"
+	    "The directory mode will be code{#o700}, as adjusted by the\n"
+            "current @code{umask}.")
+#define FUNC_NAME s_scm_mkdtemp
+{
+  char *c_tmpl;
+  char *rv;
+
+  SCM_VALIDATE_STRING (SCM_ARG1, tmpl);
+
+  scm_dynwind_begin (0);
+
+  c_tmpl = scm_to_locale_string (tmpl);
+  scm_dynwind_free (c_tmpl);
+  SCM_SYSCALL (rv = mkdtemp (c_tmpl));
+  if (rv == NULL)
+    SCM_SYSERROR;
+
+  scm_dynwind_end ();
+
+  return scm_from_locale_string (c_tmpl);
+}
+#undef FUNC_NAME
+#endif /* HAVE_MKDTEMP */
+
 \f
 /* Filename manipulation */
 
diff --git a/libguile/filesys.h b/libguile/filesys.h
index f870ee434..ec4a74a48 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -65,6 +65,7 @@ SCM_API SCM scm_symlink (SCM oldpath, SCM newpath);
 SCM_API SCM scm_readlink (SCM path);
 SCM_API SCM scm_lstat (SCM str);
 SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile);
+SCM_API SCM scm_mkdtemp (SCM tmpl);
 SCM_API SCM scm_dirname (SCM filename);
 SCM_API SCM scm_basename (SCM filename, SCM suffix);
 SCM_API SCM scm_canonicalize_path (SCM path);
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 9ec9f6172..f90ecd8a8 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -231,3 +231,34 @@
 (delete-file (test-file))
 (when (file-exists? (test-symlink))
   (delete-file (test-symlink)))
+
+
+(with-test-prefix "mkdtemp"
+
+  (pass-if-exception "number arg" exception:wrong-type-arg
+    (if (not (defined? 'mkdtemp))
+        (throw 'unresolved)
+        (mkdtemp 123)))
+
+  (pass-if "directory name template"
+    (if (not (defined? 'mkdtemp))
+        (throw 'unresolved)
+        (let* ((template "T-XXXXXX")
+               (str      (mkdtemp template))
+               (result   (and
+                          (string? str)
+                          (not (string=? str template))
+                          (string-contains str "T-")
+                          (= (string-length str 8)))))
+          (false-if-exception (rmdir str))
+          result)))
+
+  (pass-if "directory created"
+    (if (not (defined? 'mkdtemp))
+        (throw 'unresolved)
+        (let* ((template "T-XXXXXX")
+               (str      (mkdtemp template))
+               (_stat    (stat str))
+               (result   (eqv? 'directory (stat:type _stat))))
+          (false-if-exception (rmdir str))
+          result))))
-- 
2.29.2