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 f535dcbe19
commit e086dcfcf9
3 changed files with 40 additions and 7 deletions

View file

@ -7168,6 +7168,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. 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.
Additional file systems can be shared between the host and the container
using the @code{--share} and @code{--expose} command-line options: the
former specifies a directory to be shared with write access, while the
latter provides read-only access to the shared directory.
The example below creates a container in which the user's home directory
is accessible read-only, and where the @file{/exchange} directory is a
read-write mapping of the host's @file{$HOME/tmp}:
@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

@ -106,7 +106,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

@ -33,6 +33,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)
@ -336,6 +337,8 @@ list of services."
(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)
@ -368,10 +371,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)))
@ -451,6 +456,8 @@ Build the operating system declared in FILE according to ACTION.\n"))
reconfigure switch to a new operating system configuration\n")) reconfigure switch to a new operating system configuration\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 Linux 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 (_ "\
@ -557,7 +564,7 @@ Build the operating system declared in FILE according to ACTION.\n"))
(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) extension-graph dmd-graph)
(alist-cons 'action action result)) (alist-cons 'action action result))
(else (leave (_ "~a: unknown action~%") action)))))) (else (leave (_ "~a: unknown action~%") action))))))
@ -586,7 +593,7 @@ Build the operating system declared in FILE according to ACTION.\n"))
(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)