diff options
| -rw-r--r-- | guix-build-coordinator/agent-messaging/http/server.scm | 31 | ||||
| -rw-r--r-- | guix-build-coordinator/coordinator.scm | 19 |
2 files changed, 31 insertions, 19 deletions
diff --git a/guix-build-coordinator/agent-messaging/http/server.scm b/guix-build-coordinator/agent-messaging/http/server.scm index c9d70d6..a8e0d46 100644 --- a/guix-build-coordinator/agent-messaging/http/server.scm +++ b/guix-build-coordinator/agent-messaging/http/server.scm @@ -457,16 +457,21 @@ port. Also, the port used can be changed by passing the --port option.\n" "not-found" #:code 404)))) - (call-with-error-handling - controller-thunk - #:on-error 'backtrace - #:post-error (lambda args - (match method-and-path-components - ((method path-components ...) - (simple-format - (current-error-port) - "error: when processing: /~A ~A\n" - method (string-join path-components "/")))) - (render-json - `((error . ,(simple-format #f "~A" args))) - #:code 500)))) + (with-exception-handler + (lambda (exn) + (match method-and-path-components + ((method path-components ...) + (simple-format + (current-error-port) + "error: when processing: /~A ~A\n" + method (string-join path-components "/")))) + (if (agent-error? exn) + (render-json + `((error . ,(agent-error-details exn))) + #:code 400) + (render-json + `((error . ,(simple-format #f "~A" exn))) + #:code 500))) + controller-thunk + #:unwind? #t)) + diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 62d181b..bc742cf 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -42,7 +42,10 @@ #:use-module (guix-build-coordinator build-allocator) #:use-module (guix-build-coordinator agent-messaging http server) #:use-module (guix-build-coordinator client-communication) - #:export (make-build-coordinator + #:export (agent-error? + agent-error-details + + make-build-coordinator build-coordinator-datastore build-coordinator-hooks build-coordinator-metrics-registry @@ -68,6 +71,11 @@ handle-build-result handle-setup-failure-report)) +(define-exception-type &agent-error &error + make-agent-error + agent-error? + (details agent-error-details)) + (define-record-type <build-coordinator> (make-build-coordinator-record datastore hooks metrics-registry allocation-strategy) @@ -527,12 +535,12 @@ (let ((build-details (datastore-find-build datastore build-id))) (when (assq-ref build-details 'processed) (raise-exception - (make-exception-with-message "build already processed")))) + (make-agent-error 'build_already_processed)))) (when success? (unless (build-log-file-location build-id) (raise-exception - (make-exception-with-message "missing build log file"))) + (make-agent-error 'missing_build_log_file))) (for-each (lambda (output) @@ -541,9 +549,8 @@ (assq-ref output 'name)))) (unless (file-exists? output-location) (raise-exception - (make-exception-with-message - (simple-format #f "missing output ~A" - (assq-ref output 'name))))))) + (make-agent-error + `((missing_output . ,(assq-ref output 'name)))))))) (datastore-list-build-outputs datastore build-id))) (datastore-store-build-result datastore |