diff options
| -rw-r--r-- | guix-build-coordinator/agent-messaging/http.scm | 8 | ||||
| -rw-r--r-- | guix-build-coordinator/agent.scm | 29 |
2 files changed, 32 insertions, 5 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm index b7b1877..74f7c9c 100644 --- a/guix-build-coordinator/agent-messaging/http.scm +++ b/guix-build-coordinator/agent-messaging/http.scm @@ -258,13 +258,17 @@ . args) (apply - (lambda* (status #:key (log default-log)) + (lambda* (status #:key 1min-load-average (log default-log)) (coordinator-http-request log interface (string-append "/agent/" (slot-ref interface 'agent-uuid)) #:method 'PUT ; TODO Should be PATCH - #:body `((status . ,status)))) + #:body `((status . ,status) + ,@(if 1min-load-average + `((load_average + . ((1 . ,1min-load-average)))) + '())))) args)) (define-method (submit-output diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm index de28211..696c1ee 100644 --- a/guix-build-coordinator/agent.scm +++ b/guix-build-coordinator/agent.scm @@ -448,9 +448,9 @@ (let ((details (submit-status coordinator-interface 'idle - #:log (build-log-procedure - lgr - (assoc-ref build "uuid"))))) + #:1min-load-average + (get-load-average #:period 1) + #:log (build-log-procedure lgr)))) (for-each (lambda (job-args) (process-job-with-queue job-args)) @@ -476,6 +476,29 @@ (display-info) (loop (get-line (current-input-port)))))))) + (unless (running-on-the-hurd?) + (call-with-new-thread + (lambda () + (set-thread-name "gbc submit status") + + (while #t + (with-exception-handler + (lambda (exn) + (log-msg lgr 'WARN "exception submitting status: " exn)) + (lambda () + (submit-status coordinator-interface + (if (= (+ (count-jobs) + (count-post-build-jobs)) + 0) + 'idle + 'active) + #:1min-load-average + (get-load-average #:period 1) + #:log (build-log-procedure lgr))) + #:unwind? #t) + + (sleep 30))))) + (while #t (let ((current-threads (count-threads)) (job-count (count-jobs))) |