diff options
author | Ludovic Courtès <ludo@gnu.org> | 2018-03-01 17:25:14 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2018-03-01 17:25:14 +0100 |
commit | aa4c7784940581b5e271b9c7c4ac80b6ee1ee309 (patch) | |
tree | a6051edc2f5b1e4c34b9a11c0213b8944cbd9ea8 /src/cuirass | |
parent | ad577114dde4c86455262a35ad4b3838eb4a1453 (diff) | |
download | cuirass-aa4c7784940581b5e271b9c7c4ac80b6ee1ee309.tar cuirass-aa4c7784940581b5e271b9c7c4ac80b6ee1ee309.tar.gz |
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'.
Diffstat (limited to 'src/cuirass')
-rw-r--r-- | src/cuirass/base.scm | 41 |
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)))))) ;;; |