diff options
author | Christopher Baines <mail@cbaines.net> | 2021-01-31 09:38:17 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2021-01-31 09:38:17 +0000 |
commit | 21ff9aa32bc895ee84f0d68e5d2c12bcfd77ad33 (patch) | |
tree | 7a19a7ede330fb47a38c85a1ffcf6ee02a08f6c3 | |
parent | 302142db4f6a330befd85f9daee904cf8bfc885d (diff) | |
download | build-coordinator-21ff9aa32bc895ee84f0d68e5d2c12bcfd77ad33.tar build-coordinator-21ff9aa32bc895ee84f0d68e5d2c12bcfd77ad33.tar.gz |
Support listing and canceling builds by derivation system
-rw-r--r-- | guix-build-coordinator/client-communication.scm | 26 | ||||
-rw-r--r-- | guix-build-coordinator/datastore/sqlite.scm | 28 | ||||
-rw-r--r-- | scripts/guix-build-coordinator.in | 50 |
3 files changed, 97 insertions, 7 deletions
diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm index cd164ec..921cfe9 100644 --- a/guix-build-coordinator/client-communication.scm +++ b/guix-build-coordinator/client-communication.scm @@ -309,6 +309,20 @@ ((tag_key) tag_key)) #f))) query-parameters) + #:systems + (filter-map (match-lambda + ((key . value) + (if (eq? key 'system) + value + #f))) + query-parameters) + #:not-systems + (filter-map (match-lambda + ((key . value) + (if (eq? key 'not-system) + value + #f))) + query-parameters) #:processed (match (assq 'processed query-parameters) ((_ . val) @@ -503,6 +517,8 @@ #:key (tags '()) (not-tags '()) + (systems '()) + (not-systems '()) (processed 'unset) (canceled 'unset) (after-id #f) @@ -526,6 +542,16 @@ (key (simple-format #f "not_tag=~A" key))) not-tags)) + ,@(if (null? systems) + '() + (map (lambda (system) + (simple-format #f "system=~A" system)) + systems)) + ,@(if (null? not-systems) + '() + (map (lambda (system) + (simple-format #f "not-system=~A" system)) + not-systems)) ,@(if (boolean? processed) (if processed '("processed=true") diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm index 71f67e6..107a799 100644 --- a/guix-build-coordinator/datastore/sqlite.scm +++ b/guix-build-coordinator/datastore/sqlite.scm @@ -1276,6 +1276,8 @@ WHERE uuid = :uuid" (define* (list-builds #:key (tags '()) (not-tags '()) + (systems '()) + (not-systems '()) (processed 'unset) (canceled 'unset) (after-id #f) @@ -1357,6 +1359,8 @@ SELECT id FROM tags WHERE key = :key" (let* ((where-needed? (or (not (null? tag-expressions)) (not (null? not-tag-expressions)) + (not (null? systems)) + (not (null? not-systems)) (not (eq? processed 'unset)) (not (eq? canceled 'unset)))) (statement @@ -1365,7 +1369,13 @@ SELECT id FROM tags WHERE key = :key" (string-append " SELECT uuid, derivation_name, priority, processed, canceled, created_at, end_time -FROM builds +FROM builds" + (if (and (null? systems) + (null? not-systems)) + "" + " +INNER JOIN derivations ON builds.derivation_name = derivations.name") + " INNER JOIN ( SELECT build_id, (',' || group_concat(tag_id) || ',') AS tag_string FROM build_tags @@ -1384,6 +1394,22 @@ INNER JOIN ( (if (null? all-tag-expressions) '() all-tag-expressions)) + (list + (string-append + "(" + (string-join + (map (lambda (system) + (simple-format + #f + "derivations.system = '~A'" + system)) + systems) + " OR ") + ")")) + (map (lambda (system) + (simple-format #f "derivations.system != '~A'" + system)) + not-systems) (cond ((eq? processed #t) '("processed = 1")) ((eq? processed #f) '("processed = 0")) diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index 537addc..78a9885 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -157,6 +157,20 @@ (or (assq-ref result 'not-tags) '())) (alist-delete 'not-tags result)))) + (option '("system") #t #f + (lambda (opt name arg result) + (alist-cons 'systems + (cons arg + (or (assq-ref result 'systems) + '())) + (alist-delete 'systems result)))) + (option '("not-system") #t #f + (lambda (opt name arg result) + (alist-cons 'not-systems + (cons arg + (or (assq-ref result 'not-systems) + '())) + (alist-delete 'not-systems result)))) (option '("processed") #t #f (lambda (opt name arg result) (alist-cons 'processed @@ -181,6 +195,8 @@ (define %builds-list-option-defaults `((tags . ()) (not-tags . ()) + (systems . ()) + (not-systems . ()) (processed . 'unset) (canceled . 'unset) (limit . 1000))) @@ -207,11 +223,27 @@ ((key) key)) (or (assq-ref result 'not-tags) '())) - (alist-delete 'not-tags result)))))) + (alist-delete 'not-tags result)))) + (option '("system") #t #f + (lambda (opt name arg result) + (alist-cons 'systems + (cons arg + (or (assq-ref result 'systems) + '())) + (alist-delete 'systems result)))) + (option '("not-system") #t #f + (lambda (opt name arg result) + (alist-cons 'not-systems + (cons arg + (or (assq-ref result 'not-systems) + '())) + (alist-delete 'not-systems result)))))) (define %build-cancel-option-defaults `((tags . ()) - (not-tags . ()))) + (not-tags . ()) + (systems . ()) + (not-systems . ()))) (define %agent-tag-options (list (option '("tag") #t #f @@ -427,6 +459,8 @@ canceled?: ~A (assq-ref opts 'coordinator) #:tags (assq-ref opts 'tags) #:not-tags (assq-ref opts 'not-tags) + #:systems (assq-ref opts 'systems) + #:not-systems (assq-ref opts 'not-systems) #:processed (assq-ref opts 'processed) #:canceled (assq-ref opts 'canceled) #:after-id (or after-id (assq-ref opts 'after-id)) @@ -452,10 +486,12 @@ tags: "false") (assoc-ref build-details "priority") (string-join - (map (match-lambda - ((key . val) - (string-append " " key ": " val))) - (assoc-ref build-details "tags")) + (map (lambda (tag) + (let ((key (assoc-ref tag "key")) + (val (assoc-ref tag "value"))) + (string-append " " key ": " val))) + (vector->list + (assoc-ref build-details "tags"))) "\n"))) (vector->list (assoc-ref response "builds"))) @@ -498,6 +534,8 @@ tags: (assq-ref opts 'coordinator) #:tags (assq-ref opts 'tags) #:not-tags (assq-ref opts 'not-tags) + #:systems (assq-ref opts 'systems) + #:not-systems (assq-ref opts 'not-systems) #:processed #f #:canceled #f #:after-id after-id |