aboutsummaryrefslogtreecommitdiff
path: root/tests/tcpevents/server.rkt
diff options
context:
space:
mode:
Diffstat (limited to 'tests/tcpevents/server.rkt')
-rw-r--r--tests/tcpevents/server.rkt39
1 files changed, 39 insertions, 0 deletions
diff --git a/tests/tcpevents/server.rkt b/tests/tcpevents/server.rkt
new file mode 100644
index 0000000..4313bda
--- /dev/null
+++ b/tests/tcpevents/server.rkt
@@ -0,0 +1,39 @@
+#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)))))