file-systems: Add NTFS support.

* gnu/system/uuid.scm (%ntfs-endianness): New macro,
(ntfs-uuid->string): new procedure,
(%ntfs-endianness): new variable,
(string->ntfs-uuid): new exported procedure,
(%uuid-parsers): add NTFS support,
(%uuid-printers): add NTFS support.
* gnu/build/file-systems.scm (%ntfs-endianness): New macro,
(ntfs-superblock?, read-ntfs-superblock, ntfs-superblock-uuid,
check-ntfs-file-system): new procedure,
(%partition-uuid-readers): add NTFS support,
(check-file-system): add NTFS support.

gnu/build/file-systems.scm

@@ -476,6 +476,42 @@ (define (luks-header-uuid header)
   (let ((uuid (sub-bytevector header 168 36)))
     (string->uuid (utf8->string uuid))))
 
+
+;;;
+;;; NTFS file systems.
+;;;
+
+;; Taken from <linux-libre>/fs/ntfs/layout.h
+
+(define-syntax %ntfs-endianness
+  ;; Endianness of NTFS file systems.
+  (identifier-syntax (endianness little)))
+
+(define (ntfs-superblock? sblock)
+  "Return #t when SBLOCK is a NTFS superblock."
+  (bytevector=? (sub-bytevector sblock 3 8)
+                (string->utf8 "NTFS    ")))
+
+(define (read-ntfs-superblock device)
+  "Return the raw contents of DEVICE's NTFS superblock as a bytevector, or #f
+if DEVICE does not contain a NTFS file system."
+  (read-superblock device 0 511 ntfs-superblock?))
+
+(define (ntfs-superblock-uuid sblock)
+  "Return the UUID of NTFS superblock SBLOCK as a 8-byte bytevector."
+  (sub-bytevector sblock 72 8))
+
+;; TODO: Add ntfs-superblock-volume-name.  The partition label is not stored
+;; in the BOOT SECTOR like the UUID, but in the MASTER FILE TABLE, which seems
+;; way harder to access.
+
+(define (check-ntfs-file-system device)
+  "Return the health of a NTFS file system on DEVICE."
+  (match (status:exit-val
+          (system* "ntfsfix" device))
+    (0 'pass)
+    (_ 'fatal-error)))
+
 
 ;;;
 ;;; Partition lookup.
@@ -585,7 +621,9 @@ (define %partition-uuid-readers
         (partition-field-reader read-jfs-superblock
                                 jfs-superblock-uuid)
         (partition-field-reader read-f2fs-superblock
-                                f2fs-superblock-uuid)))
+                                f2fs-superblock-uuid)
+        (partition-field-reader read-ntfs-superblock
+                                ntfs-superblock-uuid)))
 
 (define read-partition-label
   (cut read-partition-field <> %partition-label-readers))
@@ -684,6 +722,7 @@ (define check-procedure
      ((string-suffix? "fat" type) check-fat-file-system)
      ((string-prefix? "jfs" type) check-jfs-file-system)
      ((string-prefix? "f2fs" type) check-f2fs-file-system)
+     ((string-prefix? "ntfs" type) check-ntfs-file-system)
      ((string-prefix? "nfs" type) (const 'pass))
      (else #f)))
 

gnu/system/uuid.scm

@@ -45,6 +45,7 @@ (define-module (gnu system uuid)
             string->btrfs-uuid
             string->fat-uuid
             string->jfs-uuid
+            string->ntfs-uuid
             iso9660-uuid->string
 
             ;; XXX: For lack of a better place.
@@ -195,6 +196,38 @@ (define (string->fat-uuid str)
                             %fat-endianness
                             2))))
 
+
+;;;
+;;; NTFS.
+;;;
+
+(define-syntax %ntfs-endianness
+  ;; Endianness of NTFS file system.
+  (identifier-syntax (endianness little)))
+
+(define (ntfs-uuid->string uuid)
+  "Convert NTFS UUID, a 8-byte bytevector, to its string representation."
+  (format #f "~{~:@(~x~)~}" (reverse (bytevector->u8-list uuid))))
+
+(define %ntfs-uuid-rx
+  (make-regexp "^([[:xdigit:]]{16})$"))
+
+(define (string->ntfs-uuid str)
+  "Parse STR, which is in NTFS format, and return a bytevector or #f."
+  (match (regexp-exec %ntfs-uuid-rx str)
+    (#f
+     #f)
+    (rx-match
+     (u8-list->bytevector
+      (let loop ((str str)
+                 (res '()))
+        (if (string=? str "")
+            res
+            (loop (string-drop str 2)
+                  (cons
+                   (string->number (string-take str 2) 16)
+                   res))))))))
+
 
 ;;;
 ;;; Generic interface.
@@ -220,13 +253,15 @@ (define %uuid-parsers
   (vhashq
    ('dce 'ext2 'ext3 'ext4 'btrfs 'jfs 'luks => string->dce-uuid)
    ('fat32 'fat16 'fat => string->fat-uuid)
+   ('ntfs => string->ntfs-uuid)
    ('iso9660 => string->iso9660-uuid)))
 
 (define %uuid-printers
   (vhashq
    ('dce 'ext2 'ext3 'ext4 'btrfs 'jfs 'luks => dce-uuid->string)
    ('iso9660 => iso9660-uuid->string)
-   ('fat32 'fat16 'fat => fat-uuid->string)))
+   ('fat32 'fat16 'fat => fat-uuid->string)
+   ('ntfs => ntfs-uuid->string)))
 
 (define* (string->uuid str #:optional (type 'dce))
   "Parse STR as a UUID of the given TYPE.  On success, return the