From b2e7df6b097b4b203860189dd59219909959c016 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 19 Sep 2022 22:55:25 -0700 Subject: [PATCH 0/4] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (4): Add GS2 authorization to sasl-scram-rfc Support local ERC modules in erc-mode buffers Make erc-login generic Add non-IRCv3 SASL module to ERC lisp/erc/erc-backend.el | 8 +- lisp/erc/erc-compat.el | 104 ++++ lisp/erc/erc-sasl.el | 477 ++++++++++++++++++ lisp/erc/erc.el | 108 ++-- lisp/net/sasl-scram-rfc.el | 21 +- test/lisp/erc/erc-sasl-tests.el | 299 +++++++++++ test/lisp/erc/erc-scenarios-sasl.el | 161 ++++++ test/lisp/erc/erc-tests.el | 47 ++ test/lisp/erc/resources/sasl/external.eld | 33 ++ test/lisp/erc/resources/sasl/plain-failed.eld | 16 + test/lisp/erc/resources/sasl/plain.eld | 35 ++ test/lisp/erc/resources/sasl/scram-sha-1.eld | 47 ++ .../lisp/erc/resources/sasl/scram-sha-256.eld | 47 ++ 13 files changed, 1358 insertions(+), 45 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/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 8ba061d5ac..3123f64b88 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -167,25 +167,46 @@ erc-subseq (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. +;; 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, advising `base64-encode-string' won't work +;; because the byte compiler precomputes the result when all inputs +;; are constants, as they are in the unpatched version. +;; ;; The only other substantial change is the addition of authz support. -;; If adopted by Emacs 29, this can dropped when ERC no longer -;; supports Emacs 28. Unfortunately, advising `base64-encode-string' -;; won't work because the byte compiler precomputes the result when -;; all inputs are constants, as they are in the unpatched version. -;; Changes from the latter are marked with a "; *n", comment below. -;; See older versions of lisp/erc/erc-sasl.el if needing a +;; 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--scram--client-final-message +(defun erc-compat--sasl-scram--client-final-message (hash-fun block-length hash-length client step) (unless (string-match "^r=\\([^,]+\\),s=\\([^,]+\\),i=\\([0-9]+\\)\\(?:$\\|,\\)" @@ -202,7 +223,7 @@ erc-compat--scram--client-final-message (c-nonce (sasl-client-property client 'c-nonce)) (cbind-input (if (string-prefix-p c-nonce nonce) - (or (sasl-client-property client 'gs2-header) "n,,") ; *1 + (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 diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el index 6cd9a928d8..bd27934125 100644 --- a/lisp/erc/erc-sasl.el +++ b/lisp/erc/erc-sasl.el @@ -162,11 +162,11 @@ erc-sasl-ecdsa-private-key "Private signing key file for ECDSA-NIST256P-CHALLENGE." :type '(choice (const nil) string)) -(defcustom erc-sasl-scram-authzid-function nil - "Function for retrieving authorization for SCRAM GSS-API header. -Passed current SASL client object as the sole argument (see -function `sasl-make-client')." - :type '(choice (const nil) function)) +(defcustom erc-sasl-authzid nil + "SASL authorization identity. +Generally unneeded for normal use. Some test frameworks and +aberrant servers may want this to match `erc-sasl-user'." + :type '(choice (const nil) string)) ;; Analogous to what erc-backend does to persist opening params. @@ -205,17 +205,7 @@ erc-sasl--plain-response (let ((sasl-read-passphrase #'erc-sasl--read-password)) (sasl-plain-response client steps))) -(defun erc-sasl--scram-client-first-message (client _step) - "Prepare CLIENT's first message." - (let* ((c-nonce (sasl-unique-id)) - (fn (alist-get 'scram-authzid-function erc-sasl--options)) - (authzid (and fn (concat "a=" (funcall fn client)))) - (gs2-header (concat "n," authzid ","))) - (sasl-client-set-property client 'c-nonce c-nonce) - (sasl-client-set-property client 'gs2-header gs2-header) - (concat gs2-header (sasl-scram--client-first-message-bare client)))) - -(declare-function erc-compat--scram--client-final-message "erc-compat" +(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) @@ -226,7 +216,7 @@ erc-sasl--scram-sha-hack-client-final-message ;; `sasl-scram--client-final-message' directly (require 'erc-compat) (let ((sasl-read-passphrase #'erc-sasl--read-password)) - (apply #'erc-compat--scram--client-final-message args))) + (apply #'erc-compat--sasl-scram--client-final-message args))) (defun erc-sasl--scram-sha-1-client-final-message (client step) "Prepare CLIENT's final message with STEP." @@ -278,15 +268,15 @@ erc-sasl--ecdsa-sign ("EXTERNAL" ignore) ("SCRAM-SHA-1" - erc-sasl--scram-client-first-message + 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-sasl--scram-client-first-message + 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-sasl--scram-client-first-message + 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" @@ -301,13 +291,17 @@ erc-sasl--create-client (let ((sasl-mechanism-alist (copy-sequence sasl-mechanism-alist)) (sasl-mechanisms sasl-mechanisms) (name (upcase (symbol-name mechanism))) - (feature (intern (concat "erc-sasl-" (symbol-name mechanism))))) + (feature (intern (concat "erc-sasl-" (symbol-name mechanism)))) + client) (setf (alist-get name sasl-mechanism-alist nil nil #'equal) `(,feature)) (cl-pushnew name sasl-mechanisms :test #'equal) - (sasl-make-client (sasl-find-mechanism `(,name)) - (or (alist-get 'user erc-sasl--options) - (erc-downcase (erc-current-nick))) - "N/A" "N/A"))) + (setq client (sasl-make-client (sasl-find-mechanism `(,name)) + (or (alist-get 'user erc-sasl--options) + (erc-downcase (erc-current-nick))) + "N/A" "N/A")) + (sasl-client-set-property client 'authenticator-name + (alist-get 'authzid erc-sasl--options)) + client)) ;; Oragono doesn't like when authzid (if present) does not match ;; the authcid. TODO see if this still true. @@ -328,7 +322,8 @@ erc-sasl--create-client (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 authc) + (sasl-client-set-property client 'authenticator-name + (alist-get 'authzid erc-sasl--options)) client)) (cl-defmethod erc-sasl--create-client ((m (eql scram-sha-256))) @@ -359,8 +354,7 @@ erc-sasl--init (password . ,erc-sasl-password) (mechanism . ,erc-sasl-mechanism) (ecdsa-private-key . ,erc-sasl-ecdsa-private-key) - (scram-authzid-function - . ,erc-sasl-scram-authzid-function)))) + (authzid . ,erc-sasl-authzid)))) (defun erc-sasl--mechanism-offered-p (offered) "Non-nil when mechanism OFFERED by server." 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))) diff --git a/test/lisp/erc/erc-sasl-tests.el b/test/lisp/erc/erc-sasl-tests.el index 5171a5d6b8..beac287a6e 100644 --- a/test/lisp/erc/erc-sasl-tests.el +++ b/test/lisp/erc/erc-sasl-tests.el @@ -109,15 +109,16 @@ erc-sasl-create-client--external (ert-deftest erc-sasl-create-client--scram-sha-1 () (let* ((erc-server-current-nick "jilles") (erc-session-password "sesame") - (erc-sasl--options '((scram-authzid-function . sasl-client-name))) + (erc-sasl--options '((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-sasl--scram-client-first-message - ,req]) + (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") @@ -146,15 +147,16 @@ 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 '((scram-authzid-function . sasl-client-name))) + (erc-sasl--options '((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-sasl--scram-client-first-message - ,req]) + (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") @@ -191,8 +193,9 @@ erc-sasl-create-client--scram-sha-256--no-authzid (step (sasl-next-step client nil))) (ert-info ("Client's initial request") (let ((req "n,,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs")) - (should (equal (format "%S" `[erc-sasl--scram-client-first-message - ,req]) + (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") @@ -229,8 +232,9 @@ erc-sasl-create-client--scram-sha-512--no-authzid (step (sasl-next-step client nil))) (ert-info ("Client's initial request") (let ((req "n,,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs")) - (should (equal (format "%S" `[erc-sasl--scram-client-first-message - ,req]) + (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") diff --git a/test/lisp/erc/erc-scenarios-sasl.el b/test/lisp/erc/erc-scenarios-sasl.el index b4f926b54c..3ff7cc805d 100644 --- a/test/lisp/erc/erc-scenarios-sasl.el +++ b/test/lisp/erc/erc-scenarios-sasl.el @@ -118,7 +118,7 @@ erc-scenarios-sasl--plain-fail (funcall expect 20 "SASL authentication failed") (should-not (erc-server-process-alive))))))) -(defun erc-scenarios--common--sasl (mech zfunc) +(defun erc-scenarios--common--sasl (mech) (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "sasl") (erc-d-linger-secs 0.5) @@ -126,7 +126,6 @@ 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-scram-authzid-function zfunc) (erc-sasl-password "sesame") (erc-sasl-mechanism mech) (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" "")) @@ -150,12 +149,13 @@ erc-scenarios--common--sasl (ert-deftest erc-scenarios-sasl--scram-sha-1 () :tags '(:expensive-test) - (erc-scenarios--common--sasl 'scram-sha-1 #'sasl-client-name)) + (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 nil)) + (erc-scenarios--common--sasl 'scram-sha-256)) ;;; erc-scenarios-sasl.el ends here -- 2.37.2