diff --git a/imperative/distributed/heartbeat.rkt b/imperative/distributed/heartbeat.rkt index 86059c4..450c351 100644 --- a/imperative/distributed/heartbeat.rkt +++ b/imperative/distributed/heartbeat.rkt @@ -2,39 +2,49 @@ (provide heartbeat) +(module+ for-testing + (provide heartbeats-enabled?)) + (require "wire-protocol.rkt") (require/activate imperative-syndicate/drivers/timer) (define-logger syndicate/distributed) +(define heartbeats-enabled? (make-parameter #t)) + ;; TODO: move heartbeats to transport level, and use separate transport-activity timeouts from ;; message-activity timeouts. Using message-activity only has problems when messages are large ;; and links are slow. Also, moving to transport level lets us use e.g. WebSocket's ping ;; mechanism rather than a message-level mechanism. (define (heartbeat who send-message teardown) - (define period (ping-interval)) - (define grace (* 3 period)) + (cond + [(heartbeats-enabled?) + (define period (ping-interval)) + (define grace (* 3 period)) - (log-syndicate/distributed-debug - "Peer ~v heartbeat period ~ams; must not experience silence longer than ~ams" - who period grace) + (log-syndicate/distributed-debug + "Peer ~v heartbeat period ~ams; must not experience silence longer than ~ams" + who period grace) - (field [next-ping-time 0]) ;; when we are to send the next ping - (field [last-received-traffic (current-inexact-milliseconds)]) ;; when we last heard from the peer + (field [next-ping-time 0]) ;; when we are to send the next ping + (field [last-received-traffic (current-inexact-milliseconds)]) ;; when we last heard from the peer - (define (schedule-next-ping!) - (next-ping-time (+ (current-inexact-milliseconds) period))) + (define (schedule-next-ping!) + (next-ping-time (+ (current-inexact-milliseconds) period))) - (on (asserted (later-than (next-ping-time))) - (schedule-next-ping!) - (send-message (Ping))) + (on (asserted (later-than (next-ping-time))) + (schedule-next-ping!) + (send-message (Ping))) - (on (asserted (later-than (+ (last-received-traffic) grace))) - (log-syndicate/distributed-info "Peer ~v heartbeat timeout after ~ams of inactivity" - who grace) - (teardown)) + (on (asserted (later-than (+ (last-received-traffic) grace))) + (log-syndicate/distributed-info "Peer ~v heartbeat timeout after ~ams of inactivity" + who grace) + (teardown)) - (lambda () - (schedule-next-ping!) - (last-received-traffic (current-inexact-milliseconds)))) + (lambda () + (schedule-next-ping!) + (last-received-traffic (current-inexact-milliseconds)))] + [else + (log-syndicate/distributed-debug "Peer ~v heartbeats disabled" who) + void])) diff --git a/imperative/test/distributed/nesting-confusion.rkt b/imperative/test/distributed/nesting-confusion.rkt index 98f8f3d..9f19593 100644 --- a/imperative/test/distributed/nesting-confusion.rkt +++ b/imperative/test/distributed/nesting-confusion.rkt @@ -5,6 +5,9 @@ (require imperative-syndicate/distributed) (require imperative-syndicate/distributed/internal-protocol) +(require (submod imperative-syndicate/distributed/heartbeat for-testing)) +(heartbeats-enabled? #f) + (assertion-struct researcher (name topic)) (define test-address (server-loopback-connection "test")) diff --git a/imperative/test/distributed/observation-visibility.rkt b/imperative/test/distributed/observation-visibility.rkt index a545943..9642a69 100644 --- a/imperative/test/distributed/observation-visibility.rkt +++ b/imperative/test/distributed/observation-visibility.rkt @@ -5,6 +5,9 @@ (require (only-in imperative-syndicate/lang activate)) (require imperative-syndicate/distributed) +(require (submod imperative-syndicate/distributed/heartbeat for-testing)) +(heartbeats-enabled? #f) + (assertion-struct presence (who)) (define test-address (server-loopback-connection "test"))