sslmultiplex.lsp

   1 #!/usr/local/bin/newlisp
   2 #
   3 # This script is intended as front end to accept socket connections on
   4 # a port and then dispatch correctly when recognizing an SSL
   5 # connection attempt. Run with:
   6 #
   7 # newlisp dispatch.lsp -P $PORT -H $HTTP -S $SSL
   8 #
   9 # stop with ^C
  10 #
  11 # Note: the dispatch goes to $SSL if the connection packet looks like
  12 # an SSL packet, and otheriwse to the $HTTP port.
  13 #
  14 # Note: awful performance.
  15
  16 (constant
  17  'PORT (if (match '(* "-P" ? *) (main-args)) (int ($it 1)))
  18  'HTTP (if (match '(* "-H" ? *) (main-args)) (int ($it 1)))
  19  'SSL  (if (match '(* "-S" ? *) (main-args)) (int ($it 1)))
  20  )
  21
  22 (write-line 2 (string (list PORT HTTP SSL)))
  23
  24 (define (read-write IN OUT)
  25   (let ((BUFFER ""))
  26     (while (net-receive IN BUFFER 1000000) (net-send OUT BUFFER))))
  27
  28 (define (traffic SOCKET CHILDPORT )
  29   (write-line 2 (string "traffic " PORT " <--> " CHILDPORT))
  30   (let ((CHILD (net-connect "127.0.0.1" CHILDPORT)))
  31     (fork (read-write CHILD SOCKET))
  32     (net-send CHILD BUFFER PFXLEN)
  33     (read-write SOCKET CHILD)))
  34
  35 (define (handle-socket SOCKET)
  36   (let ((BUFFER "") (CLIENT nil ) (PFXLEN 1))
  37     (when (= PFXLEN (net-receive SOCKET BUFFER PFXLEN))
  38       ;(write-line 2 (string (unpack "b" BUFFER)))
  39       (traffic SOCKET (if (= '(22) (unpack "b" BUFFER)) SSL HTTP)))))
  40
  41 (unless (setf SERVICE (net-listen PORT))
  42   (exit 1))
  43
  44 (while (if (net-accept SERVICE) (fork (handle-socket $it))))
  45 (exit 0)