Subject: 29.0.50; Accept functions in place of passwords in ERC

From: "J.P." <[email-masked]>
Date: Tue, 15 Nov 2022 07:06:42 -0800

Tags: patch

Hi people,

At the moment, ERC invokes password getters (deobfuscation or decryption
thunks) immediately upon receipt from upstream libraries and retains the
surrendered goods for the remainder of a session. As has been suggested
before [1], ERC should instead defer such action to help reduce some of
the friction involved with sharing backtraces and logs. While this patch
doesn't go all the way and introduce wrapping functionality for secrets
obtained from users by ERC directly, it does lay some of the groundwork.

Note that this patch assumes certain changes from bug#29108 [2] have
already been applied.

Thanks,
J.P.

[1] https://lists.gnu.org/archive/html/bug-gnu-emacs/2022-04/msg01149.html
[2] https://debbugs.gnu.org/cgi/bugreport.cgi?bug=29108#130

In GNU Emacs 29.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version
 3.24.34, cairo version 1.17.6) of 2022-11-14 built on localhost
Repository revision: 222c2970323e72c174f7b47201863ec9092e9595
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12014000
System Description: Fedora Linux 36 (Workstation Edition)

Configured using:
 'configure --enable-check-lisp-object-type --enable-checking=yes,glyphs
 'CFLAGS=-O0 -g3'
 PKG_CONFIG_PATH=:/usr/lib64/pkgconfig:/usr/share/pkgconfig'

Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 M17N_FLT MODULES NOTIFY
INOTIFY PDUMPER PNG RSVG SECCOMP SOUND SQLITE3 THREADS TIFF
TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM XINPUT2 XPM GTK3 ZLIB

Important settings:
  value of $LANG: en_US.UTF-8
  value of $XMODIFIERS: @im=ibus
  locale-coding-system: utf-8-unix

Major mode: Lisp Interaction

Minor modes in effect:
  tooltip-mode: t
  global-eldoc-mode: t
  eldoc-mode: t
  show-paren-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  tool-bar-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  line-number-mode: t
  indent-tabs-mode: t
  transient-mark-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t

Load-path shadows:
None found.

Features:
(shadow sort mail-extr emacsbug message mailcap yank-media puny dired
dired-loaddefs rfc822 mml mml-sec password-cache epa derived epg rfc6068
epg-config gnus-util text-property-search time-date subr-x mm-decode
mm-bodies mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader
cl-loaddefs cl-lib sendmail rfc2047 rfc2045 ietf-drums mm-util
mail-prsvr mail-utils rmc iso-transl tooltip cconv eldoc paren electric
uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel
term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image
regexp-opt fringe tabulated-list replace newcomment text-mode lisp-mode
prog-mode register page tab-bar menu-bar rfn-eshadow isearch easymenu
timer select scroll-bar mouse jit-lock font-lock syntax font-core
term/tty-colors frame minibuffer nadvice seq simple cl-generic
indonesian philippine cham georgian utf-8-lang misc-lang vietnamese
tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek
romanian slovak czech european ethiopic indian cyrillic chinese
composite emoji-zwj charscript charprop case-table epa-hook
jka-cmpr-hook help abbrev obarray oclosure cl-preloaded button loaddefs
theme-loaddefs faces cus-face macroexp files window text-properties
overlay sha1 md5 base64 format env code-pages mule custom widget keymap
hashtable-print-readable backquote threads dbusbind inotify lcms2
dynamic-setting system-font-setting font-render-setting cairo
move-toolbar gtk x-toolkit xinput2 x multi-tty make-network-process
emacs)

Memory information:
((conses 16 36187 5588)
 (symbols 48 5117 0)
 (strings 32 13145 1394)
 (string-bytes 1 374521)
 (vectors 16 9322)
 (vector-slots 8 148275 11115)
 (floats 8 21 25)
 (intervals 56 220 0)
 (buffers 984 10))

>From e66da1c42f88376daa8385684a31830a4051e687 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email-masked]>
Date: Sun, 13 Nov 2022 01:52:48 -0800
Subject: [PATCH] Accept functions in place of passwords in ERC

* lisp/erc/erc-backend.el (erc-session-password): Add comment
explaining type is now string, nil, or function.
* lisp/erc/erc-sasl.el (erc-sasl--read-password): Use `erc--unfun'.
* lisp/erc/erc-services.el (erc-nickserv-get-password,
erc-nickserv-send-identify): Use `erc--unfun'.
* lisp/erc/erc.el (erc--unfun): New function for unwrapping a
password couched in a getter.
(erc--debug-irc-protocol-mask-secrets): Add variable to indicate
whether to mask passwords in debug logs.
(erc--mask-secrets): New function to swap masked secret with question
marks in debug logs.
(erc-log-irc-protocol): Conditionally mask secrets when
`erc--debug-irc-protocol-mask-secrets' is non-nil.
(erc--auth-source-search): Don't unwrap secret from function before
returning.
(erc-server-join-channel, erc-login): Use `erc--unfun'.

* test/lisp/erc/erc-services-tests.el
(erc-services-tests--wrap-search): Add helper for `erc--unfun'.
(erc-services-tests--auth-source-standard,
erc-services-tests--auth-source-announced,
erc-services-tests--auth-source-overrides, erc-nickserv-get-password):
Use `erc--unfun'.
* test/lisp/erc/erc-tests.el (erc--debug-irc-protocol-mask-secrets):
Add test for masking secrets with `erc--unfun' and friends.
---
 lisp/erc/erc-backend.el             |  3 ++-
 lisp/erc/erc-sasl.el                |  2 +-
 lisp/erc/erc-services.el            |  5 ++--
 lisp/erc/erc.el                     | 38 +++++++++++++++++++++++++----
 test/lisp/erc/erc-services-tests.el | 16 +++++++++---
 test/lisp/erc/erc-tests.el          | 22 +++++++++++++++++
 6 files changed, 73 insertions(+), 13 deletions(-)

diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 37a3da8b66..382eb833ff 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -205,7 +205,8 @@ erc-whowas-on-nosuchnick
 ;;;; Variables and options
 
 (defvar-local erc-session-password nil
-  "The password used for the current session.")
+  "The password used for the current session.
+This should be a string or a function returning a string.")
 
 (defvar erc-server-responses (make-hash-table :test #'equal)
   "Hash table mapping server responses to their handler hooks.")
diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el
index a9d7ed235d..d8ef600351 100644
--- a/lisp/erc/erc-sasl.el
+++ b/lisp/erc/erc-sasl.el
@@ -141,7 +141,7 @@ erc-sasl--read-password
                               ,@(and host (list :host (symbol-name host)))))))
               erc-session-password)))
     (if found
-        (copy-sequence found)
+        (copy-sequence (erc--unfun found))
       (read-passwd prompt))))
 
 (defun erc-sasl--plain-response (client steps)
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index fe9cb5b5f1..48953288d1 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -455,7 +455,7 @@ erc-nickserv-get-password
                   (read-passwd
                    (format "NickServ password for %s on %s (RET to cancel): "
                            nick nid)))))
-       ((not (string-empty-p ret))))
+       ((not (string-empty-p (erc--unfun ret)))))
     ret))
 
 (defvar erc-auto-discard-away)
@@ -477,7 +477,8 @@ erc-nickserv-send-identify
          (msgtype (or (erc-nickserv-alist-ident-command nil nickserv-info)
                       "PRIVMSG")))
     (erc-message msgtype
-                 (concat nickserv " " identify-word " " nick password))))
+                 (concat nickserv " " identify-word " " nick
+                         (erc--unfun password)))))
 
 (defun erc-nickserv-call-identify-function (nickname)
   "Call `erc-nickserv-identify' with NICKNAME."
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 6a9bd56794..0a76719c8f 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2301,6 +2301,23 @@ erc-debug-irc-protocol
 WARNING: Do not set this variable directly!  Instead, use the
 function `erc-toggle-debug-irc-protocol' to toggle its value.")
 
+(defvar erc--debug-irc-protocol-mask-secrets t
+  "Whether to hide secrets in a debug log.
+They are still visible on screen but are replaced by question
+marks when yanked.")
+
+(defun erc--mask-secrets (string)
+  (when-let* ((eot (length string))
+              (beg (text-property-any 0 eot 'erc-secret t string))
+              (end (text-property-not-all beg eot 'erc-secret t string))
+              (sec (substring string beg end)))
+    (setq string (concat (substring string 0 beg)
+                         (make-string (- end beg) ??)
+                         (substring string end eot)))
+    (put-text-property beg end 'face 'erc-inverse-face string)
+    (put-text-property beg end 'display sec string))
+  string)
+
 (defun erc-log-irc-protocol (string &optional outbound)
   "Append STRING to the buffer *erc-protocol*.
 
@@ -2326,6 +2343,8 @@ erc-log-irc-protocol
                       (format "%s:%s" erc-session-server erc-session-port))))
           (ts (when erc-debug-irc-protocol-time-format
                 (format-time-string erc-debug-irc-protocol-time-format))))
+      (when erc--debug-irc-protocol-mask-secrets
+        (setq string (erc--mask-secrets string)))
       (with-current-buffer (get-buffer-create "*erc-protocol*")
         (save-excursion
           (goto-char (point-max))
@@ -3249,9 +3268,8 @@ erc--auth-source-search
       (setq plist (plist-put plist :max 5000))) ; `auth-source-netrc-parse'
     (unless (plist-get defaults :require)
       (setq plist (plist-put plist :require '(:secret))))
-    (when-let* ((sorted (sort (apply #'auth-source-search plist) test))
-                (secret (plist-get (car sorted) :secret)))
-      (if (functionp secret) (funcall secret) secret))))
+    (when-let* ((sorted (sort (apply #'auth-source-search plist) test)))
+      (plist-get (car sorted) :secret))))
 
 (defun erc-auth-source-search (&rest plist)
   "Call `auth-source-search', possibly with keyword params in PLIST."
@@ -3272,7 +3290,8 @@ erc-server-join-channel
     (setq secret (apply erc-auth-source-join-function
                         `(,@(and server (list :host server)) :user ,channel))))
   (erc-log (format "cmd: JOIN: %s" channel))
-  (erc-server-send (concat "JOIN " channel (and secret (concat " " secret)))))
+  (erc-server-send (concat "JOIN " channel
+                           (and secret (concat " " (erc--unfun secret))))))
 
 (defun erc--valid-local-channel-p (channel)
   "Non-nil when channel is server-local on a network that allows them."
@@ -6292,6 +6311,15 @@ erc-load-irc-script-lines
 
 ;; authentication
 
+(defun erc--unfun (maybe-fn)
+  "Return MAYBE-FN or whatever it returns."
+  (let ((s (if (functionp maybe-fn) (funcall maybe-fn) maybe-fn)))
+    (when (and erc-debug-irc-protocol
+               erc--debug-irc-protocol-mask-secrets
+               (stringp s))
+      (put-text-property 0 (length s) 'erc-secret t s))
+    s))
+
 (defun erc-login ()
   "Perform user authentication at the IRC server."
   (erc-log (format "login: nick: %s, user: %s %s %s :%s"
@@ -6301,7 +6329,7 @@ erc-login
                    erc-session-server
                    erc-session-user-full-name))
   (if erc-session-password
-      (erc-server-send (concat "PASS :" erc-session-password))
+      (erc-server-send (concat "PASS :" (erc--unfun erc-session-password)))
     (message "Logging in without password"))
   (erc-server-send (format "NICK %s" (erc-current-nick)))
   (erc-server-send
diff --git a/test/lisp/erc/erc-services-tests.el b/test/lisp/erc/erc-services-tests.el
index c22d4cf75e..e35b70e026 100644
--- a/test/lisp/erc/erc-services-tests.el
+++ b/test/lisp/erc/erc-services-tests.el
@@ -62,9 +62,13 @@ erc--auth-source-determine-params-merge
                            :x ("x")
                            :require (:secret))))))
 
+(defun erc-services-tests--wrap-search (s)
+  (lambda (&rest r) (erc--unfun (apply s r))))
+
 ;; Some of the following may be related to bug#23438.
 
 (defun erc-services-tests--auth-source-standard (search)
+  (setq search (erc-services-tests--wrap-search search))
 
   (ert-info ("Session wins")
     (let ((erc-session-server "irc.gnu.org")
@@ -93,6 +97,7 @@ erc-services-tests--auth-source-standard
       (should (string= (funcall search :user "#chan") "baz")))))
 
 (defun erc-services-tests--auth-source-announced (search)
+  (setq search (erc-services-tests--wrap-search search))
   (let* ((erc--isupport-params (make-hash-table))
          (erc-server-parameters '(("CHANTYPES" . "&#")))
          (erc--target (erc--target-from-string "&chan")))
@@ -124,6 +129,7 @@ erc-services-tests--auth-source-announced
           (should (string= (funcall search :user "#chan") "foo")))))))
 
 (defun erc-services-tests--auth-source-overrides (search)
+  (setq search (erc-services-tests--wrap-search search))
   (let* ((erc-session-server "irc.gnu.org")
          (erc-server-announced-name "my.gnu.org")
          (erc-network 'GNU.chat)
@@ -540,18 +546,20 @@ erc-nickserv-get-password
            (erc-network 'FSF.chat)
            (erc-server-current-nick "tester")
            (erc-networks--id (erc-networks--id-create nil))
-           (erc-session-port 6697))
+           (erc-session-port 6697)
+           (search (erc-services-tests--wrap-search
+                    #'erc-nickserv-get-password)))
 
       (ert-info ("Lookup custom option")
-        (should (string= (erc-nickserv-get-password "alice") "foo")))
+        (should (string= (funcall search "alice") "foo")))
 
       (ert-info ("Auth source")
         (ert-info ("Network")
-          (should (string= (erc-nickserv-get-password "bob") "sesame")))
+          (should (string= (funcall search "bob") "sesame")))
 
         (ert-info ("Network ID")
           (let ((erc-networks--id (erc-networks--id-create 'GNU/chat)))
-            (should (string= (erc-nickserv-get-password "bob") "spam")))))
+            (should (string= (funcall search "bob") "spam")))))
 
       (ert-info ("Read input")
         (should (string=
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 3221af03ed..ff592e0fa1 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -530,6 +530,28 @@ erc-ring-previous-command
   (when noninteractive
     (kill-buffer "*#fake*")))
 
+(ert-deftest erc--debug-irc-protocol-mask-secrets ()
+  (should-not erc-debug-irc-protocol)
+  (should erc--debug-irc-protocol-mask-secrets)
+  (with-temp-buffer
+    (setq erc-server-process (start-process "fake" (current-buffer) "true")
+          erc-server-current-nick "tester"
+          erc-session-server "myproxy.localhost"
+          erc-session-port 6667)
+    (let ((inhibit-message noninteractive))
+      (erc-toggle-debug-irc-protocol)
+      (erc-log-irc-protocol
+       (concat "PASS :" (erc--unfun (lambda () "changeme")) "\r\n")
+       'outgoing)
+      (set-process-query-on-exit-flag erc-server-process nil))
+    (with-current-buffer "*erc-protocol*"
+      (goto-char (point-min))
+      (search-forward "\r\n\r\n")
+      (search-forward "myproxy.localhost:6667 >> PASS :????????" (pos-eol)))
+    (when noninteractive
+      (kill-buffer "*erc-protocol*")
+      (should-not erc-debug-irc-protocol))))
+
 (ert-deftest erc-log-irc-protocol ()
   (should-not erc-debug-irc-protocol)
   (with-temp-buffer
-- 
2.38.1