diff options
Diffstat (limited to 'gnu/system.scm')
| -rw-r--r-- | gnu/system.scm | 50 |
1 files changed, 50 insertions, 0 deletions
diff --git a/gnu/system.scm b/gnu/system.scm index 99ce66aa4f..cd75e4d4ba 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -120,6 +120,7 @@ operating-system-etc-directory operating-system-locale-directory operating-system-boot-script + operating-system-uuid system-linux-image-file-name operating-system-with-gc-roots @@ -984,6 +985,55 @@ we're running in the final root." #:mapped-devices mapped-devices #:keyboard-layout (operating-system-keyboard-layout os))) +(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) + (file-system-device->string device) + (file-system-options fs)))) + + (if (eq? type 'iso9660) + (let ((pad (compose (cut string-pad <> 2 #\0) + number->string)) + (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 (map file-system-digest + (operating-system-file-systems os)) + 100)))) + 'iso9660)) + (bytevector->uuid + (uint-list->bytevector + (list (hash (map file-system-digest + (operating-system-file-systems os)) + (- (expt 2 32) 1)) + (hash (operating-system-host-name os) + (- (expt 2 32) 1)) + (hash (map service-name (operating-system-services os)) + (- (expt 2 32) 1)) + (hash (map file-system-digest (operating-system-file-systems os)) + (- (expt 2 32) 1))) + (endianness little) + 4) + type))) + (define (locale-name->definition* name) "Variant of 'locale-name->definition' that raises an error upon failure." (match (locale-name->definition name) |