Make this a real running program
This commit is contained in:
parent
4cab8d3226
commit
c3f27a9e8d
|
@ -2,19 +2,19 @@
|
||||||
|
|
||||||
(define (listener port)
|
(define (listener port)
|
||||||
(transition 'no-state
|
(transition 'no-state
|
||||||
(role/act (tcp-listener port)
|
(role/anon (tcp-listener port)
|
||||||
#:topic t
|
#:topic t
|
||||||
#:on-presence (spawn (connection-handler t))))))
|
#:on-presence (spawn (connection-handler t)))))
|
||||||
|
|
||||||
(define (connection-handler topic)
|
(define (connection-handler t)
|
||||||
(define-values (cin cout in-topic out-topic) (tcp-accept topic))
|
(define-values (cin cout in-topic out-topic) (tcp-accept t))
|
||||||
(transition 'no-state
|
(transition 'no-state
|
||||||
(cin (tcp-credit 1) #:mode 'feedback)
|
(cin (tcp-credit 1))
|
||||||
(role/act in-topic
|
(role/anon in-topic
|
||||||
[(tcp-channel _ _ (or (== #"\4") (? eof-object?)))
|
[(tcp-channel _ _ (or (== #"\4") (? eof-object?)))
|
||||||
(kill)]
|
(kill)]
|
||||||
[(tcp-channel _ _ (? bytes? bytev))
|
[(tcp-channel _ _ bytev)
|
||||||
(list (cin (tcp-credit 1) #:mode 'feedback)
|
(list (cin (tcp-credit 1))
|
||||||
(cout bytev))])))
|
(cout bytev))])))
|
||||||
|
|
||||||
(define (main port)
|
(define (main port)
|
||||||
|
@ -25,27 +25,6 @@
|
||||||
|
|
||||||
(main 5999)
|
(main 5999)
|
||||||
|
|
||||||
(define (tcp-accept topic)
|
|
||||||
(match-define (topic (tcp-channel remote-addr local-addr _)) topic)
|
|
||||||
(values (match-lambda
|
|
||||||
[(val #:mode 'feedback)
|
|
||||||
(send-feedback (tcp-channel remote-addr local-addr val))])
|
|
||||||
(match-lambda
|
|
||||||
[(val)
|
|
||||||
(send-message (tcp-channel local-addr remote-addr val))])
|
|
||||||
(topic-subscriber (tcp-channel remote-addr local-addr (wild)))
|
|
||||||
(topic-publisher (tcp-channel local-addr remote-addr (wild)))))
|
|
||||||
|
|
||||||
|
|
||||||
(define (tcp-listener port)
|
|
||||||
(topic-subscriber (tcp-channel (wild)
|
|
||||||
(tcp-local-endpoint port)
|
|
||||||
(wild))
|
|
||||||
#:monitor? #t))
|
|
||||||
|
|
||||||
(require racket/string)
|
|
||||||
(require racket/set)
|
|
||||||
(require racket/match)
|
(require racket/match)
|
||||||
(require "os2.rkt")
|
(require "../os2.rkt")
|
||||||
(require "os2-tcp.rkt")
|
(require "../fake-tcp.rkt")
|
||||||
(require "os2-tcp-helper.rkt")
|
|
||||||
|
|
Loading…
Reference in New Issue