aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--scripts/guix-build-coordinator.in56
1 files changed, 56 insertions, 0 deletions
diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in
index de8e789..c33d37a 100644
--- a/scripts/guix-build-coordinator.in
+++ b/scripts/guix-build-coordinator.in
@@ -202,6 +202,29 @@
`((tags . ())
(not-tags . ())))
+(define %agent-tag-options
+ (list (option '("tag") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'tags
+ (cons (match (string-split arg #\=)
+ ((key value) (cons key value)))
+ (or (assq-ref result 'tags)
+ '()))
+ (alist-delete 'tags result))))
+ (option '("remove-tag") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'remove-tags
+ (cons (match (string-split arg #\=)
+ ((key value) (cons key value))
+ ((key) key))
+ (or (assq-ref result 'remove-tags)
+ '()))
+ (alist-delete 'remove-tags result))))))
+
+(define %agent-tag-option-defaults
+ `((tags . ())
+ (remove-tags . ())))
+
(define %service-options
(list (option '("pid-file") #t #f
(lambda (opt name arg result)
@@ -579,6 +602,39 @@ tags:
agent-id)))
(simple-format #t "new password: ~A\n"
(assoc-ref response "new-password")))))
+ (("agent" agent-id "tags" rest ...)
+ (let ((opts (parse-options (append %agent-tag-options
+ %client-options
+ %base-options)
+ (append %agent-tag-option-defaults
+ %client-option-defaults
+ %base-option-defaults)
+ rest)))
+ (let ((agent-details (request-agent-details
+ (assq-ref opts 'coordinator)
+ agent-id)))
+ (let* ((initial-tags (assoc-ref agent-details "tags"))
+ (new-tags (remove
+ (match-lambda
+ ((key . val)
+ (any (match-lambda
+ ((k . v)
+ (and (string=? key k)
+ (string=? val v)))
+ (k
+ (string=? key k)))
+ (assq-ref opts 'remove-tags))))
+ (append initial-tags
+ (assq-ref opts 'tags)))))
+ (let ((response (send-replace-agent-tags-request
+ (assq-ref opts 'coordinator)
+ agent-id
+ new-tags)))
+ (simple-format #t "changed tags to:\n")
+ (for-each (match-lambda
+ ((k . v)
+ (simple-format #t " - ~A: ~A\n" k v)))
+ new-tags))))))
(("agent" "list" rest ...)
(let ((opts (parse-options %base-options
(append %base-option-defaults