diff options
Diffstat (limited to 'gnu/system')
-rw-r--r-- | gnu/system/image.scm | 1 | ||||
-rw-r--r-- | gnu/system/vm.scm | 62 |
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. |