[bug#28288] [PATCH 2/2] WIP

[Christopher Baines]

---
 gnu/build/vm.scm  | 19 +++++++++++++++++--
 gnu/system/vm.scm | 16 +++++++++++-----
 2 files changed, 28 insertions(+), 7 deletions(-)

diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 727494ad9..e2659cb5e 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -366,12 +366,27 @@ SYSTEM-DIRECTORY is the name of the directory of the 
'system' derivation."
       (error "failed to create GRUB EFI image"))))
 
 (define* (make-iso9660-image grub config-file os-drv target
-                             #:key (volume-id "GuixSD_image") (volume-uuid #f))
+                             #:key (volume-id "GuixSD_image") (volume-uuid #f)
+                             register-closures? (closures '()))
   "Given a GRUB package, creates an iso image as TARGET, using CONFIG-FILE as
 GRUB configuration and OS-DRV as the stuff in it."
-  (let ((grub-mkrescue (string-append grub "/bin/grub-mkrescue")))
+  (let ((grub-mkrescue (string-append grub "/bin/grub-mkrescue"))
+        (target-store  (string-append "/tmp/root" (%store-directory))))
     (mkdir-p "/tmp/root/var/run")
     (mkdir-p "/tmp/root/run")
+
+    ;; XXX: 'guix-register' wants to palpate the things it registers, so
+    ;; bind-mount the store on the target.
+    (mkdir-p target-store)
+    (mount (%store-directory) target-store "" MS_BIND)
+
+    (when register-closures?
+      (display "registering closures...\n")
+      (for-each (lambda (closure)
+                  (register-closure target
+                                    (string-append "/xchg/" closure)))
+                closures))
+
     (unless (zero? (apply system*
                           `(,grub-mkrescue "-o" ,target
                             ,(string-append "boot/grub/grub.cfg=" config-file)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 4494af003..b106dff0a 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -192,6 +192,7 @@ made available under the /xchg CIFS share."
                         os-drv
                         bootcfg-drv
                         bootloader
+                        register-closures?
                         (inputs '()))
   "Return a bootable, stand-alone iso9660 image.
 
@@ -207,8 +208,13 @@ INPUTS is a list of inputs (as for packages)."
          (let ((inputs
                 '#$(append (list qemu parted e2fsprogs dosfstools xorriso)
                            (map canonical-package
-                                (list sed grep coreutils findutils gawk))))
+                                (list sed grep coreutils findutils gawk))
+                           (if register-closures? (list guix) '())))
 
+
+               (graphs     '#$(match inputs
+                                   (((names . _) ...)
+                                    names)))
                ;; This variable is unused but allows us to add INPUTS-TO-COPY
                ;; as inputs.
                (to-register
@@ -222,6 +228,8 @@ INPUTS is a list of inputs (as for packages)."
                                #$bootcfg-drv
                                #$os-drv
                                "/xchg/guixsd.iso"
+                               #:register-closures? #$register-closures?
+                               #:closures graphs
                                #:volume-id #$file-system-label
                                #:volume-uuid #$file-system-uuid)
            (reboot))))
@@ -391,6 +399,7 @@ to USB sticks meant to be read-only."
                          #:file-system-label root-label
                          #:file-system-uuid #f
                          #:os-drv os-drv
+                         #:register-closures? #t
                          #:bootcfg-drv bootcfg
                          #:bootloader (bootloader-configuration-bootloader
                                         (operating-system-bootloader os))
@@ -403,10 +412,7 @@ to USB sticks meant to be read-only."
                                     (operating-system-bootloader os))
                       #:disk-image-size disk-image-size
                       #:disk-image-format "raw"
-                      #:file-system-type (if (string=? "iso9660"
-                                                       file-system-type)
-                                             "ext4"
-                                             file-system-type)
+                      #:file-system-type file-system-type
                       #:file-system-label root-label
                       #:copy-inputs? #t
                       #:register-closures? #t
-- 
2.14.1