diff options
Diffstat (limited to 'gnu/system/vm.scm')
-rw-r--r-- | gnu/system/vm.scm | 67 |
1 files changed, 2 insertions, 65 deletions
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 93a79b12d6..db8bc0f49a 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org> ;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> @@ -73,7 +73,6 @@ #:export (expression->derivation-in-linux-vm qemu-image virtualized-operating-system - system-qemu-image system-qemu-image/shared-store system-qemu-image/shared-store-script @@ -481,7 +480,7 @@ the operating system." (program-file "boot-program" #~(let ((system (cadr (command-line)))) (setenv "GUIX_NEW_SYSTEM" system) - (execl #$(file-append guile-2.2 "/bin/guile") + (execl #$(file-append guile-3.0 "/bin/guile") "guile" "--no-auto-compile" (string-append system "/boot"))))) @@ -559,68 +558,6 @@ the operating system." ;;; -;;; VM and disk images. -;;; - -(define* (system-qemu-image os - #:key - (file-system-type "ext4") - (disk-image-size (* 900 (expt 2 20)))) - "Return the derivation of a freestanding QEMU image of DISK-IMAGE-SIZE bytes -of the GNU system as described by OS." - (define file-systems-to-keep - ;; Keep only file systems other than root and not normally bound to real - ;; devices. - (remove (lambda (fs) - (let ((target (file-system-mount-point fs)) - (source (file-system-device fs))) - (or (string=? target "/") - (and (string? source) - (string-prefix? "/dev/" source)) - (uuid? source) - (file-system-label? source)))) - (operating-system-file-systems os))) - - (define root-uuid - ;; UUID of the root file system. - (operating-system-uuid os - (if (string=? file-system-type "iso9660") - 'iso9660 - 'dce))) - - - (let* ((os (operating-system - (inherit os) - - ;; As in 'virtualized-operating-system', use BIOS-style GRUB. - (bootloader (bootloader-configuration - (bootloader grub-bootloader) - (target "/dev/vda"))) - - ;; Assume we have an initrd with the whole QEMU shebang. - - ;; Force our own root file system. Refer to it by UUID so that - ;; it works regardless of how the image is used ("qemu -hda", - ;; Xen, etc.). - (file-systems (cons (file-system - (mount-point "/") - (device root-uuid) - (type file-system-type)) - file-systems-to-keep)))) - (bootcfg (operating-system-bootcfg os))) - (qemu-image #:os os - #:bootcfg-drv bootcfg - #:bootloader (bootloader-configuration-bootloader - (operating-system-bootloader os)) - #:disk-image-size disk-image-size - #:file-system-type file-system-type - #:file-system-uuid root-uuid - #:inputs `(("system" ,os) - ("bootcfg" ,bootcfg)) - #:copy-inputs? #t))) - - -;;; ;;; VMs that share file systems with the host. ;;; |