summary refs log tree commit diff
path: root/gnu/system/vm.scm
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/vm.scm
parent051f3254cd56aa8f3cb65a7e35ef8578af2cd3c5 (diff)
downloadguix-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/vm.scm')
-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