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:
Ludovic Courtès 2014-11-07 22:43:33 +01:00
parent c1941588dd
commit ab11f0bed4
3 changed files with 33 additions and 16 deletions

View File

@ -4151,6 +4151,10 @@ Build a virtual machine that contain the operating system declared in
The VM shares its store with the host system. 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 @item vm-image
@itemx disk-image @itemx disk-image
Return a virtual machine or disk image of the operating system declared Return a virtual machine or disk image of the operating system declared

View File

@ -402,13 +402,15 @@ with the host."
",if=virtio,cache=writeback,werror=report,readonly \ ",if=virtio,cache=writeback,werror=report,readonly \
-m 256\n")) -m 256\n"))
(define* (system-qemu-image/shared-store-script (define* (system-qemu-image/shared-store-script os
os #:key
#:key (qemu qemu)
(qemu qemu) (graphic? #t)
(graphic? #t)) full-boot?)
"Return a derivation that builds a script to run a virtual machine image of "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 (mlet* %store-monad
((os -> (virtualized-operating-system os)) ((os -> (virtualized-operating-system os))
(os-drv (operating-system-derivation os)) (os-drv (operating-system-derivation os))
@ -419,11 +421,14 @@ OS that shares its store with the host."
(display (display
(string-append "#!" #$bash "/bin/sh (string-append "#!" #$bash "/bin/sh
exec " #$qemu "/bin/" #$(qemu-command (%current-system)) exec " #$qemu "/bin/" #$(qemu-command (%current-system))
" -kernel " #$(operating-system-kernel os) "/bzImage \
-initrd " #$os-drv "/initrd \ #$@(if full-boot?
-append \"" #$(if graphic? "" "console=ttyS0 ") #~()
"--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1\" " #~(" -kernel " #$(operating-system-kernel os) "/bzImage \
#$(common-qemu-options image)) -initrd " #$os-drv "/initrd \
-append \"" #$(if graphic? "" "console=ttyS0 ")
"--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1\" "))
#$(common-qemu-options image))
port) port)
(chmod port #o555)))) (chmod port #o555))))

View File

@ -250,7 +250,7 @@ it atomically, and then run OS's activation script."
;;; ;;;
(define* (system-derivation-for-action os action (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." "Return as a monadic value the derivation for OS according to ACTION."
(case action (case action
((build init reconfigure) ((build init reconfigure)
@ -258,7 +258,7 @@ it atomically, and then run OS's activation script."
((vm-image) ((vm-image)
(system-qemu-image os #:disk-image-size image-size)) (system-qemu-image os #:disk-image-size image-size))
((vm) ((vm)
(system-qemu-image/shared-store-script os)) (system-qemu-image/shared-store-script os #:full-boot? full-boot?))
((disk-image) ((disk-image)
(system-disk-image os #:disk-image-size image-size)))) (system-disk-image os #:disk-image-size image-size))))
@ -282,14 +282,16 @@ true."
(define* (perform-action action os (define* (perform-action action os
#:key grub? dry-run? #:key grub? dry-run?
use-substitutes? device target use-substitutes? device target
image-size) image-size full-boot?)
"Perform ACTION for OS. GRUB? specifies whether to install GRUB; DEVICE is "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 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' 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 (mlet* %store-monad
((sys (system-derivation-for-action os action ((sys (system-derivation-for-action os action
#:image-size image-size)) #:image-size image-size
#:full-boot? full-boot?))
(grub (package->derivation grub)) (grub (package->derivation grub))
(grub.cfg (grub.cfg os)) (grub.cfg (grub.cfg os))
(drvs -> (if (and grub? (memq action '(init reconfigure))) (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")) --image-size=SIZE for 'vm-image', produce an image of SIZE"))
(display (_ " (display (_ "
--no-grub for 'init', do not install GRUB")) --no-grub for 'init', do not install GRUB"))
(display (_ "
--full-boot for 'vm', make a full boot sequence"))
(newline) (newline)
(display (_ " (display (_ "
-h, --help display this help and exit")) -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 (option '("no-grub") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-delete 'install-grub? 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 (option '(#\n "dry-run") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'dry-run? #t 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? #:dry-run? dry?
#:use-substitutes? (assoc-ref opts 'substitutes?) #:use-substitutes? (assoc-ref opts 'substitutes?)
#:image-size (assoc-ref opts 'image-size) #:image-size (assoc-ref opts 'image-size)
#:full-boot? (assoc-ref opts 'full-boot?)
#:grub? grub? #:grub? grub?
#:target target #:device device) #:target target #:device device)
#:system system)))) #:system system))))