From mboxrd@z Thu Jan 1 00:00:00 1970 From: David Thompson Subject: [PATCH 05/15] build: syscalls: Add clone syscall wrapper. Date: Mon, 6 Jul 2015 09:16:34 -0400 Message-ID: <1436188604-2813-5-git-send-email-dthompson2@worcester.edu> References: <1436188604-2813-1-git-send-email-dthompson2@worcester.edu> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:47392) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZC6H1-0001LK-Ox for guix-devel@gnu.org; Mon, 06 Jul 2015 09:17:31 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ZC6Gx-0006qN-IT for guix-devel@gnu.org; Mon, 06 Jul 2015 09:17:27 -0400 Received: from mail-qk0-f172.google.com ([209.85.220.172]:35689) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZC6Gx-0006q6-Az for guix-devel@gnu.org; Mon, 06 Jul 2015 09:17:23 -0400 Received: by qkbp125 with SMTP id p125so116380303qkb.2 for ; Mon, 06 Jul 2015 06:17:23 -0700 (PDT) In-Reply-To: <1436188604-2813-1-git-send-email-dthompson2@worcester.edu> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: guix-devel@gnu.org Cc: David Thompson From: David Thompson * guix/build/syscalls.scm (clone): New procedure. (CLONE_NEWNS, CLONE_NEWUTS, CLONE_NEWIPC, CLONE_NEWUSER, CLONE_NEWPID, CLONE_NEWNET): New variables. * tests/syscalls.scm: Test it. --- guix/build/syscalls.scm | 31 +++++++++++++++++++++++++++++++ tests/syscalls.scm | 15 +++++++++++++++ 2 files changed, 46 insertions(+) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index a464040..1e5b3f7 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,29 @@ 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: 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. diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 049ca93..9902279 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -76,6 +76,21 @@ (rmdir dir) #t)))) +(define (user-namespace pid) + (match pid + ("self" "/proc/self/ns/user") + ((and (? number?) (= number->string pid)) + (string-append "/proc/" pid "/ns/user")))) + +(test-assert "clone" + (match (clone (logior CLONE_NEWUSER)) + (0 (primitive-exit 0)) + (pid + ;; Check if user namespaces are different. + (not (equal? (readlink (user-namespace pid)) + (readlink (user-namespace "self"))))))) + + (test-assert "all-network-interfaces" (match (all-network-interfaces) (((? string? names) ..1) -- 2.4.3