summaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
authorCarlos Sánchez de La Lama <csanchezdll@gmail.com>2016-09-14 16:13:24 +0200
committerLudovic Courtès <ludo@gnu.org>2016-09-24 17:48:13 +0900
commit0f65f54ebd76324653fd5506a7dab42ee44d9255 (patch)
tree278735904428790cf55c52ae657acb4f7e5ed743 /gnu/system
parentd7b342d81556ddee9e369f78255bc76367a004ae (diff)
downloadpatches-0f65f54ebd76324653fd5506a7dab42ee44d9255.tar
patches-0f65f54ebd76324653fd5506a7dab42ee44d9255.tar.gz
system: grub.cfg uses correct file names when store is not in root partition.
Fixes <http://bugs.gnu.org/24346>. Reported by csanchezdll@gmail.com (Carlos Sánchez de La Lama). * guix/scripts/system.scm (previous-grub-entries): Get the initrd file name from PARAMS. * gnu/system.scm (operating-system-grub.cfg): Use 'operating-system-initrd-file' to retrieve the initrd file name. * gnu/system/grub.scm (strip-mount-point): New procedure. (grub-configuration-file)[entry->gexp]: Call 'strip-mount-point' for LINUX and INITRD. Co-authored-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/grub.scm30
1 files changed, 23 insertions, 7 deletions
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index 4592747083..3d294284e4 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -62,6 +62,17 @@
;;;
;;; Code:
+(define (strip-mount-point fs file)
+ "Strip the mount point of FS from FILE, which is a gexp or other lowerable
+object denoting a file name."
+ (let ((mount-point (file-system-mount-point fs)))
+ (if (string=? mount-point "/")
+ file
+ #~(let ((file #$file))
+ (if (string-prefix? #$mount-point file)
+ (substring #$file #$(string-length mount-point))
+ file)))))
+
(define-record-type* <grub-image>
grub-image make-grub-image
grub-image?
@@ -183,7 +194,8 @@ the store is. SYSTEM must be the target system string---e.g.,
(symbol->string (assoc-ref colors 'bg)))))
(define font-file
- #~(string-append #$grub "/share/grub/unicode.pf2"))
+ (strip-mount-point root-fs
+ (file-append grub "/share/grub/unicode.pf2")))
(mlet* %store-monad ((image (grub-background-image config)))
(return (and image
@@ -209,7 +221,7 @@ fi~%"
#$(grub-root-search root-fs font-file)
#$font-file
- #$image
+ #$(strip-mount-point root-fs image)
#$(theme-colors grub-theme-color-normal)
#$(theme-colors grub-theme-color-highlight))))))
@@ -249,15 +261,19 @@ corresponding to old generations of the system."
(define entry->gexp
(match-lambda
(($ <menu-entry> label linux arguments initrd)
- #~(format port "menuentry ~s {
+ ;; Use the right file names for LINUX and STORE-FS in case STORE-FS is
+ ;; not the "/" file system.
+ (let ((linux (strip-mount-point store-fs linux))
+ (initrd (strip-mount-point store-fs initrd)))
+ #~(format port "menuentry ~s {
~a
linux ~a ~a
initrd ~a
}~%"
- #$label
- #$(grub-root-search store-fs linux)
- #$linux (string-join (list #$@arguments))
- #$initrd))))
+ #$label
+ #$(grub-root-search store-fs linux)
+ #$linux (string-join (list #$@arguments))
+ #$initrd)))))
(mlet %store-monad ((sugar (eye-candy config store-fs system #~port)))
(define builder