me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2016-01-01 22:41:35 +01:00
parent 29824d80ec
commit f8865db6a0
2 changed files with 50 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
gnu/build/file-systems.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -23,6 +23,7 @@
#: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 @@
find-partition-by-uuid
canonicalize-device-spec
uuid->string
string->uuid
MS_RDONLY
MS_NOSUID
MS_NODEV
@ -213,6 +217,11 @@ or #f if none was found."
(disk-partitions))
(cut string-append "/dev/" <>)))
;;;
;;; UUIDs.
;;;
(define-syntax %network-byte-order
(identifier-syntax (endianness big)))
@ -228,6 +237,41 @@ like \"6b700d61-5550-48a1-874c-a3d86998990e\"."
(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 <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* (canonicalize-device-spec spec #:optional (title 'any))
"Return the device name corresponding to SPEC. TITLE is a symbol, one of
the following:

45
gnu/system/file-systems.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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
file-system?
@ -41,7 +41,6 @@
file-system-dependencies
file-system->spec
string->uuid
uuid
%fuse-control-file-system
@ -118,40 +117,6 @@ 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."