1 files changed, 42 insertions, 1 deletions
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 51895d58ec..f019fcb417 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -18,12 +18,14 @@
 
 (define-module (gnu build install)
   #:use-module (guix build utils)
+  #:use-module (guix build store-copy)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:export (install-grub
             populate-root-file-system
             reset-timestamps
-            register-closure))
+            register-closure
+            populate-single-profile-directory))
 
 ;;; Commentary:
 ;;;
@@ -157,4 +159,43 @@ by 'guix-register'.  As a side effect, this resets timestamps on store files."
     (unless (zero? status)
       (error "failed to register store items" closure))))
 
+(define* (populate-single-profile-directory directory
+                                            #:key profile closure)
+  "Populate DIRECTORY with a store containing PROFILE, whose closure is given
+in the file called CLOSURE (as generated by #:references-graphs.)  DIRECTORY
+is initialized to contain a single profile under /root pointing to PROFILE.
+This is used to create the self-contained Guix tarball."
+  (define (scope file)
+    (string-append directory "/" file))
+
+  (define %root-profile
+    "/var/guix/profiles/per-user/root")
+
+  (define (mkdir-p* dir)
+    (mkdir-p (scope dir)))
+
+  (define (symlink* old new)
+    (symlink old (scope new)))
+
+  ;; Populate the store.
+  (populate-store (list closure) directory)
+  (register-closure (canonicalize-path directory) closure)
+
+  ;; XXX: 'guix-register' registers profiles as GC roots but the symlink
+  ;; target uses $TMPDIR.  Fix that.
+  (delete-file (scope "/var/guix/gcroots/profiles"))
+  (symlink* "/var/guix/profiles"
+            "/var/guix/gcroots/profiles")
+
+  ;; Make root's profile, which makes it a GC root.
+  (mkdir-p* %root-profile)
+  (symlink* profile
+            (string-append %root-profile "/guix-profile-1-link"))
+  (symlink* (string-append %root-profile "/guix-profile-1-link")
+            (string-append %root-profile "/guix-profile"))
+
+  (mkdir-p* "/root")
+  (symlink* (string-append %root-profile "/guix-profile")
+            "/root/.guix-profile"))
+
 ;;; install.scm ends here