46 lines
1.7 KiB
Racket
46 lines
1.7 KiB
Racket
#lang syndicate/actor
|
|
|
|
(require racket/exn)
|
|
(require racket/set)
|
|
(require net/url)
|
|
|
|
(require/activate syndicate/drivers/web)
|
|
(require/activate "remote-topic.rkt")
|
|
|
|
(require "../private/util.rkt")
|
|
(require "../protocol.rkt")
|
|
|
|
(actor #:name 'topic-demand-analyzer
|
|
(define/query-set local-hosts ($ h (local-host _ _)) h)
|
|
(during/actor (topic-demand $full-topic _)
|
|
#:name (list 'general-topic full-topic)
|
|
#:let [(local-hosts-snapshot (local-hosts))]
|
|
(with-handlers [(exn? (lambda (e)
|
|
(log-error "Topic demand error: ~a" (exn->string e))))]
|
|
(match-define (web-resource (web-virtual-host _ topic-host topic-port) topic-path)
|
|
(url->resource (string->url full-topic)))
|
|
(define maybe-local-topic
|
|
(match topic-path [`("topic" (,topic ())) topic] [_ #f]))
|
|
(general-topic-main full-topic
|
|
topic-host
|
|
topic-port
|
|
maybe-local-topic
|
|
(set-member? local-hosts-snapshot
|
|
(local-host topic-host topic-port))))))
|
|
|
|
(define (general-topic-main full-topic topic-host topic-port maybe-local-topic start-as-local?)
|
|
(define (local-state)
|
|
(react (stop-when (retracted (local-host topic-host topic-port))
|
|
(remote-state))
|
|
(assert (local-topic-demand maybe-local-topic))))
|
|
|
|
(define (remote-state)
|
|
(react (stop-when #:when maybe-local-topic (asserted (local-host topic-host topic-port))
|
|
(local-state))
|
|
(remote-topic-main full-topic)))
|
|
|
|
(on-start
|
|
(if (and maybe-local-topic start-as-local?)
|
|
(local-state)
|
|
(remote-state))))
|