67 lines
2.2 KiB
Racket
67 lines
2.2 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/set)
|
|
(require racket/match)
|
|
(require racket/tcp)
|
|
(require racket/port)
|
|
|
|
(define (main)
|
|
(define listener (tcp-listen 5999 4 #t))
|
|
(let loop ()
|
|
(define-values (cin cout) (tcp-accept listener))
|
|
(define-values (local-host local-port remote-host remote-port) (tcp-addresses cin #t))
|
|
(thread (connection-handler cin cout (cons remote-host remote-port)))
|
|
(loop)))
|
|
|
|
(define (connection-handler cin cout connection-id)
|
|
(lambda ()
|
|
(with-handlers ((exn:fail? (lambda (e)
|
|
(thread-send active-connection-thread
|
|
`(depart ,(current-thread) ,connection-id))
|
|
(raise e))))
|
|
(thread-send active-connection-thread `(arrive ,(current-thread) ,connection-id))
|
|
(let loop ()
|
|
(sync (wrap-evt (read-bytes-line-evt cin 'any)
|
|
(lambda (line)
|
|
(cond [(eof-object? line) 'done]
|
|
[else
|
|
(define active-connections
|
|
(let ((ch (make-channel)))
|
|
(thread-send active-connection-thread
|
|
`(get-active-connections ,ch))
|
|
(channel-get ch)))
|
|
(for ([c active-connections])
|
|
(thread-send (car c) `(says ,connection-id ,line)))
|
|
(loop)])))
|
|
(wrap-evt (thread-receive-evt)
|
|
(lambda (dummy)
|
|
(write (thread-receive) cout)
|
|
(newline cout)
|
|
(flush-output cout)
|
|
(loop)))))
|
|
(thread-send active-connection-thread `(depart ,(current-thread) ,connection-id)))))
|
|
|
|
(define active-connection-thread
|
|
(thread
|
|
(lambda ()
|
|
(let loop ((active-connections (set)))
|
|
(match (thread-receive)
|
|
[`(get-active-connections ,ch)
|
|
(channel-put ch active-connections)
|
|
(loop active-connections)]
|
|
[`(arrive ,caller ,connection-id)
|
|
(thread-send caller `(arrived ,connection-id))
|
|
(for ([c active-connections])
|
|
(thread-send caller `(arrived ,(cdr c)))
|
|
(thread-send (car c) `(arrived ,connection-id)))
|
|
(define new-connections (set-add active-connections (cons caller connection-id)))
|
|
(loop new-connections)]
|
|
[`(depart ,caller ,connection-id)
|
|
(define new-connections (set-remove active-connections (cons caller connection-id)))
|
|
(for ([c new-connections]) (thread-send (car c) `(departed ,connection-id)))
|
|
(loop new-connections)])))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(main)
|