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)