From 2cd06f2cf8a20f719aa3823eeffac8c39b768504 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Tue, 11 Oct 2022 10:58:52 +0100 Subject: Guard against canceling builds required by others --- guix-build-coordinator/client-communication.scm | 24 +++++++++++++++++------- 1 file changed, 17 insertions(+), 7 deletions(-) (limited to 'guix-build-coordinator/client-communication.scm') 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 -- cgit v1.2.3