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