;;; 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 . ;;; 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 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: