ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

build: syscalls: Add mkdtemp!

Browse source 
* 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
Show stats Download patch file Download diff file Expand all files Collapse all files

15
guix/build/syscalls.scm
View file

@ -45,6 +45,7 @@ (define-module (guix build syscalls)
swapon
swapoff
processes
mkdtemp!
IFF_UP
IFF_BROADCAST
@ -265,6 +266,20 @@ (define (processes)
(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.

9
tests/syscalls.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -67,6 +68,14 @@ (define-module (test-syscalls)
(lambda args
(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"
(match (all-network-interfaces)
(((? string? names) ..1)