summaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/image.scm1
-rw-r--r--gnu/system/vm.scm62
2 files changed, 62 insertions, 1 deletions
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 5456b3a5a0..3082bcff46 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -72,6 +72,7 @@
#:export (root-offset
root-label
image-without-os
+ operating-system-for-image
esp-partition
esp32-partition
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index ef4c180058..fcfd1cdb48 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -71,6 +71,8 @@
#:export (virtualized-operating-system
system-qemu-image/shared-store-script
+ linux-image-startup-command
+
virtual-machine
virtual-machine?
virtual-machine-operating-system
@@ -132,7 +134,8 @@
(check? #f)
(create-mount-point? #t)))))
-(define* (virtualized-operating-system os mappings
+(define* (virtualized-operating-system os
+ #:optional (mappings '())
#:key (full-boot? #f) volatile?)
"Return an operating system based on OS suitable for use in a virtualized
environment with the store shared with the host. MAPPINGS is a list of
@@ -316,6 +319,63 @@ useful when FULL-BOOT? is true."
(gexp->derivation "run-vm.sh" builder)))
+(define* (linux-image-startup-command image
+ #:key
+ (system (%current-system))
+ (target #f)
+ (qemu qemu-minimal)
+ (graphic? #f)
+ (cpu "max")
+ (cpu-count 1)
+ (memory-size 1024)
+ (port-forwardings '())
+ (date #f))
+ "Return a list-valued gexp representing the command to start QEMU to run
+IMAGE, assuming it uses the Linux kernel, and not sharing the store with the
+host."
+ (define os
+ ;; Note: 'image-operating-system' would return the wrong OS, before
+ ;; its root partition has been assigned a UUID.
+ (operating-system-for-image image))
+
+ (define kernel-arguments
+ #~(list #$@(if graphic? #~() #~("console=ttyS0"))
+ #+@(operating-system-kernel-arguments os "/dev/vda1")))
+
+ #~`(#+(file-append qemu "/bin/"
+ (qemu-command (or target system)))
+ ,@(if (access? "/dev/kvm" (logior R_OK W_OK))
+ '("-enable-kvm")
+ '())
+
+ "-cpu" #$cpu
+ #$@(if (> cpu-count 1)
+ #~("-smp" #$(string-append "cpus=" (number->string cpu-count)))
+ #~())
+ "-m" #$(number->string memory-size)
+ "-nic" #$(string-append
+ "user,model=virtio-net-pci,"
+ (port-forwardings->qemu-options port-forwardings))
+ "-kernel" #$(operating-system-kernel-file os)
+ "-initrd" #$(file-append os "/initrd")
+ "-append" ,(string-join #$kernel-arguments)
+ "-serial" "stdio"
+
+ #$@(if date
+ #~("-rtc"
+ #$(string-append "base=" (date->string date "~5")))
+ #~())
+
+ "-object" "rng-random,filename=/dev/urandom,id=guix-vm-rng"
+ "-device" "virtio-rng-pci,rng=guix-vm-rng"
+
+ "-drive"
+ ,(string-append "file=" #$(system-image image)
+ ",format=qcow2,if=virtio,"
+ "cache=writeback,werror=report,readonly=off")
+ "-snapshot"
+ "-no-reboot"))
+
;;;
;;; High-level abstraction.