Skip to content
Permalink
Browse files

Add identify command

  • Loading branch information
borodust committed Apr 18, 2017
1 parent 4b9fc4c commit 130fc990c07cbc65687716308b680cda7f063662
Showing with 34 additions and 19 deletions.
  1. +8 −0 proxy/commands.lisp
  2. +23 −17 proxy/proxy.lisp
  3. +3 −2 proxy/utils.lisp
@@ -4,3 +4,11 @@
(defmethod process-command ((command (eql :version)) message)
(list :command :version
:version +server-version+))


(defmethod process-command ((command (eql :identify)) message)
(let* ((reg (peer-registry-of *system*))
(peer (or *peer* (register-peer reg *connection* (format nil "~A" (getf message :name))))))
(list :command :identified
:name (name-of peer)
:id (id-of peer))))
@@ -1,6 +1,7 @@
(in-package :mortar-combat.proxy)

(declaim (special *peer*))
(declaim (special *connection*))

(defvar *main-latch* (mt:make-latch))

@@ -25,29 +26,34 @@
(info-socket :initform nil)))


(defun process-request (connection)
(defun reply-to (message)
(handler-case
(process-command (getf message :command) message)
(serious-condition ()
'(:command :error
:type :unhandled-error
:text "Error during command execution"))))


(defun process-request ()
;; fixme: record connection's last communication timestamp
;; to autoclose idle connections
(let ((stream (usocket:socket-stream connection)))
(let ((stream (usocket:socket-stream *connection*)))
(when (listen stream)
;; fixme: make async: read available chunk, don't wait for more
(let ((message (conspack:decode-stream stream)))
(when (listp message)
(conspack:encode (process-command (getf message :command) message)
:stream stream)
(force-output stream)
nil)))))
(conspack:encode (reply-to message) :stream stream)
(force-output stream))))))


(defun route-stream (connection)
(declare (ignore connection))
nil)
(defun route-stream ())


(defun process-input (connection)
(if (and *peer* (eq (proxy-connection-of *peer*) connection))
(route-stream connection)
(process-request connection)))
(defun process-input ()
(if (and *peer* (eq (proxy-connection-of *peer*) *connection*))
(route-stream)
(process-request)))


(defmethod initialize-system :after ((this mortar-combat-proxy))
@@ -64,10 +70,10 @@
(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 connection)
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))
@@ -2,5 +2,6 @@


(defun make-random-uuid ()
(uuid:make-v5-uuid uuid:+namespace-x500+
(ironclad:byte-array-to-hex-string (ironclad:make-random-salt))))
(format nil "~A" (uuid:make-v5-uuid uuid:+namespace-x500+
(ironclad:byte-array-to-hex-string
(ironclad:make-random-salt)))))

0 comments on commit 130fc99

Please sign in to comment.
You can’t perform that action at this time.