me/guix
Archived
1
0
Fork 0
Code Activity

gnu: `expression->derivation-in-linux-vm' export references graphs.

Browse source 
* gnu/system/vm.scm (expression->derivation-in-linux-vm): Add
  #:reference-graphs parameter.  Honor it.  Delete duplicates in
  #:modules argument.
This commit is contained in:
Ludovic Courtès 2013-08-31 22:55:04 +02:00
parent b48d21b246
commit ca85d7bcc6
1 changed files with 27 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
gnu/system/vm.scm
View file

@ -28,6 +28,7 @@
#:use-module (gnu packages linux-initrd) #:use-module (gnu packages linux-initrd)
#:use-module ((gnu packages make-bootstrap) #:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-stripped)) #:select (%guile-static-stripped))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (expression->derivation-in-linux-vm #:export (expression->derivation-in-linux-vm
@ -53,6 +54,7 @@
(%guile-for-build)) (%guile-for-build))
(make-disk-image? #f) (make-disk-image? #f)
(references-graphs #f)
(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. In the "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. output when the VM terminates.
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
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 (define input-alist
(map (match-lambda (map (match-lambda
((input package) ((input package)
@ -77,8 +83,10 @@ DISK-IMAGE-SIZE bytes and return it."
(define builder (define builder
;; Code that launches the VM that evaluates EXP. ;; Code that launches the VM that evaluates EXP.
`(begin `(let ()
(use-modules (guix build utils)) (use-modules (guix build utils)
(srfi srfi-1)
(ice-9 rdelim))
(let ((out (assoc-ref %outputs "out")) (let ((out (assoc-ref %outputs "out"))
(cu (string-append (assoc-ref %build-inputs "coreutils") (cu (string-append (assoc-ref %build-inputs "coreutils")
@ -104,6 +112,17 @@ DISK-IMAGE-SIZE bytes and return it."
'(begin)) '(begin))
(mkdir "xchg") (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? (and (zero?
(system* qemu "-nographic" "-no-reboot" (system* qemu "-nographic" "-no-reboot"
"-net" "nic,model=e1000" "-net" "nic,model=e1000"
@ -139,9 +158,11 @@ DISK-IMAGE-SIZE bytes and return it."
,@sub-drv))) ,@sub-drv)))
inputs)) inputs))
#:env-vars env-vars #:env-vars env-vars
#:modules `((guix build utils) #:modules (delete-duplicates
,@modules) `((guix build utils)
#:guile-for-build guile-for-build))) ,@modules))
#:guile-for-build guile-for-build
#:references-graphs references-graphs)))
(define* (qemu-image store #:key (define* (qemu-image store #:key
(name "qemu-image") (name "qemu-image")