From f8865db6a002c9b968d39d0d91524edf55e0d873 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 1 Jan 2016 22:41:35 +0100 Subject: [PATCH] file-systems: Move 'string->uuid' to the build side. * gnu/system/file-systems.scm (%uuid-rx, string->uuid): Move to... * gnu/build/file-systems.scm (%uuid-rx, string->uuid): ... here. New variables. --- gnu/build/file-systems.scm | 46 ++++++++++++++++++++++++++++++++++++- gnu/system/file-systems.scm | 45 ++++-------------------------------- 2 files changed, 50 insertions(+), 41 deletions(-) diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index 00af35d3df..d83a4f6015 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,6 +23,7 @@ (define-module (gnu build file-systems) #:use-module (ice-9 match) #:use-module (ice-9 rdelim) #:use-module (ice-9 format) + #:use-module (ice-9 regex) #:use-module (system foreign) #:autoload (system repl repl) (start-repl) #:use-module (srfi srfi-1) @@ -34,6 +35,9 @@ (define-module (gnu build file-systems) find-partition-by-uuid canonicalize-device-spec + uuid->string + string->uuid + MS_RDONLY MS_NOSUID MS_NODEV @@ -213,6 +217,11 @@ (define (find-partition-by-uuid uuid) (disk-partitions)) (cut string-append "/dev/" <>))) + +;;; +;;; UUIDs. +;;; + (define-syntax %network-byte-order (identifier-syntax (endianness big))) @@ -228,6 +237,41 @@ (define (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 + ;; 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 ) 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* (canonicalize-device-spec spec #:optional (title 'any)) "Return the device name corresponding to SPEC. TITLE is a symbol, one of the following: diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 47a3dbc1e8..d93044ce04 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,13 +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) + #:use-module ((gnu build file-systems) + #:select (string->uuid uuid->string)) + #:re-export (string->uuid + uuid->string) #:export ( file-system file-system? @@ -41,7 +41,6 @@ (define-module (gnu system file-systems) file-system-dependencies file-system->spec - string->uuid uuid %fuse-control-file-system @@ -118,40 +117,6 @@ (define (file-system->spec fs) (($ 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 ) 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."