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

* gnu/build/file-systems.scm (string->iso9660-uuid): New variable.  Export it.

Co-authored-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Danny Milosavljevic 2017-06-08 21:24:36 +02:00
parent 19c90e5f69
commit bb7cf4f533
No known key found for this signature in database
GPG Key ID: E71A35542C30BAA5
1 changed files with 22 additions and 0 deletions

View File

@ -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)