Re: bug#68265: 30.0.50; ERC 5.6: Simplify alternate text insertion for outgoing messages
"J.P." <[email protected]> Fri, 12 Jan 2024 08:21:21 -0800
| Newsgroups | gmane.emacs.erc.general |
|---|---|
| Message-ID | <[email protected]> |
"J.P." <[email protected]> writes: > Demo implementation for an existing third-party package forthcoming. The demo described below illustrates a realistic use case for three closely related features: the one offered by this bug, the existing template-catalog framework, and the newly proposed hook-based "msgfspec" interface from bug67677. See that thread for the latest version of these changes as well. As an example of how this is meant to work, I've chosen to modify a project recently shared on Libera.Chat by an ERC user. It's an informal "fork" of erc-crypt that includes semi-automated Diffie-Hellman key exchange. For those not familiar, the package allows two parties to converse privately, in band, in a manner roughly analogous to OTR. The three most recent commits (mine) demonstrate overlapping ways of adapting the existing code to leverage what's hopefully an improved menu of interface options for influencing message formatting and insertion: 1. the "alternate text" slot of `erc-input' (this bug) 2. ERC's template-catalog framework for dictating how "speaker" message's appear when inserted (internal) 3. the public-facing side of (2), a hook-based interface called "msgfspec" that exposes individual components of a message template prior to formatting In case my original post wasn't clear, the main win offered by this combined, multifaceted approach over existing offerings is improved interoperability with other modules. The demo code is temporarily hosted in ERC's CI forge [1], and the relevant changes live in the last few commits of that repo. They roughly align with the three interfaces listed above, and the contrast between them hopefully reveals an obvious progression in terms of brevity, control, and flexibility. I've exported the changes in patch form for convenience, but you'll obviously have to clone the repo to try it. In addition to the commit messages and code comments, please see the recent activity in bug67677, whose latest patches are also required for the demo to work. Thanks. [1] https://gitlab.com/emacs-erc/bug68265-demo.git To actually run it, you need to fire up two emacs -Q instances, and evaluate the following, ensuring `nick' is distinct in each. (require 'erc) (erc-toggle-debug-irc-protocol) (toggle-debug-on-error) (with-current-buffer "*erc-protocol*" (toggle-truncate-lines)) (setq erc-fill-function 'erc-fill-static erc-autojoin-channels-alist '((foonet "#test")) erc-modules (cons 'crypt erc-modules)) (let* ((nick "bob") ;; ^~~~~~~~~~~~~~~~~~~ change this per instance! (erc-crypt-dir-userdef (expand-file-name (format "erc-crypt/%s/" nick) (temporary-file-directory)))) (make-directory erc-crypt-dir-userdef 'parents) (require 'erc-crypt) (with-current-buffer (erc :server "127.0.0.1" :nick nick) (unless (file-exists-p (expand-file-name "secret" erc-crypt-dir-userdef)) (erc-cmd-CRYPT "genkeys")))) Once you're up and running, navigate to the #test buffer, and type "/crypt dh <othernick>", where "<othernick>" is the `nick' specified for the _other_ instance. After that, type "/query <othernick>", and commence chatting as usual. If you take a look at the "*erc-protocol*" buffer, you'll see all new messages are encrypted. If you're bored, try sending a giant multiline message.
0001-POC-Use-erc-pre-send-functions-API.patch
(text/x-patch, 19.1 KB)
From 3f777c98b55a230a18533e39bb481b902aeba128 Mon Sep 17 00:00:00 2001 From: "J.P. Neverwas" <[email protected]> Date: Thu, 4 Jan 2024 06:04:06 -0800 Subject: [PATCH 1/3] [POC] Use erc-pre-send-functions API ;; Note that these changes exist for demonstration purposes and are intended ;; to be viewed as a series. For the sake of simplicity, they ignore ;; in-channel functionality and focus exclusively on queries (direct ;; messages). These changes only work with ERC 5.6-git and the patches from bug#68265 applied atop HEAD. The primary innovation here is the newly decoupled show-send pairing for processing prompt input via `erc-pre-send-functions'. This allows the module to refrain from disabling `erc-fill', which would otherwise mangle its payload. However, notice there's still a bit of awkwardness with `erc-crypt--insert' in terms of abstraction leakage. Third parties shouldn't be troubled with the particulars of message text properties. In much the same fashion, the function `erc-crypt-get-last-message-nick', relies on heuristics to find the speaker. --- erc-crypt.el | 251 +++++++++++++++++++++++---------------------------- 1 file changed, 111 insertions(+), 140 deletions(-) diff --git a/erc-crypt.el b/erc-crypt.el index 8528be0..fdc2c8c 100644 --- a/erc-crypt.el +++ b/erc-crypt.el @@ -7,7 +7,7 @@ ;; Version: 2.1 ;; Author: xristos <[email protected]> ;; URL: https://github.com/atomontage/erc-crypt -;; Package-Requires: ((cl-lib "0.5")) +;; Package-Requires: ((erc "5.6") (cl-lib "0.5")) ;; Keywords: comm ;; Redistribution and use in source and binary forms, with or without @@ -86,17 +86,9 @@ ;; to preserve your current history. That way, it's much easier for outsiders ;; to gauge how they differ. Just a suggestion. -;; FIXME include minimum supported version of ERC in the Package-Requires -;; header so that people who install this via package.el will automatically -;; get the right ERC as a dependency. (require 'erc) (require 'sha1) (require 'cl-lib) -(require 'erc-fill) - -;; erc-fill doesn't play nice with erc-crypt.el -(defvar-local erc-crypt-fill-function nil) -;; (make-variable-buffer-local 'erc-fill-function) ; <- pls don't do this! (defvar erc-crypt-openssl-path "openssl" "Path to openssl binary.") @@ -119,16 +111,9 @@ If input message exceeds it, message is broken up using `erc-crypt-split-message'. This is used to work around IRC protocol message limits.") -(defvar-local erc-crypt-message nil - "Last message sent (before encryption).") - (defvar-local erc-crypt-key-file nil "Path to erc-crypt keyfile. It's buffer local.") -(defvar-local erc-crypt--left-over nil - "List that contains message fragments. -Processed by `erc-crypt-post-send' inside `erc-send-completed-hook'.") - (defvar-local erc-crypt--insert-queue nil "List that contains message fragments, before insertion. Managed by `erc-crypt-maybe-insert'.") @@ -179,51 +164,54 @@ Must be string.") (defvar erc-crypt-dir-userdef "~/.emacs.d/irc/erc-crypt" "User defined directory for erc-crypt.") -;; Consider initializing at runtime so users can set `erc-crypt-dir-userdef' -;; after loading this file. -(defvar erc-crypt--dir (expand-file-name - (file-name-as-directory erc-crypt-dir-userdef)) - "Erc crypt directory contained public and private keys.") +;; You could make this `buffer-local' so that users can use different +;; directories for different ERC sessions in the same Emacs session, but you'd +;; need to update all the `erc-crypt-dh-*' functions, etc. +(defvar erc-crypt--dir nil + "Directory ending in a slash, containing public and private keys.") -(add-hook 'erc-insert-pre-hook #'erc-crypt-on-off-check) - ;; enable if '----CRYPT ON----' string found - -(define-minor-mode erc-crypt-mode +(define-erc-module crypt nil "Per buffer encryption for ERC." - :lighter " CRYPT" - (if erc-crypt-mode - ;; Enabled - (progn - ;; FIXME use new API (`erc-pre-send-functions'). - (with-suppressed-warnings ((obsolete erc-send-pre-hook)) - (add-hook 'erc-send-pre-hook #'erc-crypt-maybe-send nil t)) + ;; Enabled + ((unless erc-crypt--dir + ;; enable if '----CRYPT ON----' string found + (add-hook 'erc-insert-pre-hook #'erc-crypt-on-off-check) + (setq erc-crypt--dir + (expand-file-name (file-name-as-directory erc-crypt-dir-userdef)))) + (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-send-completed-hook #'erc-crypt-post-send 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) ;; Reset buffer locals - (setq-local erc-fill-function nil) - (setq erc-crypt--left-over nil - erc-crypt--insert-queue nil - erc-crypt-fill-function erc-fill-function)) + (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)) + (erc-crypt-mode -1))) ;; Disabled - (progn - ;; FIXME use new API (`erc-pre-send-functions'). - (with-suppressed-warnings ((obsolete erc-send-pre-hook)) - (remove-hook 'erc-send-pre-hook #'erc-crypt-maybe-send t)) + ( (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-send-completed-hook #'erc-crypt-post-send 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) - (unless erc-fill-function (kill-local-variable 'erc-fill-function)) - (setq erc-crypt-fill-function nil)))) - -;; FIXME move here so `erc-crypt-mode' itself is already defined. -(define-globalized-minor-mode erc-crypt-on-off erc-crypt-mode - erc-crypt-find-key :group 'erc-crypt) ;; enable if key found + (mapc #'kill-local-variable '(erc-crypt-key-file + erc-crypt--insert-queue + erc-crypt--post-insert + erc-split-line-length))) + 'local) + +(unless (assq 'erc-crypt-mode minor-mode-alist) + (push '(erc-crypt-mode + (erc-crypt--insert-queue + (" CRYPT⇄" (:propertize (:eval (number-to-string + (length erc-crypt--insert-queue))) + face mode-line-emphasis)) + " CRYPT")) + minor-mode-alist)) ;;; ;;; Internals @@ -274,20 +262,19 @@ See `erc-send-modify-hook' and `erc-insert-modify-hook'." (let ((start (cl-gensym))) `(when erc-crypt-mode (goto-char (point-min)) - ;; FIXME These two functions can return nil when, e.g., - ;; `erc-crypt-msg-type' is "plain-text", which means this search will - ;; always match, and QUIT messages etc. will be replaced with an - ;; indicator. - (let* ((prefix (erc-crypt-prefix-check)) - (postfix (erc-crypt-postfix-check)) - (,start nil)) - (when (re-search-forward (concat prefix ".+" postfix) nil t) + (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)))))) @@ -417,9 +404,9 @@ and the CIPHERTEXT, which must be BASE64 encoded as well." (error-message-string ex)) nil))) -;; FIXME use new API expecting an `erc-input' object instead of a STRING. -(defun erc-crypt-maybe-send (string) - "Encrypt STRING and send to receiver. Run as a hook in `erc-send-pre-hook'. +(defun erc-crypt-maybe-send (input) + "Encrypt `string' slot of `erc-input' object INPUT. +;; FIXME string ~~> input ... STRING should contain user input. In order to get around IRC protocol message size limits, STRING is split into fragments and padded to a constant size, `erc-crypt-max-length', by calling `erc-crypt-split-message'. @@ -430,22 +417,21 @@ formatting preserved intact. On errors, do not send STRING to the server." (when (and erc-crypt-mode erc-crypt-key-file ;; Skip ERC commands - (not (string= "/" (substring string 0 1)))) - (let* ((split (erc-crypt-split-message string)) - (encrypted (mapcar #'erc-crypt-encrypt split))) - (cond ((cl-some #'null encrypted) - (erc-crypt--message "Message will not be sent") - (with-suppressed-warnings ((obsolete erc-send-this)) - (setq erc-send-this nil))) - (t - ;; str is dynamically bound - (with-suppressed-warnings ((lexical str)) (defvar str)) - (setq erc-crypt-message str - str (concat erc-crypt-prefix - (cl-first encrypted) - erc-crypt-postfix) - erc-crypt--left-over - (cl-rest encrypted))))))) + (not (string-prefix-p "/" (erc-input-string input)))) + (if-let ((clear-str (erc-input-string input)) + (encrypted (mapcar #'erc-crypt-encrypt + (erc-crypt-split-message clear-str))) + ;; No need to invert with `not' if `encrypted' is non-nil. + ((not (cl-some #'null encrypted))) + (bookended (mapcar (lambda (encrypted-msg-body) + (concat erc-crypt-prefix + encrypted-msg-body + erc-crypt-postfix)) + encrypted))) + (setf (erc-input-substxt input) clear-str + (erc-input-string input) (string-join bookended "\n")) + (erc-crypt--message "Message will not be sent") + (setf (erc-input-sendp input) nil)))) (defun erc-crypt-find-key () @@ -463,7 +449,7 @@ On errors, do not send STRING to the server." channel;<--- channel or friend directory - 4rd %s channel));<- channel or friend content (key-exists (file-exists-p key-path)));<- if key found - (when key-exists (progn (erc-crypt-enable);<-- then enable erc-crypt + (when key-exists (progn (unless erc-crypt-mode (erc-crypt-enable)) (setq erc-crypt-key-file key-path))))));<- set ;; path of key @@ -474,18 +460,17 @@ Needed for receiving public keys and signature." (unless erc-crypt-mode (when (eq major-mode 'erc-mode) (when (string-match "----CRYPT ON----" string) - (erc-crypt-enable))))) + (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'." - (erc-crypt--with-message (_) - (insert erc-crypt-message) - (goto-char (point-min)) - (insert (concat (propertize erc-crypt-indicator 'face - (list :foreground erc-crypt-success-color)) - " ")))) + (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) @@ -546,20 +531,31 @@ Does not display message and does not trigger `erc-insert-modify-hook'." ;; 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))))) + (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)) - (insert (concat - (propertize - erc-crypt-indicator 'face - (list :foreground - (if error - erc-crypt-failure-color erc-crypt-success-color))) - " ")) + (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 @@ -663,6 +659,8 @@ 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 @@ -691,6 +689,7 @@ This happens inside `erc-insert-modify-hook'." "Verify received ed25519 signature, then check verified status in TEMPDIR. If positive copy to DIR / NICK directory and delete after original ~/.emasc.d/irc/erc-crypt/temp/verify-status after all." + ;; FIXME `tempdir' ends in a slash. so this results in //nick. (let* ((keyname (concat tempdir "/" nick)) (status (call-process erc-crypt-openssl-path @@ -714,6 +713,17 @@ Then move to KEYFILE with filename NICK." "--peerkey" (concat tempdir nick "-x25519_pub.pem") "-out" keyfile)) +;; XXX if this is meant to find the speaker of the previous chat message, +;; you'll have to `save-restriction' and `widen' before searching backward, +;; because this runs in a narrowed buffer. If, OTOH, this is meant to find +;; the speaker of the *current* message, you can instead do: +;; +;; (erc-get-parsed-vector-nick (erc-get-parsed-vector)) +;; +;; However, there's no real need to re-parse the original sender because ERC +;; already knows the speaker's nick but doesn't provide a way for third +;; parties to access it. Please file a bug report with M-x erc-bug RET if +;; you feel such functionality should be exposed. (defun erc-crypt-get-last-message-nick () "Get the nickname of the last message in the ERC chat buffer." (interactive) @@ -728,19 +738,6 @@ Then move to KEYFILE with filename NICK." (nick (match-string 0 nick-line))) ;; bind nick to variable (goto-char (point-max)) nick)))) -;; return nick - -(defun erc-crypt-post-send (_) - "Send message fragments placed in `erc-crypt--left-over' to remote end. -STRING is unused, but required." - (unwind-protect - (cl-loop for m in erc-crypt--left-over do - (erc-message "PRIVMSG" - (concat (erc-default-target) " " - (concat erc-crypt-prefix m erc-crypt-postfix)) - )) - (setq erc-crypt--left-over nil))) - (defun erc-crypt-split-message (string) "Split STRING and pad to maximum size if needed." @@ -797,17 +794,15 @@ It is used for verify x25519_pub.pem key." ed-b64))) (defun erc-crypt-dh-ed-sig-read () - "Read ed25519_sig.bin signature file found in `erc-crypt--dir'/secret/ dir. -It is used for verify x25519_pub.pem key." - (with-temp-buffer - (insert-file-contents (concat - erc-crypt--dir "secret/ed25519_sig.bin")) - (let* ((sig-b64 (base64-encode-string (buffer-string))) - (sig-split (erc-crypt-split-dh sig-b64)) - (sig-b64 (mapcar #'(lambda (sig-split) - (base64-encode-string sig-split t)) - sig-split))) - sig-b64))) + "Read ed25519_sig.bin signature file from `erc-crypt--dir'/secret/. +Use it to verify x25519_pub.pem in the same directory." + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally + (concat erc-crypt--dir "secret/ed25519_sig.bin")) + (let* ((sig-b64 (base64-encode-string (buffer-string))) + (sig-split (erc-crypt-split-dh sig-b64))) + (mapcar (lambda (split) (base64-encode-string split t)) sig-split)))) (defun erc-crypt-dh-ex (nick) "Read and public keys and signature and send to NICK." @@ -922,7 +917,7 @@ x25519 public key." (erc-crypt--message "Keypairs generated and signed succesfully.") (erc-crypt--message "Generate keypairs or signing failed.")))) - +;; FIXME autoload this. (defun erc-cmd-CRYPT (option &optional &rest args) ; FIXME 2x &foo (progn (cond ((string= option "genkeys") @@ -957,29 +952,5 @@ x25519 public key." (erc-send-input (substring (format "%s" args) 1 (- len 1)))) (erc-crypt-enable))))) -;;; -;;; Interactive -;;; - -;; FIXME consider using `define-erc-module' with a non-nil `local', instead of -;; `define-minor-mode' above. It gives you these enable/disable helpers for -;; free and a bunch of symbol properties and other niceties that ERC relies on -;; for Customize integrations and so forth. May have to condition the enable -;; body on `erc-crypt-find-key' passing, and disable the mode if it fails. - -;;;###autoload -(defun erc-crypt-enable () - "Enable PSK encryption for the current buffer." - (interactive) - (when (eq major-mode 'erc-mode) t) - (erc-crypt-mode 1)) - -;;;###autoload -(defun erc-crypt-disable () - "Disable PSK encryption for the current buffer." - (interactive) - (when (eq major-mode 'erc-mode) t) - (erc-crypt-mode -1)) - (provide 'erc-crypt) ;;; erc-crypt.el ends here -- 2.42.0
0002-POC-Use-format-template-based-API.patch
(text/x-patch, 16.3 KB)
From 0abc682327a45eee28d5b255ba071f3b92036dc3 Mon Sep 17 00:00:00 2001 From: "J.P. Neverwas" <[email protected]> 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
0003-POC-Use-proposed-msgfspec-API.patch
(text/x-patch, 8.7 KB)
From 7b09a1403c3f7d554d21340307ba4b13bd19b098 Mon Sep 17 00:00:00 2001 From: "J.P. Neverwas" <[email protected]> Date: Wed, 10 Jan 2024 06:47:49 -0800 Subject: [PATCH 3/3] [POC] Use proposed msgfspec 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 actually "erc-", meaning *not* internal. This demos the proposed "msgfspec" API, which allows third parties to more easily influence the content and appearance of inserted chat messages ("speaker messages") without having to fiddle with the more involved templating framework shown in the last commit (and introduced as a feature by bug#67677). However, that framework is still useful for dictating the overall look of messages in a buffer and, as such, will probably be kept internal. Modules wishing to interoperate with a specific catalog's formatting features can leverage the "msgfspec" hook to apply smaller tweaks without having to override catalog entries entirely. Less boilerplate makes for easier reading and means less surface area to maintain. --- erc-crypt.el | 103 +++++++++++++++++++++------------------------------ 1 file changed, 42 insertions(+), 61 deletions(-) diff --git a/erc-crypt.el b/erc-crypt.el index 4ab0a18..7b6e3ce 100644 --- a/erc-crypt.el +++ b/erc-crypt.el @@ -187,24 +187,26 @@ Must be string.") (add-hook 'erc-pre-send-functions #'erc-crypt-maybe-send nil t) (add-hook 'erc-insert-pre-hook #'erc-crypt-pre-insert nil t) (add-hook 'erc-insert-done-hook #'erc-crypt-dh-save nil t) + ;; Add indicator and replace message when receiving. + (add-hook 'erc--msgfspec-speaker-hook + #'erc-crypt--on-msgfspec-speaker 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 - ;; FIXME use public API when it becomes available. - erc--message-speaker-catalog 'crypt-speaker)) + (setq-local erc-split-line-length 0)) (erc-crypt-mode -1))) ;; Disabled ( (remove-hook 'erc-pre-send-functions #'erc-crypt-maybe-send t) (remove-hook 'erc-insert-pre-hook #'erc-crypt-pre-insert t) (remove-hook 'erc-insert-done-hook #'erc-crypt-dh-save t) + (remove-hook 'erc--msgfspec-speaker-hook + #'erc-crypt--on-msgfspec-speaker t) (mapc #'kill-local-variable '(erc-crypt-key-file erc-crypt--insert-queue erc-crypt--post-insert - erc-split-line-length - erc--message-speaker-catalog))) + erc-split-line-length))) 'local) (unless (assq 'erc-crypt-mode minor-mode-alist) @@ -514,74 +516,53 @@ Does not display message and does not trigger `erc-insert-modify-hook'." (push (cons :error nil) erc-crypt--insert-queue)))) erc-crypt--insert-queue) +;; Maybe optionize this or similar. +(defvar erc-crypt-indicator-style 'after-speaker) + (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)) +(defun erc-crypt--add-indicator-to-msgfmt (spec-obj &optional errorp) + "Modify `fmt' slot of `erc--msgfspec' SPEC-OBJ. +With ERRORP, use `erc-crypt-failure-face'." + (let ((rep (if errorp + #("%i" 0 2 (font-lock-face erc-crypt-failure-face)) + #("%i" 0 2 (font-lock-face erc-crypt-success-face))))) + (if (eq erc-crypt-indicator-style 'after-speaker) + (erc--msgfspec-insert-spec-after spec-obj ?n ?i rep) + (erc--msgfspec-insert-spec-before spec-obj ?n ?i rep)))) ;; 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--on-msgfspec-speaker (spec-obj) + "Update `erc--msgfspec' SPEC-OBJ for normal chat messages." + (and + (pcase spec-obj + ;; This is an outgoing encrypted message. + ((cl-struct erc--msgfspec-speaker + (key (or 'input-chan-privmsg 'input-query-privmsg))) + (erc-crypt--add-indicator-to-msgfmt spec-obj)) + ;; This is an incoming encrypted message. + ((cl-struct erc--msgfspec-speaker + (key (or 'chan-privmsg 'query-privmsg)) + (\?m string)) + ;; Modify spec when STRING is an error or a terminal message. + (let* ((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)))) + (when msg + (setf (erc--msgfspec-speaker-?m spec-obj) + (decode-coding-string msg 'utf-8)) + (erc-crypt--add-indicator-to-msgfmt spec-obj errorp))))) + (push `(?i . ,erc-crypt-indicator) (erc--msgfspec-alist spec-obj)))) (defun erc-crypt--merge-fragments (queue) "Return reconstituted and decrypted message from fragments in QUEUE." -- 2.42.0