branch: elpa/jabber
commit 7fde8db5e5ec6a9958c436ff19fdea6d43ffbda1
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
srv: Add XEP-0368 direct TLS support
Query both _xmpps-client._tcp and _xmpp-client._tcp SRV records,
merge by priority and weight per RFC 2782. Direct TLS targets use
make-network-process with :tls-parameters for TLS-on-connect with
SNI. The FSM skips STARTTLS when already encrypted.
Includes per-target connection timeout, always-append domain:5222
fallback, jabber-direct-tls-lookup defcustom, and 17 unit tests.
---
doap.xml | 9 ++
lisp/jabber-conn.el | 194 ++++++++++++++++++++++++++-------------
lisp/jabber-core.el | 9 +-
lisp/jabber-srv.el | 91 ++++++++++++++++---
tests/jabber-srv-tests.el | 224 ++++++++++++++++++++++++++++++++++++++++++++++
5 files changed, 451 insertions(+), 76 deletions(-)
diff --git a/doap.xml b/doap.xml
index 58a4b4cbbb..8e85ad132e 100644
--- a/doap.xml
+++ b/doap.xml
@@ -464,6 +464,15 @@
<xmpp:since>0.8.0</xmpp:since>
</xmpp:SupportedXep>
</implements>
+ <implements>
+ <xmpp:SupportedXep>
+ <xmpp:xep rdf:resource="https://xmpp.org/extensions/xep-0368.html"/>
+ <xmpp:status>complete</xmpp:status>
+ <xmpp:version>1.1.0</xmpp:version>
+ <xmpp:since>0.10.1-alpha</xmpp:since>
+ <xmpp:note>ALPN not supported (Emacs GnuTLS bindings lack ALPN API).
Servers multiplexing on port 443 that require ALPN will fall through to
STARTTLS targets.</xmpp:note>
+ </xmpp:SupportedXep>
+ </implements>
<implements>
<xmpp:SupportedXep>
<xmpp:xep rdf:resource="https://xmpp.org/extensions/xep-0373.html"/>
diff --git a/lisp/jabber-conn.el b/lisp/jabber-conn.el
index d8ffd67197..bf27e69dcb 100644
--- a/lisp/jabber-conn.el
+++ b/lisp/jabber-conn.el
@@ -72,6 +72,15 @@ of your JID.
This option has effect only when using native GnuTLS."
:type '(repeat string))
+(defcustom jabber-direct-tls-lookup t
+ "Whether to query _xmpps-client SRV records for direct TLS.
+When non-nil, `jabber-srv-targets' queries both _xmpps-client._tcp
+and _xmpp-client._tcp SRV records per XEP-0368, merging them by
+priority and weight. Direct TLS targets use TLS-on-connect without
+a STARTTLS upgrade."
+ :type 'boolean
+ :group 'jabber-conn)
+
(defvar jabber-connect-methods
'((network jabber-network-connect jabber-network-send)
(starttls jabber-network-connect jabber-network-send)
@@ -108,17 +117,27 @@ TYPE is a symbol; see `jabber-connection-type'."
(nth 2 entry)))
(defun jabber-srv-targets (server network-server port)
- "Find host and port to connect to.
-If NETWORK-SERVER and/or PORT are specified, use them.
-If we can't find SRV records, use standard defaults."
- ;; If the user has specified a host or a port, obey that.
+ "Find connection targets for SERVER.
+If NETWORK-SERVER and/or PORT are specified, use them (always STARTTLS).
+Otherwise query SRV records; when `jabber-direct-tls-lookup' is non-nil,
+query both _xmpps-client and _xmpp-client per XEP-0368.
+
+Returns a list of (HOST PORT DIRECTTLS-P) where DIRECTTLS-P is
+non-nil for direct TLS targets."
(if (or network-server port)
- (list (cons (or network-server server)
- (or port 5222)))
+ ;; User override: cannot assume direct TLS without SRV.
+ (list (list (or network-server server)
+ (or port 5222)
+ nil))
(or (condition-case nil
- (jabber-srv-lookup (concat "_xmpp-client._tcp." server))
+ (if jabber-direct-tls-lookup
+ (jabber-srv-lookup-mixed server)
+ (mapcar (lambda (pair)
+ (list (car pair) (cdr pair) nil))
+ (jabber-srv-lookup
+ (concat "_xmpp-client._tcp." server))))
(error nil))
- (list (cons server 5222)))))
+ (list (list server 5222 nil)))))
;; Plain TCP/IP connection
(defun jabber-network-connect (fsm server network-server port)
@@ -128,6 +147,39 @@ connection succeeds. Send a message (:connection-failed
ERRORS) if
connection fails."
(jabber-network-connect-async fsm server network-server port))
+(defun jabber-conn--tls-parameters (server)
+ "Build :tls-parameters for direct TLS to SERVER.
+SERVER is the JID domain, used for SNI and certificate verification."
+ (let ((verifyp (not (member server jabber-invalid-certificate-servers))))
+ (cons 'gnutls-x509pki
+ (gnutls-boot-parameters
+ :type 'gnutls-x509pki
+ :hostname server
+ :verify-hostname-error verifyp
+ :verify-error verifyp))))
+
+(defcustom jabber-connection-timeout 30
+ "Seconds to wait for each connection target before trying the next.
+Set to nil to disable the per-target timeout and rely on the OS
+TCP timeout instead."
+ :type '(choice (integer :tag "Seconds")
+ (const :tag "No timeout" nil))
+ :group 'jabber-conn)
+
+(defun jabber-conn--make-process (host port buffer directtls-p server)
+ "Create a network process connecting to HOST:PORT in BUFFER.
+When DIRECTTLS-P is non-nil, use TLS-on-connect with SNI for SERVER."
+ (let ((args (list :name "jabber"
+ :buffer buffer
+ :host host :service port
+ :coding 'utf-8
+ :nowait t)))
+ (when directtls-p
+ (setq args (nconc args
+ (list :tls-parameters
+ (jabber-conn--tls-parameters server)))))
+ (apply #'make-network-process args)))
+
(defun jabber-network-connect-async (fsm server network-server port)
;; Get all potential targets...
(let ((targets (jabber-srv-targets server network-server port))
@@ -137,59 +189,79 @@ connection fails."
(cl-labels
((connect
(target remaining-targets)
- (cl-labels ((connection-successful
- (c)
- ;; This mustn't be `fsm-send-sync', because the FSM
- ;; needs to change the sentinel, which cannot be done
- ;; from inside the sentinel.
- (fsm-send fsm (list :connected c)))
- (connection-failed
- (c status)
- (when (and (> (length status) 0)
- (eq (aref status (1- (length status))) ?\n))
- (setq status (substring status 0 -1)))
- (let ((err
- (format "Couldn't connect to %s:%s: %s"
- (car target) (cdr target) status)))
- (message "%s" err)
- (push err errors))
- (when c (delete-process c))
- (if remaining-targets
- (progn
- (message
- "Connecting to %s:%s..."
- (caar remaining-targets) (cdar
remaining-targets))
- (connect (car remaining-targets) (cdr
remaining-targets)))
- (fsm-send fsm (list :connection-failed (nreverse
errors))))))
- (condition-case e
- (make-network-process
- :name "jabber"
- :buffer (generate-new-buffer jabber-process-buffer)
- :host (car target) :service (cdr target)
- :coding 'utf-8
- :nowait t
- :sentinel
- (lambda (connection status)
- (cond
- ((string-match "^open" status)
- (connection-successful connection))
- ((string-match "^failed" status)
- (connection-failed connection status))
- ((string-match "^deleted" status)
- ;; This happens when we delete a process in the
- ;; "failed" case above.
- nil)
- (t
- (message "Unknown sentinel status `%s'" status)))))
- (file-error
- ;; A file-error has the error message in the third list
- ;; element.
- (connection-failed nil (car (cddr e))))
- (error
- ;; Not sure if we ever get anything but file-errors,
- ;; but let's make sure we report them:
- (connection-failed nil (error-message-string e)))))))
- (message "Connecting to %s:%s..." (caar targets) (cdar targets))
+ (let ((host (nth 0 target))
+ (svc (nth 1 target))
+ (directtls-p (nth 2 target))
+ (timeout-timer nil)
+ (settled nil))
+ (cl-labels ((cancel-timeout
+ ()
+ (when timeout-timer
+ (cancel-timer timeout-timer)
+ (setq timeout-timer nil)))
+ (connection-successful
+ (c)
+ (unless settled
+ (setq settled t)
+ (cancel-timeout)
+ ;; This mustn't be `fsm-send-sync', because the FSM
+ ;; needs to change the sentinel, which cannot be
done
+ ;; from inside the sentinel.
+ (fsm-send fsm (list :connected c directtls-p))))
+ (connection-failed
+ (c status)
+ (unless settled
+ (setq settled t)
+ (cancel-timeout)
+ (when (and (> (length status) 0)
+ (eq (aref status (1- (length status)))
?\n))
+ (setq status (substring status 0 -1)))
+ (let ((err
+ (format "Couldn't connect to %s:%s: %s"
+ host svc status)))
+ (message "%s" err)
+ (push err errors))
+ (when c (delete-process c))
+ (if remaining-targets
+ (progn
+ (message
+ "Connecting to %s:%s..."
+ (nth 0 (car remaining-targets))
+ (nth 1 (car remaining-targets)))
+ (connect (car remaining-targets)
+ (cdr remaining-targets)))
+ (fsm-send fsm (list :connection-failed
+ (nreverse errors)))))))
+ (condition-case e
+ (let ((proc (jabber-conn--make-process
+ host svc
+ (generate-new-buffer jabber-process-buffer)
+ directtls-p server)))
+ (set-process-sentinel
+ proc
+ (lambda (connection status)
+ (cond
+ ((string-match "^open" status)
+ (connection-successful connection))
+ ((string-match "^failed" status)
+ (connection-failed connection status))
+ ((string-match "^deleted" status)
+ nil)
+ (t
+ (message "Unknown sentinel status `%s'" status)))))
+ (when jabber-connection-timeout
+ (setq timeout-timer
+ (run-at-time
+ jabber-connection-timeout nil
+ (lambda ()
+ (connection-failed
+ proc "connection timed out"))))))
+ (file-error
+ (connection-failed nil (car (cddr e))))
+ (error
+ (connection-failed nil (error-message-string e))))))))
+ (message "Connecting to %s:%s..."
+ (nth 0 (car targets)) (nth 1 (car targets)))
(connect (car targets) (cdr targets)))))
(defun jabber-network-send (connection string)
diff --git a/lisp/jabber-core.el b/lisp/jabber-core.el
index 3be00428a7..37a3c08ef1 100644
--- a/lisp/jabber-core.el
+++ b/lisp/jabber-core.el
@@ -437,9 +437,12 @@ With double prefix argument, specify more connection
details."
(pcase (or (car-safe event) event)
(:connected
(let ((connection (cadr event))
- ) ;; (registerp (plist-get state-data :registerp))
+ (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)))
(when (processp connection)
;; TLS connections leave data in the process buffer, which
@@ -535,7 +538,9 @@ With double prefix argument, specify more connection
details."
:disconnection-reason
(format "Unexpected stanza %s" stanza))))
((and (jabber-xml-get-children stanza 'starttls)
- (eq (plist-get state-data :connection-type) 'starttls))
+ (eq (plist-get state-data :connection-type) 'starttls)
+ ;; XEP-0368: STARTTLS MUST NOT be used over direct TLS.
+ (not (plist-get state-data :encrypted)))
(list :starttls state-data))
;; XXX: require encryption for registration?
((plist-get state-data :registerp)
diff --git a/lisp/jabber-srv.el b/lisp/jabber-srv.el
index a729568203..0552bcb48d 100644
--- a/lisp/jabber-srv.el
+++ b/lisp/jabber-srv.el
@@ -94,6 +94,79 @@ Returns the entries reordered by weighted random selection."
(setq weight-order (delq next weight-order))))
(nreverse result)))
+(defun jabber-srv--fetch-answers (target)
+ "Perform DNS SRV query for TARGET and return parsed answer records.
+Returns a list of alists, each containing priority, weight, port,
+and target entries. Returns nil if no records found, or `:dot' if
+the single-dot target (\"service not available\") was returned."
+ (let* ((result (jabber-srv--dns-query target))
+ (answers (mapcar (lambda (a) (cadr (assq 'data a)))
+ (cadr (assq 'answers result)))))
+ (cond
+ ((null answers) nil)
+ ((and (length= answers 1)
+ (string= (cadr (assq 'target (car answers))) "."))
+ :dot)
+ (t answers))))
+
+(defun jabber-srv--sort-answers (answers)
+ "Sort ANSWERS by priority with weighted randomization per RFC 2782.
+ANSWERS is a list of alists as returned by `jabber-srv--fetch-answers'.
+Returns the entries in connection-attempt order."
+ (let (ordered)
+ (dolist (group (jabber-srv--group-by-priority answers))
+ (setq ordered (nconc ordered
+ (jabber-srv--weighted-select (cdr group)))))
+ ordered))
+
+(defun jabber-srv--tag-answers (answers directtls-p)
+ "Tag each record in ANSWERS with DIRECTTLS-P flag.
+Adds a (directtls DIRECTTLS-P) entry to each alist so the flag
+survives the priority/weight sort pipeline."
+ (mapcar (lambda (a) (cons (list 'directtls directtls-p) a))
+ answers))
+
+(defun jabber-srv--has-fallback-p (targets server)
+ "Return non-nil if TARGETS already includes SERVER on port 5222 via
STARTTLS."
+ (cl-some (lambda (t_)
+ (and (string= (nth 0 t_) server)
+ (= (nth 1 t_) 5222)
+ (not (nth 2 t_))))
+ targets))
+
+;;;###autoload
+(defun jabber-srv-lookup-mixed (server)
+ "Query both _xmpps-client and _xmpp-client SRV records for SERVER.
+Merges results by priority and weight per RFC 2782. Returns a list
+of (HOST PORT DIRECTTLS-P) where DIRECTTLS-P is non-nil for targets
+from _xmpps-client._tcp (XEP-0368 direct TLS).
+
+Always appends SERVER:5222 STARTTLS as a lowest-priority fallback
+unless the SRV results already include it."
+ (let ((xmpps (condition-case nil
+ (jabber-srv--fetch-answers
+ (concat "_xmpps-client._tcp." server))
+ (error nil)))
+ (xmpp (condition-case nil
+ (jabber-srv--fetch-answers
+ (concat "_xmpp-client._tcp." server))
+ (error nil))))
+ ;; :dot means "service explicitly unavailable"
+ (when (eq xmpps :dot) (setq xmpps nil))
+ (when (eq xmpp :dot) (setq xmpp nil))
+ (let ((merged (nconc (jabber-srv--tag-answers xmpps t)
+ (jabber-srv--tag-answers xmpp nil))))
+ (when merged
+ (let ((result (mapcar (lambda (a)
+ (list (cadr (assq 'target a))
+ (cadr (assq 'port a))
+ (cadr (assq 'directtls a))))
+ (jabber-srv--sort-answers merged))))
+ ;; Append domain:5222 STARTTLS fallback if not already present.
+ (unless (jabber-srv--has-fallback-p result server)
+ (setq result (nconc result (list (list server 5222 nil)))))
+ result)))))
+
;;;###autoload
(defun jabber-srv-lookup (target)
"Perform SRV lookup of TARGET and return connection candidates.
@@ -102,19 +175,11 @@ TARGET is a string of the form \"_Service._Proto.Name\".
Returns a list of (HOST . PORT) pairs sorted by priority with
weighted randomization per RFC 2782. The caller should attempt
connections in order. Returns nil if no SRV records were found."
- (let* ((result (jabber-srv--dns-query target))
- (answers (mapcar (lambda (a) (cadr (assq 'data a)))
- (cadr (assq 'answers result)))))
- (when (and answers
- (not (and (length= answers 1)
- (string= (cadr (assq 'target (car answers))) "."))))
- (let (ordered)
- (dolist (group (jabber-srv--group-by-priority answers))
- (setq ordered (nconc ordered
- (jabber-srv--weighted-select (cdr group)))))
- (mapcar (lambda (a) (cons (cadr (assq 'target a))
- (cadr (assq 'port a))))
- ordered)))))
+ (let ((answers (jabber-srv--fetch-answers target)))
+ (when (and answers (not (eq answers :dot)))
+ (mapcar (lambda (a) (cons (cadr (assq 'target a))
+ (cadr (assq 'port a))))
+ (jabber-srv--sort-answers answers)))))
(provide 'jabber-srv)
diff --git a/tests/jabber-srv-tests.el b/tests/jabber-srv-tests.el
new file mode 100644
index 0000000000..a95aabb4f7
--- /dev/null
+++ b/tests/jabber-srv-tests.el
@@ -0,0 +1,224 @@
+;;; jabber-srv-tests.el --- Tests for jabber-srv -*- lexical-binding: t; -*-
+
+(require 'ert)
+(require 'jabber-srv)
+(require 'jabber-conn)
+
+;;; Test data helpers
+
+(defun jabber-srv-test--make-answer (priority weight port target)
+ "Build an SRV answer alist."
+ (list (list 'priority priority)
+ (list 'weight weight)
+ (list 'port port)
+ (list 'target target)))
+
+;;; Group by priority
+
+(ert-deftest jabber-srv-test-group-by-priority-single ()
+ "Single priority group."
+ (let* ((a1 (jabber-srv-test--make-answer 10 50 5222 "a.example.com"))
+ (a2 (jabber-srv-test--make-answer 10 50 5222 "b.example.com"))
+ (groups (jabber-srv--group-by-priority (list a1 a2))))
+ (should (= (length groups) 1))
+ (should (= (caar groups) 10))
+ (should (= (length (cdar groups)) 2))))
+
+(ert-deftest jabber-srv-test-group-by-priority-multiple ()
+ "Multiple priority groups sorted lowest first."
+ (let* ((a1 (jabber-srv-test--make-answer 20 50 5222 "low.example.com"))
+ (a2 (jabber-srv-test--make-answer 5 50 5222 "high.example.com"))
+ (a3 (jabber-srv-test--make-answer 20 50 5223 "low2.example.com"))
+ (groups (jabber-srv--group-by-priority (list a1 a2 a3))))
+ (should (= (length groups) 2))
+ (should (= (caar groups) 5))
+ (should (= (caadr groups) 20))
+ (should (= (length (cdadr groups)) 2))))
+
+;;; Sort answers
+
+(ert-deftest jabber-srv-test-sort-answers-preserves-all ()
+ "Sort preserves all elements."
+ (let* ((a1 (jabber-srv-test--make-answer 10 50 5222 "a.example.com"))
+ (a2 (jabber-srv-test--make-answer 20 50 5222 "b.example.com"))
+ (a3 (jabber-srv-test--make-answer 10 50 5223 "c.example.com"))
+ (sorted (jabber-srv--sort-answers (list a1 a2 a3))))
+ (should (= (length sorted) 3))
+ ;; Priority 10 entries come before priority 20
+ (let ((targets (mapcar (lambda (a) (cadr (assq 'target a))) sorted)))
+ (should (member "a.example.com" targets))
+ (should (member "b.example.com" targets))
+ (should (member "c.example.com" targets))
+ ;; b.example.com (priority 20) must be last
+ (should (string= (nth 2 targets) "b.example.com")))))
+
+;;; Fetch answers
+
+(ert-deftest jabber-srv-test-fetch-answers-nil ()
+ "No DNS results returns nil."
+ (cl-letf (((symbol-function 'jabber-srv--dns-query)
+ (lambda (_target)
+ '((answers nil)))))
+ (should (null (jabber-srv--fetch-answers
"_xmpp-client._tcp.example.com")))))
+
+(ert-deftest jabber-srv-test-fetch-answers-dot ()
+ "Single dot target returns :dot."
+ (cl-letf (((symbol-function 'jabber-srv--dns-query)
+ (lambda (_target)
+ `((answers
+ (((data ((priority 0) (weight 0) (port 0) (target
"."))))))))))
+ (should (eq :dot (jabber-srv--fetch-answers
+ "_xmpp-client._tcp.example.com")))))
+
+(ert-deftest jabber-srv-test-fetch-answers-records ()
+ "Normal records returned as list."
+ (cl-letf (((symbol-function 'jabber-srv--dns-query)
+ (lambda (_target)
+ `((answers
+ (((data ((priority 10) (weight 50) (port 5222)
+ (target "xmpp.example.com"))))))))))
+ (let ((result (jabber-srv--fetch-answers "_xmpp-client._tcp.example.com")))
+ (should (listp result))
+ (should (= (length result) 1))
+ (should (string= (cadr (assq 'target (car result)))
+ "xmpp.example.com")))))
+
+;;; Lookup mixed
+
+(defun jabber-srv-test--mock-fetch (xmpps-answers xmpp-answers)
+ "Return a mock for `jabber-srv--fetch-answers'.
+XMPPS-ANSWERS is returned for _xmpps queries, XMPP-ANSWERS for _xmpp."
+ (lambda (target)
+ (cond
+ ((string-match "^_xmpps-client" target) xmpps-answers)
+ ((string-match "^_xmpp-client" target) xmpp-answers))))
+
+(ert-deftest jabber-srv-test-lookup-mixed-both ()
+ "Both services return records, merged by priority, with fallback appended."
+ (cl-letf (((symbol-function 'jabber-srv--fetch-answers)
+ (jabber-srv-test--mock-fetch
+ (list (jabber-srv-test--make-answer 5 50 443 "tls.example.com"))
+ (list (jabber-srv-test--make-answer 10 50 5222
"plain.example.com")))))
+ (let ((result (jabber-srv-lookup-mixed "example.com")))
+ ;; 2 SRV records + 1 fallback
+ (should (= (length result) 3))
+ ;; Priority 5 (direct TLS) comes first
+ (should (string= (nth 0 (car result)) "tls.example.com"))
+ (should (= (nth 1 (car result)) 443))
+ (should (nth 2 (car result)))
+ ;; Priority 10 (STARTTLS) comes second
+ (should (string= (nth 0 (cadr result)) "plain.example.com"))
+ (should (= (nth 1 (cadr result)) 5222))
+ (should-not (nth 2 (cadr result)))
+ ;; Fallback: example.com:5222 STARTTLS at the end
+ (let ((last (car (last result))))
+ (should (string= (nth 0 last) "example.com"))
+ (should (= (nth 1 last) 5222))
+ (should-not (nth 2 last))))))
+
+(ert-deftest jabber-srv-test-lookup-mixed-only-xmpp ()
+ "Only _xmpp-client returns records, fallback appended."
+ (cl-letf (((symbol-function 'jabber-srv--fetch-answers)
+ (jabber-srv-test--mock-fetch
+ nil
+ (list (jabber-srv-test--make-answer 10 50 5222
"plain.example.com")))))
+ (let ((result (jabber-srv-lookup-mixed "example.com")))
+ (should (= (length result) 2))
+ (should (string= (nth 0 (car result)) "plain.example.com"))
+ (should-not (nth 2 (car result)))
+ ;; Fallback appended
+ (should (equal (cadr result) '("example.com" 5222 nil))))))
+
+(ert-deftest jabber-srv-test-lookup-mixed-only-xmpps ()
+ "Only _xmpps-client returns records, with STARTTLS fallback."
+ (cl-letf (((symbol-function 'jabber-srv--fetch-answers)
+ (jabber-srv-test--mock-fetch
+ (list (jabber-srv-test--make-answer 5 50 443 "tls.example.com"))
+ nil)))
+ (let ((result (jabber-srv-lookup-mixed "example.com")))
+ (should (= (length result) 2))
+ (should (string= (nth 0 (car result)) "tls.example.com"))
+ (should (nth 2 (car result)))
+ ;; Fallback
+ (should (equal (cadr result) '("example.com" 5222 nil))))))
+
+(ert-deftest jabber-srv-test-lookup-mixed-xmpps-dot ()
+ "xmpps-client returns dot, only STARTTLS targets with fallback."
+ (cl-letf (((symbol-function 'jabber-srv--fetch-answers)
+ (jabber-srv-test--mock-fetch
+ :dot
+ (list (jabber-srv-test--make-answer 10 50 5222
"plain.example.com")))))
+ (let ((result (jabber-srv-lookup-mixed "example.com")))
+ (should (= (length result) 2))
+ (should-not (nth 2 (car result)))
+ (should (equal (cadr result) '("example.com" 5222 nil))))))
+
+(ert-deftest jabber-srv-test-lookup-mixed-neither ()
+ "Neither service returns records."
+ (cl-letf (((symbol-function 'jabber-srv--fetch-answers)
+ (jabber-srv-test--mock-fetch nil nil)))
+ (should (null (jabber-srv-lookup-mixed "example.com")))))
+
+(ert-deftest jabber-srv-test-lookup-mixed-xmpps-error ()
+ "DNS error for xmpps is caught, xmpp results still used with fallback."
+ (cl-letf (((symbol-function 'jabber-srv--fetch-answers)
+ (lambda (target)
+ (cond
+ ((string-match "^_xmpps-client" target)
+ (error "DNS query failed"))
+ ((string-match "^_xmpp-client" target)
+ (list (jabber-srv-test--make-answer 10 50 5222
+ "plain.example.com")))))))
+ (let ((result (jabber-srv-lookup-mixed "example.com")))
+ (should (= (length result) 2))
+ (should (string= (nth 0 (car result)) "plain.example.com"))
+ (should (equal (cadr result) '("example.com" 5222 nil))))))
+
+;;; Fallback dedup
+
+(ert-deftest jabber-srv-test-has-fallback-p ()
+ "Detect existing domain:5222 STARTTLS in target list."
+ (should (jabber-srv--has-fallback-p
+ '(("example.com" 5222 nil)) "example.com"))
+ (should-not (jabber-srv--has-fallback-p
+ '(("other.example.com" 5222 nil)) "example.com"))
+ (should-not (jabber-srv--has-fallback-p
+ '(("example.com" 443 t)) "example.com")))
+
+(ert-deftest jabber-srv-test-lookup-mixed-no-dup-fallback ()
+ "No fallback appended when SRV already includes domain:5222 STARTTLS."
+ (cl-letf (((symbol-function 'jabber-srv--fetch-answers)
+ (jabber-srv-test--mock-fetch
+ nil
+ (list (jabber-srv-test--make-answer 10 50 5222 "example.com")))))
+ (let ((result (jabber-srv-lookup-mixed "example.com")))
+ ;; SRV already has example.com:5222, no dup fallback
+ (should (= (length result) 1))
+ (should (equal (car result) '("example.com" 5222 nil))))))
+
+;;; jabber-srv-targets
+
+(ert-deftest jabber-srv-test-targets-user-override ()
+ "User-specified network-server returns single STARTTLS target."
+ (let ((result (jabber-srv-targets "example.com" "custom.host" nil)))
+ (should (= (length result) 1))
+ (should (equal (car result) '("custom.host" 5222 nil)))))
+
+(ert-deftest jabber-srv-test-targets-user-port ()
+ "User-specified port returns single STARTTLS target."
+ (let ((result (jabber-srv-targets "example.com" nil 5223)))
+ (should (= (length result) 1))
+ (should (equal (car result) '("example.com" 5223 nil)))))
+
+(ert-deftest jabber-srv-test-targets-fallback ()
+ "No SRV records falls back to server:5222."
+ (cl-letf (((symbol-function 'jabber-srv-lookup-mixed)
+ (lambda (_server) nil)))
+ (let ((jabber-direct-tls-lookup t))
+ (let ((result (jabber-srv-targets "example.com" nil nil)))
+ (should (= (length result) 1))
+ (should (equal (car result) '("example.com" 5222 nil)))))))
+
+(provide 'jabber-srv-tests)
+
+;;; jabber-srv-tests.el ends here
