02/05: system: Allow the root file system to have a UUID.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 29824d80ec3b86bcf68afc1a9d903e2a3c479533
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jan 1 22:29:33 2016 +0100

    system: Allow the root file system to have a UUID.
    
    This is a followup to ab64483.
    
    * gnu/system.scm (mapped-device-user): Check whether the title of FS is
    'device before calling 'string=?'.
    * gnu/system/vm.scm (virtualized-operating-system)[user-file-systems]:
    Likewise.
---
 gnu/system.scm    |    7 ++++---
 gnu/system/vm.scm |    5 +++--
 2 files changed, 7 insertions(+), 5 deletions(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index 6f7500f..acb7f15 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <address@hidden>
+;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2015 Mark H Weaver <address@hidden>
 ;;; Copyright © 2015 Alex Kost <address@hidden>
 ;;;
@@ -193,7 +193,7 @@ as 'needed-for-boot'."
 
   (define (device-mappings fs)
     (let ((device (file-system-device fs)))
-      (if (string? device)
+      (if (string? device)                        ;title is 'device
           (filter (lambda (md)
                     (string=? (string-append "/dev/mapper/"
                                              (mapped-device-target md))
@@ -216,7 +216,8 @@ as 'needed-for-boot'."
   "Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."
   (let ((target (string-append "/dev/mapper/" (mapped-device-target device))))
     (find (lambda (fs)
-            (string=? (file-system-device fs) target))
+            (and (eq? 'device (file-system-title fs))
+                 (string=? (file-system-device fs) target)))
           file-systems)))
 
 (define (operating-system-user-mapped-devices os)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 1492a0b..3cba400 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <address@hidden>
+;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -391,7 +391,8 @@ environment with the store shared with the host.  MAPPINGS 
is a list of
                     (source (file-system-device fs)))
                 (or (string=? target (%store-prefix))
                     (string=? target "/")
-                    (string-prefix? "/dev/" source))))
+                    (and (eq? 'device (file-system-title fs))
+                         (string-prefix? "/dev/" source)))))
             (operating-system-file-systems os)))
 
   (operating-system (inherit os)