diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2018-09-07 09:50:26 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2018-09-07 11:40:05 +0200 |
| commit | 1540075c790dfaeff52c93392f2fc63b9e23b77e (patch) | |
| tree | dc9c011af6bd8a6cdde92f84e0eb5ed9da957c6e | |
| parent | 0012e0dd5642fbbb8ee40a68f65afc184952fc98 (diff) | |
| download | patches-1540075c790dfaeff52c93392f2fc63b9e23b77e.tar patches-1540075c790dfaeff52c93392f2fc63b9e23b77e.tar.gz | |
vm: Make UUID computation really deterministic.
Fixes <https://bugs.gnu.org/32652>.
* 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.
| -rw-r--r-- | gnu/system/vm.scm | 33 | ||||
| -rw-r--r-- | tests/guix-system.sh | 8 |
2 files changed, 37 insertions, 4 deletions
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) diff --git a/tests/guix-system.sh b/tests/guix-system.sh index 36ba5fbd5f..a129efdfcb 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -232,6 +232,14 @@ guix system build "$tmpfile" -d | grep '\.drv$' guix system vm "$tmpfile" -d # succeeds guix system vm "$tmpfile" -d | grep '\.drv$' +# Make sure the behavior is deterministic (<https://bugs.gnu.org/32652>). +drv1="`guix system vm "$tmpfile" -d`" +drv2="`guix system vm "$tmpfile" -d`" +test "$drv1" = "$drv2" +drv1="`guix system disk-image --file-system-type=iso9660 "$tmpfile" -d`" +drv2="`guix system disk-image --file-system-type=iso9660 "$tmpfile" -d`" +test "$drv1" = "$drv2" + make_user_config "group-that-does-not-exist" "users" if guix system build "$tmpfile" -n 2> "$errorfile" then false |