system: Add "guix system docker-image" command.

* gnu/system/vm.scm (system-docker-image): New procedure.
* guix/scripts/system.scm (system-derivation-for-action): Add a case for
  docker-image, and in that case, call system-docker-image.
  (show-help): Document docker-image.
  (guix-system): Parse arguments for docker-image.
* doc/guix.texi (Invoking guix system): Document "guix system
  docker-image".
* gnu/system/examples/docker-image.tmpl: New file.
This commit is contained in:
Chris Marusich 2018-02-19 05:45:03 +01:00
parent 1c2ac6b482
commit a335f6fcc9
No known key found for this signature in database
GPG key ID: DD409A15D822469D
4 changed files with 192 additions and 8 deletions

View file

@ -20385,12 +20385,18 @@ containing at least the kernel, initrd, and bootloader data files must
be created. The @code{--image-size} option can be used to specify the
size of the image.
@cindex System images, creation in various formats
@cindex Creating system images in various formats
@item vm-image
@itemx disk-image
Return a virtual machine or disk image of the operating system declared
in @var{file} that stands alone. By default, @command{guix system}
estimates the size of the image needed to store the system, but you can
use the @option{--image-size} option to specify a value.
@itemx docker-image
Return a virtual machine, disk image, or Docker image of the operating
system declared in @var{file} that stands alone. By default,
@command{guix system} estimates the size of the image needed to store
the system, but you can use the @option{--image-size} option to specify
a value. Docker images are built to contain exactly what they need, so
the @option{--image-size} option is ignored in the case of
@code{docker-image}.
You can specify the root file system type by using the
@option{--file-system-type} option. It defaults to @code{ext4}.
@ -20408,6 +20414,28 @@ using the following command:
# dd if=$(guix system disk-image my-os.scm) of=/dev/sdc
@end example
When using @code{docker-image}, a Docker image is produced. Guix builds
the image from scratch, not from a pre-existing Docker base image. As a
result, it contains @emph{exactly} what you define in the operating
system configuration file. You can then load the image and launch a
Docker container using commands like the following:
@example
image_id="$(docker load < guixsd-docker-image.tar.gz)"
docker run -e GUIX_NEW_SYSTEM=/var/guix/profiles/system \\
--entrypoint /var/guix/profiles/system/profile/bin/guile \\
$image_id /var/guix/profiles/system/boot
@end example
This command starts a new Docker container from the specified image. It
will boot the GuixSD system in the usual manner, which means it will
start any services you have defined in the operating system
configuration. Depending on what you run in the Docker container, it
may be necessary to give the container additional permissions. For
example, if you intend to build software using Guix inside of the Docker
container, you may need to pass the @option{--privileged} option to
@code{docker run}.
@item container
Return a script to run the operating system declared in @var{file}
within a container. Containers are a set of lightweight isolation

View file

@ -0,0 +1,47 @@
;; This is an operating system configuration template for a "Docker image"
;; setup, so it has barely any services at all.
(use-modules (gnu))
(operating-system
(host-name "komputilo")
(timezone "Europe/Berlin")
(locale "en_US.utf8")
;; This is where user accounts are specified. The "root" account is
;; implicit, and is initially created with the empty password.
(users (cons (user-account
(name "alice")
(comment "Bob's sister")
(group "users")
(supplementary-groups '("wheel"
"audio" "video"))
(home-directory "/home/alice"))
%base-user-accounts))
;; Globally-installed packages.
(packages %base-packages)
;; Because the system will run in a Docker container, we may omit many
;; things that would normally be required in an operating system
;; configuration file. These things include:
;;
;; * bootloader
;; * file-systems
;; * services such as mingetty, udevd, slim, networking, dhcp
;;
;; Either these things are simply not required, or Docker provides
;; similar services for us.
;; This will be ignored.
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
(target "does-not-matter")))
;; This will be ignored, too.
(file-systems (list (file-system
(device "does-not-matter")
(mount-point "/")
(type "does-not-matter"))))
;; Guix is all you need!
(services (list (guix-service))))

View file

@ -23,6 +23,7 @@
(define-module (gnu system vm)
#:use-module (guix config)
#:use-module (guix docker)
#:use-module (guix store)
#:use-module (guix gexp)
#:use-module (guix derivations)
@ -30,6 +31,7 @@ (define-module (gnu system vm)
#:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix modules)
#:use-module (guix scripts pack)
#:use-module (guix utils)
#:use-module (guix hash)
#:use-module (guix base32)
@ -39,7 +41,9 @@ (define-module (gnu system vm)
#:use-module (gnu packages base)
#:use-module (gnu packages bootloaders)
#:use-module (gnu packages cdrom)
#:use-module (gnu packages compression)
#:use-module (gnu packages guile)
#:autoload (gnu packages gnupg) (libgcrypt)
#:use-module (gnu packages gawk)
#:use-module (gnu packages bash)
#:use-module (gnu packages less)
@ -76,6 +80,7 @@ (define-module (gnu system vm)
system-qemu-image/shared-store
system-qemu-image/shared-store-script
system-disk-image
system-docker-image
virtual-machine
virtual-machine?))
@ -377,6 +382,106 @@ (define* (qemu-image #:key
#:disk-image-format disk-image-format
#:references-graphs inputs))
(define* (system-docker-image os
#:key
(name "guixsd-docker-image")
register-closures?)
"Build a docker image. OS is the desired <operating-system>. NAME is the
base name to use for the output file. When REGISTER-CLOSURES? is not #f,
register the closure of OS with Guix in the resulting Docker image. This only
makes sense when you want to build a GuixSD Docker image that has Guix
installed inside of it. If you don't need Guix (e.g., your GuixSD Docker
image just contains a web server that is started by the Shepherd), then you
should set REGISTER-CLOSURES? to #f."
(define not-config?
(match-lambda
(('guix 'config) #f)
(('guix rest ...) #t)
(('gnu rest ...) #t)
(rest #f)))
(define config
;; (guix config) module for consumption by (guix gcrypt).
(scheme-file "gcrypt-config.scm"
#~(begin
(define-module (guix config)
#:export (%libgcrypt))
;; XXX: Work around <http://bugs.gnu.org/15602>.
(eval-when (expand load eval)
(define %libgcrypt
#+(file-append libgcrypt "/lib/libgcrypt"))))))
(mlet %store-monad ((os-drv (operating-system-derivation os #:container? #t))
(name -> (string-append name ".tar.gz"))
(graph -> "system-graph"))
(define build
(with-imported-modules `(,@(source-module-closure '((guix docker)
(guix build utils)
(gnu build vm))
#:select? not-config?)
(guix build store-copy)
((guix config) => ,config))
#~(begin
;; Guile-JSON is required by (guix docker).
(add-to-load-path
(string-append #+guile-json "/share/guile/site/"
(effective-version)))
(use-modules (guix docker)
(guix build utils)
(gnu build vm)
(srfi srfi-19)
(guix build store-copy))
(let* ((inputs '#$(append (list tar)
(if register-closures?
(list guix)
'())))
;; This initializer requires elevated privileges that are
;; not normally available in the build environment (e.g.,
;; it needs to create device nodes). In order to obtain
;; such privileges, we run it as root in a VM.
(initialize (root-partition-initializer
#:closures '(#$graph)
#:register-closures? #$register-closures?
#:system-directory #$os-drv
;; De-duplication would fail due to
;; cross-device link errors, so don't do it.
#:deduplicate? #f))
;; Even as root in a VM, the initializer would fail due to
;; lack of privileges if we use a root-directory that is on
;; a file system that is shared with the host (e.g., /tmp).
(root-directory "/guixsd-system-root"))
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
(mkdir root-directory)
(initialize root-directory)
(build-docker-image
(string-append "/xchg/" #$name) ;; The output file.
(cons* root-directory
(call-with-input-file (string-append "/xchg/" #$graph)
read-reference-graph))
#$os-drv
#:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
#:creation-time (make-time time-utc 0 1)
#:transformations `((,root-directory -> "")))))))
(expression->derivation-in-linux-vm
name
;; The VM's initrd Guile doesn't support dlopen, but our "build" gexp
;; needs to be run by a Guile that can dlopen libgcrypt. The following
;; hack works around that problem by putting the "build" gexp into an
;; executable script (created by program-file) which, when executed, will
;; run using a Guile that supports dlopen. That way, the VM's initrd
;; Guile can just execute it via invoke, without using dlopen. See:
;; https://lists.gnu.org/archive/html/guix-devel/2017-10/msg00233.html
(with-imported-modules `((guix build utils))
#~(begin
(use-modules (guix build utils))
;; If we use execl instead of invoke here, the VM will crash with a
;; kernel panic.
(invoke #$(program-file "build-docker-image" build))))
#:make-disk-image? #f
#:single-file-output? #t
#:references-graphs `((,graph ,os-drv)))))
;;;
;;; VM and disk images.

View file

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016, 2017 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
@ -701,7 +701,9 @@ (define* (system-derivation-for-action os action
("iso9660" "image.iso")
(_ "disk-image"))
#:disk-image-size image-size
#:file-system-type file-system-type))))
#:file-system-type file-system-type))
((docker-image)
(system-docker-image os #:register-closures? #t))))
(define (maybe-suggest-running-guix-pull)
"Suggest running 'guix pull' if this has never been done before."
@ -904,6 +906,8 @@ (define (show-help)
vm-image build a freestanding virtual machine image\n"))
(display (G_ "\
disk-image build a disk image, suitable for a USB stick\n"))
(display (G_ "\
docker-image build a Docker image\n"))
(display (G_ "\
init initialize a root file system to run GNU\n"))
(display (G_ "\
@ -1142,7 +1146,7 @@ (define (parse-sub-command arg result)
(case action
((build container vm vm-image disk-image reconfigure init
extension-graph shepherd-graph list-generations roll-back
switch-generation search)
switch-generation search docker-image)
(alist-cons 'action action result))
(else (leave (G_ "~a: unknown action~%") action))))))
@ -1171,7 +1175,7 @@ (define (fail)
(exit 1))
(case action
((build container vm vm-image disk-image reconfigure)
((build container vm vm-image disk-image docker-image reconfigure)
(unless (or (= count 1)
(and expr (= count 0)))
(fail)))