34 lines
1.1 KiB
Racket
34 lines
1.1 KiB
Racket
#lang syndicate
|
|
|
|
(provide server-facet/tcp
|
|
default-tcp-server-port
|
|
spawn-tcp-server!)
|
|
|
|
(require "../wire-protocol.rkt")
|
|
(require "../internal-protocol.rkt")
|
|
|
|
(require/activate syndicate/drivers/tcp)
|
|
(require/activate syndicate/distributed/server)
|
|
|
|
(define (server-facet/tcp id)
|
|
(assert (tcp-accepted id))
|
|
(assert (server-poa id))
|
|
(stop-when (retracted (server-poa-ready id)))
|
|
(on-start (issue-credit! #:amount 32768 tcp-in id))
|
|
(define accumulate! (packet-accumulator (lambda (p) (send! (message-poa->server id p)))))
|
|
(on (message (tcp-in id $bs))
|
|
(issue-credit! #:amount (bytes-length bs) tcp-in id)
|
|
(accumulate! bs))
|
|
(on (message (message-server->poa id $p))
|
|
(send! (tcp-out id (encode p)))
|
|
(when (Err? p) (stop-current-facet))))
|
|
|
|
(define default-tcp-server-port 21369)
|
|
|
|
(define (spawn-tcp-server! [port default-tcp-server-port])
|
|
(spawn #:name 'tcp-server-listener
|
|
(during/spawn (tcp-connection $id (tcp-listener port))
|
|
#:name `(server-poa ,id)
|
|
(on-start (issue-credit! (tcp-listener port)))
|
|
(server-facet/tcp id))))
|