;;; 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 (erc--unfun 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--29-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--29-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--29-sasl-scram-client-first-message
erc-sasl--scram-sha-1-client-final-message
sasl-scram-sha-1-authenticate-server)
("SCRAM-SHA-256"
erc-compat--29-sasl-scram-client-first-message
erc-sasl--scram-sha-256-client-final-message
sasl-scram-sha-256-authenticate-server)
("SCRAM-SHA-512"
erc-compat--29-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 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)))
(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 CAP 3.2-aware WIP implementation.
((unless erc--target
(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))))
((kill-local-variable 'erc-sasl--state)
(kill-local-variable 'erc-sasl--options))
'local)
(define-erc-response-handler (AUTHENTICATE)
"Begin or resume an SASL session." nil
(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)
(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 (erc--unfun (base64-encode-string data t))))
(erc-server-send (concat "AUTHENTICATE " (or data "+"))))))
(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 an 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-display-message parsed 'notice proc (erc-response.contents 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: