me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2015-07-14 15:06:46 +02:00
parent 0ec5ee9486
commit 661a1d7924
4 changed files with 121 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile.am
View File

@ -203,6 +203,7 @@ SCM_TESTS = \
tests/lint.scm \
tests/publish.scm \
tests/size.scm \
tests/file-systems.scm \
tests/containers.scm
if HAVE_GUILE_JSON

18
doc/guix.texi
View File

@ -4963,8 +4963,24 @@ interpreted as a file name; when it is @code{label}, then @code{device}
is interpreted as a partition label name; when it is @code{uuid},
@code{device} is interpreted as a partition unique identifier (UUID).
UUIDs may be converted from their string representation (as shown by the
@command{tune2fs -l} command) using the @code{uuid} form, like this:
@example
(file-system
(mount-point "/home")
(type "ext4")
(title 'uuid)
(device (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")))
@end example
The @code{label} and @code{uuid} options offer a way to refer to disk
partitions without having to hard-code their actual device name.
partitions without having to hard-code their actual device
name@footnote{Note that, while it is tempting to use
@file{/dev/disk/by-uuid} and similar device names to achieve the same
result, this is not recommended: These special device nodes are created
by the udev daemon and may be unavailable at the time the device is
mounted.}.
However, when a file system's source is a mapped device (@pxref{Mapped
Devices}), its @code{device} field @emph{must} refer to the mapped

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

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

46
tests/file-systems.scm 100644
View File

@ -0,0 +1,46 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-file-systems)
#:use-module (gnu system file-systems)
#:use-module (srfi srfi-64)
#:use-module (rnrs bytevectors))
;; Test the (gnu system file-systems) module.
(test-begin "file-systems")
(test-equal "uuid->string"
"c5307e6b-d1ba-499d-89c5-cb0b143577c4"
(uuid->string
#vu8(197 48 126 107 209 186 73 157 137 197 203 11 20 53 119 196)))
(test-equal "string->uuid"
'(16 "4dab5feb-d176-45de-b287-9b0a6e4c01cb")
(let ((uuid (string->uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")))
(list (bytevector-length uuid) (uuid->string uuid))))
(test-assert "uuid"
(let ((str "4dab5feb-d176-45de-b287-9b0a6e4c01cb"))
(bytevector=? (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")
(string->uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb"))))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0))