~ruther/guix-local

8d033e3e1607d5722ef7288208551d0331c8a853 — Ludovic Courtès 8 years ago 45c18f8
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.
2 files changed, 25 insertions(+), 8 deletions(-)

M gnu/build/vm.scm
M gnu/system/vm.scm
M gnu/build/vm.scm => gnu/build/vm.scm +16 -4
@@ 76,11 76,14 @@
                           (qemu (qemu-command)) (memory-size 512)
                           linux initrd
                           make-disk-image?
                           single-file-output?
                           (disk-image-size (* 100 (expt 2 20)))
                           (disk-image-format "qcow2")
                           (references-graphs '()))
  "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
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.
  (unless make-disk-image?
    (mkdir output)
    (copy-recursively "xchg" output)))
    (if single-file-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
                             #:key (volume-id "GuixSD_image") (volume-uuid #f))
  "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")))
    (mkdir-p "/tmp/root/var/run")
    (mkdir-p "/tmp/root/run")

M gnu/system/vm.scm => gnu/system/vm.scm +9 -4
@@ 105,16 105,19 @@
                                             (guile-for-build
                                              (%guile-for-build))

                                             (single-file-output? #f)
                                             (make-disk-image? #f)
                                             (references-graphs #f)
                                             (memory-size 256)
                                             (disk-image-format "qcow2")
                                             (disk-image-size 'guess))
  "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
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
runs with MEMORY-SIZE MiB of memory.
derivation).  The virtual machine runs with MEMORY-SIZE MiB of memory.  In the
virtual machine, EXP has access to all its inputs from the store; it should
put its output file(s) in the '/xchg' directory.

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
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
                                #:memory-size #$memory-size
                                #:make-disk-image? #$make-disk-image?
                                #:single-file-output? #$single-file-output?
                                #:disk-image-format #$disk-image-format
                                #:disk-image-size size
                                #:references-graphs graphs)))))


@@ 219,6 223,7 @@ INPUTS is a list of inputs (as for packages)."
           (reboot))))
   #:system system
   #:make-disk-image? #f
   #:single-file-output? #t
   #:references-graphs inputs))

(define* (qemu-image #:key