From mboxrd@z Thu Jan 1 00:00:00 1970 From: David Craven Subject: [PATCH] file-systems: Refactor to include check-procedure. Date: Sat, 3 Dec 2016 13:34:55 +0100 Message-ID: <20161203123455.15697-1-david@craven.ch> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:39913) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cD9YD-0004d9-5o for guix-devel@gnu.org; Sat, 03 Dec 2016 07:36:31 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cD9X4-0003Pz-Ed for guix-devel@gnu.org; Sat, 03 Dec 2016 07:36:21 -0500 Received: from so254-10.mailgun.net ([198.61.254.10]:30988) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cD9X4-0003PW-6l for guix-devel@gnu.org; Sat, 03 Dec 2016 07:35:10 -0500 List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org From: Marius Bakke * 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. Co-authored-by: David Craven --- gnu/build/file-systems.scm | 52 +++++++++++++++++++++++---------------------- gnu/build/linux-boot.scm | 13 +++++++++--- gnu/system/file-systems.scm | 24 ++++++++++++++++++--- gnu/system/linux-initrd.scm | 7 +----- 4 files changed, 59 insertions(+), 37 deletions(-) diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index 431b287..c853352 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -410,28 +410,31 @@ 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))) - (match (status:exit-val status) - (0 - #t) - (1 - (format (current-error-port) "'~a' corrected errors on ~a; continuing~%" - fsck device)) - (2 - (format (current-error-port) "'~a' corrected errors on ~a; rebooting~%" - fsck device) - (sleep 3) - (reboot)) - (code - (format (current-error-port) "'~a' exited with code ~a on ~a; \ -spawning Bourne-like REPL~%" - fsck code device) - (start-repl %bournish-language))))) +(define (check-file-system check-procedure device) + "Run a file system check on DEVICE with CHECK-PROCEDURE. When CHECK-PROCEDURE +is #f skip file system check." + (if check-procedure + (match (status:exit-val (check-procedure device)) + (0 + #t) + (1 + (format (current-error-port) + "fsck corrected errors on ~a; continuing~%" + device)) + (2 + (format (current-error-port) + "fsck corrected errors on ~a; rebooting~%" + device) + (sleep 3) + (reboot)) + (code + (format (current-error-port) + "fsck exited with code ~a on ~a; spawning Bourne-like REPL~%" + code device) + (start-repl %bournish-language))) + (format (current-error-port) + "'~a' doesn't have a file system check procedure; skipping~%" + device))) (define (mount-flags->bit-mask flags) "Return the number suitable for the 'flags' argument of 'mount' that @@ -486,12 +489,11 @@ run a file system check." (string-append "," options) ""))))) (match spec - ((source title mount-point type (flags ...) options check?) + ((source title mount-point type (flags ...) options check) (let ((source (canonicalize-device-spec source title)) (mount-point (string-append root "/" mount-point)) (flags (mount-flags->bit-mask flags))) - (when check? - (check-file-system source type)) + (check-file-system check source) ;; 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..7d2c022 100644 --- a/gnu/build/linux-boot.scm +++ b/gnu/build/linux-boot.scm @@ -236,7 +236,7 @@ the last argument of `mknod'." (compose (cut string=? program <>) basename)))) (filter-map string->number (scandir "/proc"))))) -(define* (mount-root-file-system root type +(define* (mount-root-file-system root type check-procedure #:key volatile-root? (unionfs "unionfs")) "Mount the root file system of type TYPE at device ROOT. If VOLATILE-ROOT? is true, mount ROOT read-only and make it a union with a writable tmpfs using @@ -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 check-procedure root) (mount root "/root" type))) ;; Make sure /root/etc/mtab is a symlink to /proc/self/mounts. @@ -363,6 +363,13 @@ to it are lost." mounts) "ext4")) + (define root-fs-check-procedure + (or (any (match-lambda + ((device _ "/" _ _ _ check) check) + (_ #f)) + mounts) + #f)) + (define (lookup-module name) (string-append linux-module-directory "/" (ensure-dot-ko name))) @@ -402,7 +409,7 @@ to it are lost." (if root (mount-root-file-system (canonicalize-device-spec root) - root-fs-type + root-fs-type root-fs-check-procedure #:volatile-root? volatile-root?) (mount "none" "/root" "tmpfs")) diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index b51d57f..cc2cf9a 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 @@ -92,7 +95,9 @@ (create-mount-point? file-system-create-mount-point? ; Boolean (default #f)) (dependencies file-system-dependencies ; list of - (default '()))) ; or + (default '())) ; or + (check-procedure file-system-check-procedure ; Gexp or #f + (default #f))) (define-inlinable (file-system-needed-for-boot? fs) "Return true if FS has the 'needed-for-boot?' flag set, or if it's the root @@ -104,8 +109,11 @@ 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?) - (list device title mount-point type flags options check?)))) + (($ device title mount-point type flags options mount? + needed-for-boot? check? create-mount-point? depencencies + check-procedure) + (list device title mount-point type flags options + (and check? (or check-procedure (file-system-check-procedure fs))))))) (define (specification->file-system-mapping spec writable?) "Read the SPEC and return the corresponding . SPEC is @@ -124,6 +132,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 #f)))) + (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.9.0