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:
parent
112fd34fee
commit
d03de6be0a
|
@ -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))))))
|
||||||
|
|
||||||
|
|
|
@ -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."
|
||||||
|
|
Loading…
Reference in New Issue