Subject: [bug#31755] [PATCH 17/19] database: Allow for deterministic database construction.

From: Ludovic Courtès <[email-masked]>
Date: Fri, 8 Jun 2018 11:34:49 +0200

* guix/store/database.scm (sqlite-register): Add #:time.
(%epoch): New variable.
(register-items): Add #:registration-time.  Pass #:time to
'sqlite-register'.
* gnu/build/install.scm (register-closure): Pass #:registration-time.
---
 gnu/build/install.scm   |  1 +
 guix/store/database.scm | 21 ++++++++++++++++-----
 2 files changed, 17 insertions(+), 5 deletions(-)

diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 5e84cd6f6..06ecb3995 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -158,6 +158,7 @@ deduplicates files common to CLOSURE and the rest of PREFIX."
                     #:prefix prefix
                     #:deduplicate? deduplicate?
                     #:reset-timestamps? reset-timestamps?
+                    #:registration-time %epoch
                     #:schema schema)))
 
 (define* (populate-single-profile-directory directory
diff --git a/guix/store/database.scm b/guix/store/database.scm
index 82938455b..05b2ba6c3 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -39,6 +39,7 @@
             sqlite-register
             register-path
             register-items
+            %epoch
             reset-timestamps))
 
 ;;; Code for working with the store database directly.
@@ -160,19 +161,22 @@ ids of items referred to."
               references)))
 
 (define* (sqlite-register db #:key path (references '())
-                          deriver hash nar-size)
+                          deriver hash nar-size time)
   "Registers this stuff in DB.  PATH is the store item to register and
 REFERENCES is the list of store items PATH refers to; DERIVER is the '.drv'
 that produced PATH, HASH is the base16-encoded Nix sha256 hash of
 PATH (prefixed with \"sha256:\"), and NAR-SIZE is the size in bytes PATH after
-being converted to nar form.
+being converted to nar form.  TIME is the registration time to be recorded in
+the database or #f, meaning \"right now\".
 
 Every store item in REFERENCES must already be registered."
   (let ((id (update-or-insert db #:path path
                               #:deriver deriver
                               #:hash hash
                               #:nar-size nar-size
-                              #:time (time-second (current-time time-utc)))))
+                              #:time (time-second
+                                      (or time
+                                          (current-time time-utc))))))
     ;; Call 'path-id' on each of REFERENCES.  This ensures we get a
     ;; "non-NULL constraint" failure if one of REFERENCES is unregistered.
     (add-references db id
@@ -232,15 +236,21 @@ be used internally by the daemon's build hook."
                   #:reset-timestamps? reset-timestamps?
                   #:schema schema))
 
+(define %epoch
+  ;; When it all began.
+  (make-time time-utc 0 1))
+
 (define* (register-items items
                          #:key prefix state-directory
                          (deduplicate? #t)
                          (reset-timestamps? #t)
+                         registration-time
                          (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."
+initially empty, apply SCHEMA to initialize it.  REGISTRATION-TIME must be the
+registration time to be recorded in the database; #f means \"now\"."
 
   ;; Priority for options: first what is given, then environment variables,
   ;; then defaults. %state-directory, %store-directory, and
@@ -284,7 +294,8 @@ initially empty, apply SCHEMA to initialize it."
                        #:deriver (store-info-deriver item)
                        #:hash (string-append "sha256:"
                                              (bytevector->base16-string hash))
-                       #:nar-size nar-size)
+                       #:nar-size nar-size
+                       #:time registration-time)
       (when deduplicate?
         (deduplicate real-file-name hash #:store store-dir))))
 
-- 
2.17.1