diff options
| -rw-r--r-- | config.el | 427 | ||||
| -rw-r--r-- | config.org | 523 | ||||
| -rw-r--r-- | packages.el | 1 |
3 files changed, 951 insertions, 0 deletions
@@ -3145,6 +3145,433 @@ PASS-ENTRY names the password-store entry holding JID's password.") (map! :leader :desc "IRC" "o i" #'=irc) ;; IRC:2 ends here +;; [[file:config.org::*Signal][Signal:1]] +(defun my/signel-start-h () + "Start signel if `signel-account' is set." + (when (bound-and-true-p signel-account) + (condition-case err + (signel-start) + (error (warn "Signal: not starting: %s" (error-message-string err)))))) + +(use-package! signel + :init + (add-hook 'doom-after-init-hook #'my/signel-start-h) + (map! :leader :desc "Signal" "o C" #'signel-dashboard)) +;; Signal:1 ends here + +;; [[file:config.org::*Phone numbers][Phone numbers:1]] +(defvar my/signel--number-ids (make-hash-table :test 'equal) + "Signal IDs by phone number, from signal-cli's list of recipients. +Used only to move a chat opened by number onto its ID; never shown.") + +(defvar my/signel--contacts-requests nil + "IDs of the listContacts requests not yet answered.") + +(defvar my/signel--profiles-asked nil + "Non-nil once unnamed recipients have been asked about by ID.") + +(defvar my/signel--groups-requests nil + "IDs of the listGroups requests not yet answered.") + +(defvar my/signel--groups-asked (make-hash-table :test 'equal) + "Group IDs that a message has already sent a listGroups request for.") + +(defun my/signel--name (id) + "The name to show for the person or group with ID. +Signel's contact map holds both; without an entry, a person is \"Unknown\" +and a group \"Unnamed group\"." + (gethash id signel--contact-map + (if (signel--is-group-id id) "Unnamed group" "Unknown"))) + +(defun my/signel--buffer-name (id) + "Buffer name for the chat with ID." + (format "*Signel: %s*" (my/signel--name id))) + +(defun my/signel--hide-numbers-a (args) + "Key the message in ARGS by the sender's Signal ID, without numbers. +The sender becomes their ID and loses their number, gets a name if they +came without one, and a synced message of yours goes to its recipient's ID." + (let* ((params (car args)) + (envelope (alist-get 'envelope params)) + (id (alist-get 'sourceUuid envelope)) + (sync (alist-get 'syncMessage envelope)) + (sent (alist-get 'sentMessage sync)) + (group (alist-get 'groupId (alist-get 'groupInfo + (alist-get 'dataMessage envelope))))) + (when (and group + (not (gethash group signel--contact-map)) + (not (gethash group my/signel--groups-asked))) + (puthash group t my/signel--groups-asked) + (my/signel--request-groups)) + (when id + (setf (alist-get 'source envelope) id)) + (unless (alist-get 'sourceName envelope) + (setf (alist-get 'sourceName envelope) + (my/signel--name (alist-get 'source envelope)))) + (setf (alist-get 'sourceNumber envelope nil 'remove) nil) + (when sent + (setf (alist-get 'destinationNumber sent) (alist-get 'destinationUuid sent) + (alist-get 'sentMessage sync) sent + (alist-get 'syncMessage envelope) sync)) + (setf (alist-get 'envelope params) envelope) + (list params))) + +(defun my/signel--get-buffer-a (id) + "The chat buffer for ID, found by ID rather than by name, or a new one." + (or (seq-find (lambda (buffer) + (equal (buffer-local-value 'signel--chat-id buffer) id)) + (buffer-list)) + (with-current-buffer (generate-new-buffer (my/signel--buffer-name id)) + (signel-chat-mode) + (setq signel--chat-id id) + (signel--draw-prompt) + (current-buffer)))) + +(defun my/signel--dashboard-draw-a () + "Draw the chat list with names only." + (let ((inhibit-read-only t)) + (erase-buffer) + (insert "Active Chats:\n-------------\n") + (maphash (lambda (id _) + (insert-button (my/signel--name id) + 'action #'signel--dashboard-open-entry + 'signel-id id + 'follow-link t) + (insert "\n")) + signel--active-chats))) + +(defun my/signel--request-contacts (&optional ids) + "Ask signal-cli for everyone it knows, or, with IDS, for just those. +Naming them makes signal-cli fetch their profiles first." + (push (signel--send-rpc "listContacts" + `((allRecipients . t) + ,@(and ids `((recipient . ,(vconcat ids)))))) + my/signel--contacts-requests)) + +(defun my/signel--request-groups () + "Ask signal-cli for every group, to name group chats by." + (push (signel--send-rpc "listGroups" (make-hash-table)) + my/signel--groups-requests)) + +(defun my/signel--request-names-a (&rest _) + "Ask for people's and groups' names afresh after signel starts." + (setq my/signel--contacts-requests nil + my/signel--profiles-asked nil + my/signel--groups-requests nil) + (clrhash my/signel--groups-asked) + (my/signel--request-contacts) + (my/signel--request-groups)) + +(defun my/signel--contact-name (contact) + "The name the phone shows for CONTACT, from listContacts, or nil." + (let ((profile (alist-get 'profile contact))) + (seq-find (lambda (name) (not (string-empty-p name))) + (mapcar (lambda (parts) (string-trim (string-join (delq nil parts) " "))) + (list (list (alist-get 'nickName contact)) + (list (alist-get 'nickGivenName contact) + (alist-get 'nickFamilyName contact)) + (list (alist-get 'name contact)) + (list (alist-get 'givenName profile) + (alist-get 'familyName profile))))))) + +(defun my/signel--rekey-chat (buffer id) + "Make chat BUFFER, opened by number, the chat with Signal ID instead. +If a chat with ID is already open, BUFFER's history moves to the top of +that one, which takes BUFFER's place in its windows, and BUFFER goes." + (let ((old (buffer-local-value 'signel--chat-id buffer)) + (existing (seq-find (lambda (other) + (and (not (eq other buffer)) + (equal (buffer-local-value 'signel--chat-id other) id))) + (buffer-list)))) + (when (gethash old signel--active-chats) + (remhash old signel--active-chats) + (puthash id t signel--active-chats)) + (remhash old signel--contact-map) + (if (not existing) + (with-current-buffer buffer + (setq signel--chat-id id)) + (let ((history (with-current-buffer buffer + (buffer-substring (point-min) + (save-excursion + (goto-char signel--input-marker) + (line-beginning-position)))))) + (with-current-buffer existing + (let ((inhibit-read-only t)) + (save-excursion + (goto-char (point-min)) + (insert history))))) + (dolist (window (get-buffer-window-list buffer nil t)) + (set-window-buffer window existing)) + (kill-buffer buffer)))) + +(defun my/signel--rename-chats () + "Rename every open chat, and the chat list, by what's now known." + (dolist (buffer (buffer-list)) + (when-let* ((chat (buffer-local-value 'signel--chat-id buffer))) + (with-current-buffer buffer + (rename-buffer (my/signel--buffer-name chat) t)))) + (signel--dashboard-refresh)) + +(defun my/signel--handle-contacts (contacts) + "Learn names and IDs from CONTACTS, and rename and rekey open chats." + (let (unnamed) + (seq-doseq (contact contacts) + (when-let* ((id (alist-get 'uuid contact))) + (when-let* ((number (alist-get 'number contact))) + (puthash number id my/signel--number-ids)) + (if-let* ((name (my/signel--contact-name contact))) + (puthash id name signel--contact-map) + (push id unnamed)))) + (dolist (buffer (buffer-list)) + (when-let* ((chat (buffer-local-value 'signel--chat-id buffer)) + ((not (signel--is-group-id chat))) + (id (gethash chat my/signel--number-ids))) + (my/signel--rekey-chat buffer id))) + (my/signel--rename-chats) + (when (and unnamed (not my/signel--profiles-asked)) + (setq my/signel--profiles-asked t) + (my/signel--request-contacts unnamed)))) + +(defun my/signel--handle-groups (groups) + "Learn group names from GROUPS, a listGroups answer, and rename chats. +Only each group's ID and name are read; its member lists carry numbers." + (seq-doseq (group groups) + (when-let* ((id (alist-get 'id group)) + (name (alist-get 'name group)) + ((not (string-empty-p name)))) + (puthash id name signel--contact-map))) + (my/signel--rename-chats)) + +(defun my/signel--dispatch-names-a (json) + "Handle JSON first if it answers a listContacts or listGroups request." + (when-let* ((id (alist-get 'id json))) + (cond + ((memql id my/signel--contacts-requests) + (setq my/signel--contacts-requests (delq id my/signel--contacts-requests)) + (when-let* ((contacts (alist-get 'result json))) + (my/signel--handle-contacts contacts))) + ((memql id my/signel--groups-requests) + (setq my/signel--groups-requests (delq id my/signel--groups-requests)) + (when-let* ((groups (alist-get 'result json))) + (my/signel--handle-groups groups)))))) + +(defun my/signel--chat-by-id-a (args) + "Open a chat asked for by a known number under that person's ID." + (list (gethash (car args) my/signel--number-ids (car args)))) + +(after! signel + (advice-add 'signel--handle-receive :filter-args #'my/signel--hide-numbers-a) + (advice-add 'signel--get-buffer :override #'my/signel--get-buffer-a) + (advice-add 'signel--dashboard-draw :override #'my/signel--dashboard-draw-a) + (advice-add 'signel-start :after #'my/signel--request-names-a) + (advice-add 'signel--dispatch :before #'my/signel--dispatch-names-a) + (advice-add 'signel-chat :filter-args #'my/signel--chat-by-id-a)) +;; Phone numbers:1 ends here + +;; [[file:config.org::*Voice calls][Voice calls:1]] +(defvar my/signel-calls (make-hash-table :test 'eql) + "Calls signal-cli has reported, keyed by call ID. +Each value is a plist: :peer (number or UUID), :state (as signal-cli names +it), :input and :output (the tunnel's audio devices), :modules (the +PulseAudio loopbacks connecting them) and :notification (the incoming-call +notification's ID).") + +(defun my/signel--subscribe-calls-a (&rest _) + "Ask signal-cli for call events, which it otherwise doesn't send." + (signel--send-rpc "subscribeCallEvents" (make-hash-table))) + +(defun my/signel--dispatch-call-a (json) + "Handle JSON first if it is a callEvent notification." + (when (equal (alist-get 'method json) "callEvent") + (my/signel--handle-call-event (alist-get 'result (alist-get 'params json))))) + +(defun my/signel--state-text (state &optional reason) + "Describe call STATE for a person; REASON is why an ended call ended." + (pcase state + ("RINGING_INCOMING" "incoming call (C-c C-y answers, C-c C-n declines)") + ("RINGING_OUTGOING" "ringing") + ("CONNECTING" "connecting") + ("CONNECTED" "call connected") + ("RECONNECTING" "reconnecting") + ("ENDED" (if reason (format "call ended (%s)" reason) "call ended")) + (_ (downcase state)))) + +(defun my/signel--handle-call-event (event) + "Record call EVENT, note it in its chat, and act on its new state." + (let* ((id (alist-get 'callId event)) + (state (alist-get 'state event)) + (call (gethash id my/signel-calls)) + ;; By ID, like every chat (see Phone numbers), and the same chat + ;; for the whole call. + (peer (or (plist-get call :peer) (alist-get 'uuid event) + (alist-get 'number event)))) + (setq call (plist-put call :peer peer)) + (setq call (plist-put call :state state)) + ;; The device names come once the tunnel is up; later events may leave + ;; them out, so they're only ever added. + (pcase-dolist (`(,field . ,key) '((inputDeviceName . :input) + (outputDeviceName . :output))) + (when-let* ((value (alist-get field event))) + (setq call (plist-put call key value)))) + (puthash id call my/signel-calls) + (when-let* ((notification (plist-get call :notification)) + ((not (equal state "RINGING_INCOMING")))) + (notifications-close-notification notification) + (puthash id (plist-put call :notification nil) my/signel-calls)) + (when peer + (with-current-buffer (signel--get-buffer peer) + (signel--insert-system-msg + (my/signel--state-text state (alist-get 'reason event)) 'shadow))) + (pcase state + ("RINGING_INCOMING" (my/signel--ring id peer)) + ("CONNECTED" (my/signel--connect-audio id)) + ("ENDED" (my/signel--forget-call id))) + (when (fboundp 'my/modeline-astro-update) + (my/modeline-astro-update)))) + +(defun my/signel--ring (id peer) + "Show the chat with PEER and raise a notification for incoming call ID." + (display-buffer (signel--get-buffer peer)) + (puthash id + (plist-put + (gethash id my/signel-calls) :notification + (notifications-notify + :title (format "Signal call from %s" (my/signel--name peer)) + :urgency 'critical + :actions '("answer" "Answer" "decline" "Decline") + :on-action (lambda (_notification action) + (pcase action + ("answer" (my/signel-answer id)) + ("decline" (my/signel-decline id)))))) + my/signel-calls)) + +(defun my/signel--find-call (states what) + "ID of a call in one of STATES, preferring this chat's. +WHAT finishes the error message when there's none, as in \"No call WHAT\"." + (let ((chat (bound-and-true-p signel--chat-id)) + here any) + (maphash (lambda (id call) + (when (member (plist-get call :state) states) + (if (equal (plist-get call :peer) chat) + (setq here id) + (setq any (or any id))))) + my/signel-calls) + (or here any (user-error "No call %s" what)))) + +(defun my/signel-call (recipient) + "Start a voice call to RECIPIENT, this chat's contact by default." + (interactive + (list (or (and (derived-mode-p 'signel-chat-mode) signel--chat-id) + (read-string "Call (+Phone): ")))) + (when (signel--is-group-id recipient) + (user-error "signal-cli can't make group calls")) + (signel--send-rpc "startCall" `((recipient . ,recipient)) + (signel--get-buffer recipient))) + +(defun my/signel-answer (id) + "Answer the ringing call ID." + (interactive (list (my/signel--find-call '("RINGING_INCOMING") "to answer"))) + (signel--send-rpc "acceptCall" `((callId . ,id)))) + +(defun my/signel-decline (id) + "Decline the ringing call ID." + (interactive (list (my/signel--find-call '("RINGING_INCOMING") "to decline"))) + (signel--send-rpc "rejectCall" `((callId . ,id)))) + +(defun my/signel-hangup (id) + "Hang up call ID, or stop it ringing if it's outgoing." + (interactive + (list (my/signel--find-call + '("RINGING_OUTGOING" "CONNECTING" "CONNECTED" "RECONNECTING") + "to hang up"))) + (signel--send-rpc "hangupCall" `((callId . ,id)))) + +(defun my/signel-call-modeline () + "📞 while a Signal call is ringing or up; who, and its state, on hover." + (let (calls) + (maphash (lambda (_id call) + (push (format "%s: %s" + (my/signel--name (plist-get call :peer)) + (my/signel--state-text (plist-get call :state))) + calls)) + my/signel-calls) + (when calls + (propertize "📞" 'help-echo (string-join calls "\n"))))) + +(after! signel + (add-to-list 'my/modeline-segments #'my/signel-call-modeline t) + (advice-add 'signel-start :after #'my/signel--subscribe-calls-a) + (advice-add 'signel--dispatch :before #'my/signel--dispatch-call-a) + (advice-add 'signel-stop :before #'my/signel--forget-all-calls-a) + (map! :map signel-chat-mode-map + "C-c C-v" #'my/signel-call + "C-c C-y" #'my/signel-answer + "C-c C-n" #'my/signel-decline + "C-c C-k" #'my/signel-hangup + :localleader + :desc "Call" "c" #'my/signel-call + :desc "Answer" "a" #'my/signel-answer + :desc "Decline" "d" #'my/signel-decline + :desc "Hang up" "h" #'my/signel-hangup)) +;; Voice calls:1 ends here + +;; [[file:config.org::*Call audio][Call audio:1]] +(defvar my/signel-call-source nil + "PulseAudio source to send on calls; nil follows the default source.") + +(defvar my/signel-call-sink nil + "PulseAudio sink to play calls on; nil follows the default sink.") + +(defvar my/signel-call-latency 30 + "Latency, in milliseconds, asked of each call-audio loopback.") + +(defun my/signel--loopback (source sink) + "Load a loopback from SOURCE to SINK and return its module index. +A nil SOURCE or SINK leaves PulseAudio to use (and follow) the default." + (string-to-number + (car (apply #'process-lines "pactl" "load-module" "module-loopback" + (format "latency_msec=%d" my/signel-call-latency) + (delq nil (list (and source (concat "source=" source)) + (and sink (concat "sink=" sink)))))))) + +(defun my/signel--connect-audio (id) + "Join call ID's devices to the microphone and speakers, once." + (let ((call (gethash id my/signel-calls))) + (unless (plist-get call :modules) + (condition-case err + (progn + (unless (and (plist-get call :input) (plist-get call :output)) + (error "signal-cli never named the call's audio devices")) + (puthash id + (plist-put + call :modules + (list (my/signel--loopback + my/signel-call-source + (concat "sink_for_" (plist-get call :input))) + (my/signel--loopback + (concat (plist-get call :output) ".monitor") + my/signel-call-sink))) + my/signel-calls)) + (error (message "Signal: couldn't connect call audio: %s" + (error-message-string err))))))) + +(defun my/signel--forget-call (id) + "Unload call ID's loopbacks, close its notification, and drop it." + (let ((call (gethash id my/signel-calls))) + (dolist (module (plist-get call :modules)) + (call-process "pactl" nil nil nil "unload-module" (number-to-string module))) + (when-let* ((notification (plist-get call :notification))) + (notifications-close-notification notification)) + (remhash id my/signel-calls))) + +(defun my/signel--forget-all-calls-a (&rest _) + "Drop every call, since stopping signal-cli ends them all." + (dolist (id (hash-table-keys my/signel-calls)) + (my/signel--forget-call id)) + (when (fboundp 'my/modeline-astro-update) + (my/modeline-astro-update))) +;; Call audio:1 ends here + ;; [[file:config.org::*Spelling][Spelling:1]] (after! ispell (setq ispell-dictionary "en_US,de_DE") @@ -4032,6 +4032,528 @@ value — so it's just the literal nick rather than a pass lookup. (map! :leader :desc "IRC" "o i" #'=irc) #+end_src +* Signal +[[https://github.com/keenban/signel][signel]] is a small Signal client that runs =signal-cli jsonRpc= as a +subprocess and talks JSON-RPC to it over the pipe. =SPC o C= opens its list of +active chats. The account goes in =signel-account=, from the [[*Private overlay][private overlay]], +as the number signal-cli was registered or linked with (=+15550000000=). With +it set, signel starts once Doom finishes starting up, so messages and calls +arrive without a chat being open first; with it unset, nothing starts. As with +[[*Jabber][Jabber]], a failure there becomes a warning, so a missing signal-cli can't stop +the daemon from starting. + +signal-cli 0.14 needs Java 25 or later, and finds =signal-call-tunnel=, the +helper that carries call audio, in its own =bin/= directory or on =PATH=. +#+begin_src emacs-lisp +(defun my/signel-start-h () + "Start signel if `signel-account' is set." + (when (bound-and-true-p signel-account) + (condition-case err + (signel-start) + (error (warn "Signal: not starting: %s" (error-message-string err)))))) + +(use-package! signel + :init + (add-hook 'doom-after-init-hook #'my/signel-start-h) + (map! :leader :desc "Signal" "o C" #'signel-dashboard)) +#+end_src + +** Phone numbers +Signal hides phone numbers by default: the phone shows a name, or "Unknown", +for anyone who hasn't chosen to share theirs. signal-cli still knows many of +those numbers, since linking copies the phone's whole record of everyone it +has talked to, and it reports them with every message. signel uses the +number as the chat's ID whenever there is one, so it ends up in buffer names, +in the chat list, and as the sender of anyone without a profile name. + +So Emacs never shows a number here. Each message is rewritten before signel +sees it, keyed by the sender's Signal ID (their ACI, a UUID) with the number +dropped. Chat buffers and the chat list are named by the name the phone would +show: a nickname you gave them, then their contact name, then their profile +name, and "Unknown" for anyone with none of those. + +signel keys a group chat by its group ID, a base64 key, and showed that as +its name too. Group names come from =listGroups=, also asked for at every +=signel-start=, and again the first time a message arrives from a group with +no name yet (one made or joined since), at most once per group. A group +without a name is "Unnamed group". The answer also lists each group's +members, with their numbers; only the group's ID and name are used. + +People's names come from =listContacts=, asked for at every =signel-start=, which also +fetches the profiles signal-cli doesn't have yet. Anyone still without a name +is asked about once more, by ID, which makes signal-cli fetch their profile +afresh rather than trust what it has stored. Each answer +also renames the open chats, and moves any chat opened by typing a number +(=signel-chat= still takes one) onto that person's ID, so their replies land +in the same buffer. + +signel's raw debug log, =*signel-log*=, still has whatever signal-cli sent. +#+begin_src emacs-lisp +(defvar my/signel--number-ids (make-hash-table :test 'equal) + "Signal IDs by phone number, from signal-cli's list of recipients. +Used only to move a chat opened by number onto its ID; never shown.") + +(defvar my/signel--contacts-requests nil + "IDs of the listContacts requests not yet answered.") + +(defvar my/signel--profiles-asked nil + "Non-nil once unnamed recipients have been asked about by ID.") + +(defvar my/signel--groups-requests nil + "IDs of the listGroups requests not yet answered.") + +(defvar my/signel--groups-asked (make-hash-table :test 'equal) + "Group IDs that a message has already sent a listGroups request for.") + +(defun my/signel--name (id) + "The name to show for the person or group with ID. +Signel's contact map holds both; without an entry, a person is \"Unknown\" +and a group \"Unnamed group\"." + (gethash id signel--contact-map + (if (signel--is-group-id id) "Unnamed group" "Unknown"))) + +(defun my/signel--buffer-name (id) + "Buffer name for the chat with ID." + (format "*Signel: %s*" (my/signel--name id))) + +(defun my/signel--hide-numbers-a (args) + "Key the message in ARGS by the sender's Signal ID, without numbers. +The sender becomes their ID and loses their number, gets a name if they +came without one, and a synced message of yours goes to its recipient's ID." + (let* ((params (car args)) + (envelope (alist-get 'envelope params)) + (id (alist-get 'sourceUuid envelope)) + (sync (alist-get 'syncMessage envelope)) + (sent (alist-get 'sentMessage sync)) + (group (alist-get 'groupId (alist-get 'groupInfo + (alist-get 'dataMessage envelope))))) + (when (and group + (not (gethash group signel--contact-map)) + (not (gethash group my/signel--groups-asked))) + (puthash group t my/signel--groups-asked) + (my/signel--request-groups)) + (when id + (setf (alist-get 'source envelope) id)) + (unless (alist-get 'sourceName envelope) + (setf (alist-get 'sourceName envelope) + (my/signel--name (alist-get 'source envelope)))) + (setf (alist-get 'sourceNumber envelope nil 'remove) nil) + (when sent + (setf (alist-get 'destinationNumber sent) (alist-get 'destinationUuid sent) + (alist-get 'sentMessage sync) sent + (alist-get 'syncMessage envelope) sync)) + (setf (alist-get 'envelope params) envelope) + (list params))) + +(defun my/signel--get-buffer-a (id) + "The chat buffer for ID, found by ID rather than by name, or a new one." + (or (seq-find (lambda (buffer) + (equal (buffer-local-value 'signel--chat-id buffer) id)) + (buffer-list)) + (with-current-buffer (generate-new-buffer (my/signel--buffer-name id)) + (signel-chat-mode) + (setq signel--chat-id id) + (signel--draw-prompt) + (current-buffer)))) + +(defun my/signel--dashboard-draw-a () + "Draw the chat list with names only." + (let ((inhibit-read-only t)) + (erase-buffer) + (insert "Active Chats:\n-------------\n") + (maphash (lambda (id _) + (insert-button (my/signel--name id) + 'action #'signel--dashboard-open-entry + 'signel-id id + 'follow-link t) + (insert "\n")) + signel--active-chats))) + +(defun my/signel--request-contacts (&optional ids) + "Ask signal-cli for everyone it knows, or, with IDS, for just those. +Naming them makes signal-cli fetch their profiles first." + (push (signel--send-rpc "listContacts" + `((allRecipients . t) + ,@(and ids `((recipient . ,(vconcat ids)))))) + my/signel--contacts-requests)) + +(defun my/signel--request-groups () + "Ask signal-cli for every group, to name group chats by." + (push (signel--send-rpc "listGroups" (make-hash-table)) + my/signel--groups-requests)) + +(defun my/signel--request-names-a (&rest _) + "Ask for people's and groups' names afresh after signel starts." + (setq my/signel--contacts-requests nil + my/signel--profiles-asked nil + my/signel--groups-requests nil) + (clrhash my/signel--groups-asked) + (my/signel--request-contacts) + (my/signel--request-groups)) + +(defun my/signel--contact-name (contact) + "The name the phone shows for CONTACT, from listContacts, or nil." + (let ((profile (alist-get 'profile contact))) + (seq-find (lambda (name) (not (string-empty-p name))) + (mapcar (lambda (parts) (string-trim (string-join (delq nil parts) " "))) + (list (list (alist-get 'nickName contact)) + (list (alist-get 'nickGivenName contact) + (alist-get 'nickFamilyName contact)) + (list (alist-get 'name contact)) + (list (alist-get 'givenName profile) + (alist-get 'familyName profile))))))) + +(defun my/signel--rekey-chat (buffer id) + "Make chat BUFFER, opened by number, the chat with Signal ID instead. +If a chat with ID is already open, BUFFER's history moves to the top of +that one, which takes BUFFER's place in its windows, and BUFFER goes." + (let ((old (buffer-local-value 'signel--chat-id buffer)) + (existing (seq-find (lambda (other) + (and (not (eq other buffer)) + (equal (buffer-local-value 'signel--chat-id other) id))) + (buffer-list)))) + (when (gethash old signel--active-chats) + (remhash old signel--active-chats) + (puthash id t signel--active-chats)) + (remhash old signel--contact-map) + (if (not existing) + (with-current-buffer buffer + (setq signel--chat-id id)) + (let ((history (with-current-buffer buffer + (buffer-substring (point-min) + (save-excursion + (goto-char signel--input-marker) + (line-beginning-position)))))) + (with-current-buffer existing + (let ((inhibit-read-only t)) + (save-excursion + (goto-char (point-min)) + (insert history))))) + (dolist (window (get-buffer-window-list buffer nil t)) + (set-window-buffer window existing)) + (kill-buffer buffer)))) + +(defun my/signel--rename-chats () + "Rename every open chat, and the chat list, by what's now known." + (dolist (buffer (buffer-list)) + (when-let* ((chat (buffer-local-value 'signel--chat-id buffer))) + (with-current-buffer buffer + (rename-buffer (my/signel--buffer-name chat) t)))) + (signel--dashboard-refresh)) + +(defun my/signel--handle-contacts (contacts) + "Learn names and IDs from CONTACTS, and rename and rekey open chats." + (let (unnamed) + (seq-doseq (contact contacts) + (when-let* ((id (alist-get 'uuid contact))) + (when-let* ((number (alist-get 'number contact))) + (puthash number id my/signel--number-ids)) + (if-let* ((name (my/signel--contact-name contact))) + (puthash id name signel--contact-map) + (push id unnamed)))) + (dolist (buffer (buffer-list)) + (when-let* ((chat (buffer-local-value 'signel--chat-id buffer)) + ((not (signel--is-group-id chat))) + (id (gethash chat my/signel--number-ids))) + (my/signel--rekey-chat buffer id))) + (my/signel--rename-chats) + (when (and unnamed (not my/signel--profiles-asked)) + (setq my/signel--profiles-asked t) + (my/signel--request-contacts unnamed)))) + +(defun my/signel--handle-groups (groups) + "Learn group names from GROUPS, a listGroups answer, and rename chats. +Only each group's ID and name are read; its member lists carry numbers." + (seq-doseq (group groups) + (when-let* ((id (alist-get 'id group)) + (name (alist-get 'name group)) + ((not (string-empty-p name)))) + (puthash id name signel--contact-map))) + (my/signel--rename-chats)) + +(defun my/signel--dispatch-names-a (json) + "Handle JSON first if it answers a listContacts or listGroups request." + (when-let* ((id (alist-get 'id json))) + (cond + ((memql id my/signel--contacts-requests) + (setq my/signel--contacts-requests (delq id my/signel--contacts-requests)) + (when-let* ((contacts (alist-get 'result json))) + (my/signel--handle-contacts contacts))) + ((memql id my/signel--groups-requests) + (setq my/signel--groups-requests (delq id my/signel--groups-requests)) + (when-let* ((groups (alist-get 'result json))) + (my/signel--handle-groups groups)))))) + +(defun my/signel--chat-by-id-a (args) + "Open a chat asked for by a known number under that person's ID." + (list (gethash (car args) my/signel--number-ids (car args)))) + +(after! signel + (advice-add 'signel--handle-receive :filter-args #'my/signel--hide-numbers-a) + (advice-add 'signel--get-buffer :override #'my/signel--get-buffer-a) + (advice-add 'signel--dashboard-draw :override #'my/signel--dashboard-draw-a) + (advice-add 'signel-start :after #'my/signel--request-names-a) + (advice-add 'signel--dispatch :before #'my/signel--dispatch-names-a) + (advice-add 'signel-chat :filter-args #'my/signel--chat-by-id-a)) +#+end_src + +** Voice calls +signal-cli (0.14.2 and later) makes and takes one-to-one voice calls, and +signel doesn't know about them yet, so this adds them from the outside. Each +call runs its own =signal-call-tunnel= process, which wraps Signal's RingRTC +for the WebRTC side. signal-cli relays the call's signaling, and reports each +change of state as a =callEvent= notification on the same JSON-RPC pipe: +=RINGING_INCOMING= or =RINGING_OUTGOING=, then =CONNECTING=, =CONNECTED=, +=RECONNECTING= and =ENDED=. It only sends those to a client that has called +=subscribeCallEvents=, and without a subscriber it ignores incoming calls +altogether, so that call follows every =signel-start=. signel's dispatcher +handles only =receive= notifications and drops everything else, so an advice +on it picks out =callEvent= first. + +Call IDs are signed 64-bit integers, larger than a fixnum, so they come back +from =json-read= as bignums. They're kept as they are and sent back the same +way, never through =format= or a float. =eql= compares bignums by value, so +they work as keys of an =eql= hash table. + +In a chat buffer: + +| Key | Localleader | Does | +|-----------+-------------+---------------------------------------| +| =C-c C-v= | =SPC m c= | call this chat | +| =C-c C-y= | =SPC m a= | answer the ringing call | +| =C-c C-n= | =SPC m d= | decline it | +| =C-c C-k= | =SPC m h= | hang up (or stop ringing, if calling) | + +Each works from anywhere through =M-x=, picking this chat's call when there is +one and otherwise whichever call is in the right state. A ringing call also +opens its chat, adds 📞 to the [[*Modeline][modeline]] until it ends, and raises a desktop +notification with Answer and Decline buttons. Every change of state is noted +in the chat. + +There are no group calls or video: signal-cli makes neither. + +The modeline segment is added once signel loads rather than here: this +section tangles ahead of [[*Modeline][Modeline]], where =my/modeline-segments= is defined. +#+begin_src emacs-lisp +(defvar my/signel-calls (make-hash-table :test 'eql) + "Calls signal-cli has reported, keyed by call ID. +Each value is a plist: :peer (number or UUID), :state (as signal-cli names +it), :input and :output (the tunnel's audio devices), :modules (the +PulseAudio loopbacks connecting them) and :notification (the incoming-call +notification's ID).") + +(defun my/signel--subscribe-calls-a (&rest _) + "Ask signal-cli for call events, which it otherwise doesn't send." + (signel--send-rpc "subscribeCallEvents" (make-hash-table))) + +(defun my/signel--dispatch-call-a (json) + "Handle JSON first if it is a callEvent notification." + (when (equal (alist-get 'method json) "callEvent") + (my/signel--handle-call-event (alist-get 'result (alist-get 'params json))))) + +(defun my/signel--state-text (state &optional reason) + "Describe call STATE for a person; REASON is why an ended call ended." + (pcase state + ("RINGING_INCOMING" "incoming call (C-c C-y answers, C-c C-n declines)") + ("RINGING_OUTGOING" "ringing") + ("CONNECTING" "connecting") + ("CONNECTED" "call connected") + ("RECONNECTING" "reconnecting") + ("ENDED" (if reason (format "call ended (%s)" reason) "call ended")) + (_ (downcase state)))) + +(defun my/signel--handle-call-event (event) + "Record call EVENT, note it in its chat, and act on its new state." + (let* ((id (alist-get 'callId event)) + (state (alist-get 'state event)) + (call (gethash id my/signel-calls)) + ;; By ID, like every chat (see Phone numbers), and the same chat + ;; for the whole call. + (peer (or (plist-get call :peer) (alist-get 'uuid event) + (alist-get 'number event)))) + (setq call (plist-put call :peer peer)) + (setq call (plist-put call :state state)) + ;; The device names come once the tunnel is up; later events may leave + ;; them out, so they're only ever added. + (pcase-dolist (`(,field . ,key) '((inputDeviceName . :input) + (outputDeviceName . :output))) + (when-let* ((value (alist-get field event))) + (setq call (plist-put call key value)))) + (puthash id call my/signel-calls) + (when-let* ((notification (plist-get call :notification)) + ((not (equal state "RINGING_INCOMING")))) + (notifications-close-notification notification) + (puthash id (plist-put call :notification nil) my/signel-calls)) + (when peer + (with-current-buffer (signel--get-buffer peer) + (signel--insert-system-msg + (my/signel--state-text state (alist-get 'reason event)) 'shadow))) + (pcase state + ("RINGING_INCOMING" (my/signel--ring id peer)) + ("CONNECTED" (my/signel--connect-audio id)) + ("ENDED" (my/signel--forget-call id))) + (when (fboundp 'my/modeline-astro-update) + (my/modeline-astro-update)))) + +(defun my/signel--ring (id peer) + "Show the chat with PEER and raise a notification for incoming call ID." + (display-buffer (signel--get-buffer peer)) + (puthash id + (plist-put + (gethash id my/signel-calls) :notification + (notifications-notify + :title (format "Signal call from %s" (my/signel--name peer)) + :urgency 'critical + :actions '("answer" "Answer" "decline" "Decline") + :on-action (lambda (_notification action) + (pcase action + ("answer" (my/signel-answer id)) + ("decline" (my/signel-decline id)))))) + my/signel-calls)) + +(defun my/signel--find-call (states what) + "ID of a call in one of STATES, preferring this chat's. +WHAT finishes the error message when there's none, as in \"No call WHAT\"." + (let ((chat (bound-and-true-p signel--chat-id)) + here any) + (maphash (lambda (id call) + (when (member (plist-get call :state) states) + (if (equal (plist-get call :peer) chat) + (setq here id) + (setq any (or any id))))) + my/signel-calls) + (or here any (user-error "No call %s" what)))) + +(defun my/signel-call (recipient) + "Start a voice call to RECIPIENT, this chat's contact by default." + (interactive + (list (or (and (derived-mode-p 'signel-chat-mode) signel--chat-id) + (read-string "Call (+Phone): ")))) + (when (signel--is-group-id recipient) + (user-error "signal-cli can't make group calls")) + (signel--send-rpc "startCall" `((recipient . ,recipient)) + (signel--get-buffer recipient))) + +(defun my/signel-answer (id) + "Answer the ringing call ID." + (interactive (list (my/signel--find-call '("RINGING_INCOMING") "to answer"))) + (signel--send-rpc "acceptCall" `((callId . ,id)))) + +(defun my/signel-decline (id) + "Decline the ringing call ID." + (interactive (list (my/signel--find-call '("RINGING_INCOMING") "to decline"))) + (signel--send-rpc "rejectCall" `((callId . ,id)))) + +(defun my/signel-hangup (id) + "Hang up call ID, or stop it ringing if it's outgoing." + (interactive + (list (my/signel--find-call + '("RINGING_OUTGOING" "CONNECTING" "CONNECTED" "RECONNECTING") + "to hang up"))) + (signel--send-rpc "hangupCall" `((callId . ,id)))) + +(defun my/signel-call-modeline () + "📞 while a Signal call is ringing or up; who, and its state, on hover." + (let (calls) + (maphash (lambda (_id call) + (push (format "%s: %s" + (my/signel--name (plist-get call :peer)) + (my/signel--state-text (plist-get call :state))) + calls)) + my/signel-calls) + (when calls + (propertize "📞" 'help-echo (string-join calls "\n"))))) + +(after! signel + (add-to-list 'my/modeline-segments #'my/signel-call-modeline t) + (advice-add 'signel-start :after #'my/signel--subscribe-calls-a) + (advice-add 'signel--dispatch :before #'my/signel--dispatch-call-a) + (advice-add 'signel-stop :before #'my/signel--forget-all-calls-a) + (map! :map signel-chat-mode-map + "C-c C-v" #'my/signel-call + "C-c C-y" #'my/signel-answer + "C-c C-n" #'my/signel-decline + "C-c C-k" #'my/signel-hangup + :localleader + :desc "Call" "c" #'my/signel-call + :desc "Answer" "a" #'my/signel-answer + :desc "Decline" "d" #'my/signel-decline + :desc "Hang up" "h" #'my/signel-hangup)) +#+end_src + +*** Call audio +The tunnel doesn't touch the speakers or microphone. On Linux it makes +PulseAudio devices of its own for each call, named after the call (the names +come with the call's events). Whatever plays into the null sink +=sink_for_<input>= is what the other person hears, and what they say plays +into the null sink =<output>=, to be read from its =.monitor= source. Once the +call is =CONNECTED=, two =module-loopback= modules join those to the +microphone and speakers: =my/signel-call-source= into the first, and the +second's monitor out to =my/signel-call-sink=. Left nil, they follow the +default source and sink. They're unloaded when the call ends. The tunnel's +own cleanup, which unloads every module whose arguments mention its +devices, would take them too. PipeWire's PulseAudio server provides all +three module types. + +Nothing here cancels echo, so use headphones, or the other person hears +themselves come back out of the speakers. +#+begin_src emacs-lisp +(defvar my/signel-call-source nil + "PulseAudio source to send on calls; nil follows the default source.") + +(defvar my/signel-call-sink nil + "PulseAudio sink to play calls on; nil follows the default sink.") + +(defvar my/signel-call-latency 30 + "Latency, in milliseconds, asked of each call-audio loopback.") + +(defun my/signel--loopback (source sink) + "Load a loopback from SOURCE to SINK and return its module index. +A nil SOURCE or SINK leaves PulseAudio to use (and follow) the default." + (string-to-number + (car (apply #'process-lines "pactl" "load-module" "module-loopback" + (format "latency_msec=%d" my/signel-call-latency) + (delq nil (list (and source (concat "source=" source)) + (and sink (concat "sink=" sink)))))))) + +(defun my/signel--connect-audio (id) + "Join call ID's devices to the microphone and speakers, once." + (let ((call (gethash id my/signel-calls))) + (unless (plist-get call :modules) + (condition-case err + (progn + (unless (and (plist-get call :input) (plist-get call :output)) + (error "signal-cli never named the call's audio devices")) + (puthash id + (plist-put + call :modules + (list (my/signel--loopback + my/signel-call-source + (concat "sink_for_" (plist-get call :input))) + (my/signel--loopback + (concat (plist-get call :output) ".monitor") + my/signel-call-sink))) + my/signel-calls)) + (error (message "Signal: couldn't connect call audio: %s" + (error-message-string err))))))) + +(defun my/signel--forget-call (id) + "Unload call ID's loopbacks, close its notification, and drop it." + (let ((call (gethash id my/signel-calls))) + (dolist (module (plist-get call :modules)) + (call-process "pactl" nil nil nil "unload-module" (number-to-string module))) + (when-let* ((notification (plist-get call :notification))) + (notifications-close-notification notification)) + (remhash id my/signel-calls))) + +(defun my/signel--forget-all-calls-a (&rest _) + "Drop every call, since stopping signal-cli ends them all." + (dolist (id (hash-table-keys my/signel-calls)) + (my/signel--forget-call id)) + (when (fboundp 'my/modeline-astro-update) + (my/modeline-astro-update))) +#+end_src + * Spelling Doom's =+hunspell= flag already selects hunspell; this adds the English and German dictionaries together. Both =hunspell-en_us= and =hunspell-de= need to @@ -6094,6 +6616,7 @@ The settings this config expects from there: | =user-full-name=, =user-mail-address= | Email (the address names the maildir) | | =my/jabber-accounts= | Jabber | | =set-irc-server!= calls | IRC | +| =signel-account= | Signal | | =my/blog-site-directory= | Blog | #+begin_src emacs-lisp (load! "private/config" doom-user-dir t) diff --git a/packages.el b/packages.el index d7ea364..f63ae94 100644 --- a/packages.el +++ b/packages.el @@ -9,6 +9,7 @@ (package! shrface) ; org-style faces for nov and eww (package! calibredb) (package! jabber) ; XMPP +(package! signel) ; Signal, through signal-cli (package! bbdb) ; contacts, wired into mu4e (package! osm) ; OpenStreetMap viewer (package! org-auto-tangle) |