file-systems: Add UUID type dictionaries.
* gnu/build/file-systems.scm (uuid->string): Rename to... (dce-uuid->string): ... this. (string->uuid): Rename to... (string->dce-uuid): ... this. (vhashq): New macro. (%uuid-parsers, %uuid-printers): New variables. (uuid->string, string->uuid): New procedures.
This commit is contained in:
		
							parent
							
								
									bae28ccb69
								
							
						
					
					
						commit
						a8e1247d7d
					
				
					 1 changed files with 43 additions and 6 deletions
				
			
		|  | @ -28,6 +28,7 @@ | ||||||
|   #:use-module (ice-9 rdelim) |   #:use-module (ice-9 rdelim) | ||||||
|   #:use-module (ice-9 format) |   #:use-module (ice-9 format) | ||||||
|   #:use-module (ice-9 regex) |   #:use-module (ice-9 regex) | ||||||
|  |   #:use-module (ice-9 vlist) | ||||||
|   #:use-module (system foreign) |   #:use-module (system foreign) | ||||||
|   #:autoload   (system repl repl) (start-repl) |   #:autoload   (system repl repl) (start-repl) | ||||||
|   #:use-module (srfi srfi-1) |   #:use-module (srfi srfi-1) | ||||||
|  | @ -42,7 +43,9 @@ | ||||||
|             canonicalize-device-spec |             canonicalize-device-spec | ||||||
| 
 | 
 | ||||||
|             uuid->string |             uuid->string | ||||||
|  |             dce-uuid->string | ||||||
|             string->uuid |             string->uuid | ||||||
|  |             string->dce-uuid | ||||||
|             string->iso9660-uuid |             string->iso9660-uuid | ||||||
|             string->ext2-uuid |             string->ext2-uuid | ||||||
|             string->ext3-uuid |             string->ext3-uuid | ||||||
|  | @ -516,7 +519,7 @@ were found." | ||||||
| (define-syntax %network-byte-order | (define-syntax %network-byte-order | ||||||
|   (identifier-syntax (endianness big))) |   (identifier-syntax (endianness big))) | ||||||
| 
 | 
 | ||||||
| (define (uuid->string uuid) | (define (dce-uuid->string uuid) | ||||||
|   "Convert UUID, a 16-byte bytevector, to its string representation, something |   "Convert UUID, a 16-byte bytevector, to its string representation, something | ||||||
| like \"6b700d61-5550-48a1-874c-a3d86998990e\"." | like \"6b700d61-5550-48a1-874c-a3d86998990e\"." | ||||||
|   ;; See <https://tools.ietf.org/html/rfc4122>. |   ;; See <https://tools.ietf.org/html/rfc4122>. | ||||||
|  | @ -532,7 +535,7 @@ like \"6b700d61-5550-48a1-874c-a3d86998990e\"." | ||||||
|   ;; The regexp of a UUID. |   ;; The regexp of a UUID. | ||||||
|   (make-regexp "^([[:xdigit:]]{8})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{12})$")) |   (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 |   "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 | return its contents as a 16-byte bytevector.  Return #f if STR is not a valid | ||||||
| UUID representation." | UUID representation." | ||||||
|  | @ -562,10 +565,44 @@ UUID representation." | ||||||
|                      (time-low 4) (time-mid 2) (time-hi 2) |                      (time-low 4) (time-mid 2) (time-hi 2) | ||||||
|                      (clock-seq 2) (node 6))))))) |                      (clock-seq 2) (node 6))))))) | ||||||
| 
 | 
 | ||||||
| (define string->ext2-uuid string->uuid) | (define string->ext2-uuid string->dce-uuid) | ||||||
| (define string->ext3-uuid string->uuid) | (define string->ext3-uuid string->dce-uuid) | ||||||
| (define string->ext4-uuid string->uuid) | (define string->ext4-uuid string->dce-uuid) | ||||||
| (define string->btrfs-uuid string->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)) | (define* (canonicalize-device-spec spec #:optional (title 'any)) | ||||||
|  |  | ||||||
		Reference in a new issue