davexunit pushed a commit to branch wip-container in repository guix. commit 2decdf41c066ed9d6b4538a7a26c52964bed5a94 Author: David Thompson <da...@gnu.org> 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. (perform-action): Skip GRUB config generation when building a container. --- guix/scripts/system.scm | 19 +++++++++++++------ 1 files changed, 13 insertions(+), 6 deletions(-) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 6084ab8..6e36ae3 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -31,6 +31,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 packages grub) @@ -285,6 +286,8 @@ it atomically, and then run OS's activation script." (case action ((build init reconfigure) (operating-system-derivation os)) + ((container) + (linux-container-script os #:mappings mappings)) ((vm-image) (system-qemu-image os #:disk-image-size image-size)) ((vm) @@ -324,10 +327,12 @@ boot directly to the kernel or to the bootloader." #: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))) @@ -382,6 +387,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")) @@ -491,7 +498,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)))))) @@ -512,7 +519,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)