1 files changed, 52 insertions, 45 deletions
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 5a5e703872..c9ebe124fe 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -18,7 +18,6 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu build install)
-  #:use-module (guix store database)
   #:use-module (guix build utils)
   #:use-module (guix build store-copy)
   #:use-module (srfi srfi-26)
@@ -27,6 +26,7 @@
             evaluate-populate-directive
             populate-root-file-system
             register-closure
+            install-database-and-gc-roots
             populate-single-profile-directory))
 
 ;;; Commentary:
@@ -141,41 +141,53 @@ includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM."
                 (try))
               (apply throw args)))))))
 
-(define* (register-closure prefix closure
-                           #:key
-                           (deduplicate? #t) (reset-timestamps? #t)
-                           (schema (sql-schema)))
-  "Register CLOSURE in PREFIX, where PREFIX is the directory name of the
-target store and CLOSURE is the name of a file containing a reference graph as
-produced by #:references-graphs..  As a side effect, if RESET-TIMESTAMPS? is
-true, reset timestamps on store files and, if DEDUPLICATE? is true,
-deduplicates files common to CLOSURE and the rest of PREFIX."
-  (let ((items (call-with-input-file closure read-reference-graph)))
-    (register-items items
-                    #:prefix prefix
-                    #:deduplicate? deduplicate?
-                    #:reset-timestamps? reset-timestamps?
-                    #:registration-time %epoch
-                    #:schema schema)))
+(define %root-profile
+  "/var/guix/profiles/per-user/root")
+
+(define* (install-database-and-gc-roots root database profile
+                                        #:key (profile-name "guix-profile"))
+  "Install DATABASE, the store database, under directory ROOT.  Create
+PROFILE-NAME and have it link to PROFILE, a store item."
+  (define (scope file)
+    (string-append root "/" file))
+
+  (define (mkdir-p* dir)
+    (mkdir-p (scope dir)))
+
+  (define (symlink* old new)
+    (symlink old (scope new)))
+
+  (install-file database (scope "/var/guix/db/"))
+  (chmod (scope "/var/guix/db/db.sqlite") #o644)
+  (mkdir-p* "/var/guix/profiles")
+  (mkdir-p* "/var/guix/gcroots")
+  (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 "/" profile-name "-1-link"))
+  (symlink* (string-append profile-name "-1-link")
+            (string-append %root-profile "/" profile-name)))
 
 (define* (populate-single-profile-directory directory
                                             #:key profile closure
-                                            deduplicate?
-                                            register? schema)
+                                            (profile-name "guix-profile")
+                                            database)
   "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.
-When REGISTER? is true, initialize DIRECTORY/var/guix/db to reflect the
-contents of the store; DEDUPLICATE? determines whether to deduplicate files in
-the store.
+
+When DATABASE is true, copy it to DIRECTORY/var/guix/db and create
+DIRECTORY/var/guix/gcroots and friends.
+
+PROFILE-NAME is the name of the profile being created under
+/var/guix/profiles, typically either \"guix-profile\" or \"current-guix\".
 
 This is used to create the self-contained tarballs with 'guix pack'."
   (define (scope file)
     (string-append directory "/" file))
 
-  (define %root-profile
-    "/var/guix/profiles/per-user/root")
-
   (define (mkdir-p* dir)
     (mkdir-p (scope dir)))
 
@@ -185,25 +197,20 @@ This is used to create the self-contained tarballs with 'guix pack'."
   ;; Populate the store.
   (populate-store (list closure) directory)
 
-  (when register?
-    (register-closure (canonicalize-path directory) closure
-                      #:deduplicate? deduplicate?
-                      #:schema schema)
-
-    (mkdir-p* "/var/guix/profiles")
-    (mkdir-p* "/var/guix/gcroots")
-    (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"))
+  (when database
+    (install-database-and-gc-roots directory database profile
+                                   #:profile-name profile-name))
+
+  (match profile-name
+    ("guix-profile"
+     (mkdir-p* "/root")
+     (symlink* (string-append %root-profile "/guix-profile")
+               "/root/.guix-profile"))
+    ("current-guix"
+     (mkdir-p* "/root/.config/guix")
+     (symlink* (string-append %root-profile "/current-guix")
+               "/root/.config/guix/current"))
+    (_
+     #t)))
 
 ;;; install.scm ends here