diff options
| -rw-r--r-- | scripts/guix-build-coordinator.in | 56 |
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 |