summary refs log tree commit diff
path: root/gnu/build/linux-boot.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/build/linux-boot.scm')
-rw-r--r--gnu/build/linux-boot.scm85
1 files changed, 52 insertions, 33 deletions
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 8efe6e5f9c..7d41537652 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2016, 2017, 2019–2021 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2020, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -93,7 +94,7 @@
      get-string-all)))
 
 (define (find-long-option option arguments)
-  "Find OPTION among ARGUMENTS, where OPTION is something like \"--load\".
+  "Find OPTION among ARGUMENTS, where OPTION is something like \"gnu.load\".
 Return the value associated with OPTION, or #f on failure."
   (let ((opt (string-append option "=")))
     (and=> (find (cut string-prefix? opt <>)
@@ -499,10 +500,12 @@ LINUX-MODULE-DIRECTORY, then installing KEYMAP-FILE with 'loadkeys' (if
 KEYMAP-FILE is true), then setting up QEMU guest networking if
 QEMU-GUEST-NETWORKING? is true, calling PRE-MOUNT, mounting the file systems
 specified in MOUNTS, and finally booting into the new root if any.  The initrd
-supports kernel command-line options '--load', '--root', and '--repl'.
+supports the kernel command-line options 'gnu.load' and 'gnu.repl'.  It also
+honors a subset of the Linux kernel command-line parameters such as
+'fsck.mode', 'resume', 'rootdelay', rootflags and rootfstype.
 
-Mount the root file system, specified by the '--root' command-line argument,
-if any.
+Mount the root file system, specified by the 'root' command-line argument, if
+any.
 
 MOUNTS must be a list of <file-system> objects.
 
@@ -515,33 +518,50 @@ upon error."
     (string=? (file-system-mount-point fs) "/"))
 
   (define (device-string->file-system-device device-string)
-    ;; The "--root=SPEC" kernel command-line option always provides a
-    ;; string, but the string can represent a device, an nfs-root, a UUID, or a
-    ;; label.  So check for all four.
+    ;; The "root=SPEC" kernel command-line option always provides a string,
+    ;; but the string can represent a device, an nfs-root, a UUID, or a label.
+    ;; So check for all four.
     (cond ((string-prefix? "/" device-string) device-string)
           ((string-contains device-string ":/") device-string) ; nfs-root
           ((uuid device-string) => identity)
           (else (file-system-label device-string))))
 
   (display "Welcome, this is GNU's early boot Guile.\n")
-  (display "Use '--repl' for an initrd REPL.\n\n")
+  (display "Use 'gnu.repl' for an initrd REPL.\n\n")
 
   (call-with-error-handling
     (lambda ()
       (mount-essential-file-systems)
       (let* ((args    (linux-command-line))
-             (to-load (find-long-option "--load" args))
-             ;; If present, ‘--root’ on the kernel command line takes precedence
+             (to-load (find-long-option "gnu.load" args))
+             ;; If present, ‘root’ on the kernel command line takes precedence
              ;; over the ‘device’ field of the root <file-system> record.
-             (root-device (and=> (find-long-option "--root" args)
+             (root-device (and=> (find-long-option "root" args)
                                  device-string->file-system-device))
-             (root-fs (or (find root-mount-point? mounts)
-                          ;; Fall back to fictitious defaults.
-                          (file-system (device (or root-device "/dev/root"))
-                                       (mount-point "/")
-                                       (type "ext4"))))
+             (rootfstype  (find-long-option "rootfstype" args))
+             (rootflags   (find-long-option "rootflags" args))
+             (root-fs*    (find root-mount-point? mounts))
              (fsck.mode (find-long-option "fsck.mode" args)))
 
+        (unless (or root-fs* (and root-device rootfstype))
+          (error "no root file system or 'root' and 'rootfstype' parameters"))
+
+        ;; If present, ‘root’ on the kernel command line takes precedence over
+        ;; the ‘device’ field of the root <file-system> record; likewise for
+        ;; the 'rootfstype' and 'rootflags' arguments.
+        (define root-fs
+          (if root-fs*
+              (file-system
+                (inherit root-fs*)
+                (device (or root-device (file-system-device root-fs*)))
+                (type (or rootfstype (file-system-type root-fs*)))
+                (options (or rootflags (file-system-options root-fs*))))
+              (file-system
+                (device root-device)
+                (mount-point "/")
+                (type rootfstype)
+                (options rootflags))))
+
         (define (check? fs)
           (match fsck.mode
             ("skip"  #f)
@@ -562,7 +582,7 @@ upon error."
                   (_ 'preen))
                 (file-system-repair fs))))
 
-        (when (member "--repl" args)
+        (when (member "gnu.repl" args)
           (start-repl))
 
         (display "loading kernel modules...\n")
@@ -596,9 +616,8 @@ upon error."
         (let ((root-delay (and=> (find-long-option "rootdelay" args)
                                  string->number)))
           (when root-delay
-            (format #t
-                    "Pausing for rootdelay=~a seconds before mounting the root file system...\n"
-                    root-delay)
+            (format #t "Pausing for rootdelay=~a seconds before mounting \
+the root file system...\n" root-delay)
             (sleep root-delay)))
 
         ;; Prepare the real root file system under /root.
@@ -614,18 +633,18 @@ upon error."
 
         (setenv "EXT2FS_NO_MTAB_OK" "1")
 
-        (if root-device
-            (mount-root-file-system (canonicalize-device-spec root-device)
-                                    (file-system-type root-fs)
-                                    #:volatile-root? volatile-root?
-                                    #:flags (mount-flags->bit-mask
-                                             (file-system-flags root-fs))
-                                    #:options (file-system-options root-fs)
-                                    #:check? (check? root-fs)
-                                    #:skip-check-if-clean?
-                                    (skip-check-if-clean? root-fs)
-                                    #:repair (repair root-fs))
-            (mount "none" "/root" "tmpfs"))
+        ;; Mount the root file system.
+        (mount-root-file-system (canonicalize-device-spec
+                                 (file-system-device root-fs))
+                                (file-system-type root-fs)
+                                #:volatile-root? volatile-root?
+                                #:flags (mount-flags->bit-mask
+                                         (file-system-flags root-fs))
+                                #:options (file-system-options root-fs)
+                                #:check? (check? root-fs)
+                                #:skip-check-if-clean?
+                                (skip-check-if-clean? root-fs)
+                                #:repair (repair root-fs))
 
         ;; Mount the specified non-root file systems.
         (for-each (lambda (fs)
@@ -651,7 +670,7 @@ upon error."
               (sleep 2)
               (reboot))
             (begin
-              (display "no boot file passed via '--load'\n")
+              (display "no boot file passed via 'gnu.load'\n")
               (display "entering a warm and cozy REPL\n")
               (start-repl)))))
     #:on-error on-error))