summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorDavid Thompson <davet@gnu.org>2015-05-31 20:26:47 -0400
committerDavid Thompson <dthompson2@worcester.edu>2015-07-07 20:35:08 -0400
commit8950ed11c6a0d51be056b3509f3ab269787696e9 (patch)
tree8f0581a17e1d23a067bc42157c6f77e4a8528491 /guix
parent0e88cbf8c13a6d252f3d48c36e6432ec5a9e149f (diff)
build: syscalls: Add clone.
* guix/build/syscalls.scm (clone): New procedure. (CLONE_NEWNS, CLONE_NEWUTS, CLONE_NEWIPC, CLONE_NEWUSER, CLONE_NEWPID, CLONE_NEWNET): New variables. * tests/syscalls.scm ("clone"): New test.
Diffstat (limited to 'guix')
-rw-r--r--guix/build/syscalls.scm33
1 files changed, 33 insertions, 0 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index a464040e56..cff010648a 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -47,6 +47,14 @@
processes
mkdtemp!
+ CLONE_NEWNS
+ CLONE_NEWUTS
+ CLONE_NEWIPC
+ CLONE_NEWUSER
+ CLONE_NEWPID
+ CLONE_NEWNET
+ clone
+
IFF_UP
IFF_BROADCAST
IFF_LOOPBACK
@@ -280,6 +288,31 @@ string TMPL and return its file name. TMPL must end with 'XXXXXX'."
(list err)))
(pointer->string result)))))
+;; Linux clone flags, from linux/sched.h
+(define CLONE_NEWNS #x00020000)
+(define CLONE_NEWUTS #x04000000)
+(define CLONE_NEWIPC #x08000000)
+(define CLONE_NEWUSER #x10000000)
+(define CLONE_NEWPID #x20000000)
+(define CLONE_NEWNET #x40000000)
+
+;; The libc interface to sys_clone is not useful for Scheme programs, so the
+;; low-level system call is wrapped instead.
+(define clone
+ (let* ((ptr (dynamic-func "syscall" (dynamic-link)))
+ (proc (pointer->procedure int ptr (list int int '*)))
+ ;; TODO: Don't do this.
+ (syscall-id (match (utsname:machine (uname))
+ ("i686" 120)
+ ("x86_64" 56)
+ ("mips64" 5055)
+ ("armv7l" 120))))
+ (lambda (flags)
+ "Create a new child process by duplicating the current parent process.
+Unlike the fork system call, clone accepts FLAGS that specify which resources
+are shared between the parent and child processes."
+ (proc syscall-id flags %null-pointer))))
+
;;;
;;; Packed structures.