From: "Ludovic Courtès" <ludo@gnu.org>
To: 33405@debbugs.gnu.org
Subject: [bug#33405] [PATCH 07/10] vm: Remove explicit calls to 'operating-system-derivation'.
Date: Fri, 16 Nov 2018 10:36:21 +0100 [thread overview]
Message-ID: <20181116093624.4820-7-ludo@gnu.org> (raw)
In-Reply-To: <20181116093624.4820-1-ludo@gnu.org>
* 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.
---
gnu/system/vm.scm | 183 +++++++++++++++++++++++-----------------------
1 file changed, 90 insertions(+), 93 deletions(-)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index e6f0f78120..8e310a1607 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -252,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?
@@ -300,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
@@ -329,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)
@@ -395,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
@@ -625,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)))
+ (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)))
+ (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)))))))
+ ;; 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
@@ -700,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.
+ (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))))
+ ;; 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)))
\f
;;;
@@ -827,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))
- '())
+ (define bootcfg
+ (operating-system-bootcfg os))
- ;; XXX: Passing #t here is too slow, so let it off by default.
- #:register-closures? #f
- #:copy-inputs? full-boot?)))
+ ;; 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,
--
2.19.1
next prev parent reply other threads:[~2018-11-16 9:38 UTC|newest]
Thread overview: 16+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-11-16 9:21 [bug#33405] [PATCH 00/10] De-monadify and clean up system code Ludovic Courtès
2018-11-16 9:36 ` [bug#33405] [PATCH 01/10] bootloader: De-monadify configuration file generators Ludovic Courtès
2018-11-16 9:36 ` [bug#33405] [PATCH 02/10] system: Simplify kernel argument handling Ludovic Courtès
2018-11-16 9:36 ` [bug#33405] [PATCH 03/10] linux-initrd: Return file-like objects instead of monadic values Ludovic Courtès
2018-11-16 9:36 ` [bug#33405] [PATCH 04/10] system: De-monadify 'operating-system-boot-parameters' Ludovic Courtès
2018-11-16 9:36 ` [bug#33405] [PATCH 05/10] system: Please Emacs Ludovic Courtès
2018-11-16 9:36 ` [bug#33405] [PATCH 06/10] system: De-monadify 'operating-system-bootcfg' Ludovic Courtès
2018-11-16 9:36 ` Ludovic Courtès [this message]
2018-11-16 9:36 ` [bug#33405] [PATCH 08/10] guix system: Simplify bootloader package handling Ludovic Courtès
2018-11-16 9:36 ` [bug#33405] [PATCH 09/10] guix system: De-monadify bootloader installation script Ludovic Courtès
2018-11-16 9:36 ` [bug#33405] [PATCH 10/10] guix system: Clarify 'perform-action' Ludovic Courtès
2018-11-16 13:39 ` [bug#33405] [PATCH 00/10] De-monadify and clean up system code Mathieu Othacehe
2018-11-16 16:50 ` Ludovic Courtès
2018-11-17 1:14 ` Mathieu Othacehe
2018-11-18 22:42 ` bug#33405: " Ludovic Courtès
2018-11-16 23:32 ` [bug#33405] " Danny Milosavljevic
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20181116093624.4820-7-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=33405@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.