uuid: Add a parser for FAT32 UUIDs.
* gnu/system/uuid.scm (%fat32-uuid-rx): New variable. (string->fat32-uuid): New procedure. (%uuid-parsers): Add it. * tests/uuid.scm ("uuid, FAT32, format preserved"): New test.
This commit is contained in:
parent
60e36bff1f
commit
8a7d81a5e2
|
@ -41,6 +41,7 @@
|
||||||
string->ext3-uuid
|
string->ext3-uuid
|
||||||
string->ext4-uuid
|
string->ext4-uuid
|
||||||
string->btrfs-uuid
|
string->btrfs-uuid
|
||||||
|
string->fat32-uuid
|
||||||
iso9660-uuid->string
|
iso9660-uuid->string
|
||||||
|
|
||||||
;; XXX: For lack of a better place.
|
;; XXX: For lack of a better place.
|
||||||
|
@ -175,6 +176,22 @@ ISO9660 UUID representation."
|
||||||
(low (bytevector-uint-ref uuid 2 %fat32-endianness 2)))
|
(low (bytevector-uint-ref uuid 2 %fat32-endianness 2)))
|
||||||
(format #f "~:@(~x-~x~)" low high)))
|
(format #f "~:@(~x-~x~)" low high)))
|
||||||
|
|
||||||
|
(define %fat32-uuid-rx
|
||||||
|
(make-regexp "^([[:xdigit:]]{4})-([[:xdigit:]]{4})$"))
|
||||||
|
|
||||||
|
(define (string->fat32-uuid str)
|
||||||
|
"Parse STR, which is in FAT32 format, and return a bytevector or #f."
|
||||||
|
(match (regexp-exec %fat32-uuid-rx str)
|
||||||
|
(#f
|
||||||
|
#f)
|
||||||
|
(rx-match
|
||||||
|
(uint-list->bytevector (list (string->number
|
||||||
|
(match:substring rx-match 2) 16)
|
||||||
|
(string->number
|
||||||
|
(match:substring rx-match 1) 16))
|
||||||
|
%fat32-endianness
|
||||||
|
2))))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; Generic interface.
|
;;; Generic interface.
|
||||||
|
@ -198,6 +215,7 @@ ISO9660 UUID representation."
|
||||||
(define %uuid-parsers
|
(define %uuid-parsers
|
||||||
(vhashq
|
(vhashq
|
||||||
('dce 'ext2 'ext3 'ext4 'btrfs 'luks => string->dce-uuid)
|
('dce 'ext2 'ext3 'ext4 'btrfs 'luks => string->dce-uuid)
|
||||||
|
('fat32 'fat => string->fat32-uuid)
|
||||||
('iso9660 => string->iso9660-uuid)))
|
('iso9660 => string->iso9660-uuid)))
|
||||||
|
|
||||||
(define %uuid-printers
|
(define %uuid-printers
|
||||||
|
|
|
@ -53,4 +53,8 @@
|
||||||
"1970-01-01-17-14-42-99"
|
"1970-01-01-17-14-42-99"
|
||||||
(uuid->string (uuid "1970-01-01-17-14-42-99" 'iso9660)))
|
(uuid->string (uuid "1970-01-01-17-14-42-99" 'iso9660)))
|
||||||
|
|
||||||
|
(test-equal "uuid, FAT32, format preserved"
|
||||||
|
"1234-ABCD"
|
||||||
|
(uuid->string (uuid "1234-abcd" 'fat32)))
|
||||||
|
|
||||||
(test-end)
|
(test-end)
|
||||||
|
|
Loading…
Reference in New Issue