[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
07/15: utils: Add call-with-temporary-directory.
From: |
David Thompson |
Subject: |
07/15: utils: Add call-with-temporary-directory. |
Date: |
Thu, 02 Jul 2015 00:58:58 +0000 |
davexunit pushed a commit to branch wip-container
in repository guix.
commit a3eb988d0d4443993f344d3cf64542f7ea6a34d7
Author: David Thompson <address@hidden>
Date: Wed Jun 24 21:16:11 2015 -0400
utils: Add call-with-temporary-directory.
* guix/utils.scm (call-with-temporary-directory): New procedure.
---
guix/utils.scm | 16 +++++++++++++++-
1 files changed, 15 insertions(+), 1 deletions(-)
diff --git a/guix/utils.scm b/guix/utils.scm
index a2ade2b..44913c6 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -30,7 +30,7 @@
#:use-module (rnrs bytevectors)
#:use-module ((rnrs io ports) #:select (put-bytevector))
#:use-module ((guix build utils) #:select (dump-port))
- #:use-module ((guix build syscalls) #:select (errno))
+ #:use-module ((guix build syscalls) #:select (errno mkdtemp!))
#:use-module (ice-9 vlist)
#:use-module (ice-9 format)
#:autoload (ice-9 popen) (open-pipe*)
@@ -77,6 +77,7 @@
file-extension
file-sans-extension
call-with-temporary-output-file
+ call-with-temporary-directory
with-atomic-file-output
fold2
fold-tree
@@ -652,6 +653,19 @@ call."
(false-if-exception (close out))
(false-if-exception (delete-file template))))))
+(define (call-with-temporary-directory proc)
+ "Call PROC with a name of a temporary directory; close the directory and
+delete it when leaving the dynamic extent of this call."
+ (let* ((directory (or (getenv "TMPDIR") "/tmp"))
+ (template (string-append directory "/guix-directory.XXXXXX"))
+ (tmp-dir (mkdtemp! template)))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (proc tmp-dir))
+ (lambda ()
+ (false-if-exception (rmdir tmp-dir))))))
+
(define (with-atomic-file-output file proc)
"Call PROC with an output port for the file that is going to replace FILE.
Upon success, FILE is atomically replaced by what has been written to the
- branch wip-container created (now a3cbf11), David Thompson, 2015/07/01
- 02/15: build: syscalls: Add setns syscall wrapper., David Thompson, 2015/07/01
- 03/15: build: syscalls: Add additional mount flags., David Thompson, 2015/07/01
- 04/15: build: syscalls: Add unmount flags., David Thompson, 2015/07/01
- 05/15: build: syscalls: Add pivot-root., David Thompson, 2015/07/01
- 06/15: build: syscalls: Add mkdtemp!, David Thompson, 2015/07/01
- 07/15: utils: Add call-with-temporary-directory.,
David Thompson <=
- 01/15: build: syscalls: Add clone syscall wrapper., David Thompson, 2015/07/01
- 10/15: gnu: system: Move file-system->spec to (gnu system file-systems)., David Thompson, 2015/07/01
- 09/15: gnu: system: Move <file-system-mapping> into (gnu system file-systems)., David Thompson, 2015/07/01
- 12/15: gnu: system: Add Linux container file systems., David Thompson, 2015/07/01
- 11/15: gnu: system: Add Linux container module., David Thompson, 2015/07/01
- 14/15: scripts: environment: Add --container option., David Thompson, 2015/07/01
- 08/15: gnu: build: Add Linux container module., David Thompson, 2015/07/01
- 15/15: scripts: Add 'container' subcommand., David Thompson, 2015/07/01
- 13/15: scripts: system: Add 'container' subcommand., David Thompson, 2015/07/01