More test program
This commit is contained in:
parent
d5fe945add
commit
634e795a6c
|
@ -1,11 +1,26 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
;; Trivial example program demonstrating os2-tcp.rkt.
|
;; Trivial example program demonstrating os2-tcp.rkt.
|
||||||
|
|
||||||
|
(require racket/string)
|
||||||
(require racket/set)
|
(require racket/set)
|
||||||
(require racket/match)
|
(require racket/match)
|
||||||
(require "os2.rkt")
|
(require "os2.rkt")
|
||||||
(require "os2-tcp.rkt")
|
(require "os2-tcp.rkt")
|
||||||
|
|
||||||
|
(define (send-to-all local-addr active-remotes speaker line)
|
||||||
|
(define formatted-line (string->bytes/utf-8
|
||||||
|
(format "~a: ~a~n" speaker (bytes->string/utf-8 line))))
|
||||||
|
(for/list ([remote (in-set active-remotes)])
|
||||||
|
(send-message (tcp-channel local-addr remote formatted-line))))
|
||||||
|
|
||||||
|
(define (format-names active-remotes)
|
||||||
|
(if (set-empty? active-remotes)
|
||||||
|
#"No-one else is here right now.\r\n"
|
||||||
|
(string->bytes/utf-8
|
||||||
|
(string-append*
|
||||||
|
"These connections are active:\r\n"
|
||||||
|
(for/list ([remote (in-set active-remotes)]) (format " - ~a\r\n" remote))))))
|
||||||
|
|
||||||
(define (connection-handler local-addr)
|
(define (connection-handler local-addr)
|
||||||
(transition (set) ;; of remote TcpAddresses
|
(transition (set) ;; of remote TcpAddresses
|
||||||
(role 'inbound-handler (topic-subscriber (tcp-channel (wild) local-addr (wild)))
|
(role 'inbound-handler (topic-subscriber (tcp-channel (wild) local-addr (wild)))
|
||||||
|
@ -18,6 +33,9 @@
|
||||||
[(topic 'publisher (tcp-channel remote-addr (== local-addr) _) #f)
|
[(topic 'publisher (tcp-channel remote-addr (== local-addr) _) #f)
|
||||||
(write `(arrived ,remote-addr)) (newline)
|
(write `(arrived ,remote-addr)) (newline)
|
||||||
(transition (set-add active-remotes remote-addr)
|
(transition (set-add active-remotes remote-addr)
|
||||||
|
(send-message (tcp-channel local-addr remote-addr
|
||||||
|
(format-names active-remotes)))
|
||||||
|
(send-to-all local-addr active-remotes remote-addr #"<arrived>")
|
||||||
(send-tcp-mode remote-addr local-addr 'lines)
|
(send-tcp-mode remote-addr local-addr 'lines)
|
||||||
(send-tcp-credit remote-addr local-addr 1))])
|
(send-tcp-credit remote-addr local-addr 1))])
|
||||||
#:on-absence (match t
|
#:on-absence (match t
|
||||||
|
@ -27,15 +45,15 @@
|
||||||
[(topic 'publisher (tcp-channel remote-addr (== local-addr) _) #f)
|
[(topic 'publisher (tcp-channel remote-addr (== local-addr) _) #f)
|
||||||
(write `(departed ,remote-addr)) (newline)
|
(write `(departed ,remote-addr)) (newline)
|
||||||
(set-remove active-remotes remote-addr)])
|
(set-remove active-remotes remote-addr)])
|
||||||
|
[(tcp-channel remote-addr (== local-addr) (? eof-object?))
|
||||||
|
(define new-active-remotes (set-remove active-remotes remote-addr))
|
||||||
|
(transition new-active-remotes
|
||||||
|
(send-message (tcp-channel local-addr remote-addr #"Goodbye!\r\n"))
|
||||||
|
(send-to-all local-addr new-active-remotes remote-addr #"<departed>"))]
|
||||||
[(tcp-channel remote-addr (== local-addr) (? bytes? bs))
|
[(tcp-channel remote-addr (== local-addr) (? bytes? bs))
|
||||||
(transition active-remotes
|
(transition active-remotes
|
||||||
(send-tcp-credit remote-addr local-addr 1)
|
(send-tcp-credit remote-addr local-addr 1)
|
||||||
(for/list ([remote (in-set active-remotes)])
|
(send-to-all local-addr active-remotes remote-addr bs))])
|
||||||
(send-message (tcp-channel local-addr remote
|
|
||||||
(string->bytes/utf-8
|
|
||||||
(format "~a: ~a~n"
|
|
||||||
remote-addr
|
|
||||||
(bytes->string/utf-8 bs)))))))])
|
|
||||||
(role 'outbound-handler (topic-publisher (tcp-channel local-addr (wild) (wild)))
|
(role 'outbound-handler (topic-publisher (tcp-channel local-addr (wild) (wild)))
|
||||||
#:state active-remotes)))
|
#:state active-remotes)))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue