master 5258f36168 7/8: Accept functions in place of passwords in ERC

[Amin Bandali]

branch: master
commit 5258f3616812da63526da7b1aadfe26fc384ef2a
Author: F. Jason Park <jp@neverwas.me>
Commit: Amin Bandali <bandali@gnu.org>

    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-compat.el (erc-compat--29-auth-source-pass-search):
    Use obfuscation from auth-source function when available.
    * lisp/erc/erc-sasl.el (erc-sasl--read-password,
    erc-server-AUTHENTICATE): 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-compat.el              | 14 ++++++++++++--
 lisp/erc/erc-sasl.el                |  4 ++--
 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 +++++++++++++++++++++
 7 files changed, 86 insertions(+), 16 deletions(-)

diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 6e91353808..43c5faad63 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -205,7 +205,8 @@
 ;;;; 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-compat.el b/lisp/erc/erc-compat.el
index 4893f6ce59..66a9a615e3 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -252,8 +252,18 @@ If START or END is negative, it counts from the end."
   ;; From `auth-source-pass-search'
   (cl-assert (and host (not (eq host t)))
              t "Invalid password-store search: %s %s")
-  (erc-compat--29-auth-source-pass--build-result-many
-   host user port require max))
+  (let ((rv (erc-compat--29-auth-source-pass--build-result-many
+             host user port require max)))
+    (if (and (fboundp 'auth-source--obfuscate)
+             (fboundp 'auth-source--deobfuscate))
+        (let (out)
+          (dolist (e rv out)
+            (when-let* ((s (plist-get e :secret))
+                        (v (auth-source--obfuscate s)))
+              (setf (plist-get e :secret)
+                    (byte-compile (lambda () (auth-source--deobfuscate v)))))
+            (push e out)))
+      rv)))
 
 (defun erc-compat--29-auth-source-pass-backend-parse (entry)
   (when (eq entry 'password-store)
diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el
index ab171ea4d3..9084d873ce 100644
--- a/lisp/erc/erc-sasl.el
+++ b/lisp/erc/erc-sasl.el
@@ -143,7 +143,7 @@ PROMPT is passed to `read-passwd' if necessary."
                  (apply erc-sasl-auth-source-function
                         :user (erc-sasl--get-user)
                         (and host (list :host (symbol-name host))))))))
-      (copy-sequence found)
+      (copy-sequence (erc--unfun found))
     (read-passwd prompt)))
 
 (defun erc-sasl--plain-response (client steps)
@@ -353,7 +353,7 @@ This doesn't solicit or validate a suite of supported 
mechanisms."
       (when (string= data "")
         (setq data nil))
       (when data
-        (setq data (base64-encode-string data t)))
+        (setq data (erc--unfun (base64-encode-string data t))))
       (erc-server-send (concat "AUTHENTICATE " (or data "+"))))))
 
 (defun erc-sasl--destroy (proc)
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 @@ it returns nil."
                   (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 @@ Returns t if the message could be sent, nil otherwise."
          (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 63093d509b..268d83dc44 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2335,6 +2335,23 @@ but you won't see it.
 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 10 ??)
+                         (substring string end eot)))
+    (put-text-property beg (+ 10 beg) 'face 'erc-inverse-face string)
+    (put-text-property beg (+ 10 beg) 'display sec string))
+  string)
+
 (defun erc-log-irc-protocol (string &optional outbound)
   "Append STRING to the buffer *erc-protocol*.
 
@@ -2360,6 +2377,8 @@ workaround."
                       (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))
@@ -3285,9 +3304,8 @@ the one with host foo would win."
       (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."
@@ -3308,7 +3326,8 @@ Without SECRET, consult auth-source, possibly passing 
SERVER as the
     (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."
@@ -6344,6 +6363,15 @@ user input."
 
 ;; 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"
@@ -6353,7 +6381,7 @@ user input."
                    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 7ff2e36e77..2547c5e01a 100644
--- a/test/lisp/erc/erc-services-tests.el
+++ b/test/lisp/erc/erc-services-tests.el
@@ -62,9 +62,13 @@
                            :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 @@
       (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 @@
           (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)
@@ -537,18 +543,20 @@
            (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 b185d850a6..4d0d69cd7b 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -530,6 +530,28 @@
   (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