aboutsummaryrefslogtreecommitdiff
path: root/guix-build-coordinator/client-communication.scm
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2022-10-11 10:58:52 +0100
committerChristopher Baines <mail@cbaines.net>2022-10-11 10:58:52 +0100
commit2cd06f2cf8a20f719aa3823eeffac8c39b768504 (patch)
tree4d3279047837e6eefefc517a9b9b250595b8a506 /guix-build-coordinator/client-communication.scm
parent05529c1757d0d5e2a81040b86b4a825c7d88fd9c (diff)
downloadbuild-coordinator-2cd06f2cf8a20f719aa3823eeffac8c39b768504.tar
build-coordinator-2cd06f2cf8a20f719aa3823eeffac8c39b768504.tar.gz
Guard against canceling builds required by others
Diffstat (limited to 'guix-build-coordinator/client-communication.scm')
-rw-r--r--guix-build-coordinator/client-communication.scm24
1 files changed, 17 insertions, 7 deletions
diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm
index 8d089bb..e796bd8 100644
--- a/guix-build-coordinator/client-communication.scm
+++ b/guix-build-coordinator/client-communication.scm
@@ -172,9 +172,14 @@
(derivation-inputs . ,(list->vector derivation-inputs))
(setup-failures . ,(list->vector setup-failures))))))))
(('POST "build" uuid "cancel")
- (cancel-build build-coordinator uuid)
- (render-json
- `((result . "build-canceled"))))
+ (let ((query-parameters (request-query-parameters request)))
+ (cancel-build build-coordinator uuid
+ #:ignore-if-build-required-by-another?
+ (string=? (assq-ref query-parameters
+ 'ignore-if-build-required-by-another)
+ "true"))
+ (render-json
+ `((result . "build-canceled")))))
(('POST "build" uuid "update-priority")
(update-build-priority
build-coordinator
@@ -584,12 +589,17 @@
`((defer-until . ,(date->string defer-until "~1 ~3")))
'()))))
-(define (send-cancel-build-request
- coordinator-uri
- build-id)
+(define* (send-cancel-build-request
+ coordinator-uri
+ build-id
+ #:key (ignore-if-build-required-by-another? #t))
(send-request coordinator-uri
'POST
- (string-append "/build/" build-id "/cancel")))
+ (string-append "/build/" build-id "/cancel"
+ "?ignore-if-build-required-by-another="
+ (if ignore-if-build-required-by-another?
+ "true"
+ "false"))))
(define (send-update-build-priority-request
coordinator-uri