[bug#64259] [PATCH 1/2] Offer an mdadm variant of uuids.

[Felix Lechner]

The main executable to set up and manage Linux MD arrays, mdadm, uses a UUID
format that is different from other standards. The variant is here provided
for the benefit of Guix users.

* gnu/system/uuid.scm: Offer an mdadm variant of uuids.
---
 gnu/system/uuid.scm | 46 +++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 42 insertions(+), 4 deletions(-)

diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm
index 8f967387ad..dc8bb3f7b7 100644
--- a/gnu/system/uuid.scm
+++ b/gnu/system/uuid.scm
@@ -82,8 +82,9 @@ (define-syntax %network-byte-order
   (identifier-syntax (endianness big)))
 
 (define (dce-uuid->string uuid)
-  "Convert UUID, a 16-byte bytevector, to its string representation, something
-like \"6b700d61-5550-48a1-874c-a3d86998990e\"."
+  "Convert UUID, a 16-byte bytevector, to its DCE string representation (see
+<https://tools.ietf.org/html/rfc4122>), which looks something like
+\"6b700d61-5550-48a1-874c-a3d86998990e\"."
   ;; See <https://tools.ietf.org/html/rfc4122>.
   (let ((time-low  (bytevector-uint-ref uuid 0 %network-byte-order 4))
         (time-mid  (bytevector-uint-ref uuid 4 %network-byte-order 2))
@@ -93,7 +94,7 @@ (define (dce-uuid->string uuid)
     (format #f "~8,'0x-~4,'0x-~4,'0x-~4,'0x-~12,'0x"
             time-low time-mid time-hi clock-seq node)))
 
-(define %uuid-rx
+(define %dce-uuid-rx
   ;; The regexp of a UUID.
   (make-regexp 
"^([[:xdigit:]]{8})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{12})$"))
 
@@ -101,7 +102,7 @@ (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."
-  (and=> (regexp-exec %uuid-rx str)
+  (and=> (regexp-exec %dce-uuid-rx str)
          (lambda (match)
            (letrec-syntax ((hex->number
                             (syntax-rules ()
@@ -167,6 +168,41 @@ (define (digits->string bytes)
          (parts (list year month day hour minute second hundredths)))
     (string-append (string-join (map digits->string parts) "-"))))
 
+
+;;;
+;;; Mdadm.
+;;;
+
+(define (mdadm-uuid->string uuid)
+  "Convert UUID, a 16-byte bytevector, to its Mdadm string representation,
+which looks something like \"6b700d61:555048a1:874ca3d8:6998990e\"."
+  ;; See <https://tools.ietf.org/html/rfc4122>.
+  (format #f "~8,'0x:~8,'0x:~8,'0x:~8,'0x"
+          (bytevector-uint-ref uuid 0 %network-byte-order 4)
+          (bytevector-uint-ref uuid 4 %network-byte-order 4)
+          (bytevector-uint-ref uuid 8 %network-byte-order 4)
+          (bytevector-uint-ref uuid 12 %network-byte-order 4)))
+
+(define %mdadm-uuid-rx
+  (make-regexp 
"^([[:xdigit:]]{8}):([[:xdigit:]]{8}):([[:xdigit:]]{8}):([[:xdigit:]]{8})$"))
+
+(define (string->mdadm-uuid str)
+  "Parse STR, which is in Mdadm format, and return a bytevector or #f."
+  (match (regexp-exec %mdadm-uuid-rx str)
+    (#f
+     #f)
+    (rx-match
+     (uint-list->bytevector (list (string->number
+                                   (match:substring rx-match 1) 16)
+                                  (string->number
+                                   (match:substring rx-match 2) 16)
+                                  (string->number
+                                   (match:substring rx-match 3) 16)
+                                  (string->number
+                                   (match:substring rx-match 4) 16))
+                            %network-byte-order
+                            4))))
+
 
 ;;;
 ;;; FAT32/FAT16.
@@ -259,6 +295,7 @@ (define %uuid-parsers
    ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'f2fs 'jfs 'xfs 'luks
          => string->dce-uuid)
    ('fat32 'fat16 'fat => string->fat-uuid)
+   ('mdadm => string->mdadm-uuid)
    ('ntfs => string->ntfs-uuid)
    ('iso9660 => string->iso9660-uuid)))
 
@@ -268,6 +305,7 @@ (define %uuid-printers
          => dce-uuid->string)
    ('iso9660 => iso9660-uuid->string)
    ('fat32 'fat16 'fat => fat-uuid->string)
+   ('mdadm => mdadm-uuid->string)
    ('ntfs => ntfs-uuid->string)))
 
 (define* (string->uuid str #:optional (type 'dce))
-- 
2.40.1