/
simple-proxy.lisp
155 lines (141 loc) · 6.36 KB
/
simple-proxy.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
;;; This file contains a simple proxy. It binds to a local port and connects to
;;; a remote host/port, proxying all data received locally or remotely. It uses
;;; the "socket data" accessor to reference the local and remote socket to each
;;; other, allowing one to be closed if the other gets an EOF.
;;;
;;; It has the ability to print out all data sent/received, and print out
;;; reports on connection statistics.
;;;
;;; Usage:
;;;
;;; (simple-proxy:start local-bind local-port
;;; remote-host remote-port
;;; &key stats debug ascii verbose)
;;;
;;; Not only does this offer a good example of a more advanced usage of cl-async
;;; but is actually really useful for peeking into plaintext TCP protocols. For
;;; instance, you could use it to debug HTTP requests or learn what a driver is
;;; sending to a server (which is what I built it for).
(ql:quickload :cl-async)
(defpackage :simple-proxy
(:use :cl)
(:export #:start))
(in-package :simple-proxy)
(defparameter *debug* nil "If T, will echo all data coming through the proxy")
(defparameter *verbose* nil "If T (and *debug* is T), will spit out every byte that passes through")
(defparameter *ascii* nil "If T, will echo all non-UTF8 data as a string of ASCII bytes instead of a vector")
(defun to-ascii (data)
"Print data to an ASCII string byte by byte (if enabled)."
(if *ascii*
(progn
(loop for byte-code across data do
(format t "~c" (code-char byte-code)))
(format t "~%"))
data))
(defun output-data (location &optional data)
"Outputs the given data using the specified location as the header."
(when *debug*
(if data
(progn
(format t "---~a(~a)---~%" location (length data))
(when *verbose*
(handler-case (format t "~a~%" (babel:octets-to-string data :encoding :utf-8))
(error () (format t "~a~%" (to-ascii data))))))
(format t "---~a---~%" location))))
(defun socketp (socket)
"Test if given object is an as:socket."
(subtypep (type-of socket) 'as:socket))
(defun pair-sockets (sock1 sock2)
"Pair two sockets to each other."
(when (and (socketp sock1)
(socketp sock2))
(setf (as:socket-data sock1) sock2
(as:socket-data sock2) sock1)))
(defun close-paired-socket (socket)
"Given a socket, close the paired socket (if it exists)."
(when (socketp socket)
(let ((paired-socket (as:socket-data socket)))
(when (and (socketp paired-socket)
(not (as:socket-closed-p paired-socket)))
(output-data "close")
(as:close-socket paired-socket)
;; deref them
(setf (as:socket-data socket) nil
(as:socket-data paired-socket) nil)))))
(defun proxy-event-handler (ev)
"Handle all proxy events."
(handler-case
(error ev)
;; if a socket times out, close the paired socket
(as:tcp-timeout ()
(close-paired-socket (as:tcp-socket ev)))
;; if we get a socket eof, close the paired socket, but delay it so that any
;; data being sent out before closing has a chance to "escape."
(as:tcp-error ()
(as:delay (lambda () (close-paired-socket (as:tcp-socket ev)))))
(as:tcp-eof ()
(as:delay (lambda () (close-paired-socket (as:tcp-socket ev)))))
;; just echo the event
(error ()
(when *debug*
(format t "ev: ~a (~a)~%" (type-of ev) ev)))))
(defun proxy-remote-response (sock-remote data)
"Send data received on the remote socket into the local socket."
(output-data "remote" data)
(let ((sock-local (as:socket-data sock-remote)))
(if (as:socket-closed-p sock-local)
(close-paired-socket sock-local)
(as:write-socket-data sock-local data))))
(defun proxy-local-data (sock-local data)
"Send data received on the local socket into the remote socket."
(output-data "local" data)
(let ((sock-remote (as:socket-data sock-local)))
(if (as:socket-closed-p sock-remote)
(close-paired-socket sock-remote)
(as:write-socket-data sock-remote data))))
(defun start (local-bind local-port remote-host remote-port &key stats debug ascii verbose)
"Start a proxy on a local port and proxy to a remote host. If :stats is T,
connection stats are printed every 2 seconds. If :debug is T, all data
passing through the proxy is echoed to STDOUT."
(let ((server nil)
(quit nil)
(*debug* debug)
(*verbose* verbose)
(*ascii* ascii))
(as:with-event-loop (:catch-app-errors t)
(format t "Starting proxy.~%")
(setf server (as:tcp-server
local-bind local-port
(lambda (sock-local data)
(proxy-local-data sock-local data))
:event-cb #'proxy-event-handler
:connect-cb (lambda (sock-local)
(output-data "connection")
;; on local connect, establish the remote connection
(let ((sock-remote (as:tcp-connect remote-host remote-port
#'proxy-remote-response
:event-cb #'proxy-event-handler)))
;; pair the local and remote sockets. if
;; one closes, so does the other.
(pair-sockets sock-local sock-remote)))
:backlog -1))
;; SIGINT will *cleanly* close the proxy (doesn't accept any new
;; connections, but lets current ones run free until they close).
(as:signal-handler as:+sigint+
(lambda (sig)
(declare (ignore sig))
(format t "Closing proxy...~%")
(setf quit t)
(as:close-tcp-server server)
(as:free-signal-handler as:+sigint+)))
;; if :stats is T, print connections statistics every few seconds
(when stats
(labels ((print-stats ()
(let* ((stats (as:stats))
(incoming (getf stats :incoming-tcp-connections))
(outgoing (getf stats :outgoing-tcp-connections)))
(format t "incoming: ~a~%outgoing: ~a~%~%" incoming outgoing))
(unless quit
(as:delay #'print-stats :time 2))))
(print-stats)))))
(format t "Closed.~%"))