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