branch: elpa/jabber
commit e62a1ed061a712b089272880d74829fc451bcc4c
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
core: Reset encryption state on reconnect
---
lisp/jabber-core.el | 12 ++++++++----
tests/jabber-test-conn.el | 43 +++++++++++++++++++++++++++++++++++++++++++
2 files changed, 51 insertions(+), 4 deletions(-)
diff --git a/lisp/jabber-core.el b/lisp/jabber-core.el
index 201a1e8195..e114d26ee6 100644
--- a/lisp/jabber-core.el
+++ b/lisp/jabber-core.el
@@ -384,6 +384,11 @@ override the defaults from `jabber-account-list'."
(funcall connect-function fsm server network-server port))
(list state-data nil))
+(defun jabber-core--connected-state-data (state-data connection directtls-p)
+ "Update STATE-DATA for a new CONNECTION using DIRECTTLS-P."
+ (plist-put (plist-put state-data :connection connection)
+ :encrypted (and directtls-p t)))
+
(define-state jabber-connection :connecting
(fsm state-data event _callback)
(pcase (or (car-safe event) event)
@@ -391,10 +396,9 @@ override the defaults from `jabber-account-list'."
(let ((connection (cadr event))
(directtls-p (caddr event)))
- (setq state-data (plist-put state-data :connection
connection))
- ;; Direct TLS (XEP-0368): connection is already encrypted.
- (when directtls-p
- (setq state-data (plist-put state-data :encrypted t)))
+ (setq state-data
+ (jabber-core--connected-state-data
+ state-data connection directtls-p))
(when (processp connection)
;; TLS connections leave data in the process buffer, which
diff --git a/tests/jabber-test-conn.el b/tests/jabber-test-conn.el
index 087c4e4399..12b383270b 100644
--- a/tests/jabber-test-conn.el
+++ b/tests/jabber-test-conn.el
@@ -8,10 +8,53 @@
(require 'ert)
(require 'jabber-conn)
+(require 'jabber-core)
(defvar jabber-process-buffer)
(defvar jabber-debug-keep-process-buffers)
+;;; Connection state
+
+(defun jabber-test-conn--state-handler (state)
+ "Return the `jabber-connection' handler for STATE."
+ (gethash state (get 'jabber-connection :fsm-event)))
+
+(ert-deftest jabber-conn-test-ordinary-reconnect-clears-encryption ()
+ "An ordinary TCP reconnect clears encryption state from the old socket."
+ (let* ((connection 'new-connection)
+ (result (funcall (jabber-test-conn--state-handler :connecting)
+ 'fake-fsm '(:encrypted t)
+ (list :connected connection nil) #'ignore))
+ (state-data (cadr result)))
+ (should (eq (car result) :connected))
+ (should (eq (plist-get state-data :connection) connection))
+ (should-not (plist-get state-data :encrypted))))
+
+(ert-deftest jabber-conn-test-direct-tls-sets-encryption ()
+ "A direct TLS connection records that its socket is encrypted."
+ (let* ((connection 'new-connection)
+ (result (funcall (jabber-test-conn--state-handler :connecting)
+ 'fake-fsm '(:encrypted nil)
+ (list :connected connection t) #'ignore))
+ (state-data (cadr result)))
+ (should (eq (car result) :connected))
+ (should (eq (plist-get state-data :connection) connection))
+ (should (eq (plist-get state-data :encrypted) t))))
+
+(ert-deftest jabber-conn-test-reconnect-selects-starttls ()
+ "An ordinary reconnect negotiates advertised STARTTLS."
+ (let* ((connect-result
+ (funcall (jabber-test-conn--state-handler :connecting)
+ 'fake-fsm '(:connection-type starttls :encrypted t)
+ '(:connected new-connection nil) #'ignore))
+ (features
+ `(features nil (starttls ((xmlns . ,jabber-tls-xmlns)))))
+ (result
+ (funcall (jabber-test-conn--state-handler :connected)
+ 'fake-fsm (cadr connect-result)
+ (list :stanza features) #'ignore)))
+ (should (eq (car result) :starttls))))
+
;;; Failed async connection cleanup
(ert-deftest jabber-conn-test-failed-target-kills-process-buffer ()
