diff options
| -rw-r--r-- | guix-build-coordinator/agent.scm | 78 |
1 files changed, 54 insertions, 24 deletions
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm index c7440c9..3baa368 100644 --- a/guix-build-coordinator/agent.scm +++ b/guix-build-coordinator/agent.scm @@ -325,30 +325,43 @@ (get-compressed-outputs store)))) (perform-post-build-actions - build - (lambda () - (agent-submit-log-file lgr - coordinator-interface - build-id derivation-name) - - (if result - (post-build-success lgr - coordinator-interface - build-id - derivation - end-time - submit-outputs? - output-details - compressed-outputs - with-upload-monitoring) - (post-build-failure lgr + (list + build + (lambda () + (agent-submit-log-file lgr coordinator-interface - build-id - end-time)) - (log-msg lgr 'INFO - build-id - ": finished processing: " - derivation-name))))) + build-id derivation-name) + + (if result + (post-build-success lgr + coordinator-interface + build-id + derivation + end-time + submit-outputs? + output-details + compressed-outputs + with-upload-monitoring) + (post-build-failure lgr + coordinator-interface + build-id + end-time)) + (log-msg lgr 'INFO + build-id + ": finished processing: " + derivation-name))) + #:priority + (list (assoc-ref build "derived_priority") + (if (and result submit-outputs?) + (fold + (lambda (output result) + (let ((file (cdr output))) + (+ (stat:size (stat file)) + result))) + 0 + compressed-outputs) + 0))))) + (begin (log-msg lgr 'INFO build-id @@ -393,7 +406,24 @@ (create-work-queue max-parallel-uploads (lambda (build thunk) (thunk)) - #:name "upload")) + #:name "upload" + + ;; The priority here is a list where the + ;; first element is the build priority, + ;; and the second is the number of bytes + ;; to upload + #:priority<? + (lambda (a b) + (let ((a-priority (first a)) + (b-priority (first b))) + (if (= a-priority b-priority) + (> (second a) + (second b)) + + ;; Prioritise uploading smaller + ;; files first + (< a-priority + b-priority)))))) ((process-job-with-queue count-jobs count-threads list-jobs) (create-work-queue current-max-builds |