Re: GuixSD bootable ISO-9669 image (was: Re: GuixSD on servers [Fwd: [rtracker.1984.is #131647] A question about VServer system specific requirements])

[Danny Milosavljevic <dannym@scratchpost.org>]

Something like this (totally untested):

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 0cb84b8aa..be512d59c 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -230,6 +230,55 @@ Trailing spaces are trimmed."
 
 ^L
 ;;;
+;;; ISO9660 file systems.
+;;;
+
+;; <http://www.ecma-international.org/publications/files/ECMA-ST/Ecma-119.pdf>.
+
+;(define-syntax %iso9660-endianness
+;  ;; Endianness of iso9660 file systems that we use.
+;  ;; Actually, iso9660 has redundant data (i.e. data for both endiannesses).
+;  (identifier-syntax (endianness little)))
+
+(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 (array-ref sblock 0))) ; FIXME if sblock
+    (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 Volume ID of a iso9660 superblock SBLOCK as a 4-byte bytevector."
+  ;; Note: The field is the volume creation time.
+  ;; FIXME Use only certain parts (See grub).
+  ;; FIXME treat "all 0" as invalid.
+  (sub-bytevector sblock 813 17))
+
+;; FIXME make result human-readable (See grub).
+;(define (iso9660-uuid->string uuid)
+
+(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))
+
+^L
+;;;
 ;;; LUKS encrypted devices.
 ;;;
 
@@ -340,7 +389,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 +399,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)