04/10: gnu: linux-boot: Refactor boot-system.

[guix-commits]

apteryx pushed a commit to branch allow-booting-from-btrfs-subvolume
in repository guix.

commit 4f6e3955957beb5287e9d5a5d33b74725836e1ac
Author: Maxim Cournoyer <address@hidden>
AuthorDate: Tue Feb 11 14:00:06 2020 -0500

    gnu: linux-boot: Refactor boot-system.
    
    The --root option can now be omitted, and inferred from the root file system
    declaration instead.
    
    * gnu/build/linux-boot.scm (boot-system): Remove nested definitions for
    root-fs-type, root-fs-flags and root-fs-options, and bind those inside the
    let* instead.  Make "--root" take precendence over the device field string
    representation of the root file system.
    * doc/guix.texi (Initial RAM Disk): Document that "--root" can be left
    unspecified.
---
 doc/guix.texi            |  7 ++++---
 gnu/build/linux-boot.scm | 42 ++++++++++++++++++++----------------------
 2 files changed, 24 insertions(+), 25 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 42d7cfa..85cfabc 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -25917,9 +25917,10 @@ service activation programs and then spawns the 
GNU@tie{}Shepherd, the
 initialization system.
 
 @item --root=@var{root}
-Mount @var{root} as the root file system.  @var{root} can be a
-device name like @code{/dev/sda1}, a file system label, or a file system
-UUID.
+Mount @var{root} as the root file system.  @var{root} can be a device
+name like @code{/dev/sda1}, a file system label, or a file system UUID.
+When unspecified, the device name from the root file system of the
+operating system declaration is used.
 
 @item --system=@var{system}
 Have @file{/run/booted-system} and @file{/run/current-system} point to
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 4fb711b..28697e7 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -467,26 +467,6 @@ upon error."
   (define (root-mount-point? fs)
     (string=? (file-system-mount-point fs) "/"))
 
-  (define root-fs-type
-    (or (any (lambda (fs)
-               (and (root-mount-point? fs)
-                    (file-system-type fs)))
-             mounts)
-        "ext4"))
-
-  (define root-fs-flags
-    (mount-flags->bit-mask (or (any (lambda (fs)
-                                      (and (root-mount-point? fs)
-                                           (file-system-flags fs)))
-                                    mounts)
-                               '())))
-
-  (define root-fs-options
-    (any (lambda (fs)
-           (and (root-mount-point? fs)
-                (file-system-options fs)))
-         mounts))
-
   (display "Welcome, this is GNU's early boot Guile.\n")
   (display "Use '--repl' for an initrd REPL.\n\n")
 
@@ -495,7 +475,25 @@ upon error."
       (mount-essential-file-systems)
       (let* ((args    (linux-command-line))
              (to-load (find-long-option "--load" args))
-             (root    (find-long-option "--root" args)))
+             (root-fs (find root-mount-point? mounts))
+             (root-fs-type (or (and=> root-fs file-system-type)
+                               "ext4"))
+             (root-device (and=> root-fs file-system-device))
+             (root-device-str (and=> root-device file-system-device->string))
+             ;; --root takes precedence over the 'device' field of the root
+             ;; <file-system> record.
+             (root (or (find-long-option "--root" args)
+                       root-device-str))
+             (root-fs-flags (mount-flags->bit-mask
+                             (or (and=> root-fs file-system-flags)
+                                 '())))
+             (root-fs-options (if root-fs
+                                  (file-system-options root-fs)
+                                  '()))
+             (root-options (if (null? root-fs-options)
+                               #f
+                               (file-system-options->str
+                                root-fs-options))))
 
         (when (member "--repl" args)
           (start-repl))
@@ -541,7 +539,7 @@ upon error."
                                       root-fs-type
                                       #:volatile-root? volatile-root?
                                       #:flags root-fs-flags
-                                      #:options root-fs-options))
+                                      #:options root-options))
             (mount "none" "/root" "tmpfs"))
 
         ;; Mount the specified file systems.