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.
This commit is contained in:
David Craven 2017-01-07 21:09:15 +01:00
parent 313880c73a
commit 26905ec8a6
No known key found for this signature in database
GPG key ID: C5E051C79C0BECDB

View file

@ -135,6 +135,14 @@ (define (ext2-superblock-volume-name sblock)
#f if SBLOCK has no volume name." #f if SBLOCK has no volume name."
(null-terminated-latin1->string (sub-bytevector sblock 120 16))) (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) (define (check-file-system device type)
"Run a file system check of TYPE on DEVICE." "Run a file system check of TYPE on DEVICE."
(define fsck (define check-procedure
(string-append "fsck." type)) (cond
((string-prefix? "ext" type) check-ext2-file-system)
(else #f)))
(let ((status (system* fsck "-v" "-p" "-C" "0" device))) (if check-procedure
(match (status:exit-val status) (match (check-procedure device)
(0 ('pass
#t) #t)
(1 ('errors-corrected
(format (current-error-port) "'~a' corrected errors on ~a; continuing~%" (format (current-error-port)
fsck device)) "File system check corrected errors on ~a; continuing~%"
(2 device))
(format (current-error-port) "'~a' corrected errors on ~a; rebooting~%" ('reboot-required
fsck device) (format (current-error-port)
(sleep 3) "File system check corrected errors on ~a; rebooting~%"
(reboot)) device)
(code (sleep 3)
(format (current-error-port) "'~a' exited with code ~a on ~a; \ (reboot))
spawning Bourne-like REPL~%" ('fatal-error
fsck code device) (format (current-error-port)
(start-repl %bournish-language))))) "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) (define (mount-flags->bit-mask flags)
"Return the number suitable for the 'flags' argument of 'mount' that "Return the number suitable for the 'flags' argument of 'mount' that