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.
This commit is contained in:
David Thompson 2015-06-08 09:04:38 -04:00 committed by David Thompson
parent 8e5999e0b0
commit 1c8a81b1af
3 changed files with 40 additions and 7 deletions

View File

@ -7264,6 +7264,27 @@ using the following command:
# dd if=$(guix system disk-image my-os.scm) of=/dev/sdc # dd if=$(guix system disk-image my-os.scm) of=/dev/sdc
@end example @end example
@item 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:
@example
guix system container my-config.scm \
--expose=$HOME --share=$HOME/tmp=/exchange
@end example
@end table @end table
@var{options} can contain any of the common build options provided by @var{options} can contain any of the common build options provided by

View File

@ -108,7 +108,12 @@ that will be shared with the host system."
(setenv "TMPDIR" "/tmp") (setenv "TMPDIR" "/tmp")
(setenv "GUIX_NEW_SYSTEM" #$os-drv) (setenv "GUIX_NEW_SYSTEM" #$os-drv)
(for-each mkdir-p '("/run" "/bin" "/etc" "/home" "/var")) (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 (gexp->script "run-container" script
#:modules '((ice-9 match) #:modules '((ice-9 match)

View File

@ -34,6 +34,7 @@
#:use-module (gnu build install) #:use-module (gnu build install)
#:use-module (gnu system) #:use-module (gnu system)
#:use-module (gnu system file-systems) #:use-module (gnu system file-systems)
#:use-module (gnu system linux-container)
#:use-module (gnu system vm) #:use-module (gnu system vm)
#:use-module (gnu system grub) #:use-module (gnu system grub)
#:use-module (gnu services) #:use-module (gnu services)
@ -406,6 +407,8 @@ PATTERN, a string. When PATTERN is #f, display all the system generations."
(case action (case action
((build init reconfigure) ((build init reconfigure)
(operating-system-derivation os)) (operating-system-derivation os))
((container)
(container-script os #:mappings mappings))
((vm-image) ((vm-image)
(system-qemu-image os #:disk-image-size image-size)) (system-qemu-image os #:disk-image-size image-size))
((vm) ((vm)
@ -438,10 +441,12 @@ building anything."
#:full-boot? full-boot? #:full-boot? full-boot?
#:mappings mappings)) #:mappings mappings))
(grub (package->derivation grub)) (grub (package->derivation grub))
(grub.cfg (operating-system-grub.cfg os (grub.cfg (if (eq? 'container action)
(if (eq? 'init action) (return #f)
'() (operating-system-grub.cfg os
(previous-grub-entries)))) (if (eq? 'init action)
'()
(previous-grub-entries)))))
(drvs -> (if (and grub? (memq action '(init reconfigure))) (drvs -> (if (and grub? (memq action '(init reconfigure)))
(list sys grub grub.cfg) (list sys grub grub.cfg)
(list sys))) (list sys)))
@ -523,6 +528,8 @@ Build the operating system declared in FILE according to ACTION.\n"))
list-generations list the system generations\n")) list-generations list the system generations\n"))
(display (_ "\ (display (_ "\
build build the operating system without installing anything\n")) build build the operating system without installing anything\n"))
(display (_ "\
container build a container that shares the host's store\n"))
(display (_ "\ (display (_ "\
vm build a virtual machine image that shares the host's store\n")) vm build a virtual machine image that shares the host's store\n"))
(display (_ "\ (display (_ "\
@ -694,7 +701,7 @@ argument list and OPTS is the option alist."
(alist-cons 'argument arg result) (alist-cons 'argument arg result)
(let ((action (string->symbol arg))) (let ((action (string->symbol arg)))
(case action (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) extension-graph dmd-graph list-generations)
(alist-cons 'action action result)) (alist-cons 'action action result))
(else (leave (_ "~a: unknown action~%") action)))))) (else (leave (_ "~a: unknown action~%") action))))))
@ -723,7 +730,7 @@ argument list and OPTS is the option alist."
(exit 1)) (exit 1))
(case action (case action
((build vm vm-image disk-image reconfigure) ((build container vm vm-image disk-image reconfigure)
(unless (= count 1) (unless (= count 1)
(fail))) (fail)))
((init) ((init)