diff options
author | Andy Wingo <wingo@pobox.com> | 2021-03-10 20:35:58 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2021-03-10 20:40:10 +0100 |
commit | 85433fc2b122dc78342c3c83941949d1d9318399 (patch) | |
tree | 2fff776765468df861dc8a8c5e80f551b4905a5f | |
parent | 89a299102ff3597a48febe1fb6d3097fddcda40e (diff) | |
download | guile-85433fc2b122dc78342c3c83941949d1d9318399.tar.gz |
Add mkstemp; undocument mkstemp!
* doc/ref/posix.texi (File System): Update to document mkstemp only.
* libguile/filesys.c: Make a mkstemp that doesn't modify the input
template. Instead the caller has to get the file name from
port-filename.
(scm_mkstemp): Use the new mkstemp to implement mkstemp!. Can't
deprecate yet though as the replacement hasn't been there for long
enough.
* libguile/posix.c (scm_tempnam): Update to mention mkstemp instead.
* module/system/base/compile.scm (call-with-output-file/atomic): Use
mkstemp.
* test-suite/tests/posix.test:
* test-suite/tests/r6rs-files.test: Use mkstemp.
* NEWS: Update.
-rw-r--r-- | NEWS | 4 | ||||
-rw-r--r-- | doc/ref/posix.texi | 25 | ||||
-rw-r--r-- | libguile/filesys.c | 74 | ||||
-rw-r--r-- | libguile/posix.c | 6 | ||||
-rw-r--r-- | module/system/base/compile.scm | 12 | ||||
-rw-r--r-- | test-suite/tests/posix.test | 24 | ||||
-rw-r--r-- | test-suite/tests/r6rs-files.test | 12 |
7 files changed, 93 insertions, 64 deletions
@@ -156,7 +156,9 @@ See "Environment Variables" in the manual. See "File System" in the manual. There is still `mkstemp!' but we recommend that new code uses `mkstemp', which does not mutate the -contents of the "template" argument string. +contents of the "template" argument string. Instead for `mkstemp' you +get the name of the newly-created file by calling `port-filename' on the +returned port. ** `(system foreign-library)' module diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index e78e1510c..7633bd5a3 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -981,27 +981,30 @@ and causing you to overwrite that. The safe way is to create the file using @code{open} with @code{O_EXCL} to avoid any overwriting. A loop can try again with another name if the file exists (error @code{EEXIST}). -@code{mkstemp!} below does that. +@code{mkstemp} below does that. @end deffn -@deffn {Scheme Procedure} mkstemp! tmpl [mode] -@deffnx {C Function} scm_mkstemp (tmpl) +@deffn {Scheme Procedure} mkstemp tmpl [mode] @cindex temporary file Create a new unique file in the file system and return a new buffered port open for reading and writing to the file. @var{tmpl} is a string specifying where the file should be created: it -must end with @samp{XXXXXX} and those @samp{X}s will be changed in the -string to return the name of the file. (@code{port-filename} on the -port also gives the name.) +must end with @samp{XXXXXX}. The name of the newly created file will be +the same as @var{tmpl}, but with those @samp{X}s changed, and can be +determined by calling @code{port-filename} on the returned port. -POSIX doesn't specify the permissions mode of the file, on GNU and -most systems it's @code{#o600}. An application can use @code{chmod} -to relax that if desired. For example @code{#o666} less @code{umask}, -which is usual for ordinary file creation, +Note that the newly created file is not deleted automatically by Guile; +probably the caller should arrange to call @code{delete-file} when the +file is no longer needed. + +POSIX doesn't specify the permissions mode of the file. On GNU and most +systems it's @code{#o600}; an application can use @code{chmod} to relax +that if desired. For example @code{#o666} less @code{umask}, which is +usual for ordinary file creation, @example -(let ((port (mkstemp! (string-copy "/tmp/myfile-XXXXXX")))) +(let ((port (mkstemp "/tmp/myfile-XXXXXX"))) (chmod port (logand #o666 (lognot (umask)))) ...) @end example diff --git a/libguile/filesys.c b/libguile/filesys.c index 1b0af6e14..7ca46c8af 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1454,24 +1454,29 @@ SCM_DEFINE (scm_umask, "umask", 0, 1, 0, #undef FUNC_NAME SCM_INTERNAL SCM scm_i_mkstemp (SCM, SCM); -SCM_DEFINE (scm_i_mkstemp, "mkstemp!", 1, 1, 0, +SCM_DEFINE (scm_i_mkstemp, "mkstemp", 1, 1, 0, (SCM tmpl, SCM mode), - "Create a new unique file in the file system and return a new\n" - "buffered port open for reading and writing to the file.\n" + "Create a new unique file in the file system. Return\n" + "a buffered port open for reading and writing to the file.\n" "\n" "@var{tmpl} is a string specifying where the file should be\n" - "created: it must end with @samp{XXXXXX} and those @samp{X}s\n" - "will be changed in the string to return the name of the file.\n" - "(@code{port-filename} on the port also gives the name.)\n" - "\n" - "POSIX doesn't specify the permissions mode of the file, on GNU\n" - "and most systems it's @code{#o600}. An application can use\n" - "@code{chmod} to relax that if desired. For example\n" + "created: it must end with @samp{XXXXXX}. The name of the\n" + "newly created file will be the same as @var{tmpl}, but with\n" + "those @samp{X}s changed, and can be determined by calling\n" + "@code{port-filename} on the returned port.\n" + "\n" + "Note that the newly created file is not deleted automatically\n" + "by Guile; probably the caller should arrange to call\n" + "@code{delete-file} when the file is no longer needed.\n" + "\n" + "POSIX doesn't specify the permissions mode of the file.\n" + "On GNU and most systems it's @code{#o600}. An application can\n" + "use @code{chmod} to relax that if desired. For example\n" "@code{#o666} less @code{umask}, which is usual for ordinary\n" "file creation,\n" "\n" "@example\n" - "(let ((port (mkstemp! (string-copy \"/tmp/myfile-XXXXXX\"))))\n" + "(let ((port (mkstemp \"/tmp/myfile-XXXXXX\")))\n" " (chmod port (logand #o666 (lognot (umask))))\n" " ...)\n" "@end example\n" @@ -1491,10 +1496,6 @@ SCM_DEFINE (scm_i_mkstemp, "mkstemp!", 1, 1, 0, if (!SCM_UNBNDP (mode)) SCM_VALIDATE_STRING (SCM_ARG2, mode); - /* 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); @@ -1523,13 +1524,10 @@ SCM_DEFINE (scm_i_mkstemp, "mkstemp!", 1, 1, 0, if (rv == -1) SCM_SYSERROR; - scm_substring_move_x (scm_from_locale_string (c_tmpl), - SCM_INUM0, scm_string_length (tmpl), - tmpl, SCM_INUM0); - + SCM name = scm_from_locale_string (c_tmpl); scm_dynwind_end (); - port = scm_i_fdes_to_port (rv, mode_bits, tmpl, 0); + port = scm_i_fdes_to_port (rv, mode_bits, name, 0); if (is_binary) /* Use the binary-friendly ISO-8859-1 encoding. */ scm_i_set_port_encoding_x (port, NULL); @@ -1538,6 +1536,42 @@ SCM_DEFINE (scm_i_mkstemp, "mkstemp!", 1, 1, 0, } #undef FUNC_NAME +SCM_INTERNAL SCM scm_i_mkstemp_x (SCM, SCM); +SCM_DEFINE (scm_i_mkstemp_x, "mkstemp!", 1, 1, 0, + (SCM tmpl, SCM mode), + "Create a new unique file in the file system and return a new\n" + "buffered port open for reading and writing to the file.\n" + "\n" + "@var{tmpl} is a string specifying where the file should be\n" + "created: it must end with @samp{XXXXXX} and those @samp{X}s\n" + "will be changed in the string to return the name of the file.\n" + "(@code{port-filename} on the port also gives the name.)\n" + "\n" + "POSIX doesn't specify the permissions mode of the file, on GNU\n" + "and most systems it's @code{#o600}. An application can use\n" + "@code{chmod} to relax that if desired. For example\n" + "@code{#o666} less @code{umask}, which is usual for ordinary\n" + "file creation,\n" + "\n" + "@example\n" + "(let ((port (mkstemp! (string-copy \"/tmp/myfile-XXXXXX\"))))\n" + " (chmod port (logand #o666 (lognot (umask))))\n" + " ...)\n" + "@end example\n" + "\n" + "The optional @var{mode} argument specifies a mode, as a string\n" + "in the same format that @code{open-file} takes. It defaults\n" + "to @code{\"w+\"}.") +#define FUNC_NAME s_scm_i_mkstemp_x +{ + SCM ret = scm_i_mkstemp (tmpl, mode); + scm_substring_move_x (scm_port_filename (ret), + SCM_INUM0, scm_string_length (tmpl), + tmpl, SCM_INUM0); + return ret; +} +#undef FUNC_NAME + SCM scm_mkstemp (SCM tmpl) { diff --git a/libguile/posix.c b/libguile/posix.c index 47769003a..eaf12de32 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -1,4 +1,4 @@ -/* Copyright 1995-2014,2016-2019 +/* Copyright 1995-2014,2016-2019,2021 Free Software Foundation, Inc. This file is part of Guile. @@ -1572,14 +1572,14 @@ SCM_DEFINE (scm_tmpnam, "tmpnam", 0, 0, 0, "existing file. However there is no guarantee that another\n" "process will not create the file after @code{tmpnam} is called.\n" "Care should be taken if opening the file, e.g., use the\n" - "@code{O_EXCL} open flag or use @code{mkstemp!} instead.") + "@code{O_EXCL} open flag or use @code{mkstemp} instead.") #define FUNC_NAME s_scm_tmpnam { char name[L_tmpnam]; char *rv; scm_c_issue_deprecation_warning - ("Use of tmpnam is deprecated. Use mkstemp! instead."); + ("Use of tmpnam is deprecated. Use mkstemp instead."); SCM_SYSCALL (rv = tmpnam (name)); if (rv == NULL) diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm index 567765dc0..9ec9cbb0f 100644 --- a/module/system/base/compile.scm +++ b/module/system/base/compile.scm @@ -1,6 +1,6 @@ ;;; High-level compiler interface -;; Copyright (C) 2001,2005,2008-2013,2016,2020 Free Software Foundation, Inc. +;; Copyright (C) 2001,2005,2008-2013,2016,2020,2021 Free Software Foundation, Inc. ;;; This library is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU Lesser General Public License as published by @@ -60,8 +60,8 @@ ;; emacs: (put 'call-with-output-file/atomic 'scheme-indent-function 1) (define* (call-with-output-file/atomic filename proc #:optional reference) - (let* ((template (string-append filename ".XXXXXX")) - (tmp (mkstemp! template "wb"))) + (let* ((tmp (mkstemp (string-append filename ".XXXXXX") "wb")) + (tmpname (port-filename tmp))) (call-once (lambda () (with-throw-handler #t @@ -71,12 +71,12 @@ ;; work on systems without fchmod, like MinGW. (let ((perms (or (false-if-exception (stat:perms (stat reference))) (lognot (umask))))) - (chmod template (logand #o0666 perms))) + (chmod tmpname (logand #o0666 perms))) (close-port tmp) - (rename-file template filename)) + (rename-file tmpname filename)) (lambda args (close-port tmp) - (delete-file template))))))) + (delete-file tmpname))))))) (define (ensure-language x) (if (language? x) diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test index 135f09c11..1e552d16f 100644 --- a/test-suite/tests/posix.test +++ b/test-suite/tests/posix.test @@ -1,6 +1,6 @@ ;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*- ;;;; -;;;; Copyright 2003-2004,2006-2007,2010,2012,2015,2017-2019 +;;;; Copyright 2003-2004,2006-2007,2010,2012,2015,2017-2019,2021 ;;;; Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or @@ -55,10 +55,10 @@ ;; -;; mkstemp! +;; mkstemp ;; -(with-test-prefix "mkstemp!" +(with-test-prefix "mkstemp" ;; the temporary names used in the tests here are kept to 8 characters so ;; they'll work on a DOS 8.3 file system @@ -69,28 +69,18 @@ (pass-if-exception "number arg" exception:wrong-type-arg (mkstemp! 123)) - (pass-if "filename string modified" - (let* ((template "T-XXXXXX") - (str (string-copy template)) - (port (mkstemp! str)) - (result (not (string=? str template)))) - (close-port port) - (delete-file str) - result)) - (pass-if "binary mode honored" - (let* ((template "T-XXXXXX") - (str (string-copy template)) - (outport (mkstemp! str "wb"))) + (let* ((outport (mkstemp "T-XXXXXX" "wb")) + (filename (port-filename outport))) (display "\n" outport) (close-port outport) - (let* ((inport (open-input-file str #:binary #t)) + (let* ((inport (open-input-file filename #:binary #t)) (char1 (read-char inport)) (char2 (read-char inport)) (result (and (char=? char1 #\newline) (eof-object? char2)))) (close-port inport) - (delete-file str) + (delete-file filename) result)))) ;; diff --git a/test-suite/tests/r6rs-files.test b/test-suite/tests/r6rs-files.test index 9b31a8296..86065a193 100644 --- a/test-suite/tests/r6rs-files.test +++ b/test-suite/tests/r6rs-files.test @@ -1,6 +1,6 @@ -;;; r6rs-files.test --- Test suite for R6RS (rnrs unicode) +;;; r6rs-files.test --- Test suite for R6RS (rnrs unicode) -*- scheme -*- -;; Copyright (C) 2010 Free Software Foundation, Inc. +;; Copyright (C) 2010, 2021 Free Software Foundation, Inc. ;; ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -18,13 +18,13 @@ (define-module (test-suite test-rnrs-files) - :use-module ((rnrs exceptions) :version (6)) - :use-module ((rnrs files) :version (6)) - :use-module (test-suite lib)) + #:use-module (rnrs exceptions) + #:use-module (rnrs files) + #:use-module (test-suite lib)) (with-test-prefix "delete-file" (pass-if "delete-file deletes file" - (let* ((port (mkstemp! "T-XXXXXX")) + (let* ((port (mkstemp "T-XXXXXX")) (filename (port-filename port))) (close-port port) (delete-file filename) |