mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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.
This commit is contained in:
parent
29824d80ec
commit
f8865db6a0
2 changed files with 50 additions and 41 deletions
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; 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.
|
;;; 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 match)
|
||||||
#:use-module (ice-9 rdelim)
|
#:use-module (ice-9 rdelim)
|
||||||
#:use-module (ice-9 format)
|
#:use-module (ice-9 format)
|
||||||
|
#:use-module (ice-9 regex)
|
||||||
#:use-module (system foreign)
|
#:use-module (system foreign)
|
||||||
#:autoload (system repl repl) (start-repl)
|
#:autoload (system repl repl) (start-repl)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
@ -34,6 +35,9 @@ (define-module (gnu build file-systems)
|
||||||
find-partition-by-uuid
|
find-partition-by-uuid
|
||||||
canonicalize-device-spec
|
canonicalize-device-spec
|
||||||
|
|
||||||
|
uuid->string
|
||||||
|
string->uuid
|
||||||
|
|
||||||
MS_RDONLY
|
MS_RDONLY
|
||||||
MS_NOSUID
|
MS_NOSUID
|
||||||
MS_NODEV
|
MS_NODEV
|
||||||
|
@ -213,6 +217,11 @@ (define (find-partition-by-uuid uuid)
|
||||||
(disk-partitions))
|
(disk-partitions))
|
||||||
(cut string-append "/dev/" <>)))
|
(cut string-append "/dev/" <>)))
|
||||||
|
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; UUIDs.
|
||||||
|
;;;
|
||||||
|
|
||||||
(define-syntax %network-byte-order
|
(define-syntax %network-byte-order
|
||||||
(identifier-syntax (endianness big)))
|
(identifier-syntax (endianness big)))
|
||||||
|
|
||||||
|
@ -228,6 +237,41 @@ (define (uuid->string uuid)
|
||||||
(format #f "~8,'0x-~4,'0x-~4,'0x-~4,'0x-~12,'0x"
|
(format #f "~8,'0x-~4,'0x-~4,'0x-~4,'0x-~12,'0x"
|
||||||
time-low time-mid time-hi clock-seq node)))
|
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))
|
(define* (canonicalize-device-spec spec #:optional (title 'any))
|
||||||
"Return the device name corresponding to SPEC. TITLE is a symbol, one of
|
"Return the device name corresponding to SPEC. TITLE is a symbol, one of
|
||||||
the following:
|
the following:
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; 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.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -18,13 +18,13 @@
|
||||||
|
|
||||||
(define-module (gnu system file-systems)
|
(define-module (gnu system file-systems)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 regex)
|
|
||||||
#:use-module (guix gexp)
|
#:use-module (guix gexp)
|
||||||
#:use-module (guix records)
|
#:use-module (guix records)
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module ((gnu build file-systems)
|
||||||
#:use-module ((gnu build file-systems) #:select (uuid->string))
|
#:select (string->uuid uuid->string))
|
||||||
#:re-export (uuid->string)
|
#:re-export (string->uuid
|
||||||
|
uuid->string)
|
||||||
#:export (<file-system>
|
#:export (<file-system>
|
||||||
file-system
|
file-system
|
||||||
file-system?
|
file-system?
|
||||||
|
@ -41,7 +41,6 @@ (define-module (gnu system file-systems)
|
||||||
file-system-dependencies
|
file-system-dependencies
|
||||||
|
|
||||||
file-system->spec
|
file-system->spec
|
||||||
string->uuid
|
|
||||||
uuid
|
uuid
|
||||||
|
|
||||||
%fuse-control-file-system
|
%fuse-control-file-system
|
||||||
|
@ -118,40 +117,6 @@ (define (file-system->spec fs)
|
||||||
(($ <file-system> device title mount-point type flags options _ _ check?)
|
(($ <file-system> device title mount-point type flags options _ _ check?)
|
||||||
(list 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
|
(define-syntax uuid
|
||||||
(lambda (s)
|
(lambda (s)
|
||||||
"Return the bytevector corresponding to the given UUID representation."
|
"Return the bytevector corresponding to the given UUID representation."
|
||||||
|
|
Loading…
Reference in a new issue