mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
vm: Make the image format a parameter.
* guix/build/vm.scm (load-in-linux-vm): Add #:disk-image-format parameter; add 'image-file' variable. Honor DISK-IMAGE-FORMAT. * gnu/system/vm.scm (expression->derivation-in-linux-vm): Add #:disk-image-format parameter, and honor it. (qemu-image): Likewise.
This commit is contained in:
parent
3035b50f28
commit
c4a74364b9
2 changed files with 19 additions and 9 deletions
|
@ -119,6 +119,7 @@ (define* (expression->derivation-in-linux-vm name exp
|
|||
(make-disk-image? #f)
|
||||
(references-graphs #f)
|
||||
(memory-size 256)
|
||||
(disk-image-format "qcow2")
|
||||
(disk-image-size
|
||||
(* 100 (expt 2 20))))
|
||||
"Evaluate EXP in a QEMU virtual machine running LINUX with INITRD (a
|
||||
|
@ -127,8 +128,9 @@ (define* (expression->derivation-in-linux-vm name exp
|
|||
copied to the derivation's output when the VM terminates. The virtual machine
|
||||
runs with MEMORY-SIZE MiB of memory.
|
||||
|
||||
When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of
|
||||
DISK-IMAGE-SIZE bytes and return it.
|
||||
When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of type
|
||||
DISK-IMAGE-FORMAT (e.g., 'qcow2' or 'raw'), of DISK-IMAGE-SIZE bytes and
|
||||
return it.
|
||||
|
||||
MODULES is the set of modules imported in the execution environment of EXP.
|
||||
|
||||
|
@ -174,6 +176,7 @@ (define builder
|
|||
#:linux linux #:initrd initrd
|
||||
#:memory-size #$memory-size
|
||||
#:make-disk-image? #$make-disk-image?
|
||||
#:disk-image-format #$disk-image-format
|
||||
#:disk-image-size #$disk-image-size
|
||||
#:references-graphs graphs))))
|
||||
|
||||
|
@ -190,15 +193,17 @@ (define* (qemu-image #:key
|
|||
(system (%current-system))
|
||||
(qemu qemu-headless)
|
||||
(disk-image-size (* 100 (expt 2 20)))
|
||||
(disk-image-format "qcow2")
|
||||
(file-system-type "ext4")
|
||||
grub-configuration
|
||||
(register-closures? #t)
|
||||
(inputs '())
|
||||
copy-inputs?)
|
||||
"Return a bootable, stand-alone QEMU image, with a root partition of type
|
||||
FILE-SYSTEM-TYPE. The returned image is a full disk image, with a GRUB
|
||||
installation that uses GRUB-CONFIGURATION as its configuration
|
||||
file (GRUB-CONFIGURATION must be the name of a file in the VM.)
|
||||
"Return a bootable, stand-alone QEMU image of type DISK-IMAGE-FORMAT (e.g.,
|
||||
'qcow2' or 'raw'), with a root partition of type FILE-SYSTEM-TYPE. The
|
||||
returned image is a full disk image, with a GRUB installation that uses
|
||||
GRUB-CONFIGURATION as its configuration file (GRUB-CONFIGURATION must be the
|
||||
name of a file in the VM.)
|
||||
|
||||
INPUTS is a list of inputs (as for packages). When COPY-INPUTS? is true, copy
|
||||
all of INPUTS into the image being built. When REGISTER-CLOSURES? is true,
|
||||
|
@ -242,6 +247,7 @@ (define* (qemu-image #:key
|
|||
#:system system
|
||||
#:make-disk-image? #t
|
||||
#:disk-image-size disk-image-size
|
||||
#:disk-image-format disk-image-format
|
||||
#:references-graphs graph)))
|
||||
|
||||
|
||||
|
|
|
@ -50,6 +50,7 @@ (define* (load-in-linux-vm builder
|
|||
(qemu (qemu-command)) (memory-size 512)
|
||||
linux initrd
|
||||
make-disk-image? (disk-image-size 100)
|
||||
(disk-image-format "qcow2")
|
||||
(references-graphs '()))
|
||||
"Run BUILDER, a Scheme file, into a VM running LINUX with INITRD, and copy
|
||||
the result to OUTPUT.
|
||||
|
@ -60,9 +61,12 @@ (define* (load-in-linux-vm builder
|
|||
|
||||
REFERENCES-GRAPHS can specify a list of reference-graph files as produced by
|
||||
the #:references-graphs parameter of 'derivation'."
|
||||
(define image-file
|
||||
(string-append "image." disk-image-format))
|
||||
|
||||
(when make-disk-image?
|
||||
(unless (zero? (system* "qemu-img" "create" "-f" "qcow2" "image.qcow2"
|
||||
(unless (zero? (system* "qemu-img" "create" "-f" disk-image-format
|
||||
image-file
|
||||
(number->string disk-image-size)))
|
||||
(error "qemu-img failed")))
|
||||
|
||||
|
@ -92,12 +96,12 @@ (define* (load-in-linux-vm builder
|
|||
"-append" (string-append "console=ttyS0 --load="
|
||||
builder)
|
||||
(if make-disk-image?
|
||||
'("-hda" "image.qcow2")
|
||||
`("-hda" ,image-file)
|
||||
'())))
|
||||
(error "qemu failed" qemu))
|
||||
|
||||
(if make-disk-image?
|
||||
(copy-file "image.qcow2" output)
|
||||
(copy-file image-file output)
|
||||
(begin
|
||||
(mkdir output)
|
||||
(copy-recursively "xchg" output))))
|
||||
|
|
Loading…
Reference in a new issue