aboutsummaryrefslogtreecommitdiff
path: root/scripts
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2021-02-17 09:12:50 +0000
committerChristopher Baines <mail@cbaines.net>2021-02-17 09:12:50 +0000
commitc72d2a172fafa591da3b73274ed70723d5fbf360 (patch)
tree95b5aca6b38be60302e22fb1f5d0493fb80cbc94 /scripts
parentb3733bca21de607fd7a70319e66e3ff49996a974 (diff)
downloadbuild-coordinator-c72d2a172fafa591da3b73274ed70723d5fbf360.tar
build-coordinator-c72d2a172fafa591da3b73274ed70723d5fbf360.tar.gz
Add a hook for determining whether agents should submit outputs
This should make it possible to check properly whether the outputs are needed, instead of just assuming they are not if there's been a successful build.
Diffstat (limited to 'scripts')
-rw-r--r--scripts/guix-build-coordinator.in101
1 files changed, 40 insertions, 61 deletions
diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in
index e6ebc01..3992c6f 100644
--- a/scripts/guix-build-coordinator.in
+++ b/scripts/guix-build-coordinator.in
@@ -280,67 +280,46 @@
(remove-tags . ())))
(define %service-options
- (list (option '("pid-file") #t #f
- (lambda (opt name arg result)
- (alist-cons 'pid-file
- arg
- result)))
- (option '("agent-communication") #t #f
- (lambda (opt name arg result)
- (alist-cons 'agent-communication
- (string->uri arg)
- (alist-delete 'agent-communication result))))
- (option '("client-communication") #t #f
- (lambda (opt name arg result)
- (alist-cons 'client-communication
- (string->uri arg)
- (alist-delete 'client-communication result))))
- (option '("allocation-strategy") #t #f
- (lambda (opt name arg result)
- (alist-cons
- 'allocation-strategy
- (or (assoc-ref
- `(("basic" . ,basic-build-allocation-strategy)
- ("derivation-ordered"
- . ,derivation-ordered-build-allocation-strategy))
- arg)
- (begin
- (simple-format
- (current-error-port)
- "error: ~A is not a known allocation strategy\n"
- arg)
- (exit 1)))
- result)))
- (option '("build-submitted-hook") #t #f
- (lambda (opt name arg result)
- (alist-cons 'build-submitted-hook
- (read/eval arg)
- (alist-delete 'build-submitted-hook result))))
- (option '("build-canceled-hook") #t #f
- (lambda (opt name arg result)
- (alist-cons 'build-canceled-hook
- (read/eval arg)
- (alist-delete 'build-canceled-hook result))))
- (option '("build-started-hook") #t #f
- (lambda (opt name arg result)
- (alist-cons 'build-started-hook
- (read/eval arg)
- (alist-delete 'build-started-hook result))))
- (option '("build-success-hook") #t #f
- (lambda (opt name arg result)
- (alist-cons 'build-success-hook
- (read/eval arg)
- (alist-delete 'build-success-hook result))))
- (option '("build-failure-hook") #t #f
- (lambda (opt name arg result)
- (alist-cons 'build-failure-hook
- (read/eval arg)
- (alist-delete 'build-failure-hook result))))
- (option '("build-missing-inputs-hook") #t #f
- (lambda (opt name arg result)
- (alist-cons 'build-missing-inputs-hook
- (read/eval arg)
- (alist-delete 'build-missing-inputs-hook result))))))
+ (append
+ (list (option '("pid-file") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'pid-file
+ arg
+ result)))
+ (option '("agent-communication") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'agent-communication
+ (string->uri arg)
+ (alist-delete 'agent-communication result))))
+ (option '("client-communication") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'client-communication
+ (string->uri arg)
+ (alist-delete 'client-communication result))))
+ (option '("allocation-strategy") #t #f
+ (lambda (opt name arg result)
+ (alist-cons
+ 'allocation-strategy
+ (or (assoc-ref
+ `(("basic" . ,basic-build-allocation-strategy)
+ ("derivation-ordered"
+ . ,derivation-ordered-build-allocation-strategy))
+ arg)
+ (begin
+ (simple-format
+ (current-error-port)
+ "error: ~A is not a known allocation strategy\n"
+ arg)
+ (exit 1)))
+ result))))
+ (map (lambda (hook)
+ (option (list (simple-format #f "~A-hook" hook)) #t #f
+ (lambda (opt name arg result)
+ (alist-cons (symbol-append hook '-hook)
+ (read/eval arg)
+ (alist-delete (symbol-append hook '-hook)
+ result)))))
+ %known-hooks)))
(define %service-option-defaults
;; Alist of default option values