From: "J.P." <jp@neverwas.me>
To: 29108@debbugs.gnu.org
Cc: emacs-erc@gnu.org, bandali@gnu.org
Subject: bug#29108: 25.3; ERC SASL support
Date: Fri, 18 Nov 2022 06:06:48 -0800 [thread overview]
Message-ID: <87leo8z79j.fsf__10069.3227652059$1668780515$gmane$org@neverwas.me> (raw)
In-Reply-To: <878rk9576b.fsf@neverwas.me> (J. P.'s message of "Thu, 17 Nov 2022 18:26:52 -0800")
[-- Attachment #1: Type: text/plain, Size: 148 bytes --]
v10. Added `:user' and `:password' values for main options. Simplified
approach to persisting options generally. Reduced mention of local
modules.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v9-v10.diff --]
[-- Type: text/x-patch, Size: 39393 bytes --]
From a06e72aca3f14d903f5716f844067d3a224919cd Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 18 Nov 2022 00:11:15 -0800
Subject: [PATCH 0/6] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (6):
Add GS2 authorization to sasl-scram-rfc
Don't set erc-networks--id until network is known
Support local ERC modules in erc-mode buffers
Call erc-login indirectly via new generic wrapper
Add non-IRCv3 SASL module to ERC
Accept functions in place of passwords in ERC
doc/misc/erc.texi | 161 ++++++-
etc/ERC-NEWS | 15 +-
lisp/erc/erc-backend.el | 18 +-
lisp/erc/erc-common.el | 56 ++-
lisp/erc/erc-compat.el | 116 +++++
lisp/erc/erc-goodies.el | 1 +
lisp/erc/erc-networks.el | 39 +-
lisp/erc/erc-sasl.el | 429 ++++++++++++++++++
lisp/erc/erc-services.el | 5 +-
lisp/erc/erc.el | 125 +++--
lisp/net/sasl-scram-rfc.el | 21 +-
test/lisp/erc/erc-sasl-tests.el | 344 ++++++++++++++
test/lisp/erc/erc-scenarios-sasl.el | 202 +++++++++
test/lisp/erc/erc-services-tests.el | 16 +-
test/lisp/erc/erc-tests.el | 80 ++++
test/lisp/erc/resources/sasl/external.eld | 33 ++
test/lisp/erc/resources/sasl/plain-failed.eld | 16 +
test/lisp/erc/resources/sasl/plain.eld | 39 ++
test/lisp/erc/resources/sasl/scram-sha-1.eld | 47 ++
.../lisp/erc/resources/sasl/scram-sha-256.eld | 47 ++
20 files changed, 1712 insertions(+), 98 deletions(-)
create mode 100644 lisp/erc/erc-sasl.el
create mode 100644 test/lisp/erc/erc-sasl-tests.el
create mode 100644 test/lisp/erc/erc-scenarios-sasl.el
create mode 100644 test/lisp/erc/resources/sasl/external.eld
create mode 100644 test/lisp/erc/resources/sasl/plain-failed.eld
create mode 100644 test/lisp/erc/resources/sasl/plain.eld
create mode 100644 test/lisp/erc/resources/sasl/scram-sha-1.eld
create mode 100644 test/lisp/erc/resources/sasl/scram-sha-256.eld
Interdiff:
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index d248051871..790db1135e 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -611,6 +611,7 @@ Connecting
parameters, and some, like @code{client-certificate}, will just be
@code{nil}.
+@anchor{ERC client-certificate}
To use a certificate with @code{erc-tls}, specify the optional
@var{client-certificate} keyword argument, whose value should be as
described in the documentation of @code{open-network-stream}: if
@@ -745,7 +746,10 @@ Connecting
You can manually set another nickname with the /NICK command.
@end defopt
+@anchor{ERC username}
@subheading User
+@cindex user
+
@defun erc-compute-user &optional user
Determine a suitable value to send as the first argument of the
opening @samp{USER} IRC command by consulting the following sources:
@@ -937,21 +941,11 @@ SASL
@section Authenticating via SASL
@cindex SASL
-@strong{Warning:} ERC's SASL offering is currently limited by a lack
-of support for proper IRCv3 capability negotiation. In most cases,
-this shouldn't affect your ability to authenticate. If you run into
-trouble, please contact us (@pxref{Getting Help and Reporting Bugs}).
-
Regardless of the mechanism or the network, you'll likely have to be
registered before first use. Please refer to the network's own
instructions for details. If you're new to IRC and using a bouncer,
-know that you almost certainly won't be needing SASL for the
-@samp{client -> bouncer} connection.
-
-Note that @code{sasl} is a ``local'' ERC module, which various library
-functions, like @code{erc-update-modules}, may treat differently than
-global modules in user code. However, this should not affect everyday
-client use. To get started, just add @code{sasl} to
+know that you probably won't be needing SASL for the client-to-bouncer
+connection. To get started, just add @code{sasl} to
@code{erc-modules} like any other module. But before that, please
explore all custom options pertaining to your chosen mechanism.
@@ -962,35 +956,35 @@ SASL
@indentedblock
Here, ``password'' refers to your account password, which is usually
-your @samp{NickServ} password. This often differs from any connection
-(server) password given to @code{erc-tls} via its @code{:password}
-parameter. To make this work, customize both @code{erc-sasl-user} and
-@code{erc-sasl-password} or bind them when invoking @code{erc-tls}.
+your @samp{NickServ} password. To make this work, customize
+@code{erc-sasl-user} and @code{erc-sasl-password} or specify the
+@code{:user} and @code{:password} keyword arguments when invoking
+@code{erc-tls}. Note that @code{:user} cannot be given interactively.
@end indentedblock
@var{external} (via Client TLS Certificate):
@indentedblock
-You'll want to specify the @code{:client-certificate} param when
-opening a new connection, which is typically done by calling
-@code{emacs-tls}. But before that, ensure you've registered your
-fingerprint with the network. The fingerprint is usually a SHA1 or
-SHA256 digest in either "normalized" or "openssl" forms. The first is
-lowercase without delims (@samp{deadbeef}) and the second uppercase
-with colon seps (@samp{DE:AD:BE:EF}).
+This works in conjunction with the @code{:client-certificate} keyword
+offered by @code{erc-tls}. Just ensure you've registered your
+fingerprint with the network beforehand. The fingerprint is usually a
+SHA1 or SHA256 digest in either "normalized" or "openssl" forms. The
+first is lowercase without delims (@samp{deadbeef}) and the second
+uppercase with colon seps (@samp{DE:AD:BE:EF}). These days, there's
+usually a @samp{CERT ADD} command offered by NickServ that can
+register you automatically if you issue it while connected with a
+client cert. (@pxref{ERC client-certificate}).
Additional considerations:
@enumerate
@item
-There's no reason to send your password after registering.
-@item
Most IRCds will allow you to authenticate with a client cert but
without the hassle of SASL (meaning you may not need this module).
@item
Technically, @var{EXTERNAL} merely indicates that an out-of-band mode
of authentication is in effect (being deferred to), so depending on
-the specific application or service, there's an off chance client
-certs aren't involved.
+the specific application or service, there's a remote chance your
+server has something else in mind.
@end enumerate
@end indentedblock
@@ -1015,33 +1009,33 @@ SASL
@end defopt
@defopt erc-sasl-user
-This should be your network account name, typically the same one
-registered with nickname services. Specify this when your
-@samp{NickServ} account name differs from the nick you're connecting
-with.
+This should be your network account username, typically the same one
+registered with nickname services. Specify this when your NickServ
+login differs from the @code{:user} you're connecting with.
+(@pxref{ERC username})
@end defopt
@defopt erc-sasl-password
-For ``password-based'' mechanisms, ERC sends any nonempty string as
-the authentication password.
-
-If you instead give a non-@code{nil} symbol, like @samp{Libera.Chat},
-ERC will use it for the @code{:host} field in an auth-source query.
+As noted elsewhere, the @code{:password} parameter for @code{erc-tls}
+was orignally intended for traditional ``server passwords,'' but these
+aren't really used any more. As such, this option defaults to
+borrowing that parameter for its own uses, thus allowing you to call
+@code{erc-tls} with @code{:password} set to your NickServ password.
+
+You can also set this to a nonemtpy string, and ERC will send that
+when needed, no questions asked. If you instead give a non-@code{nil}
+symbol (other than @code{:password}), like @samp{Libera.Chat}, ERC
+will use it for the @code{:host} field in an auth-source query.
Actually, the same goes for when this option is @code{nil} but an
explicit session ID is already on file (@pxref{Network Identifier}).
-For all such queries, ERC specifies the value of @code{erc-sasl-user}
-for the @code{:user} (@code{:login}) param. Keep in mind that none of
-this matters unless @code{erc-sasl-auth-source-function} holds a
-function (it's @code{nil} by default).
-
-Otherwise, if you set this option to @code{nil} (or the empty string)
-or if an auth-source lookup has failed, ERC will try a non-@code{nil}
-``server password,'' likely whatever you gave as the @var{password}
-argument to @code{erc-tls}. This fallback behavior may change,
-however, so please don't rely on it. As a last resort, ERC will
-prompt you for input.
-
-Also, if your mechanism is @code{ecdsa-nist256p-challenge}, this
+For all such queries, ERC specifies the resolved value of
+@code{erc-sasl-user} for the @code{:user} (@code{:login}) param. Keep
+in mind that none of this matters unless
+@code{erc-sasl-auth-source-function} holds a function, and it's
+@code{nil} by default. As a last resort, ERC will prompt you for
+input.
+
+Lastly, if your mechanism is @code{ecdsa-nist256p-challenge}, this
option should instead hold the file name of your key.
@end defopt
@@ -1060,6 +1054,25 @@ SASL
leave this set to @code{nil}.
@end defopt
+@subheading Troubleshooting
+
+@strong{Warning:} ERC's SASL offering is currently limited by a lack
+of support for proper IRCv3 capability negotiation. In most cases,
+this shouldn't affect your ability to authenticate.
+
+If you're struggling, remember that your SASL password is almost
+always your NickServ password. When in doubt, try restoring all SASL
+options to their defaults and calling @code{erc-tls} with @code{:user}
+set to your NickServ account name and @code{:password} to your
+NickServ password. If you're still having trouble, please contact us
+(@pxref{Getting Help and Reporting Bugs}).
+
+And if, for whatever reason, you do find yourself trying out
+non-default SASL settings, keep in mind that every change requires a
+fresh session, so you'll want to call @code{erc-tls} from scratch
+again rather than rely on @samp{/reconnect} or the auto-reconnect
+facility. In fact, it's best to temporarily set
+@code{erc-server-auto-reconnect} to @code{nil} while experimenting.
@node Sample Configuration
@section Sample Configuration
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 37b9928cf8..829ef25a47 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -103,18 +103,13 @@ messages during periods of heavy traffic no longer disappear.
Although rare, server passwords containing white space are now handled
correctly.
-** Local modules and ERC-mode hooks are more useful.
-The 'local-p' parameter of 'define-erc-module' now affects more than
-the scope of a module's minor-mode. This currently has little direct
-impact on the user experience, but third-party packages may wish to
-take note.
-
-More importantly, the function 'erc-update-modules' now supports an
-optional argument to defer enabling of local modules and instead
-return their mode commands. 'erc-open' leverages this to delay their
-activation, as well as that of all 'erc-mode-hook' members, until most
-local session variables have been initialized (minus those "server"-
-and process-focused ones in erc-backend).
+** ERC-mode hooks are more useful.
+The function 'erc-update-modules' now supports an optional argument to
+defer enabling of local modules and instead return their mode
+commands. 'erc-open' relies on this to delay their activation, as
+well as that of all 'erc-mode-hook' members, until most local session
+variables have been initialized (minus those "server"- and
+process-focused ones in erc-backend).
** Miscellaneous behavioral changes in the library API.
A number of core macros and other definitions have been moved to a new
diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el
index d8ef600351..aabb6c8a51 100644
--- a/lisp/erc/erc-sasl.el
+++ b/lisp/erc/erc-sasl.el
@@ -30,7 +30,7 @@
;;
;; - Find a way to obfuscate the password in memory (via something
;; like `auth-source--obfuscate'); it's currently visible in
-;; backtraces and bug reports.
+;; backtraces.
;;
;; - Implement a proxy mechanism that chooses the strongest available
;; mechanism for you. Requires CAP 3.2 (see bug#49860).
@@ -65,39 +65,44 @@ erc-sasl-mechanism
(const scram-sha-512)
(const ecdsa-nist256p-challenge)))
-(defcustom erc-sasl-user nil
- "Optional account username to send when authenticating.
-This is also referred to as the authentication identity, or
-\"authcid\". When nil, applicable mechanisms will use the
-session's current nick."
- :type '(choice string (const nil)))
-
-(defcustom erc-sasl-password nil
+(defcustom erc-sasl-user :user
+ "Account username to send when authenticating.
+This is also referred to as the authentication identity or
+\"authcid\". A value of `:user' or `:nick' indicates that the
+corresponding connection parameter on file should be used. These
+are most often derived from arguments provided to the `erc' and
+`erc-tls' entry points. In the case of `:nick', a downcased
+version is used."
+ :type '(choice string (const :user) (const :nick)))
+
+(defcustom erc-sasl-password :password
"Optional account password to send when authenticating.
When the value is a string, ERC will use it unconditionally for
-most mechanisms. Otherwise, when `erc-sasl-auth-source-function'
-is a function, ERC will attempt an auth-source query, possibly
-using a non-nil symbol for the suggested `:host' parameter if set
-as this option's value or passed as an `:id' to `erc-tls'.
-Failing that, ERC will try a non-nil \"session password\" if one
-is on file, typically from a `:password' argument supplied to
-`erc-tls'. As a last resort, ERC will prompt for input.
-
-Note that when `erc-sasl-mechanism' is set to
-`ecdsa-nist256p-challenge', this option should hold the file name
-of the key."
- :type '(choice (const nil) string symbol))
+most mechanisms. Likewise with `:password', except ERC will
+instead use the \"session password\" on file, which often
+originates from the entry-point commands `erc' or `erc-tls'.
+Otherwise, when `erc-sasl-auth-source-function' is a function,
+ERC will attempt an auth-source query, possibly using a non-nil
+symbol for the suggested `:host' parameter if set as this
+option's value or passed as an `:id' to `erc-tls'. Failing that,
+ERC will prompt for input.
+
+Note that, with `:password', ERC will forgo sending a traditional
+server password via the IRC \"PASS\" command. Also, when
+`erc-sasl-mechanism' is set to `ecdsa-nist256p-challenge', this
+option should hold the file name of the key."
+ :type '(choice (const nil) (const :password) string symbol))
(defcustom erc-sasl-auth-source-function nil
"Function to query auth-source for an SASL password.
Called with keyword params known to `auth-source-search', which
-may include a non-nil `erc-sasl-user' for the `:user' field
-and a non-nil `erc-sasl-password' for the `:host' field, when
-the latter option is a symbol instead of a string. In return,
-ERC expects a string to send as the SASL password, or nil, to
-move on to the next approach, as described in the doc string for
-the option `erc-sasl-password'. See info node `(erc)
-Connecting' for details on ERC's auth-source integration."
+includes `erc-sasl-user' for the `:user' field and
+`erc-sasl-password' for the `:host' field, when the latter option
+is a non-nil, non-keyword symbol. In return, ERC expects a
+string to send as the SASL password, or nil, to move on to the
+next approach, as described in the doc string for the option
+`erc-sasl-password'. See info node `(erc) Connecting' for
+details on ERC's auth-source integration."
:type '(choice (function-item erc-auth-source-search)
(const nil)
function))
@@ -110,13 +115,6 @@ erc-sasl-authzid
;; Analogous to what erc-backend does to persist opening params.
(defvar-local erc-sasl--options nil)
-;; In the future, ERC will hopefully use connection-local variables to
-;; handle such bookkeeping transparently.
-(defvar erc-sasl--session-options nil
- "An alist associating network-IDs to `erc-sasl--options'.
-This is for persisting user options captured at entry-point
-invocation throughout an Emacs session.")
-
;; Session-local (server buffer) SASL subproto state
(defvar-local erc-sasl--state nil)
@@ -126,23 +124,27 @@ erc-sasl--state
(step nil :type vector)
(pending nil :type string))
+(defun erc-sasl--get-user ()
+ (pcase (alist-get 'user erc-sasl--options)
+ (:user erc-session-username)
+ (:nick (erc-downcase (erc-current-nick)))
+ (v v)))
+
(defun erc-sasl--read-password (prompt)
"Return configured option or server password.
PROMPT is passed to `read-passwd' if necessary."
- (let* ((pass (alist-get 'password erc-sasl--options))
- (found
- (or (and (stringp pass) (not (string-empty-p pass)) pass)
- (and erc-sasl-auth-source-function
- (let ((user (alist-get 'user erc-sasl--options))
- (host (or pass
- (erc-networks--id-given erc-networks--id))))
- (apply erc-sasl-auth-source-function
- `(,@(and user (list :user user))
- ,@(and host (list :host (symbol-name host)))))))
- erc-session-password)))
- (if found
- (copy-sequence (erc--unfun found))
- (read-passwd prompt))))
+ (if-let
+ ((found (pcase (alist-get 'password erc-sasl--options)
+ (:password erc-session-password)
+ ((and (pred stringp) v) (unless (string-empty-p v) v))
+ ((and (guard erc-sasl-auth-source-function)
+ v (let host
+ (or v (erc-networks--id-given erc-networks--id))))
+ (apply erc-sasl-auth-source-function
+ :user (erc-sasl--get-user)
+ (and host (list :host (symbol-name host))))))))
+ (copy-sequence (erc--unfun found))
+ (read-passwd prompt)))
(defun erc-sasl--plain-response (client steps)
(let ((sasl-read-passphrase #'erc-sasl--read-password))
@@ -228,22 +230,20 @@ erc-sasl--create-client
(when feature
(setf (alist-get name sasl-mechanism-alist nil nil #'equal) `(,feature))
(cl-pushnew name sasl-mechanisms :test #'equal)
- (setq client (sasl-make-client (sasl-find-mechanism `(,name))
- (or (alist-get 'user erc-sasl--options)
- (erc-downcase (erc-current-nick)))
+ (setq client (sasl-make-client (sasl-find-mechanism (list name))
+ (erc-sasl--get-user)
"N/A" "N/A"))
(sasl-client-set-property client 'authenticator-name
(alist-get 'authzid erc-sasl--options))
client)))
-(cl-defmethod erc-sasl--create-client ((_m (eql plain)))
+(cl-defmethod erc-sasl--create-client ((_ (eql plain)))
"Create and return a new PLAIN client object."
;; https://tools.ietf.org/html/rfc4616#section-2.
(let* ((sans (remq (assoc "PLAIN" sasl-mechanism-alist)
sasl-mechanism-alist))
(sasl-mechanism-alist (cons '("PLAIN" erc-sasl-plain) sans))
- (authc (or (alist-get 'user erc-sasl--options)
- (erc-downcase (erc-current-nick))))
+ (authc (erc-sasl--get-user))
(port (if (numberp erc-session-port)
(number-to-string erc-session-port)
"0"))
@@ -255,58 +255,51 @@ erc-sasl--create-client
(alist-get 'authzid erc-sasl--options))
client))
-(cl-defmethod erc-sasl--create-client ((m (eql scram-sha-256)))
+(cl-defmethod erc-sasl--create-client ((_ (eql scram-sha-256)))
"Create and return a new SCRAM-SHA-256 client."
- (unless (featurep 'sasl-scram-sha256)
- (user-error "SASL mechanism %s unsupported" m))
- (cl-call-next-method))
+ (when (featurep 'sasl-scram-sha256)
+ (cl-call-next-method)))
-(cl-defmethod erc-sasl--create-client ((m (eql scram-sha-512)))
+(cl-defmethod erc-sasl--create-client ((_ (eql scram-sha-512)))
"Create and return a new SCRAM-SHA-512 client."
- (unless (featurep 'sasl-scram-sha256)
- (user-error "SASL mechanism %s unsupported" m))
- (cl-call-next-method))
+ (when (featurep 'sasl-scram-sha256)
+ (cl-call-next-method)))
(cl-defmethod erc-sasl--create-client ((_ (eql ecdsa-nist256p-challenge)))
"Create and return a new ECDSA-NIST256P-CHALLENGE client."
- (unless (executable-find "openssl")
- (user-error "Could not find openssl command-line utility"))
(let ((keyfile (cdr (assq 'password erc-sasl--options))))
- (unless (and keyfile (file-exists-p keyfile))
- (user-error "`erc-sasl-password' does not point to ECDSA keyfile"))
- (let ((client (cl-call-next-method)))
- (sasl-client-set-property client 'ecdsa-keyfile keyfile)
- client)))
+ ;; Better to signal usage errors now than inside a process filter.
+ (cond ((or (not (stringp keyfile)) (not (file-readable-p keyfile)))
+ (erc-display-error-notice
+ nil "`erc-sasl-password' not accessible as a file")
+ nil)
+ ((not (executable-find "openssl"))
+ (erc-display-error-notice nil "Could not find openssl program")
+ nil)
+ (t
+ (let ((client (cl-call-next-method)))
+ (sasl-client-set-property client 'ecdsa-keyfile keyfile)
+ client)))))
;; This stands alone because it's also used by bug#49860.
(defun erc-sasl--init ()
- ;; When reconnecting, try to recover stashed parameters.
- (let ((existing (assoc erc-networks--id erc-sasl--session-options
- #'erc-networks--id-equal-p)))
- ;; This likely only runs when `erc' was called with an :id keyword.
- (when (and existing (not erc--server-reconnecting))
- (setq erc-sasl--session-options (delq existing erc-sasl--session-options)
- existing nil))
- (setq erc-sasl--state (make-erc-sasl--state)
- erc-sasl--options (or (cdr existing)
- `((user . ,erc-sasl-user)
- (password . ,erc-sasl-password)
- (mechanism . ,erc-sasl-mechanism)
- (authzid . ,erc-sasl-authzid))))))
-
-(defun erc-sasl--on-connection-established (&rest _)
- (setf (alist-get erc-networks--id erc-sasl--session-options nil nil
- #'erc-networks--id-equal-p)
- erc-sasl--options
- ;;
- erc-sasl--options nil))
+ (setq erc-sasl--state (make-erc-sasl--state))
+ ;; If the previous attempt failed during registration, this may be
+ ;; non-nil and contain erroneous values, but how can we detect that?
+ ;; What if the server dropped the connection for some other reason?
+ (setq erc-sasl--options
+ (or (and (consp erc--server-reconnecting)
+ (alist-get 'erc-sasl--options erc--server-reconnecting))
+ `((user . ,erc-sasl-user)
+ (password . ,erc-sasl-password)
+ (mechanism . ,erc-sasl-mechanism)
+ (authzid . ,erc-sasl-authzid)))))
(defun erc-sasl--mechanism-offered-p (offered)
"Return non-nil when OFFERED appears among a list of mechanisms."
(string-match-p (rx-to-string
`(: (| bot ",")
- ,(symbol-name
- (alist-get 'mechanism erc-sasl--options))
+ ,(symbol-name (alist-get 'mechanism erc-sasl--options))
(| eot ",")))
(downcase offered)))
@@ -347,7 +340,7 @@ erc-sasl--authenticate-handler
(s905 . "ERR SASLTOOLONG (credentials too long) %s")
(s906 . "ERR_SASLABORTED (authentication aborted) %s")
(s907 . "ERR_SASLALREADY (already authenticated) %s")
- (s908 . "RPL_SASLMECHS (unsupported mechanism %m) %s")))
+ (s908 . "RPL_SASLMECHS (unsupported mechanism: %m) %s")))
(define-erc-module sasl nil
"Non-IRCv3 SASL support for ERC.
@@ -362,12 +355,11 @@ sasl
(client (erc-sasl--create-client mech)))
(unless client
(erc-display-error-notice
- nil (format "Unknown SASL mechanism: %s" mech))
- (erc-error "Unknown SASL mechanism: %s" mech))
+ nil (format "Unknown or unsupported SASL mechanism: %s" mech))
+ (erc-error "Unknown or unsupported SASL mechanism: %s" mech))
(setf (erc-sasl--state-client erc-sasl--state) client))))
((remove-hook 'erc-server-AUTHENTICATE-functions
#'erc-sasl--authenticate-handler t)
- (setf (alist-get erc-networks--id erc-sasl--session-options nil t) nil)
(kill-local-variable 'erc-sasl--state)
(kill-local-variable 'erc-sasl--options))
'local)
@@ -393,7 +385,6 @@ erc-sasl--destroy
(when erc-sasl-mode
(unless erc-server-connected
(erc-server-send "CAP END")))
- (add-hook 'erc-after-connect #'erc-sasl--on-connection-established 0 t)
(erc-handle-unknown-server-response proc parsed))
(define-erc-response-handler (907)
@@ -411,8 +402,9 @@ erc-sasl--destroy
(define-erc-response-handler (908)
"Handle a RPL_SASLALREADY response." nil
(erc-display-message parsed '(notice error) 'active 's908
- '?m (alist-get 'mechanism erc-sasl--options)
- '?s (erc-response.contents parsed))
+ ?m (alist-get 'mechanism erc-sasl--options)
+ ?s (string-join (cdr (erc-response.command-args parsed))
+ " "))
(erc-sasl--destroy proc))
(cl-defmethod erc--register-connection (&context (erc-sasl-mode (eql t)))
@@ -421,7 +413,11 @@ erc--register-connection
(m (sasl-mechanism-name (sasl-client-mechanism c))))
(progn
(erc-server-send "CAP REQ :sasl")
- (erc-login)
+ (if (and erc-session-password
+ (eq :password (alist-get 'password erc-sasl--options)))
+ (let (erc-session-password)
+ (erc-login))
+ (erc-login))
(erc-server-send (format "AUTHENTICATE %s" m)))
(erc-sasl--destroy erc-server-process)))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ebec8846b1..60bfb909e0 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1951,7 +1951,7 @@ erc-open
(with-suppressed-warnings
((obsolete erc-reuse-buffers))
erc-reuse-buffers)
- erc-networks--id)))
+ (buffer-local-variables))))
(when connect (run-hook-with-args 'erc-before-connect server port nick))
(set-buffer buffer)
(setq old-point (point))
@@ -2021,7 +2021,8 @@ erc-open
(setq erc-session-client-certificate client-certificate)
(setq erc-networks--id
(if connect
- (or erc--server-reconnecting
+ (or (and erc--server-reconnecting
+ (alist-get 'erc-networks--id erc--server-reconnecting))
(and id (erc-networks--id-create id)))
(buffer-local-value 'erc-networks--id old-buffer)))
;; debug output buffer
diff --git a/test/lisp/erc/erc-sasl-tests.el b/test/lisp/erc/erc-sasl-tests.el
index 81db9ad948..20a6760083 100644
--- a/test/lisp/erc/erc-sasl-tests.el
+++ b/test/lisp/erc/erc-sasl-tests.el
@@ -32,61 +32,83 @@ erc-sasl--mechanism-offered-p
(should-not (erc-sasl--mechanism-offered-p "fooexternal"))
(should-not (erc-sasl--mechanism-offered-p "externalbar"))))
-(ert-deftest erc-sasl--read-password ()
+(ert-deftest erc-sasl--read-password--basic ()
(ert-info ("Explicit erc-sasl-password")
(let ((erc-sasl--options '((password . "foo"))))
(should (string= (erc-sasl--read-password nil) "foo"))))
- (ert-info ("Fallback to erc-session-password")
- (let ((erc-session-password "bar")
- (erc-networks--id (erc-networks--id-create nil)))
- (should (string= (erc-sasl--read-password nil) "bar")))
+ (ert-info ("Explicit session password")
+ (let ((erc-session-password "foo")
+ (erc-sasl--options '((password . :password))))
+ (should (string= (erc-sasl--read-password nil) "foo"))))
+
+ (ert-info ("Fallback to prompt skip auth-source")
+ (should-not erc-sasl-auth-source-function)
(let ((erc-session-password "bar")
- (erc-sasl--options '((user . "tester") (password)))
(erc-networks--id (erc-networks--id-create nil)))
- (should (string= (erc-sasl--read-password nil) "bar"))))
+ (should (string= (ert-simulate-keys "bar\r"
+ (erc-sasl--read-password "?"))
+ "bar"))))
- (let* ((entries (list
- "machine FSF.chat port 6697 user bob password sesame"
- ;; This must come *after* ^, else *1 (below) always passes
- "machine GNU/chat port 6697 user bob password spam"
- "machine MyHost port irc password 123"))
- (netrc-file (make-temp-file "auth-source-test" nil nil
- (mapconcat 'identity entries "\n")))
- (auth-sources (list netrc-file))
- (erc-session-server "irc.gnu.org")
- (erc-session-port 6697)
- (erc-networks--id (erc-networks--id-create nil))
- ;;
- (erc-sasl-auth-source-function #'erc--auth-source-search)
- erc-server-announced-name ; too early
- auth-source-do-cache)
+ (ert-info ("Prompt when auth-source fails and `erc-sasl-password' null")
+ (let ((erc-sasl--options '((password)))
+ (erc-sasl-auth-source-function #'ignore))
+ (should (string= (ert-simulate-keys "baz\r"
+ (erc-sasl--read-password "pwd:"))
+ "baz")))))
- (unwind-protect
- (ert-info ("Auth source")
+(ert-deftest erc-sasl--read-password--auth-source ()
+ (ert-with-temp-file netrc-file
+ :text (string-join
+ (list
+ ;; If you swap these first 2 lines, *1 below fails
+ "machine FSF.chat port 6697 user bob password sesame"
+ "machine GNU/chat port 6697 user bob password spam"
+ "machine MyHost port irc password 123")
+ "\n")
+ (let* ((auth-sources (list netrc-file))
+ (erc-session-server "irc.gnu.org")
+ (erc-session-port 6697)
+ (erc-networks--id (erc-networks--id-create nil))
+ calls
+ (erc-sasl-auth-source-function
+ (lambda (&rest r)
+ (push r calls)
+ (apply #'erc--auth-source-search r)))
+ erc-server-announced-name ; too early
+ auth-source-do-cache)
- (ert-info ("Symbol as password specifies machine")
- (let ((erc-sasl--options '((user . "bob")
- (password . FSF.chat)))
- (erc-networks--id (make-erc-networks--id)))
- (should (string= (erc-sasl--read-password nil) "sesame"))))
+ (ert-info ("Symbol as password specifies machine")
+ (let ((erc-sasl--options '((user . "bob") (password . FSF.chat)))
+ (erc-networks--id (make-erc-networks--id)))
+ (should (string= (erc-sasl--read-password nil) "sesame"))
+ (should (equal (pop calls) '(:user "bob" :host "FSF.chat")))))
- (ert-info ("Use session ID when password empty") ; *1
- (let ((erc-sasl--options '((user . "bob") (password)))
- (erc-networks--id (erc-networks--id-create 'GNU/chat)))
- (should (string= (erc-sasl--read-password nil) "spam")))))
+ (ert-info ("ID for :host and `erc-session-username' for :user") ; *1
+ (let ((erc-session-username "bob")
+ (erc-sasl--options '((user . :user) (password)))
+ (erc-networks--id (erc-networks--id-create 'GNU/chat)))
+ (should (string= (erc-sasl--read-password nil) "spam"))
+ (should (equal (pop calls) '(:user "bob" :host "GNU/chat")))))
- (delete-file netrc-file))
+ (ert-info ("ID for :host and current nick for :user") ; *1
+ (let ((erc-server-current-nick "bob")
+ (erc-sasl--options '((user . :nick) (password)))
+ (erc-networks--id (erc-networks--id-create 'GNU/chat)))
+ (should (string= (erc-sasl--read-password nil) "spam"))
+ (should (equal (pop calls) '(:user "bob" :host "GNU/chat")))))
- (ert-info ("Prompt when search fails and server password null")
- (let ((erc-sasl-auth-source-function #'ignore))
- (should (string= (ert-simulate-keys "baz\r"
- (erc-sasl--read-password "pwd:"))
- "baz"))))))
+ (ert-info ("Symbol as password, entry lacks user field")
+ (let ((erc-server-current-nick "fake")
+ (erc-sasl--options '((user . :nick) (password . MyHost)))
+ (erc-networks--id (erc-networks--id-create 'GNU/chat)))
+ (should (string= (erc-sasl--read-password nil) "123"))
+ (should (equal (pop calls) '(:user "fake" :host "MyHost"))))))))
(ert-deftest erc-sasl-create-client--plain ()
(let* ((erc-session-password "password123")
- (erc-server-current-nick "tester")
+ (erc-session-username "tester")
+ (erc-sasl--options '((user . :user) (password . :password)))
(erc-session-port 1667)
(erc-session-server "localhost")
(client (erc-sasl--create-client 'plain))
@@ -100,7 +122,8 @@ erc-sasl-create-client--plain
(ert-deftest erc-sasl-create-client--external ()
(let* ((erc-server-current-nick "tester")
- (client (erc-sasl--create-client 'external))
+ (erc-sasl--options '((user . :nick) (password . :password)))
+ (client (erc-sasl--create-client 'external)) ; unused ^
(result (sasl-next-step client nil)))
(should (equal (format "%S" [ignore nil]) (format "%S" result)))
(should-not (sasl-step-data result))
@@ -109,9 +132,8 @@ erc-sasl-create-client--external
(should-not (assoc-default "EXTERNAL" sasl-mechanism-alist)))
(ert-deftest erc-sasl-create-client--scram-sha-1 ()
- (let* ((erc-server-current-nick "jilles")
- (erc-session-password "sesame")
- (erc-sasl--options '((authzid . "jilles")))
+ (let* ((erc-sasl--options '((user . "jilles") (password . "sesame")
+ (authzid . "jilles")))
(mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" ""))
(sasl-unique-id-function (lambda () (pop mock-rvs)))
(client (erc-sasl--create-client 'scram-sha-1))
@@ -149,7 +171,8 @@ erc-sasl-create-client--scram-sha-256
(ert-skip "Emacs lacks sasl-scram-sha256"))
(let* ((erc-server-current-nick "jilles")
(erc-session-password "sesame")
- (erc-sasl--options '((authzid . "jilles")))
+ (erc-sasl--options '((user . :nick) (password . :password)
+ (authzid . "jilles")))
(mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" ""))
(sasl-unique-id-function (lambda () (pop mock-rvs)))
(client (erc-sasl--create-client 'scram-sha-256))
@@ -189,6 +212,7 @@ erc-sasl-create-client--scram-sha-256--no-authzid
(ert-skip "Emacs lacks sasl-scram-sha256"))
(let* ((erc-server-current-nick "jilles")
(erc-session-password "sesame")
+ (erc-sasl--options '((user . :nick) (password . :password) (authzid)))
(mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" ""))
(sasl-unique-id-function (lambda () (pop mock-rvs)))
(client (erc-sasl--create-client 'scram-sha-256))
@@ -228,6 +252,7 @@ erc-sasl-create-client--scram-sha-512--no-authzid
(ert-skip "Emacs lacks sasl-scram-sha512"))
(let* ((erc-server-current-nick "jilles")
(erc-session-password "sesame")
+ (erc-sasl--options '((user . :nick) (password . :password) (authzid)))
(mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" ""))
(sasl-unique-id-function (lambda () (pop mock-rvs)))
(client (erc-sasl--create-client 'scram-sha-512))
diff --git a/test/lisp/erc/erc-scenarios-sasl.el b/test/lisp/erc/erc-scenarios-sasl.el
index 7970e65ec2..713c9929c3 100644
--- a/test/lisp/erc/erc-scenarios-sasl.el
+++ b/test/lisp/erc/erc-scenarios-sasl.el
@@ -39,9 +39,7 @@ erc-scenarios-sasl--plain
(dumb-server (erc-d-run "localhost" t 'plain))
(port (process-contact dumb-server :service))
(erc-modules (cons 'sasl erc-modules))
- (erc-sasl-mechanism 'plain)
(erc-sasl-password "password123")
- (erc-sasl--session-options nil)
(inhibit-message noninteractive)
(expect (erc-d-t-make-expecter)))
@@ -71,7 +69,6 @@ erc-scenarios-sasl--local-modules-reconnect
(erc-server-flood-penalty 0.1)
(dumb-server (erc-d-run "localhost" t 'plain 'plain))
(port (process-contact dumb-server :service))
- (erc-sasl--session-options nil)
(inhibit-message noninteractive)
(expect (erc-d-t-make-expecter)))
@@ -94,7 +91,6 @@ erc-scenarios-sasl--local-modules-reconnect
(erc-cmd-QUIT "")
(funcall expect 10 "finished"))
- (should-not erc-sasl-password) ; obviously
(should-not (memq 'sasl erc-modules))
(erc-d-t-wait-for 10 (not (erc-server-process-alive)))
@@ -114,7 +110,6 @@ erc-scenarios-sasl--external
(port (process-contact dumb-server :service))
(erc-modules (cons 'sasl erc-modules))
(erc-sasl-mechanism 'external)
- (erc-sasl--session-options nil)
(inhibit-message noninteractive)
(expect (erc-d-t-make-expecter)))
@@ -144,7 +139,6 @@ erc-scenarios-sasl--plain-fail
(erc-modules (cons 'sasl erc-modules))
(erc-sasl-password "wrong")
(erc-sasl-mechanism 'plain)
- (erc-sasl--session-options nil)
(inhibit-message noninteractive)
(expect (erc-d-t-make-expecter))
(buf nil))
@@ -172,9 +166,8 @@ erc-scenarios--common--sasl
(dumb-server (erc-d-run "localhost" t mech))
(port (process-contact dumb-server :service))
(erc-modules (cons 'sasl erc-modules))
- (erc-sasl-password "sesame")
+ (erc-sasl-user :nick)
(erc-sasl-mechanism mech)
- (erc-sasl--session-options nil)
(mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" ""))
(sasl-unique-id-function (lambda () (pop mock-rvs)))
(inhibit-message noninteractive)
@@ -184,6 +177,7 @@ erc-scenarios--common--sasl
(with-current-buffer (erc :server "127.0.0.1"
:port port
:nick "jilles"
+ :password "sesame"
:full-name "jilles")
(should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
--
2.38.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Add-GS2-authorization-to-sasl-scram-rfc.patch --]
[-- Type: text/x-patch, Size: 3030 bytes --]
From 2bdd6d498e74ec508846d464a2b69d09965e7695 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 19 Sep 2022 21:28:52 -0700
Subject: [PATCH 1/6] Add GS2 authorization to sasl-scram-rfc
* lisp/net/sasl-scram-rfc.el (sasl-scram-gs2-header-function,
sasl-scram-construct-gs2-header): Add new variable and default
function for determining a SCRAM GSS-API message header. This is
mainly intended for other libraries rather than end users.
(sasl-scram-client-first-message): Use gs2-header function.
(sasl-scram--client-final-message): Use dedicated gs2-header function.
Also remove whitespace when base64-encoding, as per RFC 5802.
(Bug#57956.)
---
lisp/net/sasl-scram-rfc.el | 21 ++++++++++++++-------
1 file changed, 14 insertions(+), 7 deletions(-)
diff --git a/lisp/net/sasl-scram-rfc.el b/lisp/net/sasl-scram-rfc.el
index ee52ed6e07..f7a2e42541 100644
--- a/lisp/net/sasl-scram-rfc.el
+++ b/lisp/net/sasl-scram-rfc.el
@@ -45,14 +45,21 @@
;;; Generic for SCRAM-*
+(defvar sasl-scram-gs2-header-function 'sasl-scram-construct-gs2-header
+ "Function to create GS2 header.
+See https://www.rfc-editor.org/rfc/rfc5801#section-4.")
+
+(defun sasl-scram-construct-gs2-header (client)
+ ;; The "n," means the client doesn't support channel binding, and
+ ;; the trailing comma is included as per RFC 5801.
+ (let ((authzid (sasl-client-property client 'authenticator-name)))
+ (concat "n," (and authzid "a=") authzid ",")))
+
(defun sasl-scram-client-first-message (client _step)
(let ((c-nonce (sasl-unique-id)))
(sasl-client-set-property client 'c-nonce c-nonce))
(concat
- ;; n = client doesn't support channel binding
- "n,"
- ;; TODO: where would we get authorization id from?
- ","
+ (funcall sasl-scram-gs2-header-function client)
(sasl-scram--client-first-message-bare client)))
(defun sasl-scram--client-first-message-bare (client)
@@ -77,11 +84,11 @@ sasl-scram--client-final-message
(c-nonce (sasl-client-property client 'c-nonce))
;; no channel binding, no authorization id
- (cbind-input "n,,"))
+ (cbind-input (funcall sasl-scram-gs2-header-function client)))
(unless (string-prefix-p c-nonce nonce)
(sasl-error "Invalid nonce from server"))
(let* ((client-final-message-without-proof
- (concat "c=" (base64-encode-string cbind-input) ","
+ (concat "c=" (base64-encode-string cbind-input t) ","
"r=" nonce))
(password
;; TODO: either apply saslprep or disallow non-ASCII characters
@@ -113,7 +120,7 @@ sasl-scram--client-final-message
(client-proof (funcall string-xor client-key client-signature))
(client-final-message
(concat client-final-message-without-proof ","
- "p=" (base64-encode-string client-proof))))
+ "p=" (base64-encode-string client-proof t))))
(sasl-client-set-property client 'auth-message auth-message)
(sasl-client-set-property client 'salted-password salted-password)
client-final-message)))
--
2.38.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-Don-t-set-erc-networks-id-until-network-is-known.patch --]
[-- Type: text/x-patch, Size: 7501 bytes --]
From 7cc800af5c610374ee381c30647e6af38bbe0a32 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 2/6] Don't set erc-networks--id until network is known
* lisp/erc/erc-networks.el (erc-networks--id-given): Accept a null
argument.
(erc-networks--id-on-connect): Remove unused function.
(erc-networks--id-equal-p): Add method for comparing initialized and
unset IDs.
(erc-networks--update-server-identity): Ensure `erc-networks--id' is
set before continuing search.
(erc-networks--init-identity): Don't assume `erc-networks--id' is
non-nil.
* lisp/erc/erc.el (erc-open): For continued sessions, try copying over
the last network ID.
(erc--auth-source-determine-params-default): Don't expect a network ID
to have been initialized.
* lisp/erc/erc-backend.el (erc-server-NICK, erc-server-433): Unless
already connected, clear network ID when server rejects or mandates a
nick change.
---
lisp/erc/erc-backend.el | 7 ++++++-
lisp/erc/erc-networks.el | 39 ++++++++++++++++-----------------------
lisp/erc/erc.el | 13 ++++++++-----
3 files changed, 30 insertions(+), 29 deletions(-)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 15fd6ac50f..ebfb4bb830 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1619,7 +1619,7 @@ define-erc-response-handler
(cl-pushnew (erc-server-buffer) bufs)
(erc-set-current-nick nn)
;; Rename session, possibly rename server buf and all targets
- (when (erc-network)
+ (when erc-server-connected
(erc-networks--id-reload erc-networks--id proc parsed))
(erc-update-mode-line)
(setq erc-nick-change-attempt-count 0)
@@ -1629,6 +1629,9 @@ define-erc-response-handler
'NICK-you ?n nick ?N nn)
(run-hook-with-args 'erc-nick-changed-functions nn nick))
(t
+ (unless (or erc-server-connected
+ (erc-networks--id-given erc-networks--id))
+ (setq erc-networks--id nil))
(erc-handle-user-status-change 'nick (list nick login host) (list nn))
(erc-display-message parsed 'notice bufs 'NICK ?n nick
?u login ?h host ?N nn))))))
@@ -2255,6 +2258,8 @@ erc-server-322-message
(define-erc-response-handler (433)
"Login-time \"nick in use\"." nil
+ (unless (or erc-server-connected (erc-networks--id-given erc-networks--id))
+ (setq erc-networks--id nil))
(erc-nickname-in-use (cadr (erc-response.command-args parsed))
"already in use"))
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index b3e5fcf1a3..100d5b4b58 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -826,12 +826,11 @@ erc-networks--id
;; For now, please use this instead of `erc-networks--id-fixed-p'.
(cl-defgeneric erc-networks--id-given (net-id)
- "Return the preassigned identifier for a network presence, if any.
-This may have originated from an `:id' arg to entry-point commands
-`erc-tls' or `erc'.")
+ "Return the preassigned identifier for a network context, if any.
+When non-nil, assume NET-ID originated from an `:id' argument to
+entry-point commands `erc-tls' or `erc'.")
-(cl-defmethod erc-networks--id-given ((_ erc-networks--id))
- nil)
+(cl-defmethod erc-networks--id-given (_) nil) ; _ may be nil
(cl-defmethod erc-networks--id-given ((nid erc-networks--id-fixed))
(erc-networks--id-symbol nid))
@@ -866,22 +865,15 @@ erc-networks--id-create
((_ symbol) &context (erc-obsolete-var erc-reuse-buffers null))
(erc-networks--id-fixed-create (intern (buffer-name))))
-(cl-defgeneric erc-networks--id-on-connect (net-id)
- "Update NET-ID `erc-networks--id' after connection params known.
-This is typically during or just after MOTD.")
-
-(cl-defmethod erc-networks--id-on-connect ((_ erc-networks--id))
- nil)
-
-(cl-defmethod erc-networks--id-on-connect ((id erc-networks--id-qualifying))
- (erc-networks--id-qualifying-update id (erc-networks--id-qualifying-create)))
-
(cl-defgeneric erc-networks--id-equal-p (self other)
- "Return non-nil when two network identities exhibit underlying equality.
-SELF and OTHER are `erc-networks--id' struct instances. This
-should normally be used only for ID recovery or merging, after
-which no two identities should be `equal' (timestamps aside) that
-aren't also `eq'.")
+ "Return non-nil when two network IDs exhibit underlying equality.
+Expect SELF and OTHER to be `erc-networks--id' struct instances
+and that this will only be called for ID recovery or merging,
+after which no two identities should be `equal' (timestamps
+aside) that aren't also `eq'.")
+
+(cl-defmethod erc-networks--id-equal-p ((_ null) (_ erc-networks--id)) nil)
+(cl-defmethod erc-networks--id-equal-p ((_ erc-networks--id) (_ null)) nil)
(cl-defmethod erc-networks--id-equal-p ((self erc-networks--id)
(other erc-networks--id))
@@ -1382,7 +1374,8 @@ erc-networks--update-server-identity
(let* ((identity erc-networks--id)
(buffer (current-buffer))
(f (lambda ()
- (unless (or (eq (current-buffer) buffer)
+ (unless (or (not erc-networks--id)
+ (eq (current-buffer) buffer)
(eq erc-networks--id identity))
(if (erc-networks--id-equal-p identity erc-networks--id)
(throw 'buffer erc-networks--id)
@@ -1401,8 +1394,8 @@ erc-networks--init-identity
"Update identity with real network name."
;; Initialize identity for real now that we know the network
(cl-assert erc-network)
- (unless (erc-networks--id-symbol erc-networks--id) ; unless just reconnected
- (erc-networks--id-on-connect erc-networks--id))
+ (unless erc-networks--id
+ (setq erc-networks--id (erc-networks--id-create nil)))
;; Find duplicate identities or other conflicting ones and act
;; accordingly.
(erc-networks--update-server-identity)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 2312246e3e..95212182b5 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2017,10 +2017,12 @@ erc-open
(setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick)))
;; client certificate (only useful if connecting over TLS)
(setq erc-session-client-certificate client-certificate)
- (setq erc-networks--id (if connect
- (erc-networks--id-create id)
- (buffer-local-value 'erc-networks--id
- old-buffer)))
+ (setq erc-networks--id
+ (if connect
+ (or (and continued-session
+ (buffer-local-value 'erc-networks--id old-buffer))
+ (and id (erc-networks--id-create id)))
+ (buffer-local-value 'erc-networks--id old-buffer)))
;; debug output buffer
(setq erc-dbuf
(when erc-log-p
@@ -3179,7 +3181,8 @@ erc-auth-source-join-function
function))
(defun erc--auth-source-determine-params-defaults ()
- (let* ((net (and-let* ((esid (erc-networks--id-symbol erc-networks--id))
+ (let* ((net (and-let* ((erc-networks--id)
+ (esid (erc-networks--id-symbol erc-networks--id))
((symbol-name esid)))))
(localp (and erc--target (erc--target-channel-local-p erc--target)))
(hosts (if localp
--
2.38.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-Support-local-ERC-modules-in-erc-mode-buffers.patch --]
[-- Type: text/x-patch, Size: 17223 bytes --]
From fea3ac6fcc199578ccf7c63f2a6b5685473a7c1e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 12 Jul 2021 03:44:28 -0700
Subject: [PATCH 3/6] Support local ERC modules in erc-mode buffers
* doc/misc/erc.texi: Mention local modules in Modules chapter.
* lisp/erc/erc-compat.el (erc-compat--local-module-modes): Add helper
for finding local modules already active as minor modes in an ERC
buffer.
* lisp/erc/erc.el (erc-migrate-modules): Add some missing mappings.
(erc-update-modules): Add optional param that changes return value
from nil to a list of minor-mode commands for local modules. Use
`custom-variable-p' to detect flavor. Currently, all modules are
global and so are their accompanying minor modes.
(erc-open): Defer enabling of local modules via `erc-update-modules'
until after buffer is initialized with other local vars. Also defer
major-mode hooks so they can detect things like whether the buffer is
a server or target buffer. Also ensure local module setup code can
detect when `erc-open' was called with a non-nil
`erc--server-reconnecting'. It's reset to nil by
`erc-server-connect'.
* lisp/erc/erc-common.el (erc--module-name-migrations,
erc--features-to-modules, erc--modules-to-features): Add alists of
old-to-new module names to support module-name migrations.
(define-erc-modules): Don't toggle local modules (minor modes) unless
`erc-mode' is the major mode. Also, don't mutate `erc-modules' when
dealing with a local module.
(erc--normalize-module-symbol): Add helper for `erc-migrate-modules'.
* lisp/erc/erc-goodies.el: Require cl-lib.
* test/lisp/erc/erc-tests.el (erc-migrate-modules,
erc-update-modules): Add rudimentary unit tests asserting correct
module-name mappings. (Bug#57955.)
---
doc/misc/erc.texi | 11 +++++-
etc/ERC-NEWS | 8 ++++
lisp/erc/erc-common.el | 56 +++++++++++++++++++++++----
lisp/erc/erc-compat.el | 12 ++++++
lisp/erc/erc-goodies.el | 1 +
lisp/erc/erc.el | 77 ++++++++++++++++++++------------------
test/lisp/erc/erc-tests.el | 58 ++++++++++++++++++++++++++++
7 files changed, 178 insertions(+), 45 deletions(-)
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index 0d807e323e..dd15036b2e 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -390,8 +390,15 @@ Modules
There is a spiffy customize interface, which may be reached by typing
@kbd{M-x customize-option @key{RET} erc-modules @key{RET}}.
-Alternatively, set @code{erc-modules} manually and then call
-@code{erc-update-modules}.
+Alternatively, set @code{erc-modules} manually, and ERC will load them
+and run their setup code during buffer initialization. Third-party
+code may need to call the function @code{erc-update-modules}
+explicitly, although this is typically unnecessary.
+
+All modules operate as minor modes under the hood, and some newer ones
+are defined as buffer-local. For everyday use, the only practical
+difference is that local modules can only be enabled in ERC buffers,
+and their toggle commands never mutate @code{erc-modules}.
The following is a list of available modules.
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index f638d4717a..4c4b154dca 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -104,6 +104,14 @@ messages during periods of heavy traffic no longer disappear.
Although rare, server passwords containing white space are now handled
correctly.
+** ERC-mode hooks are more useful.
+The function 'erc-update-modules' now supports an optional argument to
+defer enabling of local modules and instead return their mode
+commands. 'erc-open' relies on this to delay their activation, as
+well as that of all 'erc-mode-hook' members, until most local session
+variables have been initialized (minus those "server"- and
+process-focused ones in erc-backend).
+
** Miscellaneous behavioral changes in the library API.
A number of core macros and other definitions have been moved to a new
file called erc-common.el. This was done to further lessen the
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 23a1933798..b791866ee2 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -88,6 +88,41 @@ erc--target
(contents "" :type string)
(tags '() :type list))
+;; TODO move goodies modules here after 29 is released.
+(defconst erc--features-to-modules
+ '((erc-pcomplete completion pcomplete)
+ (erc-capab capab-identify)
+ (erc-join autojoin)
+ (erc-page page ctcp-page)
+ (erc-sound sound ctcp-sound)
+ (erc-stamp stamp timestamp)
+ (erc-services services nickserv))
+ "Migration alist mapping a library feature to module names.
+Keys need not be unique: a library may define more than one
+module. Sometimes a module's downcased alias will be its
+canonical name.")
+
+(defconst erc--modules-to-features
+ (let (pairs)
+ (pcase-dolist (`(,feature . ,names) erc--features-to-modules)
+ (dolist (name names)
+ (push (cons name feature) pairs)))
+ (nreverse pairs))
+ "Migration alist mapping a module's name to its home library feature.")
+
+(defconst erc--module-name-migrations
+ (let (pairs)
+ (pcase-dolist (`(,_ ,canonical . ,rest) erc--features-to-modules)
+ (dolist (obsolete rest)
+ (push (cons obsolete canonical) pairs)))
+ pairs)
+ "Association list of obsolete module names to canonical names.")
+
+(defun erc--normalize-module-symbol (symbol)
+ "Return preferred SYMBOL for `erc-modules'."
+ (setq symbol (intern (downcase (symbol-name symbol))))
+ (or (cdr (assq symbol erc--module-name-migrations)) symbol))
+
(defmacro define-erc-module (name alias doc enable-body disable-body
&optional local-p)
"Define a new minor mode using ERC conventions.
@@ -101,7 +136,9 @@ define-erc-module
This will define a minor mode called erc-NAME-mode, possibly
an alias erc-ALIAS-mode, as well as the helper functions
-erc-NAME-enable, and erc-NAME-disable.
+erc-NAME-enable, and erc-NAME-disable. Beware that for global
+modules, these helpers, as well as the minor-mode toggle, all mutate
+the user option `erc-modules'.
Example:
@@ -114,6 +151,7 @@ define-erc-module
#\\='erc-replace-insert)))"
(declare (doc-string 3) (indent defun))
(let* ((sn (symbol-name name))
+ (mod (erc--normalize-module-symbol name))
(mode (intern (format "erc-%s-mode" (downcase sn))))
(group (intern (format "erc-%s" (downcase sn))))
(enable (intern (format "erc-%s-enable" (downcase sn))))
@@ -137,16 +175,20 @@ define-erc-module
,(format "Enable ERC %S mode."
name)
(interactive)
- (add-to-list 'erc-modules (quote ,name))
- (setq ,mode t)
- ,@enable-body)
+ ,@(unless local-p `((cl-pushnew ',mod erc-modules)))
+ ,@(if local-p
+ `((when (setq ,mode (and (derived-mode-p 'erc-mode) t))
+ ,@enable-body))
+ `((setq ,mode t) ,@enable-body)))
(defun ,disable ()
,(format "Disable ERC %S mode."
name)
(interactive)
- (setq erc-modules (delq (quote ,name) erc-modules))
- (setq ,mode nil)
- ,@disable-body)
+ ,@(unless local-p `((setq erc-modules (delq ',mod erc-modules))))
+ ,@(macroexp-unprogn
+ `(,@(if local-p '(when (derived-mode-p 'erc-mode)) '(progn))
+ (setq ,mode nil)
+ ,@disable-body)))
,(when (and alias (not (eq name alias)))
`(defalias
',(intern
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index d23703394b..f7e6fb7aee 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -313,6 +313,18 @@ erc-compat--29-browse-url-irc
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
+(defun erc-compat--local-module-modes ()
+ (delq nil
+ (if (boundp 'local-minor-modes)
+ (mapcar (lambda (m)
+ (and (string-prefix-p "erc-" (symbol-name m)) m))
+ local-minor-modes)
+ (mapcar (pcase-lambda (`(,k . _))
+ (and (string-prefix-p "erc-" (symbol-name k))
+ (string-suffix-p "-mode" (symbol-name k))
+ k))
+ (buffer-local-variables)))))
+
(provide 'erc-compat)
;;; erc-compat.el ends here
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 59b5f01f23..1af83b58ba 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -31,6 +31,7 @@
;;; Imenu support
+(eval-when-compile (require 'cl-lib))
(require 'erc-common)
(defvar erc-controls-highlight-regexp)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 95212182b5..ef70aa1a21 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1791,10 +1791,7 @@ erc-migrate-modules
"Migrate old names of ERC modules to new ones."
;; modify `transforms' to specify what needs to be changed
;; each item is in the format '(old . new)
- (let ((transforms '((pcomplete . completion))))
- (delete-dups
- (mapcar (lambda (m) (or (cdr (assoc m transforms)) m))
- mods))))
+ (delete-dups (mapcar #'erc--normalize-module-symbol mods)))
(defcustom erc-modules '(netsplit fill button match track completion readonly
networks ring autojoin noncommands irccontrols
@@ -1872,28 +1869,23 @@ erc-modules
(repeat :tag "Others" :inline t symbol))
:group 'erc)
-(defun erc-update-modules ()
- "Run this to enable erc-foo-mode for all modules in `erc-modules'."
- (let (req)
- (dolist (mod erc-modules)
- (setq req (concat "erc-" (symbol-name mod)))
- (cond
- ;; yuck. perhaps we should bring the filenames into sync?
- ((string= req "erc-capab-identify")
- (setq req "erc-capab"))
- ((string= req "erc-completion")
- (setq req "erc-pcomplete"))
- ((string= req "erc-pcomplete")
- (setq mod 'completion))
- ((string= req "erc-autojoin")
- (setq req "erc-join")))
- (condition-case nil
- (require (intern req))
- (error nil))
- (let ((sym (intern-soft (concat "erc-" (symbol-name mod) "-mode"))))
- (if (fboundp sym)
- (funcall sym 1)
- (error "`%s' is not a known ERC module" mod))))))
+(defun erc-update-modules (&optional defer-locals)
+ "Enable global minor mode for all global modules in `erc-modules'.
+With DEFER-LOCALS, return minor-mode commands for all local
+modules, possibly for deferred invocation, as done by `erc-open'
+whenever a new ERC buffer is created. Local modules were
+introduced in ERC 5.5."
+ (let (local-modes)
+ (dolist (module erc-modules (and defer-locals local-modes))
+ (require (or (alist-get module erc--modules-to-features)
+ (intern (concat "erc-" (symbol-name module))))
+ nil 'noerror) ; some modules don't have a corresponding feature
+ (let ((mode (intern-soft (concat "erc-" (symbol-name module) "-mode"))))
+ (unless (and mode (fboundp mode))
+ (error "`%s' is not a known ERC module" module))
+ (if (and defer-locals (not (custom-variable-p mode)))
+ (push mode local-modes)
+ (funcall mode 1))))))
(defun erc-setup-buffer (buffer)
"Consults `erc-join-buffer' to find out how to display `BUFFER'."
@@ -1951,18 +1943,27 @@ erc-open
(let* ((target (and channel (erc--target-from-string channel)))
(buffer (erc-get-buffer-create server port nil target id))
(old-buffer (current-buffer))
- old-point
+ (old-recon-count erc-server-reconnect-count)
+ (old-point nil)
+ (delayed-modules nil)
(continued-session (and erc--server-reconnecting
(with-suppressed-warnings
((obsolete erc-reuse-buffers))
- erc-reuse-buffers))))
+ erc-reuse-buffers)
+ (buffer-local-variables))))
(when connect (run-hook-with-args 'erc-before-connect server port nick))
- (erc-update-modules)
(set-buffer buffer)
(setq old-point (point))
- (let ((old-recon-count erc-server-reconnect-count))
- (erc-mode)
- (setq erc-server-reconnect-count old-recon-count))
+ (setq delayed-modules
+ (delete-dups (append (when continued-session
+ (erc-compat--local-module-modes))
+ (erc-update-modules 'defer-locals))))
+
+ (delay-mode-hooks (erc-mode))
+
+ (setq erc-server-reconnect-count old-recon-count
+ erc--server-reconnecting continued-session)
+
(when (setq erc-server-connected (not connect))
(setq erc-server-announced-name
(buffer-local-value 'erc-server-announced-name old-buffer)))
@@ -2019,14 +2020,20 @@ erc-open
(setq erc-session-client-certificate client-certificate)
(setq erc-networks--id
(if connect
- (or (and continued-session
- (buffer-local-value 'erc-networks--id old-buffer))
+ (or (and erc--server-reconnecting
+ (alist-get 'erc-networks--id erc--server-reconnecting))
(and id (erc-networks--id-create id)))
(buffer-local-value 'erc-networks--id old-buffer)))
;; debug output buffer
(setq erc-dbuf
(when erc-log-p
(get-buffer-create (concat "*ERC-DEBUG: " server "*"))))
+
+ (erc-determine-parameters server port nick full-name user passwd)
+
+ (save-excursion (run-mode-hooks))
+ (dolist (mod delayed-modules) (funcall mod +1))
+
;; set up prompt
(unless continued-session
(goto-char (point-max))
@@ -2038,8 +2045,6 @@ erc-open
(erc-display-prompt)
(goto-char (point-max)))
- (erc-determine-parameters server port nick full-name user passwd)
-
;; Saving log file on exit
(run-hook-with-args 'erc-connect-pre-hook buffer)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index a5100ec155..fecd17b10e 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1178,4 +1178,62 @@ erc-handle-irc-url
(kill-buffer "baznet")
(kill-buffer "#chan")))
+(ert-deftest erc-migrate-modules ()
+ (should (equal (erc-migrate-modules '(autojoin timestamp button))
+ '(autojoin stamp button)))
+ ;; Default unchanged
+ (should (equal (erc-migrate-modules erc-modules) erc-modules)))
+
+(ert-deftest erc-update-modules ()
+ (let (calls
+ erc-modules
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (cl-letf (((symbol-function 'require)
+ (lambda (s &rest _) (push s calls)))
+
+ ;; Local modules
+ ((symbol-function 'erc-fake-bar-mode)
+ (lambda (n) (push (cons 'fake-bar n) calls)))
+
+ ;; Global modules
+ ((symbol-function 'erc-fake-foo-mode)
+ (lambda (n) (push (cons 'fake-foo n) calls)))
+ ((get 'erc-fake-foo-mode 'standard-value) 'ignore)
+ ((symbol-function 'erc-autojoin-mode)
+ (lambda (n) (push (cons 'autojoin n) calls)))
+ ((get 'erc-autojoin-mode 'standard-value) 'ignore)
+ ((symbol-function 'erc-networks-mode)
+ (lambda (n) (push (cons 'networks n) calls)))
+ ((get 'erc-networks-mode 'standard-value) 'ignore)
+ ((symbol-function 'erc-completion-mode)
+ (lambda (n) (push (cons 'completion n) calls)))
+ ((get 'erc-completion-mode 'standard-value) 'ignore))
+
+ (ert-info ("Local modules")
+ (setq erc-modules '(fake-foo fake-bar))
+ (should (equal (erc-update-modules t) '(erc-fake-bar-mode)))
+ ;; Bar the feature is still required but the mode is not activated
+ (should (equal (nreverse calls)
+ '(erc-fake-foo (fake-foo . 1) erc-fake-bar)))
+ (setq calls nil))
+
+ (ert-info ("Module name overrides")
+ (setq erc-modules '(completion autojoin networks))
+ (should-not (erc-update-modules t)) ; no locals
+ (should (equal (nreverse calls) '( erc-pcomplete (completion . 1)
+ erc-join (autojoin . 1)
+ erc-networks (networks . 1))))
+ (setq calls nil)))))
+
+(ert-deftest erc-compat--local-module-modes ()
+ (with-temp-buffer
+ (if (< 27 emacs-major-version)
+ (let ((local-minor-modes '(font-lock-mode erc-fake-bar-mode)))
+ (should (equal (erc-compat--local-module-modes)
+ '(erc-fake-bar-mode))))
+ (cl-letf (((symbol-function 'buffer-local-variables)
+ (lambda (&rest _) '((font-lock-mode) (erc-fake-bar-mode)))))
+ (should (equal (erc-compat--local-module-modes)
+ '(erc-fake-bar-mode)))))))
+
;;; erc-tests.el ends here
--
2.38.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-Call-erc-login-indirectly-via-new-generic-wrapper.patch --]
[-- Type: text/x-patch, Size: 1951 bytes --]
From 39d2c0c61f6b5e858e297595d79882a75a993184 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 18 Sep 2022 01:49:23 -0700
Subject: [PATCH 4/6] Call erc-login indirectly via new generic wrapper
* lisp/erc/erc-backend (erc--register-connection): Add new internal
generic function that defers to `erc-login' by default.
(erc-process-sentinel, erc-server-connect): Call
`erc--register-connection' instead of `erc-login'.
---
lisp/erc/erc-backend.el | 8 ++++++--
1 file changed, 6 insertions(+), 2 deletions(-)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index ebfb4bb830..4061522259 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -638,6 +638,10 @@ erc-open-network-stream
(let ((p (plist-put parameters :nowait t)))
(apply #'open-network-stream name buffer host service p)))
+(cl-defmethod erc--register-connection ()
+ "Perform opening IRC protocol exchange with server."
+ (erc-login))
+
(defvar erc--server-connect-dumb-ipv6-regexp
;; Not for validation (gives false positives).
(rx bot "[" (group (+ (any xdigit digit ":.")) (? "%" (+ alnum))) "]" eot))
@@ -693,7 +697,7 @@ erc-server-connect
;; waiting for a non-blocking connect - keep the user informed
(erc-display-message nil nil buffer "Opening connection..\n")
(message "%s...done" msg)
- (erc-login)) ))
+ (erc--register-connection))))
(defun erc-server-reconnect ()
"Reestablish the current IRC connection.
@@ -894,7 +898,7 @@ erc-process-sentinel
cproc (process-status cproc) event erc-server-quitting))
(if (string-match "^open" event)
;; newly opened connection (no wait)
- (erc-login)
+ (erc--register-connection)
;; assume event is 'failed
(erc-with-all-buffers-of-server cproc nil
(setq erc-server-connected nil))
--
2.38.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0005-Add-non-IRCv3-SASL-module-to-ERC.patch --]
[-- Type: text/x-patch, Size: 74321 bytes --]
From 395ae5814b44215ddd6fa025e24124cddee5365d Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 12 Jul 2021 03:44:28 -0700
Subject: [PATCH 5/6] Add non-IRCv3 SASL module to ERC
* lisp/erc/erc-compat.el (erc-compat--sasl-scram-construct-gs2-header,
erc-compat--sasl-scram-client-first-message,
erc-compat--sasl-scram--client-final-message): Add minimal
authorization support via own variant of
`sasl-scram--client-final-message' and supporting sasl-scram-rfc
functions introduced in Emacs 29.
* lisp/erc/erc.el (erc-modules): Add `sasl'.
* lisp/erc/erc-sasl.el: New file (bug#29108).
* test/lisp/erc/erc-sasl-tests.el: New file.
* test/lisp/erc/erc-scenarios-sasl.el: New file.
* test/lisp/erc/resources/sasl/plain-failed.eld: New file.
* test/lisp/erc/resources/sasl/plain.eld: New file.
* test/lisp/erc/resources/sasl/scram-sha-1.eld: New file.
* test/lisp/erc/resources/sasl/scram-sha-256.eld: New file.
* test/lisp/erc/resources/sasl/external.eld: New file.
---
doc/misc/erc.texi | 150 +++++-
etc/ERC-NEWS | 7 +-
lisp/erc/erc-compat.el | 104 +++++
lisp/erc/erc-sasl.el | 429 ++++++++++++++++++
lisp/erc/erc.el | 1 +
test/lisp/erc/erc-sasl-tests.el | 344 ++++++++++++++
test/lisp/erc/erc-scenarios-sasl.el | 202 +++++++++
test/lisp/erc/resources/sasl/external.eld | 33 ++
test/lisp/erc/resources/sasl/plain-failed.eld | 16 +
test/lisp/erc/resources/sasl/plain.eld | 39 ++
test/lisp/erc/resources/sasl/scram-sha-1.eld | 47 ++
.../lisp/erc/resources/sasl/scram-sha-256.eld | 47 ++
12 files changed, 1414 insertions(+), 5 deletions(-)
create mode 100644 lisp/erc/erc-sasl.el
create mode 100644 test/lisp/erc/erc-sasl-tests.el
create mode 100644 test/lisp/erc/erc-scenarios-sasl.el
create mode 100644 test/lisp/erc/resources/sasl/external.eld
create mode 100644 test/lisp/erc/resources/sasl/plain-failed.eld
create mode 100644 test/lisp/erc/resources/sasl/plain.eld
create mode 100644 test/lisp/erc/resources/sasl/scram-sha-1.eld
create mode 100644 test/lisp/erc/resources/sasl/scram-sha-256.eld
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index dd15036b2e..790db1135e 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -78,6 +78,7 @@ Top
Advanced Usage
* Connecting:: Ways of connecting to an IRC server.
+* SASL:: Authenticating via SASL.
* Sample Configuration:: An example configuration file.
* Integrations:: Integrations available for ERC.
* Options:: Options that are available for ERC.
@@ -486,6 +487,10 @@ Modules
@item ring
Enable an input history
+@cindex modules, sasl
+@item sasl
+Enable SASL authentication
+
@cindex modules, scrolltobottom
@item scrolltobottom
Scroll to the bottom of the buffer
@@ -533,6 +538,7 @@ Advanced Usage
@menu
* Connecting:: Ways of connecting to an IRC server.
+* SASL:: Authenticating via SASL
* Sample Configuration:: An example configuration file.
* Integrations:: Integrations available for ERC.
* Options:: Options that are available for ERC.
@@ -605,6 +611,7 @@ Connecting
parameters, and some, like @code{client-certificate}, will just be
@code{nil}.
+@anchor{ERC client-certificate}
To use a certificate with @code{erc-tls}, specify the optional
@var{client-certificate} keyword argument, whose value should be as
described in the documentation of @code{open-network-stream}: if
@@ -739,7 +746,10 @@ Connecting
You can manually set another nickname with the /NICK command.
@end defopt
+@anchor{ERC username}
@subheading User
+@cindex user
+
@defun erc-compute-user &optional user
Determine a suitable value to send as the first argument of the
opening @samp{USER} IRC command by consulting the following sources:
@@ -851,6 +861,7 @@ Connecting
@noindent
For details, @pxref{Top,,auth-source, auth, Emacs auth-source Library}.
+@anchor{ERC auth-source functions}
@defopt erc-auth-source-server-function
@end defopt
@defopt erc-auth-source-services-function
@@ -863,7 +874,8 @@ Connecting
@code{:user} is the ``desired'' nickname rather than the current one.
Generalized names, like @code{:user} and @code{:host}, are always used
over back-end specific ones, like @code{:login} or @code{:machine}.
-ERC expects a string to use as the secret or nil, if the search fails.
+ERC expects a string to use as the secret or @code{nil}, if the search
+fails.
@findex erc-auth-source-search
The default value for all three options is the function
@@ -925,6 +937,142 @@ Connecting
make the most sense, but any reasonably printable object is
acceptable.
+@node SASL
+@section Authenticating via SASL
+@cindex SASL
+
+Regardless of the mechanism or the network, you'll likely have to be
+registered before first use. Please refer to the network's own
+instructions for details. If you're new to IRC and using a bouncer,
+know that you probably won't be needing SASL for the client-to-bouncer
+connection. To get started, just add @code{sasl} to
+@code{erc-modules} like any other module. But before that, please
+explore all custom options pertaining to your chosen mechanism.
+
+@defopt erc-sasl-mechanism
+The name of an SASL subprotocol type as a @emph{lowercase} symbol.
+
+@var{plain} and @var{scram} (``password-based''):
+
+@indentedblock
+Here, ``password'' refers to your account password, which is usually
+your @samp{NickServ} password. To make this work, customize
+@code{erc-sasl-user} and @code{erc-sasl-password} or specify the
+@code{:user} and @code{:password} keyword arguments when invoking
+@code{erc-tls}. Note that @code{:user} cannot be given interactively.
+@end indentedblock
+
+@var{external} (via Client TLS Certificate):
+
+@indentedblock
+This works in conjunction with the @code{:client-certificate} keyword
+offered by @code{erc-tls}. Just ensure you've registered your
+fingerprint with the network beforehand. The fingerprint is usually a
+SHA1 or SHA256 digest in either "normalized" or "openssl" forms. The
+first is lowercase without delims (@samp{deadbeef}) and the second
+uppercase with colon seps (@samp{DE:AD:BE:EF}). These days, there's
+usually a @samp{CERT ADD} command offered by NickServ that can
+register you automatically if you issue it while connected with a
+client cert. (@pxref{ERC client-certificate}).
+
+Additional considerations:
+@enumerate
+@item
+Most IRCds will allow you to authenticate with a client cert but
+without the hassle of SASL (meaning you may not need this module).
+@item
+Technically, @var{EXTERNAL} merely indicates that an out-of-band mode
+of authentication is in effect (being deferred to), so depending on
+the specific application or service, there's a remote chance your
+server has something else in mind.
+@end enumerate
+@end indentedblock
+
+@var{ecdsa-nist256p-challenge}:
+
+@indentedblock
+This mechanism is quite complicated and currently requires the
+external @samp{openssl} executable, so please use something else if at
+all possible. Ignoring that, specify your key file (e.g.,
+@samp{~/pki/mykey.pem}) as the value of @code{erc-sasl-password}, and
+then configure your network settings. On servers running Atheme
+services, you can add your public key with @samp{NickServ} like so:
+
+@example
+ERC> /msg NickServ set property \
+ pubkey AgGZmlYTUjJlea/BVz7yrjJ6gysiAPaQxzeUzTH4hd5j
+
+@end example
+(You may be able to omit the @samp{property} subcommand.)
+@end indentedblock
+
+@end defopt
+
+@defopt erc-sasl-user
+This should be your network account username, typically the same one
+registered with nickname services. Specify this when your NickServ
+login differs from the @code{:user} you're connecting with.
+(@pxref{ERC username})
+@end defopt
+
+@defopt erc-sasl-password
+As noted elsewhere, the @code{:password} parameter for @code{erc-tls}
+was orignally intended for traditional ``server passwords,'' but these
+aren't really used any more. As such, this option defaults to
+borrowing that parameter for its own uses, thus allowing you to call
+@code{erc-tls} with @code{:password} set to your NickServ password.
+
+You can also set this to a nonemtpy string, and ERC will send that
+when needed, no questions asked. If you instead give a non-@code{nil}
+symbol (other than @code{:password}), like @samp{Libera.Chat}, ERC
+will use it for the @code{:host} field in an auth-source query.
+Actually, the same goes for when this option is @code{nil} but an
+explicit session ID is already on file (@pxref{Network Identifier}).
+For all such queries, ERC specifies the resolved value of
+@code{erc-sasl-user} for the @code{:user} (@code{:login}) param. Keep
+in mind that none of this matters unless
+@code{erc-sasl-auth-source-function} holds a function, and it's
+@code{nil} by default. As a last resort, ERC will prompt you for
+input.
+
+Lastly, if your mechanism is @code{ecdsa-nist256p-challenge}, this
+option should instead hold the file name of your key.
+@end defopt
+
+@defopt erc-sasl-auth-source-function
+This is nearly identical to the other ERC @samp{auth-source} function
+options (@pxref{ERC auth-source functions}) except that the default
+value here is @code{nil}, meaning you have to set it to something like
+@code{erc-auth-source-search} for queries to be performed.
+@end defopt
+
+@defopt erc-sasl-authzid
+In the rarest of circumstances, a network may want you to specify a
+specific role or assume an alternate identity. In most cases, this
+happens because the server is buggy or misconfigured. If you suspect
+such a thing, please contact your network operator. Otherwise, just
+leave this set to @code{nil}.
+@end defopt
+
+@subheading Troubleshooting
+
+@strong{Warning:} ERC's SASL offering is currently limited by a lack
+of support for proper IRCv3 capability negotiation. In most cases,
+this shouldn't affect your ability to authenticate.
+
+If you're struggling, remember that your SASL password is almost
+always your NickServ password. When in doubt, try restoring all SASL
+options to their defaults and calling @code{erc-tls} with @code{:user}
+set to your NickServ account name and @code{:password} to your
+NickServ password. If you're still having trouble, please contact us
+(@pxref{Getting Help and Reporting Bugs}).
+
+And if, for whatever reason, you do find yourself trying out
+non-default SASL settings, keep in mind that every change requires a
+fresh session, so you'll want to call @code{erc-tls} from scratch
+again rather than rely on @samp{/reconnect} or the auto-reconnect
+facility. In fact, it's best to temporarily set
+@code{erc-server-auto-reconnect} to @code{nil} while experimenting.
@node Sample Configuration
@section Sample Configuration
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 4c4b154dca..829ef25a47 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -48,10 +48,9 @@ hell. For some, auth-source may provide a workaround in the form of
nonstandard server passwords. See the "Connection" node in the manual
under the subheading "Password".
-If you require SASL immediately, please participate in ERC development
-by volunteering to try (and give feedback on) edge features, one of
-which is SASL. All known external offerings, past and present, are
-valiant efforts whose use is nevertheless discouraged.
+** Rudimentary SASL support has arrived.
+A new module, 'erc-sasl', now ships with ERC 5.5. See the SASL
+section in the manual for details.
** Username argument for entry-point commands.
Commands 'erc' and 'erc-tls' now accept a ':user' keyword argument,
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index f7e6fb7aee..47299ee3cc 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -273,6 +273,110 @@ erc-compat--auth-source-backend-parser-functions
auth-source-backend-parser-functions))
+;;;; SASL
+
+(declare-function sasl-step-data "sasl" (step))
+(declare-function sasl-error "sasl" (datum))
+(declare-function sasl-client-property "sasl" (client property))
+(declare-function sasl-client-set-property "sasl" (client property value))
+(declare-function sasl-mechanism-name "sasl" (mechanism))
+(declare-function sasl-client-name "sasl" (client))
+(declare-function sasl-client-mechanism "sasl" (client))
+(declare-function sasl-read-passphrase "sasl" (prompt))
+(declare-function sasl-unique-id "sasl" nil)
+(declare-function decode-hex-string "hex-util" (string))
+(declare-function rfc2104-hash "rfc2104" (hash block-length hash-length
+ key text))
+(declare-function sasl-scram--client-first-message-bare "sasl-scram-rfc"
+ (client))
+(declare-function cl-mapcar "cl-lib" (cl-func cl-x &rest cl-rest))
+
+(defun erc-compat--sasl-scram-construct-gs2-header (client)
+ ;; The "n," means the client doesn't support channel binding, and
+ ;; the trailing comma is included as per RFC 5801.
+ (let ((authzid (sasl-client-property client 'authenticator-name)))
+ (concat "n," (and authzid "a=") authzid ",")))
+
+(defun erc-compat--sasl-scram-client-first-message (client _step)
+ (let ((c-nonce (sasl-unique-id)))
+ (sasl-client-set-property client 'c-nonce c-nonce))
+ (concat (erc-compat--sasl-scram-construct-gs2-header client)
+ (sasl-scram--client-first-message-bare client)))
+
+;; This is `sasl-scram--client-final-message' from sasl-scram-rfc,
+;; with the NO-LINE-BREAK argument of `base64-encode-string' set to t
+;; because https://www.rfc-editor.org/rfc/rfc5802#section-2.1 says:
+;;
+;; > The use of base64 in SCRAM is restricted to the canonical form
+;; > with no whitespace.
+;;
+;; Unfortunately, simply advising `base64-encode-string' won't work
+;; since the byte compiler precomputes the result when all inputs are
+;; constants, as they are in the original version.
+;;
+;; The only other substantial change is the addition of authz support.
+;; This can be dropped if adopted by Emacs 29 and `compat'. Changes
+;; proposed for 29 are marked with a "; *n", comment below. See older
+;; versions of lisp/erc/erc-v3-sasl.el (bug#49860) if needing a true
+;; side-by-side diff. This also inlines the internal function
+;; `sasl-scram--client-first-message-bare' and takes various liberties
+;; with formatting.
+
+(defun erc-compat--sasl-scram--client-final-message
+ (hash-fun block-length hash-length client step)
+ (unless (string-match
+ "^r=\\([^,]+\\),s=\\([^,]+\\),i=\\([0-9]+\\)\\(?:$\\|,\\)"
+ (sasl-step-data step))
+ (sasl-error "Unexpected server response"))
+ (let* ((hmac-fun
+ (lambda (text key)
+ (decode-hex-string
+ (rfc2104-hash hash-fun block-length hash-length key text))))
+ (step-data (sasl-step-data step))
+ (nonce (match-string 1 step-data))
+ (salt-base64 (match-string 2 step-data))
+ (iteration-count (string-to-number (match-string 3 step-data)))
+ (c-nonce (sasl-client-property client 'c-nonce))
+ (cbind-input
+ (if (string-prefix-p c-nonce nonce)
+ (erc-compat--sasl-scram-construct-gs2-header client) ; *1
+ (sasl-error "Invalid nonce from server")))
+ (client-final-message-without-proof
+ (concat "c=" (base64-encode-string cbind-input t) "," ; *2
+ "r=" nonce))
+ (password
+ (sasl-read-passphrase
+ (format "%s passphrase for %s: "
+ (sasl-mechanism-name (sasl-client-mechanism client))
+ (sasl-client-name client))))
+ (salt (base64-decode-string salt-base64))
+ (string-xor (lambda (a b)
+ (apply #'unibyte-string (cl-mapcar #'logxor a b))))
+ (salted-password (let ((digest (concat salt (string 0 0 0 1)))
+ (xored nil))
+ (dotimes (_i iteration-count xored)
+ (setq digest (funcall hmac-fun digest password))
+ (setq xored (if (null xored)
+ digest
+ (funcall string-xor xored
+ digest))))))
+ (client-key (funcall hmac-fun "Client Key" salted-password))
+ (stored-key (decode-hex-string (funcall hash-fun client-key)))
+ (auth-message (concat "n=" (sasl-client-name client)
+ ",r=" c-nonce "," step-data
+ "," client-final-message-without-proof))
+ (client-signature (funcall hmac-fun
+ (encode-coding-string auth-message 'utf-8)
+ stored-key))
+ (client-proof (funcall string-xor client-key client-signature))
+ (client-final-message
+ (concat client-final-message-without-proof ","
+ "p=" (base64-encode-string client-proof t)))) ; *3
+ (sasl-client-set-property client 'auth-message auth-message)
+ (sasl-client-set-property client 'salted-password salted-password)
+ client-final-message))
+
+
;;;; Misc 29.1
(defmacro erc-compat--with-memoization (table &rest forms)
diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el
new file mode 100644
index 0000000000..dcbc732450
--- /dev/null
+++ b/lisp/erc/erc-sasl.el
@@ -0,0 +1,429 @@
+;;; erc-sasl.el --- SASL for ERC -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This "non-IRCv3" implementation resembles others that have surfaced
+;; over the years, the first possibly being from Joseph Gay:
+;;
+;; https://lists.gnu.org/archive/html/erc-discuss/2012-02/msg00001.html
+;;
+;; See options and Info manual for usage.
+;;
+;; TODO:
+;;
+;; - Find a way to obfuscate the password in memory (via something
+;; like `auth-source--obfuscate'); it's currently visible in
+;; backtraces.
+;;
+;; - Implement a proxy mechanism that chooses the strongest available
+;; mechanism for you. Requires CAP 3.2 (see bug#49860).
+;;
+;; - Integrate with whatever solution ERC eventually settles on to
+;; handle user options for different network contexts. At the
+;; moment, this does its own thing for stashing and restoring
+;; session options, but ERC should make abstractions available for
+;; all local modules to use, possibly based on connection-local
+;; variables.
+
+;;; Code:
+(require 'erc)
+(require 'rx)
+(require 'sasl)
+(require 'sasl-scram-rfc)
+(require 'sasl-scram-sha256 nil t) ; not present in Emacs 27
+
+(defgroup erc-sasl nil
+ "SASL for ERC."
+ :group 'erc
+ :package-version '(ERC . "5.4.1")) ; FIXME increment on next release
+
+(defcustom erc-sasl-mechanism 'plain
+ "SASL mechanism to connect with.
+Note that any value other than nil or `external' likely requires
+`erc-sasl-user' and `erc-sasl-password'."
+ :type '(choice (const plain)
+ (const external)
+ (const scram-sha-1)
+ (const scram-sha-256)
+ (const scram-sha-512)
+ (const ecdsa-nist256p-challenge)))
+
+(defcustom erc-sasl-user :user
+ "Account username to send when authenticating.
+This is also referred to as the authentication identity or
+\"authcid\". A value of `:user' or `:nick' indicates that the
+corresponding connection parameter on file should be used. These
+are most often derived from arguments provided to the `erc' and
+`erc-tls' entry points. In the case of `:nick', a downcased
+version is used."
+ :type '(choice string (const :user) (const :nick)))
+
+(defcustom erc-sasl-password :password
+ "Optional account password to send when authenticating.
+When the value is a string, ERC will use it unconditionally for
+most mechanisms. Likewise with `:password', except ERC will
+instead use the \"session password\" on file, which often
+originates from the entry-point commands `erc' or `erc-tls'.
+Otherwise, when `erc-sasl-auth-source-function' is a function,
+ERC will attempt an auth-source query, possibly using a non-nil
+symbol for the suggested `:host' parameter if set as this
+option's value or passed as an `:id' to `erc-tls'. Failing that,
+ERC will prompt for input.
+
+Note that, with `:password', ERC will forgo sending a traditional
+server password via the IRC \"PASS\" command. Also, when
+`erc-sasl-mechanism' is set to `ecdsa-nist256p-challenge', this
+option should hold the file name of the key."
+ :type '(choice (const nil) (const :password) string symbol))
+
+(defcustom erc-sasl-auth-source-function nil
+ "Function to query auth-source for an SASL password.
+Called with keyword params known to `auth-source-search', which
+includes `erc-sasl-user' for the `:user' field and
+`erc-sasl-password' for the `:host' field, when the latter option
+is a non-nil, non-keyword symbol. In return, ERC expects a
+string to send as the SASL password, or nil, to move on to the
+next approach, as described in the doc string for the option
+`erc-sasl-password'. See info node `(erc) Connecting' for
+details on ERC's auth-source integration."
+ :type '(choice (function-item erc-auth-source-search)
+ (const nil)
+ function))
+
+(defcustom erc-sasl-authzid nil
+ "SASL authorization identity, likely unneeded for everyday use."
+ :type '(choice (const nil) string))
+
+
+;; Analogous to what erc-backend does to persist opening params.
+(defvar-local erc-sasl--options nil)
+
+;; Session-local (server buffer) SASL subproto state
+(defvar-local erc-sasl--state nil)
+
+(cl-defstruct erc-sasl--state
+ "Holder for client object and subproto state."
+ (client nil :type vector)
+ (step nil :type vector)
+ (pending nil :type string))
+
+(defun erc-sasl--get-user ()
+ (pcase (alist-get 'user erc-sasl--options)
+ (:user erc-session-username)
+ (:nick (erc-downcase (erc-current-nick)))
+ (v v)))
+
+(defun erc-sasl--read-password (prompt)
+ "Return configured option or server password.
+PROMPT is passed to `read-passwd' if necessary."
+ (if-let
+ ((found (pcase (alist-get 'password erc-sasl--options)
+ (:password erc-session-password)
+ ((and (pred stringp) v) (unless (string-empty-p v) v))
+ ((and (guard erc-sasl-auth-source-function)
+ v (let host
+ (or v (erc-networks--id-given erc-networks--id))))
+ (apply erc-sasl-auth-source-function
+ :user (erc-sasl--get-user)
+ (and host (list :host (symbol-name host))))))))
+ (copy-sequence found)
+ (read-passwd prompt)))
+
+(defun erc-sasl--plain-response (client steps)
+ (let ((sasl-read-passphrase #'erc-sasl--read-password))
+ (sasl-plain-response client steps)))
+
+(declare-function erc-compat--sasl-scram--client-final-message "erc-compat"
+ (hash-fun block-length hash-length client step))
+
+(defun erc-sasl--scram-sha-hack-client-final-message (&rest args)
+ ;; In the future (29+), we'll hopefully be able to call
+ ;; `sasl-scram--client-final-message' directly
+ (require 'erc-compat)
+ (let ((sasl-read-passphrase #'erc-sasl--read-password))
+ (apply #'erc-compat--sasl-scram--client-final-message args)))
+
+(defun erc-sasl--scram-sha-1-client-final-message (client step)
+ (erc-sasl--scram-sha-hack-client-final-message 'sha1 64 20 client step))
+
+(defun erc-sasl--scram-sha-256-client-final-message (client step)
+ (erc-sasl--scram-sha-hack-client-final-message 'sasl-scram-sha256 64 32
+ client step))
+
+(defun erc-sasl--scram-sha512 (object &optional start end binary)
+ (secure-hash 'sha512 object start end binary))
+
+(defun erc-sasl--scram-sha-512-client-final-message (client step)
+ (erc-sasl--scram-sha-hack-client-final-message #'erc-sasl--scram-sha512
+ 128 64 client step))
+
+(defun erc-sasl--scram-sha-512-authenticate-server (client step)
+ (sasl-scram--authenticate-server #'erc-sasl--scram-sha512
+ 128 64 client step))
+
+(defun erc-sasl--ecdsa-first (client _step)
+ "Return CLIENT name."
+ (sasl-client-name client))
+
+;; FIXME do this with gnutls somehow
+(defun erc-sasl--ecdsa-sign (client step)
+ "Return signed challenge for CLIENT and current STEP."
+ (let ((challenge (sasl-step-data step)))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert challenge)
+ (call-process-region (point-min) (point-max)
+ "openssl" 'delete t nil "pkeyutl" "-inkey"
+ (sasl-client-property client 'ecdsa-keyfile)
+ "-sign")
+ (buffer-string))))
+
+(pcase-dolist
+ (`(,name . ,steps)
+ '(("PLAIN"
+ erc-sasl--plain-response)
+ ("EXTERNAL"
+ ignore)
+ ("SCRAM-SHA-1"
+ erc-compat--sasl-scram-client-first-message
+ erc-sasl--scram-sha-1-client-final-message
+ sasl-scram-sha-1-authenticate-server)
+ ("SCRAM-SHA-256"
+ erc-compat--sasl-scram-client-first-message
+ erc-sasl--scram-sha-256-client-final-message
+ sasl-scram-sha-256-authenticate-server)
+ ("SCRAM-SHA-512"
+ erc-compat--sasl-scram-client-first-message
+ erc-sasl--scram-sha-512-client-final-message
+ erc-sasl--scram-sha-512-authenticate-server)
+ ("ECDSA-NIST256P-CHALLENGE"
+ erc-sasl--ecdsa-first
+ erc-sasl--ecdsa-sign)))
+ (let ((feature (intern (concat "erc-sasl-" (downcase name)))))
+ (put feature 'sasl-mechanism (sasl-make-mechanism name steps))
+ (provide feature)))
+
+(cl-defgeneric erc-sasl--create-client (mechanism)
+ "Create and return a new SASL client object for MECHANISM."
+ (let ((sasl-mechanism-alist (copy-sequence sasl-mechanism-alist))
+ (sasl-mechanisms sasl-mechanisms)
+ (name (upcase (symbol-name mechanism)))
+ (feature (intern-soft (concat "erc-sasl-" (symbol-name mechanism))))
+ client)
+ (when feature
+ (setf (alist-get name sasl-mechanism-alist nil nil #'equal) `(,feature))
+ (cl-pushnew name sasl-mechanisms :test #'equal)
+ (setq client (sasl-make-client (sasl-find-mechanism (list name))
+ (erc-sasl--get-user)
+ "N/A" "N/A"))
+ (sasl-client-set-property client 'authenticator-name
+ (alist-get 'authzid erc-sasl--options))
+ client)))
+
+(cl-defmethod erc-sasl--create-client ((_ (eql plain)))
+ "Create and return a new PLAIN client object."
+ ;; https://tools.ietf.org/html/rfc4616#section-2.
+ (let* ((sans (remq (assoc "PLAIN" sasl-mechanism-alist)
+ sasl-mechanism-alist))
+ (sasl-mechanism-alist (cons '("PLAIN" erc-sasl-plain) sans))
+ (authc (erc-sasl--get-user))
+ (port (if (numberp erc-session-port)
+ (number-to-string erc-session-port)
+ "0"))
+ ;; In most cases, `erc-server-announced-name' won't be known.
+ (host (or erc-server-announced-name erc-session-server))
+ (mech (sasl-find-mechanism '("PLAIN")))
+ (client (sasl-make-client mech authc port host)))
+ (sasl-client-set-property client 'authenticator-name
+ (alist-get 'authzid erc-sasl--options))
+ client))
+
+(cl-defmethod erc-sasl--create-client ((_ (eql scram-sha-256)))
+ "Create and return a new SCRAM-SHA-256 client."
+ (when (featurep 'sasl-scram-sha256)
+ (cl-call-next-method)))
+
+(cl-defmethod erc-sasl--create-client ((_ (eql scram-sha-512)))
+ "Create and return a new SCRAM-SHA-512 client."
+ (when (featurep 'sasl-scram-sha256)
+ (cl-call-next-method)))
+
+(cl-defmethod erc-sasl--create-client ((_ (eql ecdsa-nist256p-challenge)))
+ "Create and return a new ECDSA-NIST256P-CHALLENGE client."
+ (let ((keyfile (cdr (assq 'password erc-sasl--options))))
+ ;; Better to signal usage errors now than inside a process filter.
+ (cond ((or (not (stringp keyfile)) (not (file-readable-p keyfile)))
+ (erc-display-error-notice
+ nil "`erc-sasl-password' not accessible as a file")
+ nil)
+ ((not (executable-find "openssl"))
+ (erc-display-error-notice nil "Could not find openssl program")
+ nil)
+ (t
+ (let ((client (cl-call-next-method)))
+ (sasl-client-set-property client 'ecdsa-keyfile keyfile)
+ client)))))
+
+;; This stands alone because it's also used by bug#49860.
+(defun erc-sasl--init ()
+ (setq erc-sasl--state (make-erc-sasl--state))
+ ;; If the previous attempt failed during registration, this may be
+ ;; non-nil and contain erroneous values, but how can we detect that?
+ ;; What if the server dropped the connection for some other reason?
+ (setq erc-sasl--options
+ (or (and (consp erc--server-reconnecting)
+ (alist-get 'erc-sasl--options erc--server-reconnecting))
+ `((user . ,erc-sasl-user)
+ (password . ,erc-sasl-password)
+ (mechanism . ,erc-sasl-mechanism)
+ (authzid . ,erc-sasl-authzid)))))
+
+(defun erc-sasl--mechanism-offered-p (offered)
+ "Return non-nil when OFFERED appears among a list of mechanisms."
+ (string-match-p (rx-to-string
+ `(: (| bot ",")
+ ,(symbol-name (alist-get 'mechanism erc-sasl--options))
+ (| eot ",")))
+ (downcase offered)))
+
+(defun erc-sasl--authenticate-handler (_proc parsed)
+ "Handle PARSED `erc-response' from server.
+Maybe transition to next state."
+ (if-let* ((response (car (erc-response.command-args parsed)))
+ ((= 400 (length response))))
+ (cl-callf (lambda (s) (concat s response))
+ (erc-sasl--state-pending erc-sasl--state))
+ (cl-assert response t)
+ (when (string= "+" response)
+ (setq response ""))
+ (setf response (base64-decode-string
+ (concat (erc-sasl--state-pending erc-sasl--state)
+ response))
+ (erc-sasl--state-pending erc-sasl--state) nil)
+ ;; The server is done sending, so our turn
+ (let ((client (erc-sasl--state-client erc-sasl--state))
+ (step (erc-sasl--state-step erc-sasl--state))
+ data)
+ (when step
+ (sasl-step-set-data step response))
+ (setq step (setf (erc-sasl--state-step erc-sasl--state)
+ (sasl-next-step client step))
+ data (sasl-step-data step))
+ (when (string= data "")
+ (setq data nil))
+ (when data
+ (setq data (base64-encode-string data t)))
+ ;; No need for : because no spaces (right?)
+ (erc-server-send (concat "AUTHENTICATE " (or data "+"))))))
+
+(erc-define-catalog
+ 'english
+ '((s902 . "ERR_NICKLOCKED nick %n unavailable: %s")
+ (s904 . "ERR_SASLFAIL (authentication failed) %s")
+ (s905 . "ERR SASLTOOLONG (credentials too long) %s")
+ (s906 . "ERR_SASLABORTED (authentication aborted) %s")
+ (s907 . "ERR_SASLALREADY (already authenticated) %s")
+ (s908 . "RPL_SASLMECHS (unsupported mechanism: %m) %s")))
+
+(define-erc-module sasl nil
+ "Non-IRCv3 SASL support for ERC.
+This doesn't solicit or validate a suite of supported mechanisms."
+ ;; See bug#49860 for a full, CAP 3.2-aware implementation, currently
+ ;; a WIP as of ERC 5.5.
+ ((unless erc--target
+ (add-hook 'erc-server-AUTHENTICATE-functions
+ #'erc-sasl--authenticate-handler 0 t)
+ (erc-sasl--init)
+ (let* ((mech (alist-get 'mechanism erc-sasl--options))
+ (client (erc-sasl--create-client mech)))
+ (unless client
+ (erc-display-error-notice
+ nil (format "Unknown or unsupported SASL mechanism: %s" mech))
+ (erc-error "Unknown or unsupported SASL mechanism: %s" mech))
+ (setf (erc-sasl--state-client erc-sasl--state) client))))
+ ((remove-hook 'erc-server-AUTHENTICATE-functions
+ #'erc-sasl--authenticate-handler t)
+ (kill-local-variable 'erc-sasl--state)
+ (kill-local-variable 'erc-sasl--options))
+ 'local)
+
+;; FIXME use generic mechanism instead of hooks after bug#49860.
+(define-erc-response-handler (AUTHENTICATE)
+ "Maybe authenticate to server." nil)
+
+(defun erc-sasl--destroy (proc)
+ (run-hook-with-args 'erc-quit-hook proc)
+ (delete-process proc)
+ (erc-error "Disconnected from %s; please review SASL settings" proc))
+
+(define-erc-response-handler (902)
+ "Handle a ERR_NICKLOCKED response." nil
+ (erc-display-message parsed '(notice error) 'active 's902
+ ?n (car (erc-response.command-args parsed))
+ ?s (erc-response.contents parsed))
+ (erc-sasl--destroy proc))
+
+(define-erc-response-handler (903)
+ "Handle a RPL_SASLSUCCESS response." nil
+ (when erc-sasl-mode
+ (unless erc-server-connected
+ (erc-server-send "CAP END")))
+ (erc-handle-unknown-server-response proc parsed))
+
+(define-erc-response-handler (907)
+ "Handle a RPL_SASLALREADY response." nil
+ (erc-display-message parsed '(notice error) 'active 's907
+ ?s (erc-response.contents parsed)))
+
+(define-erc-response-handler (904 905 906)
+ "Handle various SASL-related error responses." nil
+ (erc-display-message parsed '(notice error) 'active
+ (intern (format "s%s" (erc-response.command parsed)))
+ ?s (erc-response.contents parsed))
+ (erc-sasl--destroy proc))
+
+(define-erc-response-handler (908)
+ "Handle a RPL_SASLALREADY response." nil
+ (erc-display-message parsed '(notice error) 'active 's908
+ ?m (alist-get 'mechanism erc-sasl--options)
+ ?s (string-join (cdr (erc-response.command-args parsed))
+ " "))
+ (erc-sasl--destroy proc))
+
+(cl-defmethod erc--register-connection (&context (erc-sasl-mode (eql t)))
+ "Send speculative/pipelined CAP and AUTHENTICATE and hope for the best."
+ (if-let* ((c (erc-sasl--state-client erc-sasl--state))
+ (m (sasl-mechanism-name (sasl-client-mechanism c))))
+ (progn
+ (erc-server-send "CAP REQ :sasl")
+ (if (and erc-session-password
+ (eq :password (alist-get 'password erc-sasl--options)))
+ (let (erc-session-password)
+ (erc-login))
+ (erc-login))
+ (erc-server-send (format "AUTHENTICATE %s" m)))
+ (erc-sasl--destroy erc-server-process)))
+
+(provide 'erc-sasl)
+;;; erc-sasl.el ends here
+;;
+;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
+;; End:
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ef70aa1a21..16e1533d07 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1853,6 +1853,7 @@ erc-modules
(const :tag "readonly: Make displayed lines read-only" readonly)
(const :tag "replace: Replace text in messages" replace)
(const :tag "ring: Enable an input history" ring)
+ (const :tag "sasl: Enable SASL authentication" sasl)
(const :tag "scrolltobottom: Scroll to the bottom of the buffer"
scrolltobottom)
(const :tag "services: Identify to Nickserv (IRC Services) automatically"
diff --git a/test/lisp/erc/erc-sasl-tests.el b/test/lisp/erc/erc-sasl-tests.el
new file mode 100644
index 0000000000..20a6760083
--- /dev/null
+++ b/test/lisp/erc/erc-sasl-tests.el
@@ -0,0 +1,344 @@
+;;; erc-sasl-tests.el --- Tests for erc-sasl. -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert-x)
+(require 'erc-sasl)
+
+(ert-deftest erc-sasl--mechanism-offered-p ()
+ (let ((erc-sasl--options '((mechanism . external))))
+ (should (erc-sasl--mechanism-offered-p "foo,external"))
+ (should (erc-sasl--mechanism-offered-p "external,bar"))
+ (should (erc-sasl--mechanism-offered-p "foo,external,bar"))
+ (should-not (erc-sasl--mechanism-offered-p "fooexternal"))
+ (should-not (erc-sasl--mechanism-offered-p "externalbar"))))
+
+(ert-deftest erc-sasl--read-password--basic ()
+ (ert-info ("Explicit erc-sasl-password")
+ (let ((erc-sasl--options '((password . "foo"))))
+ (should (string= (erc-sasl--read-password nil) "foo"))))
+
+ (ert-info ("Explicit session password")
+ (let ((erc-session-password "foo")
+ (erc-sasl--options '((password . :password))))
+ (should (string= (erc-sasl--read-password nil) "foo"))))
+
+ (ert-info ("Fallback to prompt skip auth-source")
+ (should-not erc-sasl-auth-source-function)
+ (let ((erc-session-password "bar")
+ (erc-networks--id (erc-networks--id-create nil)))
+ (should (string= (ert-simulate-keys "bar\r"
+ (erc-sasl--read-password "?"))
+ "bar"))))
+
+ (ert-info ("Prompt when auth-source fails and `erc-sasl-password' null")
+ (let ((erc-sasl--options '((password)))
+ (erc-sasl-auth-source-function #'ignore))
+ (should (string= (ert-simulate-keys "baz\r"
+ (erc-sasl--read-password "pwd:"))
+ "baz")))))
+
+(ert-deftest erc-sasl--read-password--auth-source ()
+ (ert-with-temp-file netrc-file
+ :text (string-join
+ (list
+ ;; If you swap these first 2 lines, *1 below fails
+ "machine FSF.chat port 6697 user bob password sesame"
+ "machine GNU/chat port 6697 user bob password spam"
+ "machine MyHost port irc password 123")
+ "\n")
+ (let* ((auth-sources (list netrc-file))
+ (erc-session-server "irc.gnu.org")
+ (erc-session-port 6697)
+ (erc-networks--id (erc-networks--id-create nil))
+ calls
+ (erc-sasl-auth-source-function
+ (lambda (&rest r)
+ (push r calls)
+ (apply #'erc--auth-source-search r)))
+ erc-server-announced-name ; too early
+ auth-source-do-cache)
+
+ (ert-info ("Symbol as password specifies machine")
+ (let ((erc-sasl--options '((user . "bob") (password . FSF.chat)))
+ (erc-networks--id (make-erc-networks--id)))
+ (should (string= (erc-sasl--read-password nil) "sesame"))
+ (should (equal (pop calls) '(:user "bob" :host "FSF.chat")))))
+
+ (ert-info ("ID for :host and `erc-session-username' for :user") ; *1
+ (let ((erc-session-username "bob")
+ (erc-sasl--options '((user . :user) (password)))
+ (erc-networks--id (erc-networks--id-create 'GNU/chat)))
+ (should (string= (erc-sasl--read-password nil) "spam"))
+ (should (equal (pop calls) '(:user "bob" :host "GNU/chat")))))
+
+ (ert-info ("ID for :host and current nick for :user") ; *1
+ (let ((erc-server-current-nick "bob")
+ (erc-sasl--options '((user . :nick) (password)))
+ (erc-networks--id (erc-networks--id-create 'GNU/chat)))
+ (should (string= (erc-sasl--read-password nil) "spam"))
+ (should (equal (pop calls) '(:user "bob" :host "GNU/chat")))))
+
+ (ert-info ("Symbol as password, entry lacks user field")
+ (let ((erc-server-current-nick "fake")
+ (erc-sasl--options '((user . :nick) (password . MyHost)))
+ (erc-networks--id (erc-networks--id-create 'GNU/chat)))
+ (should (string= (erc-sasl--read-password nil) "123"))
+ (should (equal (pop calls) '(:user "fake" :host "MyHost"))))))))
+
+(ert-deftest erc-sasl-create-client--plain ()
+ (let* ((erc-session-password "password123")
+ (erc-session-username "tester")
+ (erc-sasl--options '((user . :user) (password . :password)))
+ (erc-session-port 1667)
+ (erc-session-server "localhost")
+ (client (erc-sasl--create-client 'plain))
+ (result (sasl-next-step client nil)))
+ (should (equal (format "%S" [erc-sasl--plain-response
+ "\0tester\0password123"])
+ (format "%S" result)))
+ (should (string= (sasl-step-data result) "\0tester\0password123"))
+ (should-not (sasl-next-step client result)))
+ (should (equal (assoc-default "PLAIN" sasl-mechanism-alist) '(sasl-plain))))
+
+(ert-deftest erc-sasl-create-client--external ()
+ (let* ((erc-server-current-nick "tester")
+ (erc-sasl--options '((user . :nick) (password . :password)))
+ (client (erc-sasl--create-client 'external)) ; unused ^
+ (result (sasl-next-step client nil)))
+ (should (equal (format "%S" [ignore nil]) (format "%S" result)))
+ (should-not (sasl-step-data result))
+ (should-not (sasl-next-step client result)))
+ (should-not (member "EXTERNAL" sasl-mechanisms))
+ (should-not (assoc-default "EXTERNAL" sasl-mechanism-alist)))
+
+(ert-deftest erc-sasl-create-client--scram-sha-1 ()
+ (let* ((erc-sasl--options '((user . "jilles") (password . "sesame")
+ (authzid . "jilles")))
+ (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" ""))
+ (sasl-unique-id-function (lambda () (pop mock-rvs)))
+ (client (erc-sasl--create-client 'scram-sha-1))
+ (step (sasl-next-step client nil)))
+ (ert-info ("Client's initial request")
+ (let ((req "n,a=jilles,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs"))
+ (should (equal (format "%S"
+ `[erc-compat--sasl-scram-client-first-message
+ ,req])
+ (format "%S" step)))
+ (should (string= (sasl-step-data step) req))))
+ (ert-info ("Server's initial response")
+ (let ((resp (concat "r=c5RqLCZy0L4fGkKAZ0hujFBsXQoKcivqCw9iDZPSpb,"
+ "s=5mJO6d4rjCnsBU1X,"
+ "i=4096"))
+ (req (concat "c=bixhPWppbGxlcyw=,"
+ "r=c5RqLCZy0L4fGkKAZ0hujFBsXQoKcivqCw9iDZPSpb,"
+ "p=OVUhgPu8wEm2cDoVLfaHzVUYPWU=")))
+ (sasl-step-set-data step resp)
+ (setq step (sasl-next-step client step))
+ (should (equal (format "%S"
+ `[erc-sasl--scram-sha-1-client-final-message
+ ,req])
+ (format "%S" step)))
+ (should (string= (sasl-step-data step) req))))
+ (ert-info ("Server's final message")
+ (let ((resp "v=ZWR23c9MJir0ZgfGf5jEtLOn6Ng="))
+ (sasl-step-set-data step resp)
+ (setq step (sasl-next-step client step))
+ (should-not (sasl-step-data step)))))
+ (should (eq sasl-unique-id-function #'sasl-unique-id-function)))
+
+(ert-deftest erc-sasl-create-client--scram-sha-256 ()
+ (unless (featurep 'sasl-scram-sha256)
+ (ert-skip "Emacs lacks sasl-scram-sha256"))
+ (let* ((erc-server-current-nick "jilles")
+ (erc-session-password "sesame")
+ (erc-sasl--options '((user . :nick) (password . :password)
+ (authzid . "jilles")))
+ (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" ""))
+ (sasl-unique-id-function (lambda () (pop mock-rvs)))
+ (client (erc-sasl--create-client 'scram-sha-256))
+ (step (sasl-next-step client nil)))
+ (ert-info ("Client's initial request")
+ (let ((req "n,a=jilles,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs"))
+ (should (equal (format "%S"
+ `[erc-compat--sasl-scram-client-first-message
+ ,req])
+ (format "%S" step)))
+ (should (string= (sasl-step-data step) req))))
+ (ert-info ("Server's initial response")
+ (let ((resp (concat
+ "r=c5RqLCZy0L4fGkKAZ0hujFBse697140729d8445fb95ec94ceacb14b3,"
+ "s=MTk2M2VkMzM5ZmU0NDRiYmI0MzIyOGVhN2YwNzYwNmI=,"
+ "i=4096"))
+ (req (concat
+ "c=bixhPWppbGxlcyw=,"
+ "r=c5RqLCZy0L4fGkKAZ0hujFBse697140729d8445fb95ec94ceacb14b3,"
+ "p=1vDesVBzJmv0lX0Ae1kHFtdVHkC6j4gISKVqaR45HFg=")))
+ (sasl-step-set-data step resp)
+ (setq step (sasl-next-step client step))
+ (should (equal (format "%S"
+ `[erc-sasl--scram-sha-256-client-final-message
+ ,req])
+ (format "%S" step)))
+ (should (string= (sasl-step-data step) req))))
+ (ert-info ("Server's final message")
+ (let ((resp "v=gUePTYSZN9xgcE06KSyKO9fUmSwH26qifoapXyEs75s="))
+ (sasl-step-set-data step resp)
+ (setq step (sasl-next-step client step))
+ (should-not (sasl-step-data step)))))
+ (should (eq sasl-unique-id-function #'sasl-unique-id-function)))
+
+(ert-deftest erc-sasl-create-client--scram-sha-256--no-authzid ()
+ (unless (featurep 'sasl-scram-sha256)
+ (ert-skip "Emacs lacks sasl-scram-sha256"))
+ (let* ((erc-server-current-nick "jilles")
+ (erc-session-password "sesame")
+ (erc-sasl--options '((user . :nick) (password . :password) (authzid)))
+ (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" ""))
+ (sasl-unique-id-function (lambda () (pop mock-rvs)))
+ (client (erc-sasl--create-client 'scram-sha-256))
+ (step (sasl-next-step client nil)))
+ (ert-info ("Client's initial request")
+ (let ((req "n,,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs"))
+ (should (equal (format "%S"
+ `[erc-compat--sasl-scram-client-first-message
+ ,req])
+ (format "%S" step)))
+ (should (string= (sasl-step-data step) req))))
+ (ert-info ("Server's initial response")
+ (let ((resp (concat
+ "r=c5RqLCZy0L4fGkKAZ0hujFBsd4067f0afdb54c3dbd4fe645b84cae37,"
+ "s=ZTg1MmE1YmFhZGI1NDcyMjk3NzYwZmRjZDM3Y2I1OTM=,"
+ "i=4096"))
+ (req (concat
+ "c=biws,"
+ "r=c5RqLCZy0L4fGkKAZ0hujFBsd4067f0afdb54c3dbd4fe645b84cae37,"
+ "p=LP4sjJrjJKp5qTsARyZCppXpKLu4FMM284hNESPvGhI=")))
+ (sasl-step-set-data step resp)
+ (setq step (sasl-next-step client step))
+ (should (equal (format "%S"
+ `[erc-sasl--scram-sha-256-client-final-message
+ ,req])
+ (format "%S" step)))
+ (should (string= (sasl-step-data step) req))))
+ (ert-info ("Server's final message")
+ (let ((resp "v=847WXfnmReGyE1qlq1And6R4bPBNROTZ7EMS/QrJtUM="))
+ (sasl-step-set-data step resp)
+ (setq step (sasl-next-step client step))
+ (should-not (sasl-step-data step)))))
+ (should (eq sasl-unique-id-function #'sasl-unique-id-function)))
+
+(ert-deftest erc-sasl-create-client--scram-sha-512--no-authzid ()
+ (unless (featurep 'sasl-scram-sha256)
+ (ert-skip "Emacs lacks sasl-scram-sha512"))
+ (let* ((erc-server-current-nick "jilles")
+ (erc-session-password "sesame")
+ (erc-sasl--options '((user . :nick) (password . :password) (authzid)))
+ (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" ""))
+ (sasl-unique-id-function (lambda () (pop mock-rvs)))
+ (client (erc-sasl--create-client 'scram-sha-512))
+ (step (sasl-next-step client nil)))
+ (ert-info ("Client's initial request")
+ (let ((req "n,,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs"))
+ (should (equal (format "%S"
+ `[erc-compat--sasl-scram-client-first-message
+ ,req])
+ (format "%S" step)))
+ (should (string= (sasl-step-data step) req))))
+ (ert-info ("Server's initial response")
+ (let ((resp (concat
+ "r=c5RqLCZy0L4fGkKAZ0hujFBs54c592745ce14e559fcc3f27b15464f6,"
+ "s=YzMzOWZiY2U0YzcwNDA0M2I4ZGE2M2ZjOTBjODExZTM=,"
+ "i=4096"))
+ (req (concat
+ "c=biws,"
+ "r=c5RqLCZy0L4fGkKAZ0hujFBs54c592745ce14e559fcc3f27b15464f6,"
+ "p=vMBb9tKxFAfBtel087/GLbo4objAIYr1wM+mFv/jYLKXE"
+ "NUF0vynm81qQbywQE5ScqFFdAfwYMZq/lj4s0V1OA==")))
+ (sasl-step-set-data step resp)
+ (setq step (sasl-next-step client step))
+ (should (equal (format
+ "%S" `[erc-sasl--scram-sha-512-client-final-message
+ ,req])
+ (format "%S" step)))
+ (should (string= (sasl-step-data step) req))))
+ (ert-info ("Server's final message")
+ (let ((resp (concat "v=Va7NIvt8wCdhvxnv+bZriSxGoto6On5EVnRHO/ece8zs0"
+ "qpQassdqir1Zlwh3e3EmBq+kcSy+ClNCsbzBpXe/w==")))
+ (sasl-step-set-data step resp)
+ (setq step (sasl-next-step client step))
+ (should-not (sasl-step-data step)))))
+ (should (eq sasl-unique-id-function #'sasl-unique-id-function)))
+
+(defconst erc-sasl-tests-ecdsa-key-file "
+-----BEGIN EC PARAMETERS-----
+BggqhkjOPQMBBw==
+-----END EC PARAMETERS-----
+-----BEGIN EC PRIVATE KEY-----
+MHcCAQEEIIJueQ3W2IrGbe9wKdOI75yGS7PYZSj6W4tg854hlsvmoAoGCCqGSM49
+AwEHoUQDQgAEAZmaVhNSMmV5r8FXPvKuMnqDKyIA9pDHN5TNMfiF3mMeikGgK10W
+IRX9cyi2wdYg9mUUYyh9GKdBCYHGUJAiCA==
+-----END EC PRIVATE KEY-----
+")
+
+(ert-deftest erc-sasl-create-client-ecdsa ()
+ :tags '(:unstable)
+ ;; This is currently useless because it just roundtrips shelling out
+ ;; to pkeyutl.
+ (ert-skip "Placeholder")
+ (unless (executable-find "openssl")
+ (ert-skip "System lacks openssl"))
+ (ert-with-temp-file keyfile
+ :prefix "ecdsa_key"
+ :suffix ".pem"
+ :text erc-sasl-tests-ecdsa-key-file
+ (let* ((erc-server-current-nick "jilles")
+ (erc-sasl--options `((password . ,keyfile)))
+ (client (erc-sasl--create-client 'ecdsa-nist256p-challenge))
+ (step (sasl-next-step client nil)))
+ (ert-info ("Client's initial request")
+ (should (equal (format "%S" [erc-sasl--ecdsa-first "jilles"])
+ (format "%S" step)))
+ (should (string= (sasl-step-data step) "jilles")))
+ (ert-info ("Server's initial response")
+ (let ((resp (concat "\0\1\2\3\4\5\6\7\10\11\12\13\14\15\16\17\20"
+ "\21\22\23\24\25\26\27\30\31\32\33\34\35\36\37")))
+ (sasl-step-set-data step resp)
+ (setq step (sasl-next-step client step))
+ (ert-with-temp-file sigfile
+ :prefix "ecdsa_sig"
+ :suffix ".sig"
+ :text (sasl-step-data step)
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert resp)
+ (let ((ec (call-process-region
+ (point-min) (point-max)
+ "openssl" 'delete t nil "pkeyutl"
+ "-inkey" keyfile "-sigfile" sigfile
+ "-verify")))
+ (unless (zerop ec)
+ (message "%s" (buffer-string)))
+ (should (zerop ec)))))))
+ (should-not (sasl-next-step client step)))))
+
+;;; erc-sasl-tests.el ends here
diff --git a/test/lisp/erc/erc-scenarios-sasl.el b/test/lisp/erc/erc-scenarios-sasl.el
new file mode 100644
index 0000000000..713c9929c3
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-sasl.el
@@ -0,0 +1,202 @@
+;;; erc-scenarios-sasl.el --- SASL tests for ERC -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+;;
+;; This file is part of GNU Emacs.
+;;
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see
+;; <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(declare-function sasl-client-name "sasl" (client))
+
+(require 'erc-scenarios-common)
+(require 'erc-sasl)
+
+(ert-deftest erc-scenarios-sasl--plain ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "sasl")
+ (erc-d-linger-secs 0.5)
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'plain))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (erc-sasl-password "password123")
+ (inhibit-message noninteractive)
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :full-name "tester")
+ (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
+
+ (erc-d-t-wait-for 10 "server buffer ready" (get-buffer "ExampleOrg"))
+
+ (ert-info ("Notices received")
+ (with-current-buffer "ExampleOrg"
+ (funcall expect 10 "This server is in debug mode")
+ ;; Regression "\0\0\0\0 ..." caused by (fillarray passphrase 0)
+ (should (string= erc-sasl-password "password123"))))))
+
+;; This is meant to assert `erc-update-modules' and local-module
+;; behavior generally. It only exists here for convenience because as
+;; of ERC 5.5, `sasl' is the only local module.
+(ert-deftest erc-scenarios-sasl--local-modules-reconnect ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "sasl")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'plain 'plain))
+ (port (process-contact dumb-server :service))
+ (inhibit-message noninteractive)
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect with options let-bound")
+ (with-current-buffer
+ ;; This won't work unless the library is already loaded
+ (let ((erc-modules (cons 'sasl erc-modules))
+ (erc-sasl-mechanism 'plain)
+ (erc-sasl-password "password123"))
+ (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :full-name "tester"))
+ (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "ExampleOrg"))
+ (ert-info ("First connection succeeds")
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished"))
+
+ (should-not (memq 'sasl erc-modules))
+
+ (erc-d-t-wait-for 10 (not (erc-server-process-alive)))
+ (erc-cmd-RECONNECT)
+ (ert-info ("Second connection succeeds")
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))))
+
+(ert-deftest erc-scenarios-sasl--external ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "sasl")
+ (erc-d-linger-secs 0.5)
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'external))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (erc-sasl-mechanism 'external)
+ (inhibit-message noninteractive)
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :full-name "tester")
+ (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
+
+ (erc-d-t-wait-for 10 "server buffer ready" (get-buffer "ExampleOrg"))
+
+ (ert-info ("Notices received")
+ (with-current-buffer "ExampleOrg"
+ (funcall expect 10 "903 * Authentication successful")
+ (funcall expect 10 "This server is in debug mode")))))
+
+(ert-deftest erc-scenarios-sasl--plain-fail ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "sasl")
+ (erc-d-linger-secs 0.5)
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'plain-failed))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (erc-sasl-password "wrong")
+ (erc-sasl-mechanism 'plain)
+ (inhibit-message noninteractive)
+ (expect (erc-d-t-make-expecter))
+ (buf nil))
+
+ (ert-info ("Connect")
+ (setq buf (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :full-name "tester"))
+ (let ((err (should-error
+ (with-current-buffer buf
+ (funcall expect 20 "Connection failed!")))))
+ (should (string-search "please review" (cadr err)))
+ (with-current-buffer buf
+ (funcall expect 10 "Opening connection")
+ (funcall expect 20 "SASL authentication failed")
+ (should-not (erc-server-process-alive)))))))
+
+(defun erc-scenarios--common--sasl (mech)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "sasl")
+ (erc-d-linger-secs 0.5)
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t mech))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (erc-sasl-user :nick)
+ (erc-sasl-mechanism mech)
+ (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" ""))
+ (sasl-unique-id-function (lambda () (pop mock-rvs)))
+ (inhibit-message noninteractive)
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "jilles"
+ :password "sesame"
+ :full-name "jilles")
+ (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
+
+ (erc-d-t-wait-for 10 "server buffer ready" (get-buffer "jaguar"))
+
+ (ert-info ("Notices received")
+ (with-current-buffer "jaguar"
+ (funcall expect 10 "Found your hostname")
+ (funcall expect 20 "marked as being away")))))
+
+(ert-deftest erc-scenarios-sasl--scram-sha-1 ()
+ :tags '(:expensive-test)
+ (let ((erc-sasl-authzid "jilles"))
+ (erc-scenarios--common--sasl 'scram-sha-1)))
+
+(ert-deftest erc-scenarios-sasl--scram-sha-256 ()
+ :tags '(:expensive-test)
+ (unless (featurep 'sasl-scram-sha256)
+ (ert-skip "Emacs lacks sasl-scram-sha256"))
+ (erc-scenarios--common--sasl 'scram-sha-256))
+
+;;; erc-scenarios-sasl.el ends here
diff --git a/test/lisp/erc/resources/sasl/external.eld b/test/lisp/erc/resources/sasl/external.eld
new file mode 100644
index 0000000000..2cd237ec4d
--- /dev/null
+++ b/test/lisp/erc/resources/sasl/external.eld
@@ -0,0 +1,33 @@
+;; -*- mode: lisp-data; -*-
+((cap-req 10 "CAP REQ :sasl"))
+((nick 1 "NICK tester"))
+((user 1 "USER tester 0 * :tester"))
+
+((auth-req 3.2 "AUTHENTICATE EXTERNAL")
+ (0.0 ":irc.example.org CAP * ACK :sasl")
+ (0.0 "AUTHENTICATE +"))
+
+((auth-noop 3.2 "AUTHENTICATE +")
+ (0.0 ":irc.example.org 900 * * tester :You are now logged in as tester")
+ (0.0 ":irc.example.org 903 * :Authentication successful"))
+
+((cap-end 3.2 "CAP END")
+ (0.0 ":irc.example.org 001 tester :Welcome to the ExampleOrg IRC Network tester")
+ (0.01 ":irc.example.org 002 tester :Your host is irc.example.org, running version oragono-2.6.1")
+ (0.01 ":irc.example.org 003 tester :This server was created Sat, 17 Jul 2021 09:06:42 UTC")
+ (0.01 ":irc.example.org 004 tester irc.example.org oragono-2.6.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0.0 ":irc.example.org 005 tester AWAYLEN=200 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
+ (0.01 ":irc.example.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY :are supported by this server")
+ (0.01 ":irc.example.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
+ (0.0 ":irc.example.org 251 tester :There are 1 users and 0 invisible on 1 server(s)")
+ (0.0 ":irc.example.org 252 tester 0 :IRC Operators online")
+ (0.0 ":irc.example.org 253 tester 0 :unregistered connections")
+ (0.0 ":irc.example.org 254 tester 0 :channels formed")
+ (0.0 ":irc.example.org 255 tester :I have 1 clients and 0 servers")
+ (0.0 ":irc.example.org 265 tester 1 1 :Current local users 1, max 1")
+ (0.21 ":irc.example.org 266 tester 1 1 :Current global users 1, max 1")
+ (0.0 ":irc.example.org 422 tester :MOTD File is missing"))
+
+((mode-user 1.2 "MODE tester +i")
+ (0.0 ":irc.example.org 221 tester +Zi")
+ (0.0 ":irc.example.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
diff --git a/test/lisp/erc/resources/sasl/plain-failed.eld b/test/lisp/erc/resources/sasl/plain-failed.eld
new file mode 100644
index 0000000000..336700290c
--- /dev/null
+++ b/test/lisp/erc/resources/sasl/plain-failed.eld
@@ -0,0 +1,16 @@
+;; -*- mode: lisp-data; -*-
+((cap-req 10 "CAP REQ :sasl"))
+((nick 1 "NICK tester"))
+((user 1 "USER tester 0 * :tester")
+ (0.0 ":irc.foonet.org NOTICE * :*** Looking up your hostname...")
+ (0.0 ":irc.foonet.org NOTICE * :*** Found your hostname")
+ (0.0 ":irc.foonet.org CAP * ACK :cap-notify sasl"))
+
+((authenticate-plain 3.2 "AUTHENTICATE PLAIN")
+ (0.0 ":irc.foonet.org AUTHENTICATE +"))
+
+((authenticate-gimme 3.2 "AUTHENTICATE AHRlc3RlcgB3cm9uZw==")
+ (0.0 ":irc.foonet.org 900 * * tester :You are now logged in as tester")
+ (0.0 ":irc.foonet.org 904 * :SASL authentication failed: Invalid account credentials"))
+
+((cap-end 3.2 "CAP END"))
diff --git a/test/lisp/erc/resources/sasl/plain.eld b/test/lisp/erc/resources/sasl/plain.eld
new file mode 100644
index 0000000000..1341cd78e5
--- /dev/null
+++ b/test/lisp/erc/resources/sasl/plain.eld
@@ -0,0 +1,39 @@
+;; -*- mode: lisp-data; -*-
+((cap-req 10 "CAP REQ :sasl"))
+((nick 1 "NICK tester"))
+((user 1 "USER tester 0 * :tester")
+ (0.0 ":irc.example.org NOTICE * :*** Looking up your hostname...")
+ (0.0 ":irc.example.org NOTICE * :*** Found your hostname")
+ (0.0 ":irc.example.org CAP * ACK :sasl"))
+
+((authenticate-plain 3.2 "AUTHENTICATE PLAIN")
+ (0.0 ":irc.example.org AUTHENTICATE +"))
+
+((authenticate-gimme 3.2 "AUTHENTICATE AHRlc3RlcgBwYXNzd29yZDEyMw==")
+ (0.0 ":irc.example.org 900 * * tester :You are now logged in as tester")
+ (0.0 ":irc.example.org 903 * :Authentication successful"))
+
+((cap-end 3.2 "CAP END")
+ (0.0 ":irc.example.org 001 tester :Welcome to the ExampleOrg IRC Network tester")
+ (0.01 ":irc.example.org 002 tester :Your host is irc.example.org, running version oragono-2.6.1")
+ (0.01 ":irc.example.org 003 tester :This server was created Sat, 17 Jul 2021 09:06:42 UTC")
+ (0.01 ":irc.example.org 004 tester irc.example.org oragono-2.6.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0.0 ":irc.example.org 005 tester AWAYLEN=200 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
+ (0.01 ":irc.example.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY :are supported by this server")
+ (0.01 ":irc.example.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
+ (0.0 ":irc.example.org 251 tester :There are 1 users and 0 invisible on 1 server(s)")
+ (0.0 ":irc.example.org 252 tester 0 :IRC Operators online")
+ (0.0 ":irc.example.org 253 tester 0 :unregistered connections")
+ (0.0 ":irc.example.org 254 tester 0 :channels formed")
+ (0.0 ":irc.example.org 255 tester :I have 1 clients and 0 servers")
+ (0.0 ":irc.example.org 265 tester 1 1 :Current local users 1, max 1")
+ (0.21 ":irc.example.org 266 tester 1 1 :Current global users 1, max 1")
+ (0.0 ":irc.example.org 422 tester :MOTD File is missing"))
+
+((mode-user 1.2 "MODE tester +i")
+ (0.0 ":irc.example.org 221 tester +Zi")
+ (0.0 ":irc.example.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
+
+((quit 5 "QUIT :\2ERC\2")
+ (0 ":tester!~u@yuvqisyu7m7qs.irc QUIT :Quit"))
+((drop 1 DROP))
diff --git a/test/lisp/erc/resources/sasl/scram-sha-1.eld b/test/lisp/erc/resources/sasl/scram-sha-1.eld
new file mode 100644
index 0000000000..49980e9e12
--- /dev/null
+++ b/test/lisp/erc/resources/sasl/scram-sha-1.eld
@@ -0,0 +1,47 @@
+;;; -*- mode: lisp-data -*-
+((cap-req 5.2 "CAP REQ :sasl"))
+((nick 10 "NICK jilles"))
+((user 10 "USER user 0 * :jilles")
+ (0 "NOTICE AUTH :*** Processing connection to jaguar.test")
+ (0 "NOTICE AUTH :*** Looking up your hostname...")
+ (0 "NOTICE AUTH :*** Checking Ident")
+ (0 "NOTICE AUTH :*** No Ident response")
+ (0 "NOTICE AUTH :*** Found your hostname")
+ (0 ":jaguar.test CAP jilles ACK :sasl"))
+
+((auth-init 10 "AUTHENTICATE SCRAM-SHA-1")
+ (0 "AUTHENTICATE +"))
+
+((auth-challenge 10 "AUTHENTICATE bixhPWppbGxlcyxuPWppbGxlcyxyPWM1UnFMQ1p5MEw0ZkdrS0FaMGh1akZCcw==")
+ (0 "AUTHENTICATE cj1jNVJxTENaeTBMNGZHa0tBWjBodWpGQnNYUW9LY2l2cUN3OWlEWlBTcGIscz01bUpPNmQ0cmpDbnNCVTFYLGk9NDA5Ng=="))
+
+((auth-final 10 "AUTHENTICATE Yz1iaXhoUFdwcGJHeGxjeXc9LHI9YzVScUxDWnkwTDRmR2tLQVowaHVqRkJzWFFvS2NpdnFDdzlpRFpQU3BiLHA9T1ZVaGdQdTh3RW0yY0RvVkxmYUh6VlVZUFdVPQ==")
+ (0 "AUTHENTICATE dj1aV1IyM2M5TUppcjBaZ2ZHZjVqRXRMT242Tmc9"))
+
+((auth-done 10 "AUTHENTICATE +")
+ (0 ":jaguar.test 900 jilles jilles!jilles@localhost.stack.nl jilles :You are now logged in as jilles")
+ (0 ":jaguar.test 903 jilles :SASL authentication successful"))
+
+((cap-end 10.2 "CAP END")
+ (0 ":jaguar.test 001 jilles :Welcome to the jaguar IRC Network jilles!~jilles@127.0.0.1")
+ (0 ":jaguar.test 002 jilles :Your host is jaguar.test, running version InspIRCd-3")
+ (0 ":jaguar.test 003 jilles :This server was created 09:44:05 Dec 24 2020")
+ (0 ":jaguar.test 004 jilles jaguar.test InspIRCd-3 BILRSWcghiorswz ABEFHIJLMNOQRSTXYabcefghijklmnopqrstuvz :BEFHIJLXYabefghjkloqv")
+ (0 ":jaguar.test 005 jilles ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=rfc1459 CHANLIMIT=#:120 CHANMODES=IXbeg,k,BEFHJLfjl,AMNOQRSTcimnprstuz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server")
+ (0 ":jaguar.test 005 jilles EXTBAN=,ANOQRSTUacmnprz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=jaguar :are supported by this server")
+ (0 ":jaguar.test 005 jilles NICKLEN=31 PREFIX=(Yqaohv)!~&@%+ REMOVE SAFELIST SECURELIST=60 SILENCE=32 STATUSMSG=!~&@%+ TOPICLEN=307 UHNAMES USERIP USERLEN=11 USERMODES=,,s,BILRSWcghiorwz WATCH=30 :are supported by this server")
+ (0 ":jaguar.test 005 jilles :are supported by this server")
+ (0 ":jaguar.test 251 jilles :There are 740 users and 108 invisible on 11 servers")
+ (0 ":jaguar.test 252 jilles 10 :operator(s) online")
+ (0 ":jaguar.test 254 jilles 373 :channels formed")
+ (0 ":jaguar.test 255 jilles :I have 28 clients and 1 servers")
+ (0 ":jaguar.test 265 jilles :Current local users: 28 Max: 29")
+ (0 ":jaguar.test 266 jilles :Current global users: 848 Max: 879")
+ (0 ":jaguar.test 375 jilles :jaguar.test message of the day")
+ (0 ":jaguar.test 372 jilles : ~~ some message of the day ~~")
+ (0 ":jaguar.test 372 jilles : ~~ or rkpryyrag gb rnpu bgure ~~")
+ (0 ":jaguar.test 376 jilles :End of message of the day."))
+
+((mode-user 1.2 "MODE jilles +i")
+ (0 ":jilles!~jilles@127.0.0.1 MODE jilles :+ri")
+ (0 ":jaguar.test 306 jilles :You have been marked as being away"))
diff --git a/test/lisp/erc/resources/sasl/scram-sha-256.eld b/test/lisp/erc/resources/sasl/scram-sha-256.eld
new file mode 100644
index 0000000000..74de9a23ec
--- /dev/null
+++ b/test/lisp/erc/resources/sasl/scram-sha-256.eld
@@ -0,0 +1,47 @@
+;;; -*- mode: lisp-data -*-
+((cap-req 5.2 "CAP REQ :sasl"))
+((nick 10 "NICK jilles"))
+((user 10 "USER user 0 * :jilles")
+ (0 "NOTICE AUTH :*** Processing connection to jaguar.test")
+ (0 "NOTICE AUTH :*** Looking up your hostname...")
+ (0 "NOTICE AUTH :*** Checking Ident")
+ (0 "NOTICE AUTH :*** No Ident response")
+ (0 "NOTICE AUTH :*** Found your hostname")
+ (0 ":jaguar.test CAP jilles ACK :sasl"))
+
+((auth-init 10 "AUTHENTICATE SCRAM-SHA-256")
+ (0 "AUTHENTICATE +"))
+
+((auth-challenge 10 "AUTHENTICATE biwsbj1qaWxsZXMscj1jNVJxTENaeTBMNGZHa0tBWjBodWpGQnM=")
+ (0 "AUTHENTICATE cj1jNVJxTENaeTBMNGZHa0tBWjBodWpGQnNkNDA2N2YwYWZkYjU0YzNkYmQ0ZmU2NDViODRjYWUzNyxzPVpUZzFNbUUxWW1GaFpHSTFORGN5TWprM056WXdabVJqWkRNM1kySTFPVE09LGk9NDA5Ng=="))
+
+((auth-final 10 "AUTHENTICATE Yz1iaXdzLHI9YzVScUxDWnkwTDRmR2tLQVowaHVqRkJzZDQwNjdmMGFmZGI1NGMzZGJkNGZlNjQ1Yjg0Y2FlMzcscD1MUDRzakpyakpLcDVxVHNBUnlaQ3BwWHBLTHU0Rk1NMjg0aE5FU1B2R2hJPQ==")
+ (0 "AUTHENTICATE dj04NDdXWGZubVJlR3lFMXFscTFBbmQ2UjRiUEJOUk9UWjdFTVMvUXJKdFVNPQ=="))
+
+((auth-done 10 "AUTHENTICATE +")
+ (0 ":jaguar.test 900 jilles jilles!jilles@localhost.stack.nl jilles :You are now logged in as jilles")
+ (0 ":jaguar.test 903 jilles :SASL authentication successful"))
+
+((cap-end 10.2 "CAP END")
+ (0 ":jaguar.test 001 jilles :Welcome to the jaguar IRC Network jilles!~jilles@127.0.0.1")
+ (0 ":jaguar.test 002 jilles :Your host is jaguar.test, running version InspIRCd-3")
+ (0 ":jaguar.test 003 jilles :This server was created 09:44:05 Dec 24 2020")
+ (0 ":jaguar.test 004 jilles jaguar.test InspIRCd-3 BILRSWcghiorswz ABEFHIJLMNOQRSTXYabcefghijklmnopqrstuvz :BEFHIJLXYabefghjkloqv")
+ (0 ":jaguar.test 005 jilles ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=rfc1459 CHANLIMIT=#:120 CHANMODES=IXbeg,k,BEFHJLfjl,AMNOQRSTcimnprstuz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server")
+ (0 ":jaguar.test 005 jilles EXTBAN=,ANOQRSTUacmnprz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=jaguar :are supported by this server")
+ (0 ":jaguar.test 005 jilles NICKLEN=31 PREFIX=(Yqaohv)!~&@%+ REMOVE SAFELIST SECURELIST=60 SILENCE=32 STATUSMSG=!~&@%+ TOPICLEN=307 UHNAMES USERIP USERLEN=11 USERMODES=,,s,BILRSWcghiorwz WATCH=30 :are supported by this server")
+ (0 ":jaguar.test 005 jilles :are supported by this server")
+ (0 ":jaguar.test 251 jilles :There are 740 users and 108 invisible on 11 servers")
+ (0 ":jaguar.test 252 jilles 10 :operator(s) online")
+ (0 ":jaguar.test 254 jilles 373 :channels formed")
+ (0 ":jaguar.test 255 jilles :I have 28 clients and 1 servers")
+ (0 ":jaguar.test 265 jilles :Current local users: 28 Max: 29")
+ (0 ":jaguar.test 266 jilles :Current global users: 848 Max: 879")
+ (0 ":jaguar.test 375 jilles :jaguar.test message of the day")
+ (0 ":jaguar.test 372 jilles : ~~ some message of the day ~~")
+ (0 ":jaguar.test 372 jilles : ~~ or rkpryyrag gb rnpu bgure ~~")
+ (0 ":jaguar.test 376 jilles :End of message of the day."))
+
+((mode-user 1.2 "MODE jilles +i")
+ (0 ":jilles!~jilles@127.0.0.1 MODE jilles :+ri")
+ (0 ":jaguar.test 306 jilles :You have been marked as being away"))
--
2.38.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #8: 0006-Accept-functions-in-place-of-passwords-in-ERC.patch --]
[-- Type: text/x-patch, Size: 11519 bytes --]
From a06e72aca3f14d903f5716f844067d3a224919cd 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 6/6] 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 4061522259..7bf21087c6 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 dcbc732450..aabb6c8a51 100644
--- a/lisp/erc/erc-sasl.el
+++ b/lisp/erc/erc-sasl.el
@@ -143,7 +143,7 @@ erc-sasl--read-password
(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)
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 16e1533d07..60bfb909e0 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2310,6 +2310,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*.
@@ -2335,6 +2352,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))
@@ -3260,9 +3279,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."
@@ -3283,7 +3301,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."
@@ -6315,6 +6334,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"
@@ -6324,7 +6352,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 7ff2e36e77..2547c5e01a 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)
@@ -537,18 +543,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 fecd17b10e..8b8cfa152b 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
next prev parent reply other threads:[~2022-11-18 14:06 UTC|newest]
Thread overview: 54+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-11-01 20:07 bug#29108: 25.3; ERC SASL support Alex Branham
2017-11-10 2:24 ` Noam Postavsky
2019-10-23 9:24 ` Lars Ingebrigtsen
2019-10-23 10:34 ` Alex Branham
2019-10-23 11:19 ` Lars Ingebrigtsen
2019-10-23 12:19 ` Stefan Kangas
2019-10-23 12:57 ` Noam Postavsky
2019-10-23 13:32 ` Stefan Kangas
2019-11-02 14:10 ` Stefan Kangas
2020-08-03 9:39 ` Lars Ingebrigtsen
2021-07-28 16:59 ` Ulrich Mueller
2021-07-28 17:21 ` Eli Zaretskii
2021-07-28 22:42 ` J.P.
2021-08-09 9:59 ` J.P.
2021-08-09 10:22 ` Ulrich Mueller
2021-08-09 10:56 ` J.P.
2021-08-09 12:39 ` J.P.
2021-08-23 13:47 ` J.P.
[not found] ` <87o89oi87g.fsf@neverwas.me>
2021-08-23 14:01 ` Lars Ingebrigtsen
[not found] ` <87zgt8s1jt.fsf@gnus.org>
2021-08-24 13:42 ` J.P.
2022-09-18 18:32 ` bug#29108: [J.P.] Add "non-IRCv3" SASL to ERC J.P.
2022-09-20 6:07 ` bug#29108: 25.3; ERC SASL support J.P.
[not found] ` <875yhifujk.fsf_-_@neverwas.me>
2022-09-21 13:13 ` J.P.
2022-10-14 3:05 ` J.P.
[not found] ` <878rljxfxs.fsf@neverwas.me>
2022-10-26 13:14 ` J.P.
[not found] ` <87k04m4th8.fsf@neverwas.me>
2022-11-08 14:10 ` J.P.
[not found] ` <87o7thlepf.fsf@neverwas.me>
2022-11-09 4:08 ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-11-09 13:49 ` J.P.
[not found] ` <874jv81bn2.fsf@neverwas.me>
2022-11-09 17:50 ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
[not found] ` <87iljoqaor.fsf@disroot.org>
2022-11-10 5:28 ` J.P.
[not found] ` <87sfirml89.fsf@neverwas.me>
2022-11-10 18:04 ` Adam Porter
2022-11-10 21:50 ` J.P.
[not found] ` <87sfiq7a3j.fsf@neverwas.me>
2022-11-11 1:25 ` Adam Porter
2022-11-11 5:56 ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
[not found] ` <878rkighkn.fsf@disroot.org>
2022-11-14 22:29 ` Adam Porter
2022-11-11 5:51 ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-11-14 22:28 ` Adam Porter
2022-11-13 15:36 ` J.P.
[not found] ` <87o7taoohd.fsf@neverwas.me>
2022-11-14 6:45 ` J.P.
2022-11-14 15:20 ` J.P.
[not found] ` <87y1sdk1fg.fsf@neverwas.me>
2022-11-16 14:51 ` J.P.
[not found] ` <875yfflzps.fsf@neverwas.me>
2022-11-17 6:30 ` J.P.
[not found] ` <877czuks8k.fsf@neverwas.me>
2022-11-17 15:28 ` J.P.
2022-11-18 2:26 ` J.P.
[not found] ` <878rk9576b.fsf@neverwas.me>
2022-11-18 14:06 ` J.P. [this message]
[not found] ` <87leo8z79j.fsf@neverwas.me>
2022-11-19 14:48 ` J.P.
[not found] ` <87tu2vroeh.fsf@neverwas.me>
2022-11-20 14:29 ` J.P.
[not found] ` <87wn7pog1l.fsf@neverwas.me>
2022-11-21 15:09 ` J.P.
[not found] ` <87y1s4mjj6.fsf@neverwas.me>
2022-11-22 14:01 ` J.P.
[not found] ` <87r0xvks03.fsf@neverwas.me>
2022-11-24 2:49 ` Amin Bandali
[not found] ` <87r0xtnk24.fsf@gnu.org>
2022-11-25 14:43 ` J.P.
[not found] ` <87wn7jgkne.fsf@neverwas.me>
2022-11-28 0:08 ` J.P.
2022-11-29 5:19 ` Amin Bandali
[not found] ` <87iliyz6at.fsf@gnu.org>
2022-11-29 15:05 ` J.P.
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='87leo8z79j.fsf__10069.3227652059$1668780515$gmane$org@neverwas.me' \
--to=jp@neverwas.me \
--cc=29108@debbugs.gnu.org \
--cc=bandali@gnu.org \
--cc=emacs-erc@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).