From 1d6c818ec060278d625db432d7ee9c9a30352cad Mon Sep 17 00:00:00 2001 From: vyzo Date: Sun, 25 Aug 2024 11:19:57 +0300 Subject: [PATCH] ensemble config tool, fix some bugz --- src/std/actor-v18/ensemble-config.ss | 4 + src/std/actor-v18/ensemble-supervisor.ss | 15 ++-- src/std/actor-v18/filesystem.ss | 7 +- src/std/actor-v18/supervisor.ss | 3 +- src/tools/build.ss | 1 + src/tools/env.ss | 17 +++- src/tools/gxensemble.ss | 27 ++++-- src/tools/gxensemble/cmd.ss | 2 + src/tools/gxensemble/config.ss | 73 ++++++++++++++++ src/tools/gxensemble/opt.ss | 104 +++++++++++++++++++++-- src/tools/gxhttpd.ss | 1 + src/tools/gxhttpd/config.ss | 2 +- 12 files changed, 232 insertions(+), 24 deletions(-) create mode 100644 src/tools/gxensemble/config.ss diff --git a/src/std/actor-v18/ensemble-config.ss b/src/std/actor-v18/ensemble-config.ss index 4e17571c4..c3029059c 100644 --- a/src/std/actor-v18/ensemble-config.ss +++ b/src/std/actor-v18/ensemble-config.ss @@ -13,6 +13,9 @@ ;;; domain: ;;; ;;; [optional] root path for ensemble executions ;;; root: +;;; ;;; [optional] supervisor public address (over TLS) +;;; public-address: +;;; ;;; ;;; supervisory services ;;; services: ( ;;; ;;; supervisor config @@ -206,6 +209,7 @@ [config: 'ensemble-v0 (merge-select old new domain:) ... (merge-select old new root:) ... + (merge-select old new public-address:) ... (merge-plist old new services:) ... (merge-alist old new roles:) ... (merge-plist old new preload:) ... diff --git a/src/std/actor-v18/ensemble-supervisor.ss b/src/std/actor-v18/ensemble-supervisor.ss index a6cf06138..66f50c053 100644 --- a/src/std/actor-v18/ensemble-supervisor.ss +++ b/src/std/actor-v18/ensemble-supervisor.ss @@ -32,7 +32,9 @@ (create-directory* root/log)) (parameterize ((current-log-directory (or root/log (ensemble-log-directory)))) (let* ((cfg (ensemble-config-merge - (default-ensemble-config (config-get! cfg domain:)) + (default-ensemble-config + (config-get! cfg domain:) + (config-get cfg public-address:)) cfg)) (root (: (config-get! cfg root:) :string)) (domain (: (config-get! cfg domain:) :symbol)) @@ -51,14 +53,14 @@ (wait-for-actor! 'supervisor) (thunk))))))))) -(def (default-ensemble-config domain) +(def (default-ensemble-config domain (public-address #f)) [config: 'ensemble-v0 domain: domain root: (path-normalize (current-directory)) - services: [supervisor: (default-ensemble-supervisor-config domain) + services: [supervisor: (default-ensemble-supervisor-config domain public-address) registry: (default-ensemble-registry-config domain)]]) -(def (default-ensemble-supervisor-config domain) +(def (default-ensemble-supervisor-config domain (public-address #f)) (parameterize ((ensemble-domain domain)) (let ((supervisor-id (cons 'supervisor domain)) (registry-id (cons 'registry domain))) @@ -75,7 +77,10 @@ log-level: 'INFO log-dir: (ensemble-server-log-directory supervisor-id) log-file: (ensemble-server-log-file supervisor-id "server.log") - addresses: [(ensemble-server-unix-addr supervisor-id)] + addresses: [(ensemble-server-unix-addr supervisor-id) + (if public-address + [[tls: public-address]] + []) ...] known-servers: [[registry-id (ensemble-server-unix-addr registry-id)]]]))) (def (default-ensemble-registry-config domain) diff --git a/src/std/actor-v18/filesystem.ss b/src/std/actor-v18/filesystem.ss index 4764f3566..ae8032532 100644 --- a/src/std/actor-v18/filesystem.ss +++ b/src/std/actor-v18/filesystem.ss @@ -160,9 +160,12 @@ (def (upload-finish key type blob-path deploy-path) (def (tar-expand base) - (let (expand-path (path-expand deploy-path base)) + (let (expand-path + (if (string-empty? deploy-path) + base + (path-expand deploy-path base))) (create-directory* expand-path) - (invoke "tar" ["xzf" "-C" expand-path blob-path]))) + (invoke "tar" ["xzf" blob-path] directory: expand-path))) (try (cond ((equal? type '(exe . gz)) diff --git a/src/std/actor-v18/supervisor.ss b/src/std/actor-v18/supervisor.ss index 24fe9ca6e..f300acf94 100644 --- a/src/std/actor-v18/supervisor.ss +++ b/src/std/actor-v18/supervisor.ss @@ -147,7 +147,8 @@ (ensemble-server-config-merge base-role-cfg role-server-cfg)))) (def (get-server-config role domain server-id) - (let* ((server-id (server-identifier-at-domain server-id domain)) + (let* ((domain (ensemble-subdomain domain)) + (server-id (server-identifier-at-domain server-id domain)) (base-cfg (get-base-server-config server-id)) (role-cfg (get-role-server-config role server-id))) (ensemble-server-config-merge base-cfg role-cfg))) diff --git a/src/tools/build.ss b/src/tools/build.ss index 9f5da73f9..ceca6514b 100755 --- a/src/tools/build.ss +++ b/src/tools/build.ss @@ -14,6 +14,7 @@ "gxensemble/admin" "gxensemble/env" "gxensemble/control" + "gxensemble/config" "gxensemble/ca" "gxensemble/list" "gxensemble/misc" diff --git a/src/tools/env.ss b/src/tools/env.ss index 29be4e5a4..402c5c3a1 100644 --- a/src/tools/env.ss +++ b/src/tools/env.ss @@ -1,16 +1,27 @@ ;;; -*- Gerbil -*- ;;; © vyzo ;;; common environment context for tools -(import (only-in :std/cli/getopt flag)) +(import (only-in :std/cli/getopt flag option)) (export #t) (def global-env-flag (flag 'global-env "-g" "--global-env" help: "use the user global env even in local package context")) +(def gerbil-path-option + (option 'gerbil-path "-G" "--gerbil-path" + help: "specifies the GERBIL_PATH for ensemble operations")) + (def (setup-local-env! opt) - (unless (hash-get opt 'global-env) - (setup-local-pkg-env! #f))) + (cond + ((hash-get opt 'gerbil-path) + => (lambda (path) + (unless (file-exists? path) + (create-directory* path)) + (setenv "GERBIL_PATH" path) + (add-load-path! (path-expand "lib" path)))) + ((not (hash-get opt 'global-env)) + (setup-local-pkg-env! #f)))) (def (setup-local-pkg-env! create?) (unless (getenv "GERBIL_PATH" #f) diff --git a/src/tools/gxensemble.ss b/src/tools/gxensemble.ss index c68d0bd6f..af01670b4 100644 --- a/src/tools/gxensemble.ss +++ b/src/tools/gxensemble.ss @@ -13,6 +13,7 @@ program: "gxensemble" help: "the Gerbil Actor Ensemble Manager" global-env-flag + gerbil-path-option supervisor-cmd registry-cmd run-cmd @@ -27,7 +28,8 @@ admin-cmd list-cmd ca-cmd - package-cmd)) + package-cmd + config-cmd)) (defrule (defcommand-table name body ...) (def name @@ -49,7 +51,8 @@ (shutdown do-shutdown) (admin do-admin) (ca do-ca) - (package do-package)) + (package do-package) + (config do-config)) (defcommand-table env-commands (known-servers do-env-known-servers) @@ -92,6 +95,12 @@ (setup do-ca-setup) (cert do-ca-cert)) +(defcommand-table config-commands + (ensemble do-config-ensemble) + (role do-config-role) + (server do-config-server) + (workers do-config-workers)) + (defrule (dispatch-command cmd opt commands) (let (table (force commands)) (cond @@ -110,10 +119,6 @@ program: name gopts ...)))) -(def (gxensemble-main cmd opt) - (setup-local-env! opt) - (dispatch-command cmd opt main-commands)) - (defcommand-nested do-admin admin-commands "gxensemble admin" admin-cookie-cmd admin-creds-cmd @@ -146,6 +151,12 @@ control-shutdown-cmd control-restart-cmd) +(defcommand-nested do-config config-commands "gxensemble config" + config-ensemble-cmd + config-role-cmd + config-preload-server-cmd + config-preload-workers-cmd) + (defcommand-nested do-list list-commands "gxensemble list" list-servers-cmd list-actors-cmd @@ -154,3 +165,7 @@ (defcommand-nested do-ca ca-commands "gxensemble ca" ca-setup-cmd ca-cert-cmd) + +(def (gxensemble-main cmd opt) + (setup-local-env! opt) + (dispatch-command cmd opt main-commands)) diff --git a/src/tools/gxensemble/cmd.ss b/src/tools/gxensemble/cmd.ss index 98bd50567..d61a013ff 100644 --- a/src/tools/gxensemble/cmd.ss +++ b/src/tools/gxensemble/cmd.ss @@ -5,6 +5,7 @@ ./admin ./env ./control + ./config ./ca ./list ./misc @@ -14,6 +15,7 @@ (import: ./admin ./env ./control + ./config ./ca ./list ./misc diff --git a/src/tools/gxensemble/config.ss b/src/tools/gxensemble/config.ss new file mode 100644 index 000000000..757ad7f26 --- /dev/null +++ b/src/tools/gxensemble/config.ss @@ -0,0 +1,73 @@ +;;; -*- Gerbil -*- +;;; © vyzo +;;; actor ensemble management tool +(import :std/config + :std/actor + :std/sugar + ./util) +(export #t) + +;;; ensemble configuration commands +(def (do-config-ensemble opt) + (let-hash opt + (let (cfg (get-ensemble-config)) + (if .?view + (write-config cfg pretty: .?pretty) + (begin + (cond (.?ensemble-domain => (cut config-push! cfg domain: <>))) + (cond (.?ensemble-root => (cut config-push! cfg root: <>))) + (cond (.?ensemble-public-address => (cut config-push! cfg public-address: <>))) + (save-config! cfg (ensemble-config-path))))))) + +(def (do-config-role opt) + (let-hash opt + (let* ((cfg (get-ensemble-config)) + (role (or .?role (error "role must be specified"))) + (role-alist (config-get cfg roles: [])) + (role-cfg (agetq role role-alist [])) + (role-server-cfg + (config-get role-cfg server-config: (empty-ensemble-server-config)))) + (cond (.?exe => (cut config-push! role-cfg exe: <>))) + (cond (.?prefix => (cut config-push! role-cfg prefix: <>))) + (cond (.?suffix => (cut config-push! role-cfg suffix: <>))) + (cond (.?policy => (cut config-push! role-cfg policy: <>))) + (cond (.?env => (cut config-push! role-server-cfg env: <>))) + (cond (.?envvars => (cut config-push! role-server-cfg envvars: <>))) + (cond (.?known-servers => (cut config-push! role-server-cfg known-server: <>))) + (when .?application + (let (default-config-path + (path-expand (symbol->string .application) + (path-expand "config" + (gerbil-path)))) + (unless (or .?config (file-exists? default-config-path)) + (error "application config must be specified")) + (let* ((config-path (or .config default-config-path)) + (app-config (call-with-input-file config-path read-config)) + (app-alist (config-get role-server-cfg application: []))) + (cond + ((assq .application app-alist) + => (lambda (p) (set-cdr! p app-config))) + (else + (set! app-alist [[.application app-config ...] app-alist ...]))) + (config-push! role-server-cfg application: app-alist)))) + (config-push! role-cfg server-config: role-server-cfg) + (cond + ((assq role role-alist) + => (lambda (p) (set-cdr! p role-cfg))) + (else + (set! role-alist [[role role-cfg ...] role-alist ...]))) + (config-push! cfg roles: role-alist) + (save-config! cfg (ensemble-config-path))))) + +(def (do-config-server opt) + (error "TODO: configure preloaded server")) + +(def (do-config-workers opt) + (error "TODO: configure preloaded workers")) + + +(def (get-ensemble-config) + (let (path (ensemble-config-path)) + (if (file-exists? path) + (load-ensemble-config-file path) + (empty-ensemble-config)))) diff --git a/src/tools/gxensemble/opt.ss b/src/tools/gxensemble/opt.ss index d3e1230a6..337b66538 100644 --- a/src/tools/gxensemble/opt.ss +++ b/src/tools/gxensemble/opt.ss @@ -7,12 +7,21 @@ ;;; ;;; getopt objects ;;; + (def ensemble-domain-option (option 'ensemble-domain "-D" "--ensemble-domain" value: string->symbol default: #f help: "specifies the ensemble domain")) +(def ensemble-public-address-option + (option 'ensemble-public-address "--public" + help: "specifies the ensemble supervisor public address for TLS")) + +(def ensemble-root-option + (option 'ensemble-root "--root" + help: "specifies the ensemble root directory")) + (def control-domain-option (option 'domain "-d" "--domain" value: string->symbol @@ -197,7 +206,7 @@ help: "arguments for the module's main procedure")) (def supervised-flag - (flag 'supervised "--supervised" + (flag 'supervised "-s" "--supervised" help: "the operation is supervised by the ensemble supervisor")) (def env-add-flag @@ -256,25 +265,70 @@ (flag 'view "--view" help: "inspect existing, don't generate")) +(def role-exe-option + (option 'exe "--exe" + help: "role executable path")) + +(def role-exe-prefix-option + (option 'prefix "--prefix" + value: string->object + help: "role executable arguments prefix; a list")) + +(def role-exe-suffix-option + (option 'suffix "--suffix" + value: string->object + help: "role executable arguments suffix; a list")) + +(def supervisor-policy-option + (option 'policy "--policy" + value: string->symbol + help: "role supervisory policy")) + +(def server-env-option + (option 'env "--env" + help: "role server environment")) + +(def server-envvars-option + (option 'envvars "--envvars" + value: string->object + help: "role server environment variables")) + +(def server-known-servers-option + (option 'known-servers "--known-servers" + value: string->object + help: "role server known servers for external communication")) + +(def server-application-option + (option 'application "--application" + value: string->symbol + help: "role server application name")) + +(def server-application-config-option + (option 'config "-C" "--config" + help: "role server application configuration")) + (def (subcommand help) (argument 'subcommand help: help value: string->symbol)) (def subcommand-env - (subcommand "what to do: known-servers|domain|supervisor")) + (subcommand "see gerbil ensemble env help")) (def subcommand-control - (subcommand "what to do: list-servers|start-server|start-workers|stop-server|restart-server|get-server-log|update-server-config|get-server-config|update-ensemble-config|get-ensemble-config|upload|shell|exec-process|kill-process|restart-process|get-process-output|shutdown|restart")) + (subcommand "see gerbil ensemble control help")) (def subcommand-list - (subcommand "what to do: servers|actors|connections")) + (subcommand "see gerbil ensemble list help")) (def subcommand-admin - (subcommand "what to do: cookie|creds|authorize|retract")) + (subcommand "see gerbil ensemble admin help")) (def subcommand-ca - (subcommand "what to do: setup|cert")) + (subcommand "see gerbil ensemble ca help")) + +(def subcommand-config + (subcommand "see gerbil ensemble config help")) (def subcommand-arguments (rest-arguments 'subcommand-args @@ -321,6 +375,12 @@ subcommand-arguments help: "ensemble supervisory control operations")) +(def config-cmd + (command 'config + subcommand-config + subcommand-arguments + help: "configure the ensemble")) + (def load-cmd (command 'load console-option @@ -591,6 +651,38 @@ restart-services-flag help: "mass restart servers in a supervised ensemble")) +;; config +(def config-ensemble-cmd + (command 'ensemble + view-flag + pretty-flag + ensemble-domain-option + ensemble-root-option + ensemble-public-address-option + help: "configure the ensemble as a whole")) + +(def config-role-cmd + (command 'role + role-option + role-exe-option + role-exe-prefix-option + role-exe-suffix-option + supervisor-policy-option + server-env-option + server-envvars-option + server-known-servers-option + server-application-option + server-application-config-option + help: "configure an ensemble role")) + +(def config-preload-server-cmd + (command 'server + help: "TODO: configure a preloaded server")) + +(def config-preload-workers-cmd + (command 'workers + help: "TODO: configure preloaded workers")) + ;; list subcommands (def list-servers-cmd (command 'servers diff --git a/src/tools/gxhttpd.ss b/src/tools/gxhttpd.ss index 290fee41b..8407f8194 100644 --- a/src/tools/gxhttpd.ss +++ b/src/tools/gxhttpd.ss @@ -17,6 +17,7 @@ program: "gxhttpd" help: "The Gerbil HTTP Daemon" global-env-flag + gerbil-path-option server-cmd ensemble-cmd config-cmd)) diff --git a/src/tools/gxhttpd/config.ss b/src/tools/gxhttpd/config.ss index 965694d0f..b6532819c 100644 --- a/src/tools/gxhttpd/config.ss +++ b/src/tools/gxhttpd/config.ss @@ -136,7 +136,7 @@ (load-httpd-config (httpd-config-path))) (def (httpd-config-path (base (gerbil-path))) - (path-expand "httpd/config" (gerbil-path))) + (path-expand "config/httpd" (gerbil-path))) (def (get-ensemble-config opt) (let (path (or (hash-get opt 'config) (ensemble-config-path)))