- nio-cvs@common-lisp.net - mailman3.common-lisp.net

[nio-cvs] r35 - in branches/home/psmith/restructure: . src/buffer src/event src/io src/protocol/yarpc src/statemachine
by psmith＠common-lisp.net 15 Jan '07

15 Jan '07

Author: psmith Date: Sun Jan 14 23:00:39 2007 New Revision: 35 Added: branches/home/psmith/restructure/run-yarpc-client.lisp Modified: branches/home/psmith/restructure/src/buffer/buffer.lisp branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp branches/home/psmith/restructure/src/event/epoll.lisp branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/nio-package.lisp branches/home/psmith/restructure/src/io/nio-server.lisp branches/home/psmith/restructure/src/io/packet.lisp branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp 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 - Send packet OK Added: branches/home/psmith/restructure/run-yarpc-client.lisp ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/run-yarpc-client.lisp Sun Jan 14 23:00:39 2007 @@ -0,0 +1,11 @@ +(push :nio-debug *features*) +(require :asdf) +(require :nio-yarpc) + +(sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host "127.0.0.1" :port 9897)) :name "nio-server") +(sleep 4) +(let ((sm (nio:add-connection "127.0.0.1" 16323 'nio-yarpc:yarpc-state-machine))) +(format t "toplevel adding conn ~A~%" sm) +(format t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(test-rpc-list)"))) + + 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 Sun Jan 14 23:00:39 2007 @@ -131,17 +131,24 @@ (sb-ext:octets-to-string (bytebuffer-read-vector bb num-bytes-to-read) :external-format external-format)) +;grrr... +;(defmethod bytebuffer-write-byte ((bb byte-buffer) value) +; (cffi:%mem-set value (buffer-buf bb) :unsigned-char position) +; (inc-position bb 1)) + ;; 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 bb) 0) - 0 + (format t "bytebuffer-write-vector - called with ~A ~A"bb vec) +; (if (> (remaining bb) 0) +; 0 (progn - (clear bb) - (let ((bytes-written (cffi:mem-write-vector vec (buffer-buf bb) :unsigned-char))) - (format t "bytebuffer-write-vector - byteswritten: ~A" bytes-written) +; (clear bb) + (let ((bytes-written (cffi:mem-write-vector vec (buffer-buf bb) :unsigned-char (length vec) (buffer-position bb)))) + (format t "bytebuffer-write-vector - byteswritten: ~A~%" bytes-written) (inc-position bb bytes-written) - bytes-written)))) + bytes-written))) +;) ;; Writes data from string str to bytebuffer using specified encoding ;TODO move string-to-octets into nio-compat 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 Sun Jan 14 23:00: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 bytebuffer-read-vector bytebuffer-read-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 clear buffer-position )) Modified: branches/home/psmith/restructure/src/event/epoll.lisp ============================================================================== --- branches/home/psmith/restructure/src/event/epoll.lisp (original) +++ branches/home/psmith/restructure/src/event/epoll.lisp Sun Jan 14 23:00:39 2007 @@ -76,14 +76,14 @@ #+nio-debug (format t "poll-events called with :event-queue ~A~%" event-queue) (with-foreign-object (events 'epoll-event +epoll-size+) (memzero events (* +epoll-event-size+ +epoll-size+)) - (loop for res = (%epoll-wait event-queue events +epoll-size+ -1) + (loop for res = (%epoll-wait event-queue events +epoll-size+ 1000) do (progn #+nio-debug (format t "poll-events - dealing with ~A~%" res) (case res (-1 (error 'poll-error)) - (0 nil) + (return nil) (t (let ((idents nil)) (loop for i from 0 below res do Modified: branches/home/psmith/restructure/src/io/async-fd.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/async-fd.lisp (original) +++ branches/home/psmith/restructure/src/io/async-fd.lisp Sun Jan 14 23:00:39 2007 @@ -47,18 +47,19 @@ (read-fd :initarg :read-fd :accessor read-fd) - (foreign-read-buffer :initform (byte-buffer 4096)) - (foreign-write-buffer :initform (byte-buffer 4096) + (foreign-read-buffer :initform (byte-buffer 1024) + :accessor foreign-read-buffer) + (foreign-write-buffer :initform (byte-buffer 1024) :accessor foreign-write-buffer) ;; (lisp-read-buffer :initform (make-uint8-seq 1024)) ;; (lisp-read-buffer-write-ptr :initform 0) - (read-ready-p :initform nil - :accessor read-ready-p + (read-ready :initform nil + :accessor read-ready :documentation "Have we been notified as read ready and not received EAGAIN from %read?") - (write-ready-p :initform nil - :accessor write-ready-p + (write-ready :initform nil + :accessor write-ready :documentation "Have we been notified as write ready and not received EAGAIN from %write?") (close-pending :initform nil) @@ -73,21 +74,28 @@ (defmethod print-object ((async-fd async-fd) stream) - (with-slots (read-fd write-fd) async-fd - (format stream "#<ASYNC-FD r/w fd: ~D/~D.>" - read-fd write-fd))) + (with-slots (socket read-fd write-fd) async-fd + (format stream "#<ASYNC-FD :socket ~D :read-fd ~D :write-fd ~D.>" + socket read-fd write-fd))) +;;Implement this in concrete SM for read +(defgeneric process-read (async-fd)) + +;;Implement this in concrete SM for read +(defgeneric process-write (async-fd)) -;;SM factory + + +;Loop over state machines calling process-outgoing-packets via state-machine::process-write + +;;SM factory (defun create-state-machine(sm-type read-fd write-fd socket) (let ((sm (make-instance sm-type :read-fd read-fd :write-fd write-fd :socket socket))) (format t "create-state-machine - Created ~S~%" sm) - (nio-buffer:flip (foreign-write-buffer sm)) + (nio-buffer:clear (foreign-read-buffer sm)) + (nio-buffer:clear (foreign-write-buffer sm)) sm)) -;;Implement this in concrete SM for read -(defgeneric process-read (async-fd)) - ;;override this in concrete SM for close ;(defmethod process-close((async-fd async-fd)reason)()) (defmethod process-close((async-fd async-fd)reason)()) @@ -108,9 +116,9 @@ (with-slots (foreign-read-buffer read-fd) state-machine (format t "read-more called with ~A~%" state-machine) -#+nio-debug (format t "read-more - calling read()~%") +#+nio-debug (format t "read-more - calling read() into ~A~%" foreign-read-buffer) (let ((new-bytes (%read read-fd (buffer-buf foreign-read-buffer) (remaining foreign-read-buffer)))) -#+nio-debug (format t "read-more : Read ~A bytes~%" new-bytes) +#+nio-debug (format t "read-more : Read ~A bytes into ~A~%" new-bytes foreign-read-buffer) (cond ((< new-bytes 0) (progn @@ -124,13 +132,8 @@ nil);;(throw 'end-of-file nil)) (t - (progn ;;Update buffer position - (inc-position foreign-read-buffer new-bytes) - -#+nio-debug (format t "read-more prior to process :buffer ~A~%" foreign-read-buffer) - (process-read state-machine))))))) - + (inc-position foreign-read-buffer new-bytes)))))) (defun close-async-fd (async-fd) "Close ASYNC-FD's fd after everything has been written from write-queue." @@ -149,33 +152,38 @@ (defun write-more (async-fd) "Write data from ASYNC-FD's write bytebuffer" -#+nio-debug (format t "write-more called with ~A~%" async-fd) +#+nio-debug (format t "async-fd:write-more - called with ~A~%" async-fd) (with-slots (write-fd foreign-write-buffer close-pending) async-fd - (setf (write-ready-p async-fd) t) -#+nio-debug (format t "foreign-write-buffer b4 flip ~A~%" foreign-write-buffer) +#+nio-debug (format t "async-fd:write-more - foreign-write-buffer b4 flip ~A~%" foreign-write-buffer) (nio-buffer:flip foreign-write-buffer) -#+nio-debug (format t "foreign-write-buffer after flip ~A~%" foreign-write-buffer) +#+nio-debug (format t "async-fd:write-more -foreign-write-buffer after flip ~A~%" foreign-write-buffer) (let ((now-written 0)) (do ((total-written 0)) ((or (eql now-written -1) (eql (remaining foreign-write-buffer) 0)) total-written) (progn (setf now-written (%write write-fd (buffer-buf foreign-write-buffer) (remaining foreign-write-buffer))) - - (format t "after write :foreign-write-buffer ~A :now-written ~A :total-written ~A ~%" foreign-write-buffer now-written total-written) + (when (not (eql now-written -1)) (inc-position foreign-write-buffer now-written) - (incf total-written now-written)))) + (incf total-written now-written))) +#+nio-debug (format t "async-fd:write-more - after write :foreign-write-buffer ~A :now-written ~A :total-written ~A ~%" foreign-write-buffer now-written total-written) + ) + + (if (eql now-written -1) ;;Deal with failure - (when (eql now-written -1) (let ((err (get-errno))) (format t "write-more - write returned -1 :errno ~A~%" err) (unless (eql err 11) ;; eagain - failed to write whole buffer need to wait for next notify (let ((err-cond (make-instance 'write-error :error err))) (close err-cond) - (error err-cond)))))) + (error err-cond)))) + ;;update buffers + (if (eql (remaining foreign-write-buffer) 0) + (clear foreign-write-buffer) + (error 'not-implemented-yet)))) #+nio-debug (format t "write buffer after write :~A~%" foreign-write-buffer) (when (eql (remaining foreign-write-buffer) 0) Modified: branches/home/psmith/restructure/src/io/nio-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/nio-package.lisp (original) +++ branches/home/psmith/restructure/src/io/nio-package.lisp Sun Jan 14 23:00:39 2007 @@ -29,13 +29,13 @@ (:export ;; async-fd.lisp - async-fd process-read foreign-read-buffer foreign-write-buffer close-sm + async-fd process-read process-write foreign-read-buffer foreign-write-buffer close-sm ;; async-socket.lisp ;;nio-server - start-server + start-server add-connection ;;packet - packet + packet write-bytes )) Modified: branches/home/psmith/restructure/src/io/nio-server.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/nio-server.lisp (original) +++ branches/home/psmith/restructure/src/io/nio-server.lisp Sun Jan 14 23:00:39 2007 @@ -33,6 +33,28 @@ ;; (format t "Accepting connection from ~S:~D [~A].~%" host port proto) t) +;TODO thread safety +(defparameter +connected-sockets+ nil + "List of sockets that have been connected and are awaiting addition to the event-notification system") + +;loop over hashtable +(defun process-async-fds (client-hash) + (maphash #'(lambda (k async-fd) + (format t "Dealing with ~a => ~a~%" k async-fd) + + ;process reads + (when (read-ready async-fd) (read-more async-fd)) + (when (> (buffer-position (foreign-read-buffer async-fd)) 0) + (process-read async-fd)) + + ;process-writes + (process-write async-fd) + (when (write-ready async-fd) (write-more async-fd))) + client-hash)) + + + + (defun start-server (connection-handler accept-filter connection-type &key (protocol :inet) @@ -70,9 +92,8 @@ (declare (ignore cond)) (format t "Poll-error, exiting..~%") (throw 'poll-error-exit nil)))) - - (loop for unix-epoll-events = (poll-events event-queue) do - + + (loop for unix-epoll-events = (poll-events event-queue) do (loop for (fd . event) in unix-epoll-events do (cond @@ -113,10 +134,41 @@ (force-close-async-fd async-fd) (throw 'error-exit nil)))) - (when (read-event-p event) (read-more async-fd)) - (when (write-event-p event) (write-more async-fd)) - ))) - )) - ))))) + (when (read-event-p event) (setf (read-ready async-fd) t)) + (when (write-event-p event) (setf (write-ready async-fd) t)))))))) + (format t "Process client adds~%") + + ;add outgoing sockets to event queue + (format t "start-server::sockets enqueued ~A~%" +connected-sockets+) + (loop for new-fd in +connected-sockets+ do + (format t "Dealing with ~A~%" new-fd) + (setf (gethash (async-fd-read-fd new-fd) client-hash) new-fd) + (add-async-fd event-queue new-fd :read-write)) + + ;TODO thread safety + (setf +connected-sockets+ nil) + + ;loop over async-fd's processing where necessary + (process-async-fds client-hash) + )))) (ignore-errors (close-fd sock)))) + + +(defun add-connection (host port connection-type + &key + (protocol :inet) + + ) + (let ((sock nil)) + (setq sock (ecase protocol + (:inet (make-inet-socket)) + (:inet6 (make-inet6-socket)))) + + (if (connect-inet-socket sock host port) + (let ((sm (create-state-machine connection-type sock sock sock))) + (push sm +connected-sockets+) + (format t "add-connection::sockets enqueued ~A~%" +connected-sockets+) + (return-from add-connection sm)) + (format t "Connect failed!!~A ~%" (get-errno))))) + \ No newline at end of file Modified: branches/home/psmith/restructure/src/io/packet.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/packet.lisp (original) +++ branches/home/psmith/restructure/src/io/packet.lisp Sun Jan 14 23:00:39 2007 @@ -28,13 +28,13 @@ ;; state-machines instantiate packets for the associated protocol ;; either based on incomming data from a packet factory or in -;; preperation for sending a packet for the current protocol. +;; preparation for sending a packet for the current protocol. +;; +;; All concete packets implement write-bytes for xfer to the io layer -;; All concete packets implement get-bytes for xfer to the io layer (defclass packet () ()) -(defmethod get-bytes((a-packet packet)) - ()) - +;Implement in concrete +(defgeneric write-bytes(packet nio-buffer)) 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 14 23:00:39 2007 @@ -29,5 +29,5 @@ (:export ;; yarpc-state-machine - yarpc-state-machine yarpc-state-machine-factory test-rpc test-rpc-list test-rpc-string get-packet-factory + yarpc-state-machine yarpc-state-machine-factory test-rpc test-rpc-list test-rpc-string get-packet-factory remote-execute )) 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 Sun Jan 14 23:00:39 2007 @@ -35,11 +35,11 @@ (defun yarpc-packet-factory () (make-instance 'yarpc-packet-factory)) -(defconstant CALL-METHOD-PACKET-ID 0) +(defconstant CALL-METHOD-PACKET-ID #x0) (defconstant METHOD-RESPONSE-PACKET-ID 1) (defmethod get-packet ((pf yarpc-packet-factory) buf) - (nio-buffer:flip 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) @@ -49,6 +49,17 @@ (defclass call-method-packet (packet)((call-string :initarg :call :accessor get-call-string))) +(defmethod print-object ((packet call-method-packet) stream) + (format stream "#<CALL-METHOD-PACKET ~A >" (get-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)) + (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf) ) + + (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 Sun Jan 14 23:00:39 2007 @@ -40,7 +40,10 @@ ;; (test-rpc "who" 2 's) ;; response - who 2 'S ;; -(defclass yarpc-state-machine (state-machine)()) +(defclass yarpc-state-machine (state-machine) + ((outgoing-packet :initarg :outgoing-packet + :accessor outgoing-packet + :initform nil))) (defun yarpc-state-machine () (make-instance 'yarpc-state-machine)) @@ -88,8 +91,16 @@ (define-condition authorization-error (error) ()) + +(defmethod process-outgoing-packet((sm yarpc-state-machine)) + (format t "process-outgoing-packet called~%") + (let ((packet (outgoing-packet sm))) + (setf (outgoing-packet sm) nil) + packet)) + + ;Process a call method packet, returns -(defmethod process-packet ((sm yarpc-state-machine) (call call-method-packet)) +(defmethod process-incomming-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 @@ -111,3 +122,7 @@ (apply (first rpc-call-list) (rest rpc-call-list)) (error 'authorization-error)))) + +(defmethod remote-execute ((sm yarpc-state-machine) call-string) + (setf (outgoing-packet sm) (make-instance 'call-method-packet :call call-string))) + \ No newline at end of file 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 Sun Jan 14 23:00:39 2007 @@ -29,5 +29,5 @@ (:export ;; state-machine - state-machine packet-factory get-packet-factory get-packet + state-machine packet-factory get-packet-factory get-packet process-outgoing-packet process-incoming-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 Sun Jan 14 23:00:39 2007 @@ -32,7 +32,7 @@ ;Base class for state machines ; ;Converts incomming data between bytes and packets using the supplied packet-factory. -;Converts outgoing data between packets and bytes using the get-bytes method on packet. +;Converts outgoing data between packets and bytes using the write-bytes method on packet. ; ;This way only the protocols packet heirarchy knows about binary representations and ; the SM can deal with protocol logic and state maintenance @@ -42,21 +42,32 @@ (defmethod print-object ((sm state-machine) stream) (format stream "#<STATE-MACHINE ~A >" (call-next-method sm nil))) -(defgeneric process-packet(state-machine packet)) +(defgeneric process-incomming-packet(state-machine packet)) + + +(defgeneric process-outgoing-packet(state-machine)) + (defgeneric get-packet-factory(state-machine)) +;The connection is read ready. +;Use the packet factory to obtain any valid packet and pass it through (defmethod process-read((sm state-machine)) - (with-slots (foreign-read-buffer foreign-write-buffer) sm + (with-slots (foreign-read-buffer) 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) - )))))) + (when (not (process-incomming-packet sm incomming-packet)) + (close-sm sm)))))) + +;The connection is write ready. +;See if theres anything ready to be written in the SM +(defmethod process-write((sm state-machine)) + (with-slots (foreign-write-buffer) sm + (let ((outgoing-packet (process-outgoing-packet sm))) + (format t "state-machine::process-write - outgoing packet: ~A~%" outgoing-packet) + (when outgoing-packet (write-bytes outgoing-packet foreign-write-buffer))))) + @@ -65,7 +76,3 @@ ; 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)))

1 0

[nio-cvs] r34 - branches/home/psmith/restructure/src/io
by psmith＠common-lisp.net 15 Jan '07

15 Jan '07

Author: psmith Date: Sun Jan 14 21:51:30 2007 New Revision: 34 Modified: branches/home/psmith/restructure/src/io/async-socket.lisp Log: Corrected socketaddr-in structure for linux Added connect functionalilty Modified: branches/home/psmith/restructure/src/io/async-socket.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/async-socket.lisp (original) +++ branches/home/psmith/restructure/src/io/async-socket.lisp Sun Jan 14 21:51:30 2007 @@ -36,6 +36,7 @@ (defconstant +sock-stream+ 1) (defconstant +sock-dgram+ 2) +#+(or darwin macosx freebsd) (defcstruct sockaddr-in (len :uint8) (family :uint8) @@ -43,6 +44,13 @@ (addr :uint32) (zero :char :count 8)) +#+linux +(defcstruct sockaddr-in + (family :uint16) + (port :uint16) + (addr :uint32) + (zero :char :count 8)) + (defconstant +sockaddr-in-len+ #.(+ 1 1 2 4 8)) (defcstruct sockaddr-in6 @@ -82,6 +90,12 @@ (sockaddr :pointer) (socklen :pointer)) +(defcfun ("connect" %connect) :int + (socket :int) + (sockaddr :pointer) + (socklent :int)) + + ;;TODO put backlog on config (defun start-listen (socket-fd &optional (backlog 1000)) (%listen socket-fd backlog)) @@ -92,25 +106,42 @@ (defun make-inet-socket (&optional (type :tcp)) (%socket +af-inet+ (ecase type (:tcp +sock-stream+) (:udp +sock-dgram+)) 0)) -(defun bind-inet-socket (socket-fd port &optional (addr "127.0.0.1")) - (with-foreign-object (sa 'sockaddr-in) + +(defun init-inet-socket(sa port addr) (memzero sa +sockaddr-in-len+) ;; init struct - (setf (foreign-slot-value sa 'sockaddr-in 'len) +sockaddr-in-len+ - (foreign-slot-value sa 'sockaddr-in 'port) (%htons port) + #+(or darwin macosx freebsd) + (setf (foreign-slot-value sa 'sockaddr-in 'len) +sockaddr-in-len+) + + (setf (foreign-slot-value sa 'sockaddr-in 'port) (%htons port) (foreign-slot-value sa 'sockaddr-in 'family) +af-inet+) ;; set addr (if (/= (%inet-pton +af-inet+ addr (foreign-slot-pointer sa 'sockaddr-in 'addr)) 1) - (error "inet_pton: Bad address ~A!" addr)) + (error "inet_pton: Bad address ~A!" addr))) + + +(defun bind-inet-socket (socket-fd port &optional (addr "127.0.0.1")) + (with-foreign-object (sa 'sockaddr-in) + (init-inet-socket sa port addr) ;; bind (if (= (%bind socket-fd sa +sockaddr-in-len+) 0) t nil))) +(defun connect-inet-socket (socket-fd addr port) + (with-foreign-object (sa 'sockaddr-in) + (init-inet-socket sa port addr) + + (let ((res (%connect socket-fd sa +sockaddr-in-len+))) + (format t "connect ~A ~A~%" res (get-errno)) + (if (= res -1) + nil + t)))) + ;;;; IPv6 @@ -146,6 +177,7 @@ (remote-port :initform nil :initarg :remote-port))) + (defun socket-accept (socket-fd connection-type) "Accept connection from SOCKET-FD. Allocates and returns socket structure denoting the connection."

1 0

[nio-cvs] r33 - in branches/home/psmith/restructure: . src/buffer src/protocol/yarpc src/statemachine
by psmith＠common-lisp.net 12 Jan '07

12 Jan '07

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)))

1 0

[nio-cvs] r32 - branches/home/psmith/restructure/src/statemachine
by psmith＠common-lisp.net 08 Jan '07

08 Jan '07

Author: psmith Date: Mon Jan 8 14:03:57 2007 New Revision: 32 Added: branches/home/psmith/restructure/src/statemachine/ branches/home/psmith/restructure/src/statemachine/nio-sm-package.lisp branches/home/psmith/restructure/src/statemachine/nio-sm.asd branches/home/psmith/restructure/src/statemachine/state-machine.lisp Log: Start of state-machine class work Added: branches/home/psmith/restructure/src/statemachine/nio-sm-package.lisp ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/src/statemachine/nio-sm-package.lisp Mon Jan 8 14:03:57 2007 @@ -0,0 +1,33 @@ +#| +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. +|# +(defpackage :nio-sm (:use :cl :nio :nio-buffer) + + (:export + + ;; state-machine + state-machine + )) Added: branches/home/psmith/restructure/src/statemachine/nio-sm.asd ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/src/statemachine/nio-sm.asd Mon Jan 8 14:03:57 2007 @@ -0,0 +1,11 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- + +(in-package :asdf) + +(defsystem :nio-sm + + :components ((:file "nio-sm-package") + (:file "state-machine" :depends-on ("nio-sm-package")) + ) + + :depends-on (:nio)) \ No newline at end of file Added: branches/home/psmith/restructure/src/statemachine/state-machine.lisp ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/src/statemachine/state-machine.lisp Mon Jan 8 14:03:57 2007 @@ -0,0 +1,52 @@ +#| +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-sm) + +(declaim (optimize (debug 3) (speed 3) (space 0))) + +; +;Base class for state machines +; +;Converts incomming data between bytes and packets using the supplied packet-factory. +;Converts outgoing data between packets and bytes using the get-bytes method on packet. +; +;This way only the protocols packet heirarchy knows about binary representations and +; the SM can deal with protocol logic and state maintenance +; +(defclass state-machine (async-fd)()) + +(defmethod print-object ((sm state-machine) stream) + (format stream "#<STATE-MACHINE ~A >" (call-next-method sm nil))) + +(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)))) + +

1 0

[nio-cvs] r31 - branches/home/psmith/restructure/src/protocol/yarpc
by psmith＠common-lisp.net 08 Jan '07

08 Jan '07

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

1 0

[nio-cvs] r30 - branches/home/psmith/restructure/src/protocol/yarpc
by psmith＠common-lisp.net 07 Jan '07

07 Jan '07

Author: psmith Date: Sun Jan 7 15:08:46 2007 New Revision: 30 Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Log: Start of remote authorization 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 15:08:46 2007 @@ -38,7 +38,7 @@ ;; Connected to 127.0.0.1. ;; Escape character is '^]'. ;; (test-rpc "who" 2 's) -;; response - who 2 'S ∑ +;; response - who 2 'S ;; (defclass yarpc-state-machine (async-fd)()) @@ -58,8 +58,17 @@ (rpc-call-list (read-from-string call-string ))) (apply (first rpc-call-list) (rest rpc-call-list)))) -(defun test-rpc-list() + +(defmacro defremote (name args &rest body) + `(defun ,name (,@args) ,@body)) + + +(defremote test-rpc-list() (list 3 "as" 's (code-char #x2211))) -(defun test-rpc-string(a b c) +(defremote test-rpc-string(a b c) (format nil "response - ~A ~A ~A ~A~%" a b c (code-char #x2211))) + + +(defremote my-remote-fn (arg1 arg2) + (format t "~A~A~%" arg1 arg2)) \ No newline at end of file

1 0

[nio-cvs] r29 - branches/home/psmith/restructure/src/protocol/yarpc
by psmith＠common-lisp.net 06 Jan '07

06 Jan '07

Author: psmith Date: Sat Jan 6 01:08:44 2007 New Revision: 29 Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Log: yarpc: allow return types other than 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 Sat Jan 6 01:08:44 2007 @@ -49,7 +49,7 @@ (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 fn-result 0 :utf-8) + (nio-buffer:bytebuffer-write-string foreign-write-buffer (write-to-string fn-result) 0 :utf-8) (close-sm sm)))) @@ -58,6 +58,8 @@ (rpc-call-list (read-from-string call-string ))) (apply (first rpc-call-list) (rest rpc-call-list)))) +(defun test-rpc-list() + (list 3 "as" 's (code-char #x2211))) -(defun test-rpc(a b c) +(defun test-rpc-string(a b c) (format nil "response - ~A ~A ~A ~A~%" a b c (code-char #x2211)))

1 0

[nio-cvs] r28 - in branches/home/psmith/restructure/src: buffer protocol/http protocol/yarpc
by psmith＠common-lisp.net 06 Jan '07

06 Jan '07

Author: psmith Date: Sat Jan 6 00:28:54 2007 New Revision: 28 Modified: branches/home/psmith/restructure/src/buffer/buffer.lisp branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp branches/home/psmith/restructure/src/protocol/http/http-state-machine.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Log: tidy up 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 Sat Jan 6 00:28:54 2007 @@ -78,16 +78,16 @@ (defclass byte-buffer (buffer)()) (defun byte-buffer (capacity) - (make-instance 'byte-buffer :capacity capacity :limit capacity :position 0 :buf (foreign-alloc :uint8 :count capacity))) + (make-instance 'byte-buffer :capacity capacity :limit capacity :position 0 :buf (cffi:foreign-alloc :uint8 :count capacity))) (defmethod print-object ((byte-buffer byte-buffer) stream) (with-slots (capacity position limit buf) byte-buffer - (format stream "<byte-buffer :capacity ~A :position ~A :limit ~A :buf ~%~A>~%" capacity position limit (if buf (hex-dump-memory (pointer-address buf) limit) nil)))) + (format stream "<byte-buffer :capacity ~A :position ~A :limit ~A :buf ~%~A>~%" capacity position limit (if buf (hex-dump-memory (cffi:pointer-address buf) limit) nil)))) (defmethod free-buffer((byte-buffer byte-buffer)) (with-slots (capacity position limit buf) byte-buffer - (foreign-free buf) + (cffi:foreign-free buf) (setf buf NIL) (setf capacity 0) (setf limit 0) @@ -140,23 +140,13 @@ 0 (progn (clear byte-buffer) - (let ((bytes-written (mem-write-vector vec (buffer-buf byte-buffer) :unsigned-char))) + (let ((bytes-written (cffi:mem-write-vector vec (buffer-buf byte-buffer) :unsigned-char))) (format t "bytebuffer-write-vector - byteswritten: ~A" bytes-written) (inc-position byte-buffer bytes-written) bytes-written)))) -(defmethod map-to-foreign ((byte-buffer byte-buffer) seq &optional (start 0) (end (length seq))) - "Map SEQ to foreign array." - (clear byte-buffer) - (let* ((len (- end start))) - (loop for i from 0 below len do - (setf (mem-aref (buffer-buf byte-buffer) :uint8 i) (aref seq (+ start i))))) - (inc-position byte-buffer end)) - - - -(defcfun ("memset" %memset) :pointer +(cffi:defcfun ("memset" %memset) :pointer (buffer :pointer) (byte :int) (len :int)) 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 Sat Jan 6 00:28:54 2007 @@ -24,8 +24,8 @@ (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-buffer (:use :cl :cffi) +(defpackage :nio-buffer (:use :cl) (:export - byte-buffer free-buffer remaining inc-position get-string buffer-buf bytebuffer-write-vector bytebuffer-write-string flip map-to-foreign + byte-buffer free-buffer remaining inc-position get-string buffer-buf bytebuffer-write-vector bytebuffer-write-string flip )) Modified: branches/home/psmith/restructure/src/protocol/http/http-state-machine.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/http/http-state-machine.lisp (original) +++ branches/home/psmith/restructure/src/protocol/http/http-state-machine.lisp Sat Jan 6 00:28:54 2007 @@ -38,7 +38,7 @@ (defmethod process-read((sm http-state-machine)) (with-slots (foreign-read-buffer foreign-write-buffer) sm #+nio-debug (format t "process-read got: ~A~%" (get-string foreign-read-buffer)) - (nio-buffer:map-to-foreign foreign-write-buffer (get-bytes (http-response :status :ok :html "<html> ock </html>"))) + (nio-buffer:bytebuffer-write-vector foreign-write-buffer (get-bytes (http-response :status :ok :html "<html> ock </html>"))) (close-sm sm))) 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 Sat Jan 6 00:28:54 2007 @@ -39,7 +39,7 @@ ;; Escape character is '^]'. ;; (test-rpc "who" 2 's) ;; response - who 2 'S ∑ - +;; (defclass yarpc-state-machine (async-fd)()) (defmethod print-object ((sm yarpc-state-machine) stream)

1 0

[nio-cvs] r27 - in branches/home/psmith/restructure: . patches src/buffer src/protocol/yarpc
by psmith＠common-lisp.net 06 Jan '07

06 Jan '07

Author: psmith Date: Fri Jan 5 23:42:00 2007 New Revision: 27 Added: branches/home/psmith/restructure/TODO branches/home/psmith/restructure/run-http.lisp - copied unchanged from r25, branches/home/psmith/restructure/run.lisp branches/home/psmith/restructure/run-yarpc.lisp - copied, changed from r25, branches/home/psmith/restructure/run.lisp branches/home/psmith/restructure/run.sh (contents, props changed) branches/home/psmith/restructure/src/protocol/yarpc/ 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 Removed: branches/home/psmith/restructure/run.lisp Modified: branches/home/psmith/restructure/patches/cffi_0.9.2-mem_rw.diff branches/home/psmith/restructure/src/buffer/buffer.lisp branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp Log: Added first steps of YetAnotherRPC protocol Added: branches/home/psmith/restructure/TODO ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/TODO Fri Jan 5 23:42:00 2007 @@ -0,0 +1,14 @@ +Do eagain queue + +Look into possibility of using chunga for chunked encoding on top of +nio-buffer for http. + +Reinstate nio-httpd with new structure (dependency on above). + +Simple API: Consider buffered-state-machine layer which just buffers +everything and assumes we have enough memory, which will allow classic +coding style for people who dont need direct memory / low level control. + +Create UDP server + +Create RPC server / client Modified: branches/home/psmith/restructure/patches/cffi_0.9.2-mem_rw.diff ============================================================================== --- branches/home/psmith/restructure/patches/cffi_0.9.2-mem_rw.diff (original) +++ branches/home/psmith/restructure/patches/cffi_0.9.2-mem_rw.diff Fri Jan 5 23:42:00 2007 @@ -18,7 +18,7 @@ > (defun mem-write-vector (vector ptr type &optional (count (length vector)) (offset 0)) > (loop for i below count > for off from offset by (%foreign-type-size type) -> do (setf (%mem-ref ptr type off) (aref vector i)) +> do (%mem-set (aref vector i) ptr type off) > finally (return i))) > > Copied: branches/home/psmith/restructure/run-yarpc.lisp (from r25, branches/home/psmith/restructure/run.lisp) ============================================================================== --- branches/home/psmith/restructure/run.lisp (original) +++ branches/home/psmith/restructure/run-yarpc.lisp Fri Jan 5 23:42:00 2007 @@ -1,4 +1,4 @@ (push :nio-debug *features*) (require :asdf) -(require :nio-http) -(nio:start-server 'identity 'identity 'nio-http:http-state-machine :host "127.0.0.1") +(require :nio-yarpc) +(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host "127.0.0.1") Added: branches/home/psmith/restructure/run.sh ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/run.sh Fri Jan 5 23:42:00 2007 @@ -0,0 +1,7 @@ +#!/bin/bash +# +# run.sh <http|yarpc> +# + +export LANG=en_US.UTF-8 +sbcl --load run-$1.lisp 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 5 23:42:00 2007 @@ -129,9 +129,9 @@ ;;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)) +(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 :ascii))) + (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)) 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 5 23:42:00 2007 @@ -27,5 +27,5 @@ (defpackage :nio-buffer (:use :cl :cffi) (:export - byte-buffer free-buffer remaining inc-position get-string buffer-buf bytebuffer-write-vector flip map-to-foreign + byte-buffer free-buffer remaining inc-position get-string buffer-buf bytebuffer-write-vector bytebuffer-write-string flip map-to-foreign )) Added: branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp Fri Jan 5 23:42:00 2007 @@ -0,0 +1,33 @@ +#| +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. +|# +(defpackage :nio-yarpc (:use :cl :nio :nio-buffer) + + (:export + + ;; yarpc-state-machine + yarpc-state-machine test-rpc + )) Added: branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc.asd ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc.asd Fri Jan 5 23:42:00 2007 @@ -0,0 +1,11 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- + +(in-package :asdf) + +(defsystem :nio-yarpc + + :components ((:file "nio-yarpc-package") + (:file "yarpc-state-machine" :depends-on ("nio-yarpc-package")) + ) + + :depends-on (:nio)) \ No newline at end of file Added: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Fri Jan 5 23:42:00 2007 @@ -0,0 +1,63 @@ +#| +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))) + +;; YetAnotherRPC state machine +;; +;; A server that processes remote procedure calls and returns results +;; +;; Test with: +;; > telnet 127.0.0.1 16323 +;; Trying 127.0.0.1... +;; Connected to 127.0.0.1. +;; Escape character is '^]'. +;; (test-rpc "who" 2 's) +;; response - who 2 'S ∑ + +(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 fn-result 0 :utf-8) + (close-sm sm)))) + + +(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 test-rpc(a b c) + (format nil "response - ~A ~A ~A ~A~%" a b c (code-char #x2211)))

1 0

[nio-cvs] r26 - branches/home/psmith/restructure/src/event
by psmith＠common-lisp.net 04 Jan '07

04 Jan '07

Author: psmith Date: Thu Jan 4 18:20:01 2007 New Revision: 26 Modified: branches/home/psmith/restructure/src/event/event-notification.lisp Log: Added dependency for errno to event-notification Modified: branches/home/psmith/restructure/src/event/event-notification.lisp ============================================================================== --- branches/home/psmith/restructure/src/event/event-notification.lisp (original) +++ branches/home/psmith/restructure/src/event/event-notification.lisp Thu Jan 4 18:20:01 2007 @@ -24,6 +24,6 @@ (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 :event-notification (:use :cl :cffi) +(defpackage :event-notification (:use :cl :cffi :nio-compat) (:export make-event-queue add-fd remove-fd poll-events poll-error read-event-p write-event-p)) \ No newline at end of file

1 0