From 26905ec8a61f2e641fec1517b045da1d89a41cf6 Mon Sep 17 00:00:00 2001
From: David Craven <david@craven.ch>
Date: Sat, 7 Jan 2017 21:09:15 +0100
Subject: file-systems: Refactor check-file-system.

* 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(-)

(limited to 'gnu/build/file-systems.scm')

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index c121ca5f8b..d753b6b792 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -135,6 +135,14 @@ (define (ext2-superblock-volume-name sblock)
 #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 @@ (define (resolve find-partition spec fmt)
 
 (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
-- 
cgit v1.2.3