Properly evaluate some TCP stop-when conditions.

Prior to this commit, the stop-whens were using
current-inexact-milliseconds in a comparison to detect a timeout,
meaning that timeouts would be missed. This commit introduces a
redundant copy of current-inexact-milliseconds in a field and changes it
on every event so that stop-when expressions involving the field are
reevaluated properly frequently.
This commit is contained in:
Tony Garnock-Jones 2016-07-17 00:28:03 -04:00
parent 09dfaf7d0e
commit 015d7c38dd
1 changed files with 9 additions and 2 deletions

View File

@ -318,8 +318,15 @@
;; ^ the most recent time we heard from our peer
[user-timeout-base-time (current-inexact-milliseconds)]
;; ^ when the index of the first outbound unacknowledged byte changed
[most-recent-time (current-inexact-milliseconds)]
;; ^ updated by timer expiry; a field, to trigger quit checks
[quit-because-reset? #f])
(let ()
(local-require (submod syndicate/actor priorities))
(on-event #:priority *query-priority*
[_ (most-recent-time (current-inexact-milliseconds))]))
(define (next-expected-seqn)
(define b (inbound))
(define v (buffer-seqn b))
@ -423,11 +430,11 @@
;; Number -> Boolean
(define (heard-from-peer-within-msec? msec)
(<= (- (current-inexact-milliseconds) (latest-peer-activity-time)) msec))
(<= (- (most-recent-time) (latest-peer-activity-time)) msec))
(define (user-timeout-expired?)
(and (not (all-output-acknowledged?))
(> (- (current-inexact-milliseconds) (user-timeout-base-time))
(> (- (most-recent-time) (user-timeout-base-time))
user-timeout-msec)))
(define (send-set-transmit-check-timer!)