Permalink
Browse files

Clean up peer data on disconnect

  • Loading branch information...
borodust committed Apr 22, 2017
1 parent 29a4b8f commit b5fa9e17ae6ceb6cbb0634123bfa848b5d7288de
Showing with 84 additions and 37 deletions.
  1. +34 −24 client/src/connector.lisp
  2. +7 −0 client/src/main.lisp
  3. +11 −1 proxy/arena.lisp
  4. +8 −0 proxy/peer.lisp
  5. +24 −12 proxy/proxy.lisp
@@ -31,26 +31,32 @@
(in-new-thread "connector-thread"
(loop while enabled-p
do (log-errors
(usocket:wait-for-input connection)
(let* ((stream (connection-stream-of this))
(message (decode-message stream))
(*connector* this))
(if-let ((reply-id (getf message :reply-for)))
(with-instance-lock-held (this)
(if-let ((handler (gethash reply-id message-table)))
(progn
(remhash reply-id message-table)
(funcall handler message))
(log:error "Handler not found for message with id ~A" reply-id)))
(when-let ((reply (process-command (getf message :command) message)))
(encode-message reply stream)
(force-output stream)))))
(handler-case
(progn
(usocket:wait-for-input connection)
(let* ((stream (connection-stream-of this))
(message (decode-message stream))
(*connector* this))
(if-let ((reply-id (getf message :reply-for)))
(with-instance-lock-held (this)
(if-let ((handler (gethash reply-id message-table)))
(progn
(remhash reply-id message-table)
(funcall handler message))
(log:error "Handler not found for message with id ~A" reply-id)))
(when-let ((reply (process-command (getf message :command) message)))
(encode-message reply stream)
(force-output stream)))))
(end-of-file ()
(setf enabled-p nil)
(log:debug "Disconnected from server"))))
finally (usocket:socket-close connection)))))
(defun disconnect-from-server (connector)
(with-slots (enabled-p) connector
(setf enabled-p nil)))
(with-slots (enabled-p connection) connector
(when enabled-p
(usocket:socket-close connection))))
(defun check-response (message expected-command)
@@ -81,15 +87,19 @@
(defmethod dispatch ((this connector) (task function) invariant &rest keys
&key &allow-other-keys)
(with-slots (message-table message-counter) this
(with-slots (enabled-p message-table message-counter) this
(with-instance-lock-held (this)
(let ((next-id (incf message-counter)))
(flet ((response-callback (message)
(let ((*message* message))
(funcall task))))
(unless (getf keys :no-reply)
(setf (gethash next-id message-table) #'response-callback))
(apply #'send-command this :message-id next-id keys))))))
(flet ((response-callback (message)
(let ((*message* message))
(funcall task))))
(if enabled-p
(let ((next-id (incf message-counter)))
(unless (getf keys :no-reply)
(setf (gethash next-id message-table) #'response-callback))
(apply #'send-command this :message-id next-id keys))
(response-callback (list :command :error
:type :disconnected
:text "Disconnected from server")))))))
(defun server-version (connector)
@@ -181,6 +181,13 @@
(run looped-flow)))))))
(defmethod discard-system ((this mortar-combat))
(with-slots (remote-server game-client game-server) this
(dolist (server (list remote-server game-client game-server))
(when server
(disconnect-from-server server)))))
(defun start (configuration-path)
(startup configuration-path (uiop:pathname-directory-pathname configuration-path)))
@@ -2,7 +2,7 @@
(defclass arena ()
((name :initarg :name :reader :name-of)
((name :initarg :name :reader name-of)
(server :initarg :server :reader server-of)
(clients :initform nil :reader clients-of)))
@@ -38,6 +38,16 @@
(setf (gethash client arena-table) arena)))
(defun remove-arena-by-server (registry server)
(with-slots (arena-table arena-by-name) registry
(when-let ((arena (find-arena-by-peer registry server)))
(when (eq (server-of arena) server)
(dolist (client (clients-of arena))
(remhash client arena-table))
(remhash (server-of arena) arena-table)
(remhash arena-by-name (name-of arena))))))
(defun find-arena-by-peer (registry peer)
(with-slots (arena-table) registry
(gethash peer arena-table)))
@@ -44,6 +44,14 @@
(gethash id peer-by-id)))
(defun remove-peer (registry peer)
(with-slots (peer-table peer-by-id) registry
(remhash (info-connection-of peer) peer-table)
(remhash (proxy-connection-of peer) peer-table)
(remhash (name-of peer) peer-table)
(remhash (id-of peer) peer-by-id)))
(defun update-peer-proxy-connection (registry peer proxy-connection)
(with-slots (peer-table) registry
(remhash (proxy-connection-of peer) peer-table)
@@ -15,7 +15,6 @@
((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-server :initform nil)))
@@ -55,13 +54,30 @@
(pour-stream stream (wrap-into-stream arena-server)))))))
(defgeneric process-condition (condition)
(:method (condition)
(log:error "Unhandled event ~A: ~A" (type-of condition) condition)))
(defun disconnect-peer (connection)
(let* ((proxy (engine-system 'mortar-combat-proxy))
(peer-reg (peer-registry-of proxy))
(arena-reg (arena-registry-of proxy)))
(when-let ((peer (find-peer-by-property peer-reg connection)))
(remove-arena-by-server arena-reg peer)
(remove-peer peer-reg peer)
(log:debug "Peer \"~A\" disconnected" (name-of peer)))))
(defmethod process-condition ((condi as:socket-eof))
(disconnect-peer (as:socket condi)))
(defmethod initialize-system :after ((this mortar-combat-proxy))
(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))
(labels ((on-accept (socket)
(when-let ((connection-timeout (property :connection-timeout)))
(as:set-socket-timeouts socket connection-timeout nil)))
(process-input (socket stream)
(let* ((*system* this)
(*connection* socket)
@@ -91,13 +107,9 @@
(as:close-tcp-server info-server)))
(define-system-function find-arena mortar-combat-proxy (name)
(with-slots (arenas) *system*
(gethash name arenas)))
(defun start ()
(startup '(:engine (:systems (mortar-combat-proxy)))))
(startup '(:engine (:systems (mortar-combat-proxy)
:log-level :debug))))
(defun stop ()

0 comments on commit b5fa9e1

Please sign in to comment.