added
authorRalph Ronnquist <ralph.ronnquist@gmail.com>
Thu, 7 May 2020 12:28:52 +0000 (22:28 +1000)
committerRalph Ronnquist <ralph.ronnquist@gmail.com>
Thu, 7 May 2020 12:28:52 +0000 (22:28 +1000)
sslmultiplex.lsp [new file with mode: 0644]

diff --git a/sslmultiplex.lsp b/sslmultiplex.lsp
new file mode 100644 (file)
index 0000000..e198d6c
--- /dev/null
@@ -0,0 +1,45 @@
+#!/usr/local/bin/newlisp
+#
+# This script is intended as front end to accept socket connections on
+# a port and then dispatch correctly when recognizing an SSL
+# connection attempt. Run with:
+#
+# newlisp dispatch.lsp -P $PORT -H $HTTP -S $SSL
+#
+# stop with ^C
+#
+# Note: the dispatch goes to $SSL if the connection packet looks like
+# an SSL packet, and otheriwse to the $HTTP port.
+#
+# Note: awful performance.
+
+(constant
+ 'PORT (if (match '(* "-P" ? *) (main-args)) (int ($it 1)))
+ 'HTTP (if (match '(* "-H" ? *) (main-args)) (int ($it 1)))
+ 'SSL  (if (match '(* "-S" ? *) (main-args)) (int ($it 1)))
+ )
+
+(write-line 2 (string (list PORT HTTP SSL)))
+
+(define (read-write IN OUT)
+  (let ((BUFFER ""))
+    (while (net-receive IN BUFFER 1000000) (net-send OUT BUFFER))))
+
+(define (traffic SOCKET CHILDPORT )
+  (write-line 2 (string "traffic " PORT " <--> " CHILDPORT))
+  (let ((CHILD (net-connect "127.0.0.1" CHILDPORT)))
+    (fork (read-write CHILD SOCKET))
+    (net-send CHILD BUFFER PFXLEN)
+    (read-write SOCKET CHILD)))
+
+(define (handle-socket SOCKET)
+  (let ((BUFFER "") (CLIENT nil ) (PFXLEN 1))
+    (when (= PFXLEN (net-receive SOCKET BUFFER PFXLEN))
+      ;(write-line 2 (string (unpack "b" BUFFER)))
+      (traffic SOCKET (if (= '(22) (unpack "b" BUFFER)) SSL HTTP)))))
+
+(unless (setf SERVICE (net-listen PORT))
+  (exit 1))
+
+(while (if (net-accept SERVICE) (fork (handle-socket $it))))
+(exit 0)