diff options
author | Mark H Weaver <mhw@netris.org> | 2016-11-07 00:33:16 -0500 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2016-11-07 00:33:16 -0500 |
commit | 71e21fb26dceef7a665b3b1c0dec7ebd92d8ec82 (patch) | |
tree | 7553a6f9ee2ed7494968e7277897098559eacf23 /gnu/system.scm | |
parent | 19ac2ba858ebc46db96364809ebfc129be9e4ccf (diff) | |
parent | 14ac8e4865206f5cd1278cd962d01ce27890d51f (diff) | |
download | gnu-guix-71e21fb26dceef7a665b3b1c0dec7ebd92d8ec82.tar gnu-guix-71e21fb26dceef7a665b3b1c0dec7ebd92d8ec82.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu/system.scm')
-rw-r--r-- | gnu/system.scm | 22 |
1 files changed, 16 insertions, 6 deletions
diff --git a/gnu/system.scm b/gnu/system.scm index 5cb09b7880..095f7286f0 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -60,6 +60,7 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (rnrs bytevectors) #:export (operating-system operating-system? @@ -733,7 +734,7 @@ listed in OS. The C library expects to find it under (label label) ;; The device where the kernel and initrd live. - (device (file-system-device store-fs)) + (device (grub-device store-fs)) (device-mount-point (file-system-mount-point store-fs)) @@ -748,6 +749,14 @@ listed in OS. The C library expects to find it under (grub-configuration-file (operating-system-bootloader os) entries #:old-entries old-entries))) +(define (grub-device fs) + "Given FS, a <file-system> object, return a value suitable for use as the +device in a <menu-entry>." + (case (file-system-title fs) + ((uuid) (file-system-device fs)) + ((label) (file-system-device fs)) + (else #f))) + (define (operating-system-parameters-file os) "Return a file that describes the boot parameters of OS. The primary use of this file is the reconstruction of GRUB menu entries for old configurations." @@ -766,10 +775,7 @@ this file is the reconstruction of GRUB menu entries for old configurations." #$(operating-system-kernel-arguments os)) (initrd #$initrd) (store - (device #$(case (file-system-title store) - ((uuid) (file-system-device store)) - ((label) (file-system-device store)) - (else #f))) + (device #$(grub-device store)) (mount-point #$(file-system-mount-point store)))) #:set-load-path? #f))) @@ -831,7 +837,11 @@ this file is the reconstruction of GRUB menu entries for old configurations." (('store ('device device) _ ...) device) (_ ;the old format - root))) + ;; Root might be a device path like "/dev/sda1", which is not a + ;; suitable GRUB device identifier. + (if (string-prefix? "/" root) + #f + root)))) (store-mount-point (match (assq 'store rest) |