From mboxrd@z Thu Jan 1 00:00:00 1970 From: cmmarusich@gmail.com Subject: [PATCH 03/10] Refactor grub.cfg generation logic Date: Fri, 28 Oct 2016 03:07:20 -0700 Message-ID: <20161028100727.1182-4-cmmarusich@gmail.com> References: <20161028100727.1182-1-cmmarusich@gmail.com> Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:56768) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1c044l-0004Rk-68 for guix-devel@gnu.org; Fri, 28 Oct 2016 06:07:56 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1c044j-0003yf-C2 for guix-devel@gnu.org; Fri, 28 Oct 2016 06:07:51 -0400 Received: from mail-pf0-x244.google.com ([2607:f8b0:400e:c00::244]:33564) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1c044i-0003y6-Tr for guix-devel@gnu.org; Fri, 28 Oct 2016 06:07:49 -0400 Received: by mail-pf0-x244.google.com with SMTP id i85so872195pfa.0 for ; Fri, 28 Oct 2016 03:07:48 -0700 (PDT) In-Reply-To: <20161028100727.1182-1-cmmarusich@gmail.com> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org From: Chris Marusich This enables the implementation of 'guix system switch-generation' and 'guix system roll-back'. Those new commands will only be able to determine the store device and mount point for a given system generation by reading them from that generation's boot parameters file, which does not contain a object. This change makes it possible for those commands regenerate grub.cfg using that information. * gnu/system.scm (operating-system-grub.cfg): Instead of passing store-fs directly as a parameter to grub-configuration-file, pass in its mount point and (basically) its device. * gnu/system/grub.scm (strip-mount-point, eye-candy, grub-root-search, grub-configuration-file, previous-grub-entries): Refactor these procedures to take a mount point and/or (basically) a device as parameters instead of a full-fledged object. --- gnu/system.scm | 10 ++++- gnu/system/grub.scm | 98 ++++++++++++++++++++++++++----------------------- guix/scripts/system.scm | 3 +- 3 files changed, 63 insertions(+), 48 deletions(-) diff --git a/gnu/system.scm b/gnu/system.scm index f9f63a0..0d8c25a 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -728,6 +728,10 @@ listed in OS. The C library expects to find it under ((system (operating-system-derivation os)) (root-fs -> (operating-system-root-file-system os)) (store-fs -> (operating-system-store-file-system os)) + (grub-root-search-device -> (case (file-system-title store-fs) + ((uuid) (file-system-device store-fs)) + ((label) (file-system-device store-fs)) + (else #f))) (label -> (kernel->grub-label (operating-system-kernel os))) (kernel -> (operating-system-kernel-file os)) (initrd (operating-system-initrd-file os)) @@ -736,7 +740,7 @@ listed in OS. The C library expects to find it under (file-system-device root-fs))) (entries -> (list (menu-entry (label label) - (device #f) ;; stub value, not used yet + (device grub-root-search-device) (linux kernel) (linux-arguments (cons* (string-append "--root=" root-device) @@ -746,7 +750,9 @@ listed in OS. The C library expects to find it under (operating-system-kernel-arguments os))) (initrd initrd))))) (grub-configuration-file (operating-system-bootloader os) - store-fs entries + (file-system-mount-point store-fs) + grub-root-search-device + entries #:old-entries old-entries))) (define (operating-system-parameters-file os) diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index 859f33a..d45fdca 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -62,16 +62,15 @@ ;;; ;;; Code: -(define (strip-mount-point fs file) - "Strip the mount point of FS from FILE, which is a gexp or other lowerable +(define (strip-mount-point mount-point file) + "Strip MOUNT-POINT 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))))) + (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 make-grub-image @@ -164,12 +163,15 @@ WIDTH/HEIGHT, or #f if none was found." (with-monad %store-monad (return #f))))) -(define (eye-candy config root-fs system port) - "Return in %STORE-MONAD a gexp that writes to PORT (a port-valued gexp) the -'grub.cfg' part concerned with graphics mode, background images, colors, and -all that. ROOT-FS is a file-system object denoting the root file system where -the store is. SYSTEM must be the target system string---e.g., -\"x86_64-linux\"." +(define (eye-candy config store-fs-mount-point store-device system port) + "Return a gexp that writes to PORT (a port-valued gexp) the 'grub.cfg' part +concerned with graphics mode, background images, colors, and all that. +STORE-FS-MOUNT-POINT is the mount point of the file system containing the +store. STORE-DEVICE is a file system UUID, a file system label, or #f. The +value of STORE-DEVICE determines the GRUB search command that will be used to +find and set the GRUB root; for details, please refer to the +'grub-root-search' procedure's docstring. SYSTEM must be the target system +string---e.g., \"x86_64-linux\"." (define setup-gfxterm-body ;; Intel systems need to be switched into graphics mode, whereas most ;; other modern architectures have no other mode and therefore don't need @@ -193,7 +195,7 @@ the store is. SYSTEM must be the target system string---e.g., (symbol->string (assoc-ref colors 'bg))))) (define font-file - (strip-mount-point root-fs + (strip-mount-point store-fs-mount-point (file-append grub "/share/grub/unicode.pf2"))) (mlet* %store-monad ((image (grub-background-image config))) @@ -201,7 +203,7 @@ the store is. SYSTEM must be the target system string---e.g., #~(format #$port " function setup_gfxterm {~a} -# Set 'root' to the partition that contains /gnu/store. +# Set GRUB's 'root' to the device that contains the store. ~a if loadfont ~a; then @@ -217,10 +219,10 @@ else set menu_color_highlight=white/blue fi~%" #$setup-gfxterm-body - #$(grub-root-search root-fs font-file) + #$(grub-root-search store-device font-file) #$font-file - #$(strip-mount-point root-fs image) + #$(strip-mount-point store-fs-mount-point image) #$(theme-colors grub-theme-color-normal) #$(theme-colors grub-theme-color-highlight)))))) @@ -229,57 +231,63 @@ fi~%" ;;; Configuration file. ;;; -(define (grub-root-search root-fs file) - "Return the GRUB 'search' command to look for ROOT-FS, which contains FILE, -a gexp. The result is a gexp that can be inserted in the grub.cfg-generation +(define (grub-root-search device file) + "Return a GRUB 'search' command (@pxref{search,,, grub, GNU GRUB manual}) +which will find the device indicated by DEVICE and which will set GRUB's +'root' to it (@pxref{root,,, grub, GNU GRUB manual}). DEVICE may be a file +system UUID or label, in which case the search command will find the device +containing the specified file system and set the root to it, or it may be #f, +in which case the search command will find the device containing the specified +FILE. The result is a gexp that can be inserted into grub.cfg-generation code." ;; Usually FILE is a file name gexp like "/gnu/store/…-linux/vmlinuz", but ;; it can also be something like "(hd0,msdos1)/vmlinuz" in the case of ;; custom menu entries. In the latter case, don't emit a 'search' command. - (if (and (string? file) (not (string-prefix? "/" file))) - "" - (case (file-system-title root-fs) - ;; Preferably refer to ROOT-FS by its UUID or label. This is more - ;; efficient and less ambiguous, see <>. - ((uuid) - (format #f "search --fs-uuid --set ~a" - (uuid->string (file-system-device root-fs)))) - ((label) - (format #f "search --label --set ~a" - (file-system-device root-fs))) + (cond ((and (string? file) (not (string-prefix? "/" file))) + "") + ((not device) + #~(format #f "search --file --set ~a" #$file)) + ((string? device) + (format #f "search --label --set ~a" device)) (else - ;; As a last resort, look for any device containing FILE. - #~(format #f "search --file --set ~a" #$file))))) + (format #f "search --fs-uuid --set ~a" (uuid->string device))))) -(define* (grub-configuration-file config store-fs entries +(define* (grub-configuration-file config + store-fs-mount-point + store-device + entries #:key (system (%current-system)) (old-entries '())) "Return the GRUB configuration file corresponding to CONFIG, a - object, and where the store is available at STORE-FS, a - object. OLD-ENTRIES is taken to be a list of menu entries -corresponding to old generations of the system." + object. STORE-FS-MOUNT-POINT is the mount point of the +file system containing the store. STORE-DEVICE is a file system UUID, a file +system label, or #f. The value of STORE-DEVICE determines the GRUB search +command that will be used to find and set the GRUB root; for details, please +refer to the 'grub-root-search' procedure's docstring. OLD-ENTRIES is taken +to be a list of menu entries corresponding to old generations of the system." (define all-entries (append entries (grub-configuration-menu-entries config))) (define entry->gexp (match-lambda (($ label device linux arguments initrd) - ;; 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))) + ;; Use the right paths in case the file system containing the store is + ;; not mounted at "/". + (let ((linux (strip-mount-point store-fs-mount-point linux)) + (initrd (strip-mount-point store-fs-mount-point initrd))) #~(format port "menuentry ~s { ~a linux ~a ~a initrd ~a }~%" #$label - #$(grub-root-search store-fs linux) + #$(grub-root-search device linux) #$linux (string-join (list #$@arguments)) #$initrd))))) - (mlet %store-monad ((sugar (eye-candy config store-fs system #~port))) + (mlet %store-monad + ((sugar (eye-candy config store-fs-mount-point store-device system #~port))) (define builder #~(call-with-output-file #$output (lambda (port) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 8f0b8cd..4edaa0f 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -375,6 +375,7 @@ it atomically, and then run OS's activation script." read-boot-parameters)) (label (boot-parameters-label params)) (root (boot-parameters-root-device params)) + (store (boot-parameters-store-device params)) (root-device (if (bytevector? root) (uuid->string root) root)) @@ -385,7 +386,7 @@ it atomically, and then run OS's activation script." (label (string-append label " (#" (number->string number) ", " (seconds->string time) ")")) - (device #f) ; stub value, not used yet + (device store) (linux kernel) (linux-arguments (cons* (string-append "--root=" root-device) -- 2.9.2