all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: Marius Bakke <mbakke@fastmail.com>
To: David Craven <david@craven.ch>, guix-devel@gnu.org
Subject: Re: [PATCH 2/2] system: Add btrfs file system support.
Date: Thu, 01 Dec 2016 20:18:20 +0100	[thread overview]
Message-ID: <87zikfsbk3.fsf@kirby.i-did-not-set--mail-host-address--so-tickle-me> (raw)
In-Reply-To: <20161130183635.6513-2-david@craven.ch>


[-- 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


  reply	other threads:[~2016-12-01 19:18 UTC|newest]

Thread overview: 14+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2016-11-30 18:36 [PATCH 1/2] gnu: Add btrfs-progs/static David Craven
2016-11-30 18:36 ` [PATCH 2/2] system: Add btrfs file system support David Craven
2016-12-01 19:18   ` Marius Bakke [this message]
2016-12-02 10:50     ` David Craven
2016-12-02 11:12       ` Chris Marusich
2016-12-02 16:27         ` David Craven
2016-12-03 15:21         ` Ludovic Courtès
2016-12-03 15:18       ` Ludovic Courtès
2016-12-03 15:31   ` Ludovic Courtès
2016-12-03 16:21     ` David Craven
2016-12-05 20:44       ` Ludovic Courtès
2016-12-03 15:15 ` [PATCH 1/2] gnu: Add btrfs-progs/static Ludovic Courtès
2016-12-03 21:41   ` David Craven
2016-12-05 20:51     ` Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87zikfsbk3.fsf@kirby.i-did-not-set--mail-host-address--so-tickle-me \
    --to=mbakke@fastmail.com \
    --cc=david@craven.ch \
    --cc=guix-devel@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.