diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-03-22 15:17:49 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-03-22 15:55:41 +0000 |
| commit | 51c318b99b7ff2203be7924fc5ff626a113f252c (patch) | |
| tree | e98d002e0d11d6d71bc8d6b932da0906c860f327 | |
| parent | f9bd2f047e295beb8252af8ae1eafaa43b70aa2a (diff) | |
| download | build-coordinator-51c318b99b7ff2203be7924fc5ff626a113f252c.tar build-coordinator-51c318b99b7ff2203be7924fc5ff626a113f252c.tar.gz | |
Have agents send their status every 30 seconds
| -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))) |