Skip to content
Browse files

Add :exit-arena message

Add additional checking for handling arenas
  • Loading branch information
borodust committed Apr 22, 2017
1 parent b5fa9e1 commit 687a95e5dc5ad0e3157e6cc912146a2a5b6eee4a
Showing with 62 additions and 28 deletions.
  1. +0 −5 client/src/connector.lisp
  2. +2 −2 client/src/main.lisp
  3. +0 −1 client/src/proxy.lisp
  4. +2 −1 common/packages.lisp
  5. +5 −0 common/process-command.lisp
  6. +11 −1 proxy/arena.lisp
  7. +37 −17 proxy/commands.lisp
  8. +5 −1 proxy/proxy.lisp
@@ -74,11 +74,6 @@
(finish-output stream)))

(defmacro with-message ((&rest properties) message &body body)
`(destructuring-bind (&key ,@properties &allow-other-keys) ,message

(defmacro with-response ((&rest properties) command-name &body body)
`(with-message (,@properties) *message*
(check-response *message* ,command-name)
@@ -52,8 +52,8 @@
(run (>> (register-game-stream client (server-identity-id identity))
(join-arena remote-server name)
(instantly ()
(setf game-client client))))
(register-player client (server-identity-name identity)))))
(setf game-client client)
(register-player client (server-identity-name identity))))))))

(defun ping-game-server ()

This file was deleted.

@@ -6,4 +6,5 @@
(:export +ok-reply+
@@ -5,6 +5,11 @@
:test #'equal)

(defmacro with-message ((&rest properties) message &body body)
`(destructuring-bind (&key ,@properties &allow-other-keys) ,message

(defgeneric process-command (command message)
(:method (command message)
(list :command :error
@@ -45,14 +45,24 @@
(dolist (client (clients-of arena))
(remhash client arena-table))
(remhash (server-of arena) arena-table)
(remhash arena-by-name (name-of arena))))))
(remhash (name-of arena) arena-by-name)))))

(defun find-arena-by-peer (registry peer)
(with-slots (arena-table) registry
(gethash peer arena-table)))

(defun remove-peer-from-arena (registry peer)
(when-let ((arena (find-arena-by-peer registry peer)))
(if (eq peer (server-of arena))
(remove-arena-by-server registry peer)
(with-slots (clients) arena
(with-slots (arena-table) registry
(deletef clients peer)
(remhash peer arena-table))))))

(defun find-arena-by-name (registry name)
(with-slots (arena-by-name) registry
(gethash name arena-by-name)))
@@ -19,9 +19,11 @@
(reg (peer-registry-of *system*))
(peer (or *peer* (register-peer reg *connection* (format nil "~A" name)))))
(if peer
(list :command :identified
:name (name-of peer)
:id (id-of peer))
(log:debug "Peer '~A' identified" name)
(list :command :identified
:name (name-of peer)
:id (id-of peer)))
(list :command :error
:type :name-unavailable
:text (format nil "Name '~A' taken" name)))))
@@ -34,29 +36,47 @@

(defmethod process-command ((command (eql :create-arena)) message)
(destructuring-bind (&key name &allow-other-keys) message
(if-let ((arena (register-arena (arena-registry-of *system*) (format nil "~A" name) *peer*)))
(with-message (name) message
(let ((reg (arena-registry-of *system*)))
(if-let ((assigned-arena (find-arena-by-peer reg *peer*)))
(list :command :error
:type :arena-exist
:text (format nil "Arena with name '~A' exists" name))))))
:type :already-in-arena
:text (format nil "Already assigned to '~A' arena" (name-of assigned-arena)))
(if-let ((arena (register-arena reg (format nil "~A" name) *peer*)))
(list :command :error
:type :arena-exist
:text (format nil "Arena with name '~A' exists" name))))))))

(defmethod process-command ((command (eql :join-arena)) message)
(destructuring-bind (&key name &allow-other-keys) message
(let ((reg (arena-registry-of *system*)))
(if-let ((arena (find-arena-by-name reg name)))
(with-message (name) message
(let* ((reg (arena-registry-of *system*))
(client-arena (find-arena-by-peer reg *peer*))
(requested-arena (find-arena-by-name reg name)))
((and client-arena (or (eq *peer* (server-of client-arena))
(not (eq client-arena requested-arena))))
(list :command :error
:type :already-in-arena
:text (format nil "Already joined '~A' arena" (name-of requested-arena))))
((null requested-arena)
(list :command :error
:type :arena-not-found
:text (format nil "Arena with name '~A' not found" name)))
;; fixme: add client limit
(prog1 +ok-reply+
(add-arena-client reg arena *peer*))
(list :command :error
:type :arena-not-found
:text (format nil "Arena with name '~A' not found" name)))))))
(t (prog1 +ok-reply+
(add-arena-client reg requested-arena *peer*))))))))

(defmethod process-command ((command (eql :exit-arena)) message)
(remove-peer-from-arena (arena-registry-of *system*) *peer*)))

(defmethod process-command ((command (eql :register-game-stream)) message)
(destructuring-bind (&key peer-id &allow-other-keys) message
(with-message (peer-id) message
(let ((reg (peer-registry-of *system*)))
(if-let ((peer (find-peer-by-id reg peer-id)))
(prog1 +ok-reply+
@@ -66,13 +66,17 @@
(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)))))
(log:debug "Peer '~A' disconnected" (name-of peer)))))

(defmethod process-condition ((condi as:socket-eof))
(disconnect-peer (as:socket condi)))

(defmethod process-condition ((condi as:socket-reset))
(log:warn "Peer disconnected unexpectedly"))

(defmethod initialize-system :after ((this mortar-combat-proxy))
(with-slots (proxy-server info-server peer-registry) this
(labels ((on-accept (socket)

0 comments on commit 687a95e

Please sign in to comment.