|
|
@@ -8,94 +8,87 @@ |
|
|
|
|
|
(define-constant +server-version+ 1)
|
|
|
(define-constant +routing-buffer-size+ (* 64 1024))
|
|
|
(define-constant +client-socket-timeout+ (* 5 60))
|
|
|
|
|
|
|
|
|
(defclass mortar-combat-proxy (enableable generic-system)
|
|
|
((proxy-socket :initform nil)
|
|
|
((proxy-server :initform nil)
|
|
|
(peer-registry :initform (make-instance 'peer-registry) :reader peer-registry-of)
|
|
|
(arena-registry :initform (make-instance 'arena-registry) :reader arena-registry-of)
|
|
|
(arenas :initform (make-hash-table :test #'equal) :reader arena-list-of)
|
|
|
(routing-buffer :initform (make-array +routing-buffer-size+
|
|
|
:element-type '(unsigned-byte 8)))
|
|
|
(info-socket :initform nil)))
|
|
|
(info-server :initform nil)))
|
|
|
|
|
|
|
|
|
(defun reply-to (message)
|
|
|
(process-command (getf message :command) message))
|
|
|
|
|
|
|
|
|
(defun process-request ()
|
|
|
;; fixme: record connection's last communication timestamp
|
|
|
;; to autoclose idle connections
|
|
|
(let ((stream (usocket:socket-stream *connection*)))
|
|
|
(when (listen stream)
|
|
|
;; fixme: make async: read available chunk, don't wait for more
|
|
|
(let ((message (decode-message stream)))
|
|
|
(when (listp message)
|
|
|
(encode-message (reply-to message) stream)
|
|
|
(force-output stream))))))
|
|
|
(defun process-request (stream)
|
|
|
(let ((message (decode-message stream)))
|
|
|
(when (listp message)
|
|
|
(encode-message (reply-to message) stream)
|
|
|
(force-output stream))))
|
|
|
|
|
|
|
|
|
(defun pour-stream (source-peer destination-peer)
|
|
|
(defun pour-stream (source-stream destination-stream)
|
|
|
(with-slots (routing-buffer) *system*
|
|
|
(when-let ((src-conn (proxy-connection-of source-peer))
|
|
|
(dst-conn (proxy-connection-of destination-peer)))
|
|
|
(let ((source-stream (usocket:socket-stream src-conn))
|
|
|
(destination-stream (usocket:socket-stream dst-conn)))
|
|
|
(when (listen source-stream)
|
|
|
;; no need to do full copy, hence no loop: let server do other work in between
|
|
|
(let ((bytes-read (read-sequence routing-buffer source-stream)))
|
|
|
(write-sequence routing-buffer destination-stream :end bytes-read)
|
|
|
(force-output destination-stream)))))))
|
|
|
|
|
|
|
|
|
(defun route-stream ()
|
|
|
(when-let ((arena (find-arena-by-peer (arena-registry-of *system*) *peer*)))
|
|
|
(let ((arena-server (server-of arena)))
|
|
|
(if (eq arena-server *peer*)
|
|
|
(loop for client in (clients-of arena)
|
|
|
do (pour-stream arena-server client))
|
|
|
(pour-stream *peer* arena-server)))))
|
|
|
(when (and source-stream destination-stream )
|
|
|
(loop with buf-len = (length routing-buffer)
|
|
|
for bytes-read = (read-sequence routing-buffer source-stream)
|
|
|
do (write-sequence routing-buffer destination-stream :end bytes-read)
|
|
|
while (= bytes-read buf-len))
|
|
|
(force-output destination-stream))))
|
|
|
|
|
|
|
|
|
(defun process-input ()
|
|
|
(if (and *peer* (eq (proxy-connection-of *peer*) *connection*))
|
|
|
(route-stream)
|
|
|
(process-request)))
|
|
|
(defun route-stream (stream)
|
|
|
(when-let ((arena (find-arena-by-peer (arena-registry-of *system*) *peer*)))
|
|
|
(let ((arena-server (server-of arena)))
|
|
|
(flet ((wrap-into-stream (peer)
|
|
|
;; fixme: find a way to avoid stream instantiating
|
|
|
(make-instance 'as:async-output-stream
|
|
|
:socket (proxy-connection-of peer))))
|
|
|
(if (eq arena-server *peer*)
|
|
|
(loop for client in (clients-of arena)
|
|
|
do (pour-stream stream (wrap-into-stream client)))
|
|
|
(pour-stream stream (wrap-into-stream arena-server)))))))
|
|
|
|
|
|
|
|
|
(defmethod initialize-system :after ((this mortar-combat-proxy))
|
|
|
(with-slots (proxy-socket info-socket peer-registry) this
|
|
|
(setf proxy-socket (usocket:socket-listen #(127 0 0 1) 8222
|
|
|
:element-type '(unsigned-byte 8))
|
|
|
info-socket (usocket:socket-listen #(127 0 0 1) 8778
|
|
|
:element-type '(unsigned-byte 8)))
|
|
|
(in-new-thread "socket-listener"
|
|
|
(let ((sockets (list proxy-socket info-socket))
|
|
|
(*system* this))
|
|
|
(flet ((%accept (passive-socket)
|
|
|
(push (usocket:socket-accept passive-socket) (cddr sockets))))
|
|
|
(loop while (enabledp this) do
|
|
|
(log-errors
|
|
|
(loop for rest-connections on (cdr (usocket:wait-for-input sockets))
|
|
|
for *connection* = (second rest-connections)
|
|
|
when (and *connection* (usocket:socket-state *connection*))
|
|
|
do (let ((*peer* (find-peer-by-property (peer-registry-of this) *connection*)))
|
|
|
(when (process-input)
|
|
|
(pop (cdr rest-connections)))))
|
|
|
(cond
|
|
|
((usocket:socket-state info-socket) (%accept info-socket))
|
|
|
((usocket:socket-state proxy-socket) (%accept proxy-socket))))))))))
|
|
|
(with-slots (proxy-server info-server peer-registry) this
|
|
|
(labels ((process-condition (e)
|
|
|
(log:error "Server event: ~A" e))
|
|
|
(on-accept (socket)
|
|
|
(declare (ignorable socket))
|
|
|
#++ (as:set-socket-timeouts socket +client-socket-timeout+ nil))
|
|
|
(process-input (socket stream)
|
|
|
(let* ((*system* this)
|
|
|
(*connection* socket)
|
|
|
(*peer* (find-peer-by-property (peer-registry-of this) *connection*)))
|
|
|
(log-errors
|
|
|
(if (and *peer* (eq (proxy-connection-of *peer*) *connection*))
|
|
|
(route-stream stream)
|
|
|
(process-request stream)))))
|
|
|
(make-server (host port)
|
|
|
(as:tcp-server host port #'process-input
|
|
|
:event-cb #'process-condition
|
|
|
:connect-cb #'on-accept
|
|
|
:stream t)))
|
|
|
(in-new-thread "connector-thread"
|
|
|
(as:with-event-loop ()
|
|
|
(setf proxy-server (make-server "127.0.0.1" 8222)
|
|
|
info-server (make-server "127.0.0.1" 8778)))))))
|
|
|
|
|
|
|
|
|
(defmethod make-system-context ((this mortar-combat-proxy))
|
|
|
(make-instance 'mortar-combat-context))
|
|
|
|
|
|
|
|
|
(defmethod discard-system :before ((this mortar-combat-proxy))
|
|
|
(with-slots (proxy-socket info-socket) this
|
|
|
(usocket:socket-close proxy-socket)
|
|
|
(usocket:socket-close info-socket)))
|
|
|
(with-slots (proxy-server info-server) this
|
|
|
(as:close-tcp-server proxy-server)
|
|
|
(as:close-tcp-server info-server)))
|
|
|
|
|
|
|
|
|
(define-system-function find-arena mortar-combat-proxy (name)
|
|
|
|
0 comments on commit
e8a41e5