summary refs log tree commit diff
path: root/gnu/system/vm.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-04-23 16:53:36 +0200
committerLudovic Courtès <ludo@gnu.org>2014-04-23 16:53:36 +0200
commitc47f0d8b71cd3b2dd1ed9fb90a997f5abecddb8b (patch)
treec41e2bd64cde00107d181ea32570b26a4031296c /gnu/system/vm.scm
parent2106d3fc8112581d1d869a13b9a6a29ab4e48b57 (diff)
downloadguix-c47f0d8b71cd3b2dd1ed9fb90a997f5abecddb8b.tar.gz
vm: Clarify 'system-qemu-image/shared-store-script'.
* gnu/system/vm.scm (system-qemu-image/shared-store-script): Move
  'initrd' definition to the top-level.  Have a single definition of
  'initrd', 'image', and 'os-drv'.
Diffstat (limited to 'gnu/system/vm.scm')
-rw-r--r--gnu/system/vm.scm26
1 files changed, 13 insertions, 13 deletions
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 069ac3093a..c491336ccb 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -341,18 +341,21 @@ with the host."
           (graphic? #t))
   "Return a derivation that builds a script to run a virtual machine image of
 OS that shares its store with the host."
-  (let* ((initrd (qemu-initrd #:mounts `((9p "store" ,(%store-prefix)))
-                              #:volatile-root? #t))
-         (os     (operating-system (inherit os) (initrd initrd))))
+  (define initrd
+    (qemu-initrd #:mounts `((9p "store" ,(%store-prefix)))
+                 #:volatile-root? #t))
+
+  (mlet* %store-monad
+      ((os ->  (operating-system (inherit os) (initrd initrd)))
+       (os-drv (operating-system-derivation os))
+       (initrd initrd)
+       (image  (system-qemu-image/shared-store os)))
     (define builder
-      (mlet %store-monad ((image  (system-qemu-image/shared-store os))
-                          (qemu   (package-file qemu
+      (mlet %store-monad ((qemu   (package-file qemu
                                                 "bin/qemu-system-x86_64"))
                           (bash   (package-file bash "bin/sh"))
                           (kernel (package-file (operating-system-kernel os)
-                                                "bzImage"))
-                          (initrd initrd)
-                          (os-drv (operating-system-derivation os)))
+                                                "bzImage")))
         (return `(let ((out (assoc-ref %outputs "out")))
                    (call-with-output-file out
                      (lambda (port)
@@ -371,17 +374,14 @@ exec " ,qemu " -enable-kvm -no-reboot -net nic,model=virtio \
                    (chmod out #o555)
                    #t))))
 
-    (mlet %store-monad ((image   (system-qemu-image/shared-store os))
-                        (initrd  initrd)
-                        (qemu    (package->derivation qemu))
+    (mlet %store-monad ((qemu    (package->derivation qemu))
                         (bash    (package->derivation bash))
-                        (os      (operating-system-derivation os))
                         (builder builder))
       (derivation-expression "run-vm.sh" builder
                              #:inputs `(("qemu" ,qemu)
                                         ("image" ,image)
                                         ("bash" ,bash)
                                         ("initrd" ,initrd)
-                                        ("os" ,os))))))
+                                        ("os" ,os-drv))))))
 
 ;;; vm.scm ends here