From f2c403eab62513c88b27ec3e4db5130a476c06ca Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 27 Jun 2014 17:54:29 +0200
Subject: system: Install /var/guix/profiles/system-1-link on new systems.

* guix/build/install.scm (directives): Add /var/guix/profiles/system.
  (populate-root-file-system): Add 'system' parameter.  Create
  /var/guix/profiles/system-1-link.
* guix/scripts/system.scm (install): Pass OS-DIR to
  'populate-root-file-system'.
* guix/build/vm.scm (initialize-root-partition): Add #:system-directory
  parameter, and pass it to 'populate-root-file-system'.
  (initialize-hard-disk): Add #:system-directory parameter, and pass it
  to 'initialize-root-partition'.
* gnu/system/vm.scm (qemu-image): Add #:os-derivation parameter and pass
  it to 'initialize-hard-disk'.
  (system-disk-image, system-qemu-image,
  system-qemu-image/shared-store): Pass #:os-derivation to 'qemu-image.
---
 gnu/system/vm.scm | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

(limited to 'gnu')

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 4e7c439894..3c9c9c83e1 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -197,6 +197,7 @@ (define* (qemu-image #:key
                      (disk-image-format "qcow2")
                      (file-system-type "ext4")
                      file-system-label
+                     os-derivation
                      grub-configuration
                      (register-closures? #t)
                      (inputs '())
@@ -204,9 +205,9 @@ (define* (qemu-image #:key
   "Return a bootable, stand-alone QEMU image of type DISK-IMAGE-FORMAT (e.g.,
 'qcow2' or 'raw'), with a root partition of type FILE-SYSTEM-TYPE.
 Optionally, FILE-SYSTEM-LABEL can be specified as the volume name for the root
-partition.  The returned image is a full disk image, with a GRUB installation
-that uses GRUB-CONFIGURATION as its configuration file (GRUB-CONFIGURATION
-must be the name of a file in the VM.)
+partition.  The returned image is a full disk image that runs OS-DERIVATION,
+with a GRUB installation that uses GRUB-CONFIGURATION as its configuration
+file (GRUB-CONFIGURATION must be the name of a file in the VM.)
 
 INPUTS is a list of inputs (as for packages).  When COPY-INPUTS? is true, copy
 all of INPUTS into the image being built.  When REGISTER-CLOSURES? is true,
@@ -240,6 +241,7 @@ (define* (qemu-image #:key
                              (((names . _) ...)
                               names))))
             (initialize-hard-disk "/dev/vda"
+                                  #:system-directory #$os-derivation
                                   #:grub.cfg #$grub-configuration
                                   #:closures graphs
                                   #:copy-closures? #$copy-inputs?
@@ -298,6 +300,7 @@ (define file-systems-to-keep
     (mlet* %store-monad ((os-drv   (operating-system-derivation os))
                          (grub.cfg (operating-system-grub.cfg os)))
       (qemu-image #:name name
+                  #:os-derivation os-drv
                   #:grub-configuration grub.cfg
                   #:disk-image-size disk-image-size
                   #:disk-image-format "raw"
@@ -334,7 +337,8 @@ (define file-systems-to-keep
     (mlet* %store-monad
         ((os-drv      (operating-system-derivation os))
          (grub.cfg    (operating-system-grub.cfg os)))
-      (qemu-image  #:grub-configuration grub.cfg
+      (qemu-image  #:os-derivation os-drv
+                   #:grub-configuration grub.cfg
                    #:disk-image-size disk-image-size
                    #:file-system-type file-system-type
                    #:inputs `(("system" ,os-drv)
@@ -376,7 +380,8 @@ (define* (system-qemu-image/shared-store
   (mlet* %store-monad
       ((os-drv      (operating-system-derivation os))
        (grub.cfg    (operating-system-grub.cfg os)))
-    (qemu-image #:grub-configuration grub.cfg
+    (qemu-image #:os-derivation os-drv
+                #:grub-configuration grub.cfg
                 #:disk-image-size disk-image-size
                 #:inputs `(("system" ,os-drv))
 
-- 
cgit v1.2.3