vm: Auto-detect if inputs should be registered.

The default value of the argument REGISTER-CLOSURE? of the ISO9660-IMAGE,
QEMU-IMAGE and SYSTEM-DOCKER-IMAGE procedures can be computed automatically,
since the operating-system definition is available in its context.  When the
operating-system definition does not contain the GUIX-SERVICE-TYPE, do not
register the closure in the database of Guix, as it takes time and doesn't
serve a purpose.

* gnu/system/vm.scm (has-guix-service-type): Add predicate.
(iso9660-image)[register-closures?]: Use it to compute the argument's default
value.
(qemu-image)[register-closures?]: Likewise, and update docstring.
(system-docker-image)[register-closures?]: Likewise.
(system-disk-image): Do not explicit a value for the REGISTER-CLOSURES?
argument of the ISO9660-IMAGE and QEMU-IMAGE procedure calls, so that its
default value is used instead.
* guix/scripts/system.scm (system-derivation-for-action): Do not explicit a
value for the REGISTER-CLOSURES? argument of the SYSTEM-DOCKER-IMAGE
procedure call, so that its default value is used instead.
This commit is contained in:
Maxim Cournoyer 2019-04-16 17:15:02 -04:00
parent 112fd34fee
commit d03de6be0a
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
2 changed files with 19 additions and 13 deletions

View File

@ -64,6 +64,7 @@
#:use-module (gnu system file-systems) #:use-module (gnu system file-systems)
#:use-module (gnu system) #:use-module (gnu system)
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu services base)
#:use-module (gnu system uuid) #:use-module (gnu system uuid)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -249,6 +250,12 @@ made available under the /xchg CIFS share."
#:guile-for-build guile-for-build #:guile-for-build guile-for-build
#:references-graphs references-graphs))) #:references-graphs references-graphs)))
(define (has-guix-service-type? os)
"Return true if OS contains a service of the type GUIX-SERVICE-TYPE."
(not (not (find (lambda (service)
(eq? (service-kind service) guix-service-type))
(operating-system-services os)))))
(define* (iso9660-image #:key (define* (iso9660-image #:key
(name "iso9660-image") (name "iso9660-image")
file-system-label file-system-label
@ -258,7 +265,7 @@ made available under the /xchg CIFS share."
os os
bootcfg-drv bootcfg-drv
bootloader bootloader
register-closures? (register-closures? (has-guix-service-type? os))
(inputs '())) (inputs '()))
"Return a bootable, stand-alone iso9660 image. "Return a bootable, stand-alone iso9660 image.
@ -343,7 +350,7 @@ INPUTS is a list of inputs (as for packages)."
os os
bootcfg-drv bootcfg-drv
bootloader bootloader
(register-closures? #t) (register-closures? (has-guix-service-type? os))
(inputs '()) (inputs '())
copy-inputs?) copy-inputs?)
"Return a bootable, stand-alone QEMU image of type DISK-IMAGE-FORMAT (e.g., "Return a bootable, stand-alone QEMU image of type DISK-IMAGE-FORMAT (e.g.,
@ -359,7 +366,9 @@ file (GRUB-CONFIGURATION must be the name of a file in the VM.)
INPUTS is a list of inputs (as for packages). When COPY-INPUTS? is true, copy INPUTS is a list of inputs (as for packages). When COPY-INPUTS? is true, copy
all of INPUTS into the image being built. When REGISTER-CLOSURES? is true, all of INPUTS into the image being built. When REGISTER-CLOSURES? is true,
register INPUTS in the store database of the image so that Guix can be used in register INPUTS in the store database of the image so that Guix can be used in
the image." the image. By default, REGISTER-CLOSURES? is set to true only if a service of
type GUIX-SERVICE-TYPE is present in the services definition of the operating
system."
(define schema (define schema
(and register-closures? (and register-closures?
(local-file (search-path %load-path (local-file (search-path %load-path
@ -474,14 +483,13 @@ the image."
(define* (system-docker-image os (define* (system-docker-image os
#:key #:key
(name "guixsd-docker-image") (name "guixsd-docker-image")
register-closures?) (register-closures? (has-guix-service-type? os)))
"Build a docker image. OS is the desired <operating-system>. NAME is the "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, base name to use for the output file. When REGISTER-CLOSURES? is true,
register the closure of OS with Guix in the resulting Docker image. This only register the closure of OS with Guix in the resulting Docker image. By
makes sense when you want to build a Guix System Docker image that has Guix default, REGISTER-CLOSURES? is set to true only if a service of type
installed inside of it. If you don't need Guix (e.g., your Docker GUIX-SERVICE-TYPE is present in the services definition of the operating
image just contains a web server that is started by the Shepherd), then you system."
should set REGISTER-CLOSURES? to #f."
(define schema (define schema
(and register-closures? (and register-closures?
(local-file (search-path %load-path (local-file (search-path %load-path
@ -678,7 +686,6 @@ to USB sticks meant to be read-only."
#:file-system-label root-label #:file-system-label root-label
#:file-system-uuid uuid #:file-system-uuid uuid
#:os os #:os os
#:register-closures? #t
#:bootcfg-drv bootcfg #:bootcfg-drv bootcfg
#:bootloader (bootloader-configuration-bootloader #:bootloader (bootloader-configuration-bootloader
(operating-system-bootloader os)) (operating-system-bootloader os))
@ -695,7 +702,6 @@ to USB sticks meant to be read-only."
#:file-system-label root-label #:file-system-label root-label
#:file-system-uuid uuid #:file-system-uuid uuid
#:copy-inputs? #t #:copy-inputs? #t
#:register-closures? #t
#:inputs `(("system" ,os) #:inputs `(("system" ,os)
("bootcfg" ,bootcfg)))))) ("bootcfg" ,bootcfg))))))

View File

@ -786,7 +786,7 @@ checking this by themselves in their 'check' procedure."
#:disk-image-size image-size #:disk-image-size image-size
#:file-system-type file-system-type)) #:file-system-type file-system-type))
((docker-image) ((docker-image)
(system-docker-image os #:register-closures? #t)))) (system-docker-image os))))
(define (maybe-suggest-running-guix-pull) (define (maybe-suggest-running-guix-pull)
"Suggest running 'guix pull' if this has never been done before." "Suggest running 'guix pull' if this has never been done before."