aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/bootloader/grub.scm4
-rw-r--r--gnu/system.scm38
-rw-r--r--gnu/system/file-systems.scm8
-rw-r--r--gnu/system/mapped-devices.scm7
-rw-r--r--gnu/system/uuid.scm48
-rw-r--r--gnu/system/vm.scm4
6 files changed, 82 insertions, 27 deletions
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index a9f0875f36..96e53c5c2b 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -30,7 +30,7 @@
#:use-module (gnu artwork)
#:use-module (gnu system)
#:use-module (gnu bootloader)
- #:use-module (gnu system file-systems)
+ #:use-module (gnu system uuid)
#:autoload (gnu packages bootloaders) (grub)
#:autoload (gnu packages compression) (gzip)
#:autoload (gnu packages gtk) (guile-cairo guile-rsvg)
@@ -300,7 +300,7 @@ code."
(match device
;; Preferably refer to DEVICE by its UUID or label. This is more
;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
- ((? bytevector? uuid)
+ ((? uuid? uuid)
(format #f "search --fs-uuid --set ~a"
(uuid->string device)))
((? string? label)
diff --git a/gnu/system.scm b/gnu/system.scm
index 6b35e3c0c7..a8d2a81316 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -54,6 +54,7 @@
#:use-module (gnu system locale)
#:use-module (gnu system pam)
#:use-module (gnu system linux-initrd)
+ #:use-module (gnu system uuid)
#:use-module (gnu system file-systems)
#:use-module (gnu system mapped-devices)
#:use-module (ice-9 match)
@@ -128,7 +129,14 @@
(define (bootable-kernel-arguments kernel-arguments system.drv root-device)
"Prepend extra arguments to KERNEL-ARGUMENTS that allow SYSTEM.DRV to be
booted from ROOT-DEVICE"
- (cons* (string-append "--root=" root-device)
+ (cons* (string-append "--root="
+ (if (uuid? root-device)
+
+ ;; Note: Always use the DCE format because that's
+ ;; what (gnu build linux-boot) expects for the
+ ;; '--root' kernel command-line option.
+ (uuid->string (uuid-bytevector root-device) 'dce)
+ root-device))
#~(string-append "--system=" #$system.drv)
#~(string-append "--load=" #$system.drv "/boot")
kernel-arguments))
@@ -261,6 +269,8 @@ directly by the user."
(store-device
(match (assq 'store rest)
+ (('store ('device (? bytevector? bv)) _ ...)
+ (bytevector->uuid bv))
(('store ('device device) _ ...)
device)
(_ ;the old format
@@ -289,16 +299,12 @@ The object has its kernel-arguments extended in order to make it bootable."
(let* ((file (string-append system "/parameters"))
(params (call-with-input-file file read-boot-parameters))
(root (boot-parameters-root-device params))
- (root-device (if (bytevector? root)
- (uuid->string root)
- root))
(kernel-arguments (boot-parameters-kernel-arguments params)))
(if params
(boot-parameters
(inherit params)
(kernel-arguments (bootable-kernel-arguments kernel-arguments
- system
- root-device)))
+ system root)))
#f)))
(define (boot-parameters->menu-entry conf)
@@ -875,9 +881,7 @@ listed in OS. The C library expects to find it under
(mlet* %store-monad
((system (operating-system-derivation os))
(root-fs -> (operating-system-root-file-system os))
- (root-device -> (if (eq? 'uuid (file-system-title root-fs))
- (uuid->string (file-system-device root-fs))
- (file-system-device root-fs)))
+ (root-device -> (file-system-device root-fs))
(params (operating-system-boot-parameters os system root-device))
(entry -> (boot-parameters->menu-entry params))
(bootloader-conf -> (operating-system-bootloader os)))
@@ -917,6 +921,15 @@ kernel arguments for that derivation to <boot-parameters>."
(store-device (fs->boot-device store))
(store-mount-point (file-system-mount-point store))))))
+(define (device->sexp device)
+ "Serialize DEVICE as an sexp (really, as an object with a read syntax.)"
+ (match device
+ ((? uuid? uuid)
+ ;; TODO: Preserve the type of UUID.
+ (uuid-bytevector uuid))
+ (_
+ device)))
+
(define* (operating-system-boot-parameters-file os #:optional (system.drv #f))
"Return a file that describes the boot parameters of OS. The primary use of
this file is the reconstruction of GRUB menu entries for old configurations.
@@ -934,14 +947,17 @@ being stored into the \"parameters\" file)."
#~(boot-parameters
(version 0)
(label #$(boot-parameters-label params))
- (root-device #$(boot-parameters-root-device params))
+ (root-device
+ #$(device->sexp
+ (boot-parameters-root-device params)))
(kernel #$(boot-parameters-kernel params))
(kernel-arguments
#$(boot-parameters-kernel-arguments params))
(initrd #$(boot-parameters-initrd params))
(bootloader-name #$(boot-parameters-bootloader-name params))
(store
- (device #$(boot-parameters-store-device params))
+ (device
+ #$(device->sexp (boot-parameters-store-device params)))
(mount-point #$(boot-parameters-store-mount-point params))))
#:set-load-path? #f)))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index dd30559d7e..52f16676f5 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -20,8 +20,7 @@
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (guix records)
- #:use-module ((gnu system uuid)
- #:select (uuid string->uuid uuid->string))
+ #:use-module (gnu system uuid)
#:re-export (uuid ;backward compatibility
string->uuid
uuid->string)
@@ -157,7 +156,10 @@ store--e.g., if FS is the root file system."
initrd code."
(match fs
(($ <file-system> device title mount-point type flags options _ _ check?)
- (list device title mount-point type flags options check?))))
+ (list (if (uuid? device)
+ (uuid-bytevector device)
+ device)
+ title mount-point type flags options check?))))
(define (spec->file-system sexp)
"Deserialize SEXP, a list, to the corresponding <file-system> object."
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index 18b9f5b4b6..17cf6b7163 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2017 Mark H Weaver <mhw@netris.org>
;;;
@@ -24,6 +24,7 @@
#:use-module (guix modules)
#:use-module (gnu services)
#:use-module (gnu services shepherd)
+ #:use-module (gnu system uuid)
#:autoload (gnu packages cryptsetup) (cryptsetup-static)
#:autoload (gnu packages linux) (mdadm-static)
#:use-module (srfi srfi-1)
@@ -99,7 +100,9 @@
'cryptsetup'."
(with-imported-modules (source-module-closure
'((gnu build file-systems)))
- #~(let ((source #$source))
+ #~(let ((source #$(if (uuid? source)
+ (uuid-bytevector source)
+ source)))
;; XXX: 'use-modules' should be at the top level.
(use-modules (rnrs bytevectors) ;bytevector?
((gnu build file-systems)
diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm
index 64dad5a374..60626ebb12 100644
--- a/gnu/system/uuid.scm
+++ b/gnu/system/uuid.scm
@@ -19,12 +19,19 @@
(define-module (gnu system uuid)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:use-module (ice-9 vlist)
#:use-module (ice-9 regex)
#:use-module (ice-9 format)
#:export (uuid
+ uuid?
+ uuid-type
+ uuid-bytevector
+
+ bytevector->uuid
+
uuid->string
dce-uuid->string
string->uuid
@@ -206,15 +213,27 @@ corresponding bytevector; otherwise return #f."
(#f #f)
((_ . (? procedure? parse)) (parse str))))
-(define* (uuid->string bv #:key (type 'dce))
- "Convert BV, a bytevector, to the UUID string representation for TYPE."
- (match (vhash-assq type %uuid-printers)
- (#f #f)
- ((_ . (? procedure? unparse)) (unparse bv))))
+;; High-level UUID representation that carries its type with it.
+;;
+;; This is necessary to serialize bytevectors with the right printer in some
+;; circumstances. For instance, GRUB "search --fs-uuid" command compares the
+;; string representation of UUIDs, not the raw bytes; thus, when emitting a
+;; GRUB 'search' command, we need to procedure the right string representation
+;; (see <https://debbugs.gnu.org/cgi/bugreport.cgi?msg=52;att=0;bug=27735>).
+(define-record-type <uuid>
+ (make-uuid type bv)
+ uuid?
+ (type uuid-type) ;'dce | 'iso9660 | ...
+ (bv uuid-bytevector))
+
+(define* (bytevector->uuid bv #:optional (type 'dce))
+ "Return a UUID object make of BV and TYPE."
+ (make-uuid type bv))
(define-syntax uuid
(lambda (s)
- "Return the bytevector corresponding to the given UUID representation."
+ "Return the UUID object corresponding to the given UUID representation."
+ ;; TODO: Extend to types other than DCE.
(syntax-case s ()
((_ str)
(string? (syntax->datum #'str))
@@ -222,6 +241,19 @@ corresponding bytevector; otherwise return #f."
(let ((bv (string->uuid (syntax->datum #'str))))
(unless bv
(syntax-violation 'uuid "invalid UUID" s))
- (datum->syntax #'str bv)))
+ #`(make-uuid 'dce #,(datum->syntax #'str bv))))
((_ str)
- #'(string->uuid str)))))
+ #'(make-uuid 'dce (string->uuid str))))))
+
+(define uuid->string
+ ;; Convert the given bytevector or UUID object, to the corresponding UUID
+ ;; string representation.
+ (match-lambda*
+ (((? bytevector? bv))
+ (uuid->string bv 'dce))
+ (((? bytevector? bv) type)
+ (match (vhash-assq type %uuid-printers)
+ (#f #f)
+ ((_ . (? procedure? unparse)) (unparse bv))))
+ (((? uuid? uuid))
+ (uuid->string (uuid-bytevector uuid) (uuid-type uuid)))))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index b106dff0a8..92f0444ed8 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -57,6 +57,7 @@
#:use-module (gnu system file-systems)
#:use-module (gnu system)
#:use-module (gnu services)
+ #:use-module (gnu system uuid)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -231,7 +232,8 @@ INPUTS is a list of inputs (as for packages)."
#:register-closures? #$register-closures?
#:closures graphs
#:volume-id #$file-system-label
- #:volume-uuid #$file-system-uuid)
+ #:volume-uuid #$(and=> file-system-uuid
+ uuid-bytevector))
(reboot))))
#:system system
#:make-disk-image? #f