Hermes/tests/tcpevents/server.rkt

40 lines
1.1 KiB
Racket

#lang racket
(define (serve in-port out-port)
(let loop []
(define evt (sync/timeout 2
(read-line-evt in-port 'any)
(thread-receive-evt)))
(cond
[(not evt)
(displayln "Timed out, exiting")
(tcp-abandon-port in-port)
(tcp-abandon-port out-port)]
[(string? evt)
(fprintf out-port "~a~n" evt)
(flush-output out-port)
(loop)]
[else
(printf "Received a message in mailbox: ~a~n"
(thread-receive))
(loop)])))
(define port-num 4321)
(define (start-server)
(define listener (tcp-listen port-num))
(thread
(lambda ()
(define-values [in-port out-port] (tcp-accept listener))
(serve in-port out-port))))
(start-server)
(define client-thread
(thread
(lambda ()
(define-values [in-port out-port] (tcp-connect "localhost" port-num))
(display "first\nsecond\nthird\n" out-port)
(flush-output out-port)
; copy-port will block until EOF is read from in-port
(copy-port in-port (current-output-port)))))