@@ -3,7 +3,7 @@
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2019, 2020, 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2019, 2020, 2023, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2020 Stefan <stefan-guix@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))))