From c45477d2a1a651485feede20fe0f3d15aec48b39 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 6 Jun 2018 23:58:18 +0200
Subject: 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).
---
 gnu/build/install.scm | 45 +++++++++++++++++++++++++++------------------
 1 file changed, 27 insertions(+), 18 deletions(-)

(limited to 'gnu/build/install.scm')

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 @@ (define (reset-timestamps directory)
                   (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 @@ (define (symlink* old new)
 
   (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"))
 
-- 
cgit v1.2.3