3
5
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00

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

View file

@ -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."

View file

@ -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))))
port)
(chmod port #o555))))
(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))))))
(gexp->derivation "run-vm.sh" builder)))
;;; vm.scm ends here