Author: psmith Date: Mon Jan 15 01:49:25 2007 New Revision: 37 Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Log: yarpc roundtrip complete Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp Mon Jan 15 01:49:25 2007 @@ -36,30 +36,48 @@ (make-instance 'yarpc-packet-factory)) (defconstant CALL-METHOD-PACKET-ID #x0) -(defconstant METHOD-RESPONSE-PACKET-ID 1) +(defconstant METHOD-RESPONSE-PACKET-ID #x1) (defmethod get-packet ((pf yarpc-packet-factory) buf) (flip buf) -; (format t "get-packet::read string - ~A~%" (bytebuffer-read-string buf (remaining buf))) - (if (>= (remaining buf) 1) ;; First byte denotes packet ID - (ecase (elt (bytebuffer-read-vector buf 1) 0) - (0 (progn (format t "got CALL-METHOD-PACKET-ID~%") (make-instance 'call-method-packet :call (bytebuffer-read-string buf (remaining buf))))) - (1 (format t "got METHOD-RESPONSE-PACKET-ID~%"))))) + (let ((ret (if (> (remaining buf) 0) ;; First byte denotes packet ID + (ecase (elt (bytebuffer-read-vector buf 1) 0) + (0 (progn (format t "got CALL-METHOD-PACKET-ID~%") (call-method-packet (bytebuffer-read-string buf (remaining buf))))) + (1 (progn (format t "got METHOD-RESPONSE-PACKET-ID~%") (method-response-packet (bytebuffer-read-string buf (remaining buf))))))))) + (if (> (remaining buf) 0) + (error 'not-implemented-yet) + (clear buf)) + ret)) -(defclass call-method-packet (packet)((call-string :initarg :call - :accessor get-call-string))) +(defclass call-method-packet (packet)((call-string :initarg :call-string + :accessor call-string))) + +(defun call-method-packet (call-string) + (make-instance 'call-method-packet :call-string call-string)) (defmethod print-object ((packet call-method-packet) stream) - (format stream "#<CALL-METHOD-PACKET ~A >" (get-call-string packet))) + (format stream "#<CALL-METHOD-PACKET ~A >" (call-string packet))) (defmethod write-bytes((packet call-method-packet) buf) (format t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) ; (nio-buffer:flip buf) (nio-buffer:bytebuffer-write-vector buf #(#x0)) - (nio-buffer:bytebuffer-write-string buf (get-call-string packet)) + (nio-buffer:bytebuffer-write-string buf (call-string packet)) (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf) ) -(defclass method-response-packet (packet)()) +(defclass method-response-packet (packet) + ((response :initarg :response + :accessor response))) + +(defun method-response-packet (response) + (make-instance 'method-response-packet :response response)) +(defmethod print-object ((packet method-response-packet) stream) + (format stream "#<METHID-RESPONSE-PACKET ~A >" (response packet))) +(defmethod write-bytes((packet method-response-packet) buf) + (format t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) + (nio-buffer:bytebuffer-write-vector buf #(#x1)) + (nio-buffer:bytebuffer-write-string buf (write-to-string (response packet))) + (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf) ) 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 Mon Jan 15 01:49:25 2007 @@ -98,22 +98,28 @@ (setf (outgoing-packet sm) nil) packet)) +;TODO queue and thread stuf +(defmethod queue-outgoing-packet((sm yarpc-state-machine) packet) + (setf (outgoing-packet sm) packet)) ;Process a call method packet, returns (defmethod process-incoming-packet ((sm yarpc-state-machine) (call call-method-packet)) - ;todo change state, create method-response packet and return it - ;(assert (eql state 0)) + (assert (eql state STATE-INITIALISED)) (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm call) (handler-case - (let ((result (execute-call (get-call-string call)))) + (let ((result (execute-call (call-string call)))) (when result (let ((response-packet (progn (setf state STATE-SEND-RESPONSE) - (method-response-packet result)))) - (values response-packet t)))) - (reader-error (re) (format t "No such function ~A~%" (get-call-string call))) - (authorization-error (ae) (format t "Function not declared with defremote ~A~%" (get-call-string call))))) - + (queue-outgoing-packet sm (method-response-packet result))))) + t))) + (reader-error (re) (format t "No such function ~A~%" (call-string call))) + (authorization-error (ae) (format t "Function not declared with defremote ~A~%" (call-string call))))) + +(defmethod process-incoming-packet ((sm yarpc-state-machine) (response method-response-packet)) + (assert (eql state STATE-INITIALISED)) + (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm response)) + (defun execute-call (call-string) (let* ((rpc-call-list (read-from-string call-string )) @@ -125,5 +131,5 @@ (defmethod remote-execute ((sm yarpc-state-machine) call-string) - (setf (outgoing-packet sm) (make-instance 'call-method-packet :call call-string))) + (queue-outgoing-packet sm (make-instance 'call-method-packet :call-string call-string))) \ No newline at end of file