From: ludo@gnu.org (Ludovic Courtès)
To: Danny Milosavljevic <dannym@scratchpost.org>
Cc: 27735@debbugs.gnu.org
Subject: bug#27735: Lookup by UUID
Date: Thu, 20 Jul 2017 00:32:21 +0200 [thread overview]
Message-ID: <87tw28kqh6.fsf_-_@gnu.org> (raw)
In-Reply-To: <20170719211107.51ebe24b@scratchpost.org> (Danny Milosavljevic's message of "Wed, 19 Jul 2017 21:11:07 +0200")
[-- Attachment #1: Type: text/plain, Size: 796 bytes --]
Hi!
Danny Milosavljevic <dannym@scratchpost.org> skribis:
> I think it's a good interim solution.
Based on your feedback I’ve come up with the two attached patches. I’ve
checked at the REPL that ‘operating-system-uuid’ gives reasonable
results for different ‘operating-system’ configs, and deterministic
results for a given config (OSes that are not ‘eq?’ but that are equal.)
On ext4 “guix system disk-image” produces an image that works like a
charm.
With iso9660, it works… by chance, because GRUB’s “search --fs-uuid”
fails. Guess why? Because it compares UUIDs as strings, and we format
it as a DCE UUID instead of an ISO UUID. Sounds familiar no? :-)
So that’s where we are. Thoughts on how to address it?
Cheers,
Ludo’.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: the first patch --]
[-- Type: text/x-patch, Size: 3891 bytes --]
From 00d49f0199dc51b02f2113c3669ea07f4461b102 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 20 Jul 2017 00:15:43 +0200
Subject: [PATCH] vm: Allow partitions to be initialized with a given UUID.
* gnu/build/vm.scm (<partition>)[uuid]: New field.
(create-ext-file-system): Add #:uuid and honor it.
(create-fat-file-system): Add #:uuid.
(format-partition): Add #:uuid and honor it.
(initialize-partition): Honor the 'uuid' field of PARTITION.
---
gnu/build/vm.scm | 26 ++++++++++++++++----------
1 file changed, 16 insertions(+), 10 deletions(-)
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 727494ad9..8dfaf2789 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -163,6 +163,7 @@ the #:references-graphs parameter of 'derivation'."
(size partition-size)
(file-system partition-file-system (default "ext4"))
(label partition-label (default #f))
+ (uuid partition-uuid (default #f))
(flags partition-flags (default '()))
(initializer partition-initializer (default (const #t))))
@@ -236,22 +237,26 @@ actual /dev name based on DEVICE."
(define MS_BIND 4096) ; <sys/mounts.h> again!
(define* (create-ext-file-system partition type
- #:key label)
+ #:key label uuid)
"Create an ext-family filesystem of TYPE on PARTITION. If LABEL is true,
-use that as the volume name."
+use that as the volume name. If UUID is true, use it as the partition UUID."
(format #t "creating ~a partition...\n" type)
(unless (zero? (apply system* (string-append "mkfs." type)
"-F" partition
- (if label
- `("-L" ,label)
- '())))
+ `(,@(if label
+ `("-L" ,label)
+ '())
+ ,@(if uuid
+ `("-U" ,(uuid->string uuid))
+ '()))))
(error "failed to create partition")))
(define* (create-fat-file-system partition
- #:key label)
+ #:key label uuid)
"Create a FAT filesystem on PARTITION. The number of File Allocation Tables
will be determined based on filesystem size. If LABEL is true, use that as the
volume name."
+ ;; FIXME: UUID is ignored!
(format #t "creating FAT partition...\n")
(unless (zero? (apply system* "mkfs.fat" partition
(if label
@@ -260,13 +265,13 @@ volume name."
(error "failed to create FAT partition")))
(define* (format-partition partition type
- #:key label)
+ #:key label uuid)
"Create a file system TYPE on PARTITION. If LABEL is true, use that as the
volume name."
(cond ((string-prefix? "ext" type)
- (create-ext-file-system partition type #:label label))
+ (create-ext-file-system partition type #:label label #:uuid uuid))
((or (string-prefix? "fat" type) (string= "vfat" type))
- (create-fat-file-system partition #:label label))
+ (create-fat-file-system partition #:label label #:uuid uuid))
(else (error "Unsupported file system."))))
(define (initialize-partition partition)
@@ -275,7 +280,8 @@ it, run its initializer, and unmount it."
(let ((target "/fs"))
(format-partition (partition-device partition)
(partition-file-system partition)
- #:label (partition-label partition))
+ #:label (partition-label partition)
+ #:uuid (partition-uuid partition))
(mkdir-p target)
(mount (partition-device partition) target
(partition-file-system partition))
--
2.13.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: Type: text/x-patch, Size: 5013 bytes --]
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 6f979aee4..bd1e1b3e5 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -56,9 +56,12 @@
#:use-module (gnu system file-systems)
#:use-module (gnu system)
#:use-module (gnu services)
+ #:use-module ((gnu build file-systems)
+ #:select (string->iso9660-uuid))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
+ #:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:export (expression->derivation-in-linux-vm
@@ -234,6 +237,7 @@ INPUTS is a list of inputs (as for packages)."
(disk-image-format "qcow2")
(file-system-type "ext4")
file-system-label
+ file-system-uuid
os-drv
bootcfg-drv
bootloader
@@ -293,6 +297,7 @@ the image."
(partitions (list (partition
(size root-size)
(label #$file-system-label)
+ (uuid #$file-system-uuid)
(file-system #$file-system-type)
(flags '(boot))
(initializer initialize))
@@ -330,6 +335,31 @@ the image."
;;; VM and disk images.
;;;
+(define* (operating-system-uuid os #:optional (type 'dce))
+ "Compute a deterministic \"UUID\" for OS, of the given TYPE (one of 'iso9660
+or 'dce)."
+ (if (eq? type 'iso9660)
+ (let ((pad (compose (cut string-pad <> 2 #\0)
+ number->string))
+ (h (hash (operating-system-services os) 3600)))
+ (string->iso9660-uuid
+ (string-append "1970-01-01-"
+ (pad (hash (operating-system-host-name os) 24)) "-"
+ (pad (quotient h 60)) "-"
+ (pad (modulo h 60)) "-"
+ (pad (hash (operating-system-file-systems os) 100)))))
+ (uint-list->bytevector
+ (list (hash file-system-type
+ (expt 2 32))
+ (hash (operating-system-host-name os)
+ (expt 2 32))
+ (hash (operating-system-services os)
+ (expt 2 32))
+ (hash (operating-system-file-systems os)
+ (expt 2 32)))
+ (endianness little)
+ 4)))
+
(define* (system-disk-image os
#:key
(name "disk-image")
@@ -346,12 +376,20 @@ to USB sticks meant to be read-only."
(if (string=? "iso9660" file-system-type)
string-upcase
identity))
+
(define root-label
- ;; Volume name of the root file system. Since we don't know which device
- ;; will hold it, we use the volume name to find it (using the UUID would
- ;; be even better, but somewhat less convenient.)
+ ;; Volume name of the root file system.
(normalize-label "GuixSD_image"))
+ (define root-uuid
+ ;; UUID of the root file system, computed in a deterministic fashion.
+ ;; This is what we use to locate the root file system so it has to be
+ ;; different from the user's own file system UUIDs.
+ (operating-system-uuid os
+ (if (string=? file-system-type "iso9660")
+ 'iso9660
+ 'dce)))
+
(define file-systems-to-keep
(remove (lambda (fs)
(string=? (file-system-mount-point fs) "/"))
@@ -369,8 +407,8 @@ to USB sticks meant to be read-only."
;; Force our own root file system.
(file-systems (cons (file-system
(mount-point "/")
- (device root-label)
- (title 'label)
+ (device root-uuid)
+ (title 'uuid)
(type file-system-type))
file-systems-to-keep)))))
@@ -379,7 +417,7 @@ to USB sticks meant to be read-only."
(if (string=? "iso9660" file-system-type)
(iso9660-image #:name name
#:file-system-label root-label
- #:file-system-uuid #f
+ #:file-system-uuid root-uuid
#:os-drv os-drv
#:bootcfg-drv bootcfg
#:bootloader (bootloader-configuration-bootloader
@@ -398,6 +436,7 @@ to USB sticks meant to be read-only."
"ext4"
file-system-type)
#:file-system-label root-label
+ #:file-system-uuid root-uuid
#:copy-inputs? #t
#:register-closures? #t
#:inputs `(("system" ,os-drv)
next prev parent reply other threads:[~2017-07-19 22:33 UTC|newest]
Thread overview: 20+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-07-17 14:40 bug#27735: Unbootable images with GuixSD on... "GuixSD" Tobias Geerinckx-Rice
2017-07-17 14:51 ` bug#27735: [PATCH 1/2] build, vm: Use a slightly less generic label Tobias Geerinckx-Rice
2017-07-17 17:20 ` Danny Milosavljevic
2017-07-17 17:58 ` Tobias Geerinckx-Rice
2017-07-18 10:09 ` Ludovic Courtès
2017-07-18 12:30 ` Tobias Geerinckx-Rice
2017-07-18 13:48 ` Danny Milosavljevic
2017-07-17 17:17 ` bug#27735: Unbootable images with GuixSD on... "GuixSD" Danny Milosavljevic
2017-07-17 18:12 ` Tobias Geerinckx-Rice
2017-07-17 18:37 ` Tobias Geerinckx-Rice
2017-07-18 11:49 ` Ludovic Courtès
2017-07-18 15:09 ` Tobias Geerinckx-Rice
2017-07-18 18:59 ` Ludovic Courtès
2017-07-18 20:42 ` Tobias Geerinckx-Rice
2017-07-19 19:11 ` Danny Milosavljevic
2017-07-19 22:32 ` Ludovic Courtès [this message]
2017-07-20 17:38 ` bug#27735: Lookup by UUID Danny Milosavljevic
2017-07-20 20:32 ` Ludovic Courtès
2017-07-20 21:51 ` Danny Milosavljevic
2017-08-05 17:50 ` Danny Milosavljevic
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87tw28kqh6.fsf_-_@gnu.org \
--to=ludo@gnu.org \
--cc=27735@debbugs.gnu.org \
--cc=dannym@scratchpost.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).