[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] New procedure mkdtemp to create unique directory names
From: |
Mike Gran |
Subject: |
[PATCH] New procedure mkdtemp to create unique directory names |
Date: |
Wed, 30 Dec 2020 00:45:55 -0800 |
* 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 */
+
/* 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