From 5dde31ef51502726a2915cc4faba81f4fadb851c Mon Sep 17 00:00:00 2001
From: David Thompson <address@hidden>
Date: Mon, 8 Jun 2015 09:04:38 -0400
Subject: [PATCH] scripts: system: Add 'container' action.

* guix/scripts/system.scm (show-help): Display 'container' action.
  (system-derivation-for-action, guix-system): Add 'container' case.
  (perform-action): Skip GRUB config generation when building a container.
* doc/guix.texi (Invoking guix system): Document it.
---
 doc/guix.texi                  | 21 +++++++++++++++++++++
 gnu/system/linux-container.scm |  7 ++++++-
 guix/scripts/system.scm        | 19 +++++++++++++------
 3 files changed, 40 insertions(+), 7 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 20bf284..3491cfb 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -7183,6 +7183,27 @@ using the following command:
 # dd if=$(guix system disk-image my-os.scm) of=/dev/sdc
 @end example
 
address@hidden container
+Return a script to run the operating system declared in @var{file}
+within a container.  Containers are a set of lightweight isolation
+mechanisms provided by the kernel Linux-libre.  Containers are
+substantially less resource-demanding than full virtual machines since
+the kernel, shared objects, and other resources can be shared with the
+host system; this also means they provide thinner isolation.
+
+Currently, the script must be run as root in order to support more than
+a single user and group.  The container shares its store with the host
+system.
+
+As with the @code{vm} action (@pxref{guix system vm}), additional file
+systems to be shared between the host and container can be specified
+using the @option{--share} and @option{--expose} options:
+
address@hidden
+guix system container my-config.scm \
+   --expose=$HOME --share=$HOME/tmp=/exchange
address@hidden example
+
 @end table
 
 @var{options} can contain any of the common build options provided by
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index abe816f..c2eb773 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -108,7 +108,12 @@ that will be shared with the host system."
                 (setenv "TMPDIR" "/tmp")
                 (setenv "GUIX_NEW_SYSTEM" #$os-drv)
                 (for-each mkdir-p '("/run" "/bin" "/etc" "/home" "/var"))
-                (primitive-load (string-append #$os-drv "/boot"))))))
+                (primitive-load (string-append #$os-drv "/boot")))
+              ;; A range of 65536 uid/gids is used to cover 16 bits worth of
+              ;; users and groups, which is sufficient for most cases.
+              ;;
+              ;; See: http://www.freedesktop.org/software/systemd/man/systemd-nspawn.html#--private-users=
+              #:host-uids 65536)))
 
       (gexp->script "run-container" script
                     #:modules '((ice-9 match)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index d847c75..4bf9ac9 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -34,6 +34,7 @@
   #:use-module (gnu build install)
   #:use-module (gnu system)
   #:use-module (gnu system file-systems)
+  #:use-module (gnu system linux-container)
   #:use-module (gnu system vm)
   #:use-module (gnu system grub)
   #:use-module (gnu services)
@@ -406,6 +407,8 @@ PATTERN, a string.  When PATTERN is #f, display all the system generations."
   (case action
     ((build init reconfigure)
      (operating-system-derivation os))
+    ((container)
+     (container-script os #:mappings mappings))
     ((vm-image)
      (system-qemu-image os #:disk-image-size image-size))
     ((vm)
@@ -438,10 +441,12 @@ building anything."
                                                 #:full-boot? full-boot?
                                                 #:mappings mappings))
        (grub      (package->derivation grub))
-       (grub.cfg  (operating-system-grub.cfg os
-                                             (if (eq? 'init action)
-                                                 '()
-                                                 (previous-grub-entries))))
+       (grub.cfg  (if (eq? 'container action)
+                      (return #f)
+                      (operating-system-grub.cfg os
+                                                 (if (eq? 'init action)
+                                                     '()
+                                                     (previous-grub-entries)))))
        (drvs   -> (if (and grub? (memq action '(init reconfigure)))
                       (list sys grub grub.cfg)
                       (list sys)))
@@ -524,6 +529,8 @@ Build the operating system declared in FILE according to ACTION.\n"))
   (display (_ "\
    build            build the operating system without installing anything\n"))
   (display (_ "\
+  container         build a Linux container that shares the host's store\n"))
+  (display (_ "\
    vm               build a virtual machine image that shares the host's store\n"))
   (display (_ "\
    vm-image         build a freestanding virtual machine image\n"))
@@ -694,7 +701,7 @@ argument list and OPTS is the option alist."
         (alist-cons 'argument arg result)
         (let ((action (string->symbol arg)))
           (case action
-            ((build vm vm-image disk-image reconfigure init
+            ((build container vm vm-image disk-image reconfigure init
               extension-graph dmd-graph list-generations)
              (alist-cons 'action action result))
             (else (leave (_ "~a: unknown action~%") action))))))
@@ -723,7 +730,7 @@ argument list and OPTS is the option alist."
         (exit 1))
 
       (case action
-        ((build vm vm-image disk-image reconfigure)
+        ((build container vm vm-image disk-image reconfigure)
          (unless (= count 1)
            (fail)))
         ((init)
-- 
2.5.0