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 (,@args) ,@body)) - + `(progn + (defun ,name (,@args) ,@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