diff options
Diffstat (limited to 'guix-build-coordinator')
| -rw-r--r-- | guix-build-coordinator/agent-messaging/http.scm | 21 | ||||
| -rw-r--r-- | guix-build-coordinator/agent.scm | 2 | ||||
| -rw-r--r-- | guix-build-coordinator/coordinator.scm | 8 | ||||
| -rw-r--r-- | guix-build-coordinator/datastore.scm | 2 | ||||
| -rw-r--r-- | guix-build-coordinator/datastore/sqlite.scm | 53 |
5 files changed, 86 insertions, 0 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm index 9448201..cdb0451 100644 --- a/guix-build-coordinator/agent-messaging/http.scm +++ b/guix-build-coordinator/agent-messaging/http.scm @@ -52,6 +52,7 @@ submit-status submit-log-file submit-build-result + report-build-start report-setup-failure submit-output fetch-builds-for-agent)) @@ -323,6 +324,19 @@ port. Also, the port used can be changed by passing the --port option.\n" (render-json '(("error" . "access denied")) #:code 403)))) + (('POST "build" uuid "report-build-start") + (let ((agent-id-for-build + (datastore-agent-for-build datastore uuid))) + (if (authenticated? agent-id-for-build request) + (begin + (handle-build-start-report datastore + agent-id-for-build + uuid) + (render-json + "message received")) + (render-json + '(("error" . "access denied")) + #:code 403)))) (('POST "build" uuid "report-setup-failure") (let ((agent-id-for-build (datastore-agent-for-build datastore uuid))) @@ -695,6 +709,13 @@ port. Also, the port used can be changed by passing the --port option.\n" #:method 'PUT ; TODO Should be PATCH #:body result)) +(define (report-build-start coordinator-uri agent-uuid password + build-id) + (coordinator-http-request + coordinator-uri agent-uuid password + (string-append "/build/" build-id "/report-build-start") + #:method 'POST)) + (define (report-setup-failure coordinator-uri agent-uuid password build-id report) (coordinator-http-request diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm index a5a3f7a..0f9eaff 100644 --- a/guix-build-coordinator/agent.scm +++ b/guix-build-coordinator/agent.scm @@ -62,6 +62,8 @@ (begin (simple-format #t "~A: setup successful, building: ~A\n" build-id derivation-name) + (report-build-start coordinator-uri uuid password + build-id) (let ((result (perform-build derivation-name))) (retry-on-error (lambda () diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 9677e74..f5be80d 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -52,6 +52,7 @@ build-output-file-location build-log-file-location + handle-build-start-report handle-build-result handle-setup-failure-report)) @@ -422,6 +423,13 @@ #f)) #t)))) +(define (handle-build-start-report datastore + agent-id + build-id) + (datastore-store-build-start datastore + build-id + agent-id)) + (define (handle-setup-failure-report datastore agent-id build-id report-json) (let ((failure-reason (assoc-ref report-json "failure_reason"))) diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm index 06334cb..e888387 100644 --- a/guix-build-coordinator/datastore.scm +++ b/guix-build-coordinator/datastore.scm @@ -17,6 +17,8 @@ (re-export datastore-find-agent) (re-export datastore-count-build-results) (re-export datastore-store-build-result) +(re-export datastore-store-build-start) +(re-export datastore-find-build-starts) (re-export datastore-count-setup-failures) (re-export datastore-list-setup-failures-for-build) (re-export datastore-fetch-setup-failures) diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm index 88db088..db9f807 100644 --- a/guix-build-coordinator/datastore/sqlite.scm +++ b/guix-build-coordinator/datastore/sqlite.scm @@ -27,6 +27,8 @@ datastore-new-agent datastore-list-agents datastore-find-agent + datastore-store-build-start + datastore-find-build-starts datastore-count-setup-failures datastore-list-setup-failures-for-build datastore-fetch-setup-failures @@ -592,6 +594,57 @@ VALUES " (store-output-metadata db build-id output-metadata)))) #t) +(define-method (datastore-store-build-start + (datastore <sqlite-datastore>) + build-id + agent-id) + + (call-with-worker-thread + (slot-ref datastore 'worker-writer-thread-channel) + (lambda (db) + (sqlite-exec + db + (string-append + " +INSERT INTO build_starts ( + build_id, agent_id, start_time +) VALUES ('" + build-id "', '" + agent-id "', " + "datetime('now')" + ")"))))) + +(define-method (datastore-find-build-starts + (datastore <sqlite-datastore>) + build-id) + (call-with-worker-thread + (slot-ref datastore 'worker-reader-thread-channel) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " +SELECT start_time, agent_id +FROM build_starts +WHERE build_id = :build_id +ORDER BY start_time DESC"))) + + (sqlite-bind-arguments + statement + #:build_id build-id) + + (let ((result + (sqlite-map + (match-lambda + (#(start_time agent_id) + `((start-time . ,(match (strptime "%F %T" start_time) + ((parts . _) parts))) + (agent-id . ,agent_id)))) + statement))) + (sqlite-reset statement) + + result))))) + (define (insert-setup-failure-and-remove-allocation db build-id |