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'.
This commit is contained in:
Ludovic Courtès 2014-04-23 16:53:36 +02:00
parent 2106d3fc81
commit c47f0d8b71
1 changed files with 13 additions and 13 deletions

View File

@ -341,18 +341,21 @@ with the host."
(graphic? #t)) (graphic? #t))
"Return a derivation that builds a script to run a virtual machine image of "Return a derivation that builds a script to run a virtual machine image of
OS that shares its store with the host." OS that shares its store with the host."
(let* ((initrd (qemu-initrd #:mounts `((9p "store" ,(%store-prefix))) (define initrd
#:volatile-root? #t)) (qemu-initrd #:mounts `((9p "store" ,(%store-prefix)))
(os (operating-system (inherit os) (initrd initrd)))) #: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 (define builder
(mlet %store-monad ((image (system-qemu-image/shared-store os)) (mlet %store-monad ((qemu (package-file qemu
(qemu (package-file qemu
"bin/qemu-system-x86_64")) "bin/qemu-system-x86_64"))
(bash (package-file bash "bin/sh")) (bash (package-file bash "bin/sh"))
(kernel (package-file (operating-system-kernel os) (kernel (package-file (operating-system-kernel os)
"bzImage")) "bzImage")))
(initrd initrd)
(os-drv (operating-system-derivation os)))
(return `(let ((out (assoc-ref %outputs "out"))) (return `(let ((out (assoc-ref %outputs "out")))
(call-with-output-file out (call-with-output-file out
(lambda (port) (lambda (port)
@ -371,17 +374,14 @@ exec " ,qemu " -enable-kvm -no-reboot -net nic,model=virtio \
(chmod out #o555) (chmod out #o555)
#t)))) #t))))
(mlet %store-monad ((image (system-qemu-image/shared-store os)) (mlet %store-monad ((qemu (package->derivation qemu))
(initrd initrd)
(qemu (package->derivation qemu))
(bash (package->derivation bash)) (bash (package->derivation bash))
(os (operating-system-derivation os))
(builder builder)) (builder builder))
(derivation-expression "run-vm.sh" builder (derivation-expression "run-vm.sh" builder
#:inputs `(("qemu" ,qemu) #:inputs `(("qemu" ,qemu)
("image" ,image) ("image" ,image)
("bash" ,bash) ("bash" ,bash)
("initrd" ,initrd) ("initrd" ,initrd)
("os" ,os)))))) ("os" ,os-drv))))))
;;; vm.scm ends here ;;; vm.scm ends here