From 30f25b033c7fbcdcc7050b1655fc832252255c7e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 24 Sep 2013 22:40:33 +0200
Subject: [PATCH] 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.
---
 gnu/packages/package-management.scm | 11 +++++++++++
 gnu/system/vm.scm                   | 23 +++++++++++++++++++++--
 2 files changed, 32 insertions(+), 2 deletions(-)

diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm
index 87fa008002..e19ce04716 100644
--- a/gnu/packages/package-management.scm
+++ b/gnu/packages/package-management.scm
@@ -103,3 +103,14 @@ A user-land free software distribution for GNU/Linux comes as part of Guix.
 
 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")))))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index df55f7c94e..a864ab3de3 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -31,6 +31,7 @@
   #: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 @@ made available under the /xchg CIFS share."
                      (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 @@ disk image, with a GRUB installation that uses GRUB-CONFIGURATION as its
 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 @@ It can be used to provide additional files, such as /etc files."
                       ;; 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 @@ It can be used to provide additional files, such as /etc files."
       (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 @@ It can be used to provide additional files, such as /etc files."
                                      ("guile" ,guile-2.0)
                                      ("mingetty" ,mingetty)
                                      ("dmd" ,dmd)
+                                     ("guix" ,guix-0.4)
 
                                      ;; Configuration.
                                      ("dmd.conf" ,dmd-conf)