aboutsummaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-09-05 00:45:53 +0200
committerLudovic Courtès <ludo@gnu.org>2013-09-05 00:46:09 +0200
commit1b89a66e1badbb8a597db0529e468f9950119a30 (patch)
tree1a008bbba2d37aaf005c0298ee1ce136f329b8a2 /gnu/system
parent29804e6eb2a755c123f2a73fb843867846cb9111 (diff)
downloadguix-1b89a66e1badbb8a597db0529e468f9950119a30.tar
guix-1b89a66e1badbb8a597db0529e468f9950119a30.tar.gz
gnu: vm: First stab at building a populated QEMU image.
* gnu/packages/linux-initrd.scm (gnu-system-initrd): New variable. * gnu/system/vm.scm (qemu-image): Add #:linux-arguments parameter. [input->name+derivation]: Add case for 'store-path?' items. Remove LOADER from `inputs'.
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/vm.scm61
1 files changed, 38 insertions, 23 deletions
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 596a697738..86430ea168 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -21,7 +21,11 @@
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (guix packages)
- #:use-module ((gnu packages base) #:select (%final-inputs guile-final))
+ #:use-module ((gnu packages base) #:select (%final-inputs
+ guile-final
+ coreutils))
+ #:use-module (gnu packages guile)
+ #:use-module (gnu packages bash)
#:use-module (gnu packages qemu)
#:use-module (gnu packages parted)
#:use-module (gnu packages grub)
@@ -30,7 +34,7 @@
#:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-stripped))
#:use-module ((gnu packages system)
- #:select (shadow))
+ #:select (mingetty))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
@@ -177,11 +181,14 @@ made available under the /xchg CIFS share."
(system (%current-system))
(disk-image-size (* 100 (expt 2 20)))
(linux linux-libre)
+ (linux-arguments '())
(initrd qemu-initrd)
(inputs '())
(inputs-to-copy '())
(boot-expression #f))
- "Return a bootable, stand-alone QEMU image.
+ "Return a bootable, stand-alone QEMU image. The returned image is a full
+disk image, with a GRUB installation whose default entry boots LINUX, with the
+arguments LINUX-ARGUMENTS, and using INITRD as its initial RAM disk.
INPUTS-TO-COPY is a list of inputs (as for packages) whose closure is copied
into the image being built.
@@ -197,13 +204,9 @@ process."
((name (? package? package) sub-drv)
`(,name . ,(derivation-path->output-path
(package-derivation store package system)
- sub-drv)))))
-
- (define loader
- (and boot-expression
- (add-text-to-store store "loader"
- (object->string boot-expression)
- '())))
+ sub-drv)))
+ ((input (and (? string?) (? store-path?) file))
+ `(,input . ,file))))
(expression->derivation-in-linux-vm
store "qemu-image"
@@ -299,12 +302,10 @@ set timeout=5
search.file /boot/bzImage
menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
- linux /boot/bzImage --root=/dev/vda1 ~a
+ linux /boot/bzImage ~a
initrd /boot/initrd
}"
- ,(if loader
- (string-append "--load=" loader)
- ""))))
+ ,(string-join linux-arguments))))
(and (zero?
(system* grub "--no-floppy"
"--boot-directory" "/fs/boot"
@@ -319,10 +320,6 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
("linux" ,linux-libre)
("initrd" ,initrd)
- ,@(if loader
- `(("loader" ,loader))
- '())
-
;; For shell scripts.
("sed" ,(car (assoc-ref %final-inputs "sed")))
("grep" ,(car (assoc-ref %final-inputs "grep")))
@@ -367,13 +364,31 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
(set! store (open-connection)))
(lambda ()
(parameterize ((%guile-for-build (package-derivation store guile-final)))
- (let* ((drv (package-derivation store shadow))
- (login (string-append (derivation-path->output-path drv)
- "/bin/login")))
+ (let* ((out (derivation-path->output-path
+ (package-derivation store mingetty)))
+ (getty (string-append out "/sbin/mingetty"))
+ (boot (add-text-to-store store "boot"
+ (object->string
+ `(begin
+ ;; Become the session leader,
+ ;; so that mingetty can do
+ ;; 'TIOCSCTTY'.
+ (setsid)
+
+ ;; Directly into mingetty.
+ (execl ,getty "mingetty"
+ "--noclear" "tty1")))
+ (list out))))
(qemu-image store
- #:boot-expression `(execl ,login "login" "tty1")
+ #:initrd gnu-system-initrd
+ #:linux-arguments `("--root=/dev/vda1"
+ ,(string-append "--load=" boot))
#:disk-image-size (* 400 (expt 2 20))
- #:inputs-to-copy `(("shadow" ,shadow))))))
+ #:inputs-to-copy `(("boot" ,boot)
+ ("coreutils" ,coreutils)
+ ("bash" ,bash)
+ ("guile" ,guile-2.0)
+ ("mingetty" ,mingetty))))))
(lambda ()
(close-connection store)))))