From 0ffd8caeeb8a0713300ed90bbcad1775078db0af Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 23 Nov 2019 11:50:51 +0000
Subject: Add a script to help manage build servers

This computes and displays the tokens needed to send build events to the Guix
Data Service.
---
 .gitignore                                        |  1 +
 Makefile.am                                       |  1 +
 configure.ac                                      |  1 +
 scripts/guix-data-service-manage-build-servers.in | 72 +++++++++++++++++++++++
 4 files changed, 75 insertions(+)
 create mode 100644 scripts/guix-data-service-manage-build-servers.in

diff --git a/.gitignore b/.gitignore
index 5889951..9023cd9 100644
--- a/.gitignore
+++ b/.gitignore
@@ -22,6 +22,7 @@ scripts/guix-data-service
 scripts/guix-data-service-process-job
 scripts/guix-data-service-process-jobs
 scripts/guix-data-service-query-build-servers
+scripts/guix-data-service-manage-build-servers
 scripts/guix-data-service-process-branch-updated-email
 scripts/guix-data-service-process-branch-updated-mbox
 test-env
diff --git a/Makefile.am b/Makefile.am
index 5964900..e5dea6f 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -26,6 +26,7 @@ bin_SCRIPTS =							\
   scripts/guix-data-service-process-jobs			\
   scripts/guix-data-service-process-branch-updated-email	\
   scripts/guix-data-service-process-branch-updated-mbox	\
+  scripts/guix-data-service-manage-build-servers		\
   scripts/guix-data-service-query-build-servers
 
 moddir = $(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION)
diff --git a/configure.ac b/configure.ac
index 5fbbe1c..996ba26 100644
--- a/configure.ac
+++ b/configure.ac
@@ -48,6 +48,7 @@ AC_CONFIG_FILES([scripts/guix-data-service-process-job], [chmod +x scripts/guix-
 AC_CONFIG_FILES([scripts/guix-data-service-process-jobs], [chmod +x scripts/guix-data-service-process-jobs])
 AC_CONFIG_FILES([scripts/guix-data-service-process-branch-updated-email], [chmod +x scripts/guix-data-service-process-branch-updated-email])
 AC_CONFIG_FILES([scripts/guix-data-service-process-branch-updated-mbox], [chmod +x scripts/guix-data-service-process-branch-updated-mbox])
+AC_CONFIG_FILES([scripts/guix-data-service-manage-build-servers], [chmod +x scripts/guix-data-service-manage-build-servers])
 AC_CONFIG_FILES([scripts/guix-data-service-query-build-servers], [chmod +x scripts/guix-data-service-query-build-servers])
 AC_CONFIG_FILES([test-env:build-aux/test-env.in], [chmod +x test-env])
 AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
diff --git a/scripts/guix-data-service-manage-build-servers.in b/scripts/guix-data-service-manage-build-servers.in
new file mode 100644
index 0000000..b994e2b
--- /dev/null
+++ b/scripts/guix-data-service-manage-build-servers.in
@@ -0,0 +1,72 @@
+#!@GUILE@ --no-auto-compile
+-*- scheme -*-
+-*- geiser-scheme-implementation: guile -*-
+!#
+;;; Guix Data Service -- Information about Guix over time
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
+;;;
+;;; This file is part of guix-data-service.
+;;;
+;;; guix-data-service is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; guix-data-service is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with the guix-data-service.  If not, see <http://www.gnu.org/licenses/>.
+
+(use-modules (srfi srfi-1)
+             (srfi srfi-37)
+             (ice-9 match)
+             (ice-9 textual-ports)
+             (squee)
+             (guix-data-service database)
+             (guix-data-service model build-server)
+             (guix-data-service model build-server-token-seed)
+             (guix-data-service builds))
+
+(define %options
+  ;; Specifications of the command-line options
+  (list (option '("secret-key-base-file") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'secret-key-base
+                              (string-trim-right
+                               (call-with-input-file arg get-string-all))
+                              result)))))
+
+(define (parse-options args)
+  (args-fold
+   args %options
+   (lambda (opt name arg result)
+     (error "unrecognized option" name))
+   (lambda (arg result)
+     (error "extraneous argument" arg))
+   '()))
+
+(let ((opts (parse-options (cdr (program-arguments)))))
+  (with-postgresql-connection
+   "manage-build-servers"
+   (lambda (conn)
+     (for-each
+      (match-lambda
+        ((id url lookup-all-derivations?)
+         (simple-format #t "\nBuild server: ~A (id: ~A)\n"
+                        url
+                        id)
+         (map
+          (match-lambda
+            ((token-seed . token)
+             (simple-format #t " - token-seed: ~A
+   token:      ~A\n"
+                            token-seed
+                            token)))
+          (compute-tokens-for-build-server
+           conn
+           (assq-ref opts 'secret-key-base)
+           id))))
+      (select-build-servers conn)))))
-- 
cgit v1.2.3