davexunit pushed a commit to branch wip-container
in repository guix.
commit 8bdb4052e340f9198f8b87266a1b68deab54ffe6
Author: David Thompson <da...@gnu.org>
Date: Sun May 31 20:26:47 2015 -0400
build: syscalls: Add clone syscall wrapper.
* guix/build/syscalls.scm (clone): New procedure.
(CLONE_NEWNS, CLONE_NEWUTS, CLONE_NEWIPC, CLONE_NEWUSER, CLONE_NEWPID,
CLONE_NEWNET): New variables.
---
guix/build/syscalls.scm | 32 ++++++++++++++++++++++++++++++++
1 files changed, 32 insertions(+), 0 deletions(-)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 3585bf2..3346358 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 Ludovic Courtès <l...@gnu.org>
+;;; Copyright © 2015 David Thompson <da...@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -37,6 +38,14 @@
swapoff
processes
+ CLONE_NEWNS
+ CLONE_NEWUTS
+ CLONE_NEWIPC
+ CLONE_NEWUSER
+ CLONE_NEWPID
+ CLONE_NEWNET
+ clone
+
IFF_UP
IFF_BROADCAST
IFF_LOOPBACK
@@ -247,6 +256,29 @@ user-land process."
(scandir "/proc"))
<))
+;; 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: Handle all supported architectures
+ (syscall-id (match (utsname:machine (uname))
+ ("x86_64" 56)
+ (_ 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.
