#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)