database: Add 'register-items'.

* guix/build/store-copy.scm (store-info): Export.
* guix/store/database.scm (register-items): New procedure.
(register-path): Implement in terms of 'register-items'.
* gnu/build/install.scm (register-closure): Use 'register-items' instead
of 'for-each' and 'register-path'.

gnu/build/install.scm

@@ -169,16 +169,11 @@ 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.
+    (register-items items
-    (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))
+                    #:schema schema)))
-              items)))
 
 (define* (populate-single-profile-directory directory
                                             #:key profile closure

guix/build/store-copy.scm

@@ -27,6 +27,7 @@
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 vlist)
   #:export (store-info?
+            store-info
             store-info-item
             store-info-deriver
             store-info-references

guix/store/database.scm

@@ -26,6 +26,7 @@
   #:use-module (guix build syscalls)
   #:use-module ((guix build utils)
                 #:select (mkdir-p executable-file?))
+  #:use-module (guix build store-copy)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
@@ -37,6 +38,7 @@
             with-database
             sqlite-register
             register-path
+            register-items
             reset-timestamps))
 
 ;;; Code for working with the store database directly.
@@ -216,11 +218,6 @@ it's a directory.  While at it, canonicalize file permissions."
                         state-directory (deduplicate? #t)
                         (reset-timestamps? #t)
                         (schema (sql-schema)))
-  ;; Priority for options: first what is given, then environment variables,
-  ;; then defaults. %state-directory, %store-directory, and
-  ;; %store-database-directory already handle the "environment variables /
-  ;; defaults" question, so we only need to choose between what is given and
-  ;; those.
   "Register PATH as a valid store file, with REFERENCES as its list of
 references, and DERIVER as its deriver (.drv that led to it.)  If PREFIX is
 given, it must be the name of the directory containing the new store to
@@ -230,47 +227,69 @@ Return #t on success.
 
 Use with care as it directly modifies the store!  This is primarily meant to
 be used internally by the daemon's build hook."
-  (let* ((db-dir (cond
+  (register-items (list (store-info path deriver references))
-                  (state-directory
+                  #:prefix prefix #:state-directory state-directory
+                  #:deduplicate? deduplicate?
+                  #:reset-timestamps? reset-timestamps?
+                  #:schema schema))
+
+(define* (register-items items
+                         #:key prefix state-directory
+                         (deduplicate? #t)
+                         (reset-timestamps? #t)
+                         (schema (sql-schema)))
+  "Register all of ITEMS, a list of <store-info> records as returned by
+'read-reference-graph', in the database under PREFIX/STATE-DIRECTORY.  ITEMS
+must be in topological order (with leaves first.)  If the database is
+initially empty, apply SCHEMA to initialize it."
+
+  ;; Priority for options: first what is given, then environment variables,
+  ;; then defaults. %state-directory, %store-directory, and
+  ;; %store-database-directory already handle the "environment variables /
+  ;; defaults" question, so we only need to choose between what is given and
+  ;; those.
+
+  (define db-dir
+    (cond (state-directory
            (string-append state-directory "/db"))
           (prefix
-                   ;; If prefix is specified, the value of NIX_STATE_DIR
-                   ;; (which affects %state-directory) isn't supposed to
-                   ;; affect db-dir, only the compile-time-customized
-                   ;; default should.
            (string-append prefix %localstatedir "/guix/db"))
           (else
            %store-database-directory)))
-         (store-dir (if prefix
+
-                        ;; same situation as above
+  (define store-dir
+    (if prefix
         (string-append prefix %storedir)
         %store-directory))
-         (to-register (if prefix
+
-                          (string-append %storedir "/" (basename path))
+  (define (register db item)
-                          ;; note: we assume here that if path is, for
+    (define to-register
-                          ;; example, /foo/bar/gnu/store/thing.txt and prefix
+      (if prefix
-                          ;; isn't given, then an environment variable has
+          (string-append %storedir "/" (basename (store-info-item item)))
-                          ;; been used to change the store directory to
+          ;; note: we assume here that if path is, for example,
-                          ;; /foo/bar/gnu/store, since otherwise real-path
+          ;; /foo/bar/gnu/store/thing.txt and prefix isn't given, then an
-                          ;; would end up being /gnu/store/thing.txt, which is
+          ;; environment variable has been used to change the store directory
-                          ;; probably not the right file in this case.
+          ;; to /foo/bar/gnu/store, since otherwise real-path would end up
-                          path))
+          ;; being /gnu/store/thing.txt, which is probably not the right file
-         (real-path (string-append store-dir "/" (basename path))))
+          ;; in this case.
-    (let-values (((hash nar-size)
+          (store-info-item item)))
-                  (nar-sha256 real-path)))
+
+    (define real-file-name
+      (string-append store-dir "/" (basename (store-info-item item))))
+
+    (let-values (((hash nar-size) (nar-sha256 real-file-name)))
       (when reset-timestamps?
-        (reset-timestamps real-path))
+        (reset-timestamps real-file-name))
+      (sqlite-register db #:path to-register
+                       #:references (store-info-references item)
+                       #:deriver (store-info-deriver item)
+                       #:hash (string-append "sha256:"
+                                             (bytevector->base16-string hash))
+                       #:nar-size nar-size)
+      (when deduplicate?
+        (deduplicate real-file-name hash #:store store-dir))))
+
   (mkdir-p db-dir)
   (parameterize ((sql-schema schema))
     (with-database (string-append db-dir "/db.sqlite") db
-          (sqlite-register
+      (for-each (cut register db <>) items))))
-           db
-           #:path to-register
-           #:references references
-           #:deriver deriver
-           #:hash (string-append "sha256:"
-                                 (bytevector->base16-string hash))
-           #:nar-size nar-size)))
-
-      (when deduplicate?
-        (deduplicate real-path hash #:store store-dir)))))