[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/07: system: vm: Move operating-system-uuid.
From: |
guix-commits |
Subject: |
01/07: system: vm: Move operating-system-uuid. |
Date: |
Tue, 5 May 2020 10:14:36 -0400 (EDT) |
mothacehe pushed a commit to branch master
in repository guix.
commit 78fbf2bd70e8af00a3ce5b05a5e25258e34f84cc
Author: Mathieu Othacehe <address@hidden>
AuthorDate: Tue Apr 28 14:12:34 2020 +0200
system: vm: Move operating-system-uuid.
* gnu/system/vm.scm (operating-system-uuid): Move to ...
* gnu/system.scm: ... here.
---
gnu/system.scm | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++
gnu/system/vm.scm | 48 ------------------------------------------------
2 files changed, 50 insertions(+), 48 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index 107b93d..0c5d5df 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
@@ -989,6 +990,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)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 6f81ac1..2fdf954 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
- branch master updated (051f325 -> 77f5296), guix-commits, 2020/05/05
- 01/07: system: vm: Move operating-system-uuid.,
guix-commits <=
- 02/07: build: store-copy: Export file-size procedure., guix-commits, 2020/05/05
- 03/07: build: install: Ignore chown exceptions., guix-commits, 2020/05/05
- 06/07: image: Add a new API., guix-commits, 2020/05/05
- 05/07: build: bootloader: Add install-efi procedure., guix-commits, 2020/05/05
- 07/07: vm: Remove obsolete procedures., guix-commits, 2020/05/05
- 04/07: build: install: Do not set store GID., guix-commits, 2020/05/05