diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-04-26 16:36:48 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-04-28 23:24:17 +0200 |
commit | 02100028bb78b9bb17764eab0f009fd6fa07fd7b (patch) | |
tree | 255dfd289ab01e3b1caa0c10580b0f90077eaa1c | |
parent | 21b679f6944f4e1f09f949322f5242b761dc22a7 (diff) | |
download | patches-02100028bb78b9bb17764eab0f009fd6fa07fd7b.tar patches-02100028bb78b9bb17764eab0f009fd6fa07fd7b.tar.gz |
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'.
-rw-r--r-- | gnu/system.scm | 8 | ||||
-rw-r--r-- | gnu/system/vm.scm | 60 |
2 files changed, 28 insertions, 40 deletions
diff --git a/gnu/system.scm b/gnu/system.scm index 93858e972a..6308867794 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -19,6 +19,7 @@ (define-module (gnu system) #:use-module (guix store) #:use-module (guix monads) + #:use-module (guix gexp) #:use-module (guix records) #:use-module (guix packages) #:use-module (guix derivations) @@ -333,10 +334,9 @@ we're running in the final root." (etc (operating-system-etc-directory os)) (dmd-conf (dmd-configuration-file services (derivation->output-path etc)))) - ;; FIXME: Use 'sexp-file' or similar. - (text-file* "boot" - "(execl \"" dmd "/bin/dmd\" \"dmd\" - \"--config\" \"" dmd-conf "\")"))) + (gexp->file "boot" + #~(execl (string-append #$dmd "/bin/dmd") + "dmd" "--config" #$dmd-conf)))) (define (operating-system-derivation os) "Return a derivation that builds OS." diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index c491336ccb..82f9ec9a12 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -19,6 +19,7 @@ (define-module (gnu system vm) #:use-module (guix config) #:use-module (guix store) + #:use-module (guix gexp) #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix monads) @@ -158,12 +159,14 @@ made available under the /xchg CIFS share." ,exp)) (user-builder (text-file "builder-in-linux-vm" (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 "\"))")) + (loader (gexp->file "linux-vm-loader" + #~(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"))) (initrd (if initrd ; use the default initrd? (return initrd) @@ -351,37 +354,22 @@ OS that shares its store with the host." (initrd initrd) (image (system-qemu-image/shared-store os))) (define builder - (mlet %store-monad ((qemu (package-file qemu - "bin/qemu-system-x86_64")) - (bash (package-file bash "bin/sh")) - (kernel (package-file (operating-system-kernel os) - "bzImage"))) - (return `(let ((out (assoc-ref %outputs "out"))) - (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 \ + #~(call-with-output-file #$output + (lambda (port) + (display + (string-append "#!" #$bash "/bin/sh +exec " #$qemu "/bin/qemu-system-x86_64 -enable-kvm -no-reboot -net nic,model=virtio \ + -virtfs local,path=" #$(%store-prefix) ",security_model=none,mount_tag=store \ -net user \ - -kernel " ,kernel " -initrd " - ,(string-append (derivation->output-path initrd) "/initrd") " \ --append \"" ,(if graphic? "" "console=ttyS0 ") -"--load=" ,(derivation->output-path os-drv) "/boot --root=/dev/vda1\" \ - -drive file=" ,(derivation->output-path image) + -kernel " #$(operating-system-kernel os) "/bzImage \ + -initrd " #$initrd "/initrd \ +-append \"" #$(if graphic? "" "console=ttyS0 ") + "--load=" #$os-drv "/boot --root=/dev/vda1\" \ + -drive file=" #$image ",if=virtio,cache=writeback,werror=report,readonly\n") - port))) - (chmod out #o555) - #t)))) - - (mlet %store-monad ((qemu (package->derivation qemu)) - (bash (package->derivation bash)) - (builder builder)) - (derivation-expression "run-vm.sh" builder - #:inputs `(("qemu" ,qemu) - ("image" ,image) - ("bash" ,bash) - ("initrd" ,initrd) - ("os" ,os-drv)))))) + port) + (chmod port #o555)))) + + (gexp->derivation "run-vm.sh" builder))) ;;; vm.scm ends here |