GNU bug report logs -
#73927
[PATCH 00/16] Installer support for (cross) installing the Hurd.
Previous Next
Full log
View this message in rfc822 format
This supports using another than the default DISK0 PART1 and using LABEL or
UUID as root file-system specifier. It still defaults to DISK0 PART1 if
the file-system cannot be found, i.e., lives only at the build side: A
virtual machine/childhurd build.
* gnu/bootloader/grub.scm (%device-spec-regexp): New variable.
(string->device-spec, device-spec->hurd-device): Use it in new procedures.
(device->hurd-device): New procedure.
(make-grub-configuration): Use them to remove hardcoded partition
number (root-index 1).
Change-Id: I49fa93dacc09883dfb4d695402c5eac2e0e17286
---
gnu/bootloader/grub.scm | 42 +++++++++++++++++++++++++++++++++++------
1 file changed, 36 insertions(+), 6 deletions(-)
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 2723eda5f4..c929af691b 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -3,7 +3,7 @@
;;; Copyright © 2016 Chris Marusich <cmmarusich <at> gmail.com>
;;; Copyright © 2017 Leo Famulari <leo <at> famulari.name>
;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe <at> gmail.com>
-;;; Copyright © 2019, 2020, 2023 Janneke Nieuwenhuizen <janneke <at> gnu.org>
+;;; Copyright © 2019, 2020, 2023, 2024 Janneke Nieuwenhuizen <janneke <at> gnu.org>
;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835 <at> gmail.com>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
;;; Copyright © 2020 Stefan <stefan-guix <at> vodafonemail.de>
@@ -34,6 +34,7 @@ (define-module (gnu bootloader grub)
#:use-module (guix gexp)
#:use-module (gnu artwork)
#:use-module (gnu bootloader)
+ #:use-module (gnu build file-systems)
#:use-module (gnu system uuid)
#:use-module (gnu system file-systems)
#:use-module (gnu system keyboard)
@@ -45,6 +46,7 @@ (define-module (gnu bootloader grub)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
+ #:use-module (srfi srfi-26)
#:export (grub-theme
grub-theme?
grub-theme-image
@@ -355,6 +357,34 @@ (define (grub-root-search device file)
((or #f (? string?))
#~(format #f "search --file --set ~a" #$file)))))
+(define %device-spec-regexp "/dev/[hsvw]d([abcd])([0-9]*)")
+(define (string->device-spec str)
+ "Return device spec STR as /dev/XdYZ, also catering for uuid or label."
+ (cond ((string-match %device-spec-regexp str)
+ str)
+ ((string->uuid str)
+ =>
+ find-partition-by-uuid)
+ (else
+ (find-partition-by-label str))))
+
+(define* (device-spec->hurd-device device-spec #:key (disk "w"))
+ "Return DEVICE-SPEC as a Hurd device spec:
+ part:PART-NUMBER:device:DISKdDISK-INDEX
+Default to part:1:device:DISKd0 if partition cannot be found."
+ (let* ((m (and=> device-spec (cute string-match %device-spec-regexp <>)))
+ (disk-char (and m (and=> (match:substring m 1) (compose car string->list))))
+ (disk-index (or (and disk-char (- (char->integer disk-char) (char->integer #\a)))
+ 0))
+ (partition-number (or (and m (and=> (match:substring m 2) string->number))
+ 1)))
+ (format #f "part:~a:device:~ad~a" partition-number disk disk-index)))
+
+(define* (device->hurd-device device #:key (disk "w"))
+ "Return DEVICE as a Hurd device spec: part:PART-NUMBER:device:DISKdDISK-INDEX."
+ (let ((device-spec (canonicalize-device-spec device)))
+ (device-spec->hurd-device device-spec #:disk disk)))
+
(define* (make-grub-configuration grub config entries
#:key
(locale #f)
@@ -413,16 +443,16 @@ (define (menu-entry->gexp entry)
;; IDE driver ("hdX") and those understood by rumpdisk ("wdX"
;; in the "noide" case).
(disk (if (member "noide" arguments) "w" "h"))
- (modules (menu-entry-multiboot-modules entry))
- (root-index 1)) ; XXX EFI will need root-index 2
+ (device-string (file-system-device->string device))
+ (device-spec (and=> device-string string->device-spec))
+ (modules (menu-entry-multiboot-modules entry)))
#~(format port "
menuentry ~s {
- multiboot ~a root=part:~a:device:~ad0~a~a
+ multiboot ~a root=~a~a~a
}~%"
#$label
#$kernel
- #$root-index
- #$disk
+ #$(device-spec->hurd-device device-spec #:disk disk)
(string-join (list #$@arguments) " " 'prefix)
(string-join (map string-join '#$modules)
"\n module " 'prefix))))
--
2.46.0
This bug report was last modified 250 days ago.
Previous Next
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.