From mboxrd@z Thu Jan 1 00:00:00 1970 From: csanchezdll@gmail.com (Carlos =?UTF-8?Q?S=C3=A1nchez?= de La Lama) Subject: bug#24346: [PATCH] Generate grub.cfg with correct paths when store is not in root partition Date: Wed, 14 Sep 2016 16:13:24 +0200 Message-ID: <7th99ilgcb.fsf@gmail.com> References: <7tlgyw11k3.fsf@kdpof.com> Mime-Version: 1.0 Content-Type: text/plain Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:60003) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bkAww-00035T-U3 for bug-guix@gnu.org; Wed, 14 Sep 2016 10:14:11 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bkAws-0007km-HM for bug-guix@gnu.org; Wed, 14 Sep 2016 10:14:06 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:33683) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bkAws-0007ki-De for bug-guix@gnu.org; Wed, 14 Sep 2016 10:14:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1bkAws-0004Oh-6G for bug-guix@gnu.org; Wed, 14 Sep 2016 10:14:02 -0400 Sender: "Debbugs-submit" Resent-Message-ID: In-Reply-To: <7tlgyw11k3.fsf@kdpof.com> ("Carlos =?UTF-8?Q?S=C3=A1nchez?= de La Lama"'s message of "Tue, 13 Sep 2016 13:23:31 +0200") List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org Sender: "bug-Guix" To: 24346@debbugs.gnu.org Rebasing to current master (76f31f0b), as new file-append made merge non-trivial. * guix/scripts/system.scm (previous-grub-entries): resolve initrd symlink for old entries (on the host). * gnu/system.scm (operating-system-grub.cfg): resolve initrd symlink for current system (on the container). * gnu/system/grub.scm: strip mount-point from GRUB filenames. --- gnu/system.scm | 2 +- gnu/system/grub.scm | 25 ++++++++++++++++++------- guix/scripts/system.scm | 6 +++--- 3 files changed, 22 insertions(+), 11 deletions(-) diff --git a/gnu/system.scm b/gnu/system.scm index 7edb018..281447f 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -738,7 +738,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 #~(readlink #$(file-append system "/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 4592747..a00f568 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -62,6 +62,14 @@ ;;; ;;; Code: +(define (strip-mount-point fs file) + (let ((mount-point (file-system-mount-point fs))) + (if (string=? mount-point "/") + file + #~(if (string-prefix? #$mount-point #$file) + (substring #$file (string-length #$mount-point)) + #$file)))) + (define-record-type* grub-image make-grub-image grub-image? @@ -183,7 +191,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 + #~(string-append #$grub "/share/grub/unicode.pf2"))) (mlet* %store-monad ((image (grub-background-image config))) (return (and image @@ -209,7 +218,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 +258,17 @@ corresponding to old generations of the system." (define entry->gexp (match-lambda (($ label linux arguments initrd) - #~(format port "menuentry ~s { + (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 953c624..5ff98a0 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -391,10 +391,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 (readlink (string-append system "/initrd"))))))) (let* ((numbers (generation-numbers profile)) (systems (map (cut generation-file-name profile <>) -- 2.9.2