system: vm: Remove unused system-disk-image-in-vm.

* gnu/system/vm.scm (system-disk-image-in-vm): Remove.

Reported-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Maxim Cournoyer 2020-11-17 14:09:57 -05:00
parent 41f27bf870
commit 19d4693939
No known key found for this signature in database
GPG key ID: 1260E46482E63562

View file

@ -77,7 +77,6 @@ (define-module (gnu system vm)
system-qemu-image/shared-store
system-qemu-image/shared-store-script
system-disk-image-in-vm
system-docker-image
virtual-machine
@ -563,77 +562,6 @@ (define build
;;; VM and disk images.
;;;
(define* (system-disk-image-in-vm os
#:key
(name "disk-image")
(file-system-type "ext4")
(disk-image-size (* 900 (expt 2 20)))
(volatile? #t)
(substitutable? #t))
"Return the derivation of a disk image of DISK-IMAGE-SIZE bytes of the
system described by OS. Said image can be copied on a USB stick as is. When
VOLATILE? is true, the root file system is made volatile; this is useful
to USB sticks meant to be read-only.
SUBSTITUTABLE? determines whether the returned derivation should be marked as
substitutable."
(define root-label
"Guix_image")
(define (root-uuid os)
;; UUID of the root file system, computed in a deterministic fashion.
;; This is what we use to locate the root file system so it has to be
;; different from the user's own file system UUIDs.
(operating-system-uuid os 'dce))
(define file-systems-to-keep
(remove (lambda (fs)
(string=? (file-system-mount-point fs) "/"))
(operating-system-file-systems os)))
(let* ((os (operating-system (inherit os)
;; Since this is meant to be used on real hardware, don't
;; install QEMU networking or anything like that. Assume USB
;; mass storage devices (usb-storage.ko) are available.
(initrd (lambda (file-systems . rest)
(apply (operating-system-initrd os)
file-systems
#:volatile-root? volatile?
rest)))
(bootloader (operating-system-bootloader os))
;; Force our own root file system. (We need a "/" file system
;; to call 'root-uuid'.)
(file-systems (cons (file-system
(mount-point "/")
(device "/dev/placeholder")
(type file-system-type))
file-systems-to-keep))))
(uuid (root-uuid os))
(os (operating-system
(inherit os)
(file-systems (cons (file-system
(mount-point "/")
(device uuid)
(type file-system-type))
file-systems-to-keep))))
(bootcfg (operating-system-bootcfg os)))
(qemu-image #:name name
#:os os
#:bootcfg-drv bootcfg
#:bootloader (bootloader-configuration-bootloader
(operating-system-bootloader os))
#:disk-image-size disk-image-size
#:disk-image-format "raw"
#:file-system-type file-system-type
#:file-system-label root-label
#:file-system-uuid uuid
#:copy-inputs? #t
#:inputs `(("system" ,os)
("bootcfg" ,bootcfg))
#:substitutable? substitutable?)))
(define* (system-qemu-image os
#:key
(file-system-type "ext4")