rekahsoft
/
guix
1
1
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

183
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,56 +625,54 @@ 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.
(initrd (lambda (file-systems . rest) (initrd (lambda (file-systems . rest)
(apply (operating-system-initrd os) (apply (operating-system-initrd os)
file-systems file-systems
#:volatile-root? #t #:volatile-root? #t
rest))) rest)))
(bootloader (if (string=? "iso9660" file-system-type) (bootloader (if (string=? "iso9660" file-system-type)
(bootloader-configuration (bootloader-configuration
(inherit (operating-system-bootloader os)) (inherit (operating-system-bootloader os))
(bootloader grub-mkrescue-bootloader)) (bootloader grub-mkrescue-bootloader))
(operating-system-bootloader os))) (operating-system-bootloader os)))
;; Force our own root file system. ;; Force our own root file system.
(file-systems (cons (file-system (file-systems (cons (file-system
(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)) (if (string=? "iso9660" file-system-type)
(bootcfg -> (operating-system-bootcfg os))) (iso9660-image #:name name
(if (string=? "iso9660" file-system-type) #:file-system-label root-label
(iso9660-image #:name name #:file-system-uuid root-uuid
#:file-system-label root-label #:os os
#:file-system-uuid root-uuid #:register-closures? #t
#:os-drv os-drv #:bootcfg-drv bootcfg
#:register-closures? #t #:bootloader (bootloader-configuration-bootloader
#:bootcfg-drv bootcfg (operating-system-bootloader os))
#:bootloader (bootloader-configuration-bootloader #:inputs `(("system" ,os)
(operating-system-bootloader os)) ("bootcfg" ,bootcfg)))
#:inputs `(("system" ,os-drv) (qemu-image #:name name
("bootcfg" ,bootcfg))) #:os os
(qemu-image #:name name #:bootcfg-drv bootcfg
#:os-drv os-drv #:bootloader (bootloader-configuration-bootloader
#:bootcfg-drv bootcfg (operating-system-bootloader os))
#:bootloader (bootloader-configuration-bootloader #:disk-image-size disk-image-size
(operating-system-bootloader os)) #:disk-image-format "raw"
#:disk-image-size disk-image-size #:file-system-type file-system-type
#:disk-image-format "raw" #:file-system-label root-label
#:file-system-type file-system-type #:file-system-uuid root-uuid
#:file-system-label root-label #:copy-inputs? #t
#:file-system-uuid root-uuid #:register-closures? #t
#:copy-inputs? #t #:inputs `(("system" ,os)
#:register-closures? #t ("bootcfg" ,bootcfg))))))
#:inputs `(("system" ,os-drv)
("bootcfg" ,bootcfg)))))))
(define* (system-qemu-image os (define* (system-qemu-image os
#:key #:key
@ -700,30 +698,28 @@ 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
;; it works regardless of how the image is used ("qemu -hda", ;; it works regardless of how the image is used ("qemu -hda",
;; Xen, etc.). ;; Xen, etc.).
(file-systems (cons (file-system (file-systems (cons (file-system
(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))) #:bootcfg-drv bootcfg
(qemu-image #:os-drv os-drv #:bootloader (bootloader-configuration-bootloader
#:bootcfg-drv bootcfg (operating-system-bootloader os))
#:bootloader (bootloader-configuration-bootloader #:disk-image-size disk-image-size
(operating-system-bootloader os)) #:file-system-type file-system-type
#:disk-image-size disk-image-size #:file-system-uuid root-uuid
#:file-system-type file-system-type #:inputs `(("system" ,os)
#:file-system-uuid root-uuid ("bootcfg" ,bootcfg))
#:inputs `(("system" ,os-drv) #:copy-inputs? #t)))
("bootcfg" ,bootcfg))
#:copy-inputs? #t))))
;;; ;;;
@ -827,25 +823,26 @@ 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
;; 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. ;; XXX: When FULL-BOOT? is true, we end up creating an image that contains
#:register-closures? #f ;; BOOTCFG and all its dependencies, including the output of OS.
#:copy-inputs? full-boot?))) ;; 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) (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,