diff options
-rw-r--r-- | guix-build-coordinator/agent-messaging/http.scm | 39 | ||||
-rw-r--r-- | guix-build-coordinator/coordinator.scm | 39 |
2 files changed, 66 insertions, 12 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm index 7d96054..7d61ab4 100644 --- a/guix-build-coordinator/agent-messaging/http.scm +++ b/guix-build-coordinator/agent-messaging/http.scm @@ -22,6 +22,7 @@ #:use-module (srfi srfi-11) #:use-module (ice-9 match) #:use-module (ice-9 format) + #:use-module (ice-9 exceptions) #:use-module (ice-9 textual-ports) #:use-module (ice-9 binary-ports) #:use-module (system repl error-handling) @@ -205,15 +206,29 @@ port. Also, the port used can be changed by passing the --port option.\n" (let ((agent-id-for-build (datastore-agent-for-build datastore uuid))) (if (authenticated? agent-id-for-build request) - (begin - (handle-build-result datastore hook-channel - agent-id-for-build uuid - (json-string->scm (utf8->string body))) - ;; Trigger build allocation, as the result of this build could - ;; change the allocation - (trigger-build-allocation) - (render-json - "message received")) + (with-exception-handler + (lambda (exn) + (simple-format (current-error-port) + "exception: ~A\n" + exn) + (render-json + `((error . ,(exception-message exn))) + #:code 500)) ; TODO better code + (lambda () + (with-exception-handler + (lambda (exn) + (backtrace) + (raise-exception exn)) + (lambda () + (handle-build-result datastore hook-channel + agent-id-for-build uuid + (json-string->scm (utf8->string body))) + ;; Trigger build allocation, as the result of this build + ;; could change the allocation + (trigger-build-allocation) + (render-json + "message received")))) + #:unwind? #t) (render-json "access denied" #:code 403)))) @@ -415,7 +430,11 @@ port. Also, the port used can be changed by passing the --port option.\n" #:body (scm->json-string result) #:headers `((Authorization . ,auth-value))))) - (json-string->scm (utf8->string body)))) + (let ((message + (json-string->scm (utf8->string body)))) + (if (>= (response-code response) 400) + (error message) + message)))) (define (report-setup-failure coordinator-uri agent-uuid password build-id report) diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index f641ca8..14fbd5d 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -20,8 +20,11 @@ (define-module (guix-build-coordinator coordinator) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (ice-9 ftw) #:use-module (ice-9 match) #:use-module (ice-9 threads) + #:use-module (ice-9 exceptions) #:use-module (gcrypt random) #:use-module (fibers channels) #:use-module (guix derivations) @@ -202,19 +205,51 @@ (basename output) ".nar.lz"))) -(define (build-log-file-location datastore build-id format) +(define (build-log-file-directory build-id) (string-append (%config 'build-logs-dir) "/" - build-id "/" + build-id)) + +(define (build-log-file-location datastore build-id format) + (string-append (build-log-file-directory build-id) "/" (cond ((string=? format "bzip2") "log.bz2") ((string=? format "gzip") "log.gz") (else (error "unknown log format" format))))) +(define (build-log-file-exists? build-id) + (let ((potential-files + (scandir (build-log-file-directory build-id) + (negate (cut member <> '("." "..")))))) + (match potential-files + ((file) file) + (() #f) + (#f #f) ; directory doesn't exist + (files (error + (simple-format #f "found multiple files for ~A: ~A" + build-id files)))))) + (define (handle-build-result datastore hook-channel agent-id build-id result-json) (let* ((result (assoc-ref result-json "result")) (success? (string=? result "success"))) + (when success? + (unless (build-log-file-exists? build-id) + (raise-exception + (make-exception-with-message "missing build log file"))) + + (for-each + (lambda (output) + (let ((output-location + (build-output-file-location datastore build-id + (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))))))) + (datastore-list-build-outputs datastore build-id))) + (datastore-store-build-result datastore build-id agent-id |