From psmith at common-lisp.net Tue Jan 2 02:31:44 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Mon, 1 Jan 2007 21:31:44 -0500 (EST) Subject: [nio-cvs] r22 - in branches/home/psmith/restructure: . src src/io src/protocol/http Message-ID: <20070102023144.3302B34061@common-lisp.net> Author: psmith Date: Mon Jan 1 21:31:43 2007 New Revision: 22 Modified: branches/home/psmith/restructure/run.lisp branches/home/psmith/restructure/src/io/async-socket.lisp branches/home/psmith/restructure/src/io/nio-package.lisp branches/home/psmith/restructure/src/nio-server.lisp branches/home/psmith/restructure/src/protocol/http/nio-http-package.lisp branches/home/psmith/restructure/src/protocol/http/nio-http.asd Log: Parameterised protocol in nio-server Modified: branches/home/psmith/restructure/run.lisp ============================================================================== --- branches/home/psmith/restructure/run.lisp (original) +++ branches/home/psmith/restructure/run.lisp Mon Jan 1 21:31:43 2007 @@ -1,5 +1,5 @@ -;;(push :nio-debug *features*) +(push :nio-debug *features*) (require :asdf) -(require :nio) +(require :nio-http) (load "src/nio-server") -(nio-server:start-server 'identity 'identity :host "127.0.0.1") +(nio-server:start-server 'identity 'identity 'nio-http:http-state-machine :host "127.0.0.1") 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 Mon Jan 1 21:31:43 2007 @@ -146,7 +146,7 @@ (remote-port :initform nil :initarg :remote-port))) -(defun socket-accept (socket-fd) +(defun socket-accept (socket-fd connection-type) "Accept connection from SOCKET-FD. Allocates and returns socket structure denoting the connection." (flet ((parse-inet6-addr (addr) @@ -170,7 +170,7 @@ ;; accept connection (let* ((res (%accept socket-fd addr len)) ;; (async-socket-fd (make-instance 'async-socket-fd :read-fd res :write-fd res))) - (async-socket-fd (create-state-machine res res (make-instance 'async-socket-fd)))) + (async-socket-fd (create-state-machine connection-type res res (make-instance 'async-socket-fd)))) (unless (< res 0) (let ((len-value (mem-ref len :unsigned-int))) 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 Mon Jan 1 21:31:43 2007 @@ -34,7 +34,7 @@ async-fd-read-fd async-fd-write-fd add-async-fd remove-async-fd set-accept-filter set-read-callback - read-error + read-error async-fd ;; async-socket.lisp make-inet-socket make-inet6-socket Modified: branches/home/psmith/restructure/src/nio-server.lisp ============================================================================== --- branches/home/psmith/restructure/src/nio-server.lisp (original) +++ branches/home/psmith/restructure/src/nio-server.lisp Mon Jan 1 21:31:43 2007 @@ -35,8 +35,11 @@ ;; (format t "Accepting connection from ~S:~D [~A].~%" host port proto) t) -(defun start-server (connection-handler accept-filter &key - (protocol :inet) (port (+ (random 60000) 1024)) (host "localhost") +(defun start-server (connection-handler accept-filter connection-type + &key + (protocol :inet) + (port (+ (random 60000) 1024)) + (host "localhost") (accept-connection #'trivial-accept)) @@ -72,12 +75,12 @@ (loop for unix-epoll-events = (poll-events event-queue) do - (loop for (fd . event) in unix-epoll-events do + (loop for (fd . event) in unix-epoll-events do (cond ;; new connection ((= fd sock) - (let ((async-fd (socket-accept fd))) + (let ((async-fd (socket-accept fd connection-type))) #+nio-debug (format t "start-server - New conn: ~A~%" async-fd) (cond ((null async-fd) Modified: branches/home/psmith/restructure/src/protocol/http/nio-http-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/http/nio-http-package.lisp (original) +++ branches/home/psmith/restructure/src/protocol/http/nio-http-package.lisp Mon Jan 1 21:31:43 2007 @@ -28,6 +28,6 @@ (:export - ;; http-response - http-response + ;; http-state-machine + http-state-machine )) Modified: branches/home/psmith/restructure/src/protocol/http/nio-http.asd ============================================================================== --- branches/home/psmith/restructure/src/protocol/http/nio-http.asd (original) +++ branches/home/psmith/restructure/src/protocol/http/nio-http.asd Mon Jan 1 21:31:43 2007 @@ -6,6 +6,7 @@ :components ((:file "nio-http-package") (:file "http-response" :depends-on ("nio-http-package")) + (:file "http-state-machine" :depends-on ("nio-http-package")) ) :depends-on (:nio)) \ No newline at end of file From psmith at common-lisp.net Thu Jan 4 01:55:34 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Wed, 3 Jan 2007 20:55:34 -0500 (EST) Subject: [nio-cvs] r23 - in branches/home/psmith/restructure: . src src/io src/protocol/http Message-ID: <20070104015534.E9F921A007@common-lisp.net> Author: psmith Date: Wed Jan 3 20:55:33 2007 New Revision: 23 Added: branches/home/psmith/restructure/README branches/home/psmith/restructure/src/io/nio-server.lisp - copied, changed from r22, branches/home/psmith/restructure/src/nio-server.lisp Removed: branches/home/psmith/restructure/src/nio-server.lisp Modified: branches/home/psmith/restructure/run.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.asd branches/home/psmith/restructure/src/protocol/http/http-response.lisp branches/home/psmith/restructure/src/protocol/http/http-state-machine.lisp branches/home/psmith/restructure/src/protocol/http/nio-http-package.lisp Log: moved nio-server into nio package narrowed nio external i/f back to base working case after restructure Added: branches/home/psmith/restructure/README ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/README Wed Jan 3 20:55:33 2007 @@ -0,0 +1,5 @@ +To run install asd's + +sbcl --load run.lisp + +wget http://localhost:16323/index.html Modified: branches/home/psmith/restructure/run.lisp ============================================================================== --- branches/home/psmith/restructure/run.lisp (original) +++ branches/home/psmith/restructure/run.lisp Wed Jan 3 20:55:33 2007 @@ -1,5 +1,4 @@ (push :nio-debug *features*) (require :asdf) (require :nio-http) -(load "src/nio-server") -(nio-server:start-server 'identity 'identity 'nio-http:http-state-machine :host "127.0.0.1") +(nio:start-server 'identity 'identity 'nio-http:http-state-machine :host "127.0.0.1") 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 Wed Jan 3 20:55:33 2007 @@ -40,10 +40,12 @@ (defclass async-fd () - ((write-fd :initarg :write-fd) + ((write-fd :initarg :write-fd + :accessor write-fd) ;; (write-queue :initform nil) - (read-fd :initarg :read-fd) + (read-fd :initarg :read-fd + :accessor read-fd) (foreign-read-buffer :initform (byte-buffer 4096)) (foreign-write-buffer :initform (byte-buffer 4096) @@ -69,16 +71,25 @@ )) -;'http-state-machine + +(defmethod print-object ((async-fd async-fd) stream) + (with-slots (read-fd write-fd) async-fd + (format stream "#" + read-fd write-fd))) + + +;;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)) sm)) -;;override this in concrete SM for read -(defmethod process-read((async-fd async-fd))()) +;;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)()) @@ -89,13 +100,6 @@ (setf close-pending t))) - -(defmethod print-object ((async-fd async-fd) stream) - (with-slots (read-fd write-fd) async-fd - (format stream "#~%" - read-fd write-fd))) - - (defclass packet () ((buffer :initarg :buffer :initform nil :documentation "Foreign array") (size :initarg :size :initform 0) @@ -114,7 +118,7 @@ ;; "Read more data from STATE-MACHINE." (defun read-more (state-machine) (with-slots (foreign-read-buffer read-fd) state-machine -#+nio-debug (format t "read-more called with ~A~%" state-machine) + (format t "read-more called with ~A~%" state-machine) #+nio-debug (format t "read-more - calling read()~%") (let ((new-bytes (%read read-fd (buffer-buf foreign-read-buffer) (remaining foreign-read-buffer)))) 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 Wed Jan 3 20:55:33 2007 @@ -29,15 +29,13 @@ (:export ;; async-fd.lisp - set-fd-nonblocking close-fd read-more write-more - async-write-seq close-async-fd force-close-async-fd - async-fd-read-fd async-fd-write-fd - add-async-fd remove-async-fd - set-accept-filter set-read-callback - read-error async-fd + async-fd process-read foreign-read-buffer foreign-write-buffer close-sm ;; async-socket.lisp - make-inet-socket make-inet6-socket - bind-inet-socket bind-inet6-socket - start-listen socket-accept remote-info + + ;;nio-server + start-server + + ;;packet + packet )) Copied: branches/home/psmith/restructure/src/io/nio-server.lisp (from r22, branches/home/psmith/restructure/src/nio-server.lisp) ============================================================================== --- branches/home/psmith/restructure/src/nio-server.lisp (original) +++ branches/home/psmith/restructure/src/io/nio-server.lisp Wed Jan 3 20:55:33 2007 @@ -24,9 +24,7 @@ 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-server (:use :cl :nio :event-notification) - (:export start-server)) -(in-package :nio-server) +(in-package :nio) (declaim (optimize (debug 3) (speed 3) (space 0))) Modified: branches/home/psmith/restructure/src/io/nio.asd ============================================================================== --- branches/home/psmith/restructure/src/io/nio.asd (original) +++ branches/home/psmith/restructure/src/io/nio.asd Wed Jan 3 20:55:33 2007 @@ -8,6 +8,7 @@ (:file "fd-helper" :depends-on ("nio-package")) (:file "async-fd" :depends-on ("fd-helper")) (:file "async-socket" :depends-on ("async-fd")) + (:file "nio-server" :depends-on ("async-socket")) ) :depends-on (:cffi :event-notification :nio-buffer :nio-compat)) Modified: branches/home/psmith/restructure/src/protocol/http/http-response.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/http/http-response.lisp (original) +++ branches/home/psmith/restructure/src/protocol/http/http-response.lisp Wed Jan 3 20:55:33 2007 @@ -69,7 +69,7 @@ (defmethod get-bytes ((http-response http-response)) (with-slots (status html) http-response - (sb-ext:string-to-octets (get-packet status "text/html" html)))) + (get-packet status "text/html" html))) 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 Wed Jan 3 20:55:33 2007 @@ -31,12 +31,15 @@ ;; A SM that speaks HTTP (defclass http-state-machine (async-fd)()) +(defmethod print-object ((sm http-state-machine) stream) + (format stream "#" (call-next-method sm nil))) + + (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)) ;;todo create packet and get-bytes - - (get-bytes (http-response :status :ok :html " ock ")) + (nio-buffer:map-to-foreign foreign-write-buffer (get-bytes (http-response :status :ok :html " ock "))) (close-sm sm))) Modified: branches/home/psmith/restructure/src/protocol/http/nio-http-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/http/nio-http-package.lisp (original) +++ branches/home/psmith/restructure/src/protocol/http/nio-http-package.lisp Wed Jan 3 20:55:33 2007 @@ -24,7 +24,7 @@ (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-http (:use :cl :nio) +(defpackage :nio-http (:use :cl :nio :nio-buffer) (:export From psmith at common-lisp.net Thu Jan 4 04:10:41 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Wed, 3 Jan 2007 23:10:41 -0500 (EST) Subject: [nio-cvs] r24 - in branches/home/psmith/restructure/src: io protocol/http Message-ID: <20070104041041.207C421013@common-lisp.net> Author: psmith Date: Wed Jan 3 23:10:39 2007 New Revision: 24 Modified: branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/nio.asd branches/home/psmith/restructure/src/protocol/http/http-state-machine.lisp Log: Corrected packet defn 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 Wed Jan 3 23:10:39 2007 @@ -99,20 +99,8 @@ (with-slots (close-pending) async-fd (setf close-pending t))) - -(defclass packet () - ((buffer :initarg :buffer :initform nil :documentation "Foreign array") - (size :initarg :size :initform 0) - (written :initarg :written :initform 0))) - - ;;; FUNCTIONS - - - - - (define-condition read-error (error) ()) ;; "Read more data from STATE-MACHINE." Modified: branches/home/psmith/restructure/src/io/nio.asd ============================================================================== --- branches/home/psmith/restructure/src/io/nio.asd (original) +++ branches/home/psmith/restructure/src/io/nio.asd Wed Jan 3 23:10:39 2007 @@ -6,6 +6,7 @@ :components ((:file "nio-package") (:file "fd-helper" :depends-on ("nio-package")) + (:file "packet" :depends-on ("nio-package")) (:file "async-fd" :depends-on ("fd-helper")) (:file "async-socket" :depends-on ("async-fd")) (:file "nio-server" :depends-on ("async-socket")) 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 Wed Jan 3 23:10:39 2007 @@ -38,13 +38,10 @@ (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)) -;;todo create packet and get-bytes (nio-buffer:map-to-foreign foreign-write-buffer (get-bytes (http-response :status :ok :html " ock "))) (close-sm sm))) -;;end TODO - (defun page-not-found (client) (serve-content client :not-found "text/html" (string-to-octets "

404 Page not found

The requested URL was not found on this server."))) From psmith at common-lisp.net Thu Jan 4 04:29:35 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Wed, 3 Jan 2007 23:29:35 -0500 (EST) Subject: [nio-cvs] r25 - branches/home/psmith/restructure/patches Message-ID: <20070104042935.D07AB25008@common-lisp.net> Author: psmith Date: Wed Jan 3 23:29:35 2007 New Revision: 25 Added: branches/home/psmith/restructure/patches/ branches/home/psmith/restructure/patches/cffi_0.9.2-mem_rw.diff Log: NIO needs following patch needed to cffi Added: branches/home/psmith/restructure/patches/cffi_0.9.2-mem_rw.diff ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/patches/cffi_0.9.2-mem_rw.diff Wed Jan 3 23:29:35 2007 @@ -0,0 +1,24 @@ +58c58,60 +< #:cancel-finalization)) +--- +> #:cancel-finalization +> #:mem-read-vector +> #:mem-write-vector)) +319a322,338 +> +> +> ;;from http://common-lisp.net/project/cffi/darcs/cffi/doc/mem-vector.txt +> +> (defun mem-read-vector (vector ptr type count &optional (offset 0)) +> (loop for i below (min count (length vector)) +> for off from offset by (%foreign-type-size type) +> do (setf (aref vector i) (%mem-ref ptr type off)) +> finally (return i))) +> +> (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)) +> finally (return i))) +> +> From psmith at common-lisp.net Thu Jan 4 23:20:02 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Thu, 4 Jan 2007 18:20:02 -0500 (EST) Subject: [nio-cvs] r26 - branches/home/psmith/restructure/src/event Message-ID: <20070104232002.953AC581BB@common-lisp.net> 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 From psmith at common-lisp.net Sat Jan 6 04:42:01 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Fri, 5 Jan 2007 23:42:01 -0500 (EST) Subject: [nio-cvs] r27 - in branches/home/psmith/restructure: . patches src/buffer src/protocol/yarpc Message-ID: <20070106044201.DAB21100D@common-lisp.net> 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 +# + +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 "#" (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))) From psmith at common-lisp.net Sat Jan 6 05:28:55 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sat, 6 Jan 2007 00:28:55 -0500 (EST) Subject: [nio-cvs] r28 - in branches/home/psmith/restructure/src: buffer protocol/http protocol/yarpc Message-ID: <20070106052855.9FB8038005@common-lisp.net> 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 "~%" capacity position limit (if buf (hex-dump-memory (pointer-address buf) limit) nil)))) + (format stream "~%" 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 " ock "))) + (nio-buffer:bytebuffer-write-vector foreign-write-buffer (get-bytes (http-response :status :ok :html " ock "))) (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) From psmith at common-lisp.net Sat Jan 6 06:08:45 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sat, 6 Jan 2007 01:08:45 -0500 (EST) Subject: [nio-cvs] r29 - branches/home/psmith/restructure/src/protocol/yarpc Message-ID: <20070106060845.7F45953010@common-lisp.net> 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))) From psmith at common-lisp.net Sun Jan 7 20:08:46 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 7 Jan 2007 15:08:46 -0500 (EST) Subject: [nio-cvs] r30 - branches/home/psmith/restructure/src/protocol/yarpc Message-ID: <20070107200846.0435D1C009@common-lisp.net> 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 (, at args) , at 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 From psmith at common-lisp.net Mon Jan 8 02:41:45 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 7 Jan 2007 21:41:45 -0500 (EST) Subject: [nio-cvs] r31 - branches/home/psmith/restructure/src/protocol/yarpc Message-ID: <20070108024145.29B4F25002@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 "#" (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 "#" (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 From psmith at common-lisp.net Mon Jan 8 19:03:58 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Mon, 8 Jan 2007 14:03:58 -0500 (EST) Subject: [nio-cvs] r32 - branches/home/psmith/restructure/src/statemachine Message-ID: <20070108190358.8C3722F027@common-lisp.net> 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 "#" (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)))) + + From psmith at common-lisp.net Fri Jan 12 06:44:45 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Fri, 12 Jan 2007 01:44:45 -0500 (EST) Subject: [nio-cvs] r33 - in branches/home/psmith/restructure: . src/buffer src/protocol/yarpc src/statemachine Message-ID: <20070112064445.603FB2D01D@common-lisp.net> 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 "#" (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 "#" (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))) From psmith at common-lisp.net Mon Jan 15 02:51:30 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 14 Jan 2007 21:51:30 -0500 (EST) Subject: [nio-cvs] r34 - branches/home/psmith/restructure/src/io Message-ID: <20070115025130.9710B3D008@common-lisp.net> 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." From psmith at common-lisp.net Mon Jan 15 04:00:43 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 14 Jan 2007 23:00:43 -0500 (EST) Subject: [nio-cvs] r35 - in branches/home/psmith/restructure: . src/buffer src/event src/io src/protocol/yarpc src/statemachine Message-ID: <20070115040043.998561E00B@common-lisp.net> 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 "#" - read-fd write-fd))) + (with-slots (socket read-fd write-fd) async-fd + (format stream "#" + 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 "#" (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 "#" (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))) From psmith at common-lisp.net Mon Jan 15 04:52:18 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 14 Jan 2007 23:52:18 -0500 (EST) Subject: [nio-cvs] r36 - in branches/home/psmith/restructure: . src/buffer src/io src/protocol/yarpc src/statemachine Message-ID: <20070115045218.809B3751A5@common-lisp.net> Author: psmith Date: Sun Jan 14 23:52:17 2007 New Revision: 36 Modified: branches/home/psmith/restructure/run-yarpc-client.lisp branches/home/psmith/restructure/src/buffer/buffer.lisp branches/home/psmith/restructure/src/io/nio-server.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/state-machine.lisp Log: yarpc ready to create response packet Modified: branches/home/psmith/restructure/run-yarpc-client.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc-client.lisp (original) +++ branches/home/psmith/restructure/run-yarpc-client.lisp Sun Jan 14 23:52:17 2007 @@ -6,6 +6,6 @@ (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)"))) +(format t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(nio-yarpc: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:52:17 2007 @@ -121,8 +121,8 @@ ;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))) + (with-slots (buf position) bb + (inc-position bb (cffi:mem-read-vector vec buf :unsigned-char num-bytes-to-read position))) vec)) ; Read bytes from bytebuffer abd return a string using the supplied decoding 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:52:17 2007 @@ -92,11 +92,11 @@ (declare (ignore cond)) (format t "Poll-error, exiting..~%") (throw 'poll-error-exit nil)))) - - (loop for unix-epoll-events = (poll-events event-queue) do + + (loop + (let ((unix-epoll-events (poll-events event-queue))) (loop for (fd . event) in unix-epoll-events do (cond - ;; new connection ((= fd sock) (let ((async-fd (socket-accept fd connection-type))) @@ -135,7 +135,7 @@ (throw 'error-exit nil)))) (when (read-event-p event) (setf (read-ready async-fd) t)) - (when (write-event-p event) (setf (write-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 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:52:17 2007 @@ -43,7 +43,7 @@ ; (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))))) + (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~%"))))) (defclass call-method-packet (packet)((call-string :initarg :call 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:52:17 2007 @@ -100,9 +100,10 @@ ;Process a call method packet, returns -(defmethod process-incomming-packet ((sm yarpc-state-machine) (call call-method-packet)) +(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)) + (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)))) (when result 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:52:17 2007 @@ -31,7 +31,7 @@ ; ;Base class for state machines ; -;Converts incomming data between bytes and packets using the supplied packet-factory. +;Converts incoming data between bytes and packets using the supplied packet-factory. ;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 @@ -42,7 +42,7 @@ (defmethod print-object ((sm state-machine) stream) (format stream "#" (call-next-method sm nil))) -(defgeneric process-incomming-packet(state-machine packet)) +(defgeneric process-incoming-packet(state-machine packet)) (defgeneric process-outgoing-packet(state-machine)) @@ -54,10 +54,10 @@ ;Use the packet factory to obtain any valid packet and pass it through (defmethod process-read((sm state-machine)) (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 - (when (not (process-incomming-packet sm incomming-packet)) + (let ((incoming-packet (get-packet (get-packet-factory sm) foreign-read-buffer))) + (format t "state-machine::process-read - incoming packet: ~A~%" incoming-packet) + (when incoming-packet + (when (not (process-incoming-packet sm incoming-packet)) (close-sm sm)))))) ;The connection is write ready. From psmith at common-lisp.net Mon Jan 15 06:49:26 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Mon, 15 Jan 2007 01:49:26 -0500 (EST) Subject: [nio-cvs] r37 - branches/home/psmith/restructure/src/protocol/yarpc Message-ID: <20070115064926.7660B4F00F@common-lisp.net> 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 "#" (get-call-string packet))) + (format stream "#" (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 "#" (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 From psmith at common-lisp.net Wed Jan 17 01:34:39 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Tue, 16 Jan 2007 20:34:39 -0500 (EST) Subject: [nio-cvs] r38 - branches/home/psmith/restructure/src/compat Message-ID: <20070117013439.A008347368@common-lisp.net> Author: psmith Date: Tue Jan 16 20:34:39 2007 New Revision: 38 Added: branches/home/psmith/restructure/src/compat/concurrent-queue.lisp Log: Added concurrent queue inter thread communication via a FIFO queue Added: branches/home/psmith/restructure/src/compat/concurrent-queue.lisp ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/src/compat/concurrent-queue.lisp Tue Jan 16 20:34:39 2007 @@ -0,0 +1,85 @@ +#| +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-compat) + +(declaim (optimize (debug 3) (speed 3) (space 0))) + +;Implements a threadsafe queue where readers wait for elements of a FIFO queue to appear using a waitqueue +;Modified from sbcl manual example + +(defclass concurrent-queue() + ((buffer-queue :initform (sb-thread:make-waitqueue) + :reader buffer-queue) + (buffer-lock :initform (sb-thread:make-mutex :name "buffer lock") + :reader buffer-lock) + (buffer :initform nil + :accessor buffer))) + +(defmacro pop-elt(a-buffer loc) + `(if ,a-buffer + (let ((head (car ,a-buffer))) + (setf ,a-buffer (cdr ,a-buffer)) +#+nio-debug (format t "reader ~A woke, read ~A as ~A~%" sb-thread:*current-thread* head ,loc) + head) + nil)) + + +(defmethod take ((queue concurrent-queue)) + (sb-thread:with-mutex ((buffer-lock queue)) + ;if its there, pop it + (let ((ret (pop-elt (buffer queue) "1sttry"))) + (if ret + ret + (progn + (sb-thread:condition-wait (buffer-queue queue) (buffer-lock queue)) + (pop-elt (buffer queue) "2ndtry")))))) + + +(defmethod add ((queue concurrent-queue) elt) + (sb-thread:with-mutex ((buffer-lock queue)) + (setf (buffer queue) (append (buffer queue) (list elt)) ) + (sb-thread:condition-notify (buffer-queue queue)))) + + + +(defun test-writer(queue) + (loop for i from 0 to 999 do + (sleep 0.1) + (add queue i))) + +(defun test-reader(queue) + (loop + (format t "reader on ~A got elt ~A~%" + sb-thread:*current-thread* (take queue)))) + +(defun test-queue() + (let ((queue (make-instance 'concurrent-queue))) + (sb-thread:make-thread #'(lambda()(test-writer queue))) + (sleep 10) + (sb-thread:make-thread #'(lambda()(test-reader queue))) + (sb-thread:make-thread #'(lambda()(test-reader queue))))) From psmith at common-lisp.net Wed Jan 17 01:39:51 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Tue, 16 Jan 2007 20:39:51 -0500 (EST) Subject: [nio-cvs] r39 - branches/home/psmith/restructure/src/compat Message-ID: <20070117013951.98D2152011@common-lisp.net> Author: psmith Date: Tue Jan 16 20:39:51 2007 New Revision: 39 Modified: branches/home/psmith/restructure/src/compat/concurrent-queue.lisp branches/home/psmith/restructure/src/compat/nio-compat-package.lisp branches/home/psmith/restructure/src/compat/nio-compat.asd Log: asdf updates for queue Modified: branches/home/psmith/restructure/src/compat/concurrent-queue.lisp ============================================================================== --- branches/home/psmith/restructure/src/compat/concurrent-queue.lisp (original) +++ branches/home/psmith/restructure/src/compat/concurrent-queue.lisp Tue Jan 16 20:39:51 2007 @@ -40,6 +40,9 @@ (buffer :initform nil :accessor buffer))) +(defun concurrent-queue() + (make-instance 'concurrent-queue)) + (defmacro pop-elt(a-buffer loc) `(if ,a-buffer (let ((head (car ,a-buffer))) Modified: branches/home/psmith/restructure/src/compat/nio-compat-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/compat/nio-compat-package.lisp (original) +++ branches/home/psmith/restructure/src/compat/nio-compat-package.lisp Tue Jan 16 20:39:51 2007 @@ -31,4 +31,6 @@ ;; errno.lisp get-errno +ERRNO_EAGAIN+ + ;;concurrent-queue + concurrent-queue add take )) Modified: branches/home/psmith/restructure/src/compat/nio-compat.asd ============================================================================== --- branches/home/psmith/restructure/src/compat/nio-compat.asd (original) +++ branches/home/psmith/restructure/src/compat/nio-compat.asd Tue Jan 16 20:39:51 2007 @@ -6,6 +6,7 @@ :components ((:file "nio-compat-package") (:file "errno" :depends-on ("nio-compat-package")) + (:file "concurrent-queue" :depends-on ("nio-compat-package")) ) :depends-on ()) From psmith at common-lisp.net Wed Jan 17 05:06:15 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Wed, 17 Jan 2007 00:06:15 -0500 (EST) Subject: [nio-cvs] r40 - in branches/home/psmith/restructure: . src/compat src/io src/protocol/yarpc Message-ID: <20070117050615.62558D00D@common-lisp.net> Author: psmith Date: Wed Jan 17 00:06:13 2007 New Revision: 40 Added: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp - copied, changed from r37, branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Modified: branches/home/psmith/restructure/run-yarpc-client.lisp branches/home/psmith/restructure/run-yarpc.lisp branches/home/psmith/restructure/src/compat/concurrent-queue.lisp branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/async-socket.lisp branches/home/psmith/restructure/src/io/nio-server.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 Log: yarpc work, saving... Modified: branches/home/psmith/restructure/run-yarpc-client.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc-client.lisp (original) +++ branches/home/psmith/restructure/run-yarpc-client.lisp Wed Jan 17 00:06:13 2007 @@ -2,10 +2,9 @@ (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") +;;shouldn't be listenting on the client hence nil for accept SM to start-server +(sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity nil :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))) +(let ((sm (nio:add-connection "127.0.0.1" 16323 'nio-yarpc:yarpc-client-state-machine))) (format t "toplevel adding conn ~A~%" sm) (format t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)"))) - - Modified: branches/home/psmith/restructure/run-yarpc.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc.lisp (original) +++ branches/home/psmith/restructure/run-yarpc.lisp Wed Jan 17 00:06:13 2007 @@ -2,4 +2,11 @@ (require :asdf) (require :nio-yarpc) -(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host "127.0.0.1") +(let ((jobq (nio-compat:concurrent-queue))) + (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity #'(lambda()(nio-yarpc:yarpc-state-machine jobq)) :host "127.0.0.1")) :name "nio-server") + (format t "server toplevel waiting for job~%" ) + (loop + ;;block waiting for jobs + (multiple-value-bind (job result-queue) (nio-compat:take jobq) + (format t "Server received job ~A~%" job) + (nio-compat:add result-queue (nio-yarpc:execute-call job))))) Modified: branches/home/psmith/restructure/src/compat/concurrent-queue.lisp ============================================================================== --- branches/home/psmith/restructure/src/compat/concurrent-queue.lisp (original) +++ branches/home/psmith/restructure/src/compat/concurrent-queue.lisp Wed Jan 17 00:06:13 2007 @@ -51,18 +51,18 @@ head) nil)) - -(defmethod take ((queue concurrent-queue)) +;Do an (optionally blocking) remove of the element at the head of this queue +(defmethod take ((queue concurrent-queue) &key (blocking-call t)) (sb-thread:with-mutex ((buffer-lock queue)) ;if its there, pop it (let ((ret (pop-elt (buffer queue) "1sttry"))) - (if ret + (if (or ret (not blocking-call)) ret (progn (sb-thread:condition-wait (buffer-queue queue) (buffer-lock queue)) (pop-elt (buffer queue) "2ndtry")))))) - +;Append the element to the tail of this queue (defmethod add ((queue concurrent-queue) elt) (sb-thread:with-mutex ((buffer-lock queue)) (setf (buffer queue) (append (buffer queue) (list elt)) ) 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 Wed Jan 17 00:06:13 2007 @@ -84,10 +84,6 @@ ;;Implement this in concrete SM for read (defgeneric process-write (async-fd)) - - -;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))) 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 Wed Jan 17 00:06:13 2007 @@ -178,7 +178,7 @@ -(defun socket-accept (socket-fd connection-type) +(defun socket-accept (socket-fd connection-factory) "Accept connection from SOCKET-FD. Allocates and returns socket structure denoting the connection." (flet ((parse-inet6-addr (addr) @@ -202,7 +202,7 @@ ;; accept connection (let* ((res (%accept socket-fd addr len)) ;; (async-socket-fd (make-instance 'async-socket-fd :read-fd res :write-fd res))) - (async-socket-fd (create-state-machine connection-type res res (make-instance 'async-socket-fd)))) + (async-socket-fd (create-state-machine connection-factory res res (make-instance 'async-socket-fd)))) (unless (< res 0) (let ((len-value (mem-ref len :unsigned-int))) 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 Wed Jan 17 00:06:13 2007 @@ -55,7 +55,7 @@ -(defun start-server (connection-handler accept-filter connection-type +(defun start-server (connection-handler accept-filter connection-factory &key (protocol :inet) (port (+ (random 60000) 1024)) @@ -99,7 +99,7 @@ (cond ;; new connection ((= fd sock) - (let ((async-fd (socket-accept fd connection-type))) + (let ((async-fd (socket-accept fd connection-factory))) #+nio-debug (format t "start-server - New conn: ~A~%" async-fd) (cond ((null async-fd) 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 Wed Jan 17 00:06:13 2007 @@ -28,6 +28,14 @@ (:export + ;;base + yarpc-state-machine-factory get-packet-factory + ;; yarpc-state-machine - yarpc-state-machine yarpc-state-machine-factory test-rpc test-rpc-list test-rpc-string get-packet-factory remote-execute + yarpc-state-machine + ;to be moved + test-rpc test-rpc-list test-rpc-string execute-call + + ;;yarpc-client-state-machine + yarpc-client-state-machine remote-execute )) 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 Wed Jan 17 00:06:13 2007 @@ -7,6 +7,7 @@ :components ((:file "nio-yarpc-package") (:file "yarpc-packet-factory" :depends-on ("nio-yarpc-package")) (:file "yarpc-state-machine" :depends-on ("yarpc-packet-factory")) + (:file "yarpc-client-state-machine" :depends-on ("yarpc-packet-factory")) ) - :depends-on (:nio :nio-sm)) \ No newline at end of file + :depends-on (:nio :nio-sm :nio-compat)) \ No newline at end of file Copied: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp (from r37, 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-client-state-machine.lisp Wed Jan 17 00:06:13 2007 @@ -28,108 +28,53 @@ (declaim (optimize (debug 3) (speed 3) (space 0))) -;; YetAnotherRPC state machine +;; YetAnotherRPC Client state machine ;; -;; A server that processes remote procedure calls and returns results +;; A client that accepts jobs to be run via a threadsafe queue and then submits them to the remote end for execution ;; -;; 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 (state-machine) - ((outgoing-packet :initarg :outgoing-packet - :accessor outgoing-packet - :initform nil))) +(defclass yarpc-client-state-machine (state-machine) + ((job-queue :initform (nio-compat:concurrent-queue) + :accessor job-queue + :documentation "The queue used to hand off work from an external thread to the io thread") + (result-queue :initform (nio-compat:concurrent-queue) + :accessor result-queue + :documentation "The queue used to hand off work from an external thread to the io thread"))) -(defun yarpc-state-machine () - (make-instance 'yarpc-state-machine)) +(defun yarpc-client-state-machine () + (make-instance 'yarpc-client-state-machine)) (defparameter yarpc-pf (yarpc-packet-factory)) -(defmethod get-packet-factory((sm yarpc-state-machine)) +(defmethod get-packet-factory((sm yarpc-client-state-machine)) yarpc-pf) -;;TODO move somewhere suitable - -(defparameter *remote-fns* nil) - -(defun register-remote-fn(name) - (push name *remote-fns*)) - -(defmacro defremote (name args &rest body) - `(progn - (defun ,name (, at args) , at body) - (register-remote-fn #',name))) - -(defremote test-rpc-list() - (list 3 "as" 's (code-char #x2211))) - -(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 "#" (call-next-method sm nil))) +(defmethod print-object ((sm yarpc-client-state-machine) stream) + (format stream "#" (call-next-method sm nil))) (defconstant STATE-INITIALISED 0) -(defconstant STATE-SEND-RESPONSE 1) +(defconstant STATE-SENT-REQUEST 1) (defparameter state STATE-INITIALISED) -(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)) - -;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)) - (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 (call-string call)))) - (when result - (let ((response-packet (progn - (setf state STATE-SEND-RESPONSE) - (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)) +(defmethod process-outgoing-packet((sm yarpc-client-state-machine)) + (format t "process-outgoing-packet called, polling the job-queue ~%") + (let ((packet (nio-compat:take (job-queue sm) :blocking-call nil))) + (when packet + (format t "process-outgoing-packet got job ~A ~%" packet) + (setf state STATE-SENT-REQUEST)) + packet)) + +(defmethod process-incoming-packet ((sm yarpc-client-state-machine) (response method-response-packet)) + (assert (eql state STATE-SENT-REQUEST)) + (format t "yarpc-client-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm response) + (nio-compat:add (result-queue sm) response) + (setf state STATE-INITIALISED)) - -(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)))) - - -(defmethod remote-execute ((sm yarpc-state-machine) call-string) - (queue-outgoing-packet sm (make-instance 'call-method-packet :call-string call-string))) - \ No newline at end of file +;Called from an external thread i.e. *not* the nio thread +;Blocks calling thread on the remote m/c's response +(defmethod remote-execute ((sm yarpc-client-state-machine) call-string) +; (queue-outgoing-packet + (assert (eql state STATE-INITIALISED)) + (nio-compat:add (job-queue sm) (make-instance 'call-method-packet :call-string call-string)) + (nio-compat:take (result-queue sm))) \ No newline at end of file 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 Wed Jan 17 00:06:13 2007 @@ -32,27 +32,57 @@ ;; ;; 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 (state-machine) - ((outgoing-packet :initarg :outgoing-packet - :accessor outgoing-packet - :initform nil))) - -(defun yarpc-state-machine () - (make-instance 'yarpc-state-machine)) + ((job-queue :initarg :job-queue + :initform (error "Must supply a job queue to write work to.") + :accessor job-queue + :documentation "The queue used to hand off work from the NIO thread to an external thread for execution") + (result-queue :initform (nio-compat:concurrent-queue) + :accessor result-queue + :documentation "The queue used to return results from an external thread to the nio thread"))) + +(defun yarpc-state-machine (read-fd write-fd socket job-queue) + (let ((sm (make-instance 'yarpc-state-machine :read-fd read-fd :write-fd write-fd :socket socket :job-queue job-queue))) + (nio-buffer:clear (foreign-read-buffer sm)) + (nio-buffer:clear (foreign-write-buffer sm)) + (format t "yarpc-state-machine - Created ~S~%" sm) + sm)) (defparameter yarpc-pf (yarpc-packet-factory)) (defmethod get-packet-factory((sm yarpc-state-machine)) yarpc-pf) +(defmethod print-object ((sm yarpc-state-machine) stream) + (format stream "#" (call-next-method sm nil))) + +(defconstant STATE-INITIALISED 0) +(defconstant STATE-SEND-RESPONSE 1) + +(defparameter state STATE-INITIALISED) + + +(defmethod process-outgoing-packet((sm yarpc-state-machine)) + (format t "yarpc-state-machine: process-outgoing-packet called, polling the results-queue ~%") + (let ((packet (nio-compat:take (result-queue sm) :blocking-call nil))) + (format t "yarpc-state-machine: process-outgoing-packet got result ~A ~%" packet) + packet)) + + +;Process a call method packet, returns +(defmethod process-incoming-packet ((sm yarpc-state-machine) (call call-method-packet)) + (assert (eql state STATE-INITIALISED)) + (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm call) + (nio-compat:add (job-queue sm) (cons (call-string call) (result-queue sm)))) + + +;Called from an external thread i.e. *not* the nio thread +;Blocks waiting for a job (call-string,result-queue) to process and return the result into the result queue +;(defmethod get-job ((sm yarpc-state-machine)) +; (values (nio-compat:take (job-queue sm)) (result-queue sm))) + + + ;;TODO move somewhere suitable (defparameter *remote-fns* nil) @@ -71,56 +101,8 @@ (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 "#" (call-next-method sm nil))) - -(defconstant STATE-INITIALISED 0) -(defconstant STATE-SEND-RESPONSE 1) - -(defparameter state STATE-INITIALISED) - (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)) - -;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)) - (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 (call-string call)))) - (when result - (let ((response-packet (progn - (setf state STATE-SEND-RESPONSE) - (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 )) (fn (member (symbol-function (first rpc-call-list)) *remote-fns* ))) @@ -129,7 +111,18 @@ (apply (first rpc-call-list) (rest rpc-call-list)) (error 'authorization-error)))) +;;end move TODO + + + + -(defmethod remote-execute ((sm yarpc-state-machine) call-string) - (queue-outgoing-packet sm (make-instance 'call-method-packet :call-string call-string))) - \ No newline at end of file +; (handler-case +; (let ((result (execute-call (call-string call)))) +; (when result +; (let ((response-packet (progn +; (setf state STATE-SEND-RESPONSE) +; (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)))) \ No newline at end of file From psmith at common-lisp.net Thu Jan 18 04:01:11 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Wed, 17 Jan 2007 23:01:11 -0500 (EST) Subject: [nio-cvs] r41 - in branches/home/psmith/restructure: . src/buffer src/compat src/io src/protocol/yarpc src/statemachine Message-ID: <20070118040111.E5D5219007@common-lisp.net> Author: psmith Date: Wed Jan 17 23:01:11 2007 New Revision: 41 Modified: branches/home/psmith/restructure/run-yarpc.lisp branches/home/psmith/restructure/src/buffer/buffer.lisp branches/home/psmith/restructure/src/compat/concurrent-queue.lisp branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/async-socket.lisp branches/home/psmith/restructure/src/io/nio-server.lisp branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.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 working end-to-end Modified: branches/home/psmith/restructure/run-yarpc.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc.lisp (original) +++ branches/home/psmith/restructure/run-yarpc.lisp Wed Jan 17 23:01:11 2007 @@ -2,11 +2,10 @@ (require :asdf) (require :nio-yarpc) -(let ((jobq (nio-compat:concurrent-queue))) - (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity #'(lambda()(nio-yarpc:yarpc-state-machine jobq)) :host "127.0.0.1")) :name "nio-server") - (format t "server toplevel waiting for job~%" ) - (loop +(sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host "127.0.0.1")) :name "nio-server") +(loop ;;block waiting for jobs - (multiple-value-bind (job result-queue) (nio-compat:take jobq) + (format t "Server toplevel waiting for job~%" ) + (destructuring-bind (job result-queue) (nio-compat:take nio-yarpc:job-queue) (format t "Server received job ~A~%" job) - (nio-compat:add result-queue (nio-yarpc:execute-call job))))) + (nio-compat:add result-queue (nio-yarpc:execute-call job)))) 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 Wed Jan 17 23:01:11 2007 @@ -55,25 +55,45 @@ ;;Utils by slyrus (http://paste.lisp.org/display/11149) (defun hex-dump-byte (address) - (format nil "~2,'0X" - (sb-alien:deref - (sb-alien:sap-alien - (sb-alien::int-sap address) - (* (sb-alien:unsigned 8)))))) + (format nil "~2,'0X" (byte-value address))) + +(defun byte-value (address) + (sb-alien:deref + (sb-alien:sap-alien + (sb-alien::int-sap address) + (* (sb-alien:unsigned 8))))) (defun hex-dump-memory (start-address length) (loop for i from start-address below (+ start-address length) collect (format nil (hex-dump-byte i)))) +;;-- end utils + + +(defun pretty-hex-dump (start-address length) +; (format t "start: ~A length ~A~%" start-address length) + (with-output-to-string (str) + (let ((rows (floor (/ length 16)))) +; (format t "rows: ~A remainder ~A~%" rows remainder) + (dotimes (row-index (+ 1 rows)) + (format str "~A~%" + (with-output-to-string (readable) + (dotimes (column-index 16) + (let ((address (+ start-address (* row-index 16) column-index))) + ; (format t "Current address : ~A~%" address) + (if (>= address (+ start-address length)) + (progn + (format str "--") + (format readable "--")) + (progn + (format str (if (eql column-index 7) "~A " "~A ") (hex-dump-byte address)) + (format readable "~A" (code-char (byte-value address))))))))))))) (defun make-uint8-seq (size) "Make uint8 sequence." (make-sequence '(vector (unsigned-byte 8)) size :initial-element 0)) -;;-- end utils - - ;;A buffer that deals with bytes (defclass byte-buffer (buffer)()) @@ -83,7 +103,7 @@ (defmethod print-object ((byte-buffer byte-buffer) stream) (with-slots (capacity position limit buf) byte-buffer - (format stream "~%" capacity position limit (if buf (hex-dump-memory (cffi:pointer-address buf) limit) nil)))) + (format stream "~%" capacity position limit (if buf (pretty-hex-dump (cffi:pointer-address buf) limit) nil)))) (defmethod free-buffer((byte-buffer byte-buffer)) (with-slots (capacity position limit buf) byte-buffer Modified: branches/home/psmith/restructure/src/compat/concurrent-queue.lisp ============================================================================== --- branches/home/psmith/restructure/src/compat/concurrent-queue.lisp (original) +++ branches/home/psmith/restructure/src/compat/concurrent-queue.lisp Wed Jan 17 23:01:11 2007 @@ -47,7 +47,7 @@ `(if ,a-buffer (let ((head (car ,a-buffer))) (setf ,a-buffer (cdr ,a-buffer)) -#+nio-debug (format t "reader ~A woke, read ~A as ~A~%" sb-thread:*current-thread* head ,loc) +#+nio-debug (format t "concurent-queue:take - (~A) read ~A at ~A~%" sb-thread:*current-thread* head ,loc) head) nil)) @@ -64,6 +64,7 @@ ;Append the element to the tail of this queue (defmethod add ((queue concurrent-queue) elt) +#+nio-debug (format t "concurent-queue:add - (~A) adding ~A~%" sb-thread:*current-thread* elt) (sb-thread:with-mutex ((buffer-lock queue)) (setf (buffer queue) (append (buffer queue) (list elt)) ) (sb-thread:condition-notify (buffer-queue queue)))) 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 Wed Jan 17 23:01:11 2007 @@ -125,11 +125,12 @@ (error 'read-error))) ((= new-bytes 0) - nil);;(throw 'end-of-file nil)) + nil);;(throw 'end-of-file nil) (t ;;Update buffer position - (inc-position foreign-read-buffer new-bytes)))))) + (inc-position foreign-read-buffer new-bytes) + (setf (read-ready state-machine) nil)))))) (defun close-async-fd (async-fd) "Close ASYNC-FD's fd after everything has been written from write-queue." 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 Wed Jan 17 23:01:11 2007 @@ -178,7 +178,7 @@ -(defun socket-accept (socket-fd connection-factory) +(defun socket-accept (socket-fd connection-type) "Accept connection from SOCKET-FD. Allocates and returns socket structure denoting the connection." (flet ((parse-inet6-addr (addr) @@ -202,7 +202,7 @@ ;; accept connection (let* ((res (%accept socket-fd addr len)) ;; (async-socket-fd (make-instance 'async-socket-fd :read-fd res :write-fd res))) - (async-socket-fd (create-state-machine connection-factory res res (make-instance 'async-socket-fd)))) + (async-socket-fd (create-state-machine connection-type res res (make-instance 'async-socket-fd)))) (unless (< res 0) (let ((len-value (mem-ref len :unsigned-int))) 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 Wed Jan 17 23:01:11 2007 @@ -55,7 +55,7 @@ -(defun start-server (connection-handler accept-filter connection-factory +(defun start-server (connection-handler accept-filter connection-type &key (protocol :inet) (port (+ (random 60000) 1024)) @@ -99,7 +99,7 @@ (cond ;; new connection ((= fd sock) - (let ((async-fd (socket-accept fd connection-factory))) + (let ((async-fd (socket-accept fd connection-type))) #+nio-debug (format t "start-server - New conn: ~A~%" async-fd) (cond ((null async-fd) 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 Wed Jan 17 23:01:11 2007 @@ -32,7 +32,7 @@ yarpc-state-machine-factory get-packet-factory ;; yarpc-state-machine - yarpc-state-machine + yarpc-state-machine job-queue ;to be moved test-rpc test-rpc-list test-rpc-string execute-call Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp Wed Jan 17 23:01:11 2007 @@ -38,7 +38,7 @@ :documentation "The queue used to hand off work from an external thread to the io thread") (result-queue :initform (nio-compat:concurrent-queue) :accessor result-queue - :documentation "The queue used to hand off work from an external thread to the io thread"))) + :documentation "The queue used to return results from the io thread to an external thread"))) (defun yarpc-client-state-machine () (make-instance 'yarpc-client-state-machine)) @@ -55,26 +55,26 @@ (defconstant STATE-INITIALISED 0) (defconstant STATE-SENT-REQUEST 1) -(defparameter state STATE-INITIALISED) - (defmethod process-outgoing-packet((sm yarpc-client-state-machine)) (format t "process-outgoing-packet called, polling the job-queue ~%") (let ((packet (nio-compat:take (job-queue sm) :blocking-call nil))) (when packet (format t "process-outgoing-packet got job ~A ~%" packet) - (setf state STATE-SENT-REQUEST)) + (setf (state sm) STATE-SENT-REQUEST)) packet)) (defmethod process-incoming-packet ((sm yarpc-client-state-machine) (response method-response-packet)) - (assert (eql state STATE-SENT-REQUEST)) + (assert (eql (state sm) STATE-SENT-REQUEST)) (format t "yarpc-client-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm response) - (nio-compat:add (result-queue sm) response) - (setf state STATE-INITIALISED)) + (let* ((*package* (find-package :nio-yarpc)) + (result (read-from-string (response response)))) + (nio-compat:add (result-queue sm) result) + (setf (state sm) STATE-INITIALISED))) ;Called from an external thread i.e. *not* the nio thread ;Blocks calling thread on the remote m/c's response (defmethod remote-execute ((sm yarpc-client-state-machine) call-string) ; (queue-outgoing-packet - (assert (eql state STATE-INITIALISED)) + (assert (eql (state sm) STATE-INITIALISED)) (nio-compat:add (job-queue sm) (make-instance 'call-method-packet :call-string call-string)) (nio-compat:take (result-queue sm))) \ No newline at end of file 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 Wed Jan 17 23:01:11 2007 @@ -33,20 +33,13 @@ ;; A server that processes remote procedure calls and returns results ;; (defclass yarpc-state-machine (state-machine) - ((job-queue :initarg :job-queue - :initform (error "Must supply a job queue to write work to.") - :accessor job-queue - :documentation "The queue used to hand off work from the NIO thread to an external thread for execution") + ( (result-queue :initform (nio-compat:concurrent-queue) :accessor result-queue :documentation "The queue used to return results from an external thread to the nio thread"))) -(defun yarpc-state-machine (read-fd write-fd socket job-queue) - (let ((sm (make-instance 'yarpc-state-machine :read-fd read-fd :write-fd write-fd :socket socket :job-queue job-queue))) - (nio-buffer:clear (foreign-read-buffer sm)) - (nio-buffer:clear (foreign-write-buffer sm)) - (format t "yarpc-state-machine - Created ~S~%" sm) - sm)) +(defparameter job-queue (nio-compat:concurrent-queue) + "The queue used to hand off work from the NIO thread to an external thread for execution") (defparameter yarpc-pf (yarpc-packet-factory)) @@ -59,27 +52,18 @@ (defconstant STATE-INITIALISED 0) (defconstant STATE-SEND-RESPONSE 1) -(defparameter state STATE-INITIALISED) - - (defmethod process-outgoing-packet((sm yarpc-state-machine)) (format t "yarpc-state-machine: process-outgoing-packet called, polling the results-queue ~%") - (let ((packet (nio-compat:take (result-queue sm) :blocking-call nil))) - (format t "yarpc-state-machine: process-outgoing-packet got result ~A ~%" packet) - packet)) - + (let ((result (nio-compat:take (result-queue sm) :blocking-call nil))) + (format t "yarpc-state-machine: process-outgoing-packet got result ~A ~%" result) + (when result + (method-response-packet result)))) -;Process a call method packet, returns +;Process a call method packet by placing it in the job-queue (defmethod process-incoming-packet ((sm yarpc-state-machine) (call call-method-packet)) - (assert (eql state STATE-INITIALISED)) + (assert (eql (state sm) STATE-INITIALISED)) (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm call) - (nio-compat:add (job-queue sm) (cons (call-string call) (result-queue sm)))) - - -;Called from an external thread i.e. *not* the nio thread -;Blocks waiting for a job (call-string,result-queue) to process and return the result into the result queue -;(defmethod get-job ((sm yarpc-state-machine)) -; (values (nio-compat:take (job-queue sm)) (result-queue sm))) + (nio-compat:add job-queue (list (call-string call) (result-queue sm)))) 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 Wed Jan 17 23:01:11 2007 @@ -29,5 +29,5 @@ (:export ;; state-machine - state-machine packet-factory get-packet-factory get-packet process-outgoing-packet process-incoming-packet + state-machine packet-factory get-packet-factory get-packet process-outgoing-packet process-incoming-packet state )) 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 Wed Jan 17 23:01:11 2007 @@ -37,7 +37,9 @@ ;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)()) +(defclass state-machine (async-fd) + ((state :initform 0 + :accessor state))) (defmethod print-object ((sm state-machine) stream) (format stream "#" (call-next-method sm nil))) From psmith at common-lisp.net Thu Jan 18 04:26:43 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Wed, 17 Jan 2007 23:26:43 -0500 (EST) Subject: [nio-cvs] r42 - in branches/home/psmith/restructure: . src/protocol/yarpc Message-ID: <20070118042643.3AEEA2F04B@common-lisp.net> Author: psmith Date: Wed Jan 17 23:26:42 2007 New Revision: 42 Modified: branches/home/psmith/restructure/run-yarpc-client.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp Log: loop sending rpc's and minor correction Modified: branches/home/psmith/restructure/run-yarpc-client.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc-client.lisp (original) +++ branches/home/psmith/restructure/run-yarpc-client.lisp Wed Jan 17 23:26:42 2007 @@ -6,5 +6,7 @@ (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity nil :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-client-state-machine))) -(format t "toplevel adding conn ~A~%" sm) -(format t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)"))) + +(loop + (format t "toplevel adding conn ~A~%" sm) + (format t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)")))) Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp Wed Jan 17 23:26:42 2007 @@ -68,13 +68,12 @@ (format t "yarpc-client-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm response) (let* ((*package* (find-package :nio-yarpc)) (result (read-from-string (response response)))) - (nio-compat:add (result-queue sm) result) - (setf (state sm) STATE-INITIALISED))) + (setf (state sm) STATE-INITIALISED) + (nio-compat:add (result-queue sm) result))) ;Called from an external thread i.e. *not* the nio thread ;Blocks calling thread on the remote m/c's response (defmethod remote-execute ((sm yarpc-client-state-machine) call-string) -; (queue-outgoing-packet (assert (eql (state sm) STATE-INITIALISED)) (nio-compat:add (job-queue sm) (make-instance 'call-method-packet :call-string call-string)) (nio-compat:take (result-queue sm))) \ No newline at end of file From psmith at common-lisp.net Fri Jan 19 00:09:16 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Thu, 18 Jan 2007 19:09:16 -0500 (EST) Subject: [nio-cvs] r43 - branches/home/psmith/restructure/src/event Message-ID: <20070119000916.5374E3D007@common-lisp.net> Author: psmith Date: Thu Jan 18 19:09:15 2007 New Revision: 43 Modified: branches/home/psmith/restructure/src/event/epoll.lisp Log: Reduced wait time and ignored EINTR on epoll_wait return 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 Thu Jan 18 19:09:15 2007 @@ -76,13 +76,18 @@ #+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+ 1000) + (loop for res = (%epoll-wait event-queue events +epoll-size+ 100) do (progn #+nio-debug (format t "poll-events - dealing with ~A~%" res) (case res - (-1 (error 'poll-error)) + (-1 + (let ((errno (get-errno))) + (format t "-1 returned from epoll-wait, errno ~A~%" errno) + (if (eql errno 4) ;EINTR - interrupted by a system call + (return nil) + (error 'poll-error)))) (return nil) (t (let ((idents nil)) From psmith at common-lisp.net Fri Jan 19 00:11:09 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Thu, 18 Jan 2007 19:11:09 -0500 (EST) Subject: [nio-cvs] r44 - in branches/home/psmith/restructure: . src/buffer src/compat src/io src/protocol/yarpc src/statemachine Message-ID: <20070119001109.115743D007@common-lisp.net> Author: psmith Date: Thu Jan 18 19:11:08 2007 New Revision: 44 Added: branches/home/psmith/restructure/src/compat/utils.lisp Modified: branches/home/psmith/restructure/run-yarpc-client.lisp branches/home/psmith/restructure/run-yarpc.lisp branches/home/psmith/restructure/src/buffer/buffer.lisp branches/home/psmith/restructure/src/compat/nio-compat-package.lisp branches/home/psmith/restructure/src/compat/nio-compat.asd branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/nio-server.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp branches/home/psmith/restructure/src/statemachine/state-machine.lisp Log: Moved verbose messages to nio-debug Modified: branches/home/psmith/restructure/run-yarpc-client.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc-client.lisp (original) +++ branches/home/psmith/restructure/run-yarpc-client.lisp Thu Jan 18 19:11:08 2007 @@ -1,4 +1,4 @@ -(push :nio-debug *features*) +;(push :nio-debug *features*) (require :asdf) (require :nio-yarpc) @@ -6,7 +6,7 @@ (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity nil :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-client-state-machine))) - -(loop - (format t "toplevel adding conn ~A~%" sm) - (format t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)")))) + (format t "~A toplevel adding conn ~A~%" (nio-compat:get-readable-time) sm) + (loop + (format t "~A toplevel Submitting job~%" (nio-compat:get-readable-time) ) + (format t "~A Result of remote-execute ~A~%" (nio-compat:get-readable-time) (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)")))) Modified: branches/home/psmith/restructure/run-yarpc.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc.lisp (original) +++ branches/home/psmith/restructure/run-yarpc.lisp Thu Jan 18 19:11:08 2007 @@ -1,11 +1,11 @@ -(push :nio-debug *features*) +;(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")) :name "nio-server") (loop ;;block waiting for jobs - (format t "Server toplevel waiting for job~%" ) + (format t "~A Server toplevel waiting for job~%" (nio-compat:get-readable-time)) (destructuring-bind (job result-queue) (nio-compat:take nio-yarpc:job-queue) - (format t "Server received job ~A~%" job) + (format t "~A Server received job ~A~%" (nio-compat:get-readable-time) job) (nio-compat:add result-queue (nio-yarpc:execute-call job)))) 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 Thu Jan 18 19:11:08 2007 @@ -159,13 +159,13 @@ ;; Write bytes from vector vec to bytebuffer (defmethod bytebuffer-write-vector((bb byte-buffer) vec) :documentation "Returns number of bytes written to bytebuffer" - (format t "bytebuffer-write-vector - called with ~A ~A"bb vec) +#+nio-debug (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 (length vec) (buffer-position bb)))) - (format t "bytebuffer-write-vector - byteswritten: ~A~%" bytes-written) +#+nio-debug (format t "bytebuffer-write-vector - byteswritten: ~A~%" bytes-written) (inc-position bb bytes-written) bytes-written))) ;) Modified: branches/home/psmith/restructure/src/compat/nio-compat-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/compat/nio-compat-package.lisp (original) +++ branches/home/psmith/restructure/src/compat/nio-compat-package.lisp Thu Jan 18 19:11:08 2007 @@ -33,4 +33,7 @@ ;;concurrent-queue concurrent-queue add take + + ;;utils + get-readable-time )) Modified: branches/home/psmith/restructure/src/compat/nio-compat.asd ============================================================================== --- branches/home/psmith/restructure/src/compat/nio-compat.asd (original) +++ branches/home/psmith/restructure/src/compat/nio-compat.asd Thu Jan 18 19:11:08 2007 @@ -7,6 +7,7 @@ :components ((:file "nio-compat-package") (:file "errno" :depends-on ("nio-compat-package")) (:file "concurrent-queue" :depends-on ("nio-compat-package")) + (:file "utils" :depends-on ("nio-compat-package")) ) :depends-on ()) Added: branches/home/psmith/restructure/src/compat/utils.lisp ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/src/compat/utils.lisp Thu Jan 18 19:11:08 2007 @@ -0,0 +1,38 @@ +#| +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-compat) + +(declaim (optimize (debug 3) (speed 3) (space 0))) + +(defun get-readable (format-string &optional (time (get-universal-time))) + (multiple-value-bind (second minute hour date month year) (decode-universal-time time) + (with-output-to-string (out) + (format out format-string year month date hour minute second)))) + +(defun get-readable-time ( &optional (time (get-universal-time))) + (get-readable "~A/~2,'0d/~2,'0d ~2,'0d:~2,'0d:~2,'0d" time)) 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 Thu Jan 18 19:11:08 2007 @@ -110,7 +110,7 @@ ;; "Read more data from STATE-MACHINE." (defun read-more (state-machine) (with-slots (foreign-read-buffer read-fd) state-machine - (format t "read-more called with ~A~%" state-machine) +#+nio-debug (format t "read-more called with ~A~%" state-machine) #+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)))) 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 Thu Jan 18 19:11:08 2007 @@ -90,7 +90,7 @@ (catch 'poll-error-exit (handler-bind ((poll-error #'(lambda (cond) (declare (ignore cond)) - (format t "Poll-error, exiting..~%") + (format t "Poll-error (errno ~A), exiting..~%" (get-errno)) (throw 'poll-error-exit nil)))) (loop 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 Thu Jan 18 19:11:08 2007 @@ -59,11 +59,11 @@ (format stream "#" (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-debug (format t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) (nio-buffer:bytebuffer-write-vector buf #(#x0)) (nio-buffer:bytebuffer-write-string buf (call-string packet)) - (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf) ) +#+nio-debug (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf) +) (defclass method-response-packet (packet) @@ -77,7 +77,8 @@ (format stream "#" (response packet))) (defmethod write-bytes((packet method-response-packet) buf) - (format t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) +#+nio-debug (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) ) +#+nio-debug (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf) +) 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 Thu Jan 18 19:11:08 2007 @@ -57,7 +57,7 @@ (defmethod process-read((sm state-machine)) (with-slots (foreign-read-buffer) sm (let ((incoming-packet (get-packet (get-packet-factory sm) foreign-read-buffer))) - (format t "state-machine::process-read - incoming packet: ~A~%" incoming-packet) + (format t "~A state-machine::process-read - incoming packet: ~A~%" (nio-compat:get-readable-time) incoming-packet) (when incoming-packet (when (not (process-incoming-packet sm incoming-packet)) (close-sm sm)))))) @@ -67,7 +67,7 @@ (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) + (format t "~A state-machine::process-write - outgoing packet: ~A~%" (nio-compat:get-readable-time) outgoing-packet) (when outgoing-packet (write-bytes outgoing-packet foreign-write-buffer))))) From psmith at common-lisp.net Fri Jan 19 02:07:22 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Thu, 18 Jan 2007 21:07:22 -0500 (EST) Subject: [nio-cvs] r45 - in branches/home/psmith/restructure: . src/protocol/yarpc Message-ID: <20070119020722.9E7902F044@common-lisp.net> Author: psmith Date: Thu Jan 18 21:07:22 2007 New Revision: 45 Modified: branches/home/psmith/restructure/TODO branches/home/psmith/restructure/run-yarpc.lisp branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Log: Allowed yarpc server to do RPC calls inline if configured so Modified: branches/home/psmith/restructure/TODO ============================================================================== --- branches/home/psmith/restructure/TODO (original) +++ branches/home/psmith/restructure/TODO Thu Jan 18 21:07:22 2007 @@ -12,3 +12,7 @@ Create UDP server Create RPC server / client + +Non blocking connects + +Allow large packets Modified: branches/home/psmith/restructure/run-yarpc.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc.lisp (original) +++ branches/home/psmith/restructure/run-yarpc.lisp Thu Jan 18 21:07:22 2007 @@ -1,11 +1,11 @@ +;Runs a multithreaded system with an IO thread dealing with IO only and a 'job' thread taking and executing jobs + ;(push :nio-debug *features*) (require :asdf) (require :nio-yarpc) +(setf nio-yarpc:+process-jobs-inline+ nil) (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host "127.0.0.1")) :name "nio-server") (loop ;;block waiting for jobs - (format t "~A Server toplevel waiting for job~%" (nio-compat:get-readable-time)) - (destructuring-bind (job result-queue) (nio-compat:take nio-yarpc:job-queue) - (format t "~A Server received job ~A~%" (nio-compat:get-readable-time) job) - (nio-compat:add result-queue (nio-yarpc:execute-call job)))) + (nio-yarpc:run-job)) 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 Thu Jan 18 21:07:22 2007 @@ -32,7 +32,7 @@ yarpc-state-machine-factory get-packet-factory ;; yarpc-state-machine - yarpc-state-machine job-queue + yarpc-state-machine job-queue run-job +process-jobs-inline+ ;to be moved test-rpc test-rpc-list test-rpc-string execute-call 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 Thu Jan 18 21:07:22 2007 @@ -1,4 +1,4 @@ -#| +\#| Copyright (c) 2007 All rights reserved. @@ -52,6 +52,19 @@ (defconstant STATE-INITIALISED 0) (defconstant STATE-SEND-RESPONSE 1) + +(defparameter +process-jobs-inline+ t + "Set this to make the NIO thread process the RPC calls - warning the procedure should not block!") + + + +(defun run-job(&key (wait-on-job-pdw t)) + (format t "~A Server toplevel waiting for job~%" (nio-compat:get-readable-time)) + (destructuring-bind (job result-queue) (nio-compat:take nio-yarpc:job-queue :blocking-call wait-on-job-pdw) + (format t "~A Server received job ~A~%" (nio-compat:get-readable-time) job) + (nio-compat:add result-queue (nio-yarpc:execute-call job)))) + + (defmethod process-outgoing-packet((sm yarpc-state-machine)) (format t "yarpc-state-machine: process-outgoing-packet called, polling the results-queue ~%") (let ((result (nio-compat:take (result-queue sm) :blocking-call nil))) @@ -63,7 +76,8 @@ (defmethod process-incoming-packet ((sm yarpc-state-machine) (call call-method-packet)) (assert (eql (state sm) STATE-INITIALISED)) (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm call) - (nio-compat:add job-queue (list (call-string call) (result-queue sm)))) + (nio-compat:add job-queue (list (call-string call) (result-queue sm))) + (when +process-jobs-inline+ (run-job :wait-on-job-pdw nil))) From psmith at common-lisp.net Fri Jan 19 06:10:54 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Fri, 19 Jan 2007 01:10:54 -0500 (EST) Subject: [nio-cvs] r46 - branches/home/psmith/restructure/src/protocol/yarpc Message-ID: <20070119061054.9342038010@common-lisp.net> Author: psmith Date: Fri Jan 19 01:10:52 2007 New Revision: 46 Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Log: Corrected typo 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 19 01:10:52 2007 @@ -1,4 +1,4 @@ -\#| +#| Copyright (c) 2007 All rights reserved. From psmith at common-lisp.net Sat Jan 20 21:18:31 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sat, 20 Jan 2007 16:18:31 -0500 (EST) Subject: [nio-cvs] r47 - branches/home/psmith/restructure/src/compat Message-ID: <20070120211831.7444950031@common-lisp.net> Author: psmith Date: Sat Jan 20 16:18:31 2007 New Revision: 47 Modified: branches/home/psmith/restructure/src/compat/utils.lisp Log: Added high res timer Modified: branches/home/psmith/restructure/src/compat/utils.lisp ============================================================================== --- branches/home/psmith/restructure/src/compat/utils.lisp (original) +++ branches/home/psmith/restructure/src/compat/utils.lisp Sat Jan 20 16:18:31 2007 @@ -36,3 +36,25 @@ (defun get-readable-time ( &optional (time (get-universal-time))) (get-readable "~A/~2,'0d/~2,'0d ~2,'0d:~2,'0d:~2,'0d" time)) + + +;;High res timer + +(let ((internal-base (get-internal-real-time)) + (universal-base (get-universal-time))) +; +; Gets the time including milliseconds by using a base time from universal time and +; tracking high res passing of time using the get-internal-real-time +; Probably not that accurate in absolute terms i.e. may drift from the base, +; but good enough for performance timings +; + (defun get-universal-high-res() + (let ((current-internal (get-internal-real-time))) + (+ universal-base (/ (- current-internal internal-base) internal-time-units-per-second) ))) + + (defun get-readable-high-res() + (let ((estimated-universal-float (get-universal-high-res))) + (multiple-value-bind (estimated-universal estimated-universal-rem) (floor estimated-universal-float) + (format nil "~A.~3,'0d"(get-readable-time estimated-universal) (* 1000 estimated-universal-rem))))) + + ) \ No newline at end of file From psmith at common-lisp.net Mon Jan 22 03:43:03 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 21 Jan 2007 22:43:03 -0500 (EST) Subject: [nio-cvs] r48 - in branches/home/psmith/restructure: . src/compat src/io src/protocol/yarpc src/statemachine src/utils Message-ID: <20070122034303.C5BAD5301B@common-lisp.net> Author: psmith Date: Sun Jan 21 22:43:03 2007 New Revision: 48 Added: branches/home/psmith/restructure/src/utils/ Modified: branches/home/psmith/restructure/run-yarpc-client.lisp branches/home/psmith/restructure/src/compat/nio-compat-package.lisp branches/home/psmith/restructure/src/compat/utils.lisp branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/nio-server.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp branches/home/psmith/restructure/src/statemachine/state-machine.lisp Log: Tidied up logging Modified: branches/home/psmith/restructure/run-yarpc-client.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc-client.lisp (original) +++ branches/home/psmith/restructure/run-yarpc-client.lisp Sun Jan 21 22:43:03 2007 @@ -6,7 +6,7 @@ (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity nil :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-client-state-machine))) - (format t "~A toplevel adding conn ~A~%" (nio-compat:get-readable-time) sm) + (format-log t "toplevel adding conn ~A~%" sm) (loop - (format t "~A toplevel Submitting job~%" (nio-compat:get-readable-time) ) - (format t "~A Result of remote-execute ~A~%" (nio-compat:get-readable-time) (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)")))) + (format-log t "Toplevel Submitting job~%" ) + (format-log t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)")))) Modified: branches/home/psmith/restructure/src/compat/nio-compat-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/compat/nio-compat-package.lisp (original) +++ branches/home/psmith/restructure/src/compat/nio-compat-package.lisp Sun Jan 21 22:43:03 2007 @@ -35,5 +35,5 @@ concurrent-queue add take ;;utils - get-readable-time + format-log )) Modified: branches/home/psmith/restructure/src/compat/utils.lisp ============================================================================== --- branches/home/psmith/restructure/src/compat/utils.lisp (original) +++ branches/home/psmith/restructure/src/compat/utils.lisp Sun Jan 21 22:43:03 2007 @@ -52,9 +52,13 @@ (let ((current-internal (get-internal-real-time))) (+ universal-base (/ (- current-internal internal-base) internal-time-units-per-second) ))) - (defun get-readable-high-res() + (defun get-readable-high-res-time() (let ((estimated-universal-float (get-universal-high-res))) (multiple-value-bind (estimated-universal estimated-universal-rem) (floor estimated-universal-float) (format nil "~A.~3,'0d"(get-readable-time estimated-universal) (* 1000 estimated-universal-rem))))) - ) \ No newline at end of file + ) + +;Format the message to destination but prepend a high res time to the message, useful for logging +(defmacro format-log (destination control-string &rest format-arguments) + `(format ,destination (concatenate 'string "~A - " ,control-string) (get-readable-high-res-time) , at format-arguments)) 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 21 22:43:03 2007 @@ -149,7 +149,7 @@ (defun write-more (async-fd) "Write data from ASYNC-FD's write bytebuffer" -#+nio-debug (format t "async-fd:write-more - called with ~A~%" async-fd) + (format-log t "async-fd:write-more - called with ~A~%" async-fd) (with-slots (write-fd foreign-write-buffer close-pending) async-fd #+nio-debug (format t "async-fd:write-more - foreign-write-buffer b4 flip ~A~%" foreign-write-buffer) (nio-buffer:flip foreign-write-buffer) 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 21 22:43:03 2007 @@ -122,7 +122,7 @@ ;; socket i/o available (t (let ((async-fd (gethash fd client-hash))) -#+nio-debug (format t "IO event ~A on ~A~%" event async-fd) + (format-log t "IO event ~A on ~A~%" event async-fd) (unless (null async-fd) (catch 'error-exit (handler-bind ((read-error #'(lambda (x) 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 21 22:43:03 2007 @@ -59,14 +59,14 @@ (defun run-job(&key (wait-on-job-pdw t)) - (format t "~A Server toplevel waiting for job~%" (nio-compat:get-readable-time)) + (format-log t "Server toplevel waiting for job~%") (destructuring-bind (job result-queue) (nio-compat:take nio-yarpc:job-queue :blocking-call wait-on-job-pdw) - (format t "~A Server received job ~A~%" (nio-compat:get-readable-time) job) + (format-log t "Server received job ~A~%" job) (nio-compat:add result-queue (nio-yarpc:execute-call job)))) (defmethod process-outgoing-packet((sm yarpc-state-machine)) - (format t "yarpc-state-machine: process-outgoing-packet called, polling the results-queue ~%") + (format-log t "yarpc-state-machine: process-outgoing-packet called, polling the results-queue ~%" ) (let ((result (nio-compat:take (result-queue sm) :blocking-call nil))) (format t "yarpc-state-machine: process-outgoing-packet got result ~A ~%" result) (when result @@ -75,7 +75,7 @@ ;Process a call method packet by placing it in the job-queue (defmethod process-incoming-packet ((sm yarpc-state-machine) (call call-method-packet)) (assert (eql (state sm) STATE-INITIALISED)) - (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm call) + (format-log t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm call) (nio-compat:add job-queue (list (call-string call) (result-queue sm))) (when +process-jobs-inline+ (run-job :wait-on-job-pdw nil))) 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 21 22:43:03 2007 @@ -57,7 +57,7 @@ (defmethod process-read((sm state-machine)) (with-slots (foreign-read-buffer) sm (let ((incoming-packet (get-packet (get-packet-factory sm) foreign-read-buffer))) - (format t "~A state-machine::process-read - incoming packet: ~A~%" (nio-compat:get-readable-time) incoming-packet) + (format-log t "state-machine::process-read - incoming packet: ~A~%" incoming-packet) (when incoming-packet (when (not (process-incoming-packet sm incoming-packet)) (close-sm sm)))))) @@ -67,7 +67,7 @@ (defmethod process-write((sm state-machine)) (with-slots (foreign-write-buffer) sm (let ((outgoing-packet (process-outgoing-packet sm))) - (format t "~A state-machine::process-write - outgoing packet: ~A~%" (nio-compat:get-readable-time) outgoing-packet) + (format-log t "state-machine::process-write - outgoing packet: ~A~%" outgoing-packet) (when outgoing-packet (write-bytes outgoing-packet foreign-write-buffer))))) From psmith at common-lisp.net Mon Jan 22 04:12:44 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 21 Jan 2007 23:12:44 -0500 (EST) Subject: [nio-cvs] r49 - in branches/home/psmith/restructure: . src/compat src/io src/protocol/yarpc src/statemachine src/utils Message-ID: <20070122041244.1272619001@common-lisp.net> Author: psmith Date: Sun Jan 21 23:12:43 2007 New Revision: 49 Added: branches/home/psmith/restructure/src/utils/nio-utils-package.lisp - copied, changed from r48, branches/home/psmith/restructure/src/compat/nio-compat-package.lisp branches/home/psmith/restructure/src/utils/nio-utils.asd - copied, changed from r44, branches/home/psmith/restructure/src/compat/nio-compat.asd branches/home/psmith/restructure/src/utils/utils.lisp - copied, changed from r48, branches/home/psmith/restructure/src/compat/utils.lisp Removed: branches/home/psmith/restructure/src/compat/utils.lisp Modified: branches/home/psmith/restructure/run-yarpc-client.lisp branches/home/psmith/restructure/src/compat/nio-compat-package.lisp branches/home/psmith/restructure/src/compat/nio-compat.asd branches/home/psmith/restructure/src/io/nio-package.lisp branches/home/psmith/restructure/src/io/nio.asd branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp branches/home/psmith/restructure/src/statemachine/nio-sm-package.lisp branches/home/psmith/restructure/src/statemachine/nio-sm.asd Log: Moved utils to own package Modified: branches/home/psmith/restructure/run-yarpc-client.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc-client.lisp (original) +++ branches/home/psmith/restructure/run-yarpc-client.lisp Sun Jan 21 23:12:43 2007 @@ -6,7 +6,7 @@ (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity nil :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-client-state-machine))) - (format-log t "toplevel adding conn ~A~%" sm) + (nio-utils:format-log t "toplevel adding conn ~A~%" sm) (loop - (format-log t "Toplevel Submitting job~%" ) - (format-log t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)")))) + (nio-utils:format-log t "Toplevel Submitting job~%" ) + (nio-utils:format-log t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)")))) Modified: branches/home/psmith/restructure/src/compat/nio-compat-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/compat/nio-compat-package.lisp (original) +++ branches/home/psmith/restructure/src/compat/nio-compat-package.lisp Sun Jan 21 23:12:43 2007 @@ -33,7 +33,4 @@ ;;concurrent-queue concurrent-queue add take - - ;;utils - format-log )) Modified: branches/home/psmith/restructure/src/compat/nio-compat.asd ============================================================================== --- branches/home/psmith/restructure/src/compat/nio-compat.asd (original) +++ branches/home/psmith/restructure/src/compat/nio-compat.asd Sun Jan 21 23:12:43 2007 @@ -7,7 +7,6 @@ :components ((:file "nio-compat-package") (:file "errno" :depends-on ("nio-compat-package")) (:file "concurrent-queue" :depends-on ("nio-compat-package")) - (:file "utils" :depends-on ("nio-compat-package")) ) :depends-on ()) 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 21 23:12:43 2007 @@ -24,7 +24,7 @@ (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 (:use :cl :cffi :event-notification :nio-buffer :nio-compat) +(defpackage :nio (:use :cl :cffi :nio-utils :event-notification :nio-buffer :nio-compat) (:export Modified: branches/home/psmith/restructure/src/io/nio.asd ============================================================================== --- branches/home/psmith/restructure/src/io/nio.asd (original) +++ branches/home/psmith/restructure/src/io/nio.asd Sun Jan 21 23:12:43 2007 @@ -12,5 +12,5 @@ (:file "nio-server" :depends-on ("async-socket")) ) - :depends-on (:cffi :event-notification :nio-buffer :nio-compat)) + :depends-on (:cffi :event-notification :nio-buffer :nio-compat :nio-utils)) 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 21 23:12:43 2007 @@ -24,7 +24,7 @@ (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-sm :nio-buffer) +(defpackage :nio-yarpc (:use :cl :nio :nio-sm :nio-buffer :nio-utils) (:export 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 21 23:12:43 2007 @@ -24,7 +24,7 @@ (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) +(defpackage :nio-sm (:use :cl :nio :nio-buffer :nio-utils) (:export Modified: branches/home/psmith/restructure/src/statemachine/nio-sm.asd ============================================================================== --- branches/home/psmith/restructure/src/statemachine/nio-sm.asd (original) +++ branches/home/psmith/restructure/src/statemachine/nio-sm.asd Sun Jan 21 23:12:43 2007 @@ -8,4 +8,4 @@ (:file "state-machine" :depends-on ("nio-sm-package")) ) - :depends-on (:nio)) \ No newline at end of file + :depends-on (:nio :nio-utils)) \ No newline at end of file Copied: branches/home/psmith/restructure/src/utils/nio-utils-package.lisp (from r48, branches/home/psmith/restructure/src/compat/nio-compat-package.lisp) ============================================================================== --- branches/home/psmith/restructure/src/compat/nio-compat-package.lisp (original) +++ branches/home/psmith/restructure/src/utils/nio-utils-package.lisp Sun Jan 21 23:12:43 2007 @@ -1,5 +1,5 @@ #| -Copyright (c) 2006 Risto Laakso +Copyright (c) 2007 All rights reserved. Redistribution and use in source and binary forms, with or without @@ -24,16 +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-compat (:use :cl) +(defpackage :nio-utils (:use :cl) (:export - ;; errno.lisp - get-errno +ERRNO_EAGAIN+ - - ;;concurrent-queue - concurrent-queue add take - ;;utils format-log )) Copied: branches/home/psmith/restructure/src/utils/nio-utils.asd (from r44, branches/home/psmith/restructure/src/compat/nio-compat.asd) ============================================================================== --- branches/home/psmith/restructure/src/compat/nio-compat.asd (original) +++ branches/home/psmith/restructure/src/utils/nio-utils.asd Sun Jan 21 23:12:43 2007 @@ -2,12 +2,10 @@ (in-package :asdf) -(defsystem :nio-compat +(defsystem :nio-utils - :components ((:file "nio-compat-package") - (:file "errno" :depends-on ("nio-compat-package")) - (:file "concurrent-queue" :depends-on ("nio-compat-package")) - (:file "utils" :depends-on ("nio-compat-package")) + :components ((:file "nio-utils-package") + (:file "utils" :depends-on ("nio-utils-package")) ) :depends-on ()) Copied: branches/home/psmith/restructure/src/utils/utils.lisp (from r48, branches/home/psmith/restructure/src/compat/utils.lisp) ============================================================================== --- branches/home/psmith/restructure/src/compat/utils.lisp (original) +++ branches/home/psmith/restructure/src/utils/utils.lisp Sun Jan 21 23:12:43 2007 @@ -25,7 +25,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -(in-package :nio-compat) +(in-package :nio-utils) (declaim (optimize (debug 3) (speed 3) (space 0))) From psmith at common-lisp.net Mon Jan 22 05:54:44 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Mon, 22 Jan 2007 00:54:44 -0500 (EST) Subject: [nio-cvs] r50 - in branches/home/psmith/restructure/src: io protocol/yarpc Message-ID: <20070122055444.8163A53012@common-lisp.net> Author: psmith Date: Mon Jan 22 00:54:43 2007 New Revision: 50 Modified: branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/async-socket.lisp branches/home/psmith/restructure/src/io/nio-server.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Log: logging tidyup 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 Mon Jan 22 00:54:43 2007 @@ -87,7 +87,7 @@ ;;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) + (format-log t "async-fd:create-state-machine - Created ~S~%" sm) (nio-buffer:clear (foreign-read-buffer sm)) (nio-buffer:clear (foreign-write-buffer sm)) sm)) 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 Mon Jan 22 00:54:43 2007 @@ -137,7 +137,7 @@ (init-inet-socket sa port addr) (let ((res (%connect socket-fd sa +sockaddr-in-len+))) - (format t "connect ~A ~A~%" res (get-errno)) + (format-log t "async-socket:connect-inet-socket library connect call returned ~A, and errno ~A~%" res (get-errno)) (if (= res -1) nil t)))) 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 Mon Jan 22 00:54:43 2007 @@ -40,8 +40,8 @@ ;loop over hashtable (defun process-async-fds (client-hash) (maphash #'(lambda (k async-fd) - (format t "Dealing with ~a => ~a~%" k async-fd) - + (format-log 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) @@ -115,7 +115,7 @@ ;; no accept, close (t - (format t "start-server - accept-connection closed~%") + (format-log t "start-server - accept-connection closed~%") (close-async-fd async-fd))))) @@ -136,12 +136,11 @@ (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+) + (format-log t "nio-server:start-server - Processing client add ~A~%" +connected-sockets+) (loop for new-fd in +connected-sockets+ do - (format t "Dealing with ~A~%" new-fd) + (format-log t "nio-server:start-server - 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)) @@ -168,7 +167,7 @@ (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+) + (format-log t "nio-server:add-connection - Socket 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/protocol/yarpc/yarpc-client-state-machine.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp Mon Jan 22 00:54:43 2007 @@ -56,16 +56,16 @@ (defconstant STATE-SENT-REQUEST 1) (defmethod process-outgoing-packet((sm yarpc-client-state-machine)) - (format t "process-outgoing-packet called, polling the job-queue ~%") + (format-log t "yarpc-client-state-machine:process-outgoing-packet called, polling the job-queue ~%") (let ((packet (nio-compat:take (job-queue sm) :blocking-call nil))) (when packet - (format t "process-outgoing-packet got job ~A ~%" packet) + (format-log t "yarpc-client-state-machine:process-outgoing-packet got job ~A ~%" packet) (setf (state sm) STATE-SENT-REQUEST)) packet)) (defmethod process-incoming-packet ((sm yarpc-client-state-machine) (response method-response-packet)) (assert (eql (state sm) STATE-SENT-REQUEST)) - (format t "yarpc-client-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm response) + (format-log t "yarpc-client-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm response) (let* ((*package* (find-package :nio-yarpc)) (result (read-from-string (response response)))) (setf (state sm) STATE-INITIALISED) 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 22 00:54:43 2007 @@ -42,8 +42,8 @@ (flip buf) (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))))))))) + (0 (progn (format-log t "yarpc-packet-factory:get-packet - got CALL-METHOD-PACKET-ID~%") (call-method-packet (bytebuffer-read-string buf (remaining buf))))) + (1 (progn (format-log t "yarpc-packet-factory:get-packet - got METHOD-RESPONSE-PACKET-ID~%") (method-response-packet (bytebuffer-read-string buf (remaining buf))))))))) (if (> (remaining buf) 0) (error 'not-implemented-yet) (clear buf)) @@ -59,10 +59,10 @@ (format stream "#" (call-string packet))) (defmethod write-bytes((packet call-method-packet) buf) -#+nio-debug (format t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) +#+nio-debug (format-log t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) (nio-buffer:bytebuffer-write-vector buf #(#x0)) (nio-buffer:bytebuffer-write-string buf (call-string packet)) -#+nio-debug (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf) +#+nio-debug (format-log t "yarpc-packet-factory:write-bytes - written ~A~%" buf) ) @@ -77,8 +77,8 @@ (format stream "#" (response packet))) (defmethod write-bytes((packet method-response-packet) buf) -#+nio-debug (format t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) +#+nio-debug (format-log 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))) -#+nio-debug (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf) +#+nio-debug (format-log 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 22 00:54:43 2007 @@ -59,23 +59,23 @@ (defun run-job(&key (wait-on-job-pdw t)) - (format-log t "Server toplevel waiting for job~%") + (format-log t "yarpc-state-machine:run-job - Server toplevel waiting for job~%") (destructuring-bind (job result-queue) (nio-compat:take nio-yarpc:job-queue :blocking-call wait-on-job-pdw) - (format-log t "Server received job ~A~%" job) + (format-log t "yarpc-state-machine:run-job - Server received job ~A~%" job) (nio-compat:add result-queue (nio-yarpc:execute-call job)))) (defmethod process-outgoing-packet((sm yarpc-state-machine)) - (format-log t "yarpc-state-machine: process-outgoing-packet called, polling the results-queue ~%" ) + (format-log t "yarpc-state-machine:process-outgoing-packet - called, polling the results-queue ~%" ) (let ((result (nio-compat:take (result-queue sm) :blocking-call nil))) - (format t "yarpc-state-machine: process-outgoing-packet got result ~A ~%" result) + (format-log t "yarpc-state-machine:process-outgoing-packet - got result ~A ~%" result) (when result (method-response-packet result)))) ;Process a call method packet by placing it in the job-queue (defmethod process-incoming-packet ((sm yarpc-state-machine) (call call-method-packet)) (assert (eql (state sm) STATE-INITIALISED)) - (format-log t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm call) + (format-log t "yarpc-state-machine:process-incoming-packet - called :sm ~A :packet ~A~%" sm call) (nio-compat:add job-queue (list (call-string call) (result-queue sm))) (when +process-jobs-inline+ (run-job :wait-on-job-pdw nil))) @@ -104,7 +104,7 @@ (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) + (format-log t "yarpc-state-machine:execute-call - 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)))) From psmith at common-lisp.net Tue Jan 23 05:52:10 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Tue, 23 Jan 2007 00:52:10 -0500 (EST) Subject: [nio-cvs] r51 - in branches/home/psmith/restructure/src: buffer io Message-ID: <20070123055210.606A03C006@common-lisp.net> Author: psmith Date: Tue Jan 23 00:52:09 2007 New Revision: 51 Modified: branches/home/psmith/restructure/src/buffer/buffer.lisp branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp branches/home/psmith/restructure/src/io/async-fd.lisp Log: Added copy-buffer and recommend-buffer-size 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 Tue Jan 23 00:52:09 2007 @@ -177,6 +177,18 @@ (bytebuffer-write-vector bb (sb-ext:string-to-octets str :external-format external-format))) + +(defmethod copy-buffer ((old byte-buffer) (new byte-buffer)) + (assert (<= (buffer-capacity old) (buffer-capacity new))) + (%memcpy (buffer-buf new) (buffer-buf old) (buffer-capacity old))) + +;void *memcpy(void *dest, const void *src, size_t n); +(cffi:defcfun ("memcpy" %memcpy) :pointer + (dest :pointer) + (src :pointer) + (len :int)) + +;void *memset(void *s, int c, size_t n); (cffi:defcfun ("memset" %memset) :pointer (buffer :pointer) (byte :int) @@ -203,6 +215,10 @@ (format t "Mybuf (after get-string): ~A~%" mybuf) + (let ((test-copy (byte-buffer 1024))) + (copy-buffer mybuf test-copy) + (format t "new copy: ~A~%" test-copy)) + (format t "Mybuf (after clear): ~A~%" (clear mybuf)) (free-buffer 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 Tue Jan 23 00:52:09 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 clear buffer-position + 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 copy-buffer )) 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 Tue Jan 23 00:52:09 2007 @@ -28,49 +28,24 @@ (declaim (optimize (debug 3) (speed 3) (space 0))) -;;; FFI - - - -;;; CLASSES - - - - - - (defclass async-fd () ((write-fd :initarg :write-fd :accessor write-fd) -;; (write-queue :initform nil) - (read-fd :initarg :read-fd :accessor read-fd) - (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 :initform nil :accessor read-ready :documentation "Have we been notified as read ready and not received EAGAIN from %read?") (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) - -;; (accept-filter :initform nil) -;; (read-callback :initform nil) - (socket :initarg :socket - :accessor socket) - - )) + :accessor socket))) (defmethod print-object ((async-fd async-fd) stream) @@ -93,7 +68,6 @@ sm)) ;;override this in concrete SM for close -;(defmethod process-close((async-fd async-fd)reason)()) (defmethod process-close((async-fd async-fd)reason)()) @@ -103,30 +77,23 @@ (with-slots (close-pending) async-fd (setf close-pending t))) -;;; FUNCTIONS - (define-condition read-error (error) ()) ;; "Read more data from STATE-MACHINE." (defun read-more (state-machine) (with-slots (foreign-read-buffer read-fd) state-machine #+nio-debug (format t "read-more called with ~A~%" state-machine) - #+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 into ~A~%" new-bytes foreign-read-buffer) (cond ((< new-bytes 0) (progn - ;;TODO if ret is -1 and errno is EAGAIN save state and wait for notification - (format t "read-error - Errno: ~A~%" (get-errno)) (error 'read-error))) - ((= new-bytes 0) nil);;(throw 'end-of-file nil) - (t ;;Update buffer position (inc-position foreign-read-buffer new-bytes) @@ -146,7 +113,6 @@ (define-condition read-error (error) ()) - (defun write-more (async-fd) "Write data from ASYNC-FD's write bytebuffer" (format-log t "async-fd:write-more - called with ~A~%" async-fd) @@ -154,23 +120,17 @@ #+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 "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))) - - (when (not (eql now-written -1)) (inc-position foreign-write-buffer 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) - ) - - +#+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 + ;;Deal with failure (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 @@ -181,15 +141,33 @@ (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) (when close-pending (close-async-fd async-fd))))) - +(defconstant +MAX-BUFFER-SIZE-BYTES+ (* 1024 1024)) +(defmacro check-buffer-size (buffer size) + `(>= (length ,buffer) ,size)) +(defun realloc-buffer (async-fd buffer size) + (if (check-buffer-size buffer size) + t + (let ((new-buffer (byte-buffer size))) + (copy-buffer buffer new-buffer) + (free-buffer buffer) + (setf (foreign-read-buffer async-fd) new-buffer)))) + + +;(recom +(defmethod recommend-buffer-size((async-fd async-fd) mode size) + (if (> size +MAX-BUFFER-SIZE-BYTES+) nil + (ecase mode + (:read (realloc-buffer (foreign-read-buffer async-fd) size)) + (:write (realloc-buffer (foreign-write-buffer async-fd) size))))) + (defun force-close-async-fd (async-fd) @@ -200,10 +178,7 @@ (defun add-async-fd (event-queue async-fd mode) (ecase mode -;; (:read (add-fd event-queue (slot-value async-fd 'read-fd) :read :trigger :level)) -;; (:write (add-fd event-queue (slot-value async-fd 'write-fd) :write :trigger :level)) - (:read-write (add-fd event-queue (slot-value async-fd 'write-fd) :read-write)) -)) + (:read-write (add-fd event-queue (slot-value async-fd 'write-fd) :read-write)))) (defun remove-async-fd (event-queue async-fd mode) From psmith at common-lisp.net Thu Jan 25 03:38:11 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Wed, 24 Jan 2007 22:38:11 -0500 (EST) Subject: [nio-cvs] r52 - branches/home/psmith/restructure/src/buffer Message-ID: <20070125033811.5C18A50034@common-lisp.net> Author: psmith Date: Wed Jan 24 22:38:10 2007 New Revision: 52 Modified: branches/home/psmith/restructure/src/buffer/buffer.lisp Log: added copy-buffer test 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 Wed Jan 24 22:38:10 2007 @@ -103,7 +103,7 @@ (defmethod print-object ((byte-buffer byte-buffer) stream) (with-slots (capacity position limit buf) byte-buffer - (format stream "~%" capacity position limit (if buf (pretty-hex-dump (cffi:pointer-address buf) limit) nil)))) + (format stream "~%" 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 @@ -180,7 +180,9 @@ (defmethod copy-buffer ((old byte-buffer) (new byte-buffer)) (assert (<= (buffer-capacity old) (buffer-capacity new))) - (%memcpy (buffer-buf new) (buffer-buf old) (buffer-capacity old))) + (%memcpy (buffer-buf new) (buffer-buf old) (buffer-capacity old)) + (setf (buffer-position new) (buffer-position old)) + (setf (buffer-limit new) (buffer-limit old))) ;void *memcpy(void *dest, const void *src, size_t n); (cffi:defcfun ("memcpy" %memcpy) :pointer @@ -205,8 +207,8 @@ (%memset (buffer-buf mybuf) 78 4) (format t "Mybuf (after memset): ~A~%" mybuf) -; (flip mybuf) -; (format t "Mybuf (after flip): ~A~%" mybuf) + (flip mybuf) + (format t "Mybuf (after flip): ~A~%" mybuf) (format t "Remaining ~A~%" (remaining mybuf)) From psmith at common-lisp.net Sun Jan 28 01:43:48 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sat, 27 Jan 2007 20:43:48 -0500 (EST) Subject: [nio-cvs] r53 - in branches/home/psmith/restructure/src: buffer io protocol/yarpc statemachine Message-ID: <20070128014348.10D9D3A019@common-lisp.net> Author: psmith Date: Sat Jan 27 20:43:47 2007 New Revision: 53 Modified: branches/home/psmith/restructure/src/buffer/buffer.lisp branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/nio-package.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp branches/home/psmith/restructure/src/statemachine/state-machine.lisp Log: start of large packet support 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 27 20:43:47 2007 @@ -35,7 +35,6 @@ (declaim (optimize (debug 3) (speed 3) (space 0))) - (defclass buffer () ((capacity :initarg :capacity :initform 0 @@ -93,14 +92,12 @@ "Make uint8 sequence." (make-sequence '(vector (unsigned-byte 8)) size :initial-element 0)) - ;;A buffer that deals with bytes (defclass byte-buffer (buffer)()) (defun byte-buffer (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 "~%" capacity position limit (if buf (hex-dump-memory (cffi:pointer-address buf) limit) nil)))) @@ -113,11 +110,15 @@ (setf limit 0) (setf position 0))) - +;bytes between the position and the limit (defmethod remaining((byte-buffer byte-buffer)) (with-slots (position limit) byte-buffer (- limit position))) +;bytes between the current position and capacity +(defmethod remaining-capacity((byte-buffer byte-buffer)) + (with-slots (position capacity) byte-buffer + (- capacity position))) (defmethod inc-position((byte-buffer byte-buffer) num-bytes) (with-slots (position limit) byte-buffer @@ -131,6 +132,12 @@ (setf limit position) (setf position 0))) +(defmethod unflip((byte-buffer byte-buffer)) + :documentation "make buffer ready for relative write operation. Used on partial read to reset the buffer for writing" + (with-slots (position limit capacity) byte-buffer + (setf position limit) + (setf limit capacity))) + (defmethod clear((byte-buffer byte-buffer)) :documentation "Reset the position to 0 and the limit to capacity" (with-slots (position limit capacity) byte-buffer @@ -150,11 +157,22 @@ (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)) - -;grrr... -;(defmethod bytebuffer-write-byte ((bb byte-buffer) value) -; (cffi:%mem-set value (buffer-buf bb) :unsigned-char position) -; (inc-position bb 1)) +; Read a byte from bytebuffer and return it incrementing the byte-buffers position +(defmethod bytebuffer-read-8((bb byte-buffer)) + (let ((val (cffi:mem-ref (cffi:make-pointer (+ (cffi:pointer-address (buffer-buf bb)) (buffer-position bb))) :unsigned-char ))) + (inc-position bb 1) + val)) + +; Read a 32 bit integer from bytebuffer and return it incrementing the byte-buffers position +(defmethod bytebuffer-read-32((bb byte-buffer)) + (let ((val (cffi:mem-ref (cffi:make-pointer (+ (cffi:pointer-address (buffer-buf bb)) (buffer-position bb))) :unsigned-int ))) + (inc-position bb 4) + val)) + +(defmethod bytebuffer-write-8 ((bb byte-buffer) value) + (setf (cffi:mem-ref (buffer-buf bb) :unsigned-char (buffer-position bb)) 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) @@ -200,8 +218,8 @@ (let ((mybuf (byte-buffer 32))) (format t "Mybuf: ~A~%" mybuf) (assert (eql 32 (remaining mybuf))) - (inc-position mybuf 2) - (assert (eql 30 (remaining mybuf))) + (inc-position mybuf 4) + (assert (eql 28 (remaining mybuf))) (format t "Mybuf: ~A~%" mybuf) (%memset (buffer-buf mybuf) 78 4) @@ -221,6 +239,9 @@ (copy-buffer mybuf test-copy) (format t "new copy: ~A~%" test-copy)) + (setf (buffer-position mybuf) 0) + (format t "bytebuffer-read-32 ~X~%" (bytebuffer-read-32 mybuf)) + (format t "Mybuf (after clear): ~A~%" (clear mybuf)) (free-buffer 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 Sat Jan 27 20:43:47 2007 @@ -27,5 +27,8 @@ (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 clear buffer-position copy-buffer + byte-buffer free-buffer remaining inc-position get-string buffer-buf + bytebuffer-write-vector bytebuffer-write-string + bytebuffer-read-vector bytebuffer-read-string bytebuffer-read-8 bytebuffer-read-32 + flip unflip clear buffer-position copy-buffer buffer-capacity )) 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 Sat Jan 27 20:43:47 2007 @@ -161,7 +161,7 @@ (setf (foreign-read-buffer async-fd) new-buffer)))) -;(recom +;TODO actually deal with cuffer allocation failure (defmethod recommend-buffer-size((async-fd async-fd) mode size) (if (> size +MAX-BUFFER-SIZE-BYTES+) nil (ecase mode 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 Sat Jan 27 20:43:47 2007 @@ -30,6 +30,7 @@ ;; async-fd.lisp async-fd process-read process-write foreign-read-buffer foreign-write-buffer close-sm + recommend-buffer-size ;; async-socket.lisp 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 Sat Jan 27 20:43:47 2007 @@ -40,18 +40,29 @@ (defmethod get-packet ((pf yarpc-packet-factory) buf) (flip buf) - (let ((ret (if (> (remaining buf) 0) ;; First byte denotes packet ID - (ecase (elt (bytebuffer-read-vector buf 1) 0) - (0 (progn (format-log t "yarpc-packet-factory:get-packet - got CALL-METHOD-PACKET-ID~%") (call-method-packet (bytebuffer-read-string buf (remaining buf))))) - (1 (progn (format-log t "yarpc-packet-factory:get-packet - 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)) + (if (>= (remaining buf) +yarpc-packet-header-size+) ;; First byte denotes packet ID ;;bytes 2,3,4,5 denote packet size + (let ((packet-id (bytebuffer-read-8 buf)) + (packet-length (bytebuffer-read-32 buf))) + (if (<= (- packet-length +yarpc-packet-header-size+) (remaining buf)) ;is the whole packet available in the buffer? + (ecase packet-id + (0 (progn (format-log t "yarpc-packet-factory:get-packet - got CALL-METHOD-PACKET-ID~%") (call-method-packet (bytebuffer-read-string buf (- packet-length +yarpc-packet-header-size+))))) + (1 (progn (format-log t "yarpc-packet-factory:get-packet - got METHOD-RESPONSE-PACKET-ID~%") (method-response-packet (bytebuffer-read-string buf (- packet-length +yarpc-packet-header-size+)))))) + (let ((buffer-capacity (buffer-capacity buf))) + ;Failed to read a whole packet unflip and check size + (unflip buf) + (if (> packet-length buffer-capacity) (error 'buffer-too-small-error :recommended-size packet-length))))))) + + (defclass call-method-packet (packet)((call-string :initarg :call-string :accessor call-string))) +(defconstant +PACKET-ID-SIZE+ 1) +(defconstant +PACKET-LENGTH-SIZE+ 4) + +(defconstant +yarpc-packet-header-size+ + (+ +PACKET-ID-SIZE+ +PACKET-LENGTH-SIZE+)) + (defun call-method-packet (call-string) (make-instance 'call-method-packet :call-string call-string)) 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 Sat Jan 27 20:43:47 2007 @@ -78,3 +78,12 @@ ; Get the packet in buf using the packet factory (defgeneric get-packet (packet-factory buf)) + +;Used to signal that the packet wants a larger buffer to complete this packet +(define-condition buffer-too-small-error (error) + ((recommended-size :initarg :recommended-size))) + +(defun buffer-too-small-error(recommended-size) + (make-instance 'buffer-too-small-error :recommended-size recommended-size)) + + From psmith at common-lisp.net Mon Jan 29 01:54:11 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 28 Jan 2007 20:54:11 -0500 (EST) Subject: [nio-cvs] r54 - branches/home/psmith/restructure/src/buffer Message-ID: <20070129015411.7FD712D16B@common-lisp.net> Author: psmith Date: Sun Jan 28 20:54:10 2007 New Revision: 54 Modified: branches/home/psmith/restructure/src/buffer/buffer.lisp Log: Added 8 & 32 accessors for the bytebuffer 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 28 20:54:10 2007 @@ -68,6 +68,12 @@ ;;-- end utils +(defun get-readable-char (char-code) + (if (<= char-code 32) + (code-char 46) + (if (> char-code 127) + (code-char 46) + (code-char char-code)))) (defun pretty-hex-dump (start-address length) ; (format t "start: ~A length ~A~%" start-address length) @@ -86,7 +92,7 @@ (format readable "--")) (progn (format str (if (eql column-index 7) "~A " "~A ") (hex-dump-byte address)) - (format readable "~A" (code-char (byte-value address))))))))))))) + (format readable "~A" (get-readable-char (byte-value address))))))))))))) (defun make-uint8-seq (size) "Make uint8 sequence." @@ -100,7 +106,7 @@ (defmethod print-object ((byte-buffer byte-buffer) stream) (with-slots (capacity position limit buf) byte-buffer - (format stream "~%" capacity position limit (if buf (hex-dump-memory (cffi:pointer-address buf) limit) nil)))) + (format stream "~%" capacity position limit (if buf (pretty-hex-dump (cffi:pointer-address buf) limit) nil)))) (defmethod free-buffer((byte-buffer byte-buffer)) (with-slots (capacity position limit buf) byte-buffer @@ -171,9 +177,14 @@ (defmethod bytebuffer-write-8 ((bb byte-buffer) value) (setf (cffi:mem-ref (buffer-buf bb) :unsigned-char (buffer-position bb)) value) -; (cffi:mem-set value (buffer-buf bb) :unsigned-char position) (inc-position bb 1)) +(defmethod bytebuffer-write-32 ((bb byte-buffer) value) + (setf (cffi:mem-ref (buffer-buf bb) :unsigned-int (buffer-position bb)) value) + (inc-position bb 4)) + + + ;; Write bytes from vector vec to bytebuffer (defmethod bytebuffer-write-vector((bb byte-buffer) vec) :documentation "Returns number of bytes written to bytebuffer" @@ -244,6 +255,23 @@ (format t "Mybuf (after clear): ~A~%" (clear mybuf)) + ;test accessors + (setf (buffer-position mybuf) 11) + (bytebuffer-write-8 mybuf 243) + (assert (eql (buffer-position mybuf) 12)) + (setf (buffer-position mybuf) 11) + (assert (eql (bytebuffer-read-8 mybuf) 243)) + (format t "Mybuf (after r/w 8bit): ~A~%" mybuf) + + (setf (buffer-position mybuf) 11) + (bytebuffer-write-32 mybuf 2147483649) + (assert (eql (buffer-position mybuf) 15)) + (setf (buffer-position mybuf) 11) + (assert (eql (bytebuffer-read-32 mybuf) 2147483649)) + (format t "Mybuf (after r/w 32bit): ~A~%" mybuf) + + + (free-buffer mybuf) (format t "Mybuf after free: ~A~%" mybuf))) From psmith at common-lisp.net Mon Jan 29 02:35:59 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 28 Jan 2007 21:35:59 -0500 (EST) Subject: [nio-cvs] r55 - in branches/home/psmith/restructure: . src/buffer src/protocol/yarpc Message-ID: <20070129023559.048AF5B074@common-lisp.net> Author: psmith Date: Sun Jan 28 21:35:58 2007 New Revision: 55 Modified: branches/home/psmith/restructure/run-yarpc-client.lisp 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/yarpc-packet-factory.lisp Log: large packet support first working version Modified: branches/home/psmith/restructure/run-yarpc-client.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc-client.lisp (original) +++ branches/home/psmith/restructure/run-yarpc-client.lisp Sun Jan 28 21:35:58 2007 @@ -1,4 +1,4 @@ -;(push :nio-debug *features*) +(push :nio-debug *features*) (require :asdf) (require :nio-yarpc) Modified: branches/home/psmith/restructure/run-yarpc.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc.lisp (original) +++ branches/home/psmith/restructure/run-yarpc.lisp Sun Jan 28 21:35:58 2007 @@ -1,6 +1,6 @@ ;Runs a multithreaded system with an IO thread dealing with IO only and a 'job' thread taking and executing jobs -;(push :nio-debug *features*) +(push :nio-debug *features*) (require :asdf) (require :nio-yarpc) 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 28 21:35:58 2007 @@ -175,14 +175,25 @@ (inc-position bb 4) val)) +;write an 8 bit value and up date position in buffer (defmethod bytebuffer-write-8 ((bb byte-buffer) value) (setf (cffi:mem-ref (buffer-buf bb) :unsigned-char (buffer-position bb)) value) (inc-position bb 1)) +;write a 32 bit value and up date position in buffer (defmethod bytebuffer-write-32 ((bb byte-buffer) value) (setf (cffi:mem-ref (buffer-buf bb) :unsigned-int (buffer-position bb)) value) (inc-position bb 4)) +;insert an 8 bit value +(defmethod bytebuffer-insert-8 ((bb byte-buffer) value byte-position) + (setf (cffi:mem-ref (buffer-buf bb) :unsigned-char byte-position) value)) + +;insert a 32 bit value +(defmethod bytebuffer-insert-32 ((bb byte-buffer) value byte-position) + (setf (cffi:mem-ref (buffer-buf bb) :unsigned-int byte-position) value)) + + ;; Write bytes from vector vec to bytebuffer 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 28 21:35:58 2007 @@ -29,6 +29,7 @@ (:export byte-buffer free-buffer remaining inc-position get-string buffer-buf bytebuffer-write-vector bytebuffer-write-string - bytebuffer-read-vector bytebuffer-read-string bytebuffer-read-8 bytebuffer-read-32 + bytebuffer-read-vector bytebuffer-read-string + bytebuffer-read-8 bytebuffer-read-32 bytebuffer-write-8 bytebuffer-write-32 bytebuffer-insert-8 bytebuffer-insert-32 flip unflip clear buffer-position copy-buffer buffer-capacity )) 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 28 21:35:58 2007 @@ -35,8 +35,14 @@ (defun yarpc-packet-factory () (make-instance 'yarpc-packet-factory)) -(defconstant CALL-METHOD-PACKET-ID #x0) -(defconstant METHOD-RESPONSE-PACKET-ID #x1) +(defconstant +CALL-METHOD-PACKET-ID+ #x0) +(defconstant +METHOD-RESPONSE-PACKET-ID+ #x1) + +(defconstant +PACKET-ID-SIZE+ 1) +(defconstant +PACKET-LENGTH-SIZE+ 4) + +(defconstant +yarpc-packet-header-size+ + (+ +PACKET-ID-SIZE+ +PACKET-LENGTH-SIZE+)) (defmethod get-packet ((pf yarpc-packet-factory) buf) (flip buf) @@ -56,13 +62,6 @@ (defclass call-method-packet (packet)((call-string :initarg :call-string :accessor call-string))) - -(defconstant +PACKET-ID-SIZE+ 1) -(defconstant +PACKET-LENGTH-SIZE+ 4) - -(defconstant +yarpc-packet-header-size+ - (+ +PACKET-ID-SIZE+ +PACKET-LENGTH-SIZE+)) - (defun call-method-packet (call-string) (make-instance 'call-method-packet :call-string call-string)) @@ -70,11 +69,13 @@ (format stream "#" (call-string packet))) (defmethod write-bytes((packet call-method-packet) buf) -#+nio-debug (format-log t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) - (nio-buffer:bytebuffer-write-vector buf #(#x0)) + #+nio-debug (format-log t "yarpc-packet-factory:write-bytes(call-method-packet) - writing ~%~A to ~%~A~%" packet buf) + (nio-buffer:bytebuffer-write-8 buf +CALL-METHOD-PACKET-ID+) + (nio-buffer:bytebuffer-write-32 buf 0) ; come back and write length later (nio-buffer:bytebuffer-write-string buf (call-string packet)) -#+nio-debug (format-log t "yarpc-packet-factory:write-bytes - written ~A~%" buf) -) + (nio-buffer:bytebuffer-insert-32 buf (buffer-position buf) 1) + #+nio-debug (format-log t "yarpc-packet-factory:write-bytes(call-method-packet) - written ~%~A ~%" buf) + ) (defclass method-response-packet (packet) @@ -89,7 +90,9 @@ (defmethod write-bytes((packet method-response-packet) buf) #+nio-debug (format-log t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) - (nio-buffer:bytebuffer-write-vector buf #(#x1)) + (nio-buffer:bytebuffer-write-8 buf +METHOD-RESPONSE-PACKET-ID+) + (nio-buffer:bytebuffer-write-32 buf 0) ; come back and write length later (nio-buffer:bytebuffer-write-string buf (write-to-string (response packet))) + (nio-buffer:bytebuffer-insert-32 buf (buffer-position buf) 1) #+nio-debug (format-log t "yarpc-packet-factory:write-bytes - written ~A~%" buf) ) From psmith at common-lisp.net Mon Jan 29 04:27:18 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 28 Jan 2007 23:27:18 -0500 (EST) Subject: [nio-cvs] r56 - in branches/home/psmith/restructure/src: buffer protocol/yarpc Message-ID: <20070129042718.0578C1E071@common-lisp.net> Author: psmith Date: Sun Jan 28 23:27:18 2007 New Revision: 56 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/yarpc/yarpc-packet-factory.lisp Log: fixed no compact problem 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 28 23:27:18 2007 @@ -151,6 +151,13 @@ (setf position 0) byte-buffer)) +(defmethod compact((byte-buffer byte-buffer)) + :documentation "copy remaining bytes to the beginning of this buffer and set position to number of bytes copied (ready for a new put" + (with-slots (buf position limit) byte-buffer + (let ((remaining (remaining byte-buffer))) + (%memcpy buf (cffi:make-pointer (+ (cffi:pointer-address buf) position)) remaining) + (setf position remaining)))) + ;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))) @@ -281,7 +288,14 @@ (assert (eql (bytebuffer-read-32 mybuf) 2147483649)) (format t "Mybuf (after r/w 32bit): ~A~%" mybuf) + (setf (buffer-position mybuf) 11) + (compact mybuf) + (format t "Mybuf (after compact): ~A~%" mybuf) + (assert (eql (buffer-position mybuf) (- 32 11))) + (flip mybuf) + (format t "Mybuf (flip): ~A~%" mybuf) + (assert (eql (bytebuffer-read-32 mybuf) 2147483649)) (free-buffer mybuf) (format t "Mybuf after free: ~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 Sun Jan 28 23:27:18 2007 @@ -31,5 +31,5 @@ bytebuffer-write-vector bytebuffer-write-string bytebuffer-read-vector bytebuffer-read-string bytebuffer-read-8 bytebuffer-read-32 bytebuffer-write-8 bytebuffer-write-32 bytebuffer-insert-8 bytebuffer-insert-32 - flip unflip clear buffer-position copy-buffer buffer-capacity + flip unflip clear buffer-position copy-buffer buffer-capacity compact )) 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 28 23:27:18 2007 @@ -50,11 +50,15 @@ (let ((packet-id (bytebuffer-read-8 buf)) (packet-length (bytebuffer-read-32 buf))) (if (<= (- packet-length +yarpc-packet-header-size+) (remaining buf)) ;is the whole packet available in the buffer? - (ecase packet-id - (0 (progn (format-log t "yarpc-packet-factory:get-packet - got CALL-METHOD-PACKET-ID~%") (call-method-packet (bytebuffer-read-string buf (- packet-length +yarpc-packet-header-size+))))) - (1 (progn (format-log t "yarpc-packet-factory:get-packet - got METHOD-RESPONSE-PACKET-ID~%") (method-response-packet (bytebuffer-read-string buf (- packet-length +yarpc-packet-header-size+)))))) - (let ((buffer-capacity (buffer-capacity buf))) + (let ((ret-packet (ecase packet-id + (0 (progn (format-log t "yarpc-packet-factory:get-packet - got CALL-METHOD-PACKET-ID~%") (call-method-packet (bytebuffer-read-string buf (- packet-length +yarpc-packet-header-size+))))) + (1 (progn (format-log t "yarpc-packet-factory:get-packet - got METHOD-RESPONSE-PACKET-ID~%") (method-response-packet (bytebuffer-read-string buf (- packet-length +yarpc-packet-header-size+)))))))) + (compact buf) + #+nio-debug (format-log t "yarpc-packet-factory:get-packet - after compact ~%~A~%" buf) + #+nio-debug (format-log t "yarpc-packet-factory:get-packet - retuirning packet ~A~%" ret-packet) + ret-packet) ;Failed to read a whole packet unflip and check size + (let ((buffer-capacity (buffer-capacity buf))) (unflip buf) (if (> packet-length buffer-capacity) (error 'buffer-too-small-error :recommended-size packet-length))))))) From psmith at common-lisp.net Mon Jan 29 05:40:17 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Mon, 29 Jan 2007 00:40:17 -0500 (EST) Subject: [nio-cvs] r57 - branches/home/psmith/restructure Message-ID: <20070129054017.155FD72083@common-lisp.net> Author: psmith Date: Mon Jan 29 00:40:10 2007 New Revision: 57 Added: branches/home/psmith/restructure/run-tests.lisp Log: Added tests main Added: branches/home/psmith/restructure/run-tests.lisp ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/run-tests.lisp Mon Jan 29 00:40:10 2007 @@ -0,0 +1,4 @@ +(require :asdf) +(require :nio-yarpc) +(in-package :nio-buffer) +(test-buffer) \ No newline at end of file From psmith at common-lisp.net Mon Jan 29 05:55:47 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Mon, 29 Jan 2007 00:55:47 -0500 (EST) Subject: [nio-cvs] r58 - in branches/home/psmith/restructure: . src/io Message-ID: <20070129055547.4666659096@common-lisp.net> Author: psmith Date: Mon Jan 29 00:55:46 2007 New Revision: 58 Added: branches/home/psmith/restructure/ips.txt branches/home/psmith/restructure/src/io/ip-authorisation.lisp Modified: branches/home/psmith/restructure/run-yarpc.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/nio.asd Log: Added ip authorisation Added: branches/home/psmith/restructure/ips.txt ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/ips.txt Mon Jan 29 00:55:46 2007 @@ -0,0 +1 @@ +("192.168.1.1" "127.0.0.1") Modified: branches/home/psmith/restructure/run-yarpc.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc.lisp (original) +++ branches/home/psmith/restructure/run-yarpc.lisp Mon Jan 29 00:55:46 2007 @@ -5,7 +5,8 @@ (require :nio-yarpc) (setf nio-yarpc:+process-jobs-inline+ nil) -(sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host "127.0.0.1")) :name "nio-server") +(nio:load-ips "ips.txt") +(sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host "127.0.0.1" :accept-connection 'nio:check-ip)) :name "nio-server") (loop ;;block waiting for jobs (nio-yarpc:run-job)) 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 Mon Jan 29 00:55:46 2007 @@ -101,9 +101,11 @@ (defun close-async-fd (async-fd) "Close ASYNC-FD's fd after everything has been written from write-queue." +#+nio-debug (format t "close-async-fd called with :async-fd ~A~%" async-fd) (with-slots (read-fd write-fd foreign-read-buffer foreign-write-buffer) async-fd + (nio-buffer:flip foreign-write-buffer) +#+nio-debug (format t "close-async-fd foreign-write-buffer ~A~%" foreign-write-buffer) (assert (eql (remaining foreign-write-buffer) 0)) -#+nio-debug (format t "close-async-fd called with :read-fd ~A :write-fd ~A~%" read-fd write-fd) ;; if write-queue is emtpy, close now (close-fd read-fd) (free-buffer foreign-read-buffer) Added: branches/home/psmith/restructure/src/io/ip-authorisation.lisp ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/src/io/ip-authorisation.lisp Mon Jan 29 00:55:46 2007 @@ -0,0 +1,41 @@ +#| +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) + +(declaim (optimize (debug 3) (speed 3) (space 0))) + +(defparameter +ip-list+ nil) + +(defun load-ips (filename) + (with-open-file (stream filename) + (setf +ip-list+ (read stream)))) + +(defun check-ip (async-fd) + (with-slots (remote-host) (socket async-fd) + (let ((str-rep (format nil "~{~a~^.~}" (reverse remote-host)))) + (format t "ip-authorisation:check-ip ~A ~A~%" str-rep +ip-list+) + (member str-rep +ip-list+ :test 'string-equal)))) \ No newline at end of file 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 Mon Jan 29 00:55:46 2007 @@ -39,4 +39,7 @@ ;;packet packet write-bytes + + ;;ip-authorisation + check-ip load-ips )) 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 Mon Jan 29 00:55:46 2007 @@ -106,8 +106,8 @@ (format t "Accept failed.~%")) ;; accept connection ? - ((set-fd-nonblocking (async-fd-read-fd async-fd)) - (funcall accept-connection async-fd) + ((funcall accept-connection async-fd) + (set-fd-nonblocking (async-fd-read-fd async-fd)) (setf (gethash (async-fd-read-fd async-fd) client-hash) async-fd) (add-async-fd event-queue async-fd :read-write) ; (add-async-fd event-queue async-fd :write) Modified: branches/home/psmith/restructure/src/io/nio.asd ============================================================================== --- branches/home/psmith/restructure/src/io/nio.asd (original) +++ branches/home/psmith/restructure/src/io/nio.asd Mon Jan 29 00:55:46 2007 @@ -10,6 +10,7 @@ (:file "async-fd" :depends-on ("fd-helper")) (:file "async-socket" :depends-on ("async-fd")) (:file "nio-server" :depends-on ("async-socket")) + (:file "ip-authorisation" :depends-on ("nio-package")) ) :depends-on (:cffi :event-notification :nio-buffer :nio-compat :nio-utils)) From psmith at common-lisp.net Tue Jan 30 04:43:01 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Mon, 29 Jan 2007 23:43:01 -0500 (EST) Subject: [nio-cvs] r59 - in branches/home/psmith/restructure: . src/nio-logger Message-ID: <20070130044301.7510C5D006@common-lisp.net> Author: psmith Date: Mon Jan 29 23:43:00 2007 New Revision: 59 Added: branches/home/psmith/restructure/src/nio-logger/ branches/home/psmith/restructure/src/nio-logger/ips.txt - copied unchanged from r58, branches/home/psmith/restructure/ips.txt branches/home/psmith/restructure/src/nio-logger/run-logging-client.lisp - copied, changed from r55, branches/home/psmith/restructure/run-yarpc-client.lisp branches/home/psmith/restructure/src/nio-logger/run-logging-server.lisp - copied, changed from r58, branches/home/psmith/restructure/run-yarpc.lisp Removed: branches/home/psmith/restructure/ips.txt branches/home/psmith/restructure/run-yarpc-client.lisp branches/home/psmith/restructure/run-yarpc.lisp Modified: branches/home/psmith/restructure/TODO Log: nio-logger first stab Modified: branches/home/psmith/restructure/TODO ============================================================================== --- branches/home/psmith/restructure/TODO (original) +++ branches/home/psmith/restructure/TODO Mon Jan 29 23:43:00 2007 @@ -11,8 +11,4 @@ Create UDP server -Create RPC server / client - Non blocking connects - -Allow large packets Copied: branches/home/psmith/restructure/src/nio-logger/run-logging-client.lisp (from r55, branches/home/psmith/restructure/run-yarpc-client.lisp) ============================================================================== --- branches/home/psmith/restructure/run-yarpc-client.lisp (original) +++ branches/home/psmith/restructure/src/nio-logger/run-logging-client.lisp Mon Jan 29 23:43:00 2007 @@ -1,12 +1,44 @@ -(push :nio-debug *features*) -(require :asdf) -(require :nio-yarpc) +#| +Copyright (c) 2007 +All rights reserved. -;;shouldn't be listenting on the client hence nil for accept SM to start-server -(sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity nil :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-client-state-machine))) - (nio-utils:format-log t "toplevel adding conn ~A~%" sm) - (loop - (nio-utils:format-log t "Toplevel Submitting job~%" ) - (nio-utils:format-log t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)")))) +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-logger) + +(declaim (optimize (debug 3) (speed 3) (space 0))) + +;;Tail the given log and write to remote logger +;;e.g. (tail-log "/var/log/httpd/access_log" "192.168.1.1") +(defun tail-log(filename ip-address) + ;;shouldn't be listenting on the client hence nil for accept SM to start-server + (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity nil :host "127.0.0.1" :port 9897)) :name "nio-server") + (sleep 4) + (let ((sm (nio:add-connection ip-address 16323 'nio-yarpc:yarpc-client-state-machine))) + (nio-utils:format-log t "toplevel adding conn ~A to ~A~%" sm ip-address) + (with-open-file (in filename :direction :input) + (loop for text = (read-line in nil nil) + (let ((rpc (format nil "(nio-logger:log +log-file-name+ ~A" text))) + (nio-utils:format-log t "Toplevel Submitting job~A~%" rpc) + (nio-utils:format-log t "Result of remote-log ~A~%" (nio-yarpc:remote-execute sm rpc))))))) Copied: branches/home/psmith/restructure/src/nio-logger/run-logging-server.lisp (from r58, branches/home/psmith/restructure/run-yarpc.lisp) ============================================================================== --- branches/home/psmith/restructure/run-yarpc.lisp (original) +++ branches/home/psmith/restructure/src/nio-logger/run-logging-server.lisp Mon Jan 29 23:43:00 2007 @@ -1,12 +1,44 @@ +#| +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-logger) + +(declaim (optimize (debug 3) (speed 3) (space 0))) + + ;Runs a multithreaded system with an IO thread dealing with IO only and a 'job' thread taking and executing jobs -(push :nio-debug *features*) -(require :asdf) -(require :nio-yarpc) - -(setf nio-yarpc:+process-jobs-inline+ nil) -(nio:load-ips "ips.txt") -(sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host "127.0.0.1" :accept-connection 'nio:check-ip)) :name "nio-server") -(loop +(defun run-logging-server() + (setf nio-yarpc:+process-jobs-inline+ nil) + (nio:load-ips "ips.txt") + (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host "127.0.0.1" :accept-connection 'nio:check-ip)) :name "nio-server") + (loop ;;block waiting for jobs - (nio-yarpc:run-job)) + (nio-yarpc:run-job))) + +(defremote log(destination control-string &rest format-arguments) + (format-log destination control-string format-arguments)) From psmith at common-lisp.net Tue Jan 30 05:45:18 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Tue, 30 Jan 2007 00:45:18 -0500 (EST) Subject: [nio-cvs] r60 - in branches/home/psmith/restructure/src: nio-logger protocol/yarpc Message-ID: <20070130054518.D5DAC2102F@common-lisp.net> Author: psmith Date: Tue Jan 30 00:45:18 2007 New Revision: 60 Added: branches/home/psmith/restructure/src/nio-logger/nio-logger-package.lisp - copied, changed from r49, branches/home/psmith/restructure/src/utils/nio-utils-package.lisp branches/home/psmith/restructure/src/nio-logger/nio-logger.asd - copied, changed from r49, branches/home/psmith/restructure/src/utils/nio-utils.asd branches/home/psmith/restructure/src/nio-logger/nio-logger.lisp branches/home/psmith/restructure/src/nio-logger/run.sh (contents, props changed) Modified: branches/home/psmith/restructure/src/nio-logger/run-logging-client.lisp branches/home/psmith/restructure/src/nio-logger/run-logging-server.lisp branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp Log: logging nearly there... Copied: branches/home/psmith/restructure/src/nio-logger/nio-logger-package.lisp (from r49, branches/home/psmith/restructure/src/utils/nio-utils-package.lisp) ============================================================================== --- branches/home/psmith/restructure/src/utils/nio-utils-package.lisp (original) +++ branches/home/psmith/restructure/src/nio-logger/nio-logger-package.lisp Tue Jan 30 00:45:18 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-utils (:use :cl) +(defpackage :nio-logger (:use :cl) (:export - ;;utils - format-log + ;;nio-logger + remote-log run-logging-server tail-log )) Copied: branches/home/psmith/restructure/src/nio-logger/nio-logger.asd (from r49, branches/home/psmith/restructure/src/utils/nio-utils.asd) ============================================================================== --- branches/home/psmith/restructure/src/utils/nio-utils.asd (original) +++ branches/home/psmith/restructure/src/nio-logger/nio-logger.asd Tue Jan 30 00:45:18 2007 @@ -2,11 +2,11 @@ (in-package :asdf) -(defsystem :nio-utils +(defsystem :nio-logger - :components ((:file "nio-utils-package") - (:file "utils" :depends-on ("nio-utils-package")) + :components ((:file "nio-logger-package") + (:file "nio-logger" :depends-on ("nio-logger-package")) ) - :depends-on ()) + :depends-on (:nio-yarpc)) Added: branches/home/psmith/restructure/src/nio-logger/nio-logger.lisp ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/src/nio-logger/nio-logger.lisp Tue Jan 30 00:45:18 2007 @@ -0,0 +1,57 @@ +#| +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-logger) + +(declaim (optimize (debug 3) (speed 3) (space 0))) + +;;Tail the given log and write to remote logger +;;e.g. (tail-log "/var/log/httpd/access_log" "192.168.1.1") +(defun tail-log(filename ip-address) + ;;shouldn't be listenting on the client hence nil for accept SM to start-server + (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity nil :host "127.0.0.1" :port 9897)) :name "nio-server") + (sleep 4) + (let ((sm (nio:add-connection ip-address 16323 'nio-yarpc:yarpc-client-state-machine))) + (nio-utils:format-log t "toplevel adding conn ~A to ~A~%" sm ip-address) + (with-open-file (in filename :direction :input) + (loop for text = (read-line in nil nil) do + (let ((rpc (format nil "(nio-logger:log +log-file-name+ ~A" text))) + (nio-utils:format-log t "Toplevel Submitting job~A~%" rpc) + (nio-utils:format-log t "Result of remote-log ~A~%" (nio-yarpc:remote-execute sm rpc))))))) + +;Runs a multithreaded system with an IO thread dealing with IO only and a 'job' thread taking and executing jobs + +(defun run-logging-server() + (setf nio-yarpc:+process-jobs-inline+ nil) + (nio:load-ips "ips.txt") + (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host "127.0.0.1" :accept-connection 'nio:check-ip)) :name "nio-server") + (loop + ;;block waiting for jobs + (nio-yarpc:run-job))) + +(nio-yarpc:defremote remote-log(destination control-string &rest format-arguments) + (format-log destination control-string format-arguments)) Modified: branches/home/psmith/restructure/src/nio-logger/run-logging-client.lisp ============================================================================== --- branches/home/psmith/restructure/src/nio-logger/run-logging-client.lisp (original) +++ branches/home/psmith/restructure/src/nio-logger/run-logging-client.lisp Tue Jan 30 00:45:18 2007 @@ -25,20 +25,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -(in-package :nio-logger) - -(declaim (optimize (debug 3) (speed 3) (space 0))) - -;;Tail the given log and write to remote logger -;;e.g. (tail-log "/var/log/httpd/access_log" "192.168.1.1") -(defun tail-log(filename ip-address) - ;;shouldn't be listenting on the client hence nil for accept SM to start-server - (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity nil :host "127.0.0.1" :port 9897)) :name "nio-server") - (sleep 4) - (let ((sm (nio:add-connection ip-address 16323 'nio-yarpc:yarpc-client-state-machine))) - (nio-utils:format-log t "toplevel adding conn ~A to ~A~%" sm ip-address) - (with-open-file (in filename :direction :input) - (loop for text = (read-line in nil nil) - (let ((rpc (format nil "(nio-logger:log +log-file-name+ ~A" text))) - (nio-utils:format-log t "Toplevel Submitting job~A~%" rpc) - (nio-utils:format-log t "Result of remote-log ~A~%" (nio-yarpc:remote-execute sm rpc))))))) +(push :nio-debug *features*) +(require :asdf) +(require :nio-yarpc) +(nio-logger:tail-log) Modified: branches/home/psmith/restructure/src/nio-logger/run-logging-server.lisp ============================================================================== --- branches/home/psmith/restructure/src/nio-logger/run-logging-server.lisp (original) +++ branches/home/psmith/restructure/src/nio-logger/run-logging-server.lisp Tue Jan 30 00:45:18 2007 @@ -25,20 +25,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -(in-package :nio-logger) - -(declaim (optimize (debug 3) (speed 3) (space 0))) - - -;Runs a multithreaded system with an IO thread dealing with IO only and a 'job' thread taking and executing jobs - -(defun run-logging-server() - (setf nio-yarpc:+process-jobs-inline+ nil) - (nio:load-ips "ips.txt") - (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host "127.0.0.1" :accept-connection 'nio:check-ip)) :name "nio-server") - (loop - ;;block waiting for jobs - (nio-yarpc:run-job))) - -(defremote log(destination control-string &rest format-arguments) - (format-log destination control-string format-arguments)) +(push :nio-debug *features*) +(require :asdf) +(require :nio-yarpc) +(nio-logger:run-logging-server) Added: branches/home/psmith/restructure/src/nio-logger/run.sh ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/src/nio-logger/run.sh Tue Jan 30 00:45:18 2007 @@ -0,0 +1,7 @@ +#!/bin/bash +# +# run.sh +# + +export LANG=en_US.UTF-8 +sbcl --load run-$1.lisp 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 Tue Jan 30 00:45:18 2007 @@ -34,7 +34,7 @@ ;; yarpc-state-machine yarpc-state-machine job-queue run-job +process-jobs-inline+ ;to be moved - test-rpc test-rpc-list test-rpc-string execute-call + test-rpc test-rpc-list test-rpc-string execute-call defremote ;;yarpc-client-state-machine yarpc-client-state-machine remote-execute From psmith at common-lisp.net Tue Jan 30 06:27:53 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Tue, 30 Jan 2007 01:27:53 -0500 (EST) Subject: [nio-cvs] r61 - branches/home/psmith/restructure/src/nio-logger Message-ID: <20070130062753.251974904C@common-lisp.net> Author: psmith Date: Tue Jan 30 01:27:51 2007 New Revision: 61 Modified: branches/home/psmith/restructure/src/nio-logger/nio-logger.asd branches/home/psmith/restructure/src/nio-logger/nio-logger.lisp branches/home/psmith/restructure/src/nio-logger/run-logging-client.lisp branches/home/psmith/restructure/src/nio-logger/run-logging-server.lisp Log: first working logger Modified: branches/home/psmith/restructure/src/nio-logger/nio-logger.asd ============================================================================== --- branches/home/psmith/restructure/src/nio-logger/nio-logger.asd (original) +++ branches/home/psmith/restructure/src/nio-logger/nio-logger.asd Tue Jan 30 01:27:51 2007 @@ -8,5 +8,5 @@ (:file "nio-logger" :depends-on ("nio-logger-package")) ) - :depends-on (:nio-yarpc)) + :depends-on (:nio-yarpc :nio-utils)) Modified: branches/home/psmith/restructure/src/nio-logger/nio-logger.lisp ============================================================================== --- branches/home/psmith/restructure/src/nio-logger/nio-logger.lisp (original) +++ branches/home/psmith/restructure/src/nio-logger/nio-logger.lisp Tue Jan 30 01:27:51 2007 @@ -39,12 +39,14 @@ (nio-utils:format-log t "toplevel adding conn ~A to ~A~%" sm ip-address) (with-open-file (in filename :direction :input) (loop for text = (read-line in nil nil) do - (let ((rpc (format nil "(nio-logger:log +log-file-name+ ~A" text))) + (let ((rpc (format nil "(nio-logger:remote-log \"~A\")" text))) (nio-utils:format-log t "Toplevel Submitting job~A~%" rpc) (nio-utils:format-log t "Result of remote-log ~A~%" (nio-yarpc:remote-execute sm rpc))))))) ;Runs a multithreaded system with an IO thread dealing with IO only and a 'job' thread taking and executing jobs +(defparameter +log-file-name+ "/tmp/out") + (defun run-logging-server() (setf nio-yarpc:+process-jobs-inline+ nil) (nio:load-ips "ips.txt") @@ -53,5 +55,6 @@ ;;block waiting for jobs (nio-yarpc:run-job))) -(nio-yarpc:defremote remote-log(destination control-string &rest format-arguments) - (format-log destination control-string format-arguments)) +(nio-yarpc:defremote remote-log(str) + (with-open-file (out +log-file-name+ :direction :output :if-exists :append) + (nio-utils:format-log out "~A~%" str))) Modified: branches/home/psmith/restructure/src/nio-logger/run-logging-client.lisp ============================================================================== --- branches/home/psmith/restructure/src/nio-logger/run-logging-client.lisp (original) +++ branches/home/psmith/restructure/src/nio-logger/run-logging-client.lisp Tue Jan 30 01:27:51 2007 @@ -27,5 +27,5 @@ (push :nio-debug *features*) (require :asdf) -(require :nio-yarpc) -(nio-logger:tail-log) +(require :nio-logger) +(nio-logger:tail-log "/tmp/test" "127.0.0.1") Modified: branches/home/psmith/restructure/src/nio-logger/run-logging-server.lisp ============================================================================== --- branches/home/psmith/restructure/src/nio-logger/run-logging-server.lisp (original) +++ branches/home/psmith/restructure/src/nio-logger/run-logging-server.lisp Tue Jan 30 01:27:51 2007 @@ -27,5 +27,5 @@ (push :nio-debug *features*) (require :asdf) -(require :nio-yarpc) +(require :nio-logger) (nio-logger:run-logging-server)