diff --git a/doc/guix.texi b/doc/guix.texi index 7927ca0b00..2da956cc73 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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 diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index dc5b1bafd4..c687bb43f5 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -402,13 +402,15 @@ (define* (common-qemu-options image) ",if=virtio,cache=writeback,werror=report,readonly \ -m 256\n")) -(define* (system-qemu-image/shared-store-script - os - #:key - (qemu qemu) - (graphic? #t)) +(define* (system-qemu-image/shared-store-script os + #:key + (qemu qemu) + (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 @@ (define builder (display (string-append "#!" #$bash "/bin/sh exec " #$qemu "/bin/" #$(qemu-command (%current-system)) -" -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)) + +#$@(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)) port) (chmod port #o555)))) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 056c8e6d30..7eb86c293d 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -250,7 +250,7 @@ (define (system->grub-entry system) ;;; (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 @@ (define* (system-derivation-for-action os action ((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 @@ (define* (maybe-build drvs (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 @@ (define (show-help) --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 @@ (define %options (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 @@ (define (fail) #: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))))