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

[guix-commits]

civodul pushed a commit to branch wip-hurd-vm
in repository guix.

commit c3e95137299b5bbb59368ede977ff17d64646d87
Author: Ludovic Courtès <address@hidden>
AuthorDate: Wed Apr 1 15:03:10 2020 +0200

    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'.
---
 gnu/build/vm.scm  | 11 ++++++++---
 gnu/system/vm.scm |  7 ++++++-
 2 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 79eed48..9413798 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -362,14 +362,18 @@ it, run its initializer, and unmount it."
                                      copy-closures?
                                      (register-closures? #t)
                                      system-directory
-                                     (deduplicate? #t))
+                                     (deduplicate? #t)
+                                     (extra-directives '()))
   "Return a procedure to initialize a root partition.
 
 If REGISTER-CLOSURES? is true, register all of CLOSURES in the partition's
 store.  If DEDUPLICATE? is true, then also deduplicate files common to
 CLOSURES and the rest of the store when registering the closures.  If
 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)
     (define target-store
       (string-append target (%store-directory)))
@@ -402,7 +406,8 @@ SYSTEM-DIRECTORY is the name of the directory of the 
'system' derivation."
 
     ;; Add the non-store directories and files.
     (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
     ;; once more in that case.
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index c6ec25a..d81a789 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -360,6 +360,7 @@ INPUTS is a list of inputs (as for packages)."
                      (disk-image-size 'guess)
                      (disk-image-format "qcow2")
                      (file-system-type "ext4")
+                     (extra-directives '())
                      file-system-label
                      file-system-uuid
                      os
@@ -383,7 +384,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
 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."
+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
     (and register-closures?
          (local-file (search-path %load-path
@@ -432,6 +436,7 @@ system."
                                      (((names . _) ...)
                                       names)))
                     (initialize (root-partition-initializer
+                                 #:extra-directives '#$extra-directives
                                  #:closures graphs
                                  #:copy-closures? #$copy-inputs?
                                  #:register-closures? #$register-closures?