branch: elpa/jabber
commit 550d537d1acb8efc13e5f98a83296abf916a11e3
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
sm: Count drained stanzas once
---
lisp/jabber-core.el | 6 ++----
lisp/jabber-sm.el | 12 +++++-------
lisp/jabber-util.el | 15 ++++++++++-----
tests/jabber-test-sm.el | 43 +++++++++++++++++++++++++++++++------------
4 files changed, 48 insertions(+), 28 deletions(-)
diff --git a/lisp/jabber-core.el b/lisp/jabber-core.el
index ca7c18e4ee..201a1e8195 100644
--- a/lisp/jabber-core.el
+++ b/lisp/jabber-core.el
@@ -850,8 +850,7 @@ override the defaults from `jabber-account-list'."
(jabber-send-sexp--immediate fsm sexp))
;; Drain any stanzas queued before disconnect.
(setq new-state-data
- (jabber-sm--drain-pending
- fsm new-state-data #'jabber-send-sexp--immediate))
+ (jabber-sm--drain-pending fsm new-state-data))
(list :session-established new-state-data)))
((jabber-sm--failed-p stanza)
(message "Stream Management resume failed, falling back to
auth")
@@ -915,8 +914,7 @@ override the defaults from `jabber-account-list'."
(list :session-established state-data :keep))
((jabber-sm--a-p stanza)
(setq state-data (jabber-sm--process-ack state-data
stanza))
- (setq state-data (jabber-sm--drain-pending
- fsm state-data
#'jabber-send-sexp--immediate))
+ (setq state-data (jabber-sm--drain-pending fsm state-data))
(list :session-established state-data :keep))
(t
;; Only message/presence/iq stanzas reach here; <r/>/<a/>
are
diff --git a/lisp/jabber-sm.el b/lisp/jabber-sm.el
index 5dcac0ae0b..89ffaaad42 100644
--- a/lisp/jabber-sm.el
+++ b/lisp/jabber-sm.el
@@ -40,7 +40,7 @@
(require 'jabber-xml)
(require 'fsm)
-(declare-function jabber-send-sexp--immediate "jabber-util.el" (jc sexp))
+(declare-function jabber-send-sexp--raw "jabber-util.el" (jc sexp))
(declare-function jabber-send-string "jabber-util.el" (jc string))
(defvar jabber-debug-log-xml)
@@ -232,11 +232,9 @@ Return updated STATE-DATA."
(nconc (plist-get state-data :sm-pending-queue)
(list (cons (jabber-sm--stanza-priority sexp) sexp)))))
-(defun jabber-sm--drain-pending (jc state-data send-fn)
+(defun jabber-sm--drain-pending (jc state-data)
"Send queued stanzas from pending queue up to the in-flight cap.
-JC is the connection. STATE-DATA is the FSM plist. SEND-FN is
-called with (JC SEXP) for each drained stanza and must bypass
-the back-pressure gate to avoid re-queuing.
+JC is the connection. STATE-DATA is the FSM plist.
The queue is stable-sorted by priority before draining so messages
go first, then IQs, then presence. FIFO order is preserved
within each priority class.
@@ -248,7 +246,7 @@ Return updated STATE-DATA."
(< (jabber-sm--in-flight-count state-data)
jabber-sm-max-in-flight)))
(let ((sexp (cdr (pop queue))))
- (funcall send-fn jc sexp)
+ (jabber-send-sexp--raw jc sexp)
(setq state-data (jabber-sm--count-outbound state-data sexp))))
(plist-put state-data :sm-pending-queue queue)))
@@ -285,7 +283,7 @@ recovery cycle."
(plist-get state-data :sm-outbound-count))
(plist-put state-data :sm-outbound-queue nil)
(plist-put state-data :sm-stall-since nil)
- (jabber-sm--drain-pending jc state-data #'jabber-send-sexp--immediate)))
+ (jabber-sm--drain-pending jc state-data)))
;;; Ack send/receive
diff --git a/lisp/jabber-util.el b/lisp/jabber-util.el
index d2f98d3196..4833c47b96 100644
--- a/lisp/jabber-util.el
+++ b/lisp/jabber-util.el
@@ -980,10 +980,10 @@ DATA is any sexp."
(when jabber-debug-log-xml
(jabber-process-console fsm direction data)))
-(defun jabber-send-sexp--immediate (jc sexp)
- "Send SEXP to JC immediately, bypassing the back-pressure gate.
-Log the XML, send it (with a proactive <r/> for countable stanzas
-when SM is enabled), and update the outbound counter."
+(defun jabber-send-sexp--raw (jc sexp)
+ "Send SEXP to JC without updating Stream Management state.
+Log the XML and append an <r/> request when SM is enabled for a
+countable stanza."
(condition-case e
(jabber-log-xml jc "sending" sexp)
(error
@@ -996,7 +996,12 @@ when SM is enabled), and update the outbound counter."
(jabber-sm--stanza-p sexp))))
(if sm-countable
(jabber-send-string jc (concat xml (jabber-sm--make-request-xml)))
- (jabber-send-string jc xml)))
+ (jabber-send-string jc xml))))
+
+(defun jabber-send-sexp--immediate (jc sexp)
+ "Send SEXP to JC immediately, bypassing the back-pressure gate.
+Update Stream Management state after transmitting the stanza."
+ (jabber-send-sexp--raw jc sexp)
(jabber-sm--count-outbound (fsm-get-state-data jc) sexp))
(defun jabber-send-sexp (jc sexp)
diff --git a/tests/jabber-test-sm.el b/tests/jabber-test-sm.el
index 04a7106922..ded3883909 100644
--- a/tests/jabber-test-sm.el
+++ b/tests/jabber-test-sm.el
@@ -514,9 +514,9 @@
(cons 0 msg2)
(cons 0 msg3))))
(sent nil))
- (setq sd (jabber-sm--drain-pending
- 'fake-jc sd
- (lambda (_jc sexp) (push sexp sent))))
+ (cl-letf (((symbol-function 'jabber-send-sexp--raw)
+ (lambda (_jc sexp) (push sexp sent))))
+ (setq sd (jabber-sm--drain-pending 'fake-jc sd)))
;; Should have sent exactly 2 (the cap)
(should (= (length sent) 2))
;; One remains in pending queue
@@ -525,6 +525,25 @@
;; Outbound count incremented for sent stanzas
(should (= (plist-get sd :sm-outbound-count) 2))))
+(ert-deftest jabber-test-sm-drain-pending-counts-once ()
+ "Draining counts each transmitted stanza exactly once."
+ (let* ((jabber-sm-max-in-flight 2)
+ (msg '(message ((to . "a@b")) (body () "1")))
+ (sd (list :sm-enabled t
+ :sm-outbound-count 10
+ :sm-last-acked 9
+ :sm-outbound-queue nil
+ :sm-pending-queue (list (cons 0 msg))))
+ (sent nil))
+ (cl-letf (((symbol-function 'jabber-send-sexp--raw)
+ (lambda (_jc sexp) (push sexp sent))))
+ (setq sd (jabber-sm--drain-pending 'fake-jc sd)))
+ (should (equal sent (list msg)))
+ (should (= (plist-get sd :sm-outbound-count) 11))
+ (should (= (length (plist-get sd :sm-outbound-queue)) 1))
+ (should (= (caar (plist-get sd :sm-outbound-queue)) 11))
+ (should (null (plist-get sd :sm-pending-queue)))))
+
(ert-deftest jabber-test-sm-drain-pending-empty ()
"Drain with empty queue is a no-op."
(let* ((jabber-sm-max-in-flight 10)
@@ -534,9 +553,9 @@
:sm-outbound-queue nil
:sm-pending-queue nil))
(sent nil))
- (setq sd (jabber-sm--drain-pending
- 'fake-jc sd
- (lambda (_jc sexp) (push sexp sent))))
+ (cl-letf (((symbol-function 'jabber-send-sexp--raw)
+ (lambda (_jc sexp) (push sexp sent))))
+ (setq sd (jabber-sm--drain-pending 'fake-jc sd)))
(should (null sent))
(should (null (plist-get sd :sm-pending-queue)))))
@@ -579,9 +598,9 @@
(cons 1 iq1)
(cons 0 msg2))))
(sent nil))
- (setq sd (jabber-sm--drain-pending
- 'fake-jc sd
- (lambda (_jc sexp) (push sexp sent))))
+ (cl-letf (((symbol-function 'jabber-send-sexp--raw)
+ (lambda (_jc sexp) (push sexp sent))))
+ (setq sd (jabber-sm--drain-pending 'fake-jc sd)))
(setq sent (nreverse sent))
;; Messages first (FIFO), then IQ, then presences (FIFO)
(should (= (length sent) 5))
@@ -612,9 +631,9 @@
(cons 0 msg1)
(cons 2 pres2))))
(sent nil))
- (setq sd (jabber-sm--drain-pending
- 'fake-jc sd
- (lambda (_jc sexp) (push sexp sent))))
+ (cl-letf (((symbol-function 'jabber-send-sexp--raw)
+ (lambda (_jc sexp) (push sexp sent))))
+ (setq sd (jabber-sm--drain-pending 'fake-jc sd)))
(setq sent (nreverse sent))
;; Message sent first, then one presence
(should (= (length sent) 2))
