diff options
Diffstat (limited to 'guix-data-service/web/build-server/controller.scm')
| -rw-r--r-- | guix-data-service/web/build-server/controller.scm | 89 |
1 files changed, 50 insertions, 39 deletions
diff --git a/guix-data-service/web/build-server/controller.scm b/guix-data-service/web/build-server/controller.scm index e759fc8..473cc61 100644 --- a/guix-data-service/web/build-server/controller.scm +++ b/guix-data-service/web/build-server/controller.scm @@ -20,7 +20,10 @@ #:use-module (ice-9 match) #:use-module (rnrs bytevectors) #:use-module (json) + #:use-module (squee) #:use-module (fibers) + #:use-module (knots) + #:use-module (knots resource-pool) #:use-module (prometheus) #:use-module (guix-data-service utils) #:use-module (guix-data-service database) @@ -123,21 +126,23 @@ (define (spawn-fiber-for-handler handler) (spawn-fiber (lambda () - (with-resource-from-pool (connection-pool) conn - (with-exception-handler - (lambda (exn) - (simple-format - (current-error-port) - "exception in build event handler: ~A\n" - exn)) - (lambda () - (with-throw-handler #t - (lambda () - (handler conn)) - (lambda _ - (display (backtrace) (current-error-port)) - (display "\n" (current-error-port))))) - #:unwind? #t))))) + (call-with-resource-from-pool (background-connection-pool) + (lambda (conn) + (with-exception-handler + (lambda (exn) + (simple-format + (current-error-port) + "exception in build event handler: ~A\n" + exn)) + (lambda () + (with-exception-handler + (lambda (exn) + (print-backtrace-and-exception/knots exn) + (raise-exception exn)) + (lambda () + (handler conn)))) + #:unwind? #t)) + #:timeout #f)))) (define (with-build-ids-for-status data build-ids @@ -218,6 +223,8 @@ (with-postgresql-transaction conn (lambda (conn) + (exec-query conn "SET LOCAL lock_timeout = '5s';") + (handle-derivation-events conn filtered-items)))))) @@ -270,8 +277,15 @@ (if (member provided-token (map cdr permitted-tokens) string=?) - (catch - 'json-invalid + (with-exception-handler + (lambda (exn) + (if (eq? (exception-kind exn) 'json-invalid) + (render-json + '((error . "could not parse body as JSON")) + #:code 400) + (render-json + '((error . "error")) + #:code 403))) (lambda () (let ((body-string (utf8->string body))) (let* ((body-json (json-string->scm body-string)) @@ -287,30 +301,27 @@ '((error . "no items to process")) #:code 400)) (else - (catch - #t + (with-exception-handler + (lambda (exn) + (render-json + '((error . "could not process events")) + #:code 500)) (lambda () - (process-items items) + (with-exception-handler + (lambda (exn) + (print-backtrace-and-exception/knots exn) + (simple-format (current-error-port) + "error processing events: ~A\n" + exn) + (for-each (lambda (item) + (simple-format (current-error-port) + " ~A\n" item)) + items)) + (lambda () + (process-items items))) (no-content)) - (lambda (key . args) - (simple-format (current-error-port) - "error processing events: ~A: ~A\n" - key - args) - (for-each (lambda (item) - (simple-format (current-error-port) - " ~A\n" item)) - items) - (render-json - '((error . "could not process events")) - #:code 500)))))))) - (lambda (key . args) - (render-json - '((error . "could not parse body as JSON")) - #:code 400))) - (render-json - '((error . "error")) - #:code 403))))))) + #:unwind? #t)))))) + #:unwind? #t))))))) (define (handle-signing-key-request id) (render-html |