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

gnu: Use gexps in obvious places in (gnu system ...). 

* gnu/system.scm (operating-system-boot-script): Use 'gexp->file'
  instead of 'text-file*'.
* gnu/system/vm.scm (expression->derivation-in-linux-vm): Likewise.
  (system-qemu-image/shared-store-script)[builder]: Turn into a gexp.
  Use 'gexp->derivation' instead of 'derivation-expression'.
This commit is contained in:
Ludovic Courtès 2014-04-26 16:36:48 +02:00
parent 21b679f694
commit 02100028bb
2 changed files with 27 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gnu/system.scm
View File

@ -19,6 +19,7 @@
(define-module (gnu system) (define-module (gnu system)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix gexp)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix derivations) #:use-module (guix derivations)
@ -333,10 +334,9 @@ we're running in the final root."
(etc (operating-system-etc-directory os)) (etc (operating-system-etc-directory os))
(dmd-conf (dmd-configuration-file services (dmd-conf (dmd-configuration-file services
(derivation->output-path etc)))) (derivation->output-path etc))))
;; FIXME: Use 'sexp-file' or similar. (gexp->file "boot"
(text-file* "boot" #~(execl (string-append #$dmd "/bin/dmd")
"(execl \"" dmd "/bin/dmd\" \"dmd\" "dmd" "--config" #$dmd-conf))))
\"--config\" \"" dmd-conf "\")")))
(define (operating-system-derivation os) (define (operating-system-derivation os)
"Return a derivation that builds OS." "Return a derivation that builds OS."

58
gnu/system/vm.scm
View File

@ -19,6 +19,7 @@
(define-module (gnu system vm) (define-module (gnu system vm)
#:use-module (guix config) #:use-module (guix config)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix gexp)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix monads) #:use-module (guix monads)
@ -158,12 +159,14 @@ made available under the /xchg CIFS share."
,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' (loader (gexp->file "linux-vm-loader"
"(begin (set! %load-path (cons \"" #~(begin
module-dir "\" %load-path)) " (set! %load-path
"(set! %load-compiled-path (cons \"" (cons #$module-dir %load-path))
compiled "\" %load-compiled-path))" (set! %load-compiled-path
"(primitive-load \"" user-builder "\"))")) (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)
@ -351,37 +354,22 @@ OS that shares its store with the host."
(initrd initrd) (initrd initrd)
(image (system-qemu-image/shared-store os))) (image (system-qemu-image/shared-store os)))
(define builder (define builder
(mlet %store-monad ((qemu (package-file qemu #~(call-with-output-file #$output
"bin/qemu-system-x86_64")) (lambda (port)
(bash (package-file bash "bin/sh")) (display
(kernel (package-file (operating-system-kernel os) (string-append "#!" #$bash "/bin/sh
"bzImage"))) exec " #$qemu "/bin/qemu-system-x86_64 -enable-kvm -no-reboot -net nic,model=virtio \
(return `(let ((out (assoc-ref %outputs "out"))) -virtfs local,path=" #$(%store-prefix) ",security_model=none,mount_tag=store \
(call-with-output-file out
(lambda (port)
(display
(string-append "#!" ,bash "
exec " ,qemu " -enable-kvm -no-reboot -net nic,model=virtio \
-virtfs local,path=" ,(%store-prefix) ",security_model=none,mount_tag=store \
-net user \ -net user \
-kernel " ,kernel " -initrd " -kernel " #$(operating-system-kernel os) "/bzImage \
,(string-append (derivation->output-path initrd) "/initrd") " \ -initrd " #$initrd "/initrd \
-append \"" ,(if graphic? "" "console=ttyS0 ") -append \"" #$(if graphic? "" "console=ttyS0 ")
"--load=" ,(derivation->output-path os-drv) "/boot --root=/dev/vda1\" \ "--load=" #$os-drv "/boot --root=/dev/vda1\" \
-drive file=" ,(derivation->output-path image) -drive file=" #$image
",if=virtio,cache=writeback,werror=report,readonly\n") ",if=virtio,cache=writeback,werror=report,readonly\n")
port))) port)
(chmod out #o555) (chmod port #o555))))
#t))))
(mlet %store-monad ((qemu (package->derivation qemu)) (gexp->derivation "run-vm.sh" builder)))
(bash (package->derivation bash))
(builder builder))
(derivation-expression "run-vm.sh" builder
#:inputs `(("qemu" ,qemu)
("image" ,image)
("bash" ,bash)
("initrd" ,initrd)
("os" ,os-drv))))))
;;; vm.scm ends here ;;; vm.scm ends here