mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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:
parent
2f3108ad03
commit
06110559bb
1 changed files with 63 additions and 2 deletions
|
@ -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)
|
||||||
|
|
Loading…
Reference in a new issue