Hi! Danny Milosavljevic <dan...@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’.
>From 00d49f0199dc51b02f2113c3669ea07f4461b102 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <l...@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
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)