bug#59284: 29.0.50; Accept functions in place of passwords in ERC

bug#59284: 29.0.50; Accept functions in place of passwords in ERC

[J.P.]

[-- Attachment #1: Type: text/plain, Size: 3934 bytes --]

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))


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Accept-functions-in-place-of-passwords-in-ERC.patch --]
[-- Type: text/x-patch, Size: 11476 bytes --]

From e66da1c42f88376daa8385684a31830a4051e687 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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

bug#59284: 29.0.50; Accept functions in place of passwords in ERC

[J.P.]

[-- Attachment #1: Type: text/plain, Size: 507 bytes --]

This was recently added to emacs-29 as

  commit 5258f3616812da63526da7b1aadfe26fc384ef2a
  Author: F. Jason Park <jp@neverwas.me>
  Date:   Sun Nov 13 01:52:48 2022 -0800
  
      Accept functions in place of passwords in ERC
      
But I forgot to increment the logging-format version number. Here's a
patch that does that and also ignores incoming messages when checking
for redacted secrets, which is currently pointless. Anyone interested
please take a look (preferably in the next few days). Thanks.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Increment-erc-debug-irc-protocol-version-to-2.patch --]
[-- Type: text/x-patch, Size: 2067 bytes --]

From 2ed44d72eb7d613dc594b69d2fcd075357cb3916 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 14 Dec 2022 20:03:15 -0800
Subject: [PATCH] Increment erc-debug-irc-protocol-version to 2

* lisp/erc/erc.el (erc-debug-irc-protocol-version): Change version to
2 to help dependent tooling detect redacted passwords.
(erc-log-irc-protocol): Don't bother redacting incoming messages.
(Bug#59284.)
---
 lisp/erc/erc.el | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 5e78096da5..6afa400478 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2323,7 +2323,7 @@ erc-error
 (defvar erc-debug-irc-protocol-time-format "%FT%T.%6N%z "
   "Timestamp format string for protocol logger.")
 
-(defconst erc-debug-irc-protocol-version "1"
+(defconst erc-debug-irc-protocol-version "2"
   "Protocol log format version number.
 This exists to help tooling track changes to the format.
 
@@ -2334,7 +2334,10 @@ erc-debug-irc-protocol-version
 double CRLF, if present, signals the end of a log.  Session resumption
 is not supported.  Logger lines must adhere to the following format:
 TIMESTAMP PEER-NAME FLOW-INDICATOR IRC-MESSAGE CRLF.  Outgoing messages
-are indicated with a >> and incoming with a <<.")
+are indicated with a >> and incoming with a <<.
+
+In version 2, certain outgoing passwords are replaced by a string
+of ten question marks.")
 
 (defvar erc-debug-irc-protocol nil
   "If non-nil, log all IRC protocol traffic to the buffer \"*erc-protocol*\".
@@ -2390,7 +2393,7 @@ 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
+      (when (and outbound erc--debug-irc-protocol-mask-secrets)
         (setq string (erc--mask-secrets string)))
       (with-current-buffer (get-buffer-create "*erc-protocol*")
         (save-excursion
-- 
2.38.1