From ca85d7bcc6dca82bea176052d0a2615cd9bd3074 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 31 Aug 2013 22:55:04 +0200
Subject: gnu: `expression->derivation-in-linux-vm' export references graphs.

* gnu/system/vm.scm (expression->derivation-in-linux-vm): Add
  #:reference-graphs parameter.  Honor it.  Delete duplicates in
  #:modules argument.
---
 gnu/system/vm.scm | 33 +++++++++++++++++++++++++++------
 1 file changed, 27 insertions(+), 6 deletions(-)

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index fedf0ee322..f3e875bee1 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -28,6 +28,7 @@
   #:use-module (gnu packages linux-initrd)
   #:use-module ((gnu packages make-bootstrap)
                 #:select (%guile-static-stripped))
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:export (expression->derivation-in-linux-vm
@@ -53,6 +54,7 @@
                                               (%guile-for-build))
 
                                              (make-disk-image? #f)
+                                             (references-graphs #f)
                                              (disk-image-size
                                               (* 100 (expt 2 20))))
   "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD.  In the
@@ -61,7 +63,11 @@ its output files in the `/xchg' directory, which is copied to the derivation's
 output when the VM terminates.
 
 When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of
-DISK-IMAGE-SIZE bytes and return it."
+DISK-IMAGE-SIZE bytes and return it.
+
+When REFERENCES-GRAPHS is true, it must be a list of file name/store path
+pairs, as for `derivation'.  The files containing the reference graphs are
+made available under the /xchg CIFS share."
   (define input-alist
     (map (match-lambda
           ((input package)
@@ -77,8 +83,10 @@ DISK-IMAGE-SIZE bytes and return it."
 
   (define builder
     ;; Code that launches the VM that evaluates EXP.
-    `(begin
-       (use-modules (guix build utils))
+    `(let ()
+       (use-modules (guix build utils)
+                    (srfi srfi-1)
+                    (ice-9 rdelim))
 
        (let ((out     (assoc-ref %outputs "out"))
              (cu      (string-append (assoc-ref %build-inputs "coreutils")
@@ -104,6 +112,17 @@ DISK-IMAGE-SIZE bytes and return it."
               '(begin))
 
          (mkdir "xchg")
+
+         ;; Copy the reference-graph files under xchg/ so EXP can access it.
+         (begin
+           ,@(match references-graphs
+               (((graph-files . _) ...)
+                (map (lambda (file)
+                       `(copy-file ,file
+                                   ,(string-append "xchg/" file)))
+                     graph-files))
+               (#f '())))
+
          (and (zero?
                (system* qemu "-nographic" "-no-reboot"
                         "-net" "nic,model=e1000"
@@ -139,9 +158,11 @@ DISK-IMAGE-SIZE bytes and return it."
                                                      ,@sub-drv)))
                                            inputs))
                                   #:env-vars env-vars
-                                  #:modules `((guix build utils)
-                                              ,@modules)
-                                  #:guile-for-build guile-for-build)))
+                                  #:modules (delete-duplicates
+                                             `((guix build utils)
+                                               ,@modules))
+                                  #:guile-for-build guile-for-build
+                                  #:references-graphs references-graphs)))
 
 (define* (qemu-image store #:key
                      (name "qemu-image")
-- 
cgit 1.4.1