From 6c46c2b4506dc5e6dc2f06f6afff979bf6dcb5e0 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 17 Jan 2021 16:11:02 +0000
Subject: Allow changing agent tags through the command line

---
 scripts/guix-build-coordinator.in | 56 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 56 insertions(+)

(limited to 'scripts')

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
-- 
cgit v1.2.3