08/08: scripts: system: Add 'container' subcommand.

[David Thompson]

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

commit fe415d65b1d4c45909829bcb179c14bcbeaa7973
Author: David Thompson <address@hidden>
Date:   Mon Jun 8 09:04:38 2015 -0400

    scripts: system: Add 'container' subcommand.
    
    * guix/scripts/system.scm (show-help): Display 'container' subcommand.
      (system-derivation-for-action, guix-system): Add 'container' case.
---
 guix/scripts/system.scm |   10 ++++++++--
 1 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index f7c9d83..0d27018 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -30,6 +30,7 @@
   #:use-module (guix build utils)
   #:use-module (gnu build install)
   #:use-module (gnu system)
+  #:use-module (gnu system linux-container)
   #:use-module (gnu system vm)
   #:use-module (gnu system grub)
   #:use-module (gnu packages grub)
@@ -277,6 +278,9 @@ it atomically, and then run OS's activation script."
   (case action
     ((build init reconfigure)
      (operating-system-derivation os))
+    ((container)
+     ;; FIXME: Allow user-specified root directory.
+     (linux-container-script os #:root-dir "/tmp/container"))
     ((vm-image)
      (system-qemu-image os #:disk-image-size image-size))
     ((vm)
@@ -374,6 +378,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"))
@@ -483,7 +489,7 @@ Build the operating system declared in FILE according to 
ACTION.\n"))
         (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)
              (alist-cons 'action action result))
             (else (leave (_ "~a: unknown action~%") action))))))
 
@@ -504,7 +510,7 @@ Build the operating system declared in FILE according to 
ACTION.\n"))
                action))
 
       (case action
-        ((build vm vm-image disk-image reconfigure)
+        ((build container vm vm-image disk-image reconfigure)
          (unless (= count 1)
            (fail)))
         ((init)