From f8865db6a002c9b968d39d0d91524edf55e0d873 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 1 Jan 2016 22:41:35 +0100 Subject: 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 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 45 insertions(+), 1 deletion(-) (limited to 'gnu/build') 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: -- cgit v1.2.3 From f453f637d5410f4d1e0b3787caa8d34b9b72d7d8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 1 Jan 2016 22:45:58 +0100 Subject: system: Allow the root file system to be named by UUID. * gnu/build/file-systems.scm (canonicalize-device-spec)[canonical-title]: Use 'string->uuid' to check whether SPEC is a UUID. When SPEC is a string and CANONICAL-TITLE is 'uuid, call 'string->uuid'. * gnu/system.scm (operating-system-grub.cfg): Add 'root-device' variable and use it for the "--root=" argument. --- gnu/build/file-systems.scm | 15 +++++++++++---- gnu/system.scm | 6 ++++-- 2 files changed, 15 insertions(+), 6 deletions(-) (limited to 'gnu/build') diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index d83a4f6015..f8b8697b46 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -295,9 +295,12 @@ (define canonical-title ;; The realm of canonicalization. (if (eq? title 'any) (if (string? spec) - (if (string-prefix? "/" spec) - 'device - 'label) + ;; The "--root=SPEC" kernel command-line option always provides a + ;; string, but the string can represent a device, a UUID, or a + ;; label. So check for all three. + (cond ((string-prefix? "/" spec) 'device) + ((string->uuid spec) 'uuid) + (else 'label)) 'uuid) title)) @@ -323,7 +326,11 @@ (define (resolve find-partition spec fmt) ;; Resolve the label. (resolve find-partition-by-label spec identity)) ((uuid) - (resolve find-partition-by-uuid spec uuid->string)) + (resolve find-partition-by-uuid + (if (string? spec) + (string->uuid spec) + spec) + uuid->string)) (else (error "unknown device title" title)))) diff --git a/gnu/system.scm b/gnu/system.scm index acb7f15e4e..6dfcc0fe3a 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -673,12 +673,14 @@ (define* (operating-system-grub.cfg os #:optional (old-entries '())) ((system (operating-system-derivation os)) (root-fs -> (operating-system-root-file-system os)) (kernel -> (operating-system-kernel os)) + (root-device -> (if (eq? 'uuid (file-system-title root-fs)) + (uuid->string (file-system-device root-fs)) + (file-system-device root-fs))) (entries -> (list (menu-entry (label (kernel->grub-label kernel)) (linux kernel) (linux-arguments - (cons* (string-append "--root=" - (file-system-device root-fs)) + (cons* (string-append "--root=" root-device) #~(string-append "--system=" #$system) #~(string-append "--load=" #$system "/boot") -- cgit v1.2.3