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

vm: 'expression->derivation-in-linux-vm' can import modules in the VM. 

* gnu/system/vm.scm (%imported-modules): New procedure.
  (expression->derivation-in-linux-vm): Add #:imported-modules
  parameter; remove #:modules.  Add LOADER, and change BUILDER to load
  it.
  (qemu-image): Remove useless #:modules argument.
This commit is contained in:
Ludovic Courtès 2014-04-11 18:42:30 +02:00
parent 7bd9604cde
commit ade5ce7abc
1 changed files with 25 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
gnu/system/vm.scm
View File

@ -81,6 +81,9 @@ input tuple. The output file name is when building for SYSTEM."
((input (and (? string?) (? store-path?) file)) ((input (and (? string?) (? store-path?) file))
(return `(,input . ,file)))))) (return `(,input . ,file))))))
;; An alias to circumvent name clashes.
(define %imported-modules imported-modules)
(define* (expression->derivation-in-linux-vm name exp (define* (expression->derivation-in-linux-vm name exp
#:key #:key
(system (%current-system)) (system (%current-system))
@ -89,7 +92,10 @@ input tuple. The output file name is when building for SYSTEM."
initrd initrd
(qemu qemu-headless) (qemu qemu-headless)
(env-vars '()) (env-vars '())
(modules '()) (imported-modules
'((guix build vm)
(guix build linux-initrd)
(guix build utils)))
(guile-for-build (guile-for-build
(%guile-for-build)) (%guile-for-build))
@ -107,11 +113,13 @@ 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
DISK-IMAGE-SIZE bytes and return it. DISK-IMAGE-SIZE bytes and return it.
IMPORTED-MODULES is the set of modules imported in the execution environment
of EXP.
When REFERENCES-GRAPHS is true, it must be a list of file name/store path 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 pairs, as for `derivation'. The files containing the reference graphs are
made available under the /xchg CIFS share." made available under the /xchg CIFS share."
;; FIXME: Allow use of macros from other modules, as done in ;; FIXME: Add #:modules parameter, for the 'use-modules' form.
;; `build-expression->derivation'.
(define input-alist (define input-alist
(map input->name+output inputs)) (map input->name+output inputs))
@ -126,7 +134,7 @@ made available under the /xchg CIFS share."
"/bzImage")) "/bzImage"))
(initrd (string-append (assoc-ref %build-inputs "initrd") (initrd (string-append (assoc-ref %build-inputs "initrd")
"/initrd")) "/initrd"))
(builder (assoc-ref %build-inputs "builder")) (loader (assoc-ref %build-inputs "loader"))
(graphs ',(match references-graphs (graphs ',(match references-graphs
(((graph-files . _) ...) graph-files) (((graph-files . _) ...) graph-files)
(_ #f)))) (_ #f))))
@ -134,7 +142,7 @@ made available under the /xchg CIFS share."
(set-path-environment-variable "PATH" '("bin") (set-path-environment-variable "PATH" '("bin")
(map cdr %build-inputs)) (map cdr %build-inputs))
(load-in-linux-vm builder (load-in-linux-vm loader
#:output (assoc-ref %outputs "out") #:output (assoc-ref %outputs "out")
#:linux linux #:initrd initrd #:linux linux #:initrd initrd
#:memory-size ,memory-size #:memory-size ,memory-size
@ -144,10 +152,18 @@ made available under the /xchg CIFS share."
(mlet* %store-monad (mlet* %store-monad
((input-alist (sequence %store-monad input-alist)) ((input-alist (sequence %store-monad input-alist))
(module-dir (%imported-modules imported-modules))
(compiled (compiled-modules imported-modules))
(exp* -> `(let ((%build-inputs ',input-alist)) (exp* -> `(let ((%build-inputs ',input-alist))
,exp)) ,exp))
(user-builder (text-file "builder-in-linux-vm" (user-builder (text-file "builder-in-linux-vm"
(object->string exp*))) (object->string exp*)))
(loader (text-file* "linux-vm-loader" ; XXX: use 'sexp-file'
"(begin (set! %load-path (cons \""
module-dir "\" %load-path)) "
"(set! %load-compiled-path (cons \""
compiled "\" %load-compiled-path))"
"(primitive-load \"" user-builder "\"))"))
(coreutils -> (car (assoc-ref %final-inputs "coreutils"))) (coreutils -> (car (assoc-ref %final-inputs "coreutils")))
(initrd (if initrd ; use the default initrd? (initrd (if initrd ; use the default initrd?
(return initrd) (return initrd)
@ -159,6 +175,7 @@ made available under the /xchg CIFS share."
("initrd" ,initrd) ("initrd" ,initrd)
("coreutils" ,coreutils) ("coreutils" ,coreutils)
("builder" ,user-builder) ("builder" ,user-builder)
("loader" ,loader)
,@inputs)))) ,@inputs))))
(derivation-expression name builder (derivation-expression name builder
;; TODO: Require the "kvm" feature. ;; TODO: Require the "kvm" feature.
@ -168,7 +185,8 @@ made available under the /xchg CIFS share."
#:modules (delete-duplicates #:modules (delete-duplicates
`((guix build utils) `((guix build utils)
(guix build vm) (guix build vm)
,@modules)) (guix build linux-initrd)
,@imported-modules))
#:guile-for-build guile-for-build #:guile-for-build guile-for-build
#:references-graphs references-graphs))) #:references-graphs references-graphs)))
@ -367,9 +385,7 @@ such as /etc files."
,@inputs-to-copy) ,@inputs-to-copy)
#:make-disk-image? #t #:make-disk-image? #t
#:disk-image-size disk-image-size #:disk-image-size disk-image-size
#:references-graphs graph #:references-graphs graph)))
#:modules '((guix build utils)
(guix build linux-initrd)))))
;;; ;;;