01/01: file-systems: Provide string->iso9660-uuid.

[Danny Milosavljevic]

dannym pushed a commit to branch master
in repository guix.

commit bb7cf4f5335370c4a29adc236816851076c0fe61
Author: Danny Milosavljevic <address@hidden>
Date:   Thu Jun 8 21:24:36 2017 +0200

    file-systems: Provide string->iso9660-uuid.
    
    * gnu/build/file-systems.scm (string->iso9660-uuid): New variable.  Export 
it.
    
    Co-authored-by: Ludovic Courtès <address@hidden>
---
 gnu/build/file-systems.scm | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 7737de3..1c733f4 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -43,6 +43,7 @@
 
             uuid->string
             string->uuid
+            string->iso9660-uuid
 
             bind-mount
 
@@ -235,6 +236,27 @@ Trailing spaces are trimmed."
 
 ;; <http://www.ecma-international.org/publications/files/ECMA-ST/Ecma-119.pdf>.
 
+(define %iso9660-uuid-rx
+  ;;                   Y                m                d                H    
            M                S                ss
+  (make-regexp 
"^([[:digit:]]{4})-([[:digit:]]{2})-([[:digit:]]{2})-([[:digit:]]{2})-([[:digit:]]{2})-([[:digit:]]{2})-([[:digit:]]{2})$"))
+
+(define (string->iso9660-uuid str)
+  "Parse STR as a ISO9660 UUID (which is really a timestamp - see 
/dev/disk/by-uuid).
+Return its contents as a 16-byte bytevector.  Return #f if STR is not a valid
+ISO9660 UUID representation."
+  (and=> (regexp-exec %iso9660-uuid-rx str)
+         (lambda (match)
+           (letrec-syntax ((match-numerals
+                            (syntax-rules ()
+                              ((_ index (name rest ...) body)
+                               (let ((name (match:substring match index)))
+                                 (match-numerals (+ 1 index) (rest ...) body)))
+                              ((_ index () body)
+                               body))))
+            (match-numerals 1 (year month day hour minute second hundredths)
+              (string->utf8 (string-append year month day
+                                           hour minute second hundredths)))))))
+
 (define (iso9660-superblock? sblock)
   "Return #t when SBLOCK is an iso9660 volume descriptor."
   (bytevector=? (sub-bytevector sblock 1 6)