gnu: vm: Initialize the image's store.

* gnu/system/vm.scm (qemu-image): Add 'initialize-store?' keyword
  parameter.  Use 'guix-register' when INITIALIZE-STORE? is true.
  (system-qemu-image): Pass #:initialize-store? #t.
This commit is contained in:
Ludovic Courtès 2013-09-24 22:40:33 +02:00
parent 2d195e6775
commit 30f25b033c
2 changed files with 32 additions and 2 deletions

View file

@ -103,3 +103,14 @@ (define (copy arch)
Guix is based on the Nix package manager.")
(license gpl3+)))
(define-public guix-0.4
;; XXX: Hack to allow the use of a 0.4ish tarball. This assumes that you
;; have run 'make dist' in your build tree. Remove when 0.4 is out.
(package (inherit guix)
(version "0.4rc")
(source (let ((builddir (dirname
(canonicalize-path
(dirname (search-path %load-path
"guix/config.scm"))))))
(string-append builddir "/guix-0.4.tar.gz")))))

View file

@ -31,6 +31,7 @@ (define-module (gnu system vm)
#:use-module (gnu packages grub)
#:use-module (gnu packages linux)
#:use-module (gnu packages linux-initrd)
#:use-module (gnu packages package-management)
#:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-stripped))
#:use-module (gnu packages system)
@ -191,6 +192,7 @@ (define* (qemu-image store #:key
(system (%current-system))
(disk-image-size (* 100 (expt 2 20)))
grub-configuration
(initialize-store? #f)
(populate #f)
(inputs '())
(inputs-to-copy '()))
@ -199,7 +201,8 @@ (define* (qemu-image store #:key
configuration file.
INPUTS-TO-COPY is a list of inputs (as for packages) whose closure is copied
into the image being built.
into the image being built. When INITIALIZE-STORE? is true, initialize the
store database in the image so that Guix can be used in the image.
When POPULATE is true, it must be the store file name of a Guile script to run
in the disk image partition once it has been populated with INPUTS-TO-COPY.
@ -298,6 +301,20 @@ (define (graph-from-file file)
;; Populate /dev.
(make-essential-device-nodes #:root "/fs")
;; Optionally, register the inputs in the image's store.
(let* ((guix (assoc-ref %build-inputs "guix"))
(register (string-append guix
"/sbin/guix-register")))
,@(if initialize-store?
(match inputs-to-copy
(((graph-files . _) ...)
(map (lambda (closure)
`(system* register "--prefix" "/fs"
,(string-append "/xchg/"
closure)))
graph-files)))
'(#f)))
(and=> (assoc-ref %build-inputs "populate")
(lambda (populate)
(chdir "/fs")
@ -415,7 +432,8 @@ (define %dmd-services
(qemu-image store
#:grub-configuration grub.cfg
#:populate populate
#:disk-image-size (* 400 (expt 2 20))
#:disk-image-size (* 500 (expt 2 20))
#:initialize-store? #t
#:inputs-to-copy `(("boot" ,boot)
("linux" ,linux-libre)
("initrd" ,gnu-system-initrd)
@ -424,6 +442,7 @@ (define %dmd-services
("guile" ,guile-2.0)
("mingetty" ,mingetty)
("dmd" ,dmd)
("guix" ,guix-0.4)
;; Configuration.
("dmd.conf" ,dmd-conf)