David Craven <da...@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 :-)
signature.asc
Description: PGP signature
>From a222eb8781866e2b1dbb715f79acc91378e116c9 Mon Sep 17 00:00:00 2001
From: Marius Bakke <mba...@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
