diff options
| -rw-r--r-- | gnu/build/file-systems.scm | 49 |
1 files changed, 43 insertions, 6 deletions
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index 203fbdfffb..fbaf158951 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -28,6 +28,7 @@ #:use-module (ice-9 rdelim) #:use-module (ice-9 format) #:use-module (ice-9 regex) + #:use-module (ice-9 vlist) #:use-module (system foreign) #:autoload (system repl repl) (start-repl) #:use-module (srfi srfi-1) @@ -42,7 +43,9 @@ canonicalize-device-spec uuid->string + dce-uuid->string string->uuid + string->dce-uuid string->iso9660-uuid string->ext2-uuid string->ext3-uuid @@ -516,7 +519,7 @@ were found." (define-syntax %network-byte-order (identifier-syntax (endianness big))) -(define (uuid->string uuid) +(define (dce-uuid->string uuid) "Convert UUID, a 16-byte bytevector, to its string representation, something like \"6b700d61-5550-48a1-874c-a3d86998990e\"." ;; See <https://tools.ietf.org/html/rfc4122>. @@ -532,7 +535,7 @@ like \"6b700d61-5550-48a1-874c-a3d86998990e\"." ;; The regexp of a UUID. (make-regexp "^([[:xdigit:]]{8})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{12})$")) -(define (string->uuid str) +(define (string->dce-uuid str) "Parse STR as a DCE UUID (see <https://tools.ietf.org/html/rfc4122>) and return its contents as a 16-byte bytevector. Return #f if STR is not a valid UUID representation." @@ -562,10 +565,44 @@ UUID representation." (time-low 4) (time-mid 2) (time-hi 2) (clock-seq 2) (node 6))))))) -(define string->ext2-uuid string->uuid) -(define string->ext3-uuid string->uuid) -(define string->ext4-uuid string->uuid) -(define string->btrfs-uuid string->uuid) +(define string->ext2-uuid string->dce-uuid) +(define string->ext3-uuid string->dce-uuid) +(define string->ext4-uuid string->dce-uuid) +(define string->btrfs-uuid string->dce-uuid) + +(define-syntax vhashq + (syntax-rules (=>) + ((_) + vlist-null) + ((_ (key others ... => value) rest ...) + (vhash-consq key value + (vhashq (others ... => value) rest ...))) + ((_ (=> value) rest ...) + (vhashq rest ...)))) + +(define %uuid-parsers + (vhashq + ('dce 'ext2 'ext3 'ext4 'btrfs 'luks => string->dce-uuid) + ('iso9660 => string->iso9660-uuid))) + +(define %uuid-printers + (vhashq + ('dce 'ext2 'ext3 'ext4 'btrfs 'luks => dce-uuid->string) + ('iso9660 => iso9660-uuid->string) + ('fat32 'fat => fat32-uuid->string))) + +(define* (string->uuid str #:key (type 'dce)) + "Parse STR as a UUID of the given TYPE. On success, return the +corresponding bytevector; otherwise return #f." + (match (vhash-assq type %uuid-parsers) + (#f #f) + ((_ . (? procedure? parse)) (parse str)))) + +(define* (uuid->string bv #:key (type 'dce)) + "Convert BV, a bytevector, to the UUID string representation for TYPE." + (match (vhash-assq type %uuid-printers) + (#f #f) + ((_ . (? procedure? unparse)) (unparse bv)))) (define* (canonicalize-device-spec spec #:optional (title 'any)) |