Add peer registry

borodust · Apr 18, 2017 · 4b9fc4cc77426b9b604f1df6679324cfa2d4640d · 4b9fc4c
1 parent bbf0592
commit 4b9fc4cc77426b9b604f1df6679324cfa2d4640d
Unified Split

Showing with 94 additions and 31 deletions.

+4 −2 mortar-combat.asd

+7 −0 proxy/arena.lisp

+0 −5 proxy/context.lisp

+53 −0 proxy/peer.lisp

+24 −24 proxy/proxy.lisp

+6 −0 proxy/utils.lisp
diff --git a/mortar-combat.asd b/mortar-combat.asd
@@ -43,10 +43,12 @@
  :mailto "dev@borodust.org"
  :license "GPLv3"
  :depends-on (log4cl cl-muth cl-conspack usocket flexi-streams
-                      cl-bodge/engine cl-bodge/utils)
+                      cl-bodge/engine cl-bodge/utils ironclad uuid)
  :serial t
  :pathname "proxy/"
  :components ((:file "packages")
-               (:file "context")
+               (:file "utils")
+               (:file "arena")
+               (:file "peer")
               (:file "proxy")
               (:file "commands")))
diff --git a/proxy/arena.lisp b/proxy/arena.lisp
@@ -0,0 +1,7 @@
+(in-package :mortar-combat.proxy)
+
+
+(defclass arena ()
+  ((name)
+   (serving-socket)
+   (client-sockets)))
diff --git a/proxy/context.lisp b/proxy/context.lisp
diff --git a/proxy/peer.lisp b/proxy/peer.lisp
@@ -0,0 +1,53 @@
+(in-package :mortar-combat.proxy)
+
+
+(defclass peer ()
+  ((id :initarg :id :reader id-of)
+   (name :initarg :name :reader name-of)
+   (info-connection :initarg :info-connection :reader info-connection-of)
+   (proxy-connection :initform nil :reader proxy-connection-of)))
+
+
+(defclass peer-registry ()
+  ((peer-table :initform (make-hash-table :test #'equal))
+   (peer-by-id :initform (make-hash-table :test #'equal))))
+
+
+(defun register-peer (registry connection name)
+  (with-slots (peer-table peer-by-id) registry
+    (with-hash-entries ((info connection)
+                        (peer-by-name name))
+        peer-table
+      (when info
+        (error "Peer was already registered for provided connection ~A" info))
+      (when peer-by-name
+        (error "Peer with name ~A exists" name))
+      (let* ((id (loop for id = (make-random-uuid)
+                    while (gethash id peer-by-id)
+                    finally (return id)))
+             (peer (make-instance 'peer
+                                  :id id
+                                  :name name
+                                  :info-connection connection)))
+        (setf info peer
+              name peer
+              (gethash id peer-by-id) peer)
+        peer))))
+
+
+(defun find-peer-by-property (registry value)
+  (with-slots (peer-table) registry
+    (gethash value peer-table)))
+
+
+(defun find-peer-by-id (registry id)
+  (with-slots (peer-by-id) registry
+    (gethash id peer-by-id)))
+
+
+(defun update-peer-proxy-connection (registry peer proxy-connection)
+  (with-slots (peer-table) registry
+    (with-slots ((peer-proxy proxy-connection)) peer
+      (remhash (proxy-connection-of peer) peer-table)
+      (setf peer-proxy proxy-connection
+            (gethash proxy-connection peer-table) peer))))
diff --git a/proxy/proxy.lisp b/proxy/proxy.lisp
@@ -1,5 +1,6 @@
 (in-package :mortar-combat.proxy)

+(declaim (special *peer*))

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

@@ -17,61 +18,60 @@

 (defclass mortar-combat-proxy (enableable generic-system)
  ((proxy-socket :initform nil)
-   (socket-table :initform (make-hash-table))
+   (peer-registry :initform (make-instance 'peer-registry) :reader peer-registry-of)
+   (arenas :initform (make-hash-table :test #'equal))
   (routing-buffer :initform (make-array +routing-buffer-size+
                                         :element-type '(unsigned-byte 8)))
   (info-socket :initform nil)))


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


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


-(defun process-input (this connection)
-  (with-slots (socket-table) this
-    (ecase (gethash connection socket-table)
-      (:info (process-request this connection))
-      (:proxy (route-stream this connection)))))
+(defun process-input (connection)
+  (if (and *peer* (eq (proxy-connection-of *peer*) connection))
+      (route-stream connection)
+      (process-request connection)))


 (defmethod initialize-system :after ((this mortar-combat-proxy))
-  (with-slots (proxy-socket info-socket socket-table) this
+  (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)))
-        (flet ((%accept (passive-socket type)
-                 (let ((active-socket (usocket:socket-accept passive-socket)))
-                   (setf (gethash active-socket socket-table) type)
-                   (push active-socket (cddr sockets)))))
+      (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 (when (process-input this connection)
-                         (pop (cdr rest-connections))))
+                    do (let ((*peer* (find-peer-by-property (peer-registry-of this) connection)))
+                         (when (process-input connection)
+                           (pop (cdr rest-connections)))))
                 (cond
-                   ((usocket:socket-state info-socket) (%accept info-socket :info))
-                   ((usocket:socket-state proxy-socket) (%accept info-socket :proxy))))))))))
+                   ((usocket:socket-state info-socket) (%accept info-socket))
+                   ((usocket:socket-state proxy-socket) (%accept proxy-socket))))))))))


 (defmethod make-system-context ((this mortar-combat-proxy))
diff --git a/proxy/utils.lisp b/proxy/utils.lisp
@@ -0,0 +1,6 @@
+(in-package :mortar-combat.proxy)
+
+
+(defun make-random-uuid ()
+  (uuid:make-v5-uuid uuid:+namespace-x500+
+                     (ironclad:byte-array-to-hex-string (ironclad:make-random-salt))))