[nio-cvs] r33 - in branches/home/psmith/restructure: . src/buffer src/protocol/yarpc src/statemachine
psmith at common-lisp.net
psmith at common-lisp.net
Fri Jan 12 06:44:45 UTC 2007
Author: psmith
Date: Fri Jan 12 01:44:39 2007
New Revision: 33
Added:
branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp
Modified:
branches/home/psmith/restructure/run-yarpc.lisp
branches/home/psmith/restructure/src/buffer/buffer.lisp
branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp
branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp
branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc.asd
branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp
branches/home/psmith/restructure/src/statemachine/nio-sm-package.lisp
branches/home/psmith/restructure/src/statemachine/state-machine.lisp
Log:
yarpc progress...
Modified: branches/home/psmith/restructure/run-yarpc.lisp
==============================================================================
--- branches/home/psmith/restructure/run-yarpc.lisp (original)
+++ branches/home/psmith/restructure/run-yarpc.lisp Fri Jan 12 01:44:39 2007
@@ -1,4 +1,5 @@
(push :nio-debug *features*)
(require :asdf)
(require :nio-yarpc)
+
(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host "127.0.0.1")
Modified: branches/home/psmith/restructure/src/buffer/buffer.lisp
==============================================================================
--- branches/home/psmith/restructure/src/buffer/buffer.lisp (original)
+++ branches/home/psmith/restructure/src/buffer/buffer.lisp Fri Jan 12 01:44:39 2007
@@ -118,33 +118,37 @@
(setf position 0)
byte-buffer))
+;reads bytes from byte-buffer and returns a vector (unsigned-byte 8)
+(defmethod bytebuffer-read-vector((bb byte-buffer) &optional (num-bytes-to-read (remaining bb)))
+ (let ((vec (make-uint8-seq num-bytes-to-read)))
+ (with-slots (buf) bb
+ (inc-position bb (cffi:mem-read-vector vec (buffer-buf bb) :unsigned-char num-bytes-to-read)))
+ vec))
+
+; Read bytes from bytebuffer abd return a string using the supplied decoding
+;TODO move octets-to-string into nio-compat
+(defmethod bytebuffer-read-string((bb byte-buffer) &optional (num-bytes-to-read (remaining bb)) (external-format :ascii))
+ (sb-ext:octets-to-string (bytebuffer-read-vector bb num-bytes-to-read) :external-format external-format))
-(defmethod get-string((byte-buffer byte-buffer))
- (flip byte-buffer)
- (with-slots (position limit buf) byte-buffer
- (let ((tmp (make-uint8-seq (remaining byte-buffer))))
- (inc-position byte-buffer (cffi:mem-read-vector tmp buf :unsigned-char limit))
- (format t " read: ~A~%" (sb-ext:octets-to-string tmp :external-format :ascii))
- tmp)))
-
-;;TODO
-;;mem-write-vector (vector ptr type &optional (count (length vector)) (offset 0))
-(defmethod bytebuffer-write-string((byte-buffer byte-buffer) str &optional (index 0) (external-format :ascii))
- :documentation "Returns number of bytes written to bytebuffer"
- (bytebuffer-write-vector byte-buffer (sb-ext:string-to-octets str :external-format external-format)))
-;;TODO rename
-(defmethod bytebuffer-write-vector((byte-buffer byte-buffer) vec &optional (index 0))
+;; Write bytes from vector vec to bytebuffer
+(defmethod bytebuffer-write-vector((bb byte-buffer) vec)
:documentation "Returns number of bytes written to bytebuffer"
- (if (> (remaining byte-buffer) 0)
+ (if (> (remaining bb) 0)
0
(progn
- (clear byte-buffer)
- (let ((bytes-written (cffi:mem-write-vector vec (buffer-buf byte-buffer) :unsigned-char)))
+ (clear bb)
+ (let ((bytes-written (cffi:mem-write-vector vec (buffer-buf bb) :unsigned-char)))
(format t "bytebuffer-write-vector - byteswritten: ~A" bytes-written)
- (inc-position byte-buffer bytes-written)
+ (inc-position bb bytes-written)
bytes-written))))
+;; Writes data from string str to bytebuffer using specified encoding
+;TODO move string-to-octets into nio-compat
+(defmethod bytebuffer-write-string((bb byte-buffer) str &optional (external-format :ascii))
+ :documentation "Returns number of bytes written to bytebuffer"
+ (bytebuffer-write-vector bb (sb-ext:string-to-octets str :external-format external-format)))
+
(cffi:defcfun ("memset" %memset) :pointer
(buffer :pointer)
@@ -168,7 +172,7 @@
(format t "Remaining ~A~%" (remaining mybuf))
- (format t "mybuf string ~A~%" (get-string mybuf))
+ (format t "mybuf string ~A~%" (bytebuffer-read-string mybuf))
(format t "Mybuf (after get-string): ~A~%" mybuf)
Modified: branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp
==============================================================================
--- branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp (original)
+++ branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp Fri Jan 12 01:44:39 2007
@@ -27,5 +27,5 @@
(defpackage :nio-buffer (:use :cl)
(:export
- byte-buffer free-buffer remaining inc-position get-string buffer-buf bytebuffer-write-vector bytebuffer-write-string flip
+ byte-buffer free-buffer remaining inc-position get-string buffer-buf bytebuffer-write-vector bytebuffer-write-string bytebuffer-read-vector bytebuffer-read-string flip
))
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 Fri Jan 12 01:44:39 2007
@@ -24,10 +24,10 @@
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|#
-(defpackage :nio-yarpc (:use :cl :nio :nio-buffer)
+(defpackage :nio-yarpc (:use :cl :nio :nio-sm :nio-buffer)
(:export
;; yarpc-state-machine
- yarpc-state-machine test-rpc test-rpc-list test-rpc-string
+ yarpc-state-machine yarpc-state-machine-factory test-rpc test-rpc-list test-rpc-string get-packet-factory
))
Modified: branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc.asd
==============================================================================
--- branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc.asd (original)
+++ branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc.asd Fri Jan 12 01:44:39 2007
@@ -5,7 +5,8 @@
(defsystem :nio-yarpc
:components ((:file "nio-yarpc-package")
- (:file "yarpc-state-machine" :depends-on ("nio-yarpc-package"))
+ (:file "yarpc-packet-factory" :depends-on ("nio-yarpc-package"))
+ (:file "yarpc-state-machine" :depends-on ("yarpc-packet-factory"))
)
- :depends-on (:nio))
\ No newline at end of file
+ :depends-on (:nio :nio-sm))
\ No newline at end of file
Added: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp
==============================================================================
--- (empty file)
+++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp Fri Jan 12 01:44:39 2007
@@ -0,0 +1,54 @@
+#|
+Copyright (c) 2007
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+3. The name of the author may not be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+|#
+(in-package :nio-yarpc)
+
+(declaim (optimize (debug 3) (speed 3) (space 0)))
+
+;;
+(defclass yarpc-packet-factory (packet-factory)())
+
+
+(defun yarpc-packet-factory ()
+ (make-instance 'yarpc-packet-factory))
+
+(defconstant CALL-METHOD-PACKET-ID 0)
+(defconstant METHOD-RESPONSE-PACKET-ID 1)
+
+(defmethod get-packet ((pf yarpc-packet-factory) buf)
+ (nio-buffer: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 (bytebuffer-read-string buf (remaining buf)))))
+ (1 (format t "got METHOD-RESPONSE-PACKET-ID~%")))))
+
+(defclass call-method-packet (packet)((call-string :initarg :call
+ :accessor get-call-string)))
+
+(defclass method-response-packet (packet)())
+
+
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 Fri Jan 12 01:44:39 2007
@@ -40,8 +40,15 @@
;; (test-rpc "who" 2 's)
;; response - who 2 'S
;;
-(defclass yarpc-state-machine (async-fd)())
+(defclass yarpc-state-machine (state-machine)())
+(defun yarpc-state-machine ()
+ (make-instance 'yarpc-state-machine))
+
+(defparameter yarpc-pf (yarpc-packet-factory))
+
+(defmethod get-packet-factory((sm yarpc-state-machine))
+ yarpc-pf)
;;TODO move somewhere suitable
@@ -74,23 +81,33 @@
(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))))
+(defconstant STATE-INITIALISED 0)
+(defconstant STATE-SEND-RESPONSE 1)
+(defparameter state STATE-INITIALISED)
(define-condition authorization-error (error) ())
-(defun execute-call (call-string)
+;Process a call method packet, returns
+(defmethod process-packet ((sm yarpc-state-machine) (call call-method-packet))
+ ;todo change state, create method-response packet and return it
+ ;(assert (eql state 0))
(handler-case
+ (let ((result (execute-call (get-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)))))
+
+
+(defun execute-call (call-string)
(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))))
+ (error 'authorization-error))))
Modified: branches/home/psmith/restructure/src/statemachine/nio-sm-package.lisp
==============================================================================
--- branches/home/psmith/restructure/src/statemachine/nio-sm-package.lisp (original)
+++ branches/home/psmith/restructure/src/statemachine/nio-sm-package.lisp Fri Jan 12 01:44:39 2007
@@ -29,5 +29,5 @@
(:export
;; state-machine
- state-machine
+ state-machine packet-factory get-packet-factory get-packet
))
Modified: branches/home/psmith/restructure/src/statemachine/state-machine.lisp
==============================================================================
--- branches/home/psmith/restructure/src/statemachine/state-machine.lisp (original)
+++ branches/home/psmith/restructure/src/statemachine/state-machine.lisp Fri Jan 12 01:44:39 2007
@@ -42,11 +42,30 @@
(defmethod print-object ((sm state-machine) stream)
(format stream "#<STATE-MACHINE ~A >" (call-next-method sm nil)))
+(defgeneric process-packet(state-machine packet))
+
+(defgeneric get-packet-factory(state-machine))
+
(defmethod process-read((sm 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))))
+ (let ((incomming-packet (get-packet (get-packet-factory sm) foreign-read-buffer)))
+ (format t "state-machine::process-read - incomming packet: ~A~%" incomming-packet)
+ (when incomming-packet
+ (multiple-value-bind (ret-packet close) (process-packet sm incomming-packet)
+ (format t "state-machine::process-read - return packet: ~A~%" ret-packet)
+ (when ret-packet (put-packet ret-packet foreign-write-buffer))
+ (if close
+ (close-sm sm)
+ ))))))
+
+
+(defclass packet-factory ()
+ ())
+
+; Get the packet in buf using the packet factory
+(defgeneric get-packet (packet-factory buf))
+; Write the packet to the buffer
+(defun put-packet (packet buf)
+ (nio-buffer:bytebuffer-write-vector buf (get-bytes packet)))
More information about the Nio-cvs
mailing list