aboutsummaryrefslogtreecommitdiff
path: root/guix-build-coordinator/agent.scm
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2020-04-16 21:40:43 +0100
committerChristopher Baines <mail@cbaines.net>2020-04-16 21:40:43 +0100
commite89225ea04c03020c03b0d3b20ddc201e593f8db (patch)
tree726985b3c4f80eec05863774e23cd4a758d5c35b /guix-build-coordinator/agent.scm
parent26cf86e1bee82f87367598ededa0dbfedab76552 (diff)
downloadbuild-coordinator-e89225ea04c03020c03b0d3b20ddc201e593f8db.tar
build-coordinator-e89225ea04c03020c03b0d3b20ddc201e593f8db.tar.gz
Add better error handling in to the agent
So that it reports issues to the coordinator, rather than just crashing.
Diffstat (limited to 'guix-build-coordinator/agent.scm')
-rw-r--r--guix-build-coordinator/agent.scm67
1 files changed, 48 insertions, 19 deletions
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index e514373..4e4a991 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -46,9 +46,13 @@
(let ((pre-build-status (pre-build-process derivation-name)))
(if (eq? (assq-ref pre-build-status 'result) 'success)
(let ((result (perform-build derivation-name)))
- (post-build uuid coordinator-uri password
- (assoc-ref build "uuid")
- derivation-name))
+ (if result
+ (post-build uuid coordinator-uri password
+ (assoc-ref build "uuid")
+ derivation-name)
+ (submit-build-result coordinator-uri uuid password
+ (assoc-ref build "uuid")
+ '((result . failure)))))
(begin
(simple-format #t "failure: ~A\n" pre-build-status)
(report-setup-failure coordinator-uri uuid password
@@ -85,33 +89,58 @@
'()))))
+ (define (delete-outputs derivation)
+ (let* ((outputs (derivation-outputs derivation))
+ (output-file-names
+ (map derivation-output-path (map cdr outputs))))
+ (if (any file-exists? output-file-names)
+ (catch
+ #t
+ (lambda ()
+ (with-store store
+ (delete-paths store output-file-names))
+ #t)
+ (lambda (key args)
+ (simple-format (current-error-port)
+ "error: delete-outputs: ~A ~A\n"
+ key args)
+ #f))
+ #t)))
+
(let ((derivation
(if (file-exists? derivation-name)
(read-derivation-from-file derivation-name)
(and (substitute-derivation derivation-name)
(read-derivation-from-file derivation-name)))))
-
- (let* ((outputs (derivation-outputs derivation))
- (output-file-names
- (map derivation-output-path (map cdr outputs))))
- (when (any file-exists? output-file-names)
- (with-store store
- (delete-paths store output-file-names)))
-
- (let ((missing-inputs
- (find-missing-inputs (derivation-inputs derivation))))
- (if (null? missing-inputs)
- '((result . success))
- `((result . failure)
- (failure_reason . missing_inputs)
- (missing_inputs . ,(list->vector missing-inputs))))))))
+ (match (delete-outputs derivation)
+ (#t
+ (let ((missing-inputs
+ (find-missing-inputs (derivation-inputs derivation))))
+ (if (null? missing-inputs)
+ '((result . success))
+ `((result . failure)
+ (failure_reason . missing_inputs)
+ (missing_inputs . ,(list->vector missing-inputs))))))
+ (failure
+ '((result . failure)
+ (failure_reason . could_not_delete_outputs))))))
(define (perform-build derivation-name)
(with-store store
(set-build-options store
#:use-substitutes? #f)
- (build-things store (list derivation-name))))
+ (catch #t
+ (lambda ()
+ (build-things store (list derivation-name))
+
+ #t)
+ (lambda (key . args)
+ (simple-format (current-error-port)
+ "error: build: ~A ~A\n"
+ key args)
+
+ #f))))
(define (post-build uuid coordinator-uri password
build-id derivation)