From bb7cf4f5335370c4a29adc236816851076c0fe61 Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Thu, 8 Jun 2017 21:24:36 +0200 Subject: [PATCH] file-systems: Provide string->iso9660-uuid. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/build/file-systems.scm (string->iso9660-uuid): New variable. Export it. Co-authored-by: Ludovic Courtès --- 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 7737de3d03..1c733f43b4 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." ;; . +(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)