diff options
| -rw-r--r-- | gnu/system.scm | 3 | ||||
| -rw-r--r-- | gnu/system/grub.scm | 30 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 9 |
3 files changed, 30 insertions, 12 deletions
diff --git a/gnu/system.scm b/gnu/system.scm index bf79bf1c27..38ae8f1771 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -727,6 +727,7 @@ listed in OS. The C library expects to find it under (store-fs -> (operating-system-store-file-system os)) (label -> (kernel->grub-label (operating-system-kernel os))) (kernel -> (operating-system-kernel-file os)) + (initrd (operating-system-initrd-file os)) (root-device -> (if (eq? 'uuid (file-system-title root-fs)) (uuid->string (file-system-device root-fs)) (file-system-device root-fs))) @@ -739,7 +740,7 @@ listed in OS. The C library expects to find it under #~(string-append "--load=" #$system "/boot") (operating-system-kernel-arguments os))) - (initrd (file-append system "/initrd")))))) + (initrd initrd))))) (grub-configuration-file (operating-system-bootloader os) store-fs entries #:old-entries old-entries))) 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 diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 953c6243ed..a2cd97ac1f 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -383,7 +383,8 @@ it atomically, and then run OS's activation script." (uuid->string root) root)) (kernel (boot-parameters-kernel params)) - (kernel-arguments (boot-parameters-kernel-arguments params))) + (kernel-arguments (boot-parameters-kernel-arguments params)) + (initrd (boot-parameters-initrd params))) (menu-entry (label (string-append label " (#" (number->string number) ", " @@ -391,10 +392,10 @@ it atomically, and then run OS's activation script." (linux kernel) (linux-arguments (cons* (string-append "--root=" root-device) - #~(string-append "--system=" #$system) - #~(string-append "--load=" #$system "/boot") + (string-append "--system=" system) + (string-append "--load=" system "/boot") kernel-arguments)) - (initrd #~(string-append #$system "/initrd")))))) + (initrd initrd))))) (let* ((numbers (generation-numbers profile)) (systems (map (cut generation-file-name profile <>) |