Package: guix-patches;
Reported by: Mathieu Othacehe <m.othacehe <at> gmail.com>
Date: Sun, 2 Apr 2017 13:51:01 UTC
Severity: important
Tags: patch
Done: Mathieu Othacehe <m.othacehe <at> gmail.com>
Bug is archived. No further changes may be made.
Message #38 received at 26339 <at> debbugs.gnu.org (full text, mbox):
From: Mathieu Othacehe <m.othacehe <at> gmail.com> To: 26339 <at> debbugs.gnu.org Cc: Mathieu Othacehe <m.othacehe <at> gmail.com> Subject: [PATCH 11/18] bootloader: Add device and type to bootloader-configuration record. Date: Sun, 2 Apr 2017 15:52:35 +0200
* gnu/system.scm (<boot-parameters>)[device, type]: New fields.
(boot-parameters-boot-device): New exported procedure.
(boot-parameters-boot-type): Ditto.
(operating-system-grub.cfg): Add new fields.
(operating-system-parameters-file): Add new fields and replace GRUB by
bootloader in doctype.
(read-boot-parameters): Ditto.
* gnu/system/bootloader.scm (extlinux-configuration-file): Adapt matching to
new fields.
---
gnu/system.scm | 29 ++++++++++++++++++++++++++++-
gnu/system/bootloader.scm | 2 +-
2 files changed, 29 insertions(+), 2 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index 6c41fe814..9775e5be8 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -105,6 +105,8 @@
boot-parameters?
boot-parameters-label
boot-parameters-root-device
+ boot-parameters-boot-device
+ boot-parameters-boot-type
boot-parameters-store-device
boot-parameters-store-mount-point
boot-parameters-kernel
@@ -736,8 +738,12 @@ populate the \"old entries\" menu."
(mlet* %store-monad
((system (operating-system-derivation os))
(root-fs -> (operating-system-root-file-system os))
+ (boot-device -> (bootloader-configuration-device
+ (operating-system-bootloader os)))
(store-fs -> (operating-system-store-file-system os))
(label -> (kernel->boot-label (operating-system-kernel os)))
+ (boot-type -> (bootloader-configuration-type
+ (operating-system-bootloader os)))
(kernel -> (operating-system-kernel-file os))
(initrd (operating-system-initrd-file os))
(root-device -> (if (eq? 'uuid (file-system-title root-fs))
@@ -746,12 +752,14 @@ populate the \"old entries\" menu."
(entries -> (list (boot-parameters
(label label)
(root-device root-device)
+ (boot-device boot-device)
;; The device where the kernel and initrd live.
(store-device (grub-device store-fs))
(store-mount-point
(file-system-mount-point store-fs))
+ (boot-type boot-type)
(kernel kernel)
(kernel-arguments
(cons* (string-append "--root=" root-device)
@@ -773,10 +781,15 @@ device in a <menu-entry>."
(define (operating-system-parameters-file os)
"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."
+this file is the reconstruction of bootloader menu entries for old
+configurations."
(mlet %store-monad ((initrd (operating-system-initrd-file os))
(root -> (operating-system-root-file-system os))
+ (boot-device -> (bootloader-configuration-device
+ (operating-system-bootloader os)))
(store -> (operating-system-store-file-system os))
+ (boot-type -> (bootloader-configuration-type
+ (operating-system-bootloader os)))
(label -> (kernel->boot-label
(operating-system-kernel os))))
(gexp->file "parameters"
@@ -788,6 +801,8 @@ this file is the reconstruction of GRUB menu entries for old configurations."
(kernel-arguments
#$(operating-system-kernel-arguments os))
(initrd #$initrd)
+ (boot-device #$boot-device)
+ (boot-type #$boot-type)
(store
(device #$(grub-device store))
(mount-point #$(file-system-mount-point store))))
@@ -809,6 +824,8 @@ this file is the reconstruction of GRUB menu entries for old configurations."
;; exactly to the device field of the <file-system> object representing the
;; OS's root file system, so it might be a device path like "/dev/sda3".
(root-device boot-parameters-root-device)
+ (boot-device boot-parameters-boot-device)
+ (boot-type boot-parameters-boot-type)
(store-device boot-parameters-store-device)
(store-mount-point boot-parameters-store-mount-point)
(kernel boot-parameters-kernel)
@@ -827,6 +844,16 @@ this file is the reconstruction of GRUB menu entries for old configurations."
(label label)
(root-device root)
+ (boot-device
+ (match (assq 'boot-device rest)
+ ((_ args) args)
+ (#f #f))) ; for compatibility reasons.
+
+ (boot-type
+ (match (assq 'boot-type rest)
+ ((_ args) args)
+ (#f 'grub))) ; for compatibility reasons.
+
;; In the past, we would store the directory name of the kernel instead
;; of the absolute file name of its image. Detect that and correct it.
(kernel (if (string=? linux (direct-store-path linux))
diff --git a/gnu/system/bootloader.scm b/gnu/system/bootloader.scm
index c2b23c380..b4774792e 100644
--- a/gnu/system/bootloader.scm
+++ b/gnu/system/bootloader.scm
@@ -104,7 +104,7 @@ corresponding to old generations of the system."
(define boot-parameters->gexp
(match-lambda
- (($ <boot-parameters> label _ _ _ kernel kernel-arguments initrd)
+ (($ <boot-parameters> label _ _ _ _ _ kernel kernel-arguments initrd)
#~(format port "LABEL ~a
MENU LABEL ~a
KERNEL ~a
--
2.12.2
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.