build: syscalls: Add mkdtemp!
* guix/build/syscalls.scm (mkdtemp!): New procedure. * tests/syscalls.scm ("mkdtemp!"): New test.
This commit is contained in:
parent
b16d138a0a
commit
b4abdeb63b
@ -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.
|
||||||
|
@ -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)
|
||||||
|
Loading…
Reference in New Issue
Block a user