[nio-cvs] r31 - branches/home/psmith/restructure/src/protocol/yarpc

[psmith at common-lisp.net]

Author: psmith
Date: Sun Jan  7 21:41:42 2007
New Revision: 31

Modified:
   branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp
   branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp
Log:
rpc progress

Modified: branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp
==============================================================================
--- branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp	(original)
+++ branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp	Sun Jan  7 21:41:42 2007
@@ -29,5 +29,5 @@
 	    (:export
 
 	     ;; yarpc-state-machine
-	     yarpc-state-machine test-rpc
+	     yarpc-state-machine test-rpc test-rpc-list test-rpc-string
 	     ))

Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp
==============================================================================
--- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp	(original)
+++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp	Sun Jan  7 21:41:42 2007
@@ -42,26 +42,18 @@
 ;;
 (defclass yarpc-state-machine (async-fd)())
 
-(defmethod print-object ((sm yarpc-state-machine) stream)
-  (format stream "#<YARPC-STATE-MACHINE ~A >" (call-next-method sm nil)))
 
-(defmethod process-read((sm yarpc-state-machine))
-  (with-slots (foreign-read-buffer foreign-write-buffer) sm
-    (let ((fn-result (execute-call (sb-ext:octets-to-string (get-string foreign-read-buffer) :external-format :ascii))))
-      (format t "process-read - function result: ~A~%" fn-result)
-      (nio-buffer:bytebuffer-write-string foreign-write-buffer (write-to-string fn-result) 0 :utf-8)
-      (close-sm sm))))
+;;TODO move somewhere suitable
 
+(defparameter *remote-fns* nil)
 
-(defun execute-call (call-string)
-  (let* ((*package* (find-package :nio-yarpc))
-         (rpc-call-list (read-from-string call-string )))
-    (apply (first rpc-call-list) (rest rpc-call-list))))
-
+(defun register-remote-fn(name)
+    (push name *remote-fns*))
 
 (defmacro defremote (name args &rest body)
-  `(defun ,name (, at args) , at body))
-
+  `(progn 
+     (defun ,name (, at args) , at body)
+     (register-remote-fn #',name)))
 
 (defremote test-rpc-list()
   (list 3 "as" 's (code-char #x2211)))
@@ -69,6 +61,36 @@
 (defremote test-rpc-string(a b c)
   (format nil "response - ~A ~A ~A ~A~%" a b c (code-char #x2211)))
 
+;;end move TODO
+
+
+;;;Utils
+
+(defun print-hashtable (table &optional (stream t))
+  (maphash #'(lambda (k v) (format stream "~a -> ~a~%" k v)) table))
+;;;
+
+
+(defmethod print-object ((sm yarpc-state-machine) stream)
+  (format stream "#<YARPC-STATE-MACHINE ~A >" (call-next-method sm nil)))
+
+(defmethod process-read((sm yarpc-state-machine))
+  (with-slots (foreign-read-buffer foreign-write-buffer) sm
+    (let ((fn-result (execute-call (sb-ext:octets-to-string (get-string foreign-read-buffer) :external-format :ascii))))
+      (format t "process-read - function result: ~A~%" fn-result)
+      (nio-buffer:bytebuffer-write-string foreign-write-buffer (write-to-string fn-result) 0 :utf-8)
+      (close-sm sm))))
+
+
+(define-condition authorization-error (error) ())
+
+(defun execute-call (call-string)
+  (handler-case
+      (let* ((rpc-call-list (read-from-string call-string ))
+	     (fn (member (symbol-function (first rpc-call-list)) *remote-fns* )))
+	(format t "fn - ~A authorised? : ~A~%" (symbol-function (first rpc-call-list)) fn)
+	(if fn
+	    (apply (first rpc-call-list) (rest rpc-call-list))
+	    (error 'authorization-error)))
+    (reader-error (re) (format t "No such function ~A~%" call-string))))
 
-(defremote my-remote-fn (arg1 arg2) 
-  (format t "~A~A~%" arg1 arg2))
\ No newline at end of file