>From a222eb8781866e2b1dbb715f79acc91378e116c9 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Tue, 8 Nov 2016 21:33:34 +0000 Subject: [PATCH] file-systems: Refactor 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 @@ -105,7 +110,7 @@ file system." "Return a list corresponding to file-system FS that can be passed to the initrd code." (match fs - (($ device title mount-point type flags options _ _ check?) + (($ 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