base: Move database update from 'evaluate' process to the main process.

Fixes <https://bugs.gnu.org/30618>.
Reported by Andreas Enge <andreas@enge.fr>.

* bin/evaluate.in (fill-job): Remove.
(main): Remove 'database' command-line argument.  Remove DB and its
uses.  Write an (evaluation EVAL JOBS) sexp.
* src/cuirass/base.scm (evaluate)[augment-job]: New procedure.
Use it.  Adjust to read (evaluation EVAL JOBS) sexp.  Call
'db-add-evaluation' and 'db-add-derivation'.

1 files changed, 29 insertions, 12 deletions

diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 8c6cd8c..89f84e9 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -219,6 +219,14 @@ fibers."
 
 (define (evaluate store db spec)
   "Evaluate and build package derivations.  Return a list of jobs."
+  (define (augment-job job eval-id)
+    (let ((drv (read-derivation-from-file
+                (assq-ref job #:derivation))))
+      `((#:eval-id . ,eval-id)
+        (#:nix-name . ,(derivation-name drv))
+        (#:system . ,(derivation-system drv))
+        ,@job)))
+
   (let* ((port (non-blocking-port
                 (open-pipe* OPEN_READ
                             "evaluate"
@@ -227,19 +235,28 @@ fibers."
                                            (assq-ref spec #:load-path))
                             (%guix-package-path)
                             (%package-cachedir)
-                            (object->string spec)
-                            (%package-database))))
-         (jobs (match (read/non-blocking port)
-                 ;; If an error occured during evaluation report it,
-                 ;; otherwise, suppose that data read from port are
-                 ;; correct and keep things going.
-                 ((? eof-object?)
-                  (raise (condition
-                          (&evaluation-error
-                           (name (assq-ref spec #:name))))))
-                 (data data))))
+                            (object->string spec))))
+         (result (match (read/non-blocking port)
+                   ;; If an error occured during evaluation report it,
+                   ;; otherwise, suppose that data read from port are
+                   ;; correct and keep things going.
+                   ((? eof-object?)
+                    (raise (condition
+                            (&evaluation-error
+                             (name (assq-ref spec #:name))))))
+                   (data data))))
     (close-pipe port)
-    jobs))
+    (match result
+      (('evaluation eval jobs)
+       (let ((eval-id (db-add-evaluation db eval)))
+         (log-message "created evaluation ~a for ~a, commit ~a" eval-id
+                      (assq-ref eval #:specification)
+                      (assq-ref eval #:revision))
+         (let ((jobs (map (lambda (job)
+                            (augment-job job eval-id))
+                          jobs)))
+           (for-each (cut db-add-derivation db <>) jobs)
+           jobs))))))
 
 
 ;;;