aboutsummaryrefslogtreecommitdiff
path: root/gnu/system/file-systems.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-07-14 15:06:46 +0200
committerLudovic Courtès <ludo@gnu.org>2015-07-14 15:24:20 +0200
commit661a1d7924e174a28e0e21bf516aa1a8a44dad73 (patch)
treee794ceca18881f189fa0be3a2477cf7a9ccd0182 /gnu/system/file-systems.scm
parent0ec5ee94861980a6957d210adf1903ea96202dd9 (diff)
downloadguix-661a1d7924e174a28e0e21bf516aa1a8a44dad73.tar
guix-661a1d7924e174a28e0e21bf516aa1a8a44dad73.tar.gz
file-systems: Allow users to specify file system UUIDs as strings.
Fixes <http://bugs.gnu.org/19778>. Reported by Mark H Weaver <mhw@netris.org>. * gnu/system/file-systems.scm (%uuid-rx): New variable. (string->uuid): New procedure. (uuid): New macro. * tests/file-systems.scm: New file. * Makefile.am (SCM_TESTS): Add it. * doc/guix.texi (File Systems): Give an example of UUID.
Diffstat (limited to 'gnu/system/file-systems.scm')
-rw-r--r--gnu/system/file-systems.scm57
1 files changed, 57 insertions, 0 deletions
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 33926444b6..ece8fb41e6 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -18,9 +18,13 @@
(define-module (gnu system file-systems)
#:use-module (ice-9 match)
+ #:use-module (ice-9 regex)
#:use-module (guix gexp)
#:use-module (guix records)
#:use-module (guix store)
+ #:use-module (rnrs bytevectors)
+ #:use-module ((gnu build file-systems) #:select (uuid->string))
+ #:re-export (uuid->string)
#:export (<file-system>
file-system
file-system?
@@ -35,6 +39,8 @@
file-system-create-mount-point?
file-system->spec
+ string->uuid
+ uuid
%fuse-control-file-system
%binary-format-file-system
@@ -106,6 +112,57 @@ initrd code."
(($ <file-system> device title mount-point type flags options _ check?)
(list device title mount-point type flags options check?))))
+(define %uuid-rx
+ ;; The regexp of a UUID.
+ (make-regexp "^([[:xdigit:]]{8})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{12})$"))
+
+(define (string->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)
+ (lambda (match)
+ (letrec-syntax ((hex->number
+ (syntax-rules ()
+ ((_ index)
+ (string->number (match:substring match index)
+ 16))))
+ (put!
+ (syntax-rules ()
+ ((_ bv index (number len) rest ...)
+ (begin
+ (bytevector-uint-set! bv index number
+ (endianness big) len)
+ (put! bv (+ index len) rest ...)))
+ ((_ bv index)
+ bv))))
+ (let ((time-low (hex->number 1))
+ (time-mid (hex->number 2))
+ (time-hi (hex->number 3))
+ (clock-seq (hex->number 4))
+ (node (hex->number 5))
+ (uuid (make-bytevector 16)))
+ (put! uuid 0
+ (time-low 4) (time-mid 2) (time-hi 2)
+ (clock-seq 2) (node 6)))))))
+
+(define-syntax uuid
+ (lambda (s)
+ "Return the bytevector corresponding to the given UUID representation."
+ (syntax-case s ()
+ ((_ str)
+ (string? (syntax->datum #'str))
+ ;; A literal string: do the conversion at expansion time.
+ (with-syntax ((bv (string->uuid (syntax->datum #'str))))
+ #''bv))
+ ((_ str)
+ #'(string->uuid str)))))
+
+
+;;;
+;;; Common file systems.
+;;;
+
(define %fuse-control-file-system
;; Control file system for Linux' file systems in user-space (FUSE).
(file-system