vm: 'iso9660-image' produces a single-file output.

* gnu/system/vm.scm (expression->derivation-in-linux-vm): Add
  #:single-file-output? and pass it to 'load-in-linux-vm'.
(iso9660-image): Pass #:single-file-output? to
'expression->derivation-in-linux-vm'.
* gnu/build/vm.scm (load-in-linux-vm): Add #:single-file-output? and
honor it.
This commit is contained in:
Ludovic Courtès 2017-07-18 21:38:16 +02:00
parent 45c18f8529
commit 8d033e3e16
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 25 additions and 8 deletions

View File

@ -76,11 +76,14 @@
(qemu (qemu-command)) (memory-size 512) (qemu (qemu-command)) (memory-size 512)
linux initrd linux initrd
make-disk-image? make-disk-image?
single-file-output?
(disk-image-size (* 100 (expt 2 20))) (disk-image-size (* 100 (expt 2 20)))
(disk-image-format "qcow2") (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. If SINGLE-FILE-OUTPUT? is true, copy a single file from
/xchg to OUTPUT. Otherwise, copy the contents of /xchg to a new directory
OUTPUT.
When MAKE-DISK-IMAGE? is true, OUTPUT will contain a VM image of When MAKE-DISK-IMAGE? is true, OUTPUT will contain a VM image of
DISK-IMAGE-SIZE bytes resulting from the execution of BUILDER, which may DISK-IMAGE-SIZE bytes resulting from the execution of BUILDER, which may
@ -137,8 +140,17 @@ the #:references-graphs parameter of 'derivation'."
;; When MAKE-DISK-IMAGE? is true, the image is in OUTPUT already. ;; When MAKE-DISK-IMAGE? is true, the image is in OUTPUT already.
(unless make-disk-image? (unless make-disk-image?
(mkdir output) (if single-file-output?
(copy-recursively "xchg" output))) (let ((graph? (lambda (name stat)
(member (basename name) references-graphs))))
(match (find-files "xchg" (negate graph?))
((result)
(copy-file result output))
(x
(error "did not find a single result file" x))))
(begin
(mkdir output)
(copy-recursively "xchg" output)))))
;;; ;;;
@ -356,7 +368,7 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
(define* (make-iso9660-image grub config-file os-drv target (define* (make-iso9660-image grub config-file os-drv target
#:key (volume-id "GuixSD_image") (volume-uuid #f)) #:key (volume-id "GuixSD_image") (volume-uuid #f))
"Given a GRUB package, creates an iso image as TARGET, using CONFIG-FILE as "Given a GRUB package, creates an iso image as TARGET, using CONFIG-FILE as
Grub configuration and OS-DRV as the stuff in it." GRUB configuration and OS-DRV as the stuff in it."
(let ((grub-mkrescue (string-append grub "/bin/grub-mkrescue"))) (let ((grub-mkrescue (string-append grub "/bin/grub-mkrescue")))
(mkdir-p "/tmp/root/var/run") (mkdir-p "/tmp/root/var/run")
(mkdir-p "/tmp/root/run") (mkdir-p "/tmp/root/run")

View File

@ -105,16 +105,19 @@
(guile-for-build (guile-for-build
(%guile-for-build)) (%guile-for-build))
(single-file-output? #f)
(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-format "qcow2")
(disk-image-size 'guess)) (disk-image-size 'guess))
"Evaluate EXP in a QEMU virtual machine running LINUX with INITRD (a "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD (a
derivation). In the virtual machine, EXP has access to all its inputs from the derivation). The virtual machine runs with MEMORY-SIZE MiB of memory. In the
store; it should put its output files in the `/xchg' directory, which is virtual machine, EXP has access to all its inputs from the store; it should
copied to the derivation's output when the VM terminates. The virtual machine put its output file(s) in the '/xchg' directory.
runs with MEMORY-SIZE MiB of memory.
If SINGLE-FILE-OUTPUT? is true, copy a single file from '/xchg' to OUTPUT.
Otherwise, copy the contents of /xchg to a new directory OUTPUT.
When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of type 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 DISK-IMAGE-FORMAT (e.g., 'qcow2' or 'raw'), of DISK-IMAGE-SIZE bytes and
@ -164,6 +167,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?
#:single-file-output? #$single-file-output?
#:disk-image-format #$disk-image-format #:disk-image-format #$disk-image-format
#:disk-image-size size #:disk-image-size size
#:references-graphs graphs))))) #:references-graphs graphs)))))
@ -219,6 +223,7 @@ INPUTS is a list of inputs (as for packages)."
(reboot)))) (reboot))))
#:system system #:system system
#:make-disk-image? #f #:make-disk-image? #f
#:single-file-output? #t
#:references-graphs inputs)) #:references-graphs inputs))
(define* (qemu-image #:key (define* (qemu-image #:key