Skip to content
Snippets Groups Projects
Commit 57410b6c authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

base: Account for derivations built behind our back.

Previously any derivation not directly built by Cuirass would be
considered as failed because 'handle-build-event' wouldn't see any build
event.  Here we just make sure the build status recorded in the database
corresponds to reality.

* src/cuirass/base.scm (update-build-statuses!): New procedure.
(spawn-builds): Call it after 'build-derivations&'.
parent 49ec7648
No related branches found
No related tags found
No related merge requests found
......@@ -329,6 +329,19 @@ Essentially this procedure inverts the inversion-of-control that
(sort jobs job<?))
(define (update-build-statuses! store db lst)
"Update the build status of the derivations listed in LST, which have just
been passed to 'build-derivations' (meaning that we can assume that, if their
outputs are invalid, that they failed to build.)"
(define (update! drv)
(match (derivation-path->output-paths drv)
(((_ . outputs) ...)
(if (any (cut valid-path? store <>) outputs)
(db-update-build-status! db drv (build-status succeeded))
(db-update-build-status! db drv (build-status failed))))))
(for-each update! lst))
(define* (spawn-builds store db jobs
#:key (max-batch-size 200))
"Build the derivations associated with JOBS, a list of job alists, updating
......@@ -362,10 +375,14 @@ MAX-BATCH-SIZE items."
(count total))
(if (zero? count)
(log-message "done with ~a derivations" total)
(let-values (((batch rest)
(if (> total max-batch-size)
(split-at jobs max-batch-size)
(values jobs '()))))
(let*-values (((batch rest)
(if (> total max-batch-size)
(split-at jobs max-batch-size)
(values jobs '())))
((drv)
(map (lambda (job)
(assq-ref job #:derivation))
batch)))
(guard (c ((nix-protocol-error? c)
(log-message "batch of builds (partially) failed:\
~a (status: ~a)"
......@@ -374,16 +391,22 @@ MAX-BATCH-SIZE items."
(log-message "building batch of ~a jobs (~a/~a)"
max-batch-size (- total count) total)
(let-values (((port finish)
(build-derivations& store
(map (lambda (job)
(assq-ref job #:derivation))
batch))))
(build-derivations& store drv)))
(process-build-log port
(lambda (event state)
(handle-build-event db event))
#t)
(close-port port)
(finish)))
;; Most of the time 'handle-build-event' will update the build
;; status of derivations. However, it could be that some
;; derivations were built "behind our back", in which case
;; 'build-derivations' doesn't actually do anything and
;; 'handle-build-event' doesn't see any event. Because of that,
;; adjust DB here.
(update-build-statuses! store db drv)
(loop rest (max (- total max-batch-size) 0))))))
(define* (handle-build-event db event)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment