diff options
| author | Mathieu Othacehe <othacehe@gnu.org> | 2020-10-01 18:18:33 +0200 |
|---|---|---|
| committer | Mathieu Othacehe <othacehe@gnu.org> | 2020-10-01 18:34:58 +0200 |
| commit | cd89fc433f64fbbf1190373096271522e1b0cc0b (patch) | |
| tree | 3adb491150eebe6815ae3e462defd71fc93fc079 /src | |
| parent | 39db021afdb48d0a08a3d8c17eff802af51fefbf (diff) | |
| download | cuirass-cd89fc433f64fbbf1190373096271522e1b0cc0b.tar cuirass-cd89fc433f64fbbf1190373096271522e1b0cc0b.tar.gz | |
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.
Diffstat (limited to 'src')
| -rw-r--r-- | src/cuirass/base.scm | 2 | ||||
| -rw-r--r-- | 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 |