[noctool-cvs] CVS source

[imattsson]

Update of /project/noctool/cvsroot/source
In directory clnet:/tmp/cvs-serv12629

Modified Files:
	network.lisp packages.lisp 
Added Files:
	network-utils.lisp network-globals.lisp 
Log Message:
IM

Split the network file into three (network, network-globals, network-utils)
to make space for a DEHANDLER macro (to define protocll handlers).
We're now dispatching protocol messages keyed off the protocol request
via a hash-table, pointing at the function we want to call.

Also exported OBJECT from the main noctool package.


--- /project/noctool/cvsroot/source/network.lisp	2008/06/14 16:18:04	1.2
+++ /project/noctool/cvsroot/source/network.lisp	2008/06/15 10:45:23	1.3
@@ -1,13 +1,5 @@
 (in-package #:net.hexapodia.noctool-network)
 
-(defvar *incoming* nil)
-(defvar *local-address* "localhost")
-(defvar *local-port* 11378)
-(defvar *net-package* (find-package :net.hexapodia.noctool-network))
-(defvar *stop-accept-loop* nil "Variable to control if we need to stop the accept loop")
-(defvar *connections* nil)
-(defvar *class-map* (make-hash-table))
-
 (defclass connection ()
   ((peer :accessor peer :initarg :peer)
    (buffer :accessor buffer :initarg :buffer)
@@ -259,10 +251,49 @@
 		     (find-class class-id)))
 	      (t (error "Unknown class"))))))
 
+(defun get-proxy (id)
+  (gethash id *proxies*))
+
+(defun (setf get-proxy) (new id)
+  (setf (gethash id *proxies*) new))
+
 (defun terminate-conn (conn)
   (setf (state conn) :terminated)
   (setf *connections* (delete conn *connections*)))
 
+(defhandler request-proxy-class (request-proxy-class class-name)
+  (let ((objects (get-class class-name)))
+    (send-proxy-list conn objects)))
+
+(defhandler request-proxy-equipment (request-proxy-equipment eq-id)
+  (let ((equipment (find eq-id *equipment* :key #'id)))
+    (when equipment
+      (send-proxy-equipment conn equipment))))
+
+(defhandler proxy-equipment (proxy-equipment &rest modifiers)
+  (let ((classes nil)
+	(monitors nil)
+	(id nil)
+	(name nil))
+    (loop for (opname . opvals) in modifiers
+	  do (case opname
+	       (id (setf id (car opvals)))
+	       (classes (setf classes opvals))
+	       (monitors (setf monitors opvals))
+	       (name (setf name (car opvals)))))
+    (let ((proxy (get-proxy id)))
+      (let ((object (if proxy
+			(object proxy)
+			(make-instance (car classes) :id id :name name))))
+	(unless proxy
+	  (let ((proxy (make-instance 'proxy
+				      :remote-node (peer conn)
+				      :object object)))
+	    (setf (get-proxy id) proxy)))
+	(when (and monitors (null (monitors object)))
+	  ;; Build monitor list and chuck it on the monitors-list
+	  )))))
+
 (defun handle-peer (conn)
   (let ((msg (handle-read conn)))
     (unless (null msg)
@@ -299,11 +330,8 @@
 				       (terminate-conn conn))))))))))
 	      (:validated
 	       (when (check-signature conn message signature)
-		 (case head
-		   (request-proxy-class (destructuring-bind (req class)
-					    msg
-					  (declare (ignorable req))
-					  (send-proxy-list conn
-					   (get-class class))))
-		   ))))
+		 (let ((handler (gethash head *handler-map*)))
+		   (cond (handler (apply handler conn msg))
+			 (t (protocol-error conn))))
+		 )))
 	  (error () (protocol-error conn)))))))
--- /project/noctool/cvsroot/source/packages.lisp	2008/06/14 16:18:04	1.7
+++ /project/noctool/cvsroot/source/packages.lisp	2008/06/15 10:45:25	1.8
@@ -17,7 +17,7 @@
   (:use #:cl #:usocket #:net.hexapodia.noctool-scheduler #:net.hexapodia.noctool-graphs
 	#+sbcl :sb-mop)
   (:export
-   #:*proxies* #:*peers* #:*equipment* #:*views* #:*noctool-package* #:id #:last-updated #:unix-host #:linux-host #:cpu-monitor #:load-monitor #:ping-monitor #:remote-node #:decode-base64 #:encode-base64 #:octetify #:destination #:alert-level #:conn #:monitors #:my-name #:my-passwd #:serialize-data #:remote-node #:dst-port #:remote-passwd #:name #:graph-type
+   #:*proxies* #:*peers* #:*equipment* #:*views* #:*noctool-package* #:id #:last-updated #:unix-host #:linux-host #:cpu-monitor #:load-monitor #:ping-monitor #:remote-node #:decode-base64 #:encode-base64 #:octetify #:destination #:alert-level #:conn #:monitors #:my-name #:my-passwd #:serialize-data #:remote-node #:dst-port #:remote-passwd #:name #:graph-type #:object
    ))
 
 (defpackage #:net.hexapodia.noctool-config

--- /project/noctool/cvsroot/source/network-utils.lisp	2008/06/15 10:45:28	NONE
+++ /project/noctool/cvsroot/source/network-utils.lisp	2008/06/15 10:45:28	1.1
(in-package :net.hexapodia.noctool-network)

(defmacro defhandler (name (proto-sym &rest llist) &body body)
  "Define a handler for VALIDATED part of a connection, it will add an
argument called CONN as the very first element. This is the connection
that the request came in over. Validation of the signature is done before
any dispatching. The first argument should be the protocol symbol to dispatch
on, it is declared as IGNORABLE, the rest of the parameters should map
to the protocol request."
  (setf (gethash proto-sym *handler-map*) name)
  `(defun ,name (conn ,proto-sym , at llist)
    (declare (ignorable ,proto-sym))
    , at body))
--- /project/noctool/cvsroot/source/network-globals.lisp	2008/06/15 10:45:28	NONE
+++ /project/noctool/cvsroot/source/network-globals.lisp	2008/06/15 10:45:28	1.1
(in-package :net.hexapodia.noctool-network)

(defvar *incoming* nil)
(defvar *local-address* "localhost")
(defvar *local-port* 11378)
(defvar *net-package* (find-package :net.hexapodia.noctool-network))
(defvar *stop-accept-loop* nil "Variable to control if we need to stop the accept loop")
(defvar *connections* nil)
(defvar *class-map* (make-hash-table))

(defvar *handler-map* (make-hash-table))

(defvar *proxies* (make-hash-table))