install: Use (guix store database) instead of 'guix-register'.

* gnu/build/install.scm (register-closure): Add #:reset-timestamps? and
and #:schema; honor them.  Rewrite in terms of 'register-path'.
(populate-single-profile-directory): Add #:schema and honor it.  Make
/var/guix/profiles and /var/guix/gcroots.
* gnu/build/vm.scm (root-partition-initializer): Pass
 #:reset-timestamps? to 'register-closure'.
* gnu/system/vm.scm (not-config?): New procedure.
(guile-sqlite3&co): New variable.
(expression->derivation-in-linux-vm)[config]: New variable.
[builder]: Use 'with-extensions'.
(iso9660-image)[schema, config]: New variables.
Wrap build expression in 'with-extensions'; add 'sql-schema' call.
Remove GUIX from INPUTS.
(qemu-image)[schema, config]: New variables.
Wrap body in 'with-extensions'.
(system-docker-image)[not-config?]: Remove.
[config]: Use 'make-config.scm'.
[schema]: New variable.
[build]: Use 'with-extensions'.  Add call to 'sql-schema'.  Remove GUIX
from INPUTS.
* gnu/system/file-systems.scm (%store-prefix): Check whether
'%store-prefix' is defined.
* guix/scripts/pack.scm (self-contained-tarball)[not-config?]
[libgcrypt, schema]: New variables.
[build]: Wrap in 'with-extensions'.  Adjust imported module list to use
'make-config.scm' for (guix config).

5 files changed, 379 insertions, 302 deletions

diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 9e30c0d23e..6cc678b44b 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -18,6 +18,7 @@
 ;;; 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)
@@ -158,23 +159,31 @@ as created and modified at the Epoch."
                   (utime file 0 0 0 0))))
             (find-files directory #:directories? #t)))
 
-(define* (register-closure store closure
-                           #:key (deduplicate? #t))
-  "Register CLOSURE in STORE, where STORE is the directory name of the target
-store and CLOSURE is the name of a file containing a reference graph as used
-by 'guix-register'.  As a side effect, this resets timestamps on store files
-and, if DEDUPLICATE? is true, deduplicates files common to CLOSURE and the
-rest of STORE."
-  (let ((status (apply system* "guix-register" "--prefix" store
-                       (append (if deduplicate? '() '("--no-deduplication"))
-                               (list closure)))))
-    (unless (zero? status)
-      (error "failed to register store items" closure))))
+(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)))
+    ;; TODO: Add a procedure to register all of ITEMS at once.
+    (for-each (lambda (item)
+                (register-path (store-info-item item)
+                               #:references (store-info-references item)
+                               #:deriver (store-info-deriver item)
+                               #:prefix prefix
+                               #:deduplicate? deduplicate?
+                               #:reset-timestamps? reset-timestamps?
+                               #:schema schema))
+              items)))
 
 (define* (populate-single-profile-directory directory
                                             #:key profile closure
                                             deduplicate?
-                                            register?)
+                                            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.
@@ -200,11 +209,11 @@ This is used to create the self-contained tarballs with 'guix pack'."
 
   (when register?
     (register-closure (canonicalize-path directory) closure
-                      #:deduplicate? deduplicate?)
+                      #:deduplicate? deduplicate?
+                      #:schema schema)
 
-    ;; XXX: 'guix-register' registers profiles as GC roots but the symlink
-    ;; target uses $TMPDIR.  Fix that.
-    (delete-file (scope "/var/guix/gcroots/profiles"))
+    (mkdir-p* "/var/guix/profiles")
+    (mkdir-p* "/var/guix/gcroots")
     (symlink* "/var/guix/profiles"
               "/var/guix/gcroots/profiles"))
 
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index fa3ce7790d..37639f723a 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -354,6 +354,7 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
       (for-each (lambda (closure)
                   (register-closure target
                                     (string-append "/xchg/" closure)
+                                    #:reset-timestamps? copy-closures?
                                     #:deduplicate? deduplicate?))
                 closures)
       (unless copy-closures?
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 2b5948256a..393dd0df70 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -194,10 +194,15 @@
 ;; differs from user to user.
 (define (%store-prefix)
   "Return the store prefix."
-  (cond ((resolve-module '(guix store) #:ensure #f)
+  ;; Note: If we have (guix store database) in the search path and we do *not*
+  ;; have (guix store) proper, 'resolve-module' returns an empty (guix store)
+  ;; with one sub-module.
+  (cond ((and=> (resolve-module '(guix store) #:ensure #f)
+                (lambda (store)
+                  (module-variable store '%store-prefix)))
          =>
-         (lambda (store)
-           ((module-ref store '%store-prefix))))
+         (lambda (variable)
+           ((variable-ref variable))))
         ((getenv "NIX_STORE")
          => identity)
         (else
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 94f1c6197a..b505b0cf6b 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -34,6 +34,7 @@
   #:use-module (guix utils)
   #:use-module (guix hash)
   #:use-module (guix base32)
+  #:use-module ((guix self) #:select (make-config.scm))
 
   #:use-module ((gnu build vm)
                 #:select (qemu-command))
@@ -50,7 +51,6 @@
   #:use-module (gnu packages disk)
   #:use-module (gnu packages zile)
   #:use-module (gnu packages linux)
-  #:use-module (gnu packages package-management)
   #:use-module ((gnu packages make-bootstrap)
                 #:select (%guile-static-stripped))
   #:use-module (gnu packages admin)
@@ -116,6 +116,19 @@
           (options "trans=virtio")
           (check? #f))))
 
+(define not-config?
+  ;; Select (guix …) and (gnu …) modules, except (guix config).
+  (match-lambda
+    (('guix 'config) #f)
+    (('guix rest ...) #t)
+    (('gnu rest ...) #t)
+    (rest #f)))
+
+(define guile-sqlite3&co
+  ;; Guile-SQLite3 and its propagated inputs.
+  (cons guile-sqlite3
+        (package-transitive-propagated-inputs guile-sqlite3)))
+
 (define* (expression->derivation-in-linux-vm name exp
                                              #:key
                                              (system (%current-system))
@@ -151,6 +164,10 @@ based on the size of the closure of REFERENCES-GRAPHS.
 When REFERENCES-GRAPHS is true, it must be a list of file name/store path
 pairs, as for `derivation'.  The files containing the reference graphs are
 made available under the /xchg CIFS share."
+  (define config
+    ;; (guix config) module for consumption by (guix gcrypt).
+    (make-config.scm #:libgcrypt libgcrypt))
+
   (define user-builder
     (program-file "builder-in-linux-vm" exp))
 
@@ -178,40 +195,44 @@ made available under the /xchg CIFS share."
 
     (define builder
       ;; Code that launches the VM that evaluates EXP.
-      (with-imported-modules (source-module-closure '((guix build utils)
-                                                      (gnu build vm)))
-        #~(begin
-            (use-modules (guix build utils)
-                         (gnu build vm))
-
-            (let* ((inputs  '#$(list qemu coreutils))
-                   (linux   (string-append #$linux "/"
-                                           #$(system-linux-image-file-name)))
-                   (initrd  (string-append #$initrd "/initrd"))
-                   (loader  #$loader)
-                   (graphs  '#$(match references-graphs
-                                 (((graph-files . _) ...) graph-files)
-                                 (_ #f)))
-                   (size    #$(if (eq? 'guess disk-image-size)
-                                  #~(+ (* 70 (expt 2 20)) ;ESP
-                                       (estimated-partition-size graphs))
-                                  disk-image-size)))
-
-              (set-path-environment-variable "PATH" '("bin") inputs)
-
-              (load-in-linux-vm loader
-                                #:output #$output
-                                #:linux linux #:initrd initrd
-                                #:memory-size #$memory-size
-                                #:make-disk-image? #$make-disk-image?
-                                #:single-file-output? #$single-file-output?
-                                ;; FIXME: ‘target-arm32?’ may not operate on
-                                ;; the right system/target values.  Rewrite
-                                ;; using ‘let-system’ when available.
-                                #:target-arm32? #$(target-arm32?)
-                                #:disk-image-format #$disk-image-format
-                                #:disk-image-size size
-                                #:references-graphs graphs)))))
+      (with-extensions guile-sqlite3&co
+        (with-imported-modules `(,@(source-module-closure
+                                    '((guix build utils)
+                                      (gnu build vm))
+                                    #:select? not-config?)
+                                 ((guix config) => ,config))
+          #~(begin
+              (use-modules (guix build utils)
+                           (gnu build vm))
+
+              (let* ((inputs  '#$(list qemu (canonical-package coreutils)))
+                     (linux   (string-append #$linux "/"
+                                             #$(system-linux-image-file-name)))
+                     (initrd  (string-append #$initrd "/initrd"))
+                     (loader  #$loader)
+                     (graphs  '#$(match references-graphs
+                                   (((graph-files . _) ...) graph-files)
+                                   (_ #f)))
+                     (size    #$(if (eq? 'guess disk-image-size)
+                                    #~(+ (* 70 (expt 2 20)) ;ESP
+                                         (estimated-partition-size graphs))
+                                    disk-image-size)))
+
+                (set-path-environment-variable "PATH" '("bin") inputs)
+
+                (load-in-linux-vm loader
+                                  #:output #$output
+                                  #:linux linux #:initrd initrd
+                                  #:memory-size #$memory-size
+                                  #:make-disk-image? #$make-disk-image?
+                                  #:single-file-output? #$single-file-output?
+                                  ;; FIXME: ‘target-arm32?’ may not operate on
+                                  ;; the right system/target values.  Rewrite
+                                  ;; using ‘let-system’ when available.
+                                  #:target-arm32? #$(target-arm32?)
+                                  #:disk-image-format #$disk-image-format
+                                  #:disk-image-size size
+                                  #:references-graphs graphs))))))
 
     (gexp->derivation name builder
                       ;; TODO: Require the "kvm" feature.
@@ -234,42 +255,56 @@ made available under the /xchg CIFS share."
   "Return a bootable, stand-alone iso9660 image.
 
 INPUTS is a list of inputs (as for packages)."
+  (define config
+    (make-config.scm #:libgcrypt libgcrypt))
+
+  (define schema
+    (and register-closures?
+         (local-file (search-path %load-path
+                                  "guix/store/schema.sql"))))
+
   (expression->derivation-in-linux-vm
    name
-   (with-imported-modules (source-module-closure '((gnu build vm)
-                                                   (guix build utils)))
-     #~(begin
-         (use-modules (gnu build vm)
-                      (guix build utils))
-
-         (let ((inputs
-                '#$(append (list qemu parted e2fsprogs dosfstools xorriso)
-                           (map canonical-package
-                                (list sed grep coreutils findutils gawk))
-                           (if register-closures? (list guix) '())))
-
-
-               (graphs     '#$(match inputs
-                                   (((names . _) ...)
-                                    names)))
-               ;; This variable is unused but allows us to add INPUTS-TO-COPY
-               ;; as inputs.
-               (to-register
-                '#$(map (match-lambda
-                          ((name thing) thing)
-                          ((name thing output) `(,thing ,output)))
-                        inputs)))
-
-           (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
-           (make-iso9660-image #$(bootloader-package bootloader)
-                               #$bootcfg-drv
-                               #$os-drv
-                               "/xchg/guixsd.iso"
-                               #:register-closures? #$register-closures?
-                               #:closures graphs
-                               #:volume-id #$file-system-label
-                               #:volume-uuid #$(and=> file-system-uuid
-                                                      uuid-bytevector)))))
+   (with-extensions guile-sqlite3&co
+     (with-imported-modules `(,@(source-module-closure '((gnu build vm)
+                                                         (guix store database)
+                                                         (guix build utils))
+                                                       #:select? not-config?)
+                              ((guix config) => ,config))
+       #~(begin
+           (use-modules (gnu build vm)
+                        (guix store database)
+                        (guix build utils))
+
+           (sql-schema #$schema)
+
+           (let ((inputs
+                  '#$(append (list qemu parted e2fsprogs dosfstools xorriso)
+                             (map canonical-package
+                                  (list sed grep coreutils findutils gawk))))
+
+
+                 (graphs     '#$(match inputs
+                                  (((names . _) ...)
+                                   names)))
+                 ;; This variable is unused but allows us to add INPUTS-TO-COPY
+                 ;; as inputs.
+                 (to-register
+                  '#$(map (match-lambda
+                            ((name thing) thing)
+                            ((name thing output) `(,thing ,output)))
+                          inputs)))
+
+             (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+             (make-iso9660-image #$(bootloader-package bootloader)
+                                 #$bootcfg-drv
+                                 #$os-drv
+                                 "/xchg/guixsd.iso"
+                                 #:register-closures? #$register-closures?
+                                 #:closures graphs
+                                 #:volume-id #$file-system-label
+                                 #:volume-uuid #$(and=> file-system-uuid
+                                                        uuid-bytevector))))))
    #:system system
 
    ;; Keep a local file system for /tmp so that we can populate it directly as
@@ -312,90 +347,104 @@ 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,
 register INPUTS in the store database of the image so that Guix can be used in
 the image."
+  (define config
+    (make-config.scm #:libgcrypt libgcrypt))
+
+  (define schema
+    (and register-closures?
+         (local-file (search-path %load-path
+                                  "guix/store/schema.sql"))))
+
   (expression->derivation-in-linux-vm
    name
-   (with-imported-modules (source-module-closure '((gnu build bootloader)
-                                                   (gnu build vm)
-                                                   (guix build utils)))
-     #~(begin
-         (use-modules (gnu build bootloader)
-                      (gnu build vm)
-                      (guix build utils)
-                      (srfi srfi-26)
-                      (ice-9 binary-ports))
-
-         (let ((inputs
-                '#$(append (list qemu parted e2fsprogs dosfstools)
-                           (map canonical-package
-                                (list sed grep coreutils findutils gawk))
-                           (if register-closures? (list guix) '())))
-
-               ;; This variable is unused but allows us to add INPUTS-TO-COPY
-               ;; as inputs.
-               (to-register
-                '#$(map (match-lambda
-                          ((name thing) thing)
-                          ((name thing output) `(,thing ,output)))
-                        inputs)))
-
-           (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
-
-           (let* ((graphs     '#$(match inputs
-                                   (((names . _) ...)
-                                    names)))
-                  (initialize (root-partition-initializer
-                               #:closures graphs
-                               #:copy-closures? #$copy-inputs?
-                               #:register-closures? #$register-closures?
-                               #:system-directory #$os-drv))
-                  (root-size  #$(if (eq? 'guess disk-image-size)
-                                    #~(max
-                                       ;; Minimum 20 MiB root size
-                                       (* 20 (expt 2 20))
-                                       (estimated-partition-size
-                                        (map (cut string-append "/xchg/" <>)
-                                             graphs)))
-                                    (- disk-image-size
-                                       (* 50 (expt 2 20)))))
-                  (partitions
-                   (append
-                    (list (partition
-                           (size root-size)
-                           (label #$file-system-label)
-                           (uuid #$(and=> file-system-uuid
-                                          uuid-bytevector))
-                           (file-system #$file-system-type)
-                           (flags '(boot))
-                           (initializer initialize)))
-                    ;; Append a small EFI System Partition for use with UEFI
-                    ;; bootloaders if we are not targeting ARM because UEFI
-                    ;; support in U-Boot is experimental.
-                    ;;
-                    ;; FIXME: ‘target-arm32?’ may be not operate on the right
-                    ;; system/target values.  Rewrite using ‘let-system’ when
-                    ;; available.
-                    (if #$(target-arm32?)
-                        '()
-                        (list (partition
-                               ;; The standalone grub image is about 10MiB, but
-                               ;; leave some room for custom or multiple images.
-                               (size (* 40 (expt 2 20)))
-                               (label "GNU-ESP")             ;cosmetic only
-                               ;; Use "vfat" here since this property is used
-                               ;; when mounting. The actual FAT-ness is based
-                               ;; on file system size (16 in this case).
-                               (file-system "vfat")
-                               (flags '(esp))))))))
-             (initialize-hard-disk "/dev/vda"
-                                   #:partitions partitions
-                                   #:grub-efi #$grub-efi
-                                   #:bootloader-package
-                                   #$(bootloader-package bootloader)
-                                   #:bootcfg #$bootcfg-drv
-                                   #:bootcfg-location
-                                   #$(bootloader-configuration-file bootloader)
-                                   #:bootloader-installer
-                                   #$(bootloader-installer bootloader))))))
+   (with-extensions guile-sqlite3&co
+     (with-imported-modules `(,@(source-module-closure '((gnu build vm)
+                                                         (gnu build bootloader)
+                                                         (guix store database)
+                                                         (guix build utils))
+                                                       #:select? not-config?)
+                              ((guix config) => ,config))
+       #~(begin
+           (use-modules (gnu build bootloader)
+                        (gnu build vm)
+                        (guix store database)
+                        (guix build utils)
+                        (srfi srfi-26)
+                        (ice-9 binary-ports))
+
+           (sql-schema #$schema)
+
+           (let ((inputs
+                  '#$(append (list qemu parted e2fsprogs dosfstools)
+                             (map canonical-package
+                                  (list sed grep coreutils findutils gawk))))
+
+                 ;; This variable is unused but allows us to add INPUTS-TO-COPY
+                 ;; as inputs.
+                 (to-register
+                  '#$(map (match-lambda
+                            ((name thing) thing)
+                            ((name thing output) `(,thing ,output)))
+                          inputs)))
+
+             (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+
+             (let* ((graphs     '#$(match inputs
+                                     (((names . _) ...)
+                                      names)))
+                    (initialize (root-partition-initializer
+                                 #:closures graphs
+                                 #:copy-closures? #$copy-inputs?
+                                 #:register-closures? #$register-closures?
+                                 #:system-directory #$os-drv))
+                    (root-size  #$(if (eq? 'guess disk-image-size)
+                                      #~(max
+                                         ;; Minimum 20 MiB root size
+                                         (* 20 (expt 2 20))
+                                         (estimated-partition-size
+                                          (map (cut string-append "/xchg/" <>)
+                                               graphs)))
+                                      (- disk-image-size
+                                         (* 50 (expt 2 20)))))
+                    (partitions
+                     (append
+                      (list (partition
+                             (size root-size)
+                             (label #$file-system-label)
+                             (uuid #$(and=> file-system-uuid
+                                            uuid-bytevector))
+                             (file-system #$file-system-type)
+                             (flags '(boot))
+                             (initializer initialize)))
+                      ;; Append a small EFI System Partition for use with UEFI
+                      ;; bootloaders if we are not targeting ARM because UEFI
+                      ;; support in U-Boot is experimental.
+                      ;;
+                      ;; FIXME: ‘target-arm32?’ may be not operate on the right
+                      ;; system/target values.  Rewrite using ‘let-system’ when
+                      ;; available.
+                      (if #$(target-arm32?)
+                          '()
+                          (list (partition
+                                 ;; The standalone grub image is about 10MiB, but
+                                 ;; leave some room for custom or multiple images.
+                                 (size (* 40 (expt 2 20)))
+                                 (label "GNU-ESP") ;cosmetic only
+                                 ;; Use "vfat" here since this property is used
+                                 ;; when mounting. The actual FAT-ness is based
+                                 ;; on file system size (16 in this case).
+                                 (file-system "vfat")
+                                 (flags '(esp))))))))
+               (initialize-hard-disk "/dev/vda"
+                                     #:partitions partitions
+                                     #:grub-efi #$grub-efi
+                                     #:bootloader-package
+                                     #$(bootloader-package bootloader)
+                                     #:bootcfg #$bootcfg-drv
+                                     #:bootcfg-location
+                                     #$(bootloader-configuration-file bootloader)
+                                     #:bootloader-installer
+                                     #$(bootloader-installer bootloader)))))))
    #:system system
    #:make-disk-image? #t
    #:disk-image-size disk-image-size
@@ -413,49 +462,41 @@ makes sense when you want to build a GuixSD Docker image that has Guix
 installed inside of it.  If you don't need Guix (e.g., your GuixSD Docker
 image just contains a web server that is started by the Shepherd), then you
 should set REGISTER-CLOSURES? to #f."
-  (define not-config?
-    (match-lambda
-      (('guix 'config) #f)
-      (('guix rest ...) #t)
-      (('gnu rest ...) #t)
-      (rest #f)))
-
   (define config
     ;; (guix config) module for consumption by (guix gcrypt).
-    (scheme-file "gcrypt-config.scm"
-                 #~(begin
-                     (define-module (guix config)
-                       #:export (%libgcrypt))
+    (make-config.scm #:libgcrypt libgcrypt))
 
-                     ;; XXX: Work around <http://bugs.gnu.org/15602>.
-                     (eval-when (expand load eval)
-                       (define %libgcrypt
-                         #+(file-append libgcrypt "/lib/libgcrypt"))))))
+  (define schema
+    (and register-closures?
+         (local-file (search-path %load-path
+                                  "guix/store/schema.sql"))))
 
   (mlet %store-monad ((os-drv (operating-system-derivation os #:container? #t))
                       (name -> (string-append name ".tar.gz"))
                       (graph -> "system-graph"))
     (define build
-      (with-extensions (list guile-json)          ;for (guix docker)
+      (with-extensions (cons guile-json          ;for (guix docker)
+                             guile-sqlite3&co)   ;for (guix store database)
         (with-imported-modules `(,@(source-module-closure
                                     '((guix docker)
+                                      (guix store database)
                                       (guix build utils)
+                                      (guix build store-copy)
                                       (gnu build vm))
                                     #:select? not-config?)
-                                 (guix build store-copy)
                                  ((guix config) => ,config))
           #~(begin
               (use-modules (guix docker)
                            (guix build utils)
                            (gnu build vm)
                            (srfi srfi-19)
-                           (guix build store-copy))
+                           (guix build store-copy)
+                           (guix store database))
+
+              ;; Set the SQL schema location.
+              (sql-schema #$schema)
 
-              (let* ((inputs '#$(append (list tar)
-                                        (if register-closures?
-                                            (list guix)
-                                            '())))
-                     ;; This initializer requires elevated privileges that are
+              (let* (;; This initializer requires elevated privileges that are
                      ;; not normally available in the build environment (e.g.,
                      ;; it needs to create device nodes).  In order to obtain
                      ;; such privileges, we run it as root in a VM.
@@ -470,7 +511,7 @@ should set REGISTER-CLOSURES? to #f."
                      ;; lack of privileges if we use a root-directory that is on
                      ;; a file system that is shared with the host (e.g., /tmp).
                      (root-directory "/guixsd-system-root"))
-                (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+                (set-path-environment-variable "PATH" '("bin" "sbin") '(#+tar))
                 (mkdir root-directory)
                 (initialize root-directory)
                 (build-docker-image
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 78bfd01eff..ed876b2592 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -35,6 +35,7 @@
   #:use-module (guix search-paths)
   #:use-module (guix build-system gnu)
   #:use-module (guix scripts build)
+  #:use-module ((guix self) #:select (make-config.scm))
   #:use-module (gnu packages)
   #:use-module (gnu packages bootstrap)
   #:use-module (gnu packages compression)
@@ -101,113 +102,133 @@ with a properly initialized store database.
 
 SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be
 added to the pack."
-  (define build
-    (with-imported-modules (source-module-closure
-                            '((guix build utils)
-                              (guix build union)
-                              (guix build store-copy)
-                              (gnu build install)))
-      #~(begin
-          (use-modules (guix build utils)
-                       ((guix build union) #:select (relative-file-name))
-                       (gnu build install)
-                       (srfi srfi-1)
-                       (srfi srfi-26)
-                       (ice-9 match))
+  (define not-config?
+    (match-lambda
+      (('guix 'config) #f)
+      (('guix _ ...) #t)
+      (('gnu _ ...) #t)
+      (_ #f)))
 
-          (define %root "root")
-
-          (define symlink->directives
-            ;; Return "populate directives" to make the given symlink and its
-            ;; parent directories.
-            (match-lambda
-              ((source '-> target)
-               (let ((target (string-append #$profile "/" target))
-                     (parent (dirname source)))
-                 ;; Never add a 'directory' directive for "/" so as to
-                 ;; preserve its ownnership when extracting the archive (see
-                 ;; below), and also because this would lead to adding the
-                 ;; same entries twice in the tarball.
-                 `(,@(if (string=? parent "/")
-                         '()
-                         `((directory ,parent)))
-                   (,source
-                    -> ,(relative-file-name parent target)))))))
-
-          (define directives
-            ;; Fully-qualified symlinks.
-            (append-map symlink->directives '#$symlinks))
-
-          ;; The --sort option was added to GNU tar in version 1.28, released
-          ;; 2014-07-28.  For testing, we use the bootstrap tar, which is
-          ;; older and doesn't support it.
-          (define tar-supports-sort?
-            (zero? (system* (string-append #+archiver "/bin/tar")
-                            "cf" "/dev/null" "--files-from=/dev/null"
-                            "--sort=name")))
-
-          ;; We need Guix here for 'guix-register'.
-          (setenv "PATH"
-                  (string-append #$(if localstatedir?
-                                       (file-append guix "/sbin:")
-                                       "")
-                                 #$archiver "/bin"))
-
-          ;; Note: there is not much to gain here with deduplication and there
-          ;; is the overhead of the '.links' directory, so turn it off.
-          ;; Furthermore GNU tar < 1.30 sometimes fails to extract tarballs
-          ;; with hard links:
-          ;; <http://lists.gnu.org/archive/html/bug-tar/2017-11/msg00009.html>.
-          (populate-single-profile-directory %root
-                                             #:profile #$profile
-                                             #:closure "profile"
-                                             #:deduplicate? #f
-                                             #:register? #$localstatedir?)
-
-          ;; Create SYMLINKS.
-          (for-each (cut evaluate-populate-directive <> %root)
-                    directives)
-
-          ;; Create the tarball.  Use GNU format so there's no file name
-          ;; length limitation.
-          (with-directory-excursion %root
-            (exit
-             (zero? (apply system* "tar"
-                           "-I"
-                           (string-join '#+(compressor-command compressor))
-                           "--format=gnu"
-
-                           ;; Avoid non-determinism in the archive.  Use
-                           ;; mtime = 1, not zero, because that is what the
-                           ;; daemon does for files in the store (see the
-                           ;; 'mtimeStore' constant in local-store.cc.)
-                           (if tar-supports-sort? "--sort=name" "--mtime=@1")
-                           "--mtime=@1"           ;for files in /var/guix
-                           "--owner=root:0"
-                           "--group=root:0"
-
-                           "--check-links"
-                           "-cvf" #$output
-                           ;; Avoid adding / and /var to the tarball, so
-                           ;; that the ownership and permissions of those
-                           ;; directories will not be overwritten when
-                           ;; extracting the archive.  Do not include /root
-                           ;; because the root account might have a
-                           ;; different home directory.
-                           #$@(if localstatedir?
-                                  '("./var/guix")
-                                  '())
-
-                           (string-append "." (%store-directory))
-
-                           (delete-duplicates
-                            (filter-map (match-lambda
-                                          (('directory directory)
-                                           (string-append "." directory))
-                                          ((source '-> _)
-                                           (string-append "." source))
-                                          (_ #f))
-                                        directives)))))))))
+  (define libgcrypt
+    (module-ref (resolve-interface '(gnu packages gnupg))
+                'libgcrypt))
+
+  (define schema
+    (and localstatedir?
+         (local-file (search-path %load-path
+                                  "guix/store/schema.sql"))))
+
+  (define build
+    (with-imported-modules `(((guix config)
+                              => ,(make-config.scm
+                                   #:libgcrypt libgcrypt))
+                             ,@(source-module-closure
+                                `((guix build utils)
+                                  (guix build union)
+                                  (guix build store-copy)
+                                  (gnu build install))
+                                #:select? not-config?))
+      (with-extensions (cons guile-sqlite3
+                             (package-transitive-propagated-inputs
+                              guile-sqlite3))
+        #~(begin
+            (use-modules (guix build utils)
+                         ((guix build union) #:select (relative-file-name))
+                         (gnu build install)
+                         (srfi srfi-1)
+                         (srfi srfi-26)
+                         (ice-9 match))
+
+            (define %root "root")
+
+            (define symlink->directives
+              ;; Return "populate directives" to make the given symlink and its
+              ;; parent directories.
+              (match-lambda
+                ((source '-> target)
+                 (let ((target (string-append #$profile "/" target))
+                       (parent (dirname source)))
+                   ;; Never add a 'directory' directive for "/" so as to
+                   ;; preserve its ownnership when extracting the archive (see
+                   ;; below), and also because this would lead to adding the
+                   ;; same entries twice in the tarball.
+                   `(,@(if (string=? parent "/")
+                           '()
+                           `((directory ,parent)))
+                     (,source
+                      -> ,(relative-file-name parent target)))))))
+
+            (define directives
+              ;; Fully-qualified symlinks.
+              (append-map symlink->directives '#$symlinks))
+
+            ;; The --sort option was added to GNU tar in version 1.28, released
+            ;; 2014-07-28.  For testing, we use the bootstrap tar, which is
+            ;; older and doesn't support it.
+            (define tar-supports-sort?
+              (zero? (system* (string-append #+archiver "/bin/tar")
+                              "cf" "/dev/null" "--files-from=/dev/null"
+                              "--sort=name")))
+
+            ;; Add 'tar' to the search path.
+            (setenv "PATH" #+(file-append archiver "/bin"))
+
+            ;; Note: there is not much to gain here with deduplication and there
+            ;; is the overhead of the '.links' directory, so turn it off.
+            ;; Furthermore GNU tar < 1.30 sometimes fails to extract tarballs
+            ;; with hard links:
+            ;; <http://lists.gnu.org/archive/html/bug-tar/2017-11/msg00009.html>.
+            (populate-single-profile-directory %root
+                                               #:profile #$profile
+                                               #:closure "profile"
+                                               #:deduplicate? #f
+                                               #:register? #$localstatedir?
+                                               #:schema #$schema)
+
+            ;; Create SYMLINKS.
+            (for-each (cut evaluate-populate-directive <> %root)
+                      directives)
+
+            ;; Create the tarball.  Use GNU format so there's no file name
+            ;; length limitation.
+            (with-directory-excursion %root
+              (exit
+               (zero? (apply system* "tar"
+                             "-I"
+                             (string-join '#+(compressor-command compressor))
+                             "--format=gnu"
+
+                             ;; Avoid non-determinism in the archive.  Use
+                             ;; mtime = 1, not zero, because that is what the
+                             ;; daemon does for files in the store (see the
+                             ;; 'mtimeStore' constant in local-store.cc.)
+                             (if tar-supports-sort? "--sort=name" "--mtime=@1")
+                             "--mtime=@1"         ;for files in /var/guix
+                             "--owner=root:0"
+                             "--group=root:0"
+
+                             "--check-links"
+                             "-cvf" #$output
+                             ;; Avoid adding / and /var to the tarball, so
+                             ;; that the ownership and permissions of those
+                             ;; directories will not be overwritten when
+                             ;; extracting the archive.  Do not include /root
+                             ;; because the root account might have a
+                             ;; different home directory.
+                             #$@(if localstatedir?
+                                    '("./var/guix")
+                                    '())
+
+                             (string-append "." (%store-directory))
+
+                             (delete-duplicates
+                              (filter-map (match-lambda
+                                            (('directory directory)
+                                             (string-append "." directory))
+                                            ((source '-> _)
+                                             (string-append "." source))
+                                            (_ #f))
+                                          directives))))))))))
 
   (gexp->derivation (string-append name ".tar"
                                    (compressor-extension compressor))