>From 0abc682327a45eee28d5b255ba071f3b92036dc3 Mon Sep 17 00:00:00 2001 From: "J.P. Neverwas" Date: Thu, 4 Jan 2024 06:04:06 -0800 Subject: [PATCH 2/3] [POC] Use format-template-based API ;; Note that these changes exist for demonstration purposes and are intended ;; to be viewed as a series. Please pretend that library symbols beginning ;; with "erc--" are not actually internal. This uses an imagined version of a public insertion-modification API based on the current message catalog framework introduced by bug#67677. Its verbosity in terms of boilerplate can be construed as a benefit or a drawback, depending on the task. The main downside is that only one module can "win" if multiple ones attempt to define templates. Thus, integration between modules requires at least one to have knowledge of the other. IOW, no "stacking" or advice-like wrapping can occur, although this could change. --- erc-crypt.el | 234 +++++++++++++++++++++++++-------------------------- 1 file changed, 117 insertions(+), 117 deletions(-) diff --git a/erc-crypt.el b/erc-crypt.el index fdc2c8c..4ab0a18 100644 --- a/erc-crypt.el +++ b/erc-crypt.el @@ -90,6 +90,10 @@ (require 'sha1) (require 'cl-lib) +(defgroup erc-crypt nil + "Send encrypted messages in ERC." + :group 'erc) + (defvar erc-crypt-openssl-path "openssl" "Path to openssl binary.") @@ -181,27 +185,26 @@ Must be string.") (if (or (eql erc--module-toggle-prefix-arg 4) (erc-crypt-find-key)) (progn (add-hook 'erc-pre-send-functions #'erc-crypt-maybe-send nil t) - (add-hook 'erc-send-modify-hook #'erc-crypt-maybe-send-fixup nil t) (add-hook 'erc-insert-pre-hook #'erc-crypt-pre-insert nil t) - (add-hook 'erc-insert-modify-hook #'erc-crypt-maybe-insert nil t) - (add-hook 'erc-insert-post-hook #'erc-crypt-dh-save nil t) + (add-hook 'erc-insert-done-hook #'erc-crypt-dh-save nil t) ;; Reset buffer locals (setq erc-crypt--insert-queue nil) ;; Don't bother splitting lines, since the sub protocol already does ;; that for transmission purposes - (setq-local erc-split-line-length 0)) + (setq-local erc-split-line-length 0 + ;; FIXME use public API when it becomes available. + erc--message-speaker-catalog 'crypt-speaker)) (erc-crypt-mode -1))) ;; Disabled ( (remove-hook 'erc-pre-send-functions #'erc-crypt-maybe-send t) - (remove-hook 'erc-send-modify-hook #'erc-crypt-maybe-send-fixup t) (remove-hook 'erc-insert-pre-hook #'erc-crypt-pre-insert t) - (remove-hook 'erc-insert-modify-hook #'erc-crypt-maybe-insert t) - (remove-hook 'erc-insert-post-hook #'erc-crypt-dh-save t) + (remove-hook 'erc-insert-done-hook #'erc-crypt-dh-save t) (mapc #'kill-local-variable '(erc-crypt-key-file erc-crypt--insert-queue erc-crypt--post-insert - erc-split-line-length))) + erc-split-line-length + erc--message-speaker-catalog))) 'local) (unless (assq 'erc-crypt-mode minor-mode-alist) @@ -250,34 +253,13 @@ The variable is set in `erc-crypt-string-check' function always when postfix)) -(cl-defmacro erc-crypt--with-message ((message) &rest body) - "Conveniently work with narrowed region as implemented by ERC hooks. - -Search for and extract an encrypted message (if present), -then bind MESSAGE to it, delete the encrypted string from buffer -and execute BODY. Finally, restore ERC text properties. - -See `erc-send-modify-hook' and `erc-insert-modify-hook'." - (declare (indent defun)) - (let ((start (cl-gensym))) - `(when erc-crypt-mode - (goto-char (point-min)) - (let ((,start nil)) - (when-let ((prefix (erc-crypt-prefix-check)) - (postfix (erc-crypt-postfix-check)) - ((re-search-forward - (rx-to-string `(: ,prefix (+ nonl) ,postfix)) nil t))) - (let ((,message (buffer-substring (+ (match-beginning 0) - (length prefix)) - (- (match-end 0) - (length postfix)))) - (,start (match-beginning 0))) - (delete-region (match-beginning 0) (match-end 0)) - ;; FIXME probably don't need `start' at all. - (cl-assert (= (point) ,start)) - (goto-char ,start) - ,@body) - (erc-restore-text-properties)))))) +(defun erc-crypt--crypted-message-p (string) + "Return whether STRING is encrypted." + (cl-assert erc-crypt-mode) + (and-let* ((prefix (erc-crypt-prefix-check)) + (postfix (erc-crypt-postfix-check)) + (m (string-search prefix string))) + (string-search postfix string (+ m (length prefix))))) (defun erc-crypt--time-millis () "Return current time (time since Unix epoch) in milliseconds." @@ -462,17 +444,6 @@ Needed for receiving public keys and signature." (when (string-match "----CRYPT ON----" string) (erc-crypt-mode +4))))) - -(defun erc-crypt-maybe-send-fixup () - "Restore encrypted message back to its plaintext form. -This happens inside `erc-send-modify-hook'." - (when erc-crypt-mode - ;; HACK bind `erc-crypt--insert-queue' to avoid interfering with ongoing - ;; receipt. FIXME don't do ^ - (let (erc-crypt--insert-queue) - (erc-crypt--insert "")))) - - (cl-defun erc-crypt-string-check (string) "Check type of irc message in STRING for erc-crypt." (cond ((string-match (concat erc-crypt-dh-prefix "\\(.+\\)" @@ -513,9 +484,19 @@ This happens inside `erc-send-modify-hook'." (when (= split 1) (setq erc-insert-this nil)))) -(defun erc-crypt-pre-insert (string) +;; FIXME use insertion metadata store (once exposed by upstream) to pass +;; messages between hook members and various API callbacks (rather than +;; overloading `erc-crypt--insert-queue' for this purpose). +(defun erc-crypt-pre-insert (_) + "FIXME." + (when erc-crypt--insert-queue + (pcase (cdar erc-crypt--insert-queue) + (1 (setq erc-insert-this nil)) + (0 (setq erc-crypt--insert-queue nil))) + (force-mode-line-update))) + +(defun erc-crypt--handle-received-msg (string) "Decrypt STRING and insert it into `erc-crypt--insert-queue'. -If decrypted message is a fragment, `erc-insert-this' is set to nil. Does not display message and does not trigger `erc-insert-modify-hook'." (erc-crypt-string-check string) (when (string= erc-crypt-msg-type "normal-encrypted") @@ -526,85 +507,108 @@ Does not display message and does not trigger `erc-insert-modify-hook'." (split (aref decrypted (- len 3)));<- python (original (aref decrypted (- len 1)));<- compatible (decrypted (substring decrypted 0 original))) - (push (cons decrypted split) erc-crypt--insert-queue) - (if (= split 1) (setq erc-insert-this nil))) + (push (cons decrypted split) erc-crypt--insert-queue)) ;; Error, erc-insert-this will be set to t so it's not possible ;; for multiple error-indicating conses to be inserted in the ;; queue. (push (cons :error nil) erc-crypt--insert-queue)))) - (when erc-crypt--insert-queue - (force-mode-line-update))) - - -;; Maybe optionize this or similar. -(defvar erc-crypt-indicator-style 'after-speaker) - -(defun erc-crypt--insert (msg &optional error) - "Insert (ERROR) MSG with `erc-crypt-indicator'." - (insert (concat (if error "(decrypt error) " "") - (decode-coding-string msg 'utf-8 :nocopy))) - (goto-char (point-min)) - (when-let ((beg (text-property-not-all (point) (point-max) - 'erc--speaker nil))) - (goto-char (if (eq erc-crypt-indicator-style 'after-speaker) - (next-single-property-change beg 'erc--speaker) - beg))) - ;; FIXME cache this and/or use defined faces instead of anonymous ones. - (insert (propertize "‍" - 'display erc-crypt-indicator - 'font-lock-face (list :foreground - (if error - erc-crypt-failure-color - erc-crypt-success-color)))) - (setq erc-crypt--insert-queue nil)) - -;; FIXME integrate the following into (around) `erc-crypt-maybe-insert' body -;; itself. Added as a separate wrapper function for demo purposes to preserve -;; indentation (smaller diff). -(defun erc-crypt-maybe-insert () - (unless (and (fboundp 'erc-stamp-inserting-date-stamp-p) - (erc-stamp-inserting-date-stamp-p)) - (erc-crypt--maybe-insert/fixme))) - -(defun erc-crypt--maybe-insert/fixme () - "Display decrypted messages and do fragment reconstruction. -This happens inside `erc-insert-modify-hook'." - (erc-crypt--with-message (_) - (cl-loop with first = (cl-first erc-crypt--insert-queue) - with rest = (cl-rest erc-crypt--insert-queue) + erc-crypt--insert-queue) + +(defface erc-crypt-success-face `((t :foreground ,erc-crypt-success-color)) + "Encrypted indicator face on success.") + +(defface erc-crypt-failure-face `((t :foreground ,erc-crypt-failure-color)) + "Encrypted indicator face on failure.") + +(defvar erc-crypt--message-speaker-input-chan-privmsg-success + (concat (propertize "<" 'font-lock-face 'erc-default-face) + (propertize "%p" 'font-lock-face 'erc-my-nick-prefix-face) + (propertize "%n" 'font-lock-face 'erc-my-nick-face) + (propertize "%i" 'font-lock-face 'erc-crypt-success-face) + (propertize "> " 'font-lock-face 'erc-default-face) + (propertize "%m" 'font-lock-face 'erc-input-face)) + "Message template for encrypted chat input from own nick.") + +(defvar erc-crypt--message-speaker-chan-privmsg-success + (concat (propertize "<" 'font-lock-face 'erc-default-face) + (propertize "%p" 'font-lock-face 'erc-nick-prefix-face) + (propertize "%n" 'font-lock-face 'erc-nick-default-face) + (propertize "%i" 'font-lock-face 'erc-crypt-success-face) + (propertize "> %m" 'font-lock-face 'erc-default-face)) + "Message template for a successfully encrypted PRIVMSG in a channel.") + +(defvar erc-crypt--message-speaker-chan-privmsg-failure + (concat (propertize "<" 'font-lock-face 'erc-default-face) + (propertize "%p" 'font-lock-face 'erc-nick-prefix-face) + (propertize "%n" 'font-lock-face 'erc-nick-default-face) + (propertize "%i" 'font-lock-face 'erc-crypt-failure-face) + (propertize "> %m" 'font-lock-face 'erc-default-face)) + "Message template for a failed encrypted PRIVMSG in a channel.") + +;; FIXME use public name instead of `-speaker' when made available upstream. +(erc-define-message-format-catalog crypt-speaker + :parent erc--message-speaker-catalog + (input-chan-privmsg . #'erc-crypt--format-speaker-input-chan-privmsg) + (input-query-privmsg . #'erc-crypt--format-speaker-input-chan-privmsg) + (query-privmsg . #'erc-crypt--format-speaker-chan-privmsg) + (chan-privmsg . #'erc-crypt--format-speaker-chan-privmsg)) + +;; An unfortunate aspect of ERC's current API is the lack of symmetry between +;; incoming and outgoing insertion hooks. For example, `erc-crypt-maybe-send' +;; actually runs *before* this function via the abnormal hook +;; `erc-pre-send-functions', whereas `erc-crypt-pre-insert' runs *after +;; `erc-crypt--format-speaker-chan-privmsg'. +(defun erc-crypt--format-speaker-input-chan-privmsg (&rest plist) + "Return prompt-input string for insertion from `format-spec' PLIST." + (format-spec erc-crypt--message-speaker-input-chan-privmsg-success + (cons `(?i . ,erc-crypt-indicator) + (apply #'format-spec-make plist)))) + +(defun erc-crypt--format-speaker-chan-privmsg (&rest plist) + "Return formatted string for insertion from `format-spec' PLIST." + (let* ((string (plist-get plist ?m)) + (queue (erc-crypt--handle-received-msg string)) + (errorp (eq (eq 1 (caar queue)) :error)) + (msg (and (erc-crypt--crypted-message-p string) + (not (eq 1 (cdar queue))) + (erc-crypt--merge-fragments queue))) + (specs (apply #'format-spec-make plist))) + (when msg + (setf (alist-get ?m specs) (decode-coding-string msg 'utf-8) + specs (cons `(?i . ,erc-crypt-indicator) specs))) + ;; FIXME use public API to access default speaker format spec when + ;; exposed by upstream. + (format-spec (cond ((null msg) erc--message-speaker-chan-privmsg) + (errorp erc-crypt--message-speaker-chan-privmsg-failure) + (t erc-crypt--message-speaker-chan-privmsg-success)) + specs 'ignore-missing))) + +(defun erc-crypt--merge-fragments (queue) + "Return reconstituted and decrypted message from fragments in QUEUE." + (progn + (cl-loop with first = (cl-first queue) + with rest = (cl-rest queue) with msg = (car first) with tag = (cdr first) ;; Incomplete message fragment - when (equal tag 1) - do (cl-return) + do (cl-assert (not (eql tag 1))) ;; Complete message in one fragment when (and (equal tag 0) (null rest)) - do (erc-crypt--insert msg) - (setq erc-crypt--post-insert msg) - (cl-return) + return (setq erc-crypt--post-insert msg) ;; Either an error or final fragment for fragment in rest collect (car fragment) into out - finally + finally return (let ((out (mapconcat #'identity (nreverse out) ""))) (if (eql msg :error) - (erc-crypt--insert out t) - (setq erc-crypt--post-insert (concat out msg)) - (erc-crypt--insert (concat out msg))))))) + (concat "(decrypt error) " out) + (setq erc-crypt--post-insert (concat out msg))))))) (defun erc-crypt-dir-check (dir) "Check if DIR exists and if not make it." (unless (file-directory-p dir) (make-directory dir t))) -(defun erc-crypt-sig-b64-convert (tempdir nick) - (let ((sig (concat tempdir nick))) - (call-process - "base64" nil ;; no infile - `(:file ,(concat sig "-ed25519_sig.bin")) - nil "-d" (concat sig "-ed25519_sig.b64")) - (delete-file (concat sig "-ed25519_sig.b64")))) - (defun erc-crypt-dh-pubkey-check (tempdir nick) "Check if all needed keys in TEMPDIR with NICK in filename exists." (when (and (file-exists-p (concat tempdir nick "-ed25519_sig.bin")) @@ -637,9 +641,9 @@ This happens inside `erc-insert-modify-hook'." ;; because ed25519_sig is binary file it must be saved to text file and (if (string= erc-crypt-msg-type "ed25519_sig");then converted from base64 (progn (with-temp-file ;by separate process - (concat tempdir nick "-ed25519_sig.b64") - (insert key-or-sig)) - (erc-crypt-sig-b64-convert tempdir nick)) + (concat tempdir nick "-ed25519_sig.bin") + (set-buffer-multibyte nil) + (insert (base64-decode-string key-or-sig)))) (with-temp-file (concat tempdir nick "-" erc-crypt-msg-type ".pem") (insert key-or-sig))) @@ -659,13 +663,9 @@ This happens inside `erc-insert-modify-hook'." (erc-crypt-move-keys tempdir dir) - ;; FIXME don't kill buffers in `erc-insert-post-hook'; if you - ;; must, use `erc-insert-done-hook' instead (set-buffer ;; buffer with received keys is unneeded now - (car (erc-buffer-list-with-nick - nick - (get-buffer-process (erc-format-network))))) - (kill-buffer-and-window) + (prog1 (erc-server-buffer) + (kill-buffer-and-window))) (erc-crypt-find-key)) ;; <- when everything is OK then find new (erc-crypt--message ;; key -- 2.42.0