nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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:
Ludovic Courtès 2014-05-22 22:30:13 +02:00
parent 3035b50f28
commit c4a74364b9
2 changed files with 19 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gnu/system/vm.scm
View File

@ -119,6 +119,7 @@ input tuple. The output file name is when building for SYSTEM."
(make-disk-image? #f) (make-disk-image? #f)
(references-graphs #f) (references-graphs #f)
(memory-size 256) (memory-size 256)
(disk-image-format "qcow2")
(disk-image-size (disk-image-size
(* 100 (expt 2 20)))) (* 100 (expt 2 20))))
"Evaluate EXP in a QEMU virtual machine running LINUX with INITRD (a "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD (a
@ -127,8 +128,9 @@ store; it should put its output files in the `/xchg' directory, which is
copied to the derivation's output when the VM terminates. The virtual machine copied to the derivation's output when the VM terminates. The virtual machine
runs with MEMORY-SIZE MiB of memory. runs with MEMORY-SIZE MiB of memory.
When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of type
DISK-IMAGE-SIZE bytes and return it. 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. MODULES is the set of modules imported in the execution environment of EXP.
@ -174,6 +176,7 @@ made available under the /xchg CIFS share."
#:linux linux #:initrd initrd #:linux linux #:initrd initrd
#:memory-size #$memory-size #:memory-size #$memory-size
#:make-disk-image? #$make-disk-image? #:make-disk-image? #$make-disk-image?
#:disk-image-format #$disk-image-format
#:disk-image-size #$disk-image-size #:disk-image-size #$disk-image-size
#:references-graphs graphs)))) #:references-graphs graphs))))
@ -190,15 +193,17 @@ made available under the /xchg CIFS share."
(system (%current-system)) (system (%current-system))
(qemu qemu-headless) (qemu qemu-headless)
(disk-image-size (* 100 (expt 2 20))) (disk-image-size (* 100 (expt 2 20)))
(disk-image-format "qcow2")
(file-system-type "ext4") (file-system-type "ext4")
grub-configuration grub-configuration
(register-closures? #t) (register-closures? #t)
(inputs '()) (inputs '())
copy-inputs?) copy-inputs?)
"Return a bootable, stand-alone QEMU image, with a root partition of type "Return a bootable, stand-alone QEMU image of type DISK-IMAGE-FORMAT (e.g.,
FILE-SYSTEM-TYPE. The returned image is a full disk image, with a GRUB 'qcow2' or 'raw'), with a root partition of type FILE-SYSTEM-TYPE. The
installation that uses GRUB-CONFIGURATION as its configuration returned image is a full disk image, with a GRUB installation that uses
file (GRUB-CONFIGURATION must be the name of a file in the VM.) 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 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, all of INPUTS into the image being built. When REGISTER-CLOSURES? is true,
@ -242,6 +247,7 @@ the image."
#:system system #:system system
#:make-disk-image? #t #:make-disk-image? #t
#:disk-image-size disk-image-size #:disk-image-size disk-image-size
#:disk-image-format disk-image-format
#:references-graphs graph))) #:references-graphs graph)))

10
guix/build/vm.scm
View File

@ -50,6 +50,7 @@
(qemu (qemu-command)) (memory-size 512) (qemu (qemu-command)) (memory-size 512)
linux initrd linux initrd
make-disk-image? (disk-image-size 100) make-disk-image? (disk-image-size 100)
(disk-image-format "qcow2")
(references-graphs '())) (references-graphs '()))
"Run BUILDER, a Scheme file, into a VM running LINUX with INITRD, and copy "Run BUILDER, a Scheme file, into a VM running LINUX with INITRD, and copy
the result to OUTPUT. the result to OUTPUT.
@ -60,9 +61,12 @@ it via /dev/hda.
REFERENCES-GRAPHS can specify a list of reference-graph files as produced by REFERENCES-GRAPHS can specify a list of reference-graph files as produced by
the #:references-graphs parameter of 'derivation'." the #:references-graphs parameter of 'derivation'."
(define image-file
(string-append "image." disk-image-format))
(when make-disk-image? (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))) (number->string disk-image-size)))
(error "qemu-img failed"))) (error "qemu-img failed")))
@ -92,12 +96,12 @@ the #:references-graphs parameter of 'derivation'."
"-append" (string-append "console=ttyS0 --load=" "-append" (string-append "console=ttyS0 --load="
builder) builder)
(if make-disk-image? (if make-disk-image?
'("-hda" "image.qcow2") `("-hda" ,image-file)
'()))) '())))
(error "qemu failed" qemu)) (error "qemu failed" qemu))
(if make-disk-image? (if make-disk-image?
(copy-file "image.qcow2" output) (copy-file image-file output)
(begin (begin
(mkdir output) (mkdir output)
(copy-recursively "xchg" output)))) (copy-recursively "xchg" output))))