From b0377e58c30c399f9844a1607d677e525bb1d05f Mon Sep 17 00:00:00 2001
From: David Craven <david@craven.ch>
Date: Tue, 14 Feb 2017 16:28:26 +0100
Subject: file-systems: Add FAT32 support.

* gnu/build/file-systems.scm (%fat32-endianness, fat32-superblock?,
read-fat32-superblock, fat32-superblock-uuid, fat32-uuid->string,
fat32-superblock-volume-name, check-fat32-file-system): New variables.
(%partition-label-readers, %partition-uuid-readers, check-file-system): Add
fat support.
(latin1->string): New variable.
(null-terminated-latin1->string): Use latin1->string.
---
 gnu/build/file-systems.scm | 66 +++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 59 insertions(+), 7 deletions(-)

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

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index f8ab95370c..fe98df95d5 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -106,15 +106,17 @@ (define (sub-bytevector bv start size)
     (bytevector-copy! bv start result 0 size)
     result))
 
-(define (null-terminated-latin1->string bv)
-  "Return the volume name of SBLOCK as a string of at most 256 characters, or
-#f if SBLOCK has no volume name."
-    ;; This is a Latin-1, nul-terminated string.
-    (let ((bytes (take-while (negate zero?) (bytevector->u8-list bv))))
+(define (latin1->string bv terminator)
+  "Return a string of BV, a latin1 bytevector, or #f.  TERMINATOR is a predicate
+that takes a number and returns #t when a termination character is found."
+    (let ((bytes (take-while (negate terminator) (bytevector->u8-list bv))))
       (if (null? bytes)
           #f
           (list->string (map integer->char bytes)))))
 
+(define null-terminated-latin1->string
+  (cut latin1->string <> zero?))
+
 
 ;;;
 ;;; Ext2 file systems.
@@ -192,6 +194,51 @@ (define (check-btrfs-file-system device)
     (0 'pass)
     (_ 'fatal-error)))
 
+
+;;;
+;;; FAT32 file systems.
+;;;
+
+;; <http://www.ecma-international.org/publications/files/ECMA-ST/Ecma-107.pdf>.
+
+(define-syntax %fat32-endianness
+  ;; Endianness of fat file systems.
+  (identifier-syntax (endianness little)))
+
+(define (fat32-superblock? sblock)
+  "Return #t when SBLOCK is a fat32 superblock."
+  (bytevector=? (sub-bytevector sblock 82 8)
+                (string->utf8 "FAT32   ")))
+
+(define (read-fat32-superblock device)
+  "Return the raw contents of DEVICE's fat32 superblock as a bytevector, or
+#f if DEVICE does not contain a fat32 file system."
+  (read-superblock device 0 90 fat32-superblock?))
+
+(define (fat32-superblock-uuid sblock)
+  "Return the Volume ID of a fat superblock SBLOCK as a 4-byte bytevector."
+  (sub-bytevector sblock 67 4))
+
+(define (fat32-uuid->string uuid)
+  "Convert fat32 UUID, a 4-byte bytevector, to its string representation."
+  (let ((high  (bytevector-uint-ref uuid 0 %fat32-endianness 2))
+        (low (bytevector-uint-ref uuid 2 %fat32-endianness 2)))
+    (format #f "~:@(~x-~x~)" low high)))
+
+(define (fat32-superblock-volume-name sblock)
+  "Return the volume name of SBLOCK as a string of at most 11 characters, or
+#f if SBLOCK has no volume name.  The volume name is a latin1 string.
+Trailing spaces are trimmed."
+  (string-trim-right (latin1->string (sub-bytevector sblock 71 11) (lambda (c) #f)) #\space))
+
+(define (check-fat32-file-system device)
+  "Return the health of a fat file system on DEVICE."
+  (match (status:exit-val
+          (system* "fsck.vfat" "-v" "-a" device))
+    (0 'pass)
+    (1 'errors-corrected)
+    (_ 'fatal-error)))
+
 
 ;;;
 ;;; LUKS encrypted devices.
@@ -307,13 +354,17 @@ (define %partition-label-readers
   (list (partition-field-reader read-ext2-superblock
                                 ext2-superblock-volume-name)
         (partition-field-reader read-btrfs-superblock
-                                btrfs-superblock-volume-name)))
+                                btrfs-superblock-volume-name)
+        (partition-field-reader read-fat32-superblock
+                                fat32-superblock-volume-name)))
 
 (define %partition-uuid-readers
   (list (partition-field-reader read-ext2-superblock
                                 ext2-superblock-uuid)
         (partition-field-reader read-btrfs-superblock
-                                btrfs-superblock-uuid)))
+                                btrfs-superblock-uuid)
+        (partition-field-reader read-fat32-superblock
+                                fat32-superblock-uuid)))
 
 (define read-partition-label
   (cut read-partition-field <> %partition-label-readers))
@@ -481,6 +532,7 @@ (define check-procedure
     (cond
      ((string-prefix? "ext" type) check-ext2-file-system)
      ((string-prefix? "btrfs" type) check-btrfs-file-system)
+     ((string-suffix? "fat" type) check-fat32-file-system)
      (else #f)))
 
   (if check-procedure
-- 
cgit v1.2.3