nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

vm: Remove explicit calls to 'operating-system-derivation'. 

* gnu/system/vm.scm (iso9660-image): Change 'os-drv' to 'os' and remove
call to 'operating-system-derivation'.
(system-qemu-image): Likewise.
(system-qemu-image/shared-store): Likewise.
This commit is contained in:
Ludovic Courtès 2018-11-16 09:05:45 +01:00
parent 9782c82217
commit 8bff7dc2ad
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 90 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
gnu/system/vm.scm
View File

@ -252,7 +252,7 @@ made available under the /xchg CIFS share."
file-system-uuid file-system-uuid
(system (%current-system)) (system (%current-system))
(qemu qemu-minimal) (qemu qemu-minimal)
os-drv os
bootcfg-drv bootcfg-drv
bootloader bootloader
register-closures? register-closures?
@ -300,7 +300,7 @@ INPUTS is a list of inputs (as for packages)."
(set-path-environment-variable "PATH" '("bin" "sbin") inputs) (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
(make-iso9660-image #$(bootloader-package bootloader) (make-iso9660-image #$(bootloader-package bootloader)
#$bootcfg-drv #$bootcfg-drv
#$os-drv #$os
"/xchg/guixsd.iso" "/xchg/guixsd.iso"
#:register-closures? #$register-closures? #:register-closures? #$register-closures?
#:closures graphs #:closures graphs
@ -329,7 +329,7 @@ INPUTS is a list of inputs (as for packages)."
(file-system-type "ext4") (file-system-type "ext4")
file-system-label file-system-label
file-system-uuid file-system-uuid
os-drv os
bootcfg-drv bootcfg-drv
bootloader bootloader
(register-closures? #t) (register-closures? #t)
@ -395,7 +395,7 @@ the image."
#:closures graphs #:closures graphs
#:copy-closures? #$copy-inputs? #:copy-closures? #$copy-inputs?
#:register-closures? #$register-closures? #:register-closures? #$register-closures?
#:system-directory #$os-drv #:system-directory #$os
;; Disable deduplication to speed things up, ;; Disable deduplication to speed things up,
;; and because it doesn't help much for a ;; and because it doesn't help much for a
@ -625,7 +625,7 @@ to USB sticks meant to be read-only."
(string=? (file-system-mount-point fs) "/")) (string=? (file-system-mount-point fs) "/"))
(operating-system-file-systems os))) (operating-system-file-systems os)))
(let ((os (operating-system (inherit os) (let* ((os (operating-system (inherit os)
;; Since this is meant to be used on real hardware, don't ;; Since this is meant to be used on real hardware, don't
;; install QEMU networking or anything like that. Assume USB ;; install QEMU networking or anything like that. Assume USB
;; mass storage devices (usb-storage.ko) are available. ;; mass storage devices (usb-storage.ko) are available.
@ -646,23 +646,21 @@ to USB sticks meant to be read-only."
(mount-point "/") (mount-point "/")
(device root-uuid) (device root-uuid)
(type file-system-type)) (type file-system-type))
file-systems-to-keep))))) file-systems-to-keep))))
(bootcfg (operating-system-bootcfg os)))
(mlet* %store-monad ((os-drv (operating-system-derivation os))
(bootcfg -> (operating-system-bootcfg os)))
(if (string=? "iso9660" file-system-type) (if (string=? "iso9660" file-system-type)
(iso9660-image #:name name (iso9660-image #:name name
#:file-system-label root-label #:file-system-label root-label
#:file-system-uuid root-uuid #:file-system-uuid root-uuid
#:os-drv os-drv #:os os
#:register-closures? #t #:register-closures? #t
#:bootcfg-drv bootcfg #:bootcfg-drv bootcfg
#:bootloader (bootloader-configuration-bootloader #:bootloader (bootloader-configuration-bootloader
(operating-system-bootloader os)) (operating-system-bootloader os))
#:inputs `(("system" ,os-drv) #:inputs `(("system" ,os)
("bootcfg" ,bootcfg))) ("bootcfg" ,bootcfg)))
(qemu-image #:name name (qemu-image #:name name
#:os-drv os-drv #:os os
#:bootcfg-drv bootcfg #:bootcfg-drv bootcfg
#:bootloader (bootloader-configuration-bootloader #:bootloader (bootloader-configuration-bootloader
(operating-system-bootloader os)) (operating-system-bootloader os))
@ -673,8 +671,8 @@ to USB sticks meant to be read-only."
#:file-system-uuid root-uuid #:file-system-uuid root-uuid
#:copy-inputs? #t #:copy-inputs? #t
#:register-closures? #t #:register-closures? #t
#:inputs `(("system" ,os-drv) #:inputs `(("system" ,os)
("bootcfg" ,bootcfg))))))) ("bootcfg" ,bootcfg))))))
(define* (system-qemu-image os (define* (system-qemu-image os
#:key #:key
@ -700,7 +698,7 @@ of the GNU system as described by OS."
'dce))) 'dce)))
(let ((os (operating-system (inherit os) (let* ((os (operating-system (inherit os)
;; Assume we have an initrd with the whole QEMU shebang. ;; Assume we have an initrd with the whole QEMU shebang.
;; Force our own root file system. Refer to it by UUID so that ;; Force our own root file system. Refer to it by UUID so that
@ -710,20 +708,18 @@ of the GNU system as described by OS."
(mount-point "/") (mount-point "/")
(device root-uuid) (device root-uuid)
(type file-system-type)) (type file-system-type))
file-systems-to-keep))))) file-systems-to-keep))))
(mlet* %store-monad (bootcfg (operating-system-bootcfg os)))
((os-drv (operating-system-derivation os)) (qemu-image #:os os
(bootcfg -> (operating-system-bootcfg os)))
(qemu-image #:os-drv os-drv
#:bootcfg-drv bootcfg #:bootcfg-drv bootcfg
#:bootloader (bootloader-configuration-bootloader #:bootloader (bootloader-configuration-bootloader
(operating-system-bootloader os)) (operating-system-bootloader os))
#:disk-image-size disk-image-size #:disk-image-size disk-image-size
#:file-system-type file-system-type #:file-system-type file-system-type
#:file-system-uuid root-uuid #:file-system-uuid root-uuid
#:inputs `(("system" ,os-drv) #:inputs `(("system" ,os)
("bootcfg" ,bootcfg)) ("bootcfg" ,bootcfg))
#:copy-inputs? #t)))) #:copy-inputs? #t)))
;;; ;;;
@ -827,13 +823,14 @@ bootloader refers to: OS kernel, initrd, bootloader data, etc."
;; Use a fixed UUID to improve determinism. ;; Use a fixed UUID to improve determinism.
(operating-system-uuid os 'dce)) (operating-system-uuid os 'dce))
(mlet* %store-monad ((os-drv (operating-system-derivation os)) (define bootcfg
(bootcfg -> (operating-system-bootcfg os))) (operating-system-bootcfg os))
;; XXX: When FULL-BOOT? is true, we end up creating an image that contains ;; 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. ;; BOOTCFG and all its dependencies, including the output of OS.
;; This is more than needed (we only need the kernel, initrd, GRUB for its ;; 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. ;; font, and the background image), but it's hard to filter that.
(qemu-image #:os-drv os-drv (qemu-image #:os os
#:bootcfg-drv bootcfg #:bootcfg-drv bootcfg
#:bootloader (bootloader-configuration-bootloader #:bootloader (bootloader-configuration-bootloader
(operating-system-bootloader os)) (operating-system-bootloader os))
@ -845,7 +842,7 @@ bootloader refers to: OS kernel, initrd, bootloader data, etc."
;; XXX: Passing #t here is too slow, so let it off by default. ;; XXX: Passing #t here is too slow, so let it off by default.
#:register-closures? #f #:register-closures? #f
#:copy-inputs? full-boot?))) #:copy-inputs? full-boot?))
(define* (common-qemu-options image shared-fs) (define* (common-qemu-options image shared-fs)
"Return the a string-value gexp with the common QEMU options to boot IMAGE, "Return the a string-value gexp with the common QEMU options to boot IMAGE,