vm: 'system-docker-image' provides an entry point.
This simplifies use of images created with 'guix system docker-image'. * gnu/system/vm.scm (system-docker-image)[boot-program]: New variable. [os]: Add it to the GC roots. [build]: Pass #:entry-point to 'build-docker-image'. * gnu/tests/docker.scm (run-docker-system-test): New procedure. (%test-docker-system): New variable. * doc/guix.texi (Invoking guix system): Remove GUIX_NEW_SYSTEM hack and '--entrypoint' from the example. Mention 'docker create', 'docker start', and 'docker exec'.
This commit is contained in:
parent
7ff4fde257
commit
247649d42e
|
@ -24500,20 +24500,26 @@ system configuration file. You can then load the image and launch a
|
|||
Docker container using commands like the following:
|
||||
|
||||
@example
|
||||
image_id="$(docker load < guix-system-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
|
||||
image_id="`docker load < guix-system-docker-image.tar.gz`"
|
||||
container_id="`docker create $image_id`"
|
||||
docker start $container_id
|
||||
@end example
|
||||
|
||||
This command starts a new Docker container from the specified image. It
|
||||
will boot the Guix 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
|
||||
configuration. You can get an interactive shell running in the container
|
||||
using @command{docker exec}:
|
||||
|
||||
@example
|
||||
docker exec -ti $container_id /run/current-system/profile/bin/bash --login
|
||||
@end example
|
||||
|
||||
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}.
|
||||
@code{docker create}.
|
||||
|
||||
@item container
|
||||
Return a script to run the operating system declared in @var{file}
|
||||
|
|
|
@ -482,7 +482,7 @@ system."
|
|||
|
||||
(define* (system-docker-image os
|
||||
#:key
|
||||
(name "guixsd-docker-image")
|
||||
(name "guix-docker-image")
|
||||
(register-closures? (has-guix-service-type? os)))
|
||||
"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 true,
|
||||
|
@ -495,7 +495,19 @@ system."
|
|||
(local-file (search-path %load-path
|
||||
"guix/store/schema.sql"))))
|
||||
|
||||
(let ((os (containerized-operating-system os '()))
|
||||
(define boot-program
|
||||
;; Program that runs the boot script of OS, which in turn starts shepherd.
|
||||
(program-file "boot-program"
|
||||
#~(let ((system (cadr (command-line))))
|
||||
(setenv "GUIX_NEW_SYSTEM" system)
|
||||
(execl #$(file-append guile-2.2 "/bin/guile")
|
||||
"guile" "--no-auto-compile"
|
||||
(string-append system "/boot")))))
|
||||
|
||||
|
||||
(let ((os (operating-system-with-gc-roots
|
||||
(containerized-operating-system os '())
|
||||
(list boot-program)))
|
||||
(name (string-append name ".tar.gz"))
|
||||
(graph "system-graph"))
|
||||
(define build
|
||||
|
@ -546,9 +558,11 @@ system."
|
|||
(string-append "/xchg/" #$graph)
|
||||
read-reference-graph)))
|
||||
#$os
|
||||
#:entry-point '(#$boot-program #$os)
|
||||
#:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
|
||||
#:creation-time (make-time time-utc 0 1)
|
||||
#:transformations `((,root-directory -> ""))))))))
|
||||
|
||||
(expression->derivation-in-linux-vm
|
||||
name build
|
||||
#:make-disk-image? #f
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
|
||||
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -28,6 +29,7 @@
|
|||
#:use-module (gnu services desktop)
|
||||
#:use-module (gnu packages bootstrap) ; %bootstrap-guile
|
||||
#:use-module (gnu packages docker)
|
||||
#:use-module (gnu packages guile)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix grafts)
|
||||
#:use-module (guix monads)
|
||||
|
@ -38,7 +40,8 @@
|
|||
#:use-module (guix tests)
|
||||
#:use-module (guix build-system trivial)
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:export (%test-docker))
|
||||
#:export (%test-docker
|
||||
%test-docker-system))
|
||||
|
||||
(define %docker-os
|
||||
(simple-operating-system
|
||||
|
@ -166,3 +169,116 @@ standard output device and then enters a new line.")
|
|||
(name "docker")
|
||||
(description "Test Docker container of Guix.")
|
||||
(value (build-tarball&run-docker-test))))
|
||||
|
||||
|
||||
(define (run-docker-system-test tarball)
|
||||
"Load DOCKER-TARBALL as Docker image and run it in a Docker container,
|
||||
inside %DOCKER-OS."
|
||||
(define os
|
||||
(marionette-operating-system
|
||||
%docker-os
|
||||
#:imported-modules '((gnu services herd)
|
||||
(guix combinators))))
|
||||
|
||||
(define vm
|
||||
(virtual-machine
|
||||
(operating-system os)
|
||||
;; FIXME: Because we're using the volatile-root setup where the root file
|
||||
;; system is a tmpfs overlaid over a small root file system, 'docker
|
||||
;; load' must be able to store the whole image into memory, hence the
|
||||
;; huge memory requirements. We should avoid the volatile-root setup
|
||||
;; instead.
|
||||
(memory-size 3000)
|
||||
(port-forwardings '())))
|
||||
|
||||
(define test
|
||||
(with-imported-modules '((gnu build marionette)
|
||||
(guix build utils))
|
||||
#~(begin
|
||||
(use-modules (srfi srfi-11) (srfi srfi-64)
|
||||
(gnu build marionette)
|
||||
(guix build utils))
|
||||
|
||||
(define marionette
|
||||
(make-marionette (list #$vm)))
|
||||
|
||||
(mkdir #$output)
|
||||
(chdir #$output)
|
||||
|
||||
(test-begin "docker")
|
||||
|
||||
(test-assert "service running"
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules (gnu services herd))
|
||||
(match (start-service 'dockerd)
|
||||
(#f #f)
|
||||
(('service response-parts ...)
|
||||
(match (assq-ref response-parts 'running)
|
||||
((pid) (number? pid))))))
|
||||
marionette))
|
||||
|
||||
(test-assert "load system image and run it"
|
||||
(marionette-eval
|
||||
`(begin
|
||||
(define (slurp command . args)
|
||||
;; Return the output from COMMAND.
|
||||
(let* ((port (apply open-pipe* OPEN_READ command args))
|
||||
(output (read-line port))
|
||||
(status (close-pipe port)))
|
||||
output))
|
||||
|
||||
(define (docker-cli command . args)
|
||||
;; Run the given Docker COMMAND.
|
||||
(apply invoke #$(file-append docker-cli "/bin/docker")
|
||||
command args))
|
||||
|
||||
(define (wait-for-container-file container file)
|
||||
;; Wait for FILE to show up in CONTAINER.
|
||||
(docker-cli "exec" container
|
||||
#$(file-append guile-2.2 "/bin/guile")
|
||||
"-c"
|
||||
(object->string
|
||||
`(let loop ((n 15))
|
||||
(when (zero? n)
|
||||
(error "file didn't show up" ,file))
|
||||
(unless (file-exists? ,file)
|
||||
(sleep 1)
|
||||
(loop (- n 1)))))))
|
||||
|
||||
(let* ((line (slurp #$(file-append docker-cli "/bin/docker")
|
||||
"load" "-i" #$tarball))
|
||||
(repository&tag (string-drop line
|
||||
(string-length
|
||||
"Loaded image: ")))
|
||||
(container (slurp
|
||||
#$(file-append docker-cli "/bin/docker")
|
||||
"create" repository&tag)))
|
||||
(docker-cli "start" container)
|
||||
|
||||
;; Wait for shepherd to be ready.
|
||||
(wait-for-container-file container
|
||||
"/var/run/shepherd/socket")
|
||||
|
||||
(docker-cli "exec" container
|
||||
"/run/current-system/profile/bin/herd"
|
||||
"status")
|
||||
(slurp #$(file-append docker-cli "/bin/docker")
|
||||
"exec" container
|
||||
"/run/current-system/profile/bin/herd"
|
||||
"status" "guix-daemon")))
|
||||
marionette))
|
||||
|
||||
(test-end)
|
||||
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
|
||||
|
||||
(gexp->derivation "docker-system-test" test))
|
||||
|
||||
(define %test-docker-system
|
||||
(system-test
|
||||
(name "docker-system")
|
||||
(description "Run a system image as produced by @command{guix system
|
||||
docker-image} inside Docker.")
|
||||
(value (with-monad %store-monad
|
||||
(>>= (system-docker-image (simple-operating-system))
|
||||
run-docker-system-test)))))
|
||||
|
|
Loading…
Reference in New Issue