guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

06/11: gnu: Add Linux container module.


From: David Thompson
Subject: 06/11: gnu: Add Linux container module.
Date: Thu, 25 Jun 2015 01:48:13 +0000

davexunit pushed a commit to branch wip-container
in repository guix.

commit 177251ef17fad860803066303db9db19d3327043
Author: David Thompson <address@hidden>
Date:   Tue Jun 2 08:48:16 2015 -0400

    gnu: Add Linux container module.
    
    * gnu/build/linux-container.scm: New file.
    * gnu-system.am (GNU_SYSTEM_MODULES): Add it.
    * .dir-locals.el: Add Scheme indent rules for 'call-with-clone', 
'with-clone',
      and 'call-with-container'.
---
 .dir-locals.el                |    4 +
 gnu-system.am                 |    1 +
 gnu/build/linux-container.scm |  147 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 152 insertions(+), 0 deletions(-)

diff --git a/.dir-locals.el b/.dir-locals.el
index cbcb120..28acd39 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -59,6 +59,10 @@
    (eval . (put 'run-with-state 'scheme-indent-function 1))
    (eval . (put 'wrap-program 'scheme-indent-function 1))
 
+   (eval . (put 'call-with-clone 'scheme-indent-function 1))
+   (eval . (put 'with-clone 'scheme-indent-function 1))
+   (eval . (put 'call-with-container 'scheme-indent-function 1))
+
    ;; Recognize '~', '+', and '$', as used for gexps, as quotation symbols.
    ;; This notably allows '(' in Paredit to not insert a space when the
    ;; preceding symbol is one of these.
diff --git a/gnu-system.am b/gnu-system.am
index a420d71..3bb8982 100644
--- a/gnu-system.am
+++ b/gnu-system.am
@@ -356,6 +356,7 @@ GNU_SYSTEM_MODULES =                                \
   gnu/build/file-systems.scm                   \
   gnu/build/install.scm                                \
   gnu/build/linux-boot.scm                     \
+  gnu/build/linux-container.scm                        \
   gnu/build/linux-initrd.scm                   \
   gnu/build/linux-modules.scm                  \
   gnu/build/vm.scm
diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm
new file mode 100644
index 0000000..7ef956e
--- /dev/null
+++ b/gnu/build/linux-container.scm
@@ -0,0 +1,147 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 David Thompson <address@hidden>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu build linux-container)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (guix utils)
+  #:use-module (guix build utils)
+  #:use-module (guix build syscalls)
+  #:export (call-with-container))
+
+(define (call-with-clone flags thunk)
+  "Run THUNK in a separate process created via clone(2) with FLAGS.  The
+parent process blocks until the container process has terminated."
+  (match (clone flags)
+    (0 (thunk))
+    (pid (waitpid pid))))
+
+(define-syntax-rule (with-clone flags body ...)
+  "Evaluate BODY in a new process created via clone(2) with the specified
+FLAGS."
+  (call-with-clone flags (lambda () body ...)))
+
+(define* (mount* source target type #:optional (flags 0) options
+                 #:key (update-mtab? #f))
+  "Like 'mount', but create the TARGET directory if it doesn't exist."
+  (mkdir-p target)
+  (mount source target type flags options #:update-mtab? update-mtab?))
+
+(define (call-with-container shared-dirs thunk)
+  "Run THUNK in a new container process.  SHARED-DIRS is a list of (HOST-DIR
+CONTAINER-DIR) tuples that will be bind mounted within the container."
+  (call-with-temporary-directory
+   (lambda (root-dir)
+     (define (scope dir)
+       (string-append root-dir dir))
+
+     ;; The container setup procedure closely resembles that of the Docker
+     ;; specification:
+     ;; https://raw.githubusercontent.com/docker/libcontainer/master/SPEC.md
+     (let* ((new-proc   (scope "/proc"))
+            (new-dev    (scope "/dev"))
+            (new-sys    (scope "/sys"))
+            (dev-shm    (string-append new-dev "/shm"))
+            (dev-mqueue (string-append new-dev "/mqueue"))
+            (dev-pts    (string-append new-dev "/pts"))
+            (uid        (getuid))
+            (gid        (getgid)))
+
+       (with-clone (logior CLONE_NEWNS
+                           CLONE_NEWUTS
+                           CLONE_NEWIPC
+                           CLONE_NEWUSER
+                           CLONE_NEWPID
+                           CLONE_NEWNET
+                           SIGCHLD)
+
+         ;; Map the user/group that created the container to the root user 
within
+         ;; the container.
+         (call-with-output-file "/proc/self/setgroups"
+           (lambda (port)
+             (display "deny" port)))
+         (call-with-output-file "/proc/self/uid_map"
+           (lambda (port)
+             (format port "0 ~d 1" uid)))
+         (call-with-output-file "/proc/self/gid_map"
+           (lambda (port)
+             (format port "0 ~d 1" gid)))
+
+         ;; Create essential mount points.
+         (mount "none" root-dir "tmpfs")
+         (mount* "none" new-proc "proc"
+                 (logior MS_NOEXEC MS_NOSUID MS_NODEV))
+         (mount* "none" new-dev "tmpfs"
+                 (logior MS_NOEXEC MS_STRICTATIME)
+                 "mode=755")
+         (mount* "none" new-sys "sysfs"
+                 (logior MS_NOEXEC MS_NOSUID MS_NODEV MS_RDONLY))
+         (mount* "none" dev-shm "tmpfs"
+                 (logior MS_NOEXEC MS_NOSUID MS_NODEV)
+                 "mode=1777,size=65536k")
+         (mount* "none" dev-mqueue "mqueue"
+                 (logior MS_NOEXEC MS_NOSUID MS_NODEV))
+         (mount* "none" dev-pts "devpts"
+                 (logior MS_NOEXEC MS_NOSUID)
+                 "newinstance,ptmxmode=0666,mode=620")
+
+         ;; Create essential device nodes via bind mounting them from the host,
+         ;; because a container within a user namespace cannot create device
+         ;; nodes.
+         (for-each (lambda (device)
+                     (call-with-output-file (scope device)
+                       (const #t))
+                     (mount device (scope device)
+                            "none" MS_BIND))
+                   '("/dev/null"
+                     "/dev/zero"
+                     "/dev/full"
+                     "/dev/random"
+                     "/dev/urandom"
+                     "/dev/tty"
+                     ;; TODO: "/dev/fuse"
+                     ))
+
+         ;; For psuedo-ttys within the container.  Needs to be a symlink to the
+         ;; host's /dev/ptmx.
+         (symlink "/dev/ptmx" (scope "/dev/ptmx"))
+
+         ;; Setup IO.
+         (symlink "/proc/self/fd"   (scope "/dev/fd"))
+         (symlink "/proc/self/fd/0" (scope "/dev/stdin"))
+         (symlink "/proc/self/fd/1" (scope "/dev/stdout"))
+         (symlink "/proc/self/fd/2" (scope "/dev/stderr"))
+
+         ;; Bind-mount shared directories.
+         ;; TODO: Use <file-system-mapping>
+         (for-each (match-lambda
+                    ((host-dir container-dir)
+                     (mount* host-dir (scope container-dir)
+                             "none" MS_BIND)))
+                   shared-dirs)
+
+         ;; Enter the container's root file system.
+         (chroot root-dir)
+         (chdir "/")
+
+         ;; Go little container, go!
+         (dynamic-wind
+           (const #t)
+           thunk
+           (lambda ()
+             (primitive-exit 1))))))))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]