From 1540075c790dfaeff52c93392f2fc63b9e23b77e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 7 Sep 2018 09:50:26 +0200 Subject: vm: Make UUID computation really deterministic. Fixes . * gnu/system/vm.scm (operating-system-uuid)[service-name, file-system-digest]: New procedures. Map these over services and file systems and hash the result. * tests/guix-system.sh: Add test. --- gnu/system/vm.scm | 33 +++++++++++++++++++++++++++++---- 1 file changed, 29 insertions(+), 4 deletions(-) (limited to 'gnu') diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 3898872a46..91e117b9f3 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -529,17 +529,42 @@ should set REGISTER-CLOSURES? to #f." (define* (operating-system-uuid os #:optional (type 'dce)) "Compute UUID object with a deterministic \"UUID\" for OS, of the given TYPE (one of 'iso9660 or 'dce). Return a UUID object." + ;; Note: For this to be deterministic, we must not hash things that contains + ;; (directly or indirectly) procedures, for example. That rules out + ;; anything that contains gexps, thunk or delayed record fields, etc. + + (define service-name + (compose service-type-name service-kind)) + + (define (file-system-digest fs) + ;; Return a hashable digest that does not contain 'dependencies' since + ;; this field can contain procedures. + (let ((device (file-system-device fs))) + (list (file-system-mount-point fs) + (file-system-type fs) + (cond ((file-system-label? device) + (file-system-label->string device)) + ((uuid? device) + (uuid->string device)) + ((string? device) + device) + (else #f)) + (file-system-options fs)))) + (if (eq? type 'iso9660) (let ((pad (compose (cut string-pad <> 2 #\0) number->string)) - (h (hash (operating-system-services os) 3600))) + (h (hash (map service-name (operating-system-services os)) + 3600))) (bytevector->uuid (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)))) + (pad (hash (map file-system-digest + (operating-system-file-systems os)) + 100)))) 'iso9660)) (bytevector->uuid (uint-list->bytevector @@ -547,9 +572,9 @@ TYPE (one of 'iso9660 or 'dce). Return a UUID object." (- (expt 2 32) 1)) (hash (operating-system-host-name os) (- (expt 2 32) 1)) - (hash (operating-system-services os) + (hash (map service-name (operating-system-services os)) (- (expt 2 32) 1)) - (hash (operating-system-file-systems os) + (hash (map file-system-digest (operating-system-file-systems os)) (- (expt 2 32) 1))) (endianness little) 4) -- cgit 1.4.1