Archived
1
0
Fork 0

vm: 'qemu-image' accepts a list of extra populate directives.

* gnu/build/vm.scm (root-partition-initializer): Add #:extra-directives
parameter and pass it to 'populate-root-file-system'.
* gnu/system/vm.scm (qemu-image): Add #:extra-directives parameter and
pass it to 'root-partition-initializer'.
This commit is contained in:
Ludovic Courtès 2020-04-01 15:03:10 +02:00
parent 87241947aa
commit 82782d8cec
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 14 additions and 4 deletions

View file

@ -363,14 +363,18 @@ it, run its initializer, and unmount it."
copy-closures? copy-closures?
(register-closures? #t) (register-closures? #t)
system-directory system-directory
(deduplicate? #t)) (deduplicate? #t)
(extra-directives '()))
"Return a procedure to initialize a root partition. "Return a procedure to initialize a root partition.
If REGISTER-CLOSURES? is true, register all of CLOSURES in the partition's If REGISTER-CLOSURES? is true, register all of CLOSURES in the partition's
store. If DEDUPLICATE? is true, then also deduplicate files common to store. If DEDUPLICATE? is true, then also deduplicate files common to
CLOSURES and the rest of the store when registering the closures. If CLOSURES and the rest of the store when registering the closures. If
COPY-CLOSURES? is true, copy all of CLOSURES to the partition. COPY-CLOSURES? is true, copy all of CLOSURES to the partition.
SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation." SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation.
EXTRA-DIRECTIVES is an optional list of directives to populate the root file
system that is passed to 'populate-root-file-system'."
(lambda (target) (lambda (target)
(define target-store (define target-store
(string-append target (%store-directory))) (string-append target (%store-directory)))
@ -403,7 +407,8 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
;; Add the non-store directories and files. ;; Add the non-store directories and files.
(display "populating...\n") (display "populating...\n")
(populate-root-file-system system-directory target) (populate-root-file-system system-directory target
#:extras extra-directives)
;; 'register-closure' resets timestamps and everything, so no need to do it ;; 'register-closure' resets timestamps and everything, so no need to do it
;; once more in that case. ;; once more in that case.

View file

@ -368,6 +368,7 @@ INPUTS is a list of inputs (as for packages)."
(disk-image-size 'guess) (disk-image-size 'guess)
(disk-image-format "qcow2") (disk-image-format "qcow2")
(file-system-type "ext4") (file-system-type "ext4")
(extra-directives '())
file-system-label file-system-label
file-system-uuid file-system-uuid
os os
@ -392,7 +393,10 @@ 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. By default, REGISTER-CLOSURES? is set to true only if a service of 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 type GUIX-SERVICE-TYPE is present in the services definition of the operating
system." system.
EXTRA-DIRECTIVES is an optional list of directives to populate the root file
system that is passed to 'populate-root-file-system'."
(define schema (define schema
(and register-closures? (and register-closures?
(local-file (search-path %load-path (local-file (search-path %load-path
@ -441,6 +445,7 @@ system."
(((names . _) ...) (((names . _) ...)
names))) names)))
(initialize (root-partition-initializer (initialize (root-partition-initializer
#:extra-directives '#$extra-directives
#:closures graphs #:closures graphs
#:copy-closures? #$copy-inputs? #:copy-closures? #$copy-inputs?
#:register-closures? #$register-closures? #:register-closures? #$register-closures?