diff options
author | Mathieu Othacehe <m.othacehe@gmail.com> | 2020-04-28 14:12:34 +0200 |
---|---|---|
committer | Mathieu Othacehe <m.othacehe@gmail.com> | 2020-05-05 16:08:32 +0200 |
commit | 78fbf2bd70e8af00a3ce5b05a5e25258e34f84cc (patch) | |
tree | 5147828e78aca6389e0339bf867710fea72e5074 /gnu/system/vm.scm | |
parent | 051f3254cd56aa8f3cb65a7e35ef8578af2cd3c5 (diff) |
system: vm: Move operating-system-uuid.
* gnu/system/vm.scm (operating-system-uuid): Move to ...
* gnu/system.scm: ... here.
Diffstat (limited to 'gnu/system/vm.scm')
-rw-r--r-- | gnu/system/vm.scm | 48 |
1 files changed, 0 insertions, 48 deletions
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 6f81ac16ff..2fdf954883 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -604,54 +604,6 @@ system." ;;; VM and disk images. ;;; -(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* (system-disk-image os #:key |