gnu: build: file-systems: Add ISO-9660.

Fixes <https://bugs.gnu.org/26751>.

* 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.
This commit is contained in:
Danny Milosavljevic 2017-05-02 22:32:09 +02:00
parent 2f3108ad03
commit 06110559bb
No known key found for this signature in database
GPG key ID: E71A35542C30BAA5

View file

@ -228,6 +228,63 @@ (define (check-fat32-file-system device)
(1 'errors-corrected) (1 'errors-corrected)
(_ 'fatal-error))) (_ 'fatal-error)))
;;;
;;; 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."
;; 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)
"Given an UUID bytevector, return its timestamp string."
(define (digits->string bytes)
(latin1->string bytes (lambda (c) #f)))
(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))
(hundredths (sub-bytevector uuid 14 2))
(parts (list year month day hour minute second hundredths)))
(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. ;;; LUKS encrypted devices.
@ -340,7 +397,9 @@ (define (read-partition-field device partition-field-readers)
(_ #f))) (_ #f)))
(define %partition-label-readers (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) ext2-superblock-volume-name)
(partition-field-reader read-btrfs-superblock (partition-field-reader read-btrfs-superblock
btrfs-superblock-volume-name) btrfs-superblock-volume-name)
@ -348,7 +407,9 @@ (define %partition-label-readers
fat32-superblock-volume-name))) fat32-superblock-volume-name)))
(define %partition-uuid-readers (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) ext2-superblock-uuid)
(partition-field-reader read-btrfs-superblock (partition-field-reader read-btrfs-superblock
btrfs-superblock-uuid) btrfs-superblock-uuid)