summary refs log tree commit diff
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.