diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2019-05-12 12:21:48 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2019-05-15 16:36:21 +0200 |
| commit | 247649d42e60b718f3f46b2bcf72d19bf799d503 (patch) | |
| tree | fac80f7fe0923c2ba21c0f86210d2d99c0669a3d /gnu/system | |
| parent | 7ff4fde257d43760b0df53334b4df63d16491452 (diff) | |
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'.
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/vm.scm | 18 |
1 files changed, 16 insertions, 2 deletions
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 2eeb7007935..aa378964987 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm | |||
| @@ -482,7 +482,7 @@ system." | |||
| 482 | 482 | ||
| 483 | (define* (system-docker-image os | 483 | (define* (system-docker-image os |
| 484 | #:key | 484 | #:key |
| 485 | (name "guixsd-docker-image") | 485 | (name "guix-docker-image") |
| 486 | (register-closures? (has-guix-service-type? os))) | 486 | (register-closures? (has-guix-service-type? os))) |
| 487 | "Build a docker image. OS is the desired <operating-system>. NAME is the | 487 | "Build a docker image. OS is the desired <operating-system>. NAME is the |
| 488 | base name to use for the output file. When REGISTER-CLOSURES? is true, | 488 | base name to use for the output file. When REGISTER-CLOSURES? is true, |
| @@ -495,7 +495,19 @@ system." | |||
| 495 | (local-file (search-path %load-path | 495 | (local-file (search-path %load-path |
| 496 | "guix/store/schema.sql")))) | 496 | "guix/store/schema.sql")))) |
| 497 | 497 | ||
| 498 | (let ((os (containerized-operating-system os '())) | 498 | (define boot-program |
| 499 | ;; Program that runs the boot script of OS, which in turn starts shepherd. | ||
| 500 | (program-file "boot-program" | ||
| 501 | #~(let ((system (cadr (command-line)))) | ||
| 502 | (setenv "GUIX_NEW_SYSTEM" system) | ||
| 503 | (execl #$(file-append guile-2.2 "/bin/guile") | ||
| 504 | "guile" "--no-auto-compile" | ||
| 505 | (string-append system "/boot"))))) | ||
| 506 | |||
| 507 | |||
| 508 | (let ((os (operating-system-with-gc-roots | ||
| 509 | (containerized-operating-system os '()) | ||
| 510 | (list boot-program))) | ||
| 499 | (name (string-append name ".tar.gz")) | 511 | (name (string-append name ".tar.gz")) |
| 500 | (graph "system-graph")) | 512 | (graph "system-graph")) |
| 501 | (define build | 513 | (define build |
| @@ -546,9 +558,11 @@ system." | |||
| 546 | (string-append "/xchg/" #$graph) | 558 | (string-append "/xchg/" #$graph) |
| 547 | read-reference-graph))) | 559 | read-reference-graph))) |
| 548 | #$os | 560 | #$os |
| 561 | #:entry-point '(#$boot-program #$os) | ||
| 549 | #:compressor '(#+(file-append gzip "/bin/gzip") "-9n") | 562 | #:compressor '(#+(file-append gzip "/bin/gzip") "-9n") |
| 550 | #:creation-time (make-time time-utc 0 1) | 563 | #:creation-time (make-time time-utc 0 1) |
| 551 | #:transformations `((,root-directory -> "")))))))) | 564 | #:transformations `((,root-directory -> "")))))))) |
| 565 | |||
| 552 | (expression->derivation-in-linux-vm | 566 | (expression->derivation-in-linux-vm |
| 553 | name build | 567 | name build |
| 554 | #:make-disk-image? #f | 568 | #:make-disk-image? #f |
