[no subject]

[Mathieu Othacehe]

branch: master
commit cd89fc433f64fbbf1190373096271522e1b0cc0b
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Thu Oct 1 18:18:33 2020 +0200

    Do not browse the store during registration.
    
    * src/cuirass/database.scm (db-register-builds): Remove store argument and
    assume that 'log and 'outputs properties are provided by the evaluation.
    * src/cuirass/base.scm (build-packages): Adapt accordingly.
---
 src/cuirass/base.scm     |  2 +-
 src/cuirass/database.scm | 15 ++++++---------
 2 files changed, 7 insertions(+), 10 deletions(-)

diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index ad15ef9..cbbe64b 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -690,7 +690,7 @@ by PRODUCT-SPECS."
   "Build JOBS and return a list of Build results."
   (define derivations
     (with-time-logging "registration"
-                       (db-register-builds store jobs eval-id)))
+                       (db-register-builds jobs eval-id)))
 
   (log-message "evaluation ~a registered ~a new derivations"
                eval-id (length derivations))
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index ff2a5e4..336c9c6 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -661,7 +661,7 @@ path) VALUES ("
                  (assq-ref product #:path) ");")
     (last-insert-rowid db)))
 
-(define (db-register-builds store jobs eval-id)
+(define (db-register-builds jobs eval-id)
   (define (new-outputs? outputs)
     (let ((new-outputs
            (filter-map (match-lambda
@@ -677,13 +677,8 @@ path) VALUES ("
            (job-name (assq-ref job #:job-name))
            (system   (assq-ref job #:system))
            (nix-name (assq-ref job #:nix-name))
-           ;; XXX: How to keep logs from several attempts?
-           (log      (log-file store drv))
-           (outputs  (filter-map (lambda (res)
-                                   (match res
-                                     ((name . path)
-                                      `(,name . ,path))))
-                                 (derivation-path->output-paths drv)))
+           (log      (assq-ref job #:log))
+           (outputs  (assq-ref job #:outputs))
            (cur-time (time-second (current-time time-utc))))
       (and (new-outputs? outputs)
            (let ((build `((#:derivation . ,drv)
@@ -706,7 +701,9 @@ path) VALUES ("
   ;; New builds registration involves running a large number of SQL queries.
   ;; To keep database workers available, use specific database workers
   ;; dedicated to evaluation registration.
-  (with-db-registration-worker-thread db (filter-map register jobs)))
+  (with-db-registration-worker-thread db
+    (log-message "Registering builds for evaluation ~a." eval-id)
+    (filter-map register jobs)))
 
 (define* (db-update-build-status! drv status #:key log-file)
   "Update the database so that DRV's status is STATUS.  This also updates the