amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

system: vm: Move operating-system-uuid.

Browse source 
* gnu/system/vm.scm (operating-system-uuid): Move to ...
* gnu/system.scm: ... here.
This commit is contained in:
Mathieu Othacehe 2020-04-28 14:12:34 +02:00
parent 051f3254cd
commit 78fbf2bd70
No known key found for this signature in database
GPG key ID: 8354763531769CA6
2 changed files with 50 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

48
gnu/system/vm.scm
View file

@ -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