diff options
| -rw-r--r-- | guix-build-coordinator/client-communication.scm | 20 | ||||
| -rw-r--r-- | guix-build-coordinator/datastore/sqlite.scm | 71 | ||||
| -rw-r--r-- | scripts/guix-build-coordinator.in | 38 |
3 files changed, 101 insertions, 28 deletions
diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm index 094ab4e..5a66cdd 100644 --- a/guix-build-coordinator/client-communication.scm +++ b/guix-build-coordinator/client-communication.scm @@ -55,6 +55,7 @@ request-agent-build-allocation-plan request-agents-list request-failed-builds-with-blocking-count-list + request-setup-failures send-create-agent-request send-agent-set-active-request send-create-agent-password-request @@ -334,6 +335,16 @@ (render-json `((error . 404)) #:code 404)))) + (('GET "setup-failures") + (let ((query-parameters (request-query-parameters request))) + (render-json + `((setup_failures + . ,(hash-map->list + (lambda (k v) + (cons k (list->vector v))) + (datastore-fetch-setup-failures + datastore + #:agent-id (assq-ref query-parameters 'agent-id)))))))) (('GET "builds") (let* ((query-parameters (request-query-parameters request)) (fold-builds-args @@ -944,6 +955,15 @@ "false")) "")))) +(define* (request-setup-failures coordinator-uri #:key agent-id) + (send-request coordinator-uri + 'GET + (string-append + "/setup-failures" + (if agent-id + (simple-format #f "?agent-id=~A" agent-id) + "")))) + (define* (send-create-agent-request coordinator-uri #:key requested-uuid diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm index e5ae519..5e39849 100644 --- a/guix-build-coordinator/datastore/sqlite.scm +++ b/guix-build-coordinator/datastore/sqlite.scm @@ -2893,14 +2893,19 @@ WHERE build_id = :build_id" result))))) (define-method (datastore-fetch-setup-failures - (datastore <sqlite-datastore>)) - (call-with-worker-thread - (slot-ref datastore 'worker-reader-thread-channel) - (lambda (db) - (let ((statement - (sqlite-prepare - db - " + (datastore <sqlite-datastore>) + . + args) + (apply + (lambda* (#:key agent-id) + (call-with-worker-thread + (slot-ref datastore 'worker-reader-thread-channel) + (lambda (db) + (let ((statement + (sqlite-prepare + db + (string-append + " SELECT setup_failures.id, builds.uuid, agent_id, failure_reason FROM setup_failures INNER JOIN builds @@ -2910,28 +2915,38 @@ WHERE builds.processed = 0 AND builds.id NOT IN ( SELECT build_id FROM allocated_builds )" - #:cache? #t))) + (if agent-id + " + AND agent_id = :agent_id" + "")) + #:cache? #t))) - (let ((result (sqlite-fold - (lambda (row result) - (match row - (#(id build-id agent-id failure-reason) - (let ((failures-for-build-id - (or (hash-ref result build-id) - '()))) - (hash-set! - result - build-id - (cons `((id . ,id) - (agent-id . ,agent-id) - (failure-reason . ,failure-reason)) - failures-for-build-id))))) - result) - (make-hash-table) - statement))) - (sqlite-reset statement) + (when agent-id + (sqlite-bind-arguments + statement + #:agent_id agent-id)) + + (let ((result (sqlite-fold + (lambda (row result) + (match row + (#(id build-id agent-id failure-reason) + (let ((failures-for-build-id + (or (hash-ref result build-id) + '()))) + (hash-set! + result + build-id + (cons `((id . ,id) + (agent-id . ,agent-id) + (failure-reason . ,failure-reason)) + failures-for-build-id))))) + result) + (make-hash-table) + statement))) + (sqlite-reset statement) - result))))) + result))))) + args)) (define-method (datastore-list-processed-builds (datastore <sqlite-datastore>)) diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index 62b48e2..10970d7 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -156,6 +156,17 @@ (ensure-all-related-derivation-outputs-have-builds . #f) (tags . ()))) +(define %setup-failure-options + (list + (option '("agent-id") #t #f + (lambda (opt name arg result) + (alist-cons 'agent-id + arg + (alist-delete 'agent-id result)))))) + +(define %setup-failure-option-defaults + `((agent-id . #f))) + (define %common-build-filtering-options (list (option '("tag") #t #f @@ -988,6 +999,33 @@ tags: (assoc-ref (request-agents-list (assq-ref opts 'coordinator)) "agents"))))) + (("setup-failures" "list" rest ...) + (let ((opts (parse-options (append %client-options + %base-options + %setup-failure-options) + (append %client-option-defaults + %base-option-defaults + %setup-failure-option-defaults) + rest))) + (for-each + (match-lambda + ((build-id . setup-failures) + (for-each + (lambda (setup-failure) + (simple-format #t "~A:\n" + (assoc-ref setup-failure "id")) + (simple-format #t " build-id: ~A\n" + build-id) + (simple-format #t " agent-id: ~A\n" + (assoc-ref setup-failure "agent-id")) + (simple-format #t " failure-reason: ~A\n" + (assoc-ref setup-failure "failure-reason")) + (newline)) + (vector->list setup-failures)))) + (assoc-ref + (request-setup-failures (assq-ref opts 'coordinator) + #:agent-id (assq-ref opts 'agent-id)) + "setup_failures")))) (("dynamic-auth" "create-token") (let ((opts (parse-options (append %client-options %base-options) |