aboutsummaryrefslogtreecommitdiff
path: root/gnu/system/vm.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system/vm.scm')
-rw-r--r--gnu/system/vm.scm210
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