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.
This commit is contained in:
parent
ed8862c404
commit
5258f36168
7 changed files with 86 additions and 16 deletions
|
|
@ -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.")
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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=
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue