vm: Support 'guix system vm --full-boot'.
* gnu/system/vm.scm (system-qemu-image/shared-store-script): Add #:full-boot? parameter and honor it. * guix/scripts/system.scm (system-derivation-for-action): Likewise. (perform-action): Likewise. (show-help): Document '--full-boot'. (%options): Add '--full-boot'. (guix-system): Add #:full-boot? argument in call to 'perform-action'. * doc/guix.texi (Invoking guix system): Document it.
This commit is contained in:
parent
c1941588dd
commit
ab11f0bed4
|
@ -4151,6 +4151,10 @@ Build a virtual machine that contain the operating system declared in
|
|||
|
||||
The VM shares its store with the host system.
|
||||
|
||||
On GNU/Linux, the default is to boot directly to the kernel. The
|
||||
@code{--full-boot} option forces a complete boot sequence, starting with
|
||||
the bootloader.
|
||||
|
||||
@item vm-image
|
||||
@itemx disk-image
|
||||
Return a virtual machine or disk image of the operating system declared
|
||||
|
|
|
@ -402,13 +402,15 @@ with the host."
|
|||
",if=virtio,cache=writeback,werror=report,readonly \
|
||||
-m 256\n"))
|
||||
|
||||
(define* (system-qemu-image/shared-store-script
|
||||
os
|
||||
(define* (system-qemu-image/shared-store-script os
|
||||
#:key
|
||||
(qemu qemu)
|
||||
(graphic? #t))
|
||||
(graphic? #t)
|
||||
full-boot?)
|
||||
"Return a derivation that builds a script to run a virtual machine image of
|
||||
OS that shares its store with the host."
|
||||
OS that shares its store with the host. When FULL-BOOT? is true, the returned
|
||||
script runs everything starting from the bootloader; otherwise it directly
|
||||
starts the operating system kernel."
|
||||
(mlet* %store-monad
|
||||
((os -> (virtualized-operating-system os))
|
||||
(os-drv (operating-system-derivation os))
|
||||
|
@ -419,11 +421,14 @@ OS that shares its store with the host."
|
|||
(display
|
||||
(string-append "#!" #$bash "/bin/sh
|
||||
exec " #$qemu "/bin/" #$(qemu-command (%current-system))
|
||||
" -kernel " #$(operating-system-kernel os) "/bzImage \
|
||||
|
||||
#$@(if full-boot?
|
||||
#~()
|
||||
#~(" -kernel " #$(operating-system-kernel os) "/bzImage \
|
||||
-initrd " #$os-drv "/initrd \
|
||||
-append \"" #$(if graphic? "" "console=ttyS0 ")
|
||||
"--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1\" "
|
||||
#$(common-qemu-options image))
|
||||
"--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1\" "))
|
||||
#$(common-qemu-options image))
|
||||
port)
|
||||
(chmod port #o555))))
|
||||
|
||||
|
|
|
@ -250,7 +250,7 @@ it atomically, and then run OS's activation script."
|
|||
;;;
|
||||
|
||||
(define* (system-derivation-for-action os action
|
||||
#:key image-size)
|
||||
#:key image-size full-boot?)
|
||||
"Return as a monadic value the derivation for OS according to ACTION."
|
||||
(case action
|
||||
((build init reconfigure)
|
||||
|
@ -258,7 +258,7 @@ it atomically, and then run OS's activation script."
|
|||
((vm-image)
|
||||
(system-qemu-image os #:disk-image-size image-size))
|
||||
((vm)
|
||||
(system-qemu-image/shared-store-script os))
|
||||
(system-qemu-image/shared-store-script os #:full-boot? full-boot?))
|
||||
((disk-image)
|
||||
(system-disk-image os #:disk-image-size image-size))))
|
||||
|
||||
|
@ -282,14 +282,16 @@ true."
|
|||
(define* (perform-action action os
|
||||
#:key grub? dry-run?
|
||||
use-substitutes? device target
|
||||
image-size)
|
||||
image-size full-boot?)
|
||||
"Perform ACTION for OS. GRUB? specifies whether to install GRUB; DEVICE is
|
||||
the target devices for GRUB; TARGET is the target root directory; IMAGE-SIZE
|
||||
is the size of the image to be built, for the 'vm-image' and 'disk-image'
|
||||
actions."
|
||||
actions. FULL-BOOT? is used for the 'vm' action; it determines whether to
|
||||
boot directly to the kernel or to the bootloader."
|
||||
(mlet* %store-monad
|
||||
((sys (system-derivation-for-action os action
|
||||
#:image-size image-size))
|
||||
#:image-size image-size
|
||||
#:full-boot? full-boot?))
|
||||
(grub (package->derivation grub))
|
||||
(grub.cfg (grub.cfg os))
|
||||
(drvs -> (if (and grub? (memq action '(init reconfigure)))
|
||||
|
@ -361,6 +363,8 @@ Build the operating system declared in FILE according to ACTION.\n"))
|
|||
--image-size=SIZE for 'vm-image', produce an image of SIZE"))
|
||||
(display (_ "
|
||||
--no-grub for 'init', do not install GRUB"))
|
||||
(display (_ "
|
||||
--full-boot for 'vm', make a full boot sequence"))
|
||||
(newline)
|
||||
(display (_ "
|
||||
-h, --help display this help and exit"))
|
||||
|
@ -385,6 +389,9 @@ Build the operating system declared in FILE according to ACTION.\n"))
|
|||
(option '("no-grub") #f #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-delete 'install-grub? result)))
|
||||
(option '("full-boot") #f #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'full-boot? #t result)))
|
||||
(option '(#\n "dry-run") #f #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'dry-run? #t result)))
|
||||
|
@ -478,6 +485,7 @@ Build the operating system declared in FILE according to ACTION.\n"))
|
|||
#:dry-run? dry?
|
||||
#:use-substitutes? (assoc-ref opts 'substitutes?)
|
||||
#:image-size (assoc-ref opts 'image-size)
|
||||
#:full-boot? (assoc-ref opts 'full-boot?)
|
||||
#:grub? grub?
|
||||
#:target target #:device device)
|
||||
#:system system))))
|
||||
|
|
Loading…
Reference in New Issue