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

vm: Use more keyword parameters for `expression->derivation-in-linux-vm'. 

* gnu/system/vm.scm (expression->derivation-in-linux-vm): Turn `system'
  and `inputs' into keyword parameters.
  (qemu-image, example1): Adjust accordingly.
This commit is contained in:
Ludovic Courtès 2013-08-27 19:04:14 +02:00
parent 858e92823f
commit 2455085a1e
1 changed files with 19 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
gnu/system/vm.scm
View File

@ -40,8 +40,10 @@
;;; ;;;
;;; Code: ;;; Code:
(define* (expression->derivation-in-linux-vm store name system exp inputs (define* (expression->derivation-in-linux-vm store name exp
#:key #:key
(system (%current-system))
(inputs '())
(linux linux-libre) (linux linux-libre)
(initrd qemu-initrd) (initrd qemu-initrd)
(qemu qemu/smb-shares) (qemu qemu/smb-shares)
@ -150,7 +152,7 @@ DISK-IMAGE-SIZE bytes and return it."
(inputs '())) (inputs '()))
"Return a bootable, stand-alone QEMU image." "Return a bootable, stand-alone QEMU image."
(expression->derivation-in-linux-vm (expression->derivation-in-linux-vm
store "qemu-image" system store "qemu-image"
`(let ((parted (string-append (assoc-ref %build-inputs "parted") `(let ((parted (string-append (assoc-ref %build-inputs "parted")
"/sbin/parted")) "/sbin/parted"))
(mkfs (string-append (assoc-ref %build-inputs "e2fsprogs") (mkfs (string-append (assoc-ref %build-inputs "e2fsprogs")
@ -212,19 +214,20 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
(zero? (zero?
(system* umount "/fs")) (system* umount "/fs"))
(reboot))))))) (reboot)))))))
`(("parted" ,parted) #:system system
("grub" ,grub) #:inputs `(("parted" ,parted)
("e2fsprogs" ,e2fsprogs) ("grub" ,grub)
("linux" ,linux-libre) ("e2fsprogs" ,e2fsprogs)
("initrd" ,qemu-initrd) ("linux" ,linux-libre)
("initrd" ,qemu-initrd)
;; For shell scripts. ;; For shell scripts.
("sed" ,(car (assoc-ref %final-inputs "sed"))) ("sed" ,(car (assoc-ref %final-inputs "sed")))
("grep" ,(car (assoc-ref %final-inputs "grep"))) ("grep" ,(car (assoc-ref %final-inputs "grep")))
("coreutils" ,(car (assoc-ref %final-inputs "coreutils"))) ("coreutils" ,(car (assoc-ref %final-inputs "coreutils")))
("findutils" ,(car (assoc-ref %final-inputs "findutils"))) ("findutils" ,(car (assoc-ref %final-inputs "findutils")))
("gawk" ,(car (assoc-ref %final-inputs "gawk"))) ("gawk" ,(car (assoc-ref %final-inputs "gawk")))
("util-linux" ,util-linux)) ("util-linux" ,util-linux))
#:make-disk-image? #t #:make-disk-image? #t
#:disk-image-size disk-image-size)) #:disk-image-size disk-image-size))
@ -241,13 +244,12 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
(lambda () (lambda ()
(parameterize ((%guile-for-build (package-derivation store guile-final))) (parameterize ((%guile-for-build (package-derivation store guile-final)))
(expression->derivation-in-linux-vm (expression->derivation-in-linux-vm
store "vm-test" (%current-system) store "vm-test"
'(begin '(begin
(display "hello from boot!\n") (display "hello from boot!\n")
(call-with-output-file "/xchg/hello" (call-with-output-file "/xchg/hello"
(lambda (p) (lambda (p)
(display "world" p)))) (display "world" p)))))))
'())))
(lambda () (lambda ()
(close-connection store))))) (close-connection store)))))