From 5efa0c406163a17d4ea471e48b88de60b7bc0475 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Wed, 4 Jul 2012 17:13:48 -0400 Subject: [PATCH] Support three levels of interest-type for a topic: participant/ordinary, monitor/observer, and "super-monitor". --- os2-example.rkt | 4 ++-- os2-tcp-test-date-service.rkt | 5 ----- os2-tcp-test-echo-service.rkt | 5 ----- os2-tcp.rkt | 8 ++++---- os2-udp.rkt | 3 +-- os2.rkt | 31 ++++++++++++++++++++++++++----- 6 files changed, 33 insertions(+), 23 deletions(-) diff --git a/os2-example.rkt b/os2-example.rkt index 68770d2..b45404e 100644 --- a/os2-example.rkt +++ b/os2-example.rkt @@ -36,8 +36,8 @@ (w 'absence) (w 'message))) (transition 'spy-state - (add-role 's->p (topic-publisher (wild) #:monitor? #t) (hs 'subscriber->publisher)) - (add-role 'p->s (topic-subscriber (wild) #:monitor? #t) (hs 'publisher->subscriber))))) + (add-role 's->p (topic-publisher (wild) #:monitor? 'everything) (hs 'subscriber->publisher)) + (add-role 'p->s (topic-subscriber (wild) #:monitor? 'everything) (hs 'publisher->subscriber))))) (ground-vm (lambda (boot-pid) (transition 'no-state diff --git a/os2-tcp-test-date-service.rkt b/os2-tcp-test-date-service.rkt index 66c6b4f..abd4475 100644 --- a/os2-tcp-test-date-service.rkt +++ b/os2-tcp-test-date-service.rkt @@ -22,11 +22,6 @@ #:state state #:topic t #:on-presence (match t - [(topic 'publisher (tcp-channel remote-addr (== local-addr) _) #t) - ;; Ignore monitor flows. They just mean there's - ;; someone willing to supply connections to us - ;; at some point in the future. - state] [(topic 'publisher (tcp-channel remote-addr (== local-addr) _) #f) (transition state (spawn (connection-handler local-addr remote-addr)))])))) diff --git a/os2-tcp-test-echo-service.rkt b/os2-tcp-test-echo-service.rkt index 29fa344..22ee5a6 100644 --- a/os2-tcp-test-echo-service.rkt +++ b/os2-tcp-test-echo-service.rkt @@ -28,11 +28,6 @@ #:state state #:topic t #:on-presence (match t - [(topic 'publisher (tcp-channel remote-addr (== local-addr) _) #t) - ;; Ignore monitor flows. They just mean there's - ;; someone willing to supply connections to us - ;; at some point in the future. - state] [(topic 'publisher (tcp-channel remote-addr (== local-addr) _) #f) (transition state (spawn (connection-handler local-addr remote-addr)))])))) diff --git a/os2-tcp.rkt b/os2-tcp.rkt index 4e18e9c..cd46dc8 100644 --- a/os2-tcp.rkt +++ b/os2-tcp.rkt @@ -84,8 +84,8 @@ (define tcp-driver (transition (set) (role 'tcp-listener-factory - (set (topic-subscriber (tcp-channel any-listener any-remote (wild)) #:monitor? #t) - (topic-publisher (tcp-channel any-remote any-listener (wild)) #:monitor? #t)) + (set (topic-subscriber (tcp-channel any-listener any-remote (wild)) #:monitor? 'everything) + (topic-publisher (tcp-channel any-remote any-listener (wild)) #:monitor? 'everything)) #:state active-handles #:topic t #:on-presence (maybe-spawn-socket t active-handles tcp-listener-manager) @@ -128,8 +128,8 @@ (define listener (tcp:tcp-listen port 4 #t)) (transition 'listener-is-running (role 'closer - (set (topic-subscriber (tcp-channel local-addr any-remote (wild)) #:monitor? #t) - (topic-publisher (tcp-channel any-remote local-addr (wild)) #:monitor? #t)) + (set (topic-subscriber (tcp-channel local-addr any-remote (wild)) #:monitor? 'everything) + (topic-publisher (tcp-channel any-remote local-addr (wild)) #:monitor? 'everything)) #:state state #:topic t ;; Hey, what if the presence we need went away between our diff --git a/os2-udp.rkt b/os2-udp.rkt index 5d61c45..b67ad2b 100644 --- a/os2-udp.rkt +++ b/os2-udp.rkt @@ -56,9 +56,8 @@ #:state active-handles #:topic t #:on-presence (match t - [(topic _ (udp-packet _ local-addr _) counterparty-monitor?) + [(topic _ (udp-packet _ local-addr _) #f) (cond - [counterparty-monitor? active-handles] [(set-member? active-handles local-addr) active-handles] [else (transition (set-add active-handles local-addr) diff --git a/os2.rkt b/os2.rkt index b67640e..3334841 100644 --- a/os2.rkt +++ b/os2.rkt @@ -138,7 +138,13 @@ meta-endpoints ;; Set ) #:transparent) -;; A Topic is a (topic Role Pattern Boolean), describing an Endpoint's +;; An InterestType is one of +;; -- #f, representing an ordinary *participant* in a conversation; +;; -- #t, representing a *monitor* or *observer* of a conversation; or +;; -- 'everything, representing a monitor that is also interested in +;; the existence of other monitors of the conversation. + +;; A Topic is a (topic Role Pattern InterestType), describing an Endpoint's ;; role in a conversation. (struct topic (role pattern monitor?) #:prefab) @@ -341,11 +347,26 @@ ;; True iff the flow between remote-topic and local-topic should be ;; visible to the local peer. This is the case when either local-topic -;; is a monitor (in which case everything is seen) or otherwise if -;; remote-topic is also not a monitor. +;; is monitoring 'everything or otherwise if remote-topic is an +;; ordinary topic only. +;; +;; |--------------+--------------+------------------------| +;; | local-topic | remote-topic | visible to local peer? | +;; |--------------+--------------+------------------------| +;; | #f | #f | yes | +;; | #f | #t | no | +;; | #f | 'everything | no | +;; | #t | #f | yes | +;; | #t | #t | no | +;; | #t | 'everything | no | +;; | 'everything | #f | yes | +;; | 'everything | #t | yes | +;; | 'everything | 'everything | yes | +;; |--------------+--------------+------------------------| +;; (define (flow-visible? local-topic remote-topic) - (or (topic-monitor? local-topic) - (not (topic-monitor? remote-topic)))) + (or (not (topic-monitor? remote-topic)) + (eq? (topic-monitor? local-topic) 'everything))) ;;--------------------------------------------------------------------------- ;; Composing state transitions and action emissions.