From mboxrd@z Thu Jan 1 00:00:00 1970 From: David Craven Subject: [PATCH 1/4] file-systems: Refactor check-file-system. Date: Sun, 8 Jan 2017 20:34:24 +0100 Message-ID: <20170108193427.6892-1-david@craven.ch> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:53112) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cQJEy-0004Ep-Js for guix-devel@gnu.org; Sun, 08 Jan 2017 14:34:54 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cQJEu-0006Aq-JM for guix-devel@gnu.org; Sun, 08 Jan 2017 14:34:52 -0500 Received: from so254-10.mailgun.net ([198.61.254.10]:10786) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cQJEu-0006A3-Dd for guix-devel@gnu.org; Sun, 08 Jan 2017 14:34:48 -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 * gnu/build/file-systems.scm (check-file-system): Use file-system type specific checker. (check-ext2-file-system): New variable. --- gnu/build/file-systems.scm | 55 +++++++++++++++++++++++++++++----------------- 1 file changed, 35 insertions(+), 20 deletions(-) diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index c121ca5f8..d753b6b79 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -135,6 +135,14 @@ if DEVICE does not contain an ext2 file system." #f if SBLOCK has no volume name." (null-terminated-latin1->string (sub-bytevector sblock 120 16))) +(define (check-ext2-file-system device) + "Return the health of an ext2 file system on DEVICE." + (match (status:exit-val + (system* "e2fsck" "-v" "-p" "-C" "0" device)) + (0 'pass) + (1 'errors-corrected) + (2 'reboot-required) + (_ 'fatal-error))) ;;; @@ -400,26 +408,33 @@ the following: (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-procedure + (cond + ((string-prefix? "ext" type) check-ext2-file-system) + (else #f))) + + (if check-procedure + (match (check-procedure device) + ('pass + #t) + ('errors-corrected + (format (current-error-port) + "File system check corrected errors on ~a; continuing~%" + device)) + ('reboot-required + (format (current-error-port) + "File system check corrected errors on ~a; rebooting~%" + device) + (sleep 3) + (reboot)) + ('fatal-error + (format (current-error-port) + "File system check on ~a failed; spawning Bourne-like REPL~%" + device) + (start-repl %bournish-language))) + (format (current-error-port) + "No file system check procedure for ~a; skipping~%" + device))) (define (mount-flags->bit-mask flags) "Return the number suitable for the 'flags' argument of 'mount' that -- 2.11.0