Merge branch 'master' into core-updates

1 files changed, 102 insertions, 108 deletions

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index a1b595d45d..8e310a1607 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -189,14 +189,12 @@ made available under the /xchg CIFS share."
                   #~(when (zero? (system* #$user-builder))
                       (reboot))))
 
-  (mlet* %store-monad
-      ((initrd       (if initrd                   ; use the default initrd?
-                         (return initrd)
-                         (base-initrd file-systems
-                                      #:on-error 'backtrace
-                                      #:linux linux
-                                      #:linux-modules %base-initrd-modules
-                                      #:qemu-networking? #t))))
+  (let ((initrd (or initrd
+                    (base-initrd file-systems
+                                 #:on-error 'backtrace
+                                 #:linux linux
+                                 #:linux-modules %base-initrd-modules
+                                 #:qemu-networking? #t))))
 
     (define builder
       ;; Code that launches the VM that evaluates EXP.
@@ -254,7 +252,7 @@ made available under the /xchg CIFS share."
                         file-system-uuid
                         (system (%current-system))
                         (qemu qemu-minimal)
-                        os-drv
+                        os
                         bootcfg-drv
                         bootloader
                         register-closures?
@@ -302,7 +300,7 @@ INPUTS is a list of inputs (as for packages)."
              (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
              (make-iso9660-image #$(bootloader-package bootloader)
                                  #$bootcfg-drv
-                                 #$os-drv
+                                 #$os
                                  "/xchg/guixsd.iso"
                                  #:register-closures? #$register-closures?
                                  #:closures graphs
@@ -331,7 +329,7 @@ INPUTS is a list of inputs (as for packages)."
                      (file-system-type "ext4")
                      file-system-label
                      file-system-uuid
-                     os-drv
+                     os
                      bootcfg-drv
                      bootloader
                      (register-closures? #t)
@@ -397,7 +395,7 @@ the image."
                                  #:closures graphs
                                  #:copy-closures? #$copy-inputs?
                                  #:register-closures? #$register-closures?
-                                 #:system-directory #$os-drv
+                                 #:system-directory #$os
 
                                  ;; Disable deduplication to speed things up,
                                  ;; and because it doesn't help much for a
@@ -627,56 +625,54 @@ to USB sticks meant to be read-only."
               (string=? (file-system-mount-point fs) "/"))
             (operating-system-file-systems os)))
 
-  (let ((os (operating-system (inherit os)
-              ;; Since this is meant to be used on real hardware, don't
-              ;; install QEMU networking or anything like that.  Assume USB
-              ;; mass storage devices (usb-storage.ko) are available.
-              (initrd (lambda (file-systems . rest)
-                        (apply (operating-system-initrd os)
-                               file-systems
-                               #:volatile-root? #t
-                               rest)))
-
-              (bootloader (if (string=? "iso9660" file-system-type)
-                              (bootloader-configuration
-                                (inherit (operating-system-bootloader os))
-                                (bootloader grub-mkrescue-bootloader))
-                              (operating-system-bootloader os)))
-
-              ;; Force our own root file system.
-              (file-systems (cons (file-system
-                                    (mount-point "/")
-                                    (device root-uuid)
-                                    (type file-system-type))
-                                  file-systems-to-keep)))))
-
-    (mlet* %store-monad ((os-drv   (operating-system-derivation os))
-                         (bootcfg  (operating-system-bootcfg os)))
-      (if (string=? "iso9660" file-system-type)
-          (iso9660-image #:name name
-                         #:file-system-label root-label
-                         #:file-system-uuid root-uuid
-                         #:os-drv os-drv
-                         #:register-closures? #t
-                         #:bootcfg-drv bootcfg
-                         #:bootloader (bootloader-configuration-bootloader
-                                        (operating-system-bootloader os))
-                         #:inputs `(("system" ,os-drv)
-                                    ("bootcfg" ,bootcfg)))
-          (qemu-image #:name name
-                      #:os-drv os-drv
-                      #:bootcfg-drv bootcfg
-                      #:bootloader (bootloader-configuration-bootloader
-                                    (operating-system-bootloader os))
-                      #:disk-image-size disk-image-size
-                      #:disk-image-format "raw"
-                      #:file-system-type file-system-type
-                      #:file-system-label root-label
-                      #:file-system-uuid root-uuid
-                      #:copy-inputs? #t
-                      #:register-closures? #t
-                      #:inputs `(("system" ,os-drv)
-                                 ("bootcfg" ,bootcfg)))))))
+  (let* ((os (operating-system (inherit os)
+               ;; Since this is meant to be used on real hardware, don't
+               ;; install QEMU networking or anything like that.  Assume USB
+               ;; mass storage devices (usb-storage.ko) are available.
+               (initrd (lambda (file-systems . rest)
+                         (apply (operating-system-initrd os)
+                                file-systems
+                                #:volatile-root? #t
+                                rest)))
+
+               (bootloader (if (string=? "iso9660" file-system-type)
+                               (bootloader-configuration
+                                 (inherit (operating-system-bootloader os))
+                                 (bootloader grub-mkrescue-bootloader))
+                               (operating-system-bootloader os)))
+
+               ;; Force our own root file system.
+               (file-systems (cons (file-system
+                                     (mount-point "/")
+                                     (device root-uuid)
+                                     (type file-system-type))
+                                   file-systems-to-keep))))
+        (bootcfg (operating-system-bootcfg os)))
+    (if (string=? "iso9660" file-system-type)
+        (iso9660-image #:name name
+                       #:file-system-label root-label
+                       #:file-system-uuid root-uuid
+                       #:os os
+                       #:register-closures? #t
+                       #:bootcfg-drv bootcfg
+                       #:bootloader (bootloader-configuration-bootloader
+                                     (operating-system-bootloader os))
+                       #:inputs `(("system" ,os)
+                                  ("bootcfg" ,bootcfg)))
+        (qemu-image #:name name
+                    #:os os
+                    #:bootcfg-drv bootcfg
+                    #:bootloader (bootloader-configuration-bootloader
+                                  (operating-system-bootloader os))
+                    #:disk-image-size disk-image-size
+                    #:disk-image-format "raw"
+                    #:file-system-type file-system-type
+                    #:file-system-label root-label
+                    #:file-system-uuid root-uuid
+                    #:copy-inputs? #t
+                    #:register-closures? #t
+                    #:inputs `(("system" ,os)
+                               ("bootcfg" ,bootcfg))))))
 
 (define* (system-qemu-image os
                             #:key
@@ -702,30 +698,28 @@ of the GNU system as described by OS."
                                'dce)))
 
 
-  (let ((os (operating-system (inherit os)
-              ;; Assume we have an initrd with the whole QEMU shebang.
-
-              ;; Force our own root file system.  Refer to it by UUID so that
-              ;; it works regardless of how the image is used ("qemu -hda",
-              ;; Xen, etc.).
-              (file-systems (cons (file-system
-                                    (mount-point "/")
-                                    (device root-uuid)
-                                    (type file-system-type))
-                                  file-systems-to-keep)))))
-    (mlet* %store-monad
-        ((os-drv      (operating-system-derivation os))
-         (bootcfg     (operating-system-bootcfg os)))
-      (qemu-image  #:os-drv os-drv
-                   #:bootcfg-drv bootcfg
-                   #:bootloader (bootloader-configuration-bootloader
-                                 (operating-system-bootloader os))
-                   #:disk-image-size disk-image-size
-                   #:file-system-type file-system-type
-                   #:file-system-uuid root-uuid
-                   #:inputs `(("system" ,os-drv)
-                              ("bootcfg" ,bootcfg))
-                   #:copy-inputs? #t))))
+  (let* ((os (operating-system (inherit os)
+               ;; Assume we have an initrd with the whole QEMU shebang.
+
+               ;; Force our own root file system.  Refer to it by UUID so that
+               ;; it works regardless of how the image is used ("qemu -hda",
+               ;; Xen, etc.).
+               (file-systems (cons (file-system
+                                     (mount-point "/")
+                                     (device root-uuid)
+                                     (type file-system-type))
+                                   file-systems-to-keep))))
+         (bootcfg (operating-system-bootcfg os)))
+    (qemu-image  #:os os
+                 #:bootcfg-drv bootcfg
+                 #:bootloader (bootloader-configuration-bootloader
+                               (operating-system-bootloader os))
+                 #:disk-image-size disk-image-size
+                 #:file-system-type file-system-type
+                 #:file-system-uuid root-uuid
+                 #:inputs `(("system" ,os)
+                            ("bootcfg" ,bootcfg))
+                 #:copy-inputs? #t)))
 
 
 ;;;
@@ -829,25 +823,26 @@ bootloader refers to: OS kernel, initrd, bootloader data, etc."
     ;; Use a fixed UUID to improve determinism.
     (operating-system-uuid os 'dce))
 
-  (mlet* %store-monad ((os-drv   (operating-system-derivation os))
-                       (bootcfg  (operating-system-bootcfg os)))
-    ;; XXX: When FULL-BOOT? is true, we end up creating an image that contains
-    ;; BOOTCFG and all its dependencies, including the output of OS-DRV.
-    ;; This is more than needed (we only need the kernel, initrd, GRUB for its
-    ;; font, and the background image), but it's hard to filter that.
-    (qemu-image #:os-drv os-drv
-                #:bootcfg-drv bootcfg
-                #:bootloader (bootloader-configuration-bootloader
-                              (operating-system-bootloader os))
-                #:disk-image-size disk-image-size
-                #:file-system-uuid root-uuid
-                #:inputs (if full-boot?
-                             `(("bootcfg" ,bootcfg))
-                             '())
-
-                ;; XXX: Passing #t here is too slow, so let it off by default.
-                #:register-closures? #f
-                #:copy-inputs? full-boot?)))
+  (define bootcfg
+    (operating-system-bootcfg os))
+
+  ;; XXX: When FULL-BOOT? is true, we end up creating an image that contains
+  ;; BOOTCFG and all its dependencies, including the output of OS.
+  ;; This is more than needed (we only need the kernel, initrd, GRUB for its
+  ;; font, and the background image), but it's hard to filter that.
+  (qemu-image #:os os
+              #:bootcfg-drv bootcfg
+              #:bootloader (bootloader-configuration-bootloader
+                            (operating-system-bootloader os))
+              #:disk-image-size disk-image-size
+              #:file-system-uuid root-uuid
+              #:inputs (if full-boot?
+                           `(("bootcfg" ,bootcfg))
+                           '())
+
+              ;; XXX: Passing #t here is too slow, so let it off by default.
+              #:register-closures? #f
+              #:copy-inputs? full-boot?))
 
 (define* (common-qemu-options image shared-fs)
   "Return the a string-value gexp with the common QEMU options to boot IMAGE,
@@ -897,21 +892,20 @@ bootloader; otherwise it directly starts the operating system kernel.  The
 DISK-IMAGE-SIZE parameter specifies the size in bytes of the root disk image;
 it is mostly useful when FULL-BOOT?  is true."
   (mlet* %store-monad ((os ->  (virtualized-operating-system os mappings full-boot?))
-                       (os-drv (operating-system-derivation os))
                        (image  (system-qemu-image/shared-store
                                 os
                                 #:full-boot? full-boot?
                                 #:disk-image-size disk-image-size)))
     (define kernel-arguments
       #~(list #$@(if graphic? #~() #~("console=ttyS0"))
-              #+@(operating-system-kernel-arguments os os-drv "/dev/vda1")))
+              #+@(operating-system-kernel-arguments os "/dev/vda1")))
 
     (define qemu-exec
       #~(list (string-append #$qemu "/bin/" #$(qemu-command (%current-system)))
               #$@(if full-boot?
                      #~()
                      #~("-kernel" #$(operating-system-kernel-file os)
-                        "-initrd" #$(file-append os-drv "/initrd")
+                        "-initrd" #$(file-append os "/initrd")
                         (format #f "-append ~s"
                                 (string-join #$kernel-arguments " "))))
               #$@(common-qemu-options image