Re: [PATCH 2/2] system: Add btrfs file system support.

[Marius Bakke <mbakke@fastmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 873 bytes --]

David Craven <david@craven.ch> writes:

> * gnu/system/linux-initrd.scm (linux-modules, helper-packages): Add
>   btrfs modules when a btrfs file-system is used.
> * gnu/build/file-systems.scm (check-file-system-irrecoverable-error,
>   check-file-system-ext): New variables.
>   (check-file-system): Support non ext file systems gracefully.

Hi! I submitted a similar patch for fat32 support a while back and Ludo
suggested refactoring the <file-system> object to contain a
'check-procedure'. I got stuck at some point and have been
procrastinating since..

Attached is what I have so far. The biggest problem is that some callers
of 'check-file-system' does not use a <file-system> object, but see also
5970e8e24 which shows how to convert a loose spec to a <file-system>.

I'll pick this back up, but testing and feedback welcome. Currently it
does not work at all :-)


[-- Attachment #1.2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-file-systems-Refactor-file-system-to-include-check-p.patch --]
[-- Type: text/x-patch, Size: 7193 bytes --]

From a222eb8781866e2b1dbb715f79acc91378e116c9 Mon Sep 17 00:00:00 2001
From: Marius Bakke <mbakke@fastmail.com>
Date: Tue, 8 Nov 2016 21:33:34 +0000
Subject: [PATCH] file-systems: Refactor <file-system> to include
 check-procedure.

* gnu/system/file-systems.scm (file-system-check-procedure): New
variable.  Extend file-system record to include it.  Export it.
* gnu/build/file-systems.scm (check-file-system): Use it.
(mount-file-system): Serialize spec before calling check-file-system.
* gnu/build/linux-boot.scm: Adjust check-file-system arguments.
* gnu/services/base.scm: Likewise.
* gnu/system/linux-initrd.scm (base-initrd): Remove e2fsck/static from
helper-packages.
---
 gnu/build/file-systems.scm  | 24 +++++++++++-------------
 gnu/build/linux-boot.scm    |  2 +-
 gnu/services/base.scm       |  8 +-------
 gnu/system/file-systems.scm | 17 ++++++++++++++++-
 gnu/system/linux-initrd.scm |  7 +------
 5 files changed, 30 insertions(+), 28 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 0d55e91..e5053f5 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -410,27 +410,25 @@ the following:
     (else
      (error "unknown device title" title))))
 
-(define (check-file-system device type)
-  "Run a file system check of TYPE on DEVICE."
-  (define fsck
-    (string-append "fsck." type))
-
-  (let ((status (system* fsck "-v" "-p" "-C" "0" device)))
+(define (check-file-system file-system)
+  "Run a file system check on FILE-SYSTEM."
+  (let* ((fsck   (file-system-check-procedure file-system))
+         (status (fsck device)))
     (match (status:exit-val status)
       (0
        #t)
       (1
-       (format (current-error-port) "'~a' corrected errors on ~a; continuing~%"
-               fsck device))
+       (format (current-error-port) "'~a' corrected errors; continuing~%"
+               fsck))
       (2
-       (format (current-error-port) "'~a' corrected errors on ~a; rebooting~%"
-               fsck device)
+       (format (current-error-port) "'~a' corrected errors; rebooting~%"
+               fsck)
        (sleep 3)
        (reboot))
       (code
-       (format (current-error-port) "'~a' exited with code ~a on ~a; \
+       (format (current-error-port) "'~a' exited with code ~a; \
 spawning Bourne-like REPL~%"
-               fsck code device)
+               fsck code)
        (start-repl %bournish-language)))))
 
 (define (mount-flags->bit-mask flags)
@@ -470,7 +468,7 @@ run a file system check."
            (mount-point (string-append root "/" mount-point))
            (flags       (mount-flags->bit-mask flags)))
        (when check?
-         (check-file-system source type))
+         (check-file-system (spec->file-system spec)))
 
        ;; Create the mount point.  Most of the time this is a directory, but
        ;; in the case of a bind mount, a regular file may be needed.
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index c34a3f7..903ce14 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -277,7 +277,7 @@ UNIONFS."
         ;; have to resort to 'pidof' here.
         (mark-as-not-killable (pidof unionfs)))
       (begin
-        (check-file-system root type)
+        (check-file-system root)
         (mount root "/root" type)))
 
   ;; Make sure /root/etc/mtab is a symlink to /proc/self/mounts.
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index afbecdb..2c18e0a 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -273,13 +273,7 @@ FILE-SYSTEM."
                                #~#t)
                          #$(if check?
                                #~(begin
-                                   ;; Make sure fsck.ext2 & co. can be found.
-                                   (setenv "PATH"
-                                           (string-append
-                                            #$e2fsprogs "/sbin:"
-                                            "/run/current-system/profile/sbin:"
-                                            (getenv "PATH")))
-                                   (check-file-system device #$type))
+                                   (check-file-system file-system))
                                #~#t)
 
                          (mount device #$target #$type flags
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 4cc1221..58e7bad 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -18,8 +18,10 @@
 
 (define-module (gnu system file-systems)
   #:use-module (ice-9 match)
+  #:use-module (guix gexp)
   #:use-module (guix records)
   #:use-module (guix store)
+  #:use-module ((gnu packages linux) #:select (e2fsck/static))
   #:use-module ((gnu build file-systems)
                 #:select (string->uuid uuid->string))
   #:re-export (string->uuid
@@ -36,6 +38,7 @@
             file-system-options
             file-system-mount?
             file-system-check?
+            file-system-check-procedure
             file-system-create-mount-point?
             file-system-dependencies
 
@@ -90,6 +93,8 @@
                     (default #f))
   (check?           file-system-check?            ; Boolean
                     (default #t))
+  (check-procedure  file-system-check-procedure   ; Gexp or #f
+                    (default #f))
   (create-mount-point? file-system-create-mount-point? ; Boolean
                        (default #f))
   (dependencies     file-system-dependencies      ; list of <file-system>
@@ -105,7 +110,7 @@ file system."
   "Return a list corresponding to file-system FS that can be passed to the
 initrd code."
   (match fs
-    (($ <file-system> device title mount-point type flags options _ _ check?)
+    (($ <file-system> device title mount-point type flags options _ _ check? _)
      (list device title mount-point type flags options check?))))
 
 (define (spec->file-system sexp)
@@ -135,6 +140,16 @@ TARGET in the other system."
          (target spec)
          (writable? writable?)))))
 
+(define (file-system-check-procedure fs)
+  "Return an fsck command corresponding to file-system FS."
+  (let ((type   (file-system-type fs))
+        (device (file-system-device fs)))
+    (cond
+     ((string-prefix? "ext" type)
+      #~(system* #$(file-append e2fsck/static "/sbin/fsck." type)
+                 "-v" "-p" "-C" "0" device))
+     (else #~(system* (string-append "fsck." type) device)))))
+
 (define-syntax uuid
   (lambda (s)
     "Return the bytevector corresponding to the given UUID representation."
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 174239a..d4b8e45 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -200,12 +200,7 @@ loaded at boot time in the order in which they appear."
 
   (define helper-packages
     ;; Packages to be copied on the initrd.
-    `(,@(if (find (lambda (fs)
-                    (string-prefix? "ext" (file-system-type fs)))
-                  file-systems)
-            (list e2fsck/static)
-            '())
-      ,@(if volatile-root?
+    `(,@(if volatile-root?
             (list unionfs-fuse/static)
             '())))
 
-- 
2.10.2