diff options
| -rw-r--r-- | guix-build-coordinator/client-communication.scm | 21 | ||||
| -rw-r--r-- | guix-build-coordinator/coordinator.scm | 12 | ||||
| -rw-r--r-- | scripts/guix-build-coordinator.in | 15 |
3 files changed, 36 insertions, 12 deletions
diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm index 39b0c23..d9f2c88 100644 --- a/guix-build-coordinator/client-communication.scm +++ b/guix-build-coordinator/client-communication.scm @@ -178,8 +178,16 @@ . ,(cancel-build build-coordinator uuid #:ignore-if-build-required-by-another? - (string=? (assq-ref query-parameters - 'ignore-if-build-required-by-another) + (string=? (or (assq-ref + query-parameters + 'ignore-if-build-required-by-another) + "") + "true") + #:skip-updating-derived-priorities? + (string=? (or + (assq-ref query-parameters + 'skip-updating-derived-priorities) + "") "true"))))))) (('POST "build" uuid "update-priority") (update-build-priority @@ -595,14 +603,19 @@ (define* (send-cancel-build-request coordinator-uri build-id - #:key (ignore-if-build-required-by-another? #t)) + #:key + (ignore-if-build-required-by-another? #t) + skip-updating-derived-priorities?) (send-request coordinator-uri 'POST (string-append "/build/" build-id "/cancel" "?ignore-if-build-required-by-another=" (if ignore-if-build-required-by-another? "true" - "false")))) + "false") + (if skip-updating-derived-priorities? + "&skip-updating-derived-priorities=true" + "")))) (define (send-update-build-priority-request coordinator-uri diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index ac871c2..c532735 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -477,7 +477,8 @@ stop-condition))))) (define* (cancel-build build-coordinator uuid - #:key (ignore-if-build-required-by-another? #t)) + #:key (ignore-if-build-required-by-another? #t) + skip-updating-derived-priorities?) (define datastore (build-coordinator-datastore build-coordinator)) (define (perform-operation) @@ -511,10 +512,11 @@ 'build-canceled)))) (when (eq? val 'build-canceled) - (datastore-update-unprocessed-builds-with-lower-derived-priorities - datastore - uuid - #f) + (unless skip-updating-derived-priorities? + (datastore-update-unprocessed-builds-with-lower-derived-priorities + datastore + uuid + #f)) (trigger-build-allocation build-coordinator) diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index c892fe3..d2f2c8a 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -269,7 +269,12 @@ (cons arg (or (assq-ref result 'not-systems) '())) - (alist-delete 'not-systems result)))))) + (alist-delete 'not-systems result)))) + (option '("skip-updating-derived-priorities") #f #f + (lambda (opt name _ result) + (alist-cons 'skip-updating-derived-priorities + #t + result))))) (define %build-cancel-option-defaults `((tags . ()) @@ -632,14 +637,18 @@ tags: (for-each (lambda (id) (send-cancel-build-request (assq-ref opts 'coordinator) - id) + id + #:skip-updating-derived-priorities? + (assq-ref opts 'skip-updating-derived-priorities)) (report)) matching-builds))) (loop (get-batch))))))) ((build-id) (send-cancel-build-request (assq-ref opts 'coordinator) - build-id))))) + build-id + #:skip-updating-derived-priorities? + (assq-ref opts 'skip-updating-derived-priorities)))))) (("build" "update-priority" rest ...) (let ((opts (parse-options (append %client-options %base-options |