mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
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.
This commit is contained in:
Andy Wingo
parent
89a299102f
commit
85433fc2b1
7 changed files with 93 additions and 64 deletions
4
NEWS
4
NEWS
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
;;
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue