From f03b7fa01cfb3d06a264f23b7f3897dfffd3ccbc Mon Sep 17 00:00:00 2001 From: Steffen Beyer Date: Thu, 28 May 2026 21:38:24 +0200 Subject: [PATCH] feat: keep disabled plugins installed Resolve disabled plugins into the Guix generation while passing their names to Tribes as runtime-disabled, preserving package/schema/data for later re-enable. --- tests/tribes-deploy-executor.scm | 26 +++++++++++++++++--- tribes/config/host.scm | 2 ++ tribes/deploy/executor.scm | 41 +++++++++++++++++++------------- tribes/deploy/operations.scm | 24 +++++++++++++------ tribes/deploy/plan.scm | 38 ++++++++++++++++++++++++++--- tribes/deploy/state.scm | 6 +++-- tribes/packages/source.scm | 4 ++-- tribes/plugins/aether.scm | 6 ++--- tribes/plugins/sender.scm | 2 +- tribes/services/tribes.scm | 5 ++++ 10 files changed, 116 insertions(+), 38 deletions(-) diff --git a/tests/tribes-deploy-executor.scm b/tests/tribes-deploy-executor.scm index 48a73cb..2c5dd9d 100644 --- a/tests/tribes-deploy-executor.scm +++ b/tests/tribes-deploy-executor.scm @@ -52,7 +52,8 @@ (test-equal "host config plugins are updated in tribes block" '(("schemaVersion" . "1") ("tribes" . (("host" . "example.com") - ("plugins" . ("aether")))) + ("plugins" . ("aether")) + ("disabledPlugins" . ()))) ("edge" . (("certificateName" . "tribes")))) (host-config-with-plugins '(("schemaVersion" . "1") @@ -61,14 +62,22 @@ ("edge" . (("certificateName" . "tribes")))) '("aether"))) - (test-equal "system target plugin names include only enabled plugins" - '("aether") + (test-equal "system target plugin names include installed plugins" + '("aether" "disabled") (system-target-plugin-names '(("plugins" . ((("plugin_name" . "aether") ("enabled" . #t)) (("plugin_name" . "disabled") ("enabled" . #f))))))) + (test-equal "system target disabled plugin names include disabled plugins" + '("disabled") + (system-target-disabled-plugin-names + '(("plugins" . ((("plugin_name" . "aether") + ("enabled" . #t)) + (("plugin_name" . "disabled") + ("enabled" . #f))))))) + (test-assert "legacy plans without resolved channel metadata still pull" (plan-requires-pull? '(("plan_hash" . "legacy")))) @@ -120,6 +129,17 @@ ("enabled" . #t)))))))) (plan-plugins plan))) + (test-equal "resolve-target keeps disabled plugins installed but runtime-disabled" + '(("aether") ("aether")) + (let ((plan + (resolve-target + `(("trusted_signers" . (,valid-signer)) + ("channels" . (,valid-channel)) + ("plugins" . ((("plugin_name" . "aether") + ("channel_id" . "guix-tribes") + ("enabled" . #f)))))))) + (list (plan-plugins plan) (plan-disabled-plugins plan)))) + (test-equal "resolve-target rejects duplicate plugin requests" "duplicate_plugin" (error-code diff --git a/tribes/config/host.scm b/tribes/config/host.scm index 59cb8d7..18bd2ed 100644 --- a/tribes/config/host.scm +++ b/tribes/config/host.scm @@ -129,6 +129,8 @@ (plugins (resolve-external-plugins (optional-string-list tribes-json "plugins" '()))) + (disabled-plugins + (optional-string-list tribes-json "disabledPlugins" '())) (database-user (optional-string tribes-json "databaseUser" (tribes-configuration-database-user tribes-defaults))) diff --git a/tribes/deploy/executor.scm b/tribes/deploy/executor.scm index eda86d4..e150869 100644 --- a/tribes/deploy/executor.scm +++ b/tribes/deploy/executor.scm @@ -128,13 +128,15 @@ channels) (and (pair? channels) (car channels)))) -(define (requested-enabled-plugins target) +(define (requested-plugins target) (filter (lambda (plugin) (and (json-object? plugin) - (plugin-entry-enabled? plugin) (string? (plugin-entry-name plugin)))) (or (json-list-ref target "plugins") '()))) +(define (requested-enabled-plugins target) + (filter plugin-entry-enabled? (requested-plugins target))) + (define (plugin-definition name) (tribes-plugin-definition-by-name name)) @@ -253,7 +255,7 @@ ("provided_capabilities" . ,guix-tribes-runtime-provided-capabilities))))) (define (plugin-name-duplicates target) - (duplicates (map plugin-entry-name (requested-enabled-plugins target)))) + (duplicates (map plugin-entry-name (requested-plugins target)))) (define (plugin-request-channel plugin channels) (let ((explicit-channel-id (plugin-entry-channel-id plugin))) @@ -276,7 +278,7 @@ (tribes-external-plugin-extra-packages (tribes-plugin-definition-external-plugin definition)))) -(define (resolved-plugin plugin-name channels requested-plugins) +(define (resolved-plugin plugin-name channels requested-plugins enabled-plugin-names) (let* ((definition (plugin-definition plugin-name)) (request-entry (find (lambda (plugin) @@ -285,6 +287,7 @@ (channel (and request-entry (plugin-request-channel request-entry channels)))) `(("name" . ,plugin-name) + ("enabled" . ,(if (member plugin-name enabled-plugin-names) #t #f)) ("channel_id" . ,(and channel (channel-id channel))) ("package_ref" . ,(package-ref channel definition)) ("migration_target_version" . #f) @@ -306,9 +309,10 @@ (define (resolve-target target) (let* ((channels (enabled-channels target)) - (requested-plugins (requested-enabled-plugins target)) + (requested-plugins (requested-plugins target)) (trusted-signers (enabled-trusted-signers target)) (requested-names (map plugin-entry-name requested-plugins)) + (requested-enabled-names (map plugin-entry-name (requested-enabled-plugins target))) (duplicate-plugin-names (plugin-name-duplicates target)) (runtime-error (runtime-capability-error)) (trust-error (channel-trust-error channels trusted-signers))) @@ -321,17 +325,20 @@ (runtime-error runtime-error) (trust-error trust-error) (else - (let ((resolved-names (resolve-plugin-names requested-names))) - (if (resolver-error-object? resolved-names) - resolved-names - (let* ((resolved-channels (map channel->resolved channels)) - (resolved-plugins - (map (lambda (name) - (resolved-plugin name channels requested-plugins)) - resolved-names)) - (resolved-extra-packages - (resolved-extra-packages resolved-names channels requested-plugins)) - (base-plan + (let ((resolved-names (resolve-plugin-names requested-names)) + (enabled-resolved-names (resolve-plugin-names requested-enabled-names))) + (cond + ((resolver-error-object? resolved-names) resolved-names) + ((resolver-error-object? enabled-resolved-names) enabled-resolved-names) + (else + (let* ((resolved-channels (map channel->resolved channels)) + (resolved-plugins + (map (lambda (name) + (resolved-plugin name channels requested-plugins enabled-resolved-names)) + resolved-names)) + (resolved-extra-packages + (resolved-extra-packages resolved-names channels requested-plugins)) + (base-plan `(("plan_schema_version" . "1") ("resolved_channels" . ,(list->vector resolved-channels)) ("resolved_plugins" . ,(list->vector resolved-plugins)) @@ -339,4 +346,4 @@ ("core_migration_target" . #f) ("core_destructive_rollback_migrations" . #()) ("closure_estimate_bytes" . #f)))) - (assoc-set base-plan "plan_hash" (string-plan-hash base-plan))))))))) + (assoc-set base-plan "plan_hash" (string-plan-hash base-plan)))))))))) diff --git a/tribes/deploy/operations.scm b/tribes/deploy/operations.scm index afaef20..071772b 100644 --- a/tribes/deploy/operations.scm +++ b/tribes/deploy/operations.scm @@ -141,11 +141,12 @@ ;; ON-FRAME is called for every helper frame so the worker snapshot can be ;; refreshed in real time. -(define (record-host-config-update! state plugins) +(define* (record-host-config-update! state plugins #:key (disabled-plugins '())) (let* ((host-config-file (deploy-config-host-config-file (state-store-config state))) (host-config (read-json-file host-config-file)) - (updated (host-config-with-plugins host-config plugins))) + (updated (host-config-with-plugins host-config plugins + #:disabled-plugins disabled-plugins))) (atomic-write-json-file host-config-file updated))) (define (channel-field channel key fallback) @@ -253,12 +254,14 @@ (define* (prepare-plugins! state helper plugins plan-hash-value on-frame #:key plan (pull-required? #t)) (let* ((cfg (state-store-config state)) + (disabled-plugins (if plan (plan-disabled-plugins plan) '())) (existing (state-store-find-generation-by-plan-hash state plan-hash-value))) (state-store-write-status! state "running" #:plugins plugins #:plan-hash plan-hash-value #:phase "running") - (record-host-config-update! state plugins) + (record-host-config-update! state plugins + #:disabled-plugins disabled-plugins) (cond ;; Idempotency: if we already built this plan and the store path still ;; exists, just re-register the GC root and report ready. @@ -338,7 +341,8 @@ #:generation-number gen-number #:built-at #f #:gc-pinned #t - #:plugins plugins) + #:plugins plugins + #:disabled-plugins disabled-plugins) (state-store-write-status! state "completed" #:plugins plugins #:plan-hash plan-hash-value @@ -395,7 +399,9 @@ #:activated-at #f #:gc-pinned #t #:plugins - (or (json-string-list-ref existing "plugins") '())) + (or (json-string-list-ref existing "plugins") '()) + #:disabled-plugins + (or (json-string-list-ref existing "disabled_plugins") '())) (state-store-activate-generation! state selected-store-path) (state-store-write-status! state "completed" #:plan-hash plan-hash-value @@ -466,7 +472,10 @@ #:code "plugin_migration_rollback_failed" #:store-path store-path) (let* ((target-plugins (or (json-string-list-ref generation "plugins") '())) - (_ (record-host-config-update! state target-plugins)) + (target-disabled-plugins + (or (json-string-list-ref generation "disabled_plugins") '())) + (_ (record-host-config-update! state target-plugins + #:disabled-plugins target-disabled-plugins)) (gen-number (json-ref generation "generation_number")) (switch-result ((helper-backend-switch helper) cfg gen-number on-frame))) (cond @@ -489,7 +498,8 @@ #:built-at (json-ref generation "built_at") #:activated-at #f #:gc-pinned #t - #:plugins target-plugins) + #:plugins target-plugins + #:disabled-plugins target-disabled-plugins) (state-store-activate-generation! state active-store-path) (state-store-write-status! state "completed" #:store-path active-store-path diff --git a/tribes/deploy/plan.scm b/tribes/deploy/plan.scm index c6df692..111b2ad 100644 --- a/tribes/deploy/plan.scm +++ b/tribes/deploy/plan.scm @@ -10,7 +10,9 @@ deployment-request-plugins host-config-with-plugins system-target-plugin-names + system-target-disabled-plugin-names plan-plugins + plan-disabled-plugins plan-resolved-channels plan-requires-pull? plan-hash @@ -65,7 +67,8 @@ "plugins"))))) (or plugins '()))) -(define (host-config-with-plugins host-config plugin-names) +(define* (host-config-with-plugins host-config plugin-names + #:key (disabled-plugins '())) (unless (json-object? host-config) (error "host config must be a JSON object")) (let ((tribes-config (json-ref host-config "tribes"))) @@ -73,7 +76,9 @@ (error "host config is missing tribes object")) (assoc-set host-config "tribes" - (assoc-set tribes-config "plugins" plugin-names)))) + (assoc-set + (assoc-set tribes-config "plugins" plugin-names) + "disabledPlugins" disabled-plugins)))) (define (system-target-plugin-names target) (let ((plugins (or (json-list-ref target "plugins") '()))) @@ -81,7 +86,18 @@ (filter-map (lambda (plugin) (and (json-object? plugin) - (plugin-entry-enabled? plugin) + (let ((name (plugin-entry-name plugin))) + (and (string? name) name)))) + plugins) + string