From b7efd969469743ac8b719dcf327cc7489d2a2287 Mon Sep 17 00:00:00 2001 From: jao Date: Wed, 8 Jun 2022 01:56:56 +0100 Subject: attic --- attic/net/signel.org | 546 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 546 insertions(+) create mode 100644 attic/net/signel.org (limited to 'attic/net/signel.org') diff --git a/attic/net/signel.org b/attic/net/signel.org new file mode 100644 index 0000000..722069c --- /dev/null +++ b/attic/net/signel.org @@ -0,0 +1,546 @@ +#+title: signel, a barebones signal chat on top of signal-cli +#+date: <2020-02-23 05:03> +#+filetags: emacs norss +#+PROPERTY: header-args :tangle yes :comments yes :results silent + +Unlike most chat systems in common use, [[https://signal.org][Signal]] lacks a decent emacs +client. All i could find was [[https://github.com/mrkrd/signal-msg][signal-msg]], which is able only to send +messages and has a readme that explicitly warns that its is /not/ a chat +application. Skimming over signal-msg's code i learnt about +[[https://github.com/AsamK/signal-cli][signal-cli]], a java-based daemon that knows how to send and receive +signal messages, and how to link to a nearby phone, or register new +users. And playing with it i saw that it can output its activities +formatted as JSON, and that offers (when run in daemon mode) a DBUS +service that can be used to send messages. + +Now, emacs knows how to run a process and capture its output handling +it to a filter function, and comes equipped with a JSON parser and +a set of built-in functions to talk to DBUS buses. + +So how about writing a simple Signal chat app for emacs? Let's call it +/signel/, and write it as [[https://gitlab.com/jaor/elibs/-/blob/master/net/signel.org][a blog post in literate org-mode]]. + +* Starting a process + +We are going to need a variable for our identity (telephone number), +and a list of contact names (until i discover how to get them directly +from signal-cli): + +#+begin_src emacs-lisp +(require 'cl-lib) + +(defvar signel-cli-user "+44744xxxxxx") +(defvar signel-contact-names '(("+447xxxxxxxx" . "john") + ("+346xxxxxxxx" . "anna"))) +#+end_src + +and a simple function to get a contact name given its telephone +number: + +#+begin_src emacs-lisp +(defun signel--contact-name (src) + (or (alist-get src signel-contact-names nil nil #'string-equal) src)) +#+end_src + +We are also going to need the path for our signal-cli executable + +#+begin_src emacs-lisp +(defvar signel-cli-exec "signal-cli") +#+end_src + +Starting the signal-cli process is easy: ~make-process~ provides all the +necessary bits. What we need is essentially calling + +#+begin_src shell +signal-cli -u +44744xxxxxx daemon --json +#+end_src + +associating to the process a buffer selected by the function +~signel--proc-buffer~ . While we are at it, we'll write also little +helpers for users of our API. + +#+begin_src emacs-lisp +(defun signel--proc-buffer () + (get-buffer-create "*signal-cli*")) + +(defun signel-signal-cli-buffer () + (get-buffer "*signal-cli*")) + +(defun signel-signal-cli-process () + (when-let ((proc (get-buffer-process (signel-signal-cli-buffer)))) + (and (process-live-p proc) proc))) +#+end_src + +#+begin_src emacs-lisp +(defun signel-start () + "Start the underlying signal-cli process if needed." + (interactive) + (if (signel-signal-cli-process) + (message "signal-cli is already running!") + (let ((b (signel--proc-buffer))) + (make-process :name "signal-cli" + :buffer b + :command `(,signel-cli-exec + "-u" + ,signel-cli-user + "daemon" "--json") + :filter #'signel--filter) + (message "Listening to signals!")))) +#+end_src + +* Parsing JSON + +We've told emacs to handle any ouput of the process to the function +~signel--filter~, which we're going to write next. This function will +receive the process object and its latest output as a string +representing a JSON object. Here's an example of the kind of outputs +that signal-cli emits: + +#+begin_src json :tangle no +{ + "envelope": { + "source": "+4473xxxxxxxx", + "sourceDevice": 1, + "relay": null, + "timestamp": 1582396178696, + "isReceipt": false, + "dataMessage": { + "timestamp": 1582396178696, + "message": "Hello there!", + "expiresInSeconds": 0, + "attachments": [], + "groupInfo": null + }, + "syncMessage": null, + "callMessage": null, + "receiptMessage": null + } +} +#+end_src + +Everything seems to be always inside ~envelope~, which contains objects +for the possible messages received. In the example above, we're +receiving a message from a /source/ contact. We can also receive +receipt messages, telling us whether our last message has been +received or read; e.g.: + +#+begin_src json :tangle no +{ + "envelope": { + "source": "+4473xxxxxxxx", + "sourceDevice": 1, + "relay": null, + "timestamp": 1582397117584, + "isReceipt": false, + "dataMessage": null, + "syncMessage": null, + "callMessage": null, + "receiptMessage": { + "when": 1582397117584, + "isDelivery": true, + "isRead": false, + "timestamps": [ + 1582397111524 + ] + } + } +} +#+end_src + +A bit confusingly, that delivery notification has a ~receiptMessage~, +but its ~isReceipt~ flag is set to ~false~. At other times, we get +~isReceipt~ but no ~receiptMessage~: + +#+begin_src json :tangle no +{ + "envelope": { + "source": "+346xxxxxxxx", + "sourceDevice": 1, + "relay": null, + "timestamp": 1582476539281, + "isReceipt": true, + "dataMessage": null, + "syncMessage": null, + "callMessage": null, + "receiptMessage": null + } +} +#+end_src + +It is very easy to parse JSON in emacs and extract signal-cli's +envelopes (and it's become faster in emacs 27, but the interface is a +bit different): + +#+begin_src emacs-lisp +(defun signel--parse-json (str) + (if (> emacs-major-version 26) + (json-parse-string str + :null-object nil + :false-object nil + :object-type 'alist + :array-type 'list) + (json-read-from-string str))) + +(defun signel--msg-contents (str) + (alist-get 'envelope (ignore-errors (signel--parse-json str)))) +#+end_src + +Here i am being old-school and opting to receive JSON dicitionaries as +alists (rather than hash maps, the default), and arrays as lists +rather than vectors just because lisps are lisps for a reason. I'm +also going to do some mild [[https://lispcast.com/nil-punning/][nil punning]], +hence the choice for null and false representations. + +Once the contents of the envelope is extracted, it's trivial (and +boring) to get into its components: + +#+begin_src emacs-lisp +(defun signel--msg-source (msg) (alist-get 'source msg)) + +(defun signel--msg-data (msg) + (alist-get 'message (alist-get 'dataMessage msg))) + +(defun signel--msg-timestamp (msg) + (if-let (msecs (alist-get 'timestamp msg)) + (format-time-string "%H:%M" (/ msecs 1000)) + "")) + +;; emacs 26 compat +(defun signel--not-false (x) + (and (not (eq :json-false x)) x)) + +(defun signel--msg-receipt (msg) + (alist-get 'receiptMessage msg)) + +(defun signel--msg-is-receipt (msg) + (signel--not-false (alist-get 'isReceipt msg))) + +(defun signel--msg-receipt-timestamp (msg) + (when-let (msecs (alist-get 'when (signel--msg-receipt msg))) + (format-time-string "%H:%M" (/ msecs 1000)))) + +(defun signel--msg-is-delivery (msg) + (when-let ((receipt (signel--msg-receipt msg))) + (signel--not-false (alist-get 'isDelivery msg)))) + +(defun signel--msg-is-read (msg) + (when-let ((receipt (signel--msg-receipt msg))) + (signel--not-false (alist-get 'isRead msg)))) +#+end_src + +* A process output filter + +We're almost ready to write our filter. It will: + +- For debugging purposes, insert the raw JSON string in the process + buffer. +- Parse the received JSON string and extract its envelope contents. +- Check wether it has a source and either message data or a receipt + timestamp. +- Dispatch to a helper function that will insert the data or + notification in a chat buffer. + +Or, in elisp: + +#+begin_src emacs-lisp +(defvar signel--line-buffer "") + +(defun signel--filter (proc str) + (signel--ordinary-insertion-filter proc str) + (let ((str (concat signel--line-buffer str))) + (if-let ((msg (signel--msg-contents str))) + (let ((source (signel--msg-source msg)) + (stamp (signel--msg-timestamp msg)) + (data (signel--msg-data msg)) + (rec-stamp (signel--msg-receipt-timestamp msg))) + (setq signel--line-buffer "") + (when source + (signel--update-chat-buffer source data stamp rec-stamp msg))) + (setq signel--line-buffer + (if (string-match-p ".*\n$" str) "" str))))) +#+end_src + +We've had to take care of the case when the filter receives input that +is not a complete JSON expression: in the case of signal-cli, that +only happens when we haven't seen yet an end of line. + +The function to insert the raw contents in the process buffer is +surprisingly hard to get right, but the emacs manual spells out a +reasonable implementation, which i just copied: + +#+begin_src emacs-lisp +(defun signel--ordinary-insertion-filter (proc string) + (when (and proc (buffer-live-p (process-buffer proc))) + (with-current-buffer (process-buffer proc) + (let ((moving (= (point) (process-mark proc)))) + (save-excursion + ;; Insert the text, advancing the process marker. + (goto-char (process-mark proc)) + (insert string) + (set-marker (process-mark proc) (point))) + (if moving (goto-char (process-mark proc))))))) +#+end_src + +* It's not an emacs app if it doesn't have a new mode + +With that out of the way, we just have to insert our data in an +appropriate buffer. We are going to associate a separate buffer to +each /source/, using for that its name: + +#+begin_src emacs-lisp +(defvar-local signel-user nil) + +(defun signel--contact-buffer (source) + (let* ((name (format "*%s" (signel--contact-name source))) + (buffer (get-buffer name))) + (unless buffer + (setq buffer (get-buffer-create name)) + (with-current-buffer buffer + (signel-chat-mode) + (setq-local signel-user source) + (insert signel-prompt))) + buffer)) +#+end_src + +where, as is often the case in emacs, we are going to have a dedicated +major mode for chat buffers, called ~signel-chat-mode~. For now, let's +keep it really simple (for the record, this is essentially a copy of +what ERC does for its erc-mode): + +#+begin_src emacs-lisp +(defvar signel-prompt ": ") + +(define-derived-mode signel-chat-mode fundamental-mode "Signal" + "Major mode for Signal chats." + (when (boundp 'next-line-add-newlines) + (set (make-local-variable 'next-line-add-newlines) nil)) + (setq line-move-ignore-invisible t) + (set (make-local-variable 'paragraph-separate) + (concat "\C-l\\|\\(^" (regexp-quote signel-prompt) "\\)")) + (set (make-local-variable 'paragraph-start) + (concat "\\(" (regexp-quote signel-prompt) "\\)")) + (setq-local completion-ignore-case t)) +#+end_src + +Note how, in ~signel--contact-buffer~, we're storing the user identity +associated with the buffer (its /source/) in a buffer-local variable +named ~signel-user~ that is set /after/ enabling ~signel-chat-mode~: order +here matters because the major mode activation cleans up the values of +any local variables previously set (i always forget that!). + +* And a customization group + +We're going to need a couple of new faces for the different parts of +inserted messages, so we'll take the chance to be tidy and introduce a +customization group: + +#+begin_src emacs-lisp +(defgroup signel nil "Signel") + +(defface signel-contact '((t :weight bold)) + "Face for contact names." + :group 'signel) + +(defface signel-timestamp '((t :foreground "grey70")) + "Face for timestamp names." + :group 'signel) + +(defface signel-notice '((t :inherit signel-timestamp)) + "Face for delivery notices." + :group 'signel) + +(defface signel-prompt '((t :weight bold)) + "Face for the input prompt marker." + :group 'signel) + +(defface signel-user '((t :foreground "orangered")) + "Face for sent messages." + :group 'signel) + +(defface signel-notification '((t :foreground "burlywood")) + "Face for notifications shown by tracking, when available." + :group 'signel) + +#+end_src + + +* Displaying incoming messages + +We have now almost all the ingredients to write +~signel--update-chat-buffer~, the function that inserts the received +message data into the chat buffer. Let's define a few little +functions to format those parts: + +#+begin_src emacs-lisp +(defun signel--contact (name) + (propertize name 'face 'signel-contact)) + +(defun signel--timestamp (&rest p) + (propertize (apply #'concat p) 'face 'signel-timestamp)) + +(defun signel--notice (notice) + (propertize notice 'face 'signel-notice)) + +(defun signel--insert-prompt () + (let ((inhibit-read-only t) + (p (point))) + (insert signel-prompt) + (set-text-properties p (- (point) 1) + '(face signel-prompt + read-only t front-sticky t rear-sticky t)))) + +(defun signel--delete-prompt () + (when (looking-at-p (regexp-quote signel-prompt)) + (let ((inhibit-read-only t)) + (delete-char (length signel-prompt))))) + +(defun signel--delete-last-prompt () + (goto-char (point-max)) + (when (re-search-backward (concat "^" (regexp-quote signel-prompt))) + (signel--delete-prompt))) + +#+end_src + +With that, we're finally ready to insert messages in our signel chat +buffers: + +#+begin_src emacs-lisp +(defcustom signel-report-deliveries nil + "Whether to show message delivery notices." + :group 'signel + :type 'boolean) + +(defcustom signel-report-read t + "Whether to show message read notices." + :group 'signel + :type 'boolean) + +(defun signel--prompt-and-notify () + (signel--insert-prompt) + (when (fboundp 'tracking-add-buffer) + (tracking-add-buffer (current-buffer) '(signel-notification)))) + +(defun signel--needs-insert-p (data stamp rec-stamp msg) + (or data + (and (or rec-stamp stamp) + (not (string= source signel-cli-user)) + (or signel-report-deliveries + (and signel-report-read (signel--msg-is-read msg)))))) + +(defun signel--update-chat-buffer (source data stamp rec-stamp msg) + (when (signel--needs-insert-p data stamp rec-stamp msg) + (when-let ((b (signel--contact-buffer source))) + (with-current-buffer b + (signel--delete-last-prompt) + (if data + (let ((p (point))) + (insert (signel--timestamp "[" stamp "] ") + (signel--contact (signel--contact-name source)) + signel-prompt + data + "\n") + (fill-region p (point))) + (let ((is-read (signel--msg-is-read msg))) + (insert (signel--timestamp "*" (or rec-stamp stamp) "* ") + (signel--notice (if is-read "(read)" "(delivered)")) + "\n"))) + (signel--prompt-and-notify) + (end-of-line))))) +#+end_src + +There are some rough edges in the above implementation that must be +polished should signel ever be released in the wild. For one, proper +handling of timestamps and their formats. And of course notifications +should be much more customizable (here i'm using [[https://github.com/jorgenschaefer/circe/blob/master/tracking.el][Circe's tracking.el]] +if available). + +* Sending messages: the DBUS interface + +With that, we're going to receive and display messages and simple +receipts, and i'm sure that we will feel the urge to answer some of +them. As mentioned above, signal-cli let's us send messages via its +[[https://github.com/AsamK/signal-cli/wiki/DBus-service][DBUS interface]]. +In a nutshell, if you want to send ~MESSAGETEXT~ to a +~RECIPIENT~ you'd invoke something like: + +#+begin_src shell :tangle no +dbus-send --session --type=method_call \ + --dest="org.asamk.Signal" \ + /org/asamk/Signal \ + org.asamk.Signal.sendMessage \ + string:MESSAGETEXT array:string: string:RECIPIENT +#+end_src + +That is, call the method ~sendMessage~ of the corresponding service +interface with three arguments (the second one empty). Using emacs' +dbus libray one can write the above as: + +#+begin_src emacs-lisp +(defun signel--send-message (user msg) + (dbus-call-method :session "org.asamk.Signal" "/org/asamk/Signal" + "org.asamk.Signal" "sendMessage" + :string msg + '(:array) + :string user)) +#+end_src + +The only complicated bit is being careful with the specification of +the types of the method arguments: if one gets them wrong, DBUS will +simply complain and say that the method is not defined, which was +confusing me at first (but of course makes sense because DBUS allows +overloading method names, so the full method spec must include its +signature). + +We want to read whatever our user writes after the last prompt and +send it via the little helper above. Here's our interactive command +for that: + +#+begin_src emacs-lisp +(defun signel-send () + "Read text inserted in the current buffer after the last prompt and send it. + +The recipient of the message is looked up in a local variable set +when the buffer was created." + (interactive) + (goto-char (point-max)) + (beginning-of-line) + (let* ((p (point)) + (plen (length signel-prompt)) + (msg (buffer-substring (+ p plen) (point-max)))) + (signel--delete-prompt) + (signel--send-message signel-user msg) + (insert (signel--timestamp (format-time-string "(%H:%M) "))) + (fill-region p (point-max)) + (goto-char (point-max)) + (set-text-properties p (point) '(face signel-user)) + (insert "\n") + (signel--insert-prompt))) +#+end_src + +and we can bind it to the return key in signal chat buffers: + +#+begin_src emacs-lisp +(define-key signel-chat-mode-map "\C-m" #'signel-send) +#+end_src + +And we are going sometimes to want to talk to contacts that don't have +yet said anything and have, therefore, no associated chat buffer: + +#+begin_src emacs-lisp +(defun signel-query (contact) + "Start a conversation with a signal contact." + (interactive (list (completing-read "Signal to: " + (mapcar #'cdr-safe signel-contact-names)))) + (let ((phone (alist-get contact + (cl-pairlis (mapcar #'cdr signel-contact-names) + (mapcar #'car signel-contact-names)) + nil nil #'string-equal))) + (when (not phone) + (error "Unknown contact %s" contact)) + (pop-to-buffer (signel--contact-buffer phone)))) +#+end_src + +There are of course lots of rough edges and missing functionality in +this incipient signel, but it's already usable and a nice +demonstration of how easy it is to get the ball rolling in this lisp +machine of ours! -- cgit v1.2.3