Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Fri, 16 Nov 2018 09:22:02 UTC
Severity: normal
Tags: patch
Done: ludo <at> gnu.org (Ludovic Courtès)
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 33405 in the body.
You can then email your comments to 33405 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org:bug#33405; Package guix-patches.
(Fri, 16 Nov 2018 09:22:02 GMT) Full text and rfc822 format available.Ludovic Courtès <ludo <at> gnu.org>:guix-patches <at> gnu.org.
(Fri, 16 Nov 2018 09:22:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: guix-patches <at> gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 00/10] De-monadify and clean up system code Date: Fri, 16 Nov 2018 10:21:03 +0100
Hello Guix! Here’s a South-hemisphere spring cleanup of the system code. Mostly it removes monadic forms here and there, which in turn simplifies the code and reduces the number of lines (yay!). There’s one user-visible change: ‘base-initrd’ and ‘raw-initrd’ are no longer monadic, so people who were using them in their ‘initrd’ field can be bitten by this incompatible. I think it’s OK though, because in practice people either no longer use the ‘initrd’ field now that there’s ‘initrd-modules’, or if they use ‘initrd’, they simply tail-call to ‘raw-initrd’ or ‘base-initrd’, in which case the type of its return value doesn’t matter much. Thoughts? Thanks, Ludo’. Ludovic Courtès (10): bootloader: De-monadify configuration file generators. system: Simplify kernel argument handling. linux-initrd: Return file-like objects instead of monadic values. system: De-monadify 'operating-system-boot-parameters'. system: Please Emacs. system: De-monadify 'operating-system-bootcfg'. vm: Remove explicit calls to 'operating-system-derivation'. guix system: Simplify bootloader package handling. guix system: De-monadify bootloader installation script. guix system: Clarify 'perform-action'. doc/guix.texi | 14 +-- gnu/bootloader/extlinux.scm | 6 +- gnu/bootloader/grub.scm | 104 +++++++++---------- gnu/bootloader/u-boot.scm | 5 - gnu/system.scm | 162 ++++++++++++++--------------- gnu/system/linux-initrd.scm | 13 ++- gnu/system/vm.scm | 202 +++++++++++++++++------------------- guix/scripts/system.scm | 89 ++++++++-------- 8 files changed, 285 insertions(+), 310 deletions(-) -- 2.19.1
guix-patches <at> gnu.org:bug#33405; Package guix-patches.
(Fri, 16 Nov 2018 09:38:01 GMT) Full text and rfc822 format available.Message #8 received at 33405 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33405 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 06/10] system: De-monadify 'operating-system-bootcfg'. Date: Fri, 16 Nov 2018 10:36:20 +0100
* gnu/system.scm (operating-system-bootcfg): Remove 'mlet*' and
'lower-object' call.
* gnu/system/vm.scm (system-disk-image)
(system-qemu-image/shared-store): Adjust accordingly.
* guix/scripts/system.scm (perform-action): Add 'lower-object' call for
BOOTCFG.
---
gnu/system.scm | 20 +++++++++-----------
gnu/system/vm.scm | 10 +++++-----
guix/scripts/system.scm | 13 +++++++------
3 files changed, 21 insertions(+), 22 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index 96b3b7d0e0..1766c8f90f 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -935,21 +935,19 @@ listed in OS. The C library expects to find it under
(define* (operating-system-bootcfg os #:optional (old-entries '()))
"Return the bootloader configuration file for OS. Use OLD-ENTRIES,
a list of <menu-entry>, to populate the \"old entries\" menu."
- (mlet* %store-monad
- ((root-fs -> (operating-system-root-file-system os))
- (root-device -> (file-system-device root-fs))
- (params -> (operating-system-boot-parameters os root-device
- #:system-kernel-arguments?
- #t))
- (entry -> (boot-parameters->menu-entry params))
- (bootloader-conf -> (operating-system-bootloader os)))
+ (let* ((root-fs (operating-system-root-file-system os))
+ (root-device (file-system-device root-fs))
+ (params (operating-system-boot-parameters
+ os root-device
+ #:system-kernel-arguments? #t))
+ (entry (boot-parameters->menu-entry params))
+ (bootloader-conf (operating-system-bootloader os)))
(define generate-config-file
(bootloader-configuration-file-generator
(bootloader-configuration-bootloader bootloader-conf)))
- ;; TODO: Remove the 'lower-object' call to make it non-monadic.
- (lower-object (generate-config-file bootloader-conf (list entry)
- #:old-entries old-entries))))
+ (generate-config-file bootloader-conf (list entry)
+ #:old-entries old-entries)))
(define* (operating-system-boot-parameters os root-device
#:key system-kernel-arguments?)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 6064e0f899..e6f0f78120 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -648,8 +648,8 @@ to USB sticks meant to be read-only."
(type file-system-type))
file-systems-to-keep)))))
- (mlet* %store-monad ((os-drv (operating-system-derivation os))
- (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)
(iso9660-image #:name name
#:file-system-label root-label
@@ -713,7 +713,7 @@ of the GNU system as described by OS."
file-systems-to-keep)))))
(mlet* %store-monad
((os-drv (operating-system-derivation os))
- (bootcfg (operating-system-bootcfg os)))
+ (bootcfg -> (operating-system-bootcfg os)))
(qemu-image #:os-drv os-drv
#:bootcfg-drv bootcfg
#:bootloader (bootloader-configuration-bootloader
@@ -827,8 +827,8 @@ 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)))
+ (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
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 9ba9428a08..c0f16cb2a7 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -858,12 +858,13 @@ static checks."
(return #f))))
(bootcfg (if (eq? 'container action)
(return #f)
- (operating-system-bootcfg
- os
- (if (eq? 'init action)
- '()
- (map boot-parameters->menu-entry
- (profile-boot-parameters))))))
+ (lower-object
+ (operating-system-bootcfg
+ os
+ (if (eq? 'init action)
+ '()
+ (map boot-parameters->menu-entry
+ (profile-boot-parameters)))))))
(bootcfg-file -> (bootloader-configuration-file bootloader))
(bootloader-installer
(let ((installer (bootloader-installer bootloader))
--
2.19.1
guix-patches <at> gnu.org:bug#33405; Package guix-patches.
(Fri, 16 Nov 2018 09:38:02 GMT) Full text and rfc822 format available.Message #11 received at 33405 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33405 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 04/10] system: De-monadify 'operating-system-boot-parameters'. Date: Fri, 16 Nov 2018 10:36:18 +0100
* gnu/system.scm (operating-system-boot-parameters): Turn to direct
style instead of monadic.
(operating-system-bootcfg): Adjust accordingly.
(operating-system-boot-parameters-file): Likewise.
---
gnu/system.scm | 55 +++++++++++++++++++++++++-------------------------
1 file changed, 27 insertions(+), 28 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index 4ea9391c4a..d4ce0d8e24 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -938,9 +938,9 @@ listed in OS. The C library expects to find it under
(mlet* %store-monad
((root-fs -> (operating-system-root-file-system os))
(root-device -> (file-system-device root-fs))
- (params (operating-system-boot-parameters os root-device
- #:system-kernel-arguments?
- #t))
+ (params -> (operating-system-boot-parameters os root-device
+ #:system-kernel-arguments?
+ #t))
(entry -> (boot-parameters->menu-entry params))
(bootloader-conf -> (operating-system-bootloader os)))
(define generate-config-file
@@ -956,25 +956,24 @@ listed in OS. The C library expects to find it under
"Return a monadic <boot-parameters> record that describes the boot
parameters of OS. When SYSTEM-KERNEL-ARGUMENTS? is true, add kernel arguments
such as '--root' and '--load' to <boot-parameters>."
- (mlet* %store-monad
- ((initrd -> (operating-system-initrd-file os))
- (store -> (operating-system-store-file-system os))
- (bootloader -> (bootloader-configuration-bootloader
- (operating-system-bootloader os)))
- (bootloader-name -> (bootloader-name bootloader))
- (label -> (kernel->boot-label (operating-system-kernel os))))
- (return (boot-parameters
- (label label)
- (root-device root-device)
- (kernel (operating-system-kernel-file os))
- (kernel-arguments
- (if system-kernel-arguments?
- (operating-system-kernel-arguments os root-device)
- (operating-system-user-kernel-arguments os)))
- (initrd initrd)
- (bootloader-name bootloader-name)
- (store-device (ensure-not-/dev (file-system-device store)))
- (store-mount-point (file-system-mount-point store))))))
+ (let* ((initrd (operating-system-initrd-file os))
+ (store (operating-system-store-file-system os))
+ (bootloader (bootloader-configuration-bootloader
+ (operating-system-bootloader os)))
+ (bootloader-name (bootloader-name bootloader))
+ (label (kernel->boot-label (operating-system-kernel os))))
+ (boot-parameters
+ (label label)
+ (root-device root-device)
+ (kernel (operating-system-kernel-file os))
+ (kernel-arguments
+ (if system-kernel-arguments?
+ (operating-system-kernel-arguments os root-device)
+ (operating-system-user-kernel-arguments os)))
+ (initrd initrd)
+ (bootloader-name bootloader-name)
+ (store-device (ensure-not-/dev (file-system-device store)))
+ (store-mount-point (file-system-mount-point store)))))
(define (device->sexp device)
"Serialize DEVICE as an sexp (really, as an object with a read syntax.)"
@@ -996,12 +995,12 @@ and '--load' to the returned file (since the returned file is then usually
stored into the content-addressed \"system\" directory, it's usually not a
good idea to give it because the content hash would change by the content hash
being stored into the \"parameters\" file)."
- (mlet* %store-monad ((root -> (operating-system-root-file-system os))
- (device -> (file-system-device root))
- (params (operating-system-boot-parameters
- os device
- #:system-kernel-arguments?
- system-kernel-arguments?)))
+ (let* ((root (operating-system-root-file-system os))
+ (device (file-system-device root))
+ (params (operating-system-boot-parameters
+ os device
+ #:system-kernel-arguments?
+ system-kernel-arguments?)))
(gexp->file "parameters"
#~(boot-parameters
(version 0)
--
2.19.1
guix-patches <at> gnu.org:bug#33405; Package guix-patches.
(Fri, 16 Nov 2018 09:38:02 GMT) Full text and rfc822 format available.Message #14 received at 33405 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33405 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 05/10] system: Please Emacs. Date: Fri, 16 Nov 2018 10:36:19 +0100
* gnu/system.scm (operating-system-bootcfg): Remove opening parenthesis
at the beginning of the line in the docstring to placate Emacs.
---
gnu/system.scm | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index d4ce0d8e24..96b3b7d0e0 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -933,8 +933,8 @@ listed in OS. The C library expects to find it under
(store-file-system (operating-system-file-systems os)))
(define* (operating-system-bootcfg os #:optional (old-entries '()))
- "Return the bootloader configuration file for OS. Use OLD-ENTRIES
-(which is a list of <menu-entry>) to populate the \"old entries\" menu."
+ "Return the bootloader configuration file for OS. Use OLD-ENTRIES,
+a list of <menu-entry>, to populate the \"old entries\" menu."
(mlet* %store-monad
((root-fs -> (operating-system-root-file-system os))
(root-device -> (file-system-device root-fs))
--
2.19.1
guix-patches <at> gnu.org:bug#33405; Package guix-patches.
(Fri, 16 Nov 2018 09:38:03 GMT) Full text and rfc822 format available.Message #17 received at 33405 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33405 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 08/10] guix system: Simplify bootloader package handling. Date: Fri, 16 Nov 2018 10:36:22 +0100
* guix/scripts/system.scm (perform-action): Remove 'bootloader-package'
variable. Pass (bootloader-package bootloader) as the 2nd argument to
'bootloader-installer-derivation'. Remove BOOTLOADER-PACKAGE from DRVS
since it's redundant.
---
guix/scripts/system.scm | 13 +++----------
1 file changed, 3 insertions(+), 10 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index c0f16cb2a7..14488107b8 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -851,11 +851,6 @@ static checks."
#:mappings mappings))
(bootloader -> (bootloader-configuration-bootloader
(operating-system-bootloader os)))
- (bootloader-package
- (let ((package (bootloader-package bootloader)))
- (if package
- (package->derivation package)
- (return #f))))
(bootcfg (if (eq? 'container action)
(return #f)
(lower-object
@@ -870,17 +865,15 @@ static checks."
(let ((installer (bootloader-installer bootloader))
(target (or target "/")))
(bootloader-installer-derivation installer
- bootloader-package
+ (bootloader-package bootloader)
bootloader-target target)))
;; For 'init' and 'reconfigure', always build BOOTCFG, even if
;; --no-bootloader is passed, because we then use it as a GC root.
;; See <http://bugs.gnu.org/21068>.
(drvs -> (if (memq action '(init reconfigure))
- (if (and install-bootloader? bootloader-package)
- (list sys bootcfg
- bootloader-package
- bootloader-installer)
+ (if install-bootloader?
+ (list sys bootcfg bootloader-installer)
(list sys bootcfg))
(list sys)))
(% (if derivations-only?
--
2.19.1
guix-patches <at> gnu.org:bug#33405; Package guix-patches.
(Fri, 16 Nov 2018 09:38:03 GMT) Full text and rfc822 format available.Message #20 received at 33405 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33405 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 10/10] guix system: Clarify 'perform-action'. Date: Fri, 16 Nov 2018 10:36:24 +0100
* guix/scripts/system.scm (perform-action): Move non-monadic local
variables outside the 'mlet' form.
---
guix/scripts/system.scm | 42 +++++++++++++++++++++--------------------
1 file changed, 22 insertions(+), 20 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 6f00f12509..6cf3704d88 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -833,6 +833,25 @@ static checks."
(define println
(cut format #t "~a~%" <>))
+ (define menu-entries
+ (if (eq? 'init action)
+ '()
+ (map boot-parameters->menu-entry (profile-boot-parameters))))
+
+ (define bootloader
+ (bootloader-configuration-bootloader (operating-system-bootloader os)))
+
+ (define bootcfg
+ (and (not (eq? 'container action))
+ (operating-system-bootcfg os menu-entries)))
+
+ (define bootloader-script
+ (let ((installer (bootloader-installer bootloader))
+ (target (or target "/")))
+ (bootloader-installer-script installer
+ (bootloader-package bootloader)
+ bootloader-target target)))
+
(when (eq? action 'reconfigure)
(maybe-suggest-running-guix-pull))
@@ -852,23 +871,6 @@ static checks."
#:image-size image-size
#:full-boot? full-boot?
#:mappings mappings))
- (bootloader -> (bootloader-configuration-bootloader
- (operating-system-bootloader os)))
- (bootcfg -> (and (not (eq? 'container action))
- (operating-system-bootcfg
- os
- (if (eq? 'init action)
- '()
- (map boot-parameters->menu-entry
- (profile-boot-parameters))))))
- (bootcfg-file -> (bootloader-configuration-file bootloader))
- (bootloader-installer
- ->
- (let ((installer (bootloader-installer bootloader))
- (target (or target "/")))
- (bootloader-installer-script installer
- (bootloader-package bootloader)
- bootloader-target target)))
;; For 'init' and 'reconfigure', always build BOOTCFG, even if
;; --no-bootloader is passed, because we then use it as a GC root.
@@ -876,7 +878,7 @@ static checks."
(drvs (mapm %store-monad lower-object
(if (memq action '(init reconfigure))
(if install-bootloader?
- (list sys bootcfg bootloader-installer)
+ (list sys bootcfg bootloader-script)
(list sys bootcfg))
(list sys))))
(% (if derivations-only?
@@ -887,7 +889,7 @@ static checks."
(if (or dry-run? derivations-only?)
(return #f)
- (begin
+ (let ((bootcfg-file (bootloader-configuration-file bootloader)))
(for-each (compose println derivation->output-path)
drvs)
@@ -896,7 +898,7 @@ static checks."
(mbegin %store-monad
(switch-to-system os)
(mwhen install-bootloader?
- (install-bootloader bootloader-installer
+ (install-bootloader bootloader-script
#:bootcfg bootcfg
#:bootcfg-file bootcfg-file
#:target "/"))))
--
2.19.1
guix-patches <at> gnu.org:bug#33405; Package guix-patches.
(Fri, 16 Nov 2018 09:38:04 GMT) Full text and rfc822 format available.Message #23 received at 33405 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33405 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 07/10] vm: Remove explicit calls to 'operating-system-derivation'. Date: Fri, 16 Nov 2018 10:36:21 +0100
* 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)))
;;;
@@ -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
guix-patches <at> gnu.org:bug#33405; Package guix-patches.
(Fri, 16 Nov 2018 09:38:04 GMT) Full text and rfc822 format available.Message #26 received at 33405 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33405 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 03/10] linux-initrd: Return file-like objects instead of monadic values. Date: Fri, 16 Nov 2018 10:36:17 +0100
This is an incompatible change visible to users via the 'initrd' field
of 'operating-system'. However, assuming the user's 'initrd' value
tail-calls to 'raw-initrd' or 'base-initrd', the switch to non-monadic
style is invisible.
* gnu/system/linux-initrd.scm (expression->initrd): Use 'computed-file'
instead of 'gexp->derivation'.
(raw-initrd, base-initrd): Adjust docstring to mention non-monadic
return.
* gnu/system/vm.scm (expression->derivation-in-linux-vm): Adjust
accordingly.
* gnu/system.scm (operating-system-directory-base-entries)
(operating-system-initrd-file)
(operating-system-boot-parameters): Adjust accordingly.
* doc/guix.texi (operating-system Reference)
(Initial RAM Disk): Update.
---
doc/guix.texi | 14 +++++++-------
gnu/system.scm | 18 +++++++++---------
gnu/system/linux-initrd.scm | 13 ++++++-------
gnu/system/vm.scm | 14 ++++++--------
4 files changed, 28 insertions(+), 31 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index cf3e95eb9f..439bbd7ef5 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -9860,7 +9860,7 @@ The list of Linux kernel modules that need to be available in the
initial RAM disk. @xref{Initial RAM Disk}.
@item @code{initrd} (default: @code{base-initrd})
-A monadic procedure that returns an initial RAM disk for the Linux
+A procedure that returns an initial RAM disk for the Linux
kernel. This field is provided to support low-level customization and
should rarely be needed for casual use. @xref{Initial RAM Disk}.
@@ -21917,10 +21917,10 @@ here is how to use it and customize it further.
@cindex initrd
@cindex initial RAM disk
-@deffn {Monadic Procedure} raw-initrd @var{file-systems} @
+@deffn {Scheme Procedure} raw-initrd @var{file-systems} @
[#:linux-modules '()] [#:mapped-devices '()] @
[#:helper-packages '()] [#:qemu-networking? #f] [#:volatile-root? #f]
-Return a monadic derivation that builds a raw initrd. @var{file-systems} is
+Return a derivation that builds a raw initrd. @var{file-systems} is
a list of file systems to be mounted by the initrd, possibly in addition to
the root file system specified on the kernel command line via @code{--root}.
@var{linux-modules} is a list of kernel modules to be loaded at boot time.
@@ -21938,10 +21938,10 @@ When @var{volatile-root?} is true, the root file system is writable but any chan
to it are lost.
@end deffn
-@deffn {Monadic Procedure} base-initrd @var{file-systems} @
+@deffn {Scheme Procedure} base-initrd @var{file-systems} @
[#:mapped-devices '()] [#:qemu-networking? #f] [#:volatile-root? #f]@
[#:linux-modules '()]
-Return a monadic derivation that builds a generic initrd, with kernel
+Return as a file-like object a generic initrd, with kernel
modules taken from @var{linux}. @var{file-systems} is a list of file-systems to be
mounted by the initrd, possibly in addition to the root file system specified
on the kernel command line via @code{--root}. @var{mapped-devices} is a list of device
@@ -21961,9 +21961,9 @@ program. That gives a lot of flexibility. The
@code{expression->initrd} procedure builds such an initrd, given the
program to run in that initrd.
-@deffn {Monadic Procedure} expression->initrd @var{exp} @
+@deffn {Scheme Procedure} expression->initrd @var{exp} @
[#:guile %guile-static-stripped] [#:name "guile-initrd"]
-Return a derivation that builds a Linux initrd (a gzipped cpio archive)
+Return as a file-like object a Linux initrd (a gzipped cpio archive)
containing @var{guile} and that evaluates @var{exp}, a G-expression,
upon booting. All the derivations referenced by @var{exp} are
automatically copied to the initrd.
diff --git a/gnu/system.scm b/gnu/system.scm
index b218efc875..4ea9391c4a 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -154,7 +154,7 @@
(default '())) ; list of gexps/strings
(bootloader operating-system-bootloader) ; <bootloader-configuration>
- (initrd operating-system-initrd ; (list fs) -> M derivation
+ (initrd operating-system-initrd ; (list fs) -> file-like
(default base-initrd))
(initrd-modules operating-system-initrd-modules ; list of strings
(thunked) ; it's system-dependent
@@ -442,7 +442,7 @@ value of the SYSTEM-SERVICE-TYPE service."
(return `(("locale" ,locale)))
(mlet %store-monad
((kernel -> (operating-system-kernel os))
- (initrd (operating-system-initrd-file os))
+ (initrd -> (operating-system-initrd-file os))
(params (operating-system-boot-parameters-file os)))
(return `(("kernel" ,kernel)
("parameters" ,params)
@@ -870,12 +870,12 @@ hardware-related operations as necessary when booting a Linux container."
(define make-initrd
(operating-system-initrd os))
- (mlet %store-monad ((initrd (make-initrd boot-file-systems
- #:linux (operating-system-kernel os)
- #:linux-modules
- (operating-system-initrd-modules os)
- #:mapped-devices mapped-devices)))
- (return (file-append initrd "/initrd"))))
+ (let ((initrd (make-initrd boot-file-systems
+ #:linux (operating-system-kernel os)
+ #:linux-modules
+ (operating-system-initrd-modules os)
+ #:mapped-devices mapped-devices)))
+ (file-append initrd "/initrd")))
(define (locale-name->definition* name)
"Variant of 'locale-name->definition' that raises an error upon failure."
@@ -957,7 +957,7 @@ listed in OS. The C library expects to find it under
parameters of OS. When SYSTEM-KERNEL-ARGUMENTS? is true, add kernel arguments
such as '--root' and '--load' to <boot-parameters>."
(mlet* %store-monad
- ((initrd (operating-system-initrd-file os))
+ ((initrd -> (operating-system-initrd-file os))
(store -> (operating-system-store-file-system os))
(bootloader -> (bootloader-configuration-bootloader
(operating-system-bootloader os)))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index a5a111908f..a53d3cb106 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -20,8 +20,6 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system linux-initrd)
- #:use-module (guix monads)
- #:use-module (guix store)
#:use-module (guix gexp)
#:use-module (guix utils)
#:use-module ((guix store)
@@ -63,7 +61,7 @@
(gzip gzip)
(name "guile-initrd")
(system (%current-system)))
- "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
+ "Return as a file-like object a Linux initrd (a gzipped cpio archive)
containing GUILE and that evaluates EXP, a G-expression, upon booting. All
the derivations referenced by EXP are automatically copied to the initrd."
@@ -100,8 +98,9 @@ the derivations referenced by EXP are automatically copied to the initrd."
#:references-graphs '("closure")
#:gzip (string-append #$gzip "/bin/gzip")))))
- (gexp->derivation name builder
- #:references-graphs `(("closure" ,init))))
+ (computed-file name builder
+ #:options
+ `(#:references-graphs (("closure" ,init)))))
(define (flat-linux-module-directory linux modules)
"Return a flat directory containing the Linux kernel modules listed in
@@ -143,7 +142,7 @@ MODULES and taken from LINUX."
qemu-networking?
volatile-root?
(on-error 'debug))
- "Return a monadic derivation that builds a raw initrd, with kernel
+ "Return as a file-like object a raw initrd, with kernel
modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be
mounted by the initrd, possibly in addition to the root file system specified
on the kernel command line via '--root'. LINUX-MODULES is a list of kernel
@@ -294,7 +293,7 @@ FILE-SYSTEMS."
volatile-root?
(extra-modules '()) ;deprecated
(on-error 'debug))
- "Return a monadic derivation that builds a generic initrd, with kernel
+ "Return as a file-like object a generic initrd, with kernel
modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be
mounted by the initrd, possibly in addition to the root file system specified
on the kernel command line via '--root'. MAPPED-DEVICES is a list of device
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index d43b71cbaf..6064e0f899 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.
--
2.19.1
guix-patches <at> gnu.org:bug#33405; Package guix-patches.
(Fri, 16 Nov 2018 09:38:05 GMT) Full text and rfc822 format available.Message #29 received at 33405 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33405 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 09/10] guix system: De-monadify bootloader installation script. Date: Fri, 16 Nov 2018 10:36:23 +0100
* guix/scripts/system.scm (bootloader-installer-derivation): Rename
to...
(bootloader-installer-script): ... this. Use 'scheme-file' instead of
'gexp->file'.
(perform-action): Adjust accordingly. Move 'lower-object' call to the
point where DRVS is computed.
---
guix/scripts/system.scm | 65 +++++++++++++++++++++--------------------
1 file changed, 34 insertions(+), 31 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 14488107b8..6f00f12509 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -175,12 +175,16 @@ TARGET, and register them."
(return *unspecified*)))
-(define* (install-bootloader installer-drv
+(define* (install-bootloader installer
#:key
bootcfg bootcfg-file
target)
- "Call INSTALLER-DRV with error handling, in %STORE-MONAD."
- (with-monad %store-monad
+ "Run INSTALLER, a bootloader installation script, with error handling, in
+%STORE-MONAD."
+ (mlet %store-monad ((installer-drv (if installer
+ (lower-object installer)
+ (return #f)))
+ (bootcfg (lower-object bootcfg)))
(let* ((gc-root (string-append target %gc-roots-directory
"/bootcfg"))
(temp-gc-root (string-append gc-root ".new"))
@@ -790,19 +794,18 @@ checking this by themselves in their 'check' procedure."
(warning (G_ "Consider running 'guix pull' before 'reconfigure'.~%"))
(warning (G_ "Failing to do that may downgrade your system!~%"))))
-(define (bootloader-installer-derivation installer
- bootloader device target)
+(define (bootloader-installer-script installer
+ bootloader device target)
"Return a file calling INSTALLER gexp with given BOOTLOADER, DEVICE
and TARGET arguments."
- (with-monad %store-monad
- (gexp->file "bootloader-installer"
- (with-imported-modules '((gnu build bootloader)
- (guix build utils))
- #~(begin
- (use-modules (gnu build bootloader)
- (guix build utils)
- (ice-9 binary-ports))
- (#$installer #$bootloader #$device #$target))))))
+ (scheme-file "bootloader-installer"
+ (with-imported-modules '((gnu build bootloader)
+ (guix build utils))
+ #~(begin
+ (use-modules (gnu build bootloader)
+ (guix build utils)
+ (ice-9 binary-ports))
+ (#$installer #$bootloader #$device #$target)))))
(define* (perform-action action os
#:key skip-safety-checks?
@@ -851,31 +854,31 @@ static checks."
#:mappings mappings))
(bootloader -> (bootloader-configuration-bootloader
(operating-system-bootloader os)))
- (bootcfg (if (eq? 'container action)
- (return #f)
- (lower-object
- (operating-system-bootcfg
- os
- (if (eq? 'init action)
- '()
- (map boot-parameters->menu-entry
- (profile-boot-parameters)))))))
+ (bootcfg -> (and (not (eq? 'container action))
+ (operating-system-bootcfg
+ os
+ (if (eq? 'init action)
+ '()
+ (map boot-parameters->menu-entry
+ (profile-boot-parameters))))))
(bootcfg-file -> (bootloader-configuration-file bootloader))
(bootloader-installer
+ ->
(let ((installer (bootloader-installer bootloader))
(target (or target "/")))
- (bootloader-installer-derivation installer
- (bootloader-package bootloader)
- bootloader-target target)))
+ (bootloader-installer-script installer
+ (bootloader-package bootloader)
+ bootloader-target target)))
;; For 'init' and 'reconfigure', always build BOOTCFG, even if
;; --no-bootloader is passed, because we then use it as a GC root.
;; See <http://bugs.gnu.org/21068>.
- (drvs -> (if (memq action '(init reconfigure))
- (if install-bootloader?
- (list sys bootcfg bootloader-installer)
- (list sys bootcfg))
- (list sys)))
+ (drvs (mapm %store-monad lower-object
+ (if (memq action '(init reconfigure))
+ (if install-bootloader?
+ (list sys bootcfg bootloader-installer)
+ (list sys bootcfg))
+ (list sys))))
(% (if derivations-only?
(return (for-each (compose println derivation-file-name)
drvs))
--
2.19.1
guix-patches <at> gnu.org:bug#33405; Package guix-patches.
(Fri, 16 Nov 2018 09:38:07 GMT) Full text and rfc822 format available.Message #32 received at 33405 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33405 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 02/10] system: Simplify kernel argument handling. Date: Fri, 16 Nov 2018 10:36:16 +0100
* gnu/system.scm (bootable-kernel-arguments): Remove 'kernel-arguments'
parameter and return only the base list of kernel arguments. Rename
'system.drv' to 'system'.
(operating-system-kernel-arguments): Adjust accordingly and remove
'system.drv' parameter.
(read-boot-parameters-file): Adjust accordingly. Remove 'if params'
since dominating code assumed PARAMS is always true.
(operating-system-boot-parameters): Remove 'system.drv' parameter; add
#:system-kernel-arguments? instead and honor it.
(operating-system-bootcfg): Adjust accordingly.
(operating-system-boot-parameters-file): Likewise.
* gnu/system/vm.scm (system-qemu-image/shared-store-script): Remove
'os-drv' variable. Adjust call to 'operating-system-kernel-arguments'.
---
gnu/system.scm | 91 +++++++++++++++++++++++------------------------
gnu/system/vm.scm | 5 ++-
2 files changed, 47 insertions(+), 49 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index 93340cccd2..b218efc875 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -127,23 +127,21 @@
;;;
;;; Code:
-(define (bootable-kernel-arguments kernel-arguments system.drv root-device)
- "Prepend extra arguments to KERNEL-ARGUMENTS that allow SYSTEM.DRV to be
-booted from ROOT-DEVICE"
- (cons* (string-append "--root="
- (cond ((uuid? root-device)
+(define (bootable-kernel-arguments system root-device)
+ "Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE."
+ (list (string-append "--root="
+ (cond ((uuid? root-device)
- ;; Note: Always use the DCE format because that's
- ;; what (gnu build linux-boot) expects for the
- ;; '--root' kernel command-line option.
- (uuid->string (uuid-bytevector root-device)
- 'dce))
- ((file-system-label? root-device)
- (file-system-label->string root-device))
- (else root-device)))
- #~(string-append "--system=" #$system.drv)
- #~(string-append "--load=" #$system.drv "/boot")
- kernel-arguments))
+ ;; Note: Always use the DCE format because that's
+ ;; what (gnu build linux-boot) expects for the
+ ;; '--root' kernel command-line option.
+ (uuid->string (uuid-bytevector root-device)
+ 'dce))
+ ((file-system-label? root-device)
+ (file-system-label->string root-device))
+ (else root-device)))
+ #~(string-append "--system=" #$system)
+ #~(string-append "--load=" #$system "/boot")))
;; System-wide configuration.
;; TODO: Add per-field docstrings/stexi.
@@ -209,12 +207,11 @@ booted from ROOT-DEVICE"
(sudoers-file operating-system-sudoers-file ; file-like
(default %sudoers-specification)))
-(define (operating-system-kernel-arguments os system.drv root-device)
+(define (operating-system-kernel-arguments os root-device)
"Return all the kernel arguments, including the ones not specified
directly by the user."
- (bootable-kernel-arguments (operating-system-user-kernel-arguments os)
- system.drv
- root-device))
+ (append (bootable-kernel-arguments os root-device)
+ (operating-system-user-kernel-arguments os)))
;;;
@@ -328,14 +325,11 @@ format is unrecognized.
The object has its kernel-arguments extended in order to make it bootable."
(let* ((file (string-append system "/parameters"))
(params (call-with-input-file file read-boot-parameters))
- (root (boot-parameters-root-device params))
- (kernel-arguments (boot-parameters-kernel-arguments params)))
- (if params
- (boot-parameters
- (inherit params)
- (kernel-arguments (bootable-kernel-arguments kernel-arguments
- system root)))
- #f)))
+ (root (boot-parameters-root-device params)))
+ (boot-parameters
+ (inherit params)
+ (kernel-arguments (append (bootable-kernel-arguments system root)
+ (boot-parameters-kernel-arguments params))))))
(define (boot-parameters->menu-entry conf)
(menu-entry
@@ -942,10 +936,11 @@ listed in OS. The C library expects to find it under
"Return the bootloader configuration file for OS. Use OLD-ENTRIES
(which is a list of <menu-entry>) to populate the \"old entries\" menu."
(mlet* %store-monad
- ((system (operating-system-derivation os))
- (root-fs -> (operating-system-root-file-system os))
+ ((root-fs -> (operating-system-root-file-system os))
(root-device -> (file-system-device root-fs))
- (params (operating-system-boot-parameters os system root-device))
+ (params (operating-system-boot-parameters os root-device
+ #:system-kernel-arguments?
+ #t))
(entry -> (boot-parameters->menu-entry params))
(bootloader-conf -> (operating-system-bootloader os)))
(define generate-config-file
@@ -956,10 +951,11 @@ listed in OS. The C library expects to find it under
(lower-object (generate-config-file bootloader-conf (list entry)
#:old-entries old-entries))))
-(define (operating-system-boot-parameters os system.drv root-device)
- "Return a monadic <boot-parameters> record that describes the boot parameters
-of OS. SYSTEM.DRV is either a derivation or #f. If it's a derivation, adds
-kernel arguments for that derivation to <boot-parameters>."
+(define* (operating-system-boot-parameters os root-device
+ #:key system-kernel-arguments?)
+ "Return a monadic <boot-parameters> record that describes the boot
+parameters of OS. When SYSTEM-KERNEL-ARGUMENTS? is true, add kernel arguments
+such as '--root' and '--load' to <boot-parameters>."
(mlet* %store-monad
((initrd (operating-system-initrd-file os))
(store -> (operating-system-store-file-system os))
@@ -972,9 +968,9 @@ kernel arguments for that derivation to <boot-parameters>."
(root-device root-device)
(kernel (operating-system-kernel-file os))
(kernel-arguments
- (if system.drv
- (operating-system-kernel-arguments os system.drv root-device)
- (operating-system-user-kernel-arguments os)))
+ (if system-kernel-arguments?
+ (operating-system-kernel-arguments os root-device)
+ (operating-system-user-kernel-arguments os)))
(initrd initrd)
(bootloader-name bootloader-name)
(store-device (ensure-not-/dev (file-system-device store)))
@@ -990,19 +986,22 @@ kernel arguments for that derivation to <boot-parameters>."
(_
device)))
-(define* (operating-system-boot-parameters-file os #:optional (system.drv #f))
+(define* (operating-system-boot-parameters-file os
+ #:key system-kernel-arguments?)
"Return a file that describes the boot parameters of OS. The primary use of
this file is the reconstruction of GRUB menu entries for old configurations.
-SYSTEM.DRV is optional. If given, adds kernel arguments for that system to the
-returned file (since the returned file is then usually stored into the
-content-addressed \"system\" directory, it's usually not a good idea
-to give it because the content hash would change by the content hash
+
+When SYSTEM-KERNEL-ARGUMENTS? is true, add kernel arguments such as '--root'
+and '--load' to the returned file (since the returned file is then usually
+stored into the content-addressed \"system\" directory, it's usually not a
+good idea to give it because the content hash would change by the content hash
being stored into the \"parameters\" file)."
(mlet* %store-monad ((root -> (operating-system-root-file-system os))
(device -> (file-system-device root))
- (params (operating-system-boot-parameters os
- system.drv
- device)))
+ (params (operating-system-boot-parameters
+ os device
+ #:system-kernel-arguments?
+ system-kernel-arguments?)))
(gexp->file "parameters"
#~(boot-parameters
(version 0)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index a1b595d45d..d43b71cbaf 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -897,21 +897,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
--
2.19.1
guix-patches <at> gnu.org:bug#33405; Package guix-patches.
(Fri, 16 Nov 2018 09:38:07 GMT) Full text and rfc822 format available.Message #35 received at 33405 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33405 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 01/10] bootloader: De-monadify configuration file generators. Date: Fri, 16 Nov 2018 10:36:15 +0100
* gnu/bootloader/extlinux.scm: Remove unneeded imports.
(extlinux-configuration-file): Use 'computed-file' instead of
'gexp->derivation'.
* gnu/bootloader/grub.scm (svg->png): Likewise.
(grub-background-image, eye-candy): Adjust accordingly, return
non-monadically.
(grub-configuration-file): Likewise, and use 'computed-file' instead of
'gexp->derivation'.
* gnu/bootloader/u-boot.scm: Remove unneeded imports.
* gnu/system.scm: Add 'lower-object' call.
---
gnu/bootloader/extlinux.scm | 6 +--
gnu/bootloader/grub.scm | 104 +++++++++++++++++-------------------
gnu/bootloader/u-boot.scm | 5 --
gnu/system.scm | 10 ++--
4 files changed, 56 insertions(+), 69 deletions(-)
diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
index 8b7a95a6fc..b48596c496 100644
--- a/gnu/bootloader/extlinux.scm
+++ b/gnu/bootloader/extlinux.scm
@@ -19,12 +19,8 @@
(define-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
- #:use-module (gnu system)
- #:use-module (gnu build bootloader)
#:use-module (gnu packages bootloaders)
#:use-module (guix gexp)
- #:use-module (guix monads)
- #:use-module (guix records)
#:use-module (guix utils)
#:export (extlinux-bootloader
extlinux-bootloader-gpt))
@@ -78,7 +74,7 @@ TIMEOUT ~a~%"
(format port "~%"))
#~())))))
- (gexp->derivation "extlinux.conf" builder))
+ (computed-file "extlinux.conf" builder))
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 06856dd58c..161e8b3d02 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -20,26 +20,18 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader grub)
- #:use-module (guix store)
- #:use-module (guix packages)
- #:use-module (guix derivations)
#:use-module (guix records)
- #:use-module (guix monads)
+ #:use-module ((guix utils) #:select (%current-system))
#:use-module (guix gexp)
- #:use-module (guix download)
#:use-module (gnu artwork)
- #:use-module (gnu system)
#:use-module (gnu bootloader)
#:use-module (gnu system uuid)
#:use-module (gnu system file-systems)
#:autoload (gnu packages bootloaders) (grub)
- #:autoload (gnu packages compression) (gzip)
#:autoload (gnu packages gtk) (guile-cairo guile-rsvg)
- #:autoload (gnu packages guile) (guile-2.2)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
- #:use-module (rnrs bytevectors)
#:export (grub-image
grub-image?
grub-image-aspect-ratio
@@ -121,14 +113,14 @@ otherwise."
(define* (svg->png svg #:key width height)
"Build a PNG of HEIGHT x WIDTH from SVG."
- (gexp->derivation "grub-image.png"
- (with-imported-modules '((gnu build svg))
- (with-extensions (list guile-rsvg guile-cairo)
- #~(begin
- (use-modules (gnu build svg))
- (svg->png #+svg #$output
- #:width #$width
- #:height #$height))))))
+ (computed-file "grub-image.png"
+ (with-imported-modules '((gnu build svg))
+ (with-extensions (list guile-rsvg guile-cairo)
+ #~(begin
+ (use-modules (gnu build svg))
+ (svg->png #+svg #$output
+ #:width #$width
+ #:height #$height))))))
(define* (grub-background-image config #:key (width 1024) (height 768))
"Return the GRUB background image defined in CONFIG with a ratio of
@@ -138,15 +130,13 @@ WIDTH/HEIGHT, or #f if none was found."
(= (grub-image-aspect-ratio image) ratio))
(grub-theme-images
(bootloader-theme config)))))
- (if image
- (svg->png (grub-image-file image)
- #:width width #:height height)
- (with-monad %store-monad
- (return #f)))))
+ (and image
+ (svg->png (grub-image-file image)
+ #:width width #:height height))))
(define* (eye-candy config store-device store-mount-point
#:key system port)
- "Return in %STORE-MONAD a gexp that writes to PORT (a port-valued gexp) the
+ "Return a gexp that writes to PORT (a port-valued gexp) the
'grub.cfg' part concerned with graphics mode, background images, colors, and
all that. STORE-DEVICE designates the device holding the store, and
STORE-MOUNT-POINT is its mount point; these are used to determine where the
@@ -194,9 +184,11 @@ fi~%" #$font-file)
(strip-mount-point store-mount-point
(file-append grub "/share/grub/unicode.pf2")))
- (mlet* %store-monad ((image (grub-background-image config)))
- (return (and image
- #~(format #$port "
+ (define image
+ (grub-background-image config))
+
+ (and image
+ #~(format #$port "
function setup_gfxterm {~a}
# Set 'root' to the partition that contains /gnu/store.
@@ -213,14 +205,14 @@ else
set menu_color_normal=cyan/blue
set menu_color_highlight=white/blue
fi~%"
- #$setup-gfxterm-body
- #$(grub-root-search store-device font-file)
- #$(setup-gfxterm config font-file)
- #$(grub-setup-io config)
+ #$setup-gfxterm-body
+ #$(grub-root-search store-device font-file)
+ #$(setup-gfxterm config font-file)
+ #$(grub-setup-io config)
- #$(strip-mount-point store-mount-point image)
- #$(theme-colors grub-theme-color-normal)
- #$(theme-colors grub-theme-color-highlight))))))
+ #$(strip-mount-point store-mount-point image)
+ #$(theme-colors grub-theme-color-normal)
+ #$(theme-colors grub-theme-color-highlight))))
;;;
@@ -331,36 +323,36 @@ entries corresponding to old generations of the system."
#$(grub-root-search device kernel)
#$kernel (string-join (list #$@arguments))
#$initrd))))
- (mlet %store-monad ((sugar (eye-candy config
- (menu-entry-device
- (first all-entries))
- (menu-entry-device-mount-point
- (first all-entries))
- #:system system
- #:port #~port)))
- (define builder
- #~(call-with-output-file #$output
- (lambda (port)
- (format port
- "# This file was generated from your GuixSD configuration. Any changes
+ (define sugar
+ (eye-candy config
+ (menu-entry-device (first all-entries))
+ (menu-entry-device-mount-point (first all-entries))
+ #:system system
+ #:port #~port))
+
+ (define builder
+ #~(call-with-output-file #$output
+ (lambda (port)
+ (format port
+ "# This file was generated from your GuixSD configuration. Any changes
# will be lost upon reconfiguration.
")
- #$sugar
- (format port "
+ #$sugar
+ (format port "
set default=~a
set timeout=~a~%"
- #$(bootloader-configuration-default-entry config)
- #$(bootloader-configuration-timeout config))
- #$@(map menu-entry->gexp all-entries)
+ #$(bootloader-configuration-default-entry config)
+ #$(bootloader-configuration-timeout config))
+ #$@(map menu-entry->gexp all-entries)
- #$@(if (pair? old-entries)
- #~((format port "
+ #$@(if (pair? old-entries)
+ #~((format port "
submenu \"GNU system, old configurations...\" {~%")
- #$@(map menu-entry->gexp old-entries)
- (format port "}~%"))
- #~()))))
+ #$@(map menu-entry->gexp old-entries)
+ (format port "}~%"))
+ #~()))))
- (gexp->derivation "grub.cfg" builder)))
+ (computed-file "grub.cfg" builder))
diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm
index 0157fde3da..b5fab14e14 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -20,13 +20,8 @@
(define-module (gnu bootloader u-boot)
#:use-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
- #:use-module (gnu system)
- #:use-module (gnu build bootloader)
#:use-module (gnu packages bootloaders)
#:use-module (guix gexp)
- #:use-module (guix monads)
- #:use-module (guix records)
- #:use-module (guix utils)
#:export (u-boot-bootloader
u-boot-a20-olinuxino-lime-bootloader
u-boot-a20-olinuxino-lime2-bootloader
diff --git a/gnu/system.scm b/gnu/system.scm
index 99bc09873d..93340cccd2 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -948,9 +948,13 @@ listed in OS. The C library expects to find it under
(params (operating-system-boot-parameters os system root-device))
(entry -> (boot-parameters->menu-entry params))
(bootloader-conf -> (operating-system-bootloader os)))
- ((bootloader-configuration-file-generator
- (bootloader-configuration-bootloader bootloader-conf))
- bootloader-conf (list entry) #:old-entries old-entries)))
+ (define generate-config-file
+ (bootloader-configuration-file-generator
+ (bootloader-configuration-bootloader bootloader-conf)))
+
+ ;; TODO: Remove the 'lower-object' call to make it non-monadic.
+ (lower-object (generate-config-file bootloader-conf (list entry)
+ #:old-entries old-entries))))
(define (operating-system-boot-parameters os system.drv root-device)
"Return a monadic <boot-parameters> record that describes the boot parameters
--
2.19.1
guix-patches <at> gnu.org:bug#33405; Package guix-patches.
(Fri, 16 Nov 2018 13:40:02 GMT) Full text and rfc822 format available.Message #38 received at 33405 <at> debbugs.gnu.org (full text, mbox):
From: Mathieu Othacehe <m.othacehe <at> gmail.com> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 33405 <at> debbugs.gnu.org Subject: Re: [bug#33405] [PATCH 00/10] De-monadify and clean up system code Date: Fri, 16 Nov 2018 22:39:42 +0900
Hey Ludo, > Thoughts? Having struggled (a lot) with this part of Guix, I find that switching to file-like objects, instead of having to carry a monadic context everywhere is a huge improvement, thanks! The whole serie LGTM. Mathieu
guix-patches <at> gnu.org:bug#33405; Package guix-patches.
(Fri, 16 Nov 2018 16:52:02 GMT) Full text and rfc822 format available.Message #41 received at 33405 <at> debbugs.gnu.org (full text, mbox):
From: ludo <at> gnu.org (Ludovic Courtès) To: Mathieu Othacehe <m.othacehe <at> gmail.com> Cc: 33405 <at> debbugs.gnu.org Subject: Re: [bug#33405] [PATCH 00/10] De-monadify and clean up system code Date: Fri, 16 Nov 2018 17:50:49 +0100
Heya! Mathieu Othacehe <m.othacehe <at> gmail.com> skribis: > Having struggled (a lot) with this part of Guix, I find that switching > to file-like objects, instead of having to carry a monadic context > everywhere is a huge improvement, thanks! Cool. I noticed while browsing the installer that it uses the monadic API mostly, so indeed, I would recommend switching to file-like objects as much as possible—it’s easier and less intimidating. Thanks for your feedback! Ludo’.
guix-patches <at> gnu.org:bug#33405; Package guix-patches.
(Fri, 16 Nov 2018 23:33:02 GMT) Full text and rfc822 format available.Message #44 received at 33405 <at> debbugs.gnu.org (full text, mbox):
From: Danny Milosavljevic <dannym <at> scratchpost.org> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 33405 <at> debbugs.gnu.org Subject: Re: [bug#33405] [PATCH 00/10] De-monadify and clean up system code Date: Sat, 17 Nov 2018 00:32:50 +0100
[Message part 1 (text/plain, inline)]
Wow! Nice clean-up! This series LGTM!
[Message part 2 (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#33405; Package guix-patches.
(Sat, 17 Nov 2018 01:16:02 GMT) Full text and rfc822 format available.Message #47 received at 33405 <at> debbugs.gnu.org (full text, mbox):
From: Mathieu Othacehe <m.othacehe <at> gmail.com> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 33405 <at> debbugs.gnu.org Subject: Re: [bug#33405] [PATCH 00/10] De-monadify and clean up system code Date: Sat, 17 Nov 2018 10:14:59 +0900
Hey, > Cool. I noticed while browsing the installer that it uses the monadic > API mostly, so indeed, I would recommend switching to file-like objects > as much as possible—it’s easier and less intimidating. Yes reviewing your serie, I realized a single 'computed-file' could avoid me all the monadic context. Testing it right now :) Mathieu
ludo <at> gnu.org (Ludovic Courtès):Ludovic Courtès <ludo <at> gnu.org>:Message #52 received at 33405-done <at> debbugs.gnu.org (full text, mbox):
From: ludo <at> gnu.org (Ludovic Courtès) To: Mathieu Othacehe <m.othacehe <at> gmail.com>, Danny Milosavljevic <dannym <at> scratchpost.org> Cc: 33405-done <at> debbugs.gnu.org Subject: Re: [bug#33405] [PATCH 00/10] De-monadify and clean up system code Date: Sun, 18 Nov 2018 23:42:05 +0100
Hello, Thanks Danny & Mathieu for your feedback! Pushed as ab6caf4f1d94a5e8f58cbdfde15d7bef77eb25c4. Ludo’.
Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Mon, 17 Dec 2018 12:24:04 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.