bug#26751: [PATCH v2] gnu: build: file-systems: Add ISO-9660.

[Danny Milosavljevic]

* gnu/build/file-systems.scm (iso9660-superblock?,
read-iso9660-primary-volume-descriptor, read-iso9660-superblock,
iso9660-superblock-uuid, iso9660-uuid->string,
iso9660-superblock-volume-name): New variables.
(%partition-label-readers): Add iso9660.
(%partition-uuid-readers): Add iso9660.
---
 gnu/build/file-systems.scm | 64 ++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 62 insertions(+), 2 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 0cb84b8aa..3e702cc8d 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -230,6 +230,62 @@ Trailing spaces are trimmed."
 
 
 ;;;
+;;; ISO9660 file systems.
+;;;
+
+;; <http://www.ecma-international.org/publications/files/ECMA-ST/Ecma-119.pdf>.
+
+(define (iso9660-superblock? sblock)
+  "Return #t when SBLOCK is a iso9660 superblock."
+  (bytevector=? (sub-bytevector sblock 1 6)
+                ;; Note: "\x01" is the volume descriptor format version
+                (string->utf8 "CD001\x01")))
+
+(define (read-iso9660-primary-volume-descriptor device offset)
+  "Find and read the first primary volume descriptor, starting at OFFSET.
+   Return #f if not found."
+  (let* ((sblock    (read-superblock device offset 2048 iso9660-superblock?))
+         (type-code (if sblock (array-ref sblock 0) 255)))
+    (match type-code
+      (255 #f) ; Volume Descriptor Set Terminator.
+      (1 sblock) ; Primary Volume Descriptor
+      (_ (read-iso9660-primary-volume-descriptor device (+ offset 2048))))))
+
+(define (read-iso9660-superblock device)
+  "Return the raw contents of DEVICE's iso9660 superblock as a bytevector, or
+#f if DEVICE does not contain a iso9660 file system."
+  ;; Start reading at sector 16.
+  (read-iso9660-primary-volume-descriptor device (* 2048 16)))
+
+(define (iso9660-superblock-uuid sblock)
+  "Return the modification time of a iso9660 superblock SBLOCK as a 
bytevector."
+  ;; FIXME Use only certain parts (See grub).
+  ;; FIXME treat "all 0" as invalid.
+  ;; Drops GMT offset for compatibility with Grub, blkid and /dev/disk/by-uuid.
+  ;; Compare Grub: "2014-12-02-19-30-23-00".
+  ;; Compare blkid result: "2014-12-02-19-30-23-00".
+  ;; Compare /dev/disk/by-uuid entry: "2014-12-02-19-30-23-00".
+  (sub-bytevector sblock 830 16))
+
+(define (iso9660-uuid->string uuid)
+  (define digits->string latin1->string)
+  (let* ((year (sub-bytevector uuid 0 4))
+         (month (sub-bytevector uuid 4 2))
+         (day (sub-bytevector uuid 6 2))
+         (hour (sub-bytevector uuid 8 2))
+         (minute (sub-bytevector uuid 10 2))
+         (second (sub-bytevector uuid 12 2))
+         (hundreths (sub-bytevector uuid 14 2))
+         (parts (list year month day hour minute second hundreths)))
+    (string-append (string-join (map digits->string parts)))))
+
+(define (iso9660-superblock-volume-name sblock)
+  "Return the volume name of SBLOCK as a string.  The volume name is an ASCII
+string.  Trailing spaces are trimmed."
+  (string-trim-right (latin1->string (sub-bytevector sblock 40 32) (lambda (c) 
#f)) #\space))
+
+
+;;;
 ;;; LUKS encrypted devices.
 ;;;
 
@@ -340,7 +396,9 @@ partition field reader that returned a value."
     (_ #f)))
 
 (define %partition-label-readers
-  (list (partition-field-reader read-ext2-superblock
+  (list (partition-field-reader read-iso9660-superblock
+                                iso9660-superblock-volume-name)
+        (partition-field-reader read-ext2-superblock
                                 ext2-superblock-volume-name)
         (partition-field-reader read-btrfs-superblock
                                 btrfs-superblock-volume-name)
@@ -348,7 +406,9 @@ partition field reader that returned a value."
                                 fat32-superblock-volume-name)))
 
 (define %partition-uuid-readers
-  (list (partition-field-reader read-ext2-superblock
+  (list (partition-field-reader read-iso9660-superblock
+                                iso9660-superblock-uuid)
+        (partition-field-reader read-ext2-superblock
                                 ext2-superblock-uuid)
         (partition-field-reader read-btrfs-superblock
                                 btrfs-superblock-uuid)