Move config/test/models to daemon TCP protocol, TUI uses .env fallback
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 29s
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 29s
- Daemon: add handle-client-config inline handler for :config-get, :config-set, :config-list, :provider-test, :provider-models - TUI cmd-config: write .env directly, send reload to daemon if connected - TUI: /config test and /config models send TCP to daemon (fallback: daemon-not-running message) - Add Test Provider and Discover Models to Ctrl+P daemon commands
This commit is contained in:
@@ -496,9 +496,15 @@ Called from handle-submit."
|
|||||||
(dolist (e (sort entries #'string-lessp :key #'car))
|
(dolist (e (sort entries #'string-lessp :key #'car))
|
||||||
(format out "~a=~a~%" (car e) (cdr e)))))))
|
(format out "~a=~a~%" (car e) (cdr e)))))))
|
||||||
|
|
||||||
|
(defun daemon-send (action-plist)
|
||||||
|
"Send a message to the daemon if connected. Returns T if sent."
|
||||||
|
(let ((s (st :stream)))
|
||||||
|
(when (and s (open-stream-p s))
|
||||||
|
(send-daemon (list :type :event :payload action-plist))
|
||||||
|
t)))
|
||||||
|
|
||||||
(defun cmd-config (text)
|
(defun cmd-config (text)
|
||||||
"Handle /config commands using direct .env file access."
|
"Handle /config commands. Writes .env directly, sends to daemon if connected."
|
||||||
(let* ((parts (uiop:split-string text :separator '(#\Space)))
|
(let* ((parts (uiop:split-string text :separator '(#\Space)))
|
||||||
(sub (and (>= (length parts) 2) (second parts))))
|
(sub (and (>= (length parts) 2) (second parts))))
|
||||||
(case (and sub (intern (string-upcase sub) :keyword))
|
(case (and sub (intern (string-upcase sub) :keyword))
|
||||||
@@ -506,17 +512,29 @@ Called from handle-submit."
|
|||||||
(let ((name (third parts))
|
(let ((name (third parts))
|
||||||
(key (fourth parts)))
|
(key (fourth parts)))
|
||||||
(if (and name key)
|
(if (and name key)
|
||||||
(progn (config-env-set (format nil "~a_API_KEY" (string-upcase name)) key)
|
(let ((env-key (format nil "~a_API_KEY" (string-upcase name))))
|
||||||
(add-msg :system (format nil "✓ ~a API key set" name)))
|
(config-env-set env-key key)
|
||||||
|
(daemon-send (list :action :reload-config))
|
||||||
|
(add-msg :system (format nil "✓ ~a API key set" name)))
|
||||||
(add-msg :system "Usage: /config provider <name> <apikey>"))))
|
(add-msg :system "Usage: /config provider <name> <apikey>"))))
|
||||||
((:test :models :status)
|
(:test
|
||||||
(add-msg :system "Run this from the daemon session (Passepartout) — /config only reads/writes .env"))
|
(let ((name (third parts)))
|
||||||
|
(if (and name (daemon-send (list :action :provider-test :name name)))
|
||||||
|
(add-msg :system (format nil "Testing ~a... (response will appear)" name))
|
||||||
|
(add-msg :system "* Daemon not running — start passepartout daemon *"))))
|
||||||
|
(:models
|
||||||
|
(let ((name (third parts)))
|
||||||
|
(if (and name (daemon-send (list :action :provider-models :name name)))
|
||||||
|
(add-msg :system (format nil "Discovering ~a models... (response will appear)" name))
|
||||||
|
(add-msg :system "* Daemon not running — start passepartout daemon *"))))
|
||||||
(:cascade
|
(:cascade
|
||||||
(let ((slot (third parts))
|
(let ((slot (third parts))
|
||||||
(cascade (fourth parts)))
|
(cascade (fourth parts)))
|
||||||
(if cascade
|
(if cascade
|
||||||
(progn (config-env-set (if slot (format nil "~a_CASCADE" (string-upcase slot)) "PROVIDER_CASCADE") cascade)
|
(let ((env-key (if slot (format nil "~a_CASCADE" (string-upcase slot)) "PROVIDER_CASCADE")))
|
||||||
(add-msg :system (format nil "✓ ~a cascade: ~a" (or slot "global") cascade)))
|
(config-env-set env-key cascade)
|
||||||
|
(daemon-send (list :action :reload-config))
|
||||||
|
(add-msg :system (format nil "✓ ~a cascade: ~a" (or slot "global") cascade)))
|
||||||
(add-msg :system (format nil "Cascade: ~a" (or (cdr (assoc "PROVIDER_CASCADE" (config-env-read) :test #'string-equal)) "not set"))))))
|
(add-msg :system (format nil "Cascade: ~a" (or (cdr (assoc "PROVIDER_CASCADE" (config-env-read) :test #'string-equal)) "not set"))))))
|
||||||
(:proxy
|
(:proxy
|
||||||
(let ((url (third parts)))
|
(let ((url (third parts)))
|
||||||
@@ -537,7 +555,7 @@ Called from handle-submit."
|
|||||||
(progn (config-env-set key path)
|
(progn (config-env-set key path)
|
||||||
(add-msg :system (format nil "✓ ~a set" key)))
|
(add-msg :system (format nil "✓ ~a set" key)))
|
||||||
(add-msg :system (format nil "~a: ~a" key (or (cdr (assoc key (config-env-read) :test #'string-equal)) "not set"))))))
|
(add-msg :system (format nil "~a: ~a" key (or (cdr (assoc key (config-env-read) :test #'string-equal)) "not set"))))))
|
||||||
(t (add-msg :system "Usage: /config provider <name> <key> | /config cascade <slot> <providers> | /config proxy <url> | /config timeout <n> | /config folder <key> <path>")))))
|
(t (add-msg :system "Usage: /config provider <name> <key> | /config cascade <slot> <providers> | /config proxy <url> | /config timeout <n> | /config folder <key> <path> | /config test <name> | /config models <name>")))))
|
||||||
|
|
||||||
(defun cmd-identity (text)
|
(defun cmd-identity (text)
|
||||||
"Handle /identity: show or load identity from IDENTITY.org directly."
|
"Handle /identity: show or load identity from IDENTITY.org directly."
|
||||||
|
|||||||
@@ -333,6 +333,8 @@ Semantic keys (all presets define these):
|
|||||||
'((:title "Status — Daemon health info" :value (:action :status))
|
'((:title "Status — Daemon health info" :value (:action :status))
|
||||||
(:title "Stats — Daemon statistics" :value (:action :stats))
|
(:title "Stats — Daemon statistics" :value (:action :stats))
|
||||||
(:title "Ping — Daemon reachability" :value (:action :ping))
|
(:title "Ping — Daemon reachability" :value (:action :ping))
|
||||||
|
(:title "Test Provider — Check connection" :value (:action :provider-test))
|
||||||
|
(:title "Discover Models — List available" :value (:action :provider-models))
|
||||||
(:title "Memory Snapshot — Capture state" :value (:action :memory-snapshot))
|
(:title "Memory Snapshot — Capture state" :value (:action :memory-snapshot))
|
||||||
(:title "Memory Rebuild — Rebuild indices" :value (:action :memory-rebuild))
|
(:title "Memory Rebuild — Rebuild indices" :value (:action :memory-rebuild))
|
||||||
(:title "Memory Compact — Optimize storage" :value (:action :memory-compact))
|
(:title "Memory Compact — Optimize storage" :value (:action :memory-compact))
|
||||||
|
|||||||
@@ -171,10 +171,45 @@ The daemon sends a handshake message on connection, then enters a read loop, inj
|
|||||||
nil))))
|
nil))))
|
||||||
(format stream "~a" (frame-message health-msg))
|
(format stream "~a" (frame-message health-msg))
|
||||||
(finish-output stream)))
|
(finish-output stream)))
|
||||||
|
((member (getf (getf msg :payload) :action)
|
||||||
|
'(:config-get :config-set :config-list
|
||||||
|
:provider-test :provider-models))
|
||||||
|
(handle-client-config msg stream))
|
||||||
(t (stimulus-inject msg :stream stream))))))
|
(t (stimulus-inject msg :stream stream))))))
|
||||||
(error (c) (log-message "CLIENT ERROR: ~a" c)))
|
(error (c) (log-message "CLIENT ERROR: ~a" c)))
|
||||||
(ignore-errors (usocket:socket-close socket))))
|
(ignore-errors (usocket:socket-close socket))))
|
||||||
|
|
||||||
|
(defun handle-client-config (msg stream)
|
||||||
|
"Handle config/provider commands inline (not through the cognitive pipeline)."
|
||||||
|
(let* ((payload (getf msg :payload))
|
||||||
|
(action (getf payload :action))
|
||||||
|
(name (getf payload :name))
|
||||||
|
(key (getf payload :key))
|
||||||
|
(value (getf payload :value))
|
||||||
|
(result nil))
|
||||||
|
(case action
|
||||||
|
(:config-list
|
||||||
|
(setf result (with-output-to-string (out)
|
||||||
|
(dolist (e (sort (config-read) #'string-lessp :key #'car))
|
||||||
|
(format out "~a=~a~%" (car e) (cdr e))))))
|
||||||
|
(:config-get
|
||||||
|
(let ((val (config-get (intern (string-upcase key) :keyword))))
|
||||||
|
(setf result (format nil "~a: ~:[not set~;~:*~a~]" key val))))
|
||||||
|
(:config-set
|
||||||
|
(config-set (intern (string-upcase key) :keyword) value)
|
||||||
|
(setf result (format nil "✓ ~a set" key)))
|
||||||
|
(:provider-test
|
||||||
|
(let ((ok (ignore-errors (test-provider-connection
|
||||||
|
(intern (string-downcase name) :keyword)))))
|
||||||
|
(setf result (format nil "~a: ~:[✗ failed~;✓ connected~]" name ok))))
|
||||||
|
(:provider-models
|
||||||
|
(let ((models (ignore-errors (test-provider-connection
|
||||||
|
(intern (string-downcase name) :keyword)))))
|
||||||
|
(setf result (format nil "~a models: ~a" name (or models "unavailable"))))))
|
||||||
|
(when result
|
||||||
|
(format stream "~a" (frame-message (list :type :event :payload (list :text result))))
|
||||||
|
(finish-output stream))))
|
||||||
|
|
||||||
(defun start-daemon (&key (port 9105) (max-retries 10))
|
(defun start-daemon (&key (port 9105) (max-retries 10))
|
||||||
"Starts the network listener for TUI/CLI clients.
|
"Starts the network listener for TUI/CLI clients.
|
||||||
If PORT is taken, tries subsequent ports up to PORT+MAX-RETRIES."
|
If PORT is taken, tries subsequent ports up to PORT+MAX-RETRIES."
|
||||||
|
|||||||
Reference in New Issue
Block a user