add tcp repl to inserter

1 files changed, 35 insertions, 0 deletions

diff --git a/ebus-racket/util/tcp-repl.rkt b/ebus-racket/util/tcp-repl.rkt
new file mode 100644
index 0000000..4b19d85
--- /dev/null
+++ b/ebus-racket/util/tcp-repl.rkt
@@ -0,0 +1,35 @@
+(module tcp-repl racket/base
+  (require mzlib/thread
+	   racket/tcp)
+  (provide (prefix-out tcp-repl- run)
+	   (prefix-out tcp-repl- logger))
+
+  (define logger (make-logger 'tcp-repl (current-logger)))
+
+  (define (run namespace port)
+    (thread
+     (lambda ()
+       (run-server port ; TCP-Port
+		   (make-connection-handler namespace) ; connection handler
+		   #f; timeout
+		   (lambda (tcp-port max-allow-wait reuse?) ; listen handler
+		     (log-message logger 'info (format "Listen on ~a:~a" "127.0.0.1" tcp-port) #t)
+		     (tcp-listen tcp-port max-allow-wait reuse? "127.0.0.1"))
+		   ))))
+
+  (define (tcp-tostring port)
+    (let-values ([(address-from port-from address-to port-to) (tcp-addresses port #t)])
+      (format "~a:~a -> ~a:~a" address-from port-from address-to port-to)))
+      
+  (define (make-connection-handler namespace)
+    (lambda (ip op)
+      (let/ec exit
+	(log-message logger 'info (format "New Connection ~a" (tcp-tostring ip)) #t)
+	(parameterize ([current-input-port   ip]
+		       [current-output-port  op]
+		       [current-error-port   op]
+		       [current-namespace namespace])
+	  (read-eval-print-loop))
+	(log-message logger 'info (format "End Connection ~a" (tcp-tostring ip)) #t)
+	(close-output-port op))))
+  ) ; end module tcp-repl
\ No newline at end of file