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

@@ -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

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)))

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))))))))))

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

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<?)))
+
+(define (system-target-disabled-plugin-names target)
+  (let ((plugins (or (json-list-ref target "plugins") '())))
+    (sort
+     (filter-map
+      (lambda (plugin)
+        (and (json-object? plugin)
+             (not (plugin-entry-enabled? plugin))
              (let ((name (plugin-entry-name plugin)))
                (and (string? name) name))))
       plugins)
@@ -101,6 +117,22 @@
       resolved)
      string<?)))
 
+(define (plan-disabled-plugins plan)
+  (let ((resolved (or (json-list-ref plan "resolved_plugins")
+                      (json-list-ref plan "resolvedPlugins")
+                      '())))
+    (sort
+     (filter-map
+      (lambda (plugin)
+        (and (json-object? plugin)
+             (let ((enabled-entry (assoc "enabled" plugin)))
+               (and enabled-entry (equal? (cdr enabled-entry) #f)))
+             (let ((name (or (json-ref plugin "name")
+                             (plugin-entry-name plugin))))
+               (and (string? name) name))))
+      resolved)
+     string<?)))
+
 (define (plan-resolved-channels plan)
   (or (json-list-ref plan "resolved_channels")
       (json-list-ref plan "resolvedChannels")))

tribes/deploy/state.scm

@@ -291,7 +291,8 @@ predate the local-control deployment state and therefore may not appear in
                                          built-at
                                          activated-at
                                          (gc-pinned #t)
-                                         (plugins #f))
+                                         (plugins #f)
+                                         (disabled-plugins #f))
   (let ((generation
          `(("store_path" . ,store-path)
            ("generation_number" . ,generation-number)
@@ -300,7 +301,8 @@ predate the local-control deployment state and therefore may not appear in
            ("gc_pinned" . ,gc-pinned)
            ("built_at" . ,built-at)
            ("activated_at" . ,activated-at)
-           ,@(if plugins `(("plugins" . ,plugins)) '()))))
+           ,@(if plugins `(("plugins" . ,plugins)) '())
+           ,@(if disabled-plugins `(("disabled_plugins" . ,disabled-plugins)) '()))))
     (state-store-upsert-generation! store generation)
     (when (string=? generation-status "active")
       (state-store-activate-generation! store store-path))

tribes/packages/source.scm

@@ -54,7 +54,7 @@
   "https://git.teralink.net/tribes/tribes.git")
 
 (define %tribes-commit
-  "309ef7b04766883067f9795f5bdf40fd05bff340")
+  "dd61e5d88c44dfbd1a27c5c80a73643413894e52")
 
 (define %tribes-revision "1")
 
@@ -62,7 +62,7 @@
   (git-version "0.2.0" %tribes-revision %tribes-commit))
 
 (define %tribes-source-sha256
-  "0z6qi23zll4wz4b7ly43kxwgwkz6s03wxxsiz02wbikyi0b3bfri")
+  "1d7a7p6cf0gjm0s1jcclsbns6vsqhncgmpchlzihhl8ka0yr8bq2")
 
 (define %tribes-upstream-source
   (origin

tribes/plugins/aether.scm

@@ -16,7 +16,7 @@
   %aether-home-page)
 
 (define %aether-commit
-  "b4b8c83ddb2ea49bb3a770f27f956bbfbfd30d88")
+  "34bec7225b8a2657d7b9bcc51aec3fc260117c2c")
 
 (define %aether-revision "1")
 
@@ -24,10 +24,10 @@
   (git-version "0.2.0" %aether-revision %aether-commit))
 
 (define %aether-source-sha256
-  "0nnhz58q4d6w4gmdwdgzbh6bds0mmwcrs3n71hp26b1m1dbhzvf7")
+  "108ks4j2prb11a16g10r0l16j6wxzx457jk0filk57s580j7i7j4")
 
 (define %aether-mix-deps-sha256
-  "061xxapdxhq9b3mgicwn8najnz3rz0lgcwqqv475cff5c68y7jwc")
+  "1pk1qv8skbgzi0wg59zj9aiyxx2hxl2k6ngxqqbwvj7wsbiz95bb")
 
 (define %aether-npm-deps-sha256
   "10cwajh8yfdfd9znhibnbali1i8bk7wxrviih03n67lfkmxmghz2")

tribes/plugins/sender.scm

@@ -28,7 +28,7 @@
   "0dm13hvc3qawab7kh8mvjf0hzz6vlx52g9fh9njg96fi2ghqcyhx")
 
 (define %sender-mix-deps-sha256
-  "08mdy38247dqni8f84y09m8vz6hvjakvc4ml28x1jxqvq53s4nq3")
+  "1j23whn54r7j2i9n328zdjkcl59kwgg9wg3spsz23z6c38p9r083")
 
 (define %sender-npm-deps-sha256
   "1ksryrfzhs2jdlq4prj04725i5fcdvhslamfzl77i7knsh5sclfd")

tribes/services/tribes.scm

@@ -24,6 +24,7 @@
             tribes-configuration?
             tribes-configuration-package
             tribes-configuration-plugins
+            tribes-configuration-disabled-plugins
             tribes-configuration-user
             tribes-configuration-group
             tribes-configuration-working-directory
@@ -66,6 +67,8 @@
            (default #f))
   (plugins tribes-configuration-plugins
            (default '()))
+  (disabled-plugins tribes-configuration-disabled-plugins
+                    (default '()))
   (user tribes-configuration-user
         (default "tribes"))
   (group tribes-configuration-group
@@ -296,6 +299,8 @@
       #~(setenv "TRIBES_SYNC_BIND_ADDRESS"
                 #$(tribes-configuration-sync-bind-address config))
       #~(setenv "TRIBES_PLUGIN_DIR" #$(tribes-effective-plugin-directory config))
+      #~(setenv "TRIBES_DISABLED_PLUGINS"
+                #$(string-join (tribes-configuration-disabled-plugins config) ","))
       #~(setenv "TRIBES_LOCAL_CONTROL_SOCKET"
                 #$(tribes-local-control-socket-file config))
       #~(setenv "TRIBES_ADMIN_PUBKEYS"