Merge remote-tracking branch 'origin/master' into core-updates-frozen.

2 files changed, 295 insertions, 120 deletions

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 4eeb81cf26..d8a5ddf1e5 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -166,14 +166,23 @@ if DEVICE does not contain an ext2 file system."
   (sub-bytevector sblock 104 16))
 
 (define (ext2-superblock-volume-name sblock)
-  "Return the volume name of SBLOCK as a string of at most 16 characters, or
-#f if SBLOCK has no volume name."
+  "Return the volume name of ext2 superblock SBLOCK as a string of at most 16
+characters, or #f if SBLOCK has no volume name."
   (null-terminated-latin1->string (sub-bytevector sblock 120 16)))
 
-(define (check-ext2-file-system device)
-  "Return the health of an ext2 file system on DEVICE."
+(define (check-ext2-file-system device force? repair)
+  "Return the health of an unmounted ext2 file system on DEVICE.  If FORCE? is
+true, check the file system even if it's marked as clean.  If REPAIR is false,
+do not write to the file system to fix errors.  If it's #t, fix all
+errors.  Otherwise, fix only those considered safe to repair automatically."
   (match (status:exit-val
-          (system* "e2fsck" "-v" "-p" "-C" "0" device))
+          (apply system* `("e2fsck" "-v" "-C" "0"
+                           ,@(if force? '("-f") '())
+                           ,@(match repair
+                               (#f '("-n"))
+                               (#t '("-y"))
+                               (_  '("-p")))
+                           ,device)))
     (0 'pass)
     (1 'errors-corrected)
     (2 'reboot-required)
@@ -256,19 +265,27 @@ bytevector."
   (sub-bytevector sblock 56 16))
 
 (define (bcachefs-superblock-volume-name sblock)
-  "Return the volume name of SBLOCK as a string of at most 32 characters, or
-#f if SBLOCK has no volume name."
+  "Return the volume name of bcachefs superblock SBLOCK as a string of at most
+32 characters, or #f if SBLOCK has no volume name."
   (null-terminated-latin1->string (sub-bytevector sblock 72 32)))
 
-(define (check-bcachefs-file-system device)
-  "Return the health of a bcachefs file system on DEVICE."
+(define (check-bcachefs-file-system device force? repair)
+  "Return the health of an unmounted bcachefs file system on DEVICE.  If FORCE?
+is true, check the file system even if it's marked as clean.  If REPAIR is
+false, do not write to the file system to fix errors.  If it's #t, fix all
+errors. Otherwise, fix only those considered safe to repair automatically."
   (let ((ignored-bits (logior 2))       ; DEVICE was mounted read-only
         (status
          ;; A number, or #f on abnormal termination (e.g., assertion failure).
          (status:exit-val
-          (apply system* "bcachefs" "fsck" "-p" "-v"
-                 ;; Make each multi-device member a separate argument.
-                 (string-split device #\:)))))
+          (apply system* `("bcachefs" "fsck" "-v"
+                           ,@(if force? '("-f") '())
+                           ,@(match repair
+                               (#f '("-n"))
+                               (#t '("-y"))
+                               (_  '("-p")))
+                           ;; Make each multi-device member a separate argument.
+                           ,@(string-split device #\:))))))
     (match (and=> status (cut logand <> (lognot ignored-bits)))
       (0 'pass)
       (1 'errors-corrected)
@@ -300,16 +317,33 @@ if DEVICE does not contain a btrfs file system."
   (sub-bytevector sblock 32 16))
 
 (define (btrfs-superblock-volume-name sblock)
-  "Return the volume name of SBLOCK as a string of at most 256 characters, or
-#f if SBLOCK has no volume name."
+  "Return the volume name of btrfs superblock SBLOCK as a string of at most 256
+characters, or #f if SBLOCK has no volume name."
   (null-terminated-latin1->string (sub-bytevector sblock 299 256)))
 
-(define (check-btrfs-file-system device)
-  "Return the health of a btrfs file system on DEVICE."
-  (match (status:exit-val
-          (system* "btrfs" "device" "scan"))
-    (0 'pass)
-    (_ 'fatal-error)))
+(define (check-btrfs-file-system device force? repair)
+  "Return the health of an unmounted btrfs file system on DEVICE.  If FORCE? is
+false, return 'PASS unconditionally as btrfs claims no need for off-line checks.
+When FORCE? is true, do perform a real check.  This is not recommended!  See
+@uref{https://bugzilla.redhat.com/show_bug.cgi?id=625967#c8}.  If REPAIR is
+false, do not write to DEVICE.  If it's #t, fix any errors found.  Otherwise,
+fix only those considered safe to repair automatically."
+  (if force?
+      (match (status:exit-val
+              (apply system* `("btrfs" "check" "--progress"
+                               ;; Btrfs's ‘--force’ is not relevant to us here.
+                               ,@(match repair
+                                   ;; Upstream considers ALL repairs dangerous
+                                   ;; and will warn the user at run time.
+                                   (#t '("--repair"))
+                                   (_  '("--readonly" ; a no-op for clarity
+                                         ;; A 466G file system with 180G used is
+                                         ;; enough to kill btrfs with 6G of RAM.
+                                         "--mode" "lowmem")))
+                               ,device)))
+        (0 'pass)
+        (_ 'fatal-error))
+      'pass))
 
 
 ;;;
@@ -333,15 +367,22 @@ if DEVICE does not contain a btrfs file system."
   (sub-bytevector sblock 67 4))
 
 (define (fat32-superblock-volume-name sblock)
-  "Return the volume name of SBLOCK as a string of at most 11 characters, or
-#f if SBLOCK has no volume name.  The volume name is a latin1 string.
-Trailing spaces are trimmed."
+  "Return the volume name of fat superblock SBLOCK as a string of at most 11
+characters, or #f if SBLOCK has no volume name.  The volume name is a latin1
+string.  Trailing spaces are trimmed."
   (string-trim-right (latin1->string (sub-bytevector sblock 71 11) (lambda (c) #f)) #\space))
 
-(define (check-fat-file-system device)
-  "Return the health of a fat file system on DEVICE."
+(define (check-fat-file-system device force? repair)
+  "Return the health of an unmounted FAT file system on DEVICE.  FORCE? is
+ignored: a full file system scan is always performed.  If REPAIR is false, do
+not write to the file system to fix errors. Otherwise, automatically fix them
+using the least destructive approach."
   (match (status:exit-val
-          (system* "fsck.vfat" "-v" "-a" device))
+          (apply system* `("fsck.vfat" "-v"
+                           ,@(match repair
+                               (#f '("-n"))
+                               (_  '("-a"))) ; no 'safe/#t distinction
+                           ,device)))
     (0 'pass)
     (1 'errors-corrected)
     (_ 'fatal-error)))
@@ -366,9 +407,9 @@ Trailing spaces are trimmed."
   (sub-bytevector sblock 39 4))
 
 (define (fat16-superblock-volume-name sblock)
-  "Return the volume name of SBLOCK as a string of at most 11 characters, or
-#f if SBLOCK has no volume name.  The volume name is a latin1 string.
-Trailing spaces are trimmed."
+  "Return the volume name of fat superblock SBLOCK as a string of at most 11
+characters, or #f if SBLOCK has no volume name.  The volume name is a latin1
+string.  Trailing spaces are trimmed."
   (string-trim-right (latin1->string (sub-bytevector sblock 43 11)
                                      (lambda (c) #f))
                      #\space))
@@ -427,8 +468,8 @@ SBLOCK as a bytevector.  If that's not set, returns the creation time."
     (sub-bytevector time 0 16))) ; strips GMT offset.
 
 (define (iso9660-superblock-volume-name sblock)
-  "Return the volume name of SBLOCK as a string.  The volume name is an ASCII
-string.  Trailing spaces are trimmed."
+  "Return the volume name of iso9660 superblock SBLOCK as a string.  The volume
+name is an ASCII string.  Trailing spaces are trimmed."
   ;; Note: Valid characters are of the set "[0-9][A-Z]_" (ECMA-119 Appendix A)
   (string-trim-right (latin1->string (sub-bytevector sblock 40 32)
                                      (lambda (c) #f)) #\space))
@@ -459,14 +500,32 @@ if DEVICE does not contain a JFS file system."
   (sub-bytevector sblock 136 16))
 
 (define (jfs-superblock-volume-name sblock)
-  "Return the volume name of SBLOCK as a string of at most 16 characters, or
-#f if SBLOCK has no volume name."
+  "Return the volume name of JFS superblock SBLOCK as a string of at most 16
+characters, or #f if SBLOCK has no volume name."
   (null-terminated-latin1->string (sub-bytevector sblock 152 16)))
 
-(define (check-jfs-file-system device)
-  "Return the health of a JFS file system on DEVICE."
+(define (check-jfs-file-system device force? repair)
+  "Return the health of an unmounted JFS file system on DEVICE.  If FORCE? is
+true, check the file system even if it's marked as clean.  If REPAIR is false,
+do not write to the file system to fix errors, and replay the transaction log
+only if FORCE?  is true. Otherwise, replay the transaction log before checking
+and automatically fix found errors."
   (match (status:exit-val
-          (system* "jfs_fsck" "-p" "-v" device))
+          (apply system*
+                 `("jfs_fsck" "-v"
+                   ;; The ‘LEVEL’ logic is convoluted.  To quote fsck/xchkdsk.c
+                   ;; (‘-p’, ‘-a’, and ‘-r’ are aliases in every way):
+                   ;; “If -f was chosen, have it override [-p] by [forcing] a
+                   ;;  check regardless of the outcome after the log is
+                   ;;  replayed”.
+                   ;; “If -n is specified by itself, don't replay the journal.
+                   ;;  If -n is specified with [-p], replay the journal but
+                   ;;  don't make any other changes”.
+                   ,@(if force? '("-f") '())
+                   ,@(match repair
+                       (#f '("-n"))
+                       (_  '("-p"))) ; no 'safe/#t distinction
+                   ,device)))
     (0 'pass)
     (1 'errors-corrected)
     (2 'reboot-required)
@@ -511,18 +570,28 @@ if DEVICE does not contain an F2FS file system."
                   16))
 
 (define (f2fs-superblock-volume-name sblock)
-  "Return the volume name of SBLOCK as a string of at most 512 characters, or
-#f if SBLOCK has no volume name."
+  "Return the volume name of F2FS superblock SBLOCK as a string of at most 512
+characters, or #f if SBLOCK has no volume name."
   (null-terminated-utf16->string
    (sub-bytevector sblock (- (+ #x470 12) #x400) 512)
    %f2fs-endianness))
 
-(define (check-f2fs-file-system device)
-  "Return the health of a F2FS file system on DEVICE."
+(define (check-f2fs-file-system device force? repair)
+  "Return the health of an unmuounted F2FS file system on DEVICE.  If FORCE? is
+true, check the file system even if it's marked as clean.  If either FORCE? or
+REPAIR are true, automatically fix found errors."
+  ;; There's no ‘-n’ equivalent (‘--dry-run’ does not disable writes).
+  ;; ’-y’ is an alias of ‘-f’.  The man page is bad: read main.c.
+  (when (and force? (not repair))
+    (format (current-error-port)
+            "warning: forced check of F2FS ~a implies repairing any errors~%"
+            device))
   (match (status:exit-val
-          (system* "fsck.f2fs" "-p" device))
-    ;; 0 and -1 are the only two possibilities
-    ;; (according to the manpage)
+          (apply system* `("fsck.f2fs"
+                           ,@(if force? '("-f") '())
+                           ,@(if repair '("-p") '("--dry-run"))
+                           ,device)))
+    ;; 0 and -1 are the only two possibilities according to the man page.
     (0 'pass)
     (_ 'fatal-error)))
 
@@ -600,14 +669,82 @@ if DEVICE does not contain a NTFS file system."
 ;; in the BOOT SECTOR like the UUID, but in the MASTER FILE TABLE, which seems
 ;; way harder to access.
 
-(define (check-ntfs-file-system device)
-  "Return the health of a NTFS file system on DEVICE."
+(define (check-ntfs-file-system device force? repair)
+  "Return the health of an unmounted NTFS file system on DEVICE.  FORCE? is
+ignored: a full check is always performed.  Repair is not possible: if REPAIR is
+true and the volume has been repaired by an external tool, clear the volume
+dirty flag to indicate that it's now safe to mount."
   (match (status:exit-val
-          (system* "ntfsfix" device))
+          (apply system* `("ntfsfix"
+                           ,@(if repair '("--clear-dirty") '("--no-action"))
+                           ,device)))
     (0 'pass)
     (_ 'fatal-error)))
 
 
+
+;;;
+;;; XFS file systems.
+;;;
+
+;; <https://git.kernel.org/pub/scm/fs/xfs/xfs-documentation.git/tree/design/XFS_Filesystem_Structure/allocation_groups.asciidoc>
+
+(define-syntax %xfs-endianness
+  ;; Endianness of XFS file systems.
+  (identifier-syntax (endianness big)))
+
+(define (xfs-superblock? sblock)
+  "Return #t when SBLOCK is an XFS superblock."
+  (bytevector=? (sub-bytevector sblock 0 4)
+                (string->utf8 "XFSB")))
+
+(define (read-xfs-superblock device)
+  "Return the raw contents of DEVICE's XFS superblock as a bytevector, or #f
+if DEVICE does not contain an XFS file system."
+  (read-superblock device 0 120 xfs-superblock?))
+
+(define (xfs-superblock-uuid sblock)
+  "Return the UUID of XFS superblock SBLOCK as a 16-byte bytevector."
+  (sub-bytevector sblock 32 16))
+
+(define (xfs-superblock-volume-name sblock)
+  "Return the volume name of XFS superblock SBLOCK as a string of at most 12
+characters, or #f if SBLOCK has no volume name."
+  (null-terminated-latin1->string (sub-bytevector sblock 108 12)))
+
+(define (check-xfs-file-system device force? repair)
+  "Return the health of an unmounted XFS file system on DEVICE.  If FORCE? is
+false, return 'PASS unconditionally as XFS claims no need for off-line checks.
+When FORCE? is true, do perform a thorough check.  If REPAIR is false, do not
+write to DEVICE.  If it's #t, replay the log, check, and fix any errors found.
+Otherwise, only replay the log, and check without attempting further repairs."
+  (define (xfs_repair)
+    (status:exit-val
+     (apply system* `("xfs_repair" "-Pv"
+                      ,@(match repair
+                          (#t '("-e"))
+                          (_  '("-n"))) ; will miss some errors
+                      ,device))))
+  (if force?
+      ;; xfs_repair fails with exit status 2 if the log is dirty, which is
+      ;; likely in situations where you're running xfs_repair.  Only the kernel
+      ;; can replay the log by {,un}mounting it cleanly.
+      (match (let ((status (xfs_repair)))
+               (if (and repair (eq? 2 status))
+                   (let ((target "/replay-XFS-log"))
+                     ;; The kernel helpfully prints a ‘Mounting…’ notice for us.
+                     (mkdir target)
+                     (mount device target "xfs")
+                     (umount target)
+                     (rmdir target)
+                     (xfs_repair))
+                   status))
+        (0 'pass)
+        (4 'errors-corrected)
+        (_ 'fatal-error))
+      'pass))
+
+
 ;;;
 ;;; Partition lookup.
 ;;;
@@ -700,7 +837,9 @@ partition field reader that returned a value."
         (partition-field-reader read-jfs-superblock
                                 jfs-superblock-volume-name)
         (partition-field-reader read-f2fs-superblock
-                                f2fs-superblock-volume-name)))
+                                f2fs-superblock-volume-name)
+        (partition-field-reader read-xfs-superblock
+                                xfs-superblock-volume-name)))
 
 (define %partition-uuid-readers
   (list (partition-field-reader read-iso9660-superblock
@@ -722,7 +861,9 @@ partition field reader that returned a value."
         (partition-field-reader read-f2fs-superblock
                                 f2fs-superblock-uuid)
         (partition-field-reader read-ntfs-superblock
-                                ntfs-superblock-uuid)))
+                                ntfs-superblock-uuid)
+        (partition-field-reader read-xfs-superblock
+                                xfs-superblock-uuid)))
 
 (define read-partition-label
   (cut read-partition-field <> %partition-label-readers))
@@ -816,8 +957,13 @@ containing ':/')."
               (uuid-bytevector spec)
               uuid->string))))
 
-(define (check-file-system device type)
-  "Run a file system check of TYPE on DEVICE."
+(define (check-file-system device type force? repair)
+  "Check an unmounted TYPE file system on DEVICE.  Do nothing but warn if it is
+mounted.  If FORCE? is true, check even when considered unnecessary.  If REPAIR
+is false, try not to write to DEVICE at all.  If it's #t, try to fix all errors
+found.  Otherwise, fix only those considered safe to repair automatically.  Not
+all TYPEs support all values or combinations of FORCE? and REPAIR.  Don't throw
+an exception in such cases but perform the nearest sane action."
   (define check-procedure
     (cond
      ((string-prefix? "ext" type) check-ext2-file-system)
@@ -828,36 +974,44 @@ containing ':/')."
      ((string-prefix? "f2fs" type) check-f2fs-file-system)
      ((string-prefix? "ntfs" type) check-ntfs-file-system)
      ((string-prefix? "nfs" type) (const 'pass))
+     ((string-prefix? "xfs" type) check-xfs-file-system)
      (else #f)))
 
   (if check-procedure
-      (match (check-procedure device)
-        ('pass
-         #t)
-        ('errors-corrected
-         (format (current-error-port)
-                 "File system check corrected errors on ~a; continuing~%"
-                 device))
-        ('reboot-required
-         (format (current-error-port)
-                 "File system check corrected errors on ~a; rebooting~%"
-                 device)
-         (sleep 3)
-         (reboot))
-        ('fatal-error
-         (format (current-error-port) "File system check on ~a failed~%"
-                 device)
-
-         ;; Spawn a REPL only if someone would be able to interact with it.
-         (when (isatty? (current-input-port))
-           (format (current-error-port) "Spawning Bourne-like REPL.~%")
-
-           ;; 'current-output-port' is typically connected to /dev/klog (in
-           ;; PID 1), but here we want to make sure we talk directly to the
-           ;; user.
-           (with-output-to-file "/dev/console"
-             (lambda ()
-               (start-repl %bournish-language))))))
+      (let ((mount (find (lambda (mount)
+                           (string=? device (mount-source mount)))
+                         (mounts))))
+        (if mount
+            (format (current-error-port)
+                    "Refusing to check ~a file system already mounted at ~a~%"
+                    device (mount-point mount))
+            (match (check-procedure device force? repair)
+              ('pass
+               #t)
+              ('errors-corrected
+               (format (current-error-port)
+                       "File system check corrected errors on ~a; continuing~%"
+                       device))
+              ('reboot-required
+               (format (current-error-port)
+                       "File system check corrected errors on ~a; rebooting~%"
+                       device)
+               (sleep 3)
+               (reboot))
+              ('fatal-error
+               (format (current-error-port) "File system check on ~a failed~%"
+                       device)
+
+               ;; Spawn a REPL only if someone might interact with it.
+               (when (isatty? (current-input-port))
+                 (format (current-error-port) "Spawning Bourne-like REPL.~%")
+
+                 ;; 'current-output-port' is typically connected to /dev/klog
+                 ;; (in PID 1), but here we want to make sure we talk directly
+                 ;; to the user.
+                 (with-output-to-file "/dev/console"
+                   (lambda ()
+                     (start-repl %bournish-language))))))))
       (format (current-error-port)
               "No file system check procedure for ~a; skipping~%"
               device)))
@@ -886,7 +1040,11 @@ corresponds to the symbols listed in FLAGS."
       (()
        0))))
 
-(define* (mount-file-system fs #:key (root "/root"))
+(define* (mount-file-system fs #:key (root "/root")
+                            (check? (file-system-check? fs))
+                            (skip-check-if-clean?
+                             (file-system-skip-check-if-clean? fs))
+                            (repair (file-system-repair fs)))
   "Mount the file system described by FS, a <file-system> object, under ROOT."
 
   (define (mount-nfs source mount-point type flags options)
@@ -924,8 +1082,8 @@ corresponds to the symbols listed in FLAGS."
                                (file-system-mount-flags (statfs source)))
                               0)))
          (options (file-system-options fs)))
-    (when (file-system-check? fs)
-      (check-file-system source type))
+    (when check?
+      (check-file-system source type (not skip-check-if-clean?) repair))
 
     (catch 'system-error
       (lambda ()
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 95d0a1fe79..8efe6e5f9c 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -25,6 +25,7 @@
   #:autoload   (system repl repl) (start-repl)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
@@ -44,7 +45,6 @@
             make-static-device-nodes
             configure-qemu-networking
 
-            device-number
             boot-system))
 
 ;;; Commentary:
@@ -134,14 +134,9 @@ succeeds.  Return nothing otherwise.  The kernel logs any details to dmesg."
            ;; is found on the command line; our canonicalize-device-spec gives
            ;; up after 20 seconds.  We could emulate the former by looping…
            (device (canonicalize-device-spec spec))
-           (rdev (stat:rdev (stat device)))
-           ;; For backwards compatibility, device numbering is a baroque affair.
-           ;; This is the full 64-bit scheme used by glibc's <sys/sysmacros.h>.
-           (major (logior (ash (logand #x00000000000fff00 rdev) -8)
-                          (ash (logand #xfffff00000000000 rdev) -32)))
-           (minor (logior      (logand #x00000000000000ff rdev)
-                          (ash (logand #x00000ffffff00000 rdev) -12))))
-      (format #f "~a:~a" major minor)))
+           (rdev (stat:rdev (stat device))))
+      (let-values (((major minor) (device-number->major+minor rdev)))
+        (format #f "~a:~a" major minor))))
 
   ;; Write the resume DEVICE to this magic file, using the MAJOR:MINOR device
   ;; numbers if possible.  The kernel will immediately try to resume from it.
@@ -392,11 +387,6 @@ networking values.)  Return #t if INTERFACE is up, #f otherwise."
 
     (logand (network-interface-flags sock interface) IFF_UP)))
 
-(define (device-number major minor)
-  "Return the device number for the device with MAJOR and MINOR, for use as
-the last argument of `mknod'."
-  (+ (* major 256) minor))
-
 (define (pidof program)
   "Return the PID of the first presumed instance of PROGRAM."
   (let ((program (basename program)))
@@ -408,12 +398,17 @@ the last argument of `mknod'."
 
 (define* (mount-root-file-system root type
                                  #:key volatile-root? (flags 0) options
-                                 check?)
+                                 check? skip-check-if-clean? repair)
   "Mount the root file system of type TYPE at device ROOT. If VOLATILE-ROOT? is
 true, mount ROOT read-only and make it an overlay with a writable tmpfs using
 the kernel built-in overlayfs. FLAGS and OPTIONS indicates the options to use
 to mount ROOT, and behave the same as for the `mount' procedure.
-If CHECK? is true, first run ROOT's fsck tool (if any) non-interactively."
+
+If CHECK? is true, first run ROOT's fsck tool (if any) non-interactively.
+If SKIP-CHECK-IF-CLEAN? is true, ask fsck to return immediately if ROOT is
+marked as clean.  If REPAIR is true, fsck may write to ROOT to perform repairs.
+If REPAIR is also 'PREEN, ask fsck to perform only those repairs that it
+considers safe."
 
   (if volatile-root?
       (begin
@@ -435,7 +430,7 @@ If CHECK? is true, first run ROOT's fsck tool (if any) non-interactively."
                "lowerdir=/real-root,upperdir=/rw-root/upper,workdir=/rw-root/work"))
       (begin
         (when check?
-          (check-file-system root type))
+          (check-file-system root type (not skip-check-if-clean?) repair))
         (mount root "/root" type flags options)))
 
   ;; Make sure /root/etc/mtab is a symlink to /proc/self/mounts.
@@ -536,21 +531,36 @@ upon error."
       (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))
@@ -606,17 +616,24 @@ upon error."
 
         (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?
+                                    (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)