@@ -51,15 +51,17 @@ (define-module (gnu bootloader)
menu-entry?
menu-entry-label
menu-entry-device
+ menu-entry-device-mount-point
+ menu-entry-device-subvol
menu-entry-linux
menu-entry-linux-arguments
menu-entry-initrd
- menu-entry-device-mount-point
menu-entry-multiboot-kernel
menu-entry-multiboot-arguments
menu-entry-multiboot-modules
menu-entry-chain-loader
+ normalize-file
menu-entry->sexp
sexp->menu-entry
@@ -126,6 +128,8 @@ (define-record-type* <menu-entry>
(default #f))
(device-mount-point menu-entry-device-mount-point
(default #f))
+ (device-subvol menu-entry-device-subvol
+ (default #f))
(linux menu-entry-linux
(default #f))
(linux-arguments menu-entry-linux-arguments
@@ -142,6 +146,18 @@ (define-record-type* <menu-entry>
(chain-loader menu-entry-chain-loader
(default #f))) ; string, path of efi file
+(define (normalize-file entry file)
+ "Normalize a file FILE stored in a menu entry into one suitable for a
+bootloader. Realizes device-mount-point and device-subvol."
+ (match-menu-entry entry (device-mount-point device-subvol)
+ ;; Avoid using cut procedure from SRFI-26 inside G-exp.
+ (let ((mount (and=> device-mount-point (cut string-trim <> #\/))))
+ #~(let* ((file (string-trim #$file #\/))
+ (file (if (and #$mount (string-prefix? #$mount file))
+ (substring file (string-length #$mount))
+ file)))
+ (string-append (or #$device-subvol "") "/" file)))))
+
(define (report-menu-entry-error menu-entry)
(raise
(condition
@@ -169,7 +185,7 @@ (define (menu-entry->sexp entry)
`(label ,(file-system-label->string label)))
(_ device)))
(match entry
- (($ <menu-entry> label device mount-point
+ (($ <menu-entry> label device mount-point subvol
(? identity linux) linux-arguments (? identity initrd)
#f () () #f)
`(menu-entry (version 0)
@@ -178,8 +194,9 @@ (define (menu-entry->sexp entry)
(device-mount-point ,mount-point)
(linux ,linux)
(linux-arguments ,linux-arguments)
- (initrd ,initrd)))
- (($ <menu-entry> label device mount-point #f () #f
+ (initrd ,initrd)
+ (device-subvol ,subvol)))
+ (($ <menu-entry> label device mount-point subvol #f () #f
(? identity multiboot-kernel) multiboot-arguments
multiboot-modules #f)
`(menu-entry (version 0)
@@ -188,19 +205,23 @@ (define (menu-entry->sexp entry)
(device-mount-point ,mount-point)
(multiboot-kernel ,multiboot-kernel)
(multiboot-arguments ,multiboot-arguments)
- (multiboot-modules ,multiboot-modules)))
- (($ <menu-entry> label device mount-point #f () #f #f () ()
+ (multiboot-modules ,multiboot-modules)
+ (device-subvol ,subvol)))
+ (($ <menu-entry> label device mount-point subvol #f () #f #f () ()
(? identity chain-loader))
`(menu-entry (version 0)
(label ,label)
(device ,(device->sexp device))
(device-mount-point ,mount-point)
- (chain-loader ,chain-loader)))
+ (chain-loader ,chain-loader)
+ (device-subvol ,subvol)))
(_ (report-menu-entry-error entry))))
(define (sexp->menu-entry sexp)
"Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
record."
+ ;; XXX: The match ORs shadow subvol.
+ (define subvol #f)
(define (sexp->device device-sexp)
(match device-sexp
(('uuid type uuid-string)
@@ -213,35 +234,41 @@ (define (sexp->menu-entry sexp)
('label label) ('device device)
('device-mount-point mount-point)
('linux linux) ('linux-arguments linux-arguments)
- ('initrd initrd) _ ...)
+ ('initrd initrd)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(linux linux)
(linux-arguments linux-arguments)
(initrd initrd)))
(('menu-entry ('version 0)
('label label) ('device device)
- ('device-mount-point mount-point)
+ ('device-mount-point mount-point) ('device-subvol subvol)
('multiboot-kernel multiboot-kernel)
('multiboot-arguments multiboot-arguments)
- ('multiboot-modules multiboot-modules) _ ...)
+ ('multiboot-modules multiboot-modules)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(multiboot-kernel multiboot-kernel)
(multiboot-arguments multiboot-arguments)
(multiboot-modules multiboot-modules)))
(('menu-entry ('version 0)
('label label) ('device device)
- ('device-mount-point mount-point)
- ('chain-loader chain-loader) _ ...)
+ ('device-mount-point mount-point) ('device-subvol subvol)
+ ('chain-loader chain-loader)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(chain-loader chain-loader)))))
@@ -328,6 +328,7 @@ (define (boot-parameters->menu-entry conf)
(label (boot-parameters-label conf))
(device (boot-parameters-store-device conf))
(device-mount-point (boot-parameters-store-mount-point conf))
+ (device-subvol (boot-parameters-store-directory-prefix conf))
(linux (and (not multiboot?) kernel))
(linux-arguments (if (not multiboot?)
(boot-parameters-kernel-arguments conf)
From: Lilah Tascheter <lilah@lunabee.space> * gnu/bootloader.scm (menu-entry-device-subvol): Add and export field. (normalize-file): Add procedure. (device->sexp): Match device-subvol and include in S-expression. (sexp->menu-entry): Try match device-subvol and include in menu-entry. * gnu/system/boot.scm (boot-parameters->menu-entry): Add device-subvol value to menu-entry. Change-Id: I3654d160f7306bb45a78b82ea6b249ff4281f739 --- gnu/bootloader.scm | 51 ++++++++++++++++++++++++++++++++++----------- gnu/system/boot.scm | 1 + 2 files changed, 40 insertions(+), 12 deletions(-)