From a75a3d71329d3ca07a2ef18b81fc7b463f703ed7 Mon Sep 17 00:00:00 2001
From: Tobias Geerinckx-Rice <me@tobias.gr>
Date: Sun, 23 May 2021 17:02:29 +0200
Subject: linux-boot: Honour fsck.mode & fsck.repair.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* gnu/build/linux-boot.scm (boot-system): Honour ‘fsck.mode=’ and
‘fsck.repair=’ kernel command line options.
* doc/guix.texi (Initial RAM Disk): Document both.
---
 gnu/build/linux-boot.scm | 72 +++++++++++++++++++++++++++++-------------------
 1 file changed, 44 insertions(+), 28 deletions(-)

(limited to 'gnu/build')

diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index ab05d1ba5e..8f0f3eb2fc 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -541,21 +541,36 @@ (define (device-string->file-system-device device-string)
       (mount-essential-file-systems)
       (let* ((args    (linux-command-line))
              (to-load (find-long-option "--load" args))
-             (root-fs (find root-mount-point? mounts))
-             (root-fs-type (or (and=> root-fs file-system-type)
-                               "ext4"))
-             (root-fs-device (and=> root-fs file-system-device))
-             (root-fs-flags (mount-flags->bit-mask
-                             (or (and=> root-fs file-system-flags)
-                                 '())))
-             (root-options (if root-fs
-                               (file-system-options root-fs)
-                               #f))
-             ;; --root takes precedence over the 'device' field of the root
-             ;; <file-system> record.
-             (root-device (or (and=> (find-long-option "--root" args)
-                                     device-string->file-system-device)
-                              root-fs-device)))
+             ;; 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)
+                                 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"))))
+             (fsck.mode (find-long-option "fsck.mode" args)))
+
+        (define (check? fs)
+          (match fsck.mode
+            ("skip"  #f)
+            ("force" #t)
+            (_ (file-system-check? fs)))) ; assume "auto"
+
+        (define (skip-check-if-clean? fs)
+          (match fsck.mode
+            ("force" #f)
+            (_ (file-system-skip-check-if-clean? fs))))
+
+        (define (repair fs)
+          (let ((arg (find-long-option "fsck.repair" args)))
+            (if arg
+                (match arg
+                  ("no"  #f)
+                  ("yes" #t)
+                  (_ 'preen))
+                (file-system-repair fs))))
 
         (when (member "--repl" args)
           (start-repl))
@@ -611,23 +626,24 @@ (define (device-string->file-system-device device-string)
 
         (if root-device
             (mount-root-file-system (canonicalize-device-spec root-device)
-                                    root-fs-type
+                                    (file-system-type root-fs)
                                     #:volatile-root? volatile-root?
-                                    #:flags root-fs-flags
-                                    #:options root-options
-                                    #:check? (if root-fs
-                                                 (file-system-check? root-fs)
-                                                 #t)
+                                    #:flags (mount-flags->bit-mask
+                                             (file-system-flags root-fs))
+                                    #:options (file-system-options root-fs)
+                                    #:check? (check? root-fs)
                                     #:skip-check-if-clean?
-                                    (and=> root-fs
-                                           file-system-skip-check-if-clean?)
-                                    #:repair (if root-fs
-                                                 (file-system-repair root-fs)
-                                                 'preen))
+                                    (skip-check-if-clean? root-fs)
+                                    #:repair (repair root-fs))
             (mount "none" "/root" "tmpfs"))
 
-        ;; Mount the specified file systems.
-        (for-each mount-file-system
+        ;; Mount the specified non-root file systems.
+        (for-each (lambda (fs)
+                    (mount-file-system fs
+                                       #:check? (check? fs)
+                                       #:skip-check-if-clean?
+                                       (skip-check-if-clean? fs)
+                                       #:repair (repair fs)))
                   (remove root-mount-point? mounts))
 
         (setenv "EXT2FS_NO_MTAB_OK" #f)
-- 
cgit v1.2.3