build: syscalls: Add mkdtemp!

* guix/build/syscalls.scm (mkdtemp!): New procedure.
* tests/syscalls.scm ("mkdtemp!"): New test.
This commit is contained in:
David Thompson 2015-06-24 20:50:34 -04:00 committed by David Thompson
parent b16d138a0a
commit b4abdeb63b
2 changed files with 24 additions and 0 deletions

View File

@ -45,6 +45,7 @@
swapon swapon
swapoff swapoff
processes processes
mkdtemp!
IFF_UP IFF_UP
IFF_BROADCAST IFF_BROADCAST
@ -265,6 +266,20 @@ user-land process."
(scandir "/proc")) (scandir "/proc"))
<)) <))
(define mkdtemp!
(let* ((ptr (dynamic-func "mkdtemp" (dynamic-link)))
(proc (pointer->procedure '* ptr '(*))))
(lambda (tmpl)
"Create a new unique directory in the file system using the template
string TMPL and return its file name. TMPL must end with 'XXXXXX'."
(let ((result (proc (string->pointer tmpl)))
(err (errno)))
(when (null-pointer? result)
(throw 'system-error "mkdtemp!" "~S: ~A"
(list tmpl (strerror err))
(list err)))
(pointer->string result)))))
;;; ;;;
;;; Packed structures. ;;; Packed structures.

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -67,6 +68,14 @@
(lambda args (lambda args
(memv (system-error-errno args) (list EPERM EINVAL ENOENT))))) (memv (system-error-errno args) (list EPERM EINVAL ENOENT)))))
(test-assert "mkdtemp!"
(let* ((tmp (or (getenv "TMPDIR") "/tmp"))
(dir (mkdtemp! (string-append tmp "/guix-test-XXXXXX"))))
(and (file-exists? dir)
(begin
(rmdir dir)
#t))))
(test-assert "all-network-interfaces" (test-assert "all-network-interfaces"
(match (all-network-interfaces) (match (all-network-interfaces)
(((? string? names) ..1) (((? string? names) ..1)