From 4636640de8ecd9e3702bca75c9ce0649ac5d4979 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 1 Jul 2022 09:44:04 +0200
Subject: file-systems: Add 'cleanly-unmounted-ext2?'.

* gnu/build/file-systems.scm (ext2-superblock-cleanly-unmounted?)
(cleanly-unmounted-ext2?): New procedures.
---
 gnu/build/file-systems.scm | 24 ++++++++++++++++++++++++
 1 file changed, 24 insertions(+)

(limited to 'gnu/build')

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index b06a4cc25c..1d3b33e7bd 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -52,6 +52,8 @@
             read-partition-uuid
             read-luks-partition-uuid
 
+            cleanly-unmounted-ext2?
+
             bind-mount
 
             system*/tty
@@ -193,6 +195,23 @@ NUL terminator, return the size of the bytevector."
 if DEVICE does not contain an ext2 file system."
   (read-superblock device 1024 264 ext2-superblock?))
 
+(define (ext2-superblock-cleanly-unmounted? sblock)
+  "Return true if SBLOCK denotes a file system that was cleanly unmounted,
+false otherwise."
+  (define EXT2_VALID_FS 1)                        ;cleanly unmounted
+  (define EXT2_ERROR_FS 2)                        ;errors detected
+
+  (define EXT3_FEATURE_INCOMPAT_RECOVER #x0004)   ;journal needs recovery
+
+  (let ((state (bytevector-u16-ref sblock 58 %ext2-endianness)))
+    (cond ((= state EXT2_VALID_FS)
+           (let ((incompatible-features
+                  (bytevector-u32-ref sblock 96 %ext2-endianness)))
+             (zero? (logand incompatible-features
+                            EXT3_FEATURE_INCOMPAT_RECOVER))))
+          ((= state EXT2_ERROR_FS) #f)
+          (else (error "invalid ext2 superblock state" state)))))
+
 (define (ext2-superblock-uuid sblock)
   "Return the UUID of ext2 superblock SBLOCK as a 16-byte bytevector."
   (sub-bytevector sblock 104 16))
@@ -220,6 +239,11 @@ errors.  Otherwise, fix only those considered safe to repair automatically."
     (2 'reboot-required)
     (_ 'fatal-error)))
 
+(define (cleanly-unmounted-ext2? device)          ;convenience procedure
+  "Return true if DEVICE is an ext2 file system and if it was cleanly
+unmounted."
+  (ext2-superblock-cleanly-unmounted? (read-ext2-superblock device)))
+
 
 ;;;
 ;;; Linux swap.
-- 
cgit v1.2.3