Fix agent confusion over how many builds are running

The previous code was less than ideal, this simpler and avoids less messy
state.

1 files changed, 39 insertions, 52 deletions

diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index ef2cc61..3209dd8 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -54,15 +54,6 @@
                                lvl
                                str))))
 
-
-  (define (fetch-jobs current-count max-count)
-    (let ((received-builds
-           (fetch-builds-for-agent coordinator-uri uuid password
-                                   systems
-                                   max-count
-                                   #:log (build-log-procedure lgr))))
-      received-builds))
-
   (define (process-job build)
     (let ((build-id (assoc-ref build "uuid"))
           (derivation-name (assoc-ref build "derivation-name")))
@@ -118,54 +109,50 @@
 
   (log-msg lgr 'INFO "starting agent " uuid)
   (log-msg lgr 'INFO "connecting to coordinator " coordinator-uri)
-  (let-values (((process-job-with-queue count-jobs)
+  (let-values (((process-job-with-queue count-jobs list-jobs)
                 (create-work-queue max-parallel-builds
                                    process-job)))
     (let ((details (submit-status coordinator-uri uuid password 'idle
                                   #:log (build-log-procedure
                                          (assoc-ref build "uuid")))))
-      (let* ((builds (vector->list (assoc-ref details "builds")))
-             (initial-build-ids (map (lambda (build)
-                                       (assoc-ref build "uuid"))
-                                     builds)))
-        (for-each
-         (lambda (job-args)
-           (process-job-with-queue job-args))
-         builds)
-
-        (let loop ((build-ids initial-build-ids))
-          (let ((job-count (count-jobs)))
-            (if (< job-count max-parallel-builds)
-                (let* ((fetched-builds
-                        (fetch-jobs job-count max-parallel-builds))
-                       (new-builds
-                        (remove (lambda (build)
-                                  (member (assoc-ref build "uuid")
-                                          build-ids))
-                                fetched-builds)))
-
-                  (log-msg lgr 'INFO
-                           "max " max-parallel-builds
-                           " builds, currently allocated "
-                           (length fetched-builds))
-                  (log-msg lgr 'INFO
-                           "starting " (length new-builds)
-                           " new "
-                           (if (eq? (length new-builds) 1) "build" "builds"))
-                  (for-each
-                   (lambda (job-args)
-                     (process-job-with-queue job-args))
-                   new-builds)
-
-                  (when (null? new-builds)
-                    (sleep 30))
-
-                  (loop (map (lambda (build)
-                               (assoc-ref build "uuid"))
-                             fetched-builds)))
-                (begin
-                  (sleep 3)
-                  (loop build-ids)))))))))
+      (for-each
+       (lambda (job-args)
+         (process-job-with-queue job-args))
+       (vector->list (assoc-ref details "builds")))
+
+      (while #t
+        (if (< (count-jobs) max-parallel-builds)
+            (let* ((queued-build-ids
+                    (map (lambda (job-args)
+                           (assoc-ref (car job-args) "uuid"))
+                         (list-jobs)))
+                   (fetched-builds
+                    (fetch-builds-for-agent coordinator-uri uuid password
+                                            systems
+                                            max-parallel-builds
+                                            #:log (build-log-procedure lgr)))
+                   (new-builds
+                    (remove (lambda (build)
+                              (member (assoc-ref build "uuid")
+                                      queued-build-ids))
+                            fetched-builds)))
+
+              (log-msg lgr 'INFO
+                       "max " max-parallel-builds
+                       " builds, currently allocated "
+                       (length fetched-builds))
+              (log-msg lgr 'INFO
+                       "starting " (length new-builds)
+                       " new "
+                       (if (eq? (length new-builds) 1) "build" "builds"))
+              (for-each
+               (lambda (job-args)
+                 (process-job-with-queue job-args))
+               new-builds)
+
+              (when (null? new-builds)
+                (sleep 30)))
+            (sleep 3))))))
 
 (define* (build-log-procedure lgr #:optional build-id)
   (lambda (level . components)