From f6a9d0484c6cdd1554f6ce0e7372ec8b7f2a52ca Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sun, 2 Feb 2014 01:34:33 +0100
Subject: [PATCH] gnu: vm: Add /run/current-system and /bin/sh.

* gnu/system/vm.scm (operating-system-default-contents): Populate
  /run/current-system and create /bin/sh.
* gnu/system.scm (operating-system-profile-derivation,
  operating-system-profile-directory): New procedures.
  (operating-system-derivation): Use it.
---
 gnu/system.scm    | 17 +++++++++++++----
 gnu/system/vm.scm | 13 +++++++++----
 2 files changed, 22 insertions(+), 8 deletions(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index afea976165..514e67ab9a 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -49,6 +49,7 @@
             operating-system-locale
             operating-system-services
 
+            operating-system-profile-directory
             operating-system-derivation))
 
 ;;; Commentary:
@@ -284,6 +285,17 @@ alias ll='ls -l'
                            ("pam.d" ,pam.d))
                 #:name "etc")))
 
+(define (operating-system-profile-derivation os)
+  "Return a derivation that builds the default profile of OS."
+  ;; TODO: Replace with a real profile with a manifest.
+  (union (operating-system-packages os)
+         #:name "default-profile"))
+
+(define (operating-system-profile-directory os)
+  "Return the directory name of the default profile of OS."
+  (mlet %store-monad ((drv (operating-system-profile-derivation os)))
+    (return (derivation->output-path drv))))
+
 (define (operating-system-derivation os)
   "Return a derivation that builds OS."
   (mlet* %store-monad
@@ -310,11 +322,8 @@ alias ll='ls -l'
                                               services))))
        (groups   -> (append (operating-system-groups os)
                             (append-map service-user-groups services)))
-       (packages -> (operating-system-packages os))
 
-       ;; TODO: Replace with a real profile with a manifest.
-       (profile-drv (union packages
-                           #:name "default-profile"))
+       (profile-drv (operating-system-profile-derivation os))
        (profile ->  (derivation->output-path profile-drv))
        (etc-drv     (etc-directory #:accounts accounts #:groups groups
                                    #:pam-services pam-services
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index f36cfd0318..00edc8e40b 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -458,15 +458,20 @@ such as /etc files."
 (define (operating-system-default-contents os)
   "Return a list of directives suitable for 'system-qemu-image' describing the
 basic contents of the root file system of OS."
-  (mlet* %store-monad ((os-drv         (operating-system-derivation os))
-                       (os-dir      -> (derivation->output-path os-drv))
-                       (build-user-gid (operating-system-build-gid os)))
-    (return `((directory "/nix/store" 0 ,(or build-user-gid 0))
+  (mlet* %store-monad ((os-drv    (operating-system-derivation os))
+                       (os-dir -> (derivation->output-path os-drv))
+                       (build-gid (operating-system-build-gid os))
+                       (profile   (operating-system-profile-directory os)))
+    (return `((directory "/nix/store" 0 ,(or build-gid 0))
               (directory "/etc")
               (directory "/var/log")                     ; for dmd
               (directory "/var/run/nscd")
               (directory "/var/nix/gcroots")
               ("/var/nix/gcroots/system" -> ,os-dir)
+              (directory "/run")
+              ("/run/current-system" -> ,profile)
+              (directory "/bin")
+              ("/bin/sh" -> "/run/current-system/bin/sh")
               (directory "/tmp")
               (directory "/var/nix/profiles/per-user/root" 0 0)
               (directory "/var/nix/profiles/per-user/guest"