pack: Move store database creation to a separate derivation.

* guix/scripts/pack.scm (store-database): New procedure.
(self-contained-tarball): Use it when LOCALSTATEDIR? is true.
Remove 'schema' and add 'database'.
[build]: Pass DATABASE to 'populate-single-profile-directory'.
(squashfs-image): Remove #:deduplicate? parameter.
[build]: Remove (gnu build install) and (guix config) from the imported
modules.  Remove 'with-extensions'.
* gnu/build/install.scm (populate-single-profile-directory): Remove
 #:deduplicate?, #:register?, and #:schema; add #:database.  Remove call
to 'register-closure' and simply copy DATABASE instead.

gnu/build/install.scm

@@ -161,14 +161,13 @@ deduplicates files common to CLOSURE and the rest of PREFIX."
 (define* (populate-single-profile-directory directory
                                             #:key profile closure
                                             (profile-name "guix-profile")
-                                            deduplicate?
+                                            database)
-                                            register? schema)
   "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
+When DATABASE is true, copy it to DIRECTORY/var/guix/db and create
-the store.
+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\".
@@ -189,11 +188,9 @@ This is used to create the self-contained tarballs with 'guix pack'."
   ;; Populate the store.
   (populate-store (list closure) directory)
 
-  (when register?
+  (when database
-    (register-closure (canonicalize-path directory) closure
+    (install-file database (scope "/var/guix/db/"))
-                      #:deduplicate? deduplicate?
+    (chmod (scope "/var/guix/db/db.sqlite") #o644)
-                      #:schema schema)
-
     (mkdir-p* "/var/guix/profiles")
     (mkdir-p* "/var/guix/gcroots")
     (symlink* "/var/guix/profiles"

guix/scripts/pack.scm

@@ -103,6 +103,47 @@ found."
                       (package-transitive-propagated-inputs package)))
               (list guile-gcrypt guile-sqlite3)))
 
+(define (store-database items)
+  "Return a directory containing a store database where all of ITEMS and their
+dependencies are registered."
+  (define schema
+    (local-file (search-path %load-path
+                             "guix/store/schema.sql")))
+
+
+  (define labels
+    (map (lambda (n)
+           (string-append "closure" (number->string n)))
+         (iota (length items))))
+
+  (define build
+    (with-extensions gcrypt-sqlite3&co
+      ;; XXX: Adding (gnu build install) just to work around
+      ;; <https://bugs.gnu.org/15602>: that way, (guix build store-copy) is
+      ;; copied last and the 'store-info-XXX' macros are correctly expanded.
+      (with-imported-modules (source-module-closure
+                              '((guix build store-copy)
+                                (guix store database)
+                                (gnu build install)))
+        #~(begin
+            (use-modules (guix store database)
+                         (guix build store-copy)
+                         (srfi srfi-1))
+
+            (define (read-closure closure)
+              (call-with-input-file closure read-reference-graph))
+
+            (let ((items (append-map read-closure '#$labels)))
+              (register-items items
+                              #:state-directory #$output
+                              #:deduplicate? #f
+                              #:reset-timestamps? #f
+                              #:registration-time %epoch
+                              #:schema #$schema))))))
+
+  (computed-file "store-database" build
+                 #:options `(#:references-graphs ,(zip labels items))))
+
 (define* (self-contained-tarball name profile
                                  #:key target
                                  deduplicate?
@@ -117,10 +158,10 @@ with a properly initialized store database.
 
 SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be
 added to the pack."
-  (define schema
+  (define database
     (and localstatedir?
-         (local-file (search-path %load-path
+         (file-append (store-database (list profile))
-                                  "guix/store/schema.sql"))))
+                      "/db/db.sqlite")))
 
   (define build
     (with-imported-modules `(((guix config) => ,(make-config.scm))
@@ -181,9 +222,7 @@ added to the pack."
             (populate-single-profile-directory %root
                                                #:profile #$profile
                                                #:closure "profile"
-                                               #:deduplicate? #f
+                                               #:database #+database)
-                                               #:register? #$localstatedir?
-                                               #:schema #$schema)
 
             ;; Create SYMLINKS.
             (for-each (cut evaluate-populate-directive <> %root)
@@ -240,7 +279,6 @@ added to the pack."
 
 (define* (squashfs-image name profile
                          #:key target
-                         deduplicate?
                          (compressor (first %compressors))
                          localstatedir?
                          (symlinks '())
@@ -252,16 +290,12 @@ points for virtual file systems (like procfs), and optional symlinks.
 SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be
 added to the pack."
   (define build
-    (with-imported-modules `(((guix config) => ,(make-config.scm))
+    (with-imported-modules (source-module-closure
-                             ,@(source-module-closure
                             '((guix build utils)
-                                  (guix build store-copy)
+                              (guix build store-copy))
-                                  (gnu build install))
+                            #:select? not-config?)
-                                #:select? not-config?))
-      (with-extensions gcrypt-sqlite3&co
       #~(begin
           (use-modules (guix build utils)
-                         (gnu build install)
                        (guix build store-copy)
                        (srfi srfi-1)
                        (srfi srfi-26)
@@ -319,7 +353,7 @@ added to the pack."
                    ;; Create empty mount points.
                    "-p" "/proc d 555 0 0"
                    "-p" "/sys d 555 0 0"
-                     "-p" "/dev d 555 0 0"))))))
+                   "-p" "/dev d 555 0 0")))))
 
   (gexp->derivation (string-append name
                                    (compressor-extension compressor)