aboutsummaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
authorMathieu Othacehe <m.othacehe@gmail.com>2020-04-28 14:12:34 +0200
committerMathieu Othacehe <m.othacehe@gmail.com>2020-05-05 16:08:32 +0200
commit78fbf2bd70e8af00a3ce5b05a5e25258e34f84cc (patch)
tree5147828e78aca6389e0339bf867710fea72e5074 /gnu/system
parent051f3254cd56aa8f3cb65a7e35ef8578af2cd3c5 (diff)
downloadpatches-78fbf2bd70e8af00a3ce5b05a5e25258e34f84cc.tar
patches-78fbf2bd70e8af00a3ce5b05a5e25258e34f84cc.tar.gz
system: vm: Move operating-system-uuid.
* gnu/system/vm.scm (operating-system-uuid): Move to ... * gnu/system.scm: ... here.
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/vm.scm48
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