guix
/
guix
mirror of git://git.savannah.gnu.org/guix.git
3
4
Fork 0
Code Issues Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2018-09-07 09:50:26 +02:00
parent 0012e0dd56
commit 1540075c79
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 37 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
gnu/system/vm.scm
View File

@ -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)

8
tests/guix-system.sh
View File

@ -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