me
/
guix
Archived
1
0
Fork 0
Code

bootloader: Convert device in menu-entry to proper sexp. 

Previously, menu-entry->sexp didn't try to convert `device` to a
proper sexp, which was inserted directly into the boot parameters
G-exp, leading to a G-exp input error.  Now convert both uuid and
file-system-label possibilities to sexps, and add parsing code to
sexp->menu-entry.  This fixes #57307.

* gnu/bootloader.scm (menu-entry->sexp, sexp->menu-entry): Take
non-string devices into account.

Signed-off-by: Marius Bakke <marius@gnu.org>
master
Josselin Poiret 2022-08-21 10:41:15 +02:00 committed by Marius Bakke
parent b9322d7819
commit 0811d2cb8d
No known key found for this signature in database
GPG Key ID: A2A06DF2A33A54FA
1 changed files with 21 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
gnu/bootloader.scm
View File

@ -4,6 +4,7 @@
;;; Copyright © 2017 Leo Famulari <leo@famulari.name> ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2019, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2019, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -21,6 +22,8 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader) (define-module (gnu bootloader)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:use-module (guix discovery) #:use-module (guix discovery)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix profiles) #:use-module (guix profiles)
@ -104,12 +107,19 @@
(define (menu-entry->sexp entry) (define (menu-entry->sexp entry)
"Return ENTRY serialized as an sexp." "Return ENTRY serialized as an sexp."
(define (device->sexp device)
(match device
((? uuid? uuid)
`(uuid ,(uuid-type uuid) ,(uuid->string uuid)))
((? file-system-label? label)
`(label ,(file-system-label->string label)))
(_ device)))
(match entry (match entry
(($ <menu-entry> label device mount-point linux linux-arguments initrd #f (($ <menu-entry> label device mount-point linux linux-arguments initrd #f
()) ())
`(menu-entry (version 0) `(menu-entry (version 0)
(label ,label) (label ,label)
(device ,device) (device ,(device->sexp device))
(device-mount-point ,mount-point) (device-mount-point ,mount-point)
(linux ,linux) (linux ,linux)
(linux-arguments ,linux-arguments) (linux-arguments ,linux-arguments)
@ -118,7 +128,7 @@
multiboot-kernel multiboot-arguments multiboot-modules) multiboot-kernel multiboot-arguments multiboot-modules)
`(menu-entry (version 0) `(menu-entry (version 0)
(label ,label) (label ,label)
(device ,device) (device ,(device->sexp device))
(device-mount-point ,mount-point) (device-mount-point ,mount-point)
(multiboot-kernel ,multiboot-kernel) (multiboot-kernel ,multiboot-kernel)
(multiboot-arguments ,multiboot-arguments) (multiboot-arguments ,multiboot-arguments)
@ -127,6 +137,13 @@
(define (sexp->menu-entry sexp) (define (sexp->menu-entry sexp)
"Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry> "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
record." record."
(define (sexp->device device-sexp)
(match device-sexp
(('uuid type uuid-string)
(uuid uuid-string type))
(('label label)
(file-system-label label))
(_ device-sexp)))
(match sexp (match sexp
(('menu-entry ('version 0) (('menu-entry ('version 0)
('label label) ('device device) ('label label) ('device device)
@ -135,7 +152,7 @@ record."
('initrd initrd) _ ...) ('initrd initrd) _ ...)
(menu-entry (menu-entry
(label label) (label label)
(device device) (device (sexp->device device))
(device-mount-point mount-point) (device-mount-point mount-point)
(linux linux) (linux linux)
(linux-arguments linux-arguments) (linux-arguments linux-arguments)
@ -148,7 +165,7 @@ record."
('multiboot-modules multiboot-modules) _ ...) ('multiboot-modules multiboot-modules) _ ...)
(menu-entry (menu-entry
(label label) (label label)
(device device) (device (sexp->device device))
(device-mount-point mount-point) (device-mount-point mount-point)
(multiboot-kernel multiboot-kernel) (multiboot-kernel multiboot-kernel)
(multiboot-arguments multiboot-arguments) (multiboot-arguments multiboot-arguments)