system: Really filter out Linux device names for the store.

This is a followup to db4e8fd5d4.
Fixes <https://bugs.gnu.org/28445>.
Reported by Mark H Weaver <mhw@netris.org>.

* gnu/system.scm (ensure-not-/dev): New procedure.
(read-boot-parameters)[ensure-not-/dev]: Remove.
(operating-system-boot-parameters): Use it.
This commit is contained in:
Ludovic Courtès 2017-10-06 23:09:48 +02:00
parent 5266ff719e
commit 90d23ed9df
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 9 additions and 6 deletions

View File

@ -231,6 +231,14 @@ directly by the user."
(kernel-arguments boot-parameters-kernel-arguments) (kernel-arguments boot-parameters-kernel-arguments)
(initrd boot-parameters-initrd)) (initrd boot-parameters-initrd))
(define (ensure-not-/dev device)
"If DEVICE starts with a slash, return #f. This is meant to filter out
Linux device names such as /dev/sda, and to preserve GRUB device names and
file system labels."
(if (and (string? device) (string-prefix? "/" device))
#f
device))
(define (read-boot-parameters port) (define (read-boot-parameters port)
"Read boot parameters from PORT and return the corresponding "Read boot parameters from PORT and return the corresponding
<boot-parameters> object or #f if the format is unrecognized." <boot-parameters> object or #f if the format is unrecognized."
@ -243,11 +251,6 @@ directly by the user."
((? string? device) ((? string? device)
device))) device)))
(define (ensure-not-/dev device)
(if (and (string? device) (string-prefix? "/" device))
#f
device))
(match (read port) (match (read port)
(('boot-parameters ('version 0) (('boot-parameters ('version 0)
('label label) ('root-device root) ('label label) ('root-device root)
@ -939,7 +942,7 @@ kernel arguments for that derivation to <boot-parameters>."
(operating-system-user-kernel-arguments os))) (operating-system-user-kernel-arguments os)))
(initrd initrd) (initrd initrd)
(bootloader-name bootloader-name) (bootloader-name bootloader-name)
(store-device (fs->boot-device store)) (store-device (ensure-not-/dev (fs->boot-device store)))
(store-mount-point (file-system-mount-point store)))))) (store-mount-point (file-system-mount-point store))))))
(define (device->sexp device) (define (device->sexp device)