system: Introduce a disjoint UUID type.

Conceptually a UUID is just a bytevector.  However, there's software out
there such as GRUB that relies on the string representation of different
UUID types (e.g., the string representation of DCE UUIDs differs from
that of ISO-9660 UUIDs, even if they are actually bytevectors of the
same length).  This new <uuid> record type allows us to preserve
information about the type of UUID so we can eventually convert it to a
string using the right representation.

* gnu/system/uuid.scm (<uuid>): New record type.
(bytevector->uuid): New procedure.
(uuid): Return calls to 'make-uuid'.
(uuid->string): Rewrite using 'match-lambda*' to accept a single 'uuid?'
argument.
* gnu/bootloader/grub.scm (grub-root-search): Check for 'uuid?' instead
of 'bytevector?'.
* gnu/system.scm (bootable-kernel-arguments): Check whether ROOT-DEVICE
is 'uuid?'.
(read-boot-parameters): Use 'bytevector->uuid' when the
store device is a bytevector.
(read-boot-parameters-file): Check for 'uuid?' instead of 'bytevector?'.
(device->sexp): New procedure.
(operating-system-boot-parameters-file): Use it for 'root-device' and
'store'.
(operating-system-bootcfg): Remove conditional in definition of
'root-device'.
* gnu/system/file-systems.scm (file-system->spec): Check for 'uuid?' on
DEVICE and take its bytevector.
* gnu/system/mapped-devices.scm (open-luks-device): Likewise.
* gnu/system/vm.scm (iso9660-image): Call 'uuid-bytevector' for the
 #:volume-uuid argument.

4 files changed, 53 insertions, 14 deletions

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