diff options
author | Michael Gran <spk121@yahoo.com> | 2021-01-19 05:00:49 -0800 |
---|---|---|
committer | Michael Gran <spk121@yahoo.com> | 2021-01-19 05:58:14 -0800 |
commit | d98e1d5e4fd9a8d3d37b81d6dc71edabb6b2adae (patch) | |
tree | 699ee718764304c3e15741965b6e7e884e685c39 | |
parent | d60ff39105199dc6c3da5a69c28a967fed2965ba (diff) | |
download | guile-d98e1d5e4fd9a8d3d37b81d6dc71edabb6b2adae.tar.gz |
New procedure mkdtemp! to create unique temporary directory
* configure.ac (AC_CHECK_FUNCS): add mkdtemp! test
* doc/ref/posix.texi: document mkdtemp!
* libguile/filesys.c (scm_mkdtemp_x): new function
* libguile/filesys.h: new declaration for scm_mkdtemp_x
* test-suite/tests/filesys.test: add tests for mkdtemp!
Adapted from a patch by Rob Browning.
-rw-r--r-- | configure.ac | 22 | ||||
-rw-r--r-- | doc/ref/posix.texi | 21 | ||||
-rw-r--r-- | libguile/filesys.c | 42 | ||||
-rw-r--r-- | libguile/filesys.h | 1 | ||||
-rw-r--r-- | test-suite/tests/filesys.test | 39 |
5 files changed, 112 insertions, 13 deletions
diff --git a/configure.ac b/configure.ac index 3e96094f6..3150e456d 100644 --- a/configure.ac +++ b/configure.ac @@ -3,7 +3,7 @@ dnl Process this file with autoconf to produce configure. dnl define(GUILE_CONFIGURE_COPYRIGHT,[[ -Copyright 1998-2020 Free Software Foundation, Inc. +Copyright 1998-2021 Free Software Foundation, Inc. This file is part of Guile. @@ -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..8ea5baa5c 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -1,7 +1,7 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. @c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007, -@c 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2017 Free Software Foundation, Inc. +@c 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2017, 2021 Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @node POSIX @@ -1020,6 +1020,25 @@ 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_x (tmpl) +@cindex temporary directory +Create a new directory named in accordance with the template string +@var{tmpl}. + +@var{tmpl} is a string specifying the directory's name. The last six +characters of @var{tmpl} must be @samp{XXXXXX}, characters that will be +modified to ensure the directory name is unique. Upon successful +execution, those @samp{X}s will be changed to reflect the name of the +unique directory created. + +The permissions of the directory created are OS dependent, but, are +usually @code{#o700}. + +The return value is unspecified. An error may be thrown if the template +has the wrong format or if the directory cannot be created. +@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..3cd3446c8 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1,4 +1,4 @@ -/* Copyright 1996-2002,2004,2006,2009-2019 +/* Copyright 1996-2002,2004,2006,2009-2019,2021 Free Software Foundation, Inc. This file is part of Guile. @@ -1544,6 +1544,46 @@ scm_mkstemp (SCM tmpl) return scm_i_mkstemp (tmpl, SCM_UNDEFINED); } +#if HAVE_MKDTEMP +SCM_DEFINE (scm_mkdtemp_x, "mkdtemp!", 1, 0, 0, + (SCM tmpl), + "Create a new unique directory in the file system named in\n" + "accordance with @var{tmpl}. The last 6 characters of the\n" + "template must be XXXXXX\n" + "\n" + "Upon success, the template string -- if mutable -- will be\n" + "modified in place with the name of the directory created.\n" + "The name will also be the return value.\n" + "\n" + "An error may be thrown if the template is incorrect or if\n" + "the directory could not be created.\n") +#define FUNC_NAME s_scm_mkdtemp_x +{ + char *c_tmpl; + char *rv; + + SCM_VALIDATE_STRING (SCM_ARG1, tmpl); + + /* Ensure tmpl is mutable. */ + scm_i_string_start_writing (tmpl); + scm_i_string_stop_writing (); + + 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_substring_move_x (scm_from_locale_string (c_tmpl), + SCM_INUM0, scm_string_length (tmpl), + tmpl, SCM_INUM0); + scm_dynwind_end (); + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME +#endif /* HAVE_MKDTEMP */ + /* Filename manipulation */ diff --git a/libguile/filesys.h b/libguile/filesys.h index e25d59477..7f8f6ee4e 100644 --- a/libguile/filesys.h +++ b/libguile/filesys.h @@ -66,6 +66,7 @@ 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_mkstemp (SCM tmpl); +SCM_API SCM scm_mkdtemp_x (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..8ef4e396e 100644 --- a/test-suite/tests/filesys.test +++ b/test-suite/tests/filesys.test @@ -231,3 +231,42 @@ (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 prefix is unmodified" + (if (not (defined? 'mkdtemp!)) + (throw 'unresolved) + (let ((template (string-copy "T-XXXXXX"))) + (mkdtemp! template) + (false-if-exception (rmdir template)) + (and + (string? template) + (string-contains template "T-") + (= (string-length template) 8))))) + + (pass-if-exception "read-only template" exception:miscellaneous-error + (if (not (defined? 'mkdtemp!)) + (throw 'unresolved) + (mkdtemp! (substring/read-only "T-XXXXXX" 0)))) + + (pass-if-exception "invalid template" exception:system-error + (if (not (defined? 'mkdtemp!)) + (throw 'unresolved) + (mkdtemp! (string-copy "T-AAAAAA" 0)))) + + (pass-if "directory created" + (if (not (defined? 'mkdtemp!)) + (throw 'unresolved) + (let ((template (string-copy "T-XXXXXX"))) + (mkdtemp! template) + (let* ((_stat (stat template)) + (result (eqv? 'directory (stat:type _stat)))) + (false-if-exception (rmdir template)) + result))))) |