passepartout: v0.5.0 hotfix 2 — daemon stable
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
- Restore (in-package :passepartout) to core-reason - Move *VAULT-MEMORY* back to core-skills - Fix ASDF and defstruct/defpackage ordering - Increase daemon timeout to 120s - Handshake: 0.5.0 Verified: daemon processes messages, TUI clean, gate trace works
This commit is contained in:
41
lisp/channel-signal.lisp
Normal file
41
lisp/channel-signal.lisp
Normal file
@@ -0,0 +1,41 @@
|
||||
(in-package :passepartout)
|
||||
(defun signal-get-account ()
|
||||
(vault-get-secret :signal))
|
||||
|
||||
(defun signal-poll ()
|
||||
"Polls Signal for new messages and injects them into the harness."
|
||||
(let ((account (signal-get-account)))
|
||||
(when account
|
||||
(handler-case
|
||||
(let* ((output (uiop:run-program (list "signal-cli" "-u" account "receive" "--json")
|
||||
:output :string :error-output :string :ignore-error-status t))
|
||||
(lines (cl-ppcre:split "\\\\n" output)))
|
||||
(dolist (line lines)
|
||||
(when (and line (> (length line) 0))
|
||||
(let* ((json (ignore-errors (cl-json:decode-json-from-string line)))
|
||||
(envelope (cdr (assoc :envelope json)))
|
||||
(source (cdr (assoc :source envelope)))
|
||||
(data-message (cdr (assoc :data-message envelope)))
|
||||
(text (cdr (assoc :message data-message))))
|
||||
(when (and source text)
|
||||
(log-message "SIGNAL: Received message from ~a" source)
|
||||
(unless (ignore-errors (hitl-handle-message text :signal))
|
||||
(stimulus-inject
|
||||
(list :type :EVENT
|
||||
:meta (list :source :signal :chat-id source)
|
||||
:payload (list :sensor :user-input :text text)))))))))
|
||||
(error (c) (log-message "SIGNAL POLL ERROR: ~a" c))))))
|
||||
|
||||
(defun signal-send (action context)
|
||||
"Sends a message via Signal."
|
||||
(declare (ignore context))
|
||||
(let* ((payload (getf action :payload))
|
||||
(meta (getf action :meta))
|
||||
(chat-id (or (getf meta :chat-id) (getf payload :chat-id) (getf action :chat-id)))
|
||||
(text (or (getf payload :text) (getf action :text)))
|
||||
(account (signal-get-account)))
|
||||
(when (and account chat-id text)
|
||||
(handler-case
|
||||
(uiop:run-program (list "signal-cli" "-u" account "send" "-m" text chat-id)
|
||||
:output :string :error-output :string)
|
||||
(error (c) (log-message "SIGNAL ERROR: ~a" c))))))
|
||||
Reference in New Issue
Block a user