Various newlisp scripts.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 

45 lines
1.4 KiB

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