From psmith at common-lisp.net Sat Feb 3 03:12:25 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Fri, 2 Feb 2007 22:12:25 -0500 (EST) Subject: [nio-cvs] r62 - branches/home/psmith/restructure/src/compat Message-ID: <20070203031225.CC5A34904D@common-lisp.net> Author: psmith Date: Fri Feb 2 22:12:25 2007 New Revision: 62 Modified: branches/home/psmith/restructure/src/compat/errno.lisp branches/home/psmith/restructure/src/compat/nio-compat-package.lisp branches/home/psmith/restructure/src/compat/nio-compat.asd Log: Added perror Modified: branches/home/psmith/restructure/src/compat/errno.lisp ============================================================================== --- branches/home/psmith/restructure/src/compat/errno.lisp (original) +++ branches/home/psmith/restructure/src/compat/errno.lisp Fri Feb 2 22:12:25 2007 @@ -34,3 +34,11 @@ (defconstant +ERRNO_EAGAIN+ 11) + +(cffi:defcfun ("perror" %perror) :void + (function-str :pointer)) + + +(defun perror() + (%perror (cffi:null-pointer))) + \ No newline at end of file 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 Fri Feb 2 22:12:25 2007 @@ -29,7 +29,7 @@ (:export ;; errno.lisp - get-errno +ERRNO_EAGAIN+ + get-errno +ERRNO_EAGAIN+ perror ;;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 Fri Feb 2 22:12:25 2007 @@ -9,5 +9,5 @@ (:file "concurrent-queue" :depends-on ("nio-compat-package")) ) - :depends-on ()) + :depends-on (:cffi)) From psmith at common-lisp.net Sat Feb 3 03:16:10 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Fri, 2 Feb 2007 22:16:10 -0500 (EST) Subject: [nio-cvs] r63 - branches/home/psmith/restructure/src/buffer Message-ID: <20070203031610.722C64B006@common-lisp.net> Author: psmith Date: Fri Feb 2 22:16:10 2007 New Revision: 63 Modified: branches/home/psmith/restructure/src/buffer/buffer.lisp Log: Corrected compact 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 Feb 2 22:16:10 2007 @@ -88,8 +88,8 @@ ; (format t "Current address : ~A~%" address) (if (>= address (+ start-address length)) (progn - (format str "--") - (format readable "--")) + (format str (if (eql column-index 7) " " ".. ")) + (format readable ".")) (progn (format str (if (eql column-index 7) "~A " "~A ") (hex-dump-byte address)) (format readable "~A" (get-readable-char (byte-value address))))))))))))) @@ -153,10 +153,11 @@ (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 + (with-slots (buf position limit capacity) byte-buffer (let ((remaining (remaining byte-buffer))) (%memcpy buf (cffi:make-pointer (+ (cffi:pointer-address buf) position)) remaining) - (setf position remaining)))) + (setf position remaining) + (setf limit capacity)))) ;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))) From psmith at common-lisp.net Sat Feb 3 03:20:03 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Fri, 2 Feb 2007 22:20:03 -0500 (EST) Subject: [nio-cvs] r64 - in branches/home/psmith/restructure/src: io nio-logger Message-ID: <20070203032003.485444C00A@common-lisp.net> Author: psmith Date: Fri Feb 2 22:20:01 2007 New Revision: 64 Modified: branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/nio-logger/nio-logger.lisp Log: logger updates 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 Fri Feb 2 22:20:01 2007 @@ -136,6 +136,7 @@ (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 + (perror) (let ((err-cond (make-instance 'write-error :error err))) (close err-cond) (error err-cond)))) 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 Fri Feb 2 22:20:01 2007 @@ -29,6 +29,18 @@ (declaim (optimize (debug 3) (speed 3) (space 0))) + + +(defmacro with-line-from-tailed-file ((line filename delay) &rest body) + `(with-open-file (in ,filename :direction :input) + (loop for ,line = (read-line in nil nil) do + (if ,line + (progn , at body) + (progn + (format t "read nil~%") + (sleep ,delay)))))) + + ;;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) @@ -37,11 +49,10 @@ (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: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))))))) + (with-line-from-tailed-file (text filename 1) + (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 @@ -57,4 +68,6 @@ (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))) + (nio-utils:format-log out "~A~%" str)) + t) + From psmith at common-lisp.net Sat Feb 3 04:45:48 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Fri, 2 Feb 2007 23:45:48 -0500 (EST) Subject: [nio-cvs] r65 - branches/home/psmith/restructure/src/io Message-ID: <20070203044548.6F5D01A09C@common-lisp.net> Author: psmith Date: Fri Feb 2 23:45:48 2007 New Revision: 65 Modified: branches/home/psmith/restructure/src/io/nio-server.lisp Log: Only attempt write when theres something to be written 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 Fri Feb 2 23:45:48 2007 @@ -49,7 +49,9 @@ ;process-writes (process-write async-fd) - (when (write-ready async-fd) (write-more async-fd))) + (when (and (write-ready async-fd) + (> (buffer-position (foreign-write-buffer async-fd)) 0)) + (write-more async-fd))) client-hash)) From psmith at common-lisp.net Sun Feb 4 19:44:59 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 4 Feb 2007 14:44:59 -0500 (EST) Subject: [nio-cvs] r66 - in branches/home/psmith/restructure/src: buffer io nio-logger protocol/yarpc statemachine Message-ID: <20070204194459.62D6C5305D@common-lisp.net> Author: psmith Date: Sun Feb 4 14:44:58 2007 New Revision: 66 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/io/packet.lisp 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/protocol/yarpc/yarpc-packet-factory.lisp branches/home/psmith/restructure/src/statemachine/state-machine.lisp Log: plumb in 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 Sun Feb 4 14:44:58 2007 @@ -159,6 +159,18 @@ (setf position remaining) (setf limit capacity)))) + + +;Used to signal either an attempt has been made to write data to a buffer that is too small using a write (overflow) +; or an incomming packet doesn't have enough room to fit +(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)) + + + ;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))) @@ -185,11 +197,13 @@ ;write an 8 bit value and up date position in buffer (defmethod bytebuffer-write-8 ((bb byte-buffer) value) + (when (< (remaining bb) 1) (error 'buffer-too-small-error)) (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) + (when (< (remaining bb) 4) (error 'buffer-too-small-error)) (setf (cffi:mem-ref (buffer-buf bb) :unsigned-int (buffer-position bb)) value) (inc-position bb 4)) @@ -202,27 +216,24 @@ (setf (cffi:mem-ref (buffer-buf bb) :unsigned-int byte-position) value)) - - ;; Write bytes from vector vec to bytebuffer (defmethod bytebuffer-write-vector((bb byte-buffer) vec) :documentation "Returns number of bytes written to bytebuffer" #+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)))) + (when (< (remaining bb) (length vec)) (error 'buffer-too-small-error)) + (let ((bytes-written (cffi:mem-write-vector vec (buffer-buf bb) :unsigned-char (length vec) (buffer-position bb)))) #+nio-debug (format t "bytebuffer-write-vector - byteswritten: ~A~%" bytes-written) - (inc-position bb bytes-written) - 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))) + (let ((vec (sb-ext:string-to-octets str :external-format external-format))) + (when (< (remaining bb) (length vec)) (error 'buffer-too-small-error)) + (bytebuffer-write-vector bb vec))) 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 Feb 4 14:44:58 2007 @@ -32,4 +32,5 @@ 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 compact + buffer-too-small-error )) 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 Feb 4 14:44:58 2007 @@ -152,11 +152,8 @@ (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) + (if (>= (length buffer) size) t (let ((new-buffer (byte-buffer size))) (copy-buffer buffer new-buffer) @@ -164,7 +161,7 @@ (setf (foreign-read-buffer async-fd) new-buffer)))) -;TODO actually deal with cuffer allocation failure +;TODO actually deal with buffer 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 Sun Feb 4 14:44:58 2007 @@ -38,7 +38,7 @@ start-server add-connection ;;packet - packet write-bytes + packet write-bytes get-packet-size ;;ip-authorisation check-ip load-ips 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 Feb 4 14:44:58 2007 @@ -38,3 +38,6 @@ ;Implement in concrete (defgeneric write-bytes(packet nio-buffer)) + +(defgeneric get-packet-size(packet)) + 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 Sun Feb 4 14:44:58 2007 @@ -56,7 +56,7 @@ ;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") +(defparameter +log-file-name+ "./out") (defun run-logging-server() (setf nio-yarpc:+process-jobs-inline+ nil) 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 Sun Feb 4 14:44:58 2007 @@ -28,4 +28,4 @@ (push :nio-debug *features*) (require :asdf) (require :nio-logger) -(nio-logger:tail-log "/tmp/test" "127.0.0.1") +(nio-logger:tail-log "./test" "127.0.0.1") 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 Feb 4 14:44:58 2007 @@ -80,7 +80,10 @@ (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) ) - + +(defmethod get-packet-size ((packet call-method-packet)) + (+ +yarpc-packet-header-size+ + (length (sb-ext:string-to-octets (write-to-string (call-string packet)))))) (defclass method-response-packet (packet) ((response :initarg :response @@ -100,3 +103,7 @@ (nio-buffer:bytebuffer-insert-32 buf (buffer-position buf) 1) #+nio-debug (format-log t "yarpc-packet-factory:write-bytes - written ~A~%" buf) ) + +(defmethod get-packet-size ((packet method-response-packet)) + (+ +yarpc-packet-header-size+ + (length (sb-ext:string-to-octets (write-to-string (response 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 Feb 4 14:44:58 2007 @@ -68,7 +68,13 @@ (with-slots (foreign-write-buffer) sm (let ((outgoing-packet (process-outgoing-packet sm))) (format-log t "state-machine::process-write - outgoing packet: ~A~%" outgoing-packet) - (when outgoing-packet (write-bytes outgoing-packet foreign-write-buffer))))) + (when outgoing-packet + (handler-case + (write-bytes outgoing-packet foreign-write-buffer) + (buffer-too-small-error (e) + (if (recommend-buffer-size sm :write (get-packet-size outgoing-packet)) + (write-bytes outgoing-packet foreign-write-buffer) + (format t "Failed to resize io buffer, dropping packet: ~A~%" outgoing-packet)))))))) @@ -79,11 +85,7 @@ ; 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)) +; Get size of packet +(defgeneric get-packet (packet-factory buf)) From psmith at common-lisp.net Sun Feb 4 20:53:04 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 4 Feb 2007 15:53:04 -0500 (EST) Subject: [nio-cvs] r67 - in branches/home/psmith/restructure/src: buffer io protocol/yarpc statemachine Message-ID: <20070204205304.4EC7D330A1@common-lisp.net> Author: psmith Date: Sun Feb 4 15:53:04 2007 New Revision: 67 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/protocol/yarpc/yarpc-packet-factory.lisp branches/home/psmith/restructure/src/statemachine/state-machine.lisp Log: client side large packet OK 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 Feb 4 15:53:04 2007 @@ -48,6 +48,9 @@ :initform 0 :accessor buffer-position :documentation "Index of next element to be read/written 0<=position<=limit") + (mark :initarg :position + :initform 0 + :documentation "A marked position") (buf :initarg :buf :accessor buffer-buf))) @@ -159,6 +162,15 @@ (setf position remaining) (setf limit capacity)))) +(defmethod mark((bb byte-buffer)) + :documentation "mark a position in the buffer for subsequent use with reset" + (with-slots (position mark) bb + (setf mark position))) + +(defmethod reset((bb byte-buffer)) + (with-slots (position mark) bb + (setf position mark))) + ;Used to signal either an attempt has been made to write data to a buffer that is too small using a write (overflow) @@ -231,9 +243,7 @@ ;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" - (let ((vec (sb-ext:string-to-octets str :external-format external-format))) - (when (< (remaining bb) (length vec)) (error 'buffer-too-small-error)) - (bytebuffer-write-vector bb vec))) + (bytebuffer-write-vector bb (sb-ext:string-to-octets str :external-format external-format))) @@ -241,7 +251,7 @@ (assert (<= (buffer-capacity old) (buffer-capacity new))) (%memcpy (buffer-buf new) (buffer-buf old) (buffer-capacity old)) (setf (buffer-position new) (buffer-position old)) - (setf (buffer-limit new) (buffer-limit old))) + (setf (buffer-limit new) (buffer-capacity new))) ;void *memcpy(void *dest, const void *src, size_t n); (cffi:defcfun ("memcpy" %memcpy) :pointer 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 Feb 4 15:53:04 2007 @@ -31,6 +31,6 @@ 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 compact + flip unflip clear buffer-position copy-buffer buffer-capacity compact mark reset buffer-too-small-error )) 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 Feb 4 15:53:04 2007 @@ -152,21 +152,34 @@ (defconstant +MAX-BUFFER-SIZE-BYTES+ (* 1024 1024)) -(defun realloc-buffer (async-fd buffer size) - (if (>= (length 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)))) + + +;(let ((buffer (foreign-read-buffer async-fd))) +; (if (>= (length 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))))) + + +(defmacro realloc-buffer(async-fd accessor size) + `(let ((buffer (,accessor ,async-fd))) + (if (>= (buffer-capacity buffer) size) + t + (let ((new-buffer (byte-buffer ,size))) + (copy-buffer buffer new-buffer) + (free-buffer buffer) + (setf (,accessor ,async-fd) new-buffer))))) + ;TODO actually deal with buffer allocation failure (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))))) + (:read (realloc-buffer async-fd foreign-read-buffer size)) + (:write (realloc-buffer async-fd foreign-write-buffer size))))) 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 Feb 4 15:53:04 2007 @@ -74,12 +74,19 @@ (defmethod write-bytes((packet call-method-packet) buf) #+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-buffer:bytebuffer-insert-32 buf (buffer-position buf) 1) + (nio-buffer:mark buf) + (handler-case + (progn + (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-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) - ) + ) + (buffer-too-small-error (err) + (nio-buffer:reset buf) + (error err)))) + (defmethod get-packet-size ((packet call-method-packet)) (+ +yarpc-packet-header-size+ @@ -97,12 +104,18 @@ (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-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-buffer:mark buf) + (handler-case + (progn + (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) -) + ) + (buffer-too-small-error (err) + (nio-buffer:reset buf) + (error err)))) (defmethod get-packet-size ((packet method-response-packet)) (+ +yarpc-packet-header-size+ 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 Feb 4 15:53:04 2007 @@ -71,9 +71,11 @@ (when outgoing-packet (handler-case (write-bytes outgoing-packet foreign-write-buffer) - (buffer-too-small-error (e) + (buffer-too-small-error (write-error1) (if (recommend-buffer-size sm :write (get-packet-size outgoing-packet)) - (write-bytes outgoing-packet foreign-write-buffer) + (handler-case + (write-bytes outgoing-packet foreign-write-buffer) + (buffer-too-small-error (write-error1) (format t "Failed to write packet after resize (something already in write buffer?, dropping packet ~A~% out buffer:~%~A~%" outgoing-packet foreign-write-buffer))) (format t "Failed to resize io buffer, dropping packet: ~A~%" outgoing-packet)))))))) From psmith at common-lisp.net Sun Feb 4 23:04:14 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 4 Feb 2007 18:04:14 -0500 (EST) Subject: [nio-cvs] r68 - in branches/home/psmith/restructure/src: buffer io statemachine Message-ID: <20070204230414.D09BC15145@common-lisp.net> Author: psmith Date: Sun Feb 4 18:04:14 2007 New Revision: 68 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/statemachine/state-machine.lisp Log: large packet server side OK. 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 Feb 4 18:04:14 2007 @@ -107,6 +107,10 @@ (defun byte-buffer (capacity) (make-instance 'byte-buffer :capacity capacity :limit capacity :position 0 :buf (cffi:foreign-alloc :uint8 :count capacity))) +;Gets a pointer to the address in the native memory of the position index +(defmethod buffer-pointer ((bb byte-buffer)) + (cffi:make-pointer (+ (cffi:pointer-address (buffer-buf bb)) (buffer-position bb)))) + (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)))) @@ -176,7 +180,8 @@ ;Used to signal either an attempt has been made to write data to a buffer that is too small using a write (overflow) ; or an incomming packet doesn't have enough room to fit (define-condition buffer-too-small-error (error) - ((recommended-size :initarg :recommended-size))) + ((recommended-size :initarg :recommended-size + :accessor recommended-size))) (defun buffer-too-small-error(recommended-size) (make-instance 'buffer-too-small-error :recommended-size recommended-size)) 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 Feb 4 18:04:14 2007 @@ -32,5 +32,5 @@ 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 compact mark reset - buffer-too-small-error + buffer-too-small-error recommended-size buffer-pointer )) 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 Feb 4 18:04:14 2007 @@ -84,7 +84,7 @@ (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)))) + (let ((new-bytes (%read read-fd (buffer-pointer 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) 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 Feb 4 18:04:14 2007 @@ -56,7 +56,13 @@ ;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 ((incoming-packet (get-packet (get-packet-factory sm) foreign-read-buffer))) + (let ((incoming-packet + (handler-case + (get-packet (get-packet-factory sm) foreign-read-buffer) + (buffer-too-small-error (read-err) + (if (recommend-buffer-size sm :read (recommended-size read-err)) + (format-log t "resized incomming buffer ~A~%"foreign-read-buffer) + (error 'not-implemented-yet-read-resize-failure)))))) (format-log t "state-machine::process-read - incoming packet: ~A~%" incoming-packet) (when incoming-packet (when (not (process-incoming-packet sm incoming-packet)) From psmith at common-lisp.net Mon Feb 5 04:51:27 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 4 Feb 2007 23:51:27 -0500 (EST) Subject: [nio-cvs] r69 - branches/home/psmith/restructure/src/io Message-ID: <20070205045127.9986E330A1@common-lisp.net> Author: psmith Date: Sun Feb 4 23:51:27 2007 New Revision: 69 Modified: branches/home/psmith/restructure/src/io/fd-helper.lisp Log: Corrections to fcntl and O_NONBLOCK definitions for linux Modified: branches/home/psmith/restructure/src/io/fd-helper.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/fd-helper.lisp (original) +++ branches/home/psmith/restructure/src/io/fd-helper.lisp Sun Feb 4 23:51:27 2007 @@ -32,7 +32,12 @@ (defconstant +cmd-get-flags+ 3) (defconstant +cmd-set-flags+ 4) -(defconstant +arg-nonblock+ #x0004) + +#+(or darwin macosx freebsd) +(defconstant +arg-nonblock+ #x4) + +#+linux +(defconstant +arg-nonblock+ #x800) (defcfun ("close" %close) :int (fd :int)) @@ -40,7 +45,10 @@ (defcfun ("fcntl" %fcntl) :int (fd :int) (cmd :int) +#+(or darwin macosx freebsd) (arg :int)) +#+linux + (arg :long)) (defcfun ("read" %read) :long (fd :int) @@ -60,10 +68,15 @@ (defun memzero (ptr size) (%memset ptr 0 size)) +(defun get-fd-flags(unix-fd) + (%fcntl unix-fd +cmd-get-flags+ 0)) (defun set-fd-nonblocking (unix-fd) "Set UNIX-FD to non-blocking mode (O_NONBLOCK)." - (%fcntl unix-fd +cmd-set-flags+ +arg-nonblock+)) + (let* ((flags (get-fd-flags unix-fd)) + (new-flags (logior flags +arg-nonblock+))) + (format t "set-fd-nonblocking :fd ~A :old-flags 0x~X 0x~X~%" unix-fd flags new-flags) + (%fcntl unix-fd +cmd-set-flags+ new-flags))) (defun close-fd (unix-fd) From psmith at common-lisp.net Mon Feb 5 04:51:52 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 4 Feb 2007 23:51:52 -0500 (EST) Subject: [nio-cvs] r70 - branches/home/psmith/restructure/src/io Message-ID: <20070205045152.2839A3301C@common-lisp.net> Author: psmith Date: Sun Feb 4 23:51:51 2007 New Revision: 70 Modified: branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/nio-server.lisp Log: Large packet support working 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 Feb 4 23:51:51 2007 @@ -77,7 +77,9 @@ (with-slots (close-pending) async-fd (setf close-pending t))) -(define-condition read-error (error) ()) +(define-condition read-error (error) + ((errno :initform :errno + :accessor read-error-errno))) ;; "Read more data from STATE-MACHINE." (defun read-more (state-machine) @@ -88,16 +90,19 @@ #+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))) + (let ((errno (get-errno))) + (format t "read-error - Errno: ~A~%" errno) + (cond ((eql errno +ERRNO_EAGAIN+) + (setf (read-ready state-machine) nil)) + (t + (error 'read-error :errno errno))))) ((= new-bytes 0) nil);;(throw 'end-of-file nil) (t ;;Update buffer position (inc-position foreign-read-buffer new-bytes) - (setf (read-ready state-machine) nil)))))) + (when (> (remaining foreign-read-buffer) 0) + (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/nio-server.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/nio-server.lisp (original) +++ branches/home/psmith/restructure/src/io/nio-server.lisp Sun Feb 4 23:51:51 2007 @@ -109,7 +109,12 @@ ;; accept connection ? ((funcall accept-connection async-fd) - (set-fd-nonblocking (async-fd-read-fd async-fd)) + (sleep 0.1) + (let ((nb-ret (set-fd-nonblocking (async-fd-read-fd async-fd)))) + (format t "set bb ret: ~A :flags ~A~%" nb-ret (get-fd-flags (async-fd-read-fd async-fd))) + (when (< nb-ret 0) + (format t "Error setting socket non-blocking: ") + (perror))) (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) From psmith at common-lisp.net Mon Feb 5 16:57:22 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Mon, 5 Feb 2007 11:57:22 -0500 (EST) Subject: [nio-cvs] r71 - branches/home/psmith/restructure/src/nio-logger Message-ID: <20070205165722.E0C157E008@common-lisp.net> Author: psmith Date: Mon Feb 5 11:57:21 2007 New Revision: 71 Modified: branches/home/psmith/restructure/src/nio-logger/run-logging-client.lisp branches/home/psmith/restructure/src/nio-logger/run.sh Log: Made startup more firendly 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 Mon Feb 5 11:57:21 2007 @@ -28,4 +28,9 @@ (push :nio-debug *features*) (require :asdf) (require :nio-logger) -(nio-logger:tail-log "./test" "127.0.0.1") + +;Use run.sh logging-client +(let ((log-file (second sb-ext:*posix-argv*)) + (ip (third sb-ext:*posix-argv*))) + (format t "Starting logging client with ~A ~A~%" log-file ip) + (nio-logger:tail-log log-file ip)) Modified: branches/home/psmith/restructure/src/nio-logger/run.sh ============================================================================== --- branches/home/psmith/restructure/src/nio-logger/run.sh (original) +++ branches/home/psmith/restructure/src/nio-logger/run.sh Mon Feb 5 11:57:21 2007 @@ -1,7 +1,8 @@ #!/bin/bash # -# run.sh +# run.sh +# run.sh # export LANG=en_US.UTF-8 -sbcl --load run-$1.lisp +sbcl --load run-$1.lisp --end-toplevel-options $2 $3 From psmith at common-lisp.net Tue Feb 6 01:29:42 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Mon, 5 Feb 2007 20:29:42 -0500 (EST) Subject: [nio-cvs] r72 - branches/home/psmith/restructure/src/nio-logger Message-ID: <20070206012942.43E046200D@common-lisp.net> Author: psmith Date: Mon Feb 5 20:29:41 2007 New Revision: 72 Modified: branches/home/psmith/restructure/src/nio-logger/nio-logger.lisp branches/home/psmith/restructure/src/nio-logger/run-logging-server.lisp branches/home/psmith/restructure/src/nio-logger/run.sh Log: Updates to logging server for cmd line usage 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 Mon Feb 5 20:29:41 2007 @@ -58,10 +58,11 @@ (defparameter +log-file-name+ "./out") -(defun run-logging-server() +(defun run-logging-server(listen-ip out-file &optional (allowed-ips "ips.txt")) (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") + (setf +log-file-name+ out-file) + (nio:load-ips allowed-ips) + (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host listen-ip :accept-connection 'nio:check-ip)) :name "nio-server") (loop ;;block waiting for jobs (nio-yarpc:run-job))) 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 Mon Feb 5 20:29:41 2007 @@ -28,4 +28,9 @@ (push :nio-debug *features*) (require :asdf) (require :nio-logger) -(nio-logger:run-logging-server) + +(let ((listen-ip (second sb-ext:*posix-argv*)) + (out-file (third sb-ext:*posix-argv*)) + (allowed-ips-filename (fourth sb-ext:*posix-argv*))) + (format t "Starting logging Server with ~A ~A ~A~%" listen-ip out-file allowed-ips-filename) + (nio-logger:run-logging-server listen-ip out-file allowed-ips-filename)) Modified: branches/home/psmith/restructure/src/nio-logger/run.sh ============================================================================== --- branches/home/psmith/restructure/src/nio-logger/run.sh (original) +++ branches/home/psmith/restructure/src/nio-logger/run.sh Mon Feb 5 20:29:41 2007 @@ -1,8 +1,8 @@ #!/bin/bash # # run.sh -# run.sh +# run.sh # export LANG=en_US.UTF-8 -sbcl --load run-$1.lisp --end-toplevel-options $2 $3 +sbcl --load run-$1.lisp --end-toplevel-options $2 $3 $4 From psmith at common-lisp.net Tue Feb 6 01:30:09 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Mon, 5 Feb 2007 20:30:09 -0500 (EST) Subject: [nio-cvs] r73 - branches/home/psmith/restructure/src/io Message-ID: <20070206013009.DA79563062@common-lisp.net> Author: psmith Date: Mon Feb 5 20:30:09 2007 New Revision: 73 Modified: branches/home/psmith/restructure/src/io/fd-helper.lisp Log: Corrected typo Modified: branches/home/psmith/restructure/src/io/fd-helper.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/fd-helper.lisp (original) +++ branches/home/psmith/restructure/src/io/fd-helper.lisp Mon Feb 5 20:30:09 2007 @@ -46,7 +46,7 @@ (fd :int) (cmd :int) #+(or darwin macosx freebsd) - (arg :int)) + (arg :int) #+linux (arg :long)) From psmith at common-lisp.net Tue Feb 6 03:43:59 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Mon, 5 Feb 2007 22:43:59 -0500 (EST) Subject: [nio-cvs] r74 - in branches/home/psmith/restructure/src: io nio-logger protocol/yarpc Message-ID: <20070206034359.3C59E2E1BE@common-lisp.net> Author: psmith Date: Mon Feb 5 22:43:57 2007 New Revision: 74 Modified: 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/nio-logger/nio-logger.asd branches/home/psmith/restructure/src/nio-logger/nio-logger.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Log: Changes for server close 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 Feb 5 22:43:57 2007 @@ -43,7 +43,8 @@ (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) + (close-pending :initform nil + :accessor close-pending) (socket :initarg :socket :accessor socket))) @@ -151,7 +152,7 @@ (error 'not-implemented-yet)))) #+nio-debug (format t "write buffer after write :~A~%" foreign-write-buffer) - (when (eql (remaining foreign-write-buffer) 0) + (when (eql (buffer-position foreign-write-buffer) 0) (when close-pending (close-async-fd async-fd))))) 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 Feb 5 22:43:57 2007 @@ -30,7 +30,7 @@ ;; async-fd.lisp async-fd process-read process-write foreign-read-buffer foreign-write-buffer close-sm - recommend-buffer-size + recommend-buffer-size close-pending ;; async-socket.lisp 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 Feb 5 22:43:57 2007 @@ -39,7 +39,8 @@ ;loop over hashtable (defun process-async-fds (client-hash) - (maphash #'(lambda (k async-fd) + (let ((removals nil)) + (maphash #'(lambda (k async-fd) (format-log t "Dealing with ~a => ~a~%" k async-fd) ;process reads @@ -50,9 +51,16 @@ ;process-writes (process-write async-fd) (when (and (write-ready async-fd) - (> (buffer-position (foreign-write-buffer async-fd)) 0)) - (write-more async-fd))) - client-hash)) + (> (buffer-position (foreign-write-buffer async-fd)) 0)) + (write-more async-fd)) + + (when (close-pending async-fd) + (write-more async-fd) + (push async-fd removals))) + client-hash) + (dolist (async-fd removals) + (remhash (async-fd-read-fd async-fd) client-hash)) + (format t "client-hash list ~A~%"client-hash ))) 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 Mon Feb 5 22:43:57 2007 @@ -8,5 +8,5 @@ (:file "nio-logger" :depends-on ("nio-logger-package")) ) - :depends-on (:nio-yarpc :nio-utils)) + :depends-on (:nio-yarpc :nio-utils :cl-base64)) 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 Mon Feb 5 22:43:57 2007 @@ -50,7 +50,7 @@ (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-line-from-tailed-file (text filename 1) - (let ((rpc (format nil "(nio-logger:remote-log \"~A\")" text))) + (let ((rpc (format nil "(nio-logger:remote-log \"~A\")" (cl-base64:string-to-base64-string 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)))))) @@ -67,8 +67,8 @@ ;;block waiting for jobs (nio-yarpc:run-job))) -(nio-yarpc:defremote remote-log(str) +(nio-yarpc:defremote remote-log(base64-str) (with-open-file (out +log-file-name+ :direction :output :if-exists :append) - (nio-utils:format-log out "~A~%" str)) + (nio-utils:format-log out "~A~%" (cl-base64:base64-string-to-string base64-str))) t) 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 Feb 5 22:43:57 2007 @@ -102,12 +102,14 @@ (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-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)))) + (error 'authorization-error))) + (reader-error (re) (format-log t "yarpc-state-machine:execute-call - reader error on call-string ~A ~%" re)))) ;;end move TODO From psmith at common-lisp.net Wed Feb 7 01:17:03 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Tue, 6 Feb 2007 20:17:03 -0500 (EST) Subject: [nio-cvs] r75 - branches/home/psmith/restructure/src/statemachine Message-ID: <20070207011703.4F6972F058@common-lisp.net> Author: psmith Date: Tue Feb 6 20:17:03 2007 New Revision: 75 Modified: branches/home/psmith/restructure/src/statemachine/state-machine.lisp Log: Removed close con in sm if process-packet returns null (is allowed) 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 Tue Feb 6 20:17:03 2007 @@ -65,8 +65,7 @@ (error 'not-implemented-yet-read-resize-failure)))))) (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)))))) + (process-incoming-packet sm incoming-packet))))) ;The connection is write ready. ;See if theres anything ready to be written in the SM From psmith at common-lisp.net Wed Feb 7 01:48:25 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Tue, 6 Feb 2007 20:48:25 -0500 (EST) Subject: [nio-cvs] r76 - in branches/home/psmith/restructure: . src/event src/io src/nio-logger Message-ID: <20070207014825.4F9793E008@common-lisp.net> Author: psmith Date: Tue Feb 6 20:48:24 2007 New Revision: 76 Modified: branches/home/psmith/restructure/run-http.lisp branches/home/psmith/restructure/src/event/epoll.lisp branches/home/psmith/restructure/src/io/nio-server.lisp branches/home/psmith/restructure/src/nio-logger/nio-logger.lisp Log: Thread safe connect; tidy up Modified: branches/home/psmith/restructure/run-http.lisp ============================================================================== --- branches/home/psmith/restructure/run-http.lisp (original) +++ branches/home/psmith/restructure/run-http.lisp Tue Feb 6 20:48:24 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") +(nio:start-server 'nio-http:http-state-machine :host "127.0.0.1") 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 Tue Feb 6 20:48:24 2007 @@ -73,14 +73,14 @@ (define-condition poll-error (error) ()) (defun poll-events (event-queue) -#+nio-debug (format t "poll-events called with :event-queue ~A~%" event-queue) +#+nio-debug2 (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+ 100) do (progn -#+nio-debug (format t "poll-events - dealing with ~A~%" res) +#+nio-debug2 (format t "poll-events - dealing with ~A~%" res) (case res (-1 (let ((errno (get-errno))) 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 Tue Feb 6 20:48:24 2007 @@ -34,7 +34,7 @@ t) ;TODO thread safety -(defparameter +connected-sockets+ nil +(defparameter +connected-sockets-queue+ (nio-compat:concurrent-queue) "List of sockets that have been connected and are awaiting addition to the event-notification system") ;loop over hashtable @@ -59,13 +59,13 @@ (push async-fd removals))) client-hash) (dolist (async-fd removals) - (remhash (async-fd-read-fd async-fd) client-hash)) - (format t "client-hash list ~A~%"client-hash ))) + (remhash (async-fd-read-fd async-fd) client-hash)))) +; (format t "client-hash list ~A~%"client-hash ) -(defun start-server (connection-handler accept-filter connection-type +(defun start-server (connection-type &key (protocol :inet) (port (+ (random 60000) 1024)) @@ -153,14 +153,12 @@ (when (write-event-p event) (setf (write-ready async-fd) t))))))))) ;add outgoing sockets to event queue - (format-log t "nio-server:start-server - Processing client add ~A~%" +connected-sockets+) - (loop for new-fd in +connected-sockets+ do +#+nio-debug2 (format-log t "nio-server:start-server - Processing client add ~A~%" +connected-sockets-queue+) + + (loop for new-fd = (nio-compat:take +connected-sockets-queue+ :blocking-call nil) until (null new-fd) do (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)) - - ;TODO thread safety - (setf +connected-sockets+ nil) ;loop over async-fd's processing where necessary (process-async-fds client-hash) @@ -181,8 +179,8 @@ (if (connect-inet-socket sock host port) (let ((sm (create-state-machine connection-type sock sock sock))) - (push sm +connected-sockets+) - (format-log t "nio-server:add-connection - Socket enqueued: ~A~%" +connected-sockets+) + (nio-compat:add +connected-sockets-queue+ sm) + (format-log t "nio-server:add-connection - Socket enqueued: ~A~%" +connected-sockets-queue+) (return-from add-connection sm)) (format t "Connect failed!!~A ~%" (get-errno))))) \ No newline at end of file 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 Feb 6 20:48:24 2007 @@ -45,8 +45,7 @@ ;;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) + (sb-thread:make-thread #'(lambda()(nio:start-server nil)) :name "nio-server") (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-line-from-tailed-file (text filename 1) @@ -62,7 +61,7 @@ (setf nio-yarpc:+process-jobs-inline+ nil) (setf +log-file-name+ out-file) (nio:load-ips allowed-ips) - (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host listen-ip :accept-connection 'nio:check-ip)) :name "nio-server") + (sb-thread:make-thread #'(lambda()(nio:start-server 'nio-yarpc:yarpc-state-machine :host listen-ip :accept-connection 'nio:check-ip)) :name "nio-server") (loop ;;block waiting for jobs (nio-yarpc:run-job))) From psmith at common-lisp.net Wed Feb 7 04:55:55 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Tue, 6 Feb 2007 23:55:55 -0500 (EST) Subject: [nio-cvs] r77 - in branches/home/psmith/restructure/src: io nio-logger Message-ID: <20070207045555.C45C85F0F6@common-lisp.net> Author: psmith Date: Tue Feb 6 23:55:55 2007 New Revision: 77 Modified: branches/home/psmith/restructure/src/io/nio-server.lisp branches/home/psmith/restructure/src/nio-logger/nio-logger.lisp branches/home/psmith/restructure/src/nio-logger/run-logging-client.lisp Log: nio-server Only listen if necessary 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 Tue Feb 6 23:55:55 2007 @@ -65,35 +65,30 @@ -(defun start-server (connection-type +(defun start-server (connection-type &key - (protocol :inet) - (port (+ (random 60000) 1024)) - (host "localhost") + (protocol :inet) + (port (+ (random 60000) 1024)) + (host "127.0.0.1") (accept-connection #'trivial-accept)) - - (let (sock (event-queue (make-event-queue)) (client-hash (make-hash-table :test 'eql)) ) - (setq sock (ecase protocol - (:inet (make-inet-socket)) - (:inet6 (make-inet6-socket)))) - - (unless (ecase protocol - (:inet (bind-inet-socket sock port host)) - (:inet6 (bind-inet6-socket sock port host))) - (error "Can't bind socket!")) - - (set-fd-nonblocking sock) - - (format t "~&Starting server on ~S port ~S.. (socket fd is ~D)~%" host port sock) - - (start-listen sock) - - (add-fd event-queue sock :read :trigger :level) + (when (not (null connection-type)) + (format t "Binding to ~A:~A~%" host port) + (setq sock (ecase protocol + (:inet (make-inet-socket)) + (:inet6 (make-inet6-socket)))) + (unless (ecase protocol + (:inet (bind-inet-socket sock port host)) + (:inet6 (bind-inet6-socket sock port host))) + (error "Can't bind socket!")) + (set-fd-nonblocking sock) + (format t "~&Starting server on ~S port ~S.. (socket fd is ~D)~%" host port sock) + (start-listen sock) + (add-fd event-queue sock :read :trigger :level)) (format t "waiting for events..~%") (force-output) @@ -108,8 +103,10 @@ (loop for (fd . event) in unix-epoll-events do (cond ;; new connection - ((= fd sock) - (let ((async-fd (socket-accept fd connection-type))) + ((and sock (= fd sock)) + (progn +#+nio-debug (format t "start-server - incomming conn") + (let ((async-fd (socket-accept fd connection-type))) #+nio-debug (format t "start-server - New conn: ~A~%" async-fd) (cond ((null async-fd) @@ -131,7 +128,7 @@ ;; no accept, close (t (format-log t "start-server - accept-connection closed~%") - (close-async-fd async-fd))))) + (close-async-fd async-fd)))))) ;; socket i/o available @@ -168,10 +165,9 @@ (defun add-connection (host port connection-type - &key - (protocol :inet) - - ) + &key + (protocol :inet)) + (format-log t "nio-server:add-connection - Called with: ~A:~A:~A ~%" protocol host port) (let ((sock nil)) (setq sock (ecase protocol (:inet (make-inet-socket)) 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 Feb 6 23:55:55 2007 @@ -44,8 +44,7 @@ ;;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 nil)) :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-line-from-tailed-file (text filename 1) 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 Feb 6 23:55:55 2007 @@ -33,4 +33,7 @@ (let ((log-file (second sb-ext:*posix-argv*)) (ip (third sb-ext:*posix-argv*))) (format t "Starting logging client with ~A ~A~%" log-file ip) - (nio-logger:tail-log log-file ip)) + (sb-thread:make-thread #'(lambda()(nio-logger:tail-log log-file ip)) :name "nio-server") + + ;;shouldn't be listenting on the client hence nil for accept SM to start-server + (nio:start-server nil)) From psmith at common-lisp.net Wed Feb 7 06:03:22 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Wed, 7 Feb 2007 01:03:22 -0500 (EST) Subject: [nio-cvs] r78 - in branches/home/psmith/restructure/src: io protocol/yarpc statemachine Message-ID: <20070207060322.885357D164@common-lisp.net> Author: psmith Date: Wed Feb 7 01:03:21 2007 New Revision: 78 Modified: 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/statemachine/state-machine.lisp Log: verbosity changes 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 Feb 7 01:03:21 2007 @@ -41,7 +41,7 @@ (defun process-async-fds (client-hash) (let ((removals nil)) (maphash #'(lambda (k async-fd) - (format-log t "Dealing with ~a => ~a~%" k async-fd) +#+nio-debug2 (format-log t "Dealing with ~a => ~a~%" k async-fd) ;process reads (when (read-ready async-fd) (read-more async-fd)) @@ -153,7 +153,7 @@ #+nio-debug2 (format-log t "nio-server:start-server - Processing client add ~A~%" +connected-sockets-queue+) (loop for new-fd = (nio-compat:take +connected-sockets-queue+ :blocking-call nil) until (null new-fd) do - (format-log t "nio-server:start-server - Dealing with ~A~%" new-fd) +#+nio-debug (format-log t "nio-server:start-server - adding connection to nio thread ~A~%" new-fd) (setf (gethash (async-fd-read-fd new-fd) client-hash) new-fd) (add-async-fd event-queue new-fd :read-write)) 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 Feb 7 01:03:21 2007 @@ -56,12 +56,12 @@ (defconstant STATE-SENT-REQUEST 1) (defmethod process-outgoing-packet((sm yarpc-client-state-machine)) - (format-log t "yarpc-client-state-machine:process-outgoing-packet called, polling the job-queue ~%") +#+nio-debug2 (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-log t "yarpc-client-state-machine:process-outgoing-packet got job ~A ~%" packet) (setf (state sm) STATE-SENT-REQUEST)) - packet)) + packet)) (defmethod process-incoming-packet ((sm yarpc-client-state-machine) (response method-response-packet)) (assert (eql (state sm) STATE-SENT-REQUEST)) 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 Feb 7 01:03:21 2007 @@ -72,8 +72,8 @@ (defmethod process-write((sm state-machine)) (with-slots (foreign-write-buffer) sm (let ((outgoing-packet (process-outgoing-packet sm))) - (format-log t "state-machine::process-write - outgoing packet: ~A~%" outgoing-packet) (when outgoing-packet +#+nio-debug (format-log t "state-machine::process-write - outgoing packet: ~A~%" outgoing-packet) (handler-case (write-bytes outgoing-packet foreign-write-buffer) (buffer-too-small-error (write-error1) From psmith at common-lisp.net Thu Feb 8 00:31:51 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Wed, 7 Feb 2007 19:31:51 -0500 (EST) Subject: [nio-cvs] r79 - branches/home/psmith/restructure/src/nio-logger Message-ID: <20070208003151.59B8C4046@common-lisp.net> Author: psmith Date: Wed Feb 7 19:31:49 2007 New Revision: 79 Modified: branches/home/psmith/restructure/src/nio-logger/nio-logger.lisp Log: Removed unnecessary logging 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 Wed Feb 7 19:31:49 2007 @@ -37,7 +37,7 @@ (if ,line (progn , at body) (progn - (format t "read nil~%") +; (format t "read nil~%") (sleep ,delay)))))) From psmith at common-lisp.net Sat Feb 10 01:06:30 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Fri, 9 Feb 2007 20:06:30 -0500 (EST) Subject: [nio-cvs] r80 - in branches/home/psmith/restructure/src: io utils Message-ID: <20070210010630.7580F2D0A3@common-lisp.net> Author: psmith Date: Fri Feb 9 20:06:30 2007 New Revision: 80 Added: branches/home/psmith/restructure/src/io/nodes.lisp Modified: branches/home/psmith/restructure/src/io/nio.asd branches/home/psmith/restructure/src/utils/nio-utils-package.lisp Log: start of nodes 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 Fri Feb 9 20:06:30 2007 @@ -11,6 +11,7 @@ (:file "async-socket" :depends-on ("async-fd")) (:file "nio-server" :depends-on ("async-socket")) (:file "ip-authorisation" :depends-on ("nio-package")) + (:file "nodes" :depends-on ("nio-package")) ) :depends-on (:cffi :event-notification :nio-buffer :nio-compat :nio-utils)) Added: branches/home/psmith/restructure/src/io/nodes.lisp ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/src/io/nodes.lisp Fri Feb 9 20:06:30 2007 @@ -0,0 +1,80 @@ +#| +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))) + +;;concept of a remote socket +(defclass node() + ((host :initarg :host + :reader host) + (port :initarg :port + :reader port) + (last-connect-attempt :initform nil + :accessor last-connect-attempt + :documentation "Time we last attempted a connection") + (retry-delay :initform 600 + :accessor retry-delay + :documentation "The delay to wait after the last-connection-attempt before trying to connect again") + (active-conn :initform nil + :accessor active-conn + :documentation "If we are connected to this remote socket this is set to the SM"))) + +(defun node(host port) + (make-instance 'node :host host :port port)) + +;(node-from-socket-repn "192.168.1.1:1234") +(defun node-from-socket-repn(socket) + (let ((colon-idx (search ":" socket))) + (if colon-idx + (node (subseq socket 0 colon-idx) (subseq socket (+ colon-idx 1))) + (error 'parse-error)))) + + +(defmethod print-object ((a-node node) stream) + (with-slots (host port last-connect-attempt retry-delay active-conn) a-node + (format stream "#" host port last-connect-attempt retry-delay active-conn))) + + +(defparameter *nodes-list* nil + "List of nodes to connect to") + +(defun load-nodes (filename) + (with-open-file (stream filename) + (loop for line = (read-line stream nil nil) do + (push (node-from-socket-repn line) *nodes-list*)))) + + +;;returns floating point (high-res) next allowed connect time +(defun get-next-allowed-connect-time(node) + (if (null (last-connect-attempt node)) + (get-universal-high-res) + (+ (last-connect-attempt node) (retry-delay node)))) + +(defun update-last-connect-attempt(node) + (setf (last-connect-attempt node) (get-universal-high-res))) + Modified: 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/utils/nio-utils-package.lisp Fri Feb 9 20:06:30 2007 @@ -29,5 +29,5 @@ (:export ;;utils - format-log + format-log get-universal-high-res )) From psmith at common-lisp.net Sat Feb 10 20:36:44 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sat, 10 Feb 2007 15:36:44 -0500 (EST) Subject: [nio-cvs] r81 - in branches/home/psmith/restructure/src: io nio-logger protocol/yarpc Message-ID: <20070210203644.AD1C038010@common-lisp.net> Author: psmith Date: Sat Feb 10 15:36:43 2007 New Revision: 81 Modified: 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 branches/home/psmith/restructure/src/io/nodes.lisp branches/home/psmith/restructure/src/nio-logger/nio-logger.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: First stab at rpc multiplexing 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 Feb 10 15:36:43 2007 @@ -42,4 +42,7 @@ ;;ip-authorisation check-ip load-ips + + ;;nodes + node with-connected-nodes active-conn )) 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 Sat Feb 10 15:36:43 2007 @@ -35,7 +35,7 @@ ;TODO thread safety (defparameter +connected-sockets-queue+ (nio-compat:concurrent-queue) - "List of sockets that have been connected and are awaiting addition to the event-notification system") + "List of node objects that are to be connected to") ;loop over hashtable (defun process-async-fds (client-hash) @@ -150,12 +150,18 @@ (when (write-event-p event) (setf (write-ready async-fd) t))))))))) ;add outgoing sockets to event queue -#+nio-debug2 (format-log t "nio-server:start-server - Processing client add ~A~%" +connected-sockets-queue+) - - (loop for new-fd = (nio-compat:take +connected-sockets-queue+ :blocking-call nil) until (null new-fd) do +#+nio-debug2 (format-log t "nio-server:start-server - Processing new connections queue ~A~%" +connected-sockets-queue+) + (loop for node = (nio-compat:take +connected-sockets-queue+ :blocking-call nil) until (null node) do +#+nio-debug (format-log t "nio-server:start-server - adding node to nodes-list ~A~%" node) + (push node *nodes-list*)) + (with-connect-ready-nodes (a-node) +#+nio-debug (format-log t "nio-server:start-server - attempting connection to node ~A~%" a-node) + (let ((new-fd (connect (host a-node) (port a-node) connection-type))) + (update-last-connect-attempt a-node) + (when new-fd #+nio-debug (format-log t "nio-server:start-server - adding connection to nio thread ~A~%" new-fd) - (setf (gethash (async-fd-read-fd new-fd) client-hash) new-fd) - (add-async-fd event-queue new-fd :read-write)) + (setf (gethash (async-fd-read-fd new-fd) client-hash) new-fd) + (add-async-fd event-queue new-fd :read-write)))) ;loop over async-fd's processing where necessary (process-async-fds client-hash) @@ -164,10 +170,10 @@ (close-fd sock)))) -(defun add-connection (host port connection-type - &key - (protocol :inet)) - (format-log t "nio-server:add-connection - Called with: ~A:~A:~A ~%" protocol host port) +(defun connect(host port connection-type + &key + (protocol :inet)) + (format-log t "nio-server:connect - Called with: ~A:~A:~A ~%" protocol host port) (let ((sock nil)) (setq sock (ecase protocol (:inet (make-inet-socket)) @@ -175,8 +181,10 @@ (if (connect-inet-socket sock host port) (let ((sm (create-state-machine connection-type sock sock sock))) - (nio-compat:add +connected-sockets-queue+ sm) - (format-log t "nio-server:add-connection - Socket enqueued: ~A~%" +connected-sockets-queue+) - (return-from add-connection sm)) +; (nio-compat:add +connected-sockets-queue+ sm) +; (format-log t "nio-server:connect - Socket enqueued: ~A~%" +connected-sockets-queue+) + (return-from connect sm)) (format t "Connect failed!!~A ~%" (get-errno))))) - \ No newline at end of file + +(defun add-connection(node) + (nio-compat:add +connected-sockets-queue+ node)) \ No newline at end of file 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 Sat Feb 10 15:36:43 2007 @@ -9,9 +9,9 @@ (: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")) + (:file "nodes" :depends-on ("nio-package")) + (:file "nio-server" :depends-on ("async-socket" "nodes")) (:file "ip-authorisation" :depends-on ("nio-package")) - (:file "nodes" :depends-on ("nio-package")) ) :depends-on (:cffi :event-notification :nio-buffer :nio-compat :nio-utils)) Modified: branches/home/psmith/restructure/src/io/nodes.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/nodes.lisp (original) +++ branches/home/psmith/restructure/src/io/nodes.lisp Sat Feb 10 15:36:43 2007 @@ -75,6 +75,21 @@ (get-universal-high-res) (+ (last-connect-attempt node) (retry-delay node)))) +(defun allowed-to-connect(node) + (if (null (last-connect-attempt node)) + t + (and (not (active-conn node)) (< (+ (last-connect-attempt node) (retry-delay node)) (get-universal-high-res))))) + (defun update-last-connect-attempt(node) (setf (last-connect-attempt node) (get-universal-high-res))) +;;iterates over the nodes list looking for nodes that are ready to be connected to +;;i.e. the SM is null and the next-allowed-connect time has expired +(defmacro with-connect-ready-nodes ((node) &rest body) + `(dolist (,node *nodes-list*) + (when (allowed-to-connect ,node) , at body))) + + +(defmacro with-connected-nodes ((node) &rest body) + `(dolist (,node *nodes-list*) + (when (active-conn ,node) , at body))) 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 Sat Feb 10 15:36:43 2007 @@ -41,16 +41,20 @@ (sleep ,delay)))))) +(defun callback(result) + (nio-utils:format-log t "Result of remote-log ~A~%" result)) + + ;;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) (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-line-from-tailed-file (text filename 1) - (let ((rpc (format nil "(nio-logger:remote-log \"~A\")" (cl-base64:string-to-base64-string 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)))))) + (nio:add-connection (nio:node ip-address 16323)) + (with-line-from-tailed-file (text filename 1) + (let ((rpc (format nil "(nio-logger:remote-log \"~A\")" (cl-base64:string-to-base64-string text)))) + (nio-utils:format-log t "Toplevel Submitting job~A~%" rpc) + (nio:with-connected-nodes (node) + (nio-yarpc:remote-execute (nio:active-conn node) rpc #'callback))))) ;Runs a multithreaded system with an IO thread dealing with IO only and a 'job' thread taking and executing jobs 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 Sat Feb 10 15:36:43 2007 @@ -36,9 +36,23 @@ ((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 return results from the io thread to an external thread"))) + (request-map :initform (make-hash-table) + :reader request-map + :documentation "A map from request-id (a unique id for this request) to remote-job"))) + +(defclass remote-job() + ((callback :accessor callback + :documentation "A function accepting one argument to call with the result of the remote operation") + (start-time :initform (get-universal-high-res) + :reader start-time + :documentation "The (floating point) start time") + (timeout :initarg :timeout + :initform 1.5 + :documentation "The time in seconds before a timeout should occur, abviously we dont guarantee that this will be honored, it depends on other processing but should be close."))) + +(defun remote-job(callback) + (make-instance 'remote-job :callback callback)) + (defun yarpc-client-state-machine () (make-instance 'yarpc-client-state-machine)) @@ -55,25 +69,23 @@ (defconstant STATE-INITIALISED 0) (defconstant STATE-SENT-REQUEST 1) +(defparameter +request-id+ 0) + (defmethod process-outgoing-packet((sm yarpc-client-state-machine)) #+nio-debug2 (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-log t "yarpc-client-state-machine:process-outgoing-packet got job ~A ~%" packet) - (setf (state sm) STATE-SENT-REQUEST)) - packet)) + (let ((ttd (nio-compat:take (job-queue sm) :blocking-call nil))) + (when ttd + (format-log t "yarpc-client-state-machine:process-outgoing-packet got job ~A ~%" ttd) + (destructuring-bind (job call-string) ttd + (setf (gethash (1+ +request-id+) (request-map sm)) job) + (make-instance 'call-method-packet :call-string call-string :request-id +request-id+))))) (defmethod process-incoming-packet ((sm yarpc-client-state-machine) (response method-response-packet)) - (assert (eql (state sm) STATE-SENT-REQUEST)) (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) (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) - (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 + +;Execute the call-string on the remote node and call callback with the result +(defmethod remote-execute ((sm yarpc-client-state-machine) call-string callback) + (nio-compat:add (job-queue sm) '((remote-job callback) call-string))) 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 Feb 10 15:36:43 2007 @@ -40,19 +40,21 @@ (defconstant +PACKET-ID-SIZE+ 1) (defconstant +PACKET-LENGTH-SIZE+ 4) +;(defconstant +PACKET-REQUEST-ID+ 4) (defconstant +yarpc-packet-header-size+ (+ +PACKET-ID-SIZE+ +PACKET-LENGTH-SIZE+)) (defmethod get-packet ((pf yarpc-packet-factory) buf) (flip buf) - (if (>= (remaining buf) +yarpc-packet-header-size+) ;; First byte denotes packet ID ;;bytes 2,3,4,5 denote packet size + (if (>= (remaining buf) +yarpc-packet-header-size+) ;; First byte denotes packet ID ;;bytes 2,3,4,5 denote packet size ;; 6,7,8,9 request-id (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? - (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+)))))))) + (let* ((packet-request-id (bytebuffer-read-32 buf)) + (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+)) :request-id packet-request-id))) + (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+)) :request-id packet-request-id)))))) (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) @@ -64,7 +66,11 @@ -(defclass call-method-packet (packet)((call-string :initarg :call-string +(defclass yarpc-packet(packet) + ((request-id :initarg :request-id + :reader request-id))) + +(defclass call-method-packet (yarpc-packet)((call-string :initarg :call-string :accessor call-string))) (defun call-method-packet (call-string) (make-instance 'call-method-packet :call-string call-string)) @@ -79,6 +85,7 @@ (progn (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-32 buf (request-id packet)) (nio-buffer:bytebuffer-write-string buf (call-string packet)) (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) @@ -92,7 +99,7 @@ (+ +yarpc-packet-header-size+ (length (sb-ext:string-to-octets (write-to-string (call-string packet)))))) -(defclass method-response-packet (packet) +(defclass method-response-packet (yarpc-packet) ((response :initarg :response :accessor response))) @@ -109,6 +116,7 @@ (progn (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-32 buf (request-id packet)) (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) 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 Feb 10 15:36:43 2007 @@ -58,26 +58,25 @@ -(defun run-job(&key (wait-on-job-pdw t)) +(defun run-job(&key (blocking t)) (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) + (destructuring-bind (job request-id result-queue) (nio-compat:take nio-yarpc:job-queue :blocking-call blocking) (format-log t "yarpc-state-machine:run-job - Server received job ~A~%" job) - (nio-compat:add result-queue (nio-yarpc:execute-call job)))) + (nio-compat:add result-queue (list request-id (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 ~%" ) - (let ((result (nio-compat:take (result-queue sm) :blocking-call nil))) - (format-log t "yarpc-state-machine:process-outgoing-packet - got result ~A ~%" result) + (destructuring-bind (request-id result) (nio-compat:take (result-queue sm) :blocking-call nil) + (format-log t "yarpc-state-machine:process-outgoing-packet - got :request-id ~A result ~A ~%" request-id result) (when result - (method-response-packet result)))) + (method-response-packet result :request-id request-id)))) ;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) - (nio-compat:add job-queue (list (call-string call) (result-queue sm))) - (when +process-jobs-inline+ (run-job :wait-on-job-pdw nil))) + (nio-compat:add job-queue (list (call-string call) (request-id call) (result-queue sm))) + (when +process-jobs-inline+ (run-job :blocking nil))) From psmith at common-lisp.net Sat Feb 10 23:52:33 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sat, 10 Feb 2007 18:52:33 -0500 (EST) Subject: [nio-cvs] r82 - in branches/home/psmith/restructure/src: io nio-logger protocol/yarpc Message-ID: <20070210235233.80BF952009@common-lisp.net> Author: psmith Date: Sat Feb 10 18:52:32 2007 New Revision: 82 Modified: branches/home/psmith/restructure/src/io/nio-server.lisp 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/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: getting there... 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 Sat Feb 10 18:52:32 2007 @@ -68,7 +68,7 @@ (defun start-server (connection-type &key (protocol :inet) - (port (+ (random 60000) 1024)) + (port 0) ;//if set then listen (host "127.0.0.1") (accept-connection #'trivial-accept)) (let (sock @@ -76,7 +76,7 @@ (client-hash (make-hash-table :test 'eql)) ) - (when (not (null connection-type)) + (when (not (eql port 0)) (format t "Binding to ~A:~A~%" host port) (setq sock (ecase protocol (:inet (make-inet-socket)) @@ -161,6 +161,7 @@ (when new-fd #+nio-debug (format-log t "nio-server:start-server - adding connection to nio thread ~A~%" new-fd) (setf (gethash (async-fd-read-fd new-fd) client-hash) new-fd) + (setf (active-conn a-node) new-fd) (add-async-fd event-queue new-fd :read-write)))) ;loop over async-fd's processing where necessary 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 Sat Feb 10 18:52:32 2007 @@ -54,6 +54,7 @@ (let ((rpc (format nil "(nio-logger:remote-log \"~A\")" (cl-base64:string-to-base64-string text)))) (nio-utils:format-log t "Toplevel Submitting job~A~%" rpc) (nio:with-connected-nodes (node) + (nio-utils:format-log t "Toplevel sending ~A to ~A~%" rpc node) (nio-yarpc:remote-execute (nio:active-conn node) rpc #'callback))))) ;Runs a multithreaded system with an IO thread dealing with IO only and a 'job' thread taking and executing jobs @@ -64,7 +65,7 @@ (setf nio-yarpc:+process-jobs-inline+ nil) (setf +log-file-name+ out-file) (nio:load-ips allowed-ips) - (sb-thread:make-thread #'(lambda()(nio:start-server 'nio-yarpc:yarpc-state-machine :host listen-ip :accept-connection 'nio:check-ip)) :name "nio-server") + (sb-thread:make-thread #'(lambda()(nio:start-server 'nio-yarpc:yarpc-state-machine :host listen-ip :port 16323 :accept-connection 'nio:check-ip)) :name "nio-server") (loop ;;block waiting for jobs (nio-yarpc:run-job))) 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 Sat Feb 10 18:52:32 2007 @@ -36,4 +36,4 @@ (sb-thread:make-thread #'(lambda()(nio-logger:tail-log log-file ip)) :name "nio-server") ;;shouldn't be listenting on the client hence nil for accept SM to start-server - (nio:start-server nil)) + (nio:start-server 'nio-yarpc:yarpc-client-state-machine)) 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 Sat Feb 10 18:52:32 2007 @@ -41,7 +41,8 @@ :documentation "A map from request-id (a unique id for this request) to remote-job"))) (defclass remote-job() - ((callback :accessor callback + ((callback :initarg :callback + :accessor callback :documentation "A function accepting one argument to call with the result of the remote operation") (start-time :initform (get-universal-high-res) :reader start-time @@ -72,7 +73,7 @@ (defparameter +request-id+ 0) (defmethod process-outgoing-packet((sm yarpc-client-state-machine)) -#+nio-debug2 (format-log t "yarpc-client-state-machine:process-outgoing-packet called, polling the job-queue ~%") +#+nio-debug (format-log t "yarpc-client-state-machine:process-outgoing-packet called, polling the job-queue ~%") (let ((ttd (nio-compat:take (job-queue sm) :blocking-call nil))) (when ttd (format-log t "yarpc-client-state-machine:process-outgoing-packet got job ~A ~%" ttd) @@ -88,4 +89,5 @@ ;Execute the call-string on the remote node and call callback with the result (defmethod remote-execute ((sm yarpc-client-state-machine) call-string callback) - (nio-compat:add (job-queue sm) '((remote-job callback) call-string))) + (format-log t "yarpc-client-state-machine:remote-execute called :sm ~A :call-string ~A :callback ~A~%" sm call-string callback) + (nio-compat:add (job-queue sm) (list (remote-job callback) call-string))) 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 Feb 10 18:52:32 2007 @@ -40,7 +40,7 @@ (defconstant +PACKET-ID-SIZE+ 1) (defconstant +PACKET-LENGTH-SIZE+ 4) -;(defconstant +PACKET-REQUEST-ID+ 4) +(defconstant +PACKET-REQUEST-ID-SIZE+ 4) (defconstant +yarpc-packet-header-size+ (+ +PACKET-ID-SIZE+ +PACKET-LENGTH-SIZE+)) @@ -53,8 +53,8 @@ (if (<= (- packet-length +yarpc-packet-header-size+) (remaining buf)) ;is the whole packet available in the buffer? (let* ((packet-request-id (bytebuffer-read-32 buf)) (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+)) :request-id packet-request-id))) - (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+)) :request-id packet-request-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+ +PACKET-REQUEST-ID-SIZE+)) :request-id packet-request-id))) + (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+ +PACKET-REQUEST-ID-SIZE+)) :request-id packet-request-id)))))) (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) @@ -70,10 +70,12 @@ ((request-id :initarg :request-id :reader request-id))) -(defclass call-method-packet (yarpc-packet)((call-string :initarg :call-string - :accessor call-string))) -(defun call-method-packet (call-string) - (make-instance 'call-method-packet :call-string call-string)) +(defclass call-method-packet (yarpc-packet) + ((call-string :initarg :call-string + :accessor call-string))) + +(defun call-method-packet (call-string &key request-id) + (make-instance 'call-method-packet :call-string call-string :request-id request-id)) (defmethod print-object ((packet call-method-packet) stream) (format stream "#" (call-string packet))) @@ -103,8 +105,8 @@ ((response :initarg :response :accessor response))) -(defun method-response-packet (response) - (make-instance 'method-response-packet :response response)) +(defun method-response-packet (response &key request-id) + (make-instance 'method-response-packet :response response :request-id request-id)) (defmethod print-object ((packet method-response-packet) stream) (format stream "#" (response 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 Sat Feb 10 18:52:32 2007 @@ -60,17 +60,20 @@ (defun run-job(&key (blocking t)) (format-log t "yarpc-state-machine:run-job - Server toplevel waiting for job~%") - (destructuring-bind (job request-id result-queue) (nio-compat:take nio-yarpc:job-queue :blocking-call blocking) - (format-log t "yarpc-state-machine:run-job - Server received job ~A~%" job) - (nio-compat:add result-queue (list request-id (nio-yarpc:execute-call job))))) + (let ((server-job (nio-compat:take nio-yarpc:job-queue :blocking-call blocking))) + (when server-job + (destructuring-bind (job request-id result-queue) server-job + (format-log t "yarpc-state-machine:run-job - Server received job ~A~%" job) + (nio-compat:add result-queue (list request-id (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 ~%" ) - (destructuring-bind (request-id result) (nio-compat:take (result-queue sm) :blocking-call nil) - (format-log t "yarpc-state-machine:process-outgoing-packet - got :request-id ~A result ~A ~%" request-id result) - (when result - (method-response-packet result :request-id request-id)))) + (let ((server-job (nio-compat:take (result-queue sm) :blocking-call nil))) + (when server-job + (destructuring-bind (request-id result) server-job + (format-log t "yarpc-state-machine:process-outgoing-packet - got :request-id ~A result ~A ~%" request-id result) + (method-response-packet result :request-id request-id))))) ;Process a call method packet by placing it in the job-queue (defmethod process-incoming-packet ((sm yarpc-state-machine) (call call-method-packet)) From psmith at common-lisp.net Sun Feb 11 00:39:23 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sat, 10 Feb 2007 19:39:23 -0500 (EST) Subject: [nio-cvs] r83 - branches/home/psmith/restructure/src/protocol/yarpc Message-ID: <20070211003923.A17A76308B@common-lisp.net> Author: psmith Date: Sat Feb 10 19:39:23 2007 New Revision: 83 Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp Log: first working multiplexing rpc 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 Sat Feb 10 19:39:23 2007 @@ -78,14 +78,18 @@ (when ttd (format-log t "yarpc-client-state-machine:process-outgoing-packet got job ~A ~%" ttd) (destructuring-bind (job call-string) ttd - (setf (gethash (1+ +request-id+) (request-map sm)) job) + (setf (gethash (incf +request-id+) (request-map sm)) job) (make-instance 'call-method-packet :call-string call-string :request-id +request-id+))))) (defmethod process-incoming-packet ((sm yarpc-client-state-machine) (response method-response-packet)) (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)))) - (nio-compat:add (result-queue sm) result))) + (result (read-from-string (response response))) + (request-id (request-id response))) + (format-log t "yarpc-client-state-machine:process-incoming-packet :result ~A :request-id ~A~%" result request-id) + (maphash #'(lambda (k v) (format t "~a -> ~a~%" k v)) (request-map sm)) + (let ((remote-job (gethash request-id (request-map sm)))) + (funcall (callback remote-job) result)))) ;Execute the call-string on the remote node and call callback with the result (defmethod remote-execute ((sm yarpc-client-state-machine) call-string callback) From psmith at common-lisp.net Sun Feb 11 01:11:04 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sat, 10 Feb 2007 20:11:04 -0500 (EST) Subject: [nio-cvs] r84 - in branches/home/psmith/restructure/src: event io nio-logger protocol/yarpc statemachine Message-ID: <20070211011104.086A66308B@common-lisp.net> Author: psmith Date: Sat Feb 10 20:11:03 2007 New Revision: 84 Modified: branches/home/psmith/restructure/src/event/epoll.lisp branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/nio-server.lisp 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 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 branches/home/psmith/restructure/src/statemachine/state-machine.lisp Log: cleanup of debug msgs 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 Sat Feb 10 20:11:03 2007 @@ -84,10 +84,12 @@ (case res (-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) + (progn + (format t "-1 returned from epoll-wait, errno:") + (perror) + (error 'poll-error))))) (return nil) (t (let ((idents nil)) 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 Feb 10 20:11:03 2007 @@ -123,7 +123,7 @@ (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) +#+nio-debug (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 Sat Feb 10 20:11:03 2007 @@ -134,7 +134,7 @@ ;; socket i/o available (t (let ((async-fd (gethash fd client-hash))) - (format-log t "IO event ~A on ~A~%" event async-fd) +#+nio-debug (format-log t "nio-server::start-server - 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/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 Sat Feb 10 20:11:03 2007 @@ -42,7 +42,8 @@ (defun callback(result) - (nio-utils:format-log t "Result of remote-log ~A~%" result)) +#+nio-debug (nio-utils:format-log t "Result of remote-log ~A~%" result) +) ;;Tail the given log and write to remote logger @@ -52,9 +53,9 @@ (nio:add-connection (nio:node ip-address 16323)) (with-line-from-tailed-file (text filename 1) (let ((rpc (format nil "(nio-logger:remote-log \"~A\")" (cl-base64:string-to-base64-string text)))) - (nio-utils:format-log t "Toplevel Submitting job~A~%" rpc) +#+nio-debug (nio-utils:format-log t "nio-logger::tail-log Submitting job~A~%" rpc) (nio:with-connected-nodes (node) - (nio-utils:format-log t "Toplevel sending ~A to ~A~%" rpc node) +#+nio-debug (nio-utils:format-log t "Toplevel sending ~A to ~A~%" rpc node) (nio-yarpc:remote-execute (nio:active-conn node) rpc #'callback))))) ;Runs a multithreaded system with an IO thread dealing with IO only and a 'job' thread taking and executing jobs 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 Sat Feb 10 20:11:03 2007 @@ -25,7 +25,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -(push :nio-debug *features*) +;(push :nio-debug *features*) (require :asdf) (require :nio-logger) 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 Sat Feb 10 20:11:03 2007 @@ -25,7 +25,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -(push :nio-debug *features*) +;(push :nio-debug *features*) (require :asdf) (require :nio-logger) 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 Sat Feb 10 20:11:03 2007 @@ -76,22 +76,22 @@ #+nio-debug (format-log t "yarpc-client-state-machine:process-outgoing-packet called, polling the job-queue ~%") (let ((ttd (nio-compat:take (job-queue sm) :blocking-call nil))) (when ttd - (format-log t "yarpc-client-state-machine:process-outgoing-packet got job ~A ~%" ttd) +#+nio-debug (format-log t "yarpc-client-state-machine:process-outgoing-packet got job ~A ~%" ttd) (destructuring-bind (job call-string) ttd (setf (gethash (incf +request-id+) (request-map sm)) job) (make-instance 'call-method-packet :call-string call-string :request-id +request-id+))))) (defmethod process-incoming-packet ((sm yarpc-client-state-machine) (response method-response-packet)) - (format-log t "yarpc-client-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm response) +#+nio-debug (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))) (request-id (request-id response))) - (format-log t "yarpc-client-state-machine:process-incoming-packet :result ~A :request-id ~A~%" result request-id) - (maphash #'(lambda (k v) (format t "~a -> ~a~%" k v)) (request-map sm)) +#+nio-debug (format-log t "yarpc-client-state-machine:process-incoming-packet :result ~A :request-id ~A~%" result request-id) +; (maphash #'(lambda (k v) (format t "~a -> ~a~%" k v)) (request-map sm)) (let ((remote-job (gethash request-id (request-map sm)))) (funcall (callback remote-job) result)))) ;Execute the call-string on the remote node and call callback with the result (defmethod remote-execute ((sm yarpc-client-state-machine) call-string callback) - (format-log t "yarpc-client-state-machine:remote-execute called :sm ~A :call-string ~A :callback ~A~%" sm call-string callback) +#+nio-debug (format-log t "yarpc-client-state-machine:remote-execute called :sm ~A :call-string ~A :callback ~A~%" sm call-string callback) (nio-compat:add (job-queue sm) (list (remote-job callback) call-string))) 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 Feb 10 20:11:03 2007 @@ -53,8 +53,12 @@ (if (<= (- packet-length +yarpc-packet-header-size+) (remaining buf)) ;is the whole packet available in the buffer? (let* ((packet-request-id (bytebuffer-read-32 buf)) (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+ +PACKET-REQUEST-ID-SIZE+)) :request-id packet-request-id))) - (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+ +PACKET-REQUEST-ID-SIZE+)) :request-id packet-request-id)))))) + (0 (progn +#+nio-debug (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+ +PACKET-REQUEST-ID-SIZE+)) :request-id packet-request-id))) + (1 (progn +#+nio-debug (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+ +PACKET-REQUEST-ID-SIZE+)) :request-id packet-request-id)))))) (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) 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 Feb 10 20:11:03 2007 @@ -59,25 +59,25 @@ (defun run-job(&key (blocking t)) - (format-log t "yarpc-state-machine:run-job - Server toplevel waiting for job~%") +#+nio-debug (format-log t "yarpc-state-machine:run-job - Server toplevel waiting for job~%") (let ((server-job (nio-compat:take nio-yarpc:job-queue :blocking-call blocking))) (when server-job (destructuring-bind (job request-id result-queue) server-job - (format-log t "yarpc-state-machine:run-job - Server received job ~A~%" job) +#+nio-debug (format-log t "yarpc-state-machine:run-job - Server received job ~A~%" job) (nio-compat:add result-queue (list request-id (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 ~%" ) +#+nio-debug (format-log t "yarpc-state-machine:process-outgoing-packet - called, polling the results-queue ~%" ) (let ((server-job (nio-compat:take (result-queue sm) :blocking-call nil))) (when server-job (destructuring-bind (request-id result) server-job - (format-log t "yarpc-state-machine:process-outgoing-packet - got :request-id ~A result ~A ~%" request-id result) +#+nio-debug (format-log t "yarpc-state-machine:process-outgoing-packet - got :request-id ~A result ~A ~%" request-id result) (method-response-packet result :request-id request-id))))) ;Process a call method packet by placing it in the job-queue (defmethod process-incoming-packet ((sm yarpc-state-machine) (call call-method-packet)) - (format-log t "yarpc-state-machine:process-incoming-packet - called :sm ~A :packet ~A~%" sm call) +#+nio-debug (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) (request-id call) (result-queue sm))) (when +process-jobs-inline+ (run-job :blocking nil))) @@ -107,7 +107,7 @@ (handler-case (let* ((rpc-call-list (read-from-string call-string )) (fn (member (symbol-function (first rpc-call-list)) *remote-fns* ))) - (format-log t "yarpc-state-machine:execute-call - fn ~A authorised? : ~A~%" (symbol-function (first rpc-call-list)) fn) +#+nio-debug (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))) 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 Feb 10 20:11:03 2007 @@ -61,7 +61,9 @@ (get-packet (get-packet-factory sm) foreign-read-buffer) (buffer-too-small-error (read-err) (if (recommend-buffer-size sm :read (recommended-size read-err)) + (progn (format-log t "resized incomming buffer ~A~%"foreign-read-buffer) + nil) (error 'not-implemented-yet-read-resize-failure)))))) (format-log t "state-machine::process-read - incoming packet: ~A~%" incoming-packet) (when incoming-packet From psmith at common-lisp.net Sun Feb 11 23:53:11 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 11 Feb 2007 18:53:11 -0500 (EST) Subject: [nio-cvs] r85 - in branches/home/psmith/restructure/src: io nio-logger utils Message-ID: <20070211235311.7FF5338034@common-lisp.net> Author: psmith Date: Sun Feb 11 18:53:09 2007 New Revision: 85 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/io/nio.asd branches/home/psmith/restructure/src/io/nodes.lisp branches/home/psmith/restructure/src/nio-logger/nio-logger.asd 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/utils/nio-utils-package.lisp Log: Reconnect working 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 Feb 11 18:53:09 2007 @@ -45,14 +45,16 @@ :documentation "Have we been notified as write ready and not received EAGAIN from %write?") (close-pending :initform nil :accessor close-pending) +;TODO this is either an inet-socket if we are client side or a node is we are server side... (socket :initarg :socket - :accessor socket))) + :accessor socket + :documentation "The remote node we are talking to"))) (defmethod print-object ((async-fd async-fd) stream) - (with-slots (socket read-fd write-fd) async-fd - (format stream "#" - socket read-fd write-fd))) + (with-slots (read-fd write-fd) async-fd + (format stream "#" + read-fd write-fd))) ;;Implement this in concrete SM for read (defgeneric process-read (async-fd)) @@ -120,6 +122,8 @@ (define-condition read-error (error) ()) +(define-condition write-error (error) + ((error-number :initarg :error))) (defun write-more (async-fd) "Write data from ASYNC-FD's write bytebuffer" @@ -144,7 +148,7 @@ (unless (eql err 11) ;; eagain - failed to write whole buffer need to wait for next notify (perror) (let ((err-cond (make-instance 'write-error :error err))) - (close err-cond) + (close-fd (write-fd async-fd)) (error err-cond)))) ;;update buffers (if (eql (remaining foreign-write-buffer) 0) @@ -158,17 +162,6 @@ (defconstant +MAX-BUFFER-SIZE-BYTES+ (* 1024 1024)) - - -;(let ((buffer (foreign-read-buffer async-fd))) -; (if (>= (length 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))))) - - (defmacro realloc-buffer(async-fd accessor size) `(let ((buffer (,accessor ,async-fd))) (if (>= (buffer-capacity buffer) size) 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 Feb 11 18:53:09 2007 @@ -132,10 +132,10 @@ t nil))) -(defun connect-inet-socket (socket-fd addr port) +(defun connect-inet-socket (socket-fd node) + (format-log t "async-socket:connect-inet-socket ccalled with ~A, and ~A~%" socket-fd node) (with-foreign-object (sa 'sockaddr-in) - (init-inet-socket sa port addr) - + (init-inet-socket sa (remote-port node) (remote-host node)) (let ((res (%connect socket-fd sa +sockaddr-in-len+))) (format-log t "async-socket:connect-inet-socket library connect call returned ~A, and errno ~A~%" res (get-errno)) (if (= res -1) @@ -171,13 +171,6 @@ ;;;; SOCKET I/O -(defclass async-socket-fd () - ((family :initform :unknown :initarg :family) - (remote-host :initform nil :initarg :remote-host) - (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." @@ -200,16 +193,18 @@ (let ((len (foreign-alloc :unsigned-long :initial-element +sockaddr-in6-len+))) ;; accept connection +#+nio-debug (format-log t "async-socket::socket-accept - calling %accept~%") (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-fd (create-state-machine connection-type res res (node nil nil)))) + +#+nio-debug (format-log t "async-socket::socket-accept - create async-fd ~A~%" async-fd) (unless (< res 0) (let ((len-value (mem-ref len :unsigned-int))) ;; parse sockaddr struct for remote client info - (with-slots (family remote-host remote-port) (socket async-socket-fd) + (with-slots (family remote-host remote-port) (socket async-fd) (cond ((= len-value +sockaddr-in6-len+) @@ -224,12 +219,5 @@ (foreign-free len) - (if (>= res 0) async-socket-fd nil) + (if (>= res 0) async-fd nil) ))))))) - - -(defun remote-info (async-socket-fd) - "Return FAMILY, REMOTE-HOST and REMOTE-PORT in list." - (with-slots (family remote-host remote-port) async-socket-fd - (list family remote-host remote-port))) - 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 Feb 11 18:53:09 2007 @@ -41,7 +41,7 @@ (defun process-async-fds (client-hash) (let ((removals nil)) (maphash #'(lambda (k async-fd) -#+nio-debug2 (format-log t "Dealing with ~a => ~a~%" k async-fd) +#+nio-debug (format-log t "Dealing with ~a => ~a~%" k async-fd) ;process reads (when (read-ready async-fd) (read-more async-fd)) @@ -49,20 +49,22 @@ (process-read async-fd)) ;process-writes - (process-write async-fd) - (when (and (write-ready async-fd) - (> (buffer-position (foreign-write-buffer async-fd)) 0)) - (write-more async-fd)) - - (when (close-pending async-fd) - (write-more async-fd) - (push async-fd removals))) + (handler-case + (progn + (process-write async-fd) + (when (and (write-ready async-fd) + (> (buffer-position (foreign-write-buffer async-fd)) 0)) + (write-more async-fd)) + + (when (close-pending async-fd) + (write-more async-fd) + (push async-fd removals))) + (write-error (we) (push async-fd removals)))) client-hash) (dolist (async-fd removals) + (format-log t "nio-server:process-async-fds processing remove for ~a~%" async-fd) + (setf (active-conn (socket async-fd)) nil) (remhash (async-fd-read-fd async-fd) client-hash)))) -; (format t "client-hash list ~A~%"client-hash ) - - (defun start-server (connection-type @@ -121,9 +123,7 @@ (format t "Error setting socket non-blocking: ") (perror))) (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) - ) + (add-async-fd event-queue async-fd :read-write)) ;; no accept, close (t @@ -149,14 +149,16 @@ (when (read-event-p event) (setf (read-ready async-fd) t)) (when (write-event-p event) (setf (write-ready async-fd) t))))))))) - ;add outgoing sockets to event queue +;add outgoing sockets to event queue #+nio-debug2 (format-log t "nio-server:start-server - Processing new connections queue ~A~%" +connected-sockets-queue+) (loop for node = (nio-compat:take +connected-sockets-queue+ :blocking-call nil) until (null node) do #+nio-debug (format-log t "nio-server:start-server - adding node to nodes-list ~A~%" node) (push node *nodes-list*)) + (with-connect-ready-nodes (a-node) #+nio-debug (format-log t "nio-server:start-server - attempting connection to node ~A~%" a-node) - (let ((new-fd (connect (host a-node) (port a-node) connection-type))) + (let ((new-fd (connect a-node connection-type))) +#+nio-debug (format-log t "nio-server:start-server - connect returned async-fd ~A~%" new-fd) (update-last-connect-attempt a-node) (when new-fd #+nio-debug (format-log t "nio-server:start-server - adding connection to nio thread ~A~%" new-fd) @@ -171,19 +173,17 @@ (close-fd sock)))) -(defun connect(host port connection-type +(defun connect(node connection-type &key (protocol :inet)) - (format-log t "nio-server:connect - Called with: ~A:~A:~A ~%" protocol host port) + (format-log t "nio-server:connect - Called with: ~A ~A~%" protocol node) (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))) -; (nio-compat:add +connected-sockets-queue+ sm) -; (format-log t "nio-server:connect - Socket enqueued: ~A~%" +connected-sockets-queue+) + (if (connect-inet-socket sock node) + (let ((sm (create-state-machine connection-type sock sock node))) (return-from connect sm)) (format t "Connect failed!!~A ~%" (get-errno))))) 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 Feb 11 18:53:09 2007 @@ -8,8 +8,8 @@ (: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 "nodes" :depends-on ("nio-package")) + (:file "async-socket" :depends-on ("async-fd" "nodes")) (:file "nio-server" :depends-on ("async-socket" "nodes")) (:file "ip-authorisation" :depends-on ("nio-package")) ) Modified: branches/home/psmith/restructure/src/io/nodes.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/nodes.lisp (original) +++ branches/home/psmith/restructure/src/io/nodes.lisp Sun Feb 11 18:53:09 2007 @@ -28,24 +28,28 @@ (declaim (optimize (debug 3) (speed 3) (space 0))) -;;concept of a remote socket + +;;concept of a remote socket with properties e.g. stats, connection attempts etc (defclass node() - ((host :initarg :host - :reader host) - (port :initarg :port - :reader port) + ((family :initform :unknown :initarg :family) + (remote-host :initarg :remote-host + :initform nil + :accessor remote-host) + (remote-port :initarg :remote-port + :initform nil + :accessor remote-port) (last-connect-attempt :initform nil :accessor last-connect-attempt :documentation "Time we last attempted a connection") - (retry-delay :initform 600 + (retry-delay :initform 60 :accessor retry-delay - :documentation "The delay to wait after the last-connection-attempt before trying to connect again") + :documentation "The delay to wait (in secs) after the last-connection-attempt before trying to connect again (10 mins)") (active-conn :initform nil :accessor active-conn :documentation "If we are connected to this remote socket this is set to the SM"))) (defun node(host port) - (make-instance 'node :host host :port port)) + (make-instance 'node :remote-host host :remote-port port)) ;(node-from-socket-repn "192.168.1.1:1234") (defun node-from-socket-repn(socket) @@ -56,8 +60,9 @@ (defmethod print-object ((a-node node) stream) - (with-slots (host port last-connect-attempt retry-delay active-conn) a-node - (format stream "#" host port last-connect-attempt retry-delay active-conn))) + (with-slots (remote-host remote-port last-connect-attempt retry-delay active-conn) a-node + (format stream "#" + remote-host remote-port last-connect-attempt retry-delay active-conn))) (defparameter *nodes-list* nil 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 Sun Feb 11 18:53:09 2007 @@ -8,5 +8,5 @@ (:file "nio-logger" :depends-on ("nio-logger-package")) ) - :depends-on (:nio-yarpc :nio-utils :cl-base64)) + :depends-on (:nio-yarpc :nio-utils :cl-base64 :sb-posix)) 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 Sun Feb 11 18:53:09 2007 @@ -25,7 +25,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -;(push :nio-debug *features*) +(push :nio-debug *features*) (require :asdf) (require :nio-logger) @@ -33,7 +33,20 @@ (let ((log-file (second sb-ext:*posix-argv*)) (ip (third sb-ext:*posix-argv*))) (format t "Starting logging client with ~A ~A~%" log-file ip) - (sb-thread:make-thread #'(lambda()(nio-logger:tail-log log-file ip)) :name "nio-server") + (sb-thread:make-thread #'(lambda()(nio:start-server 'nio-yarpc:yarpc-client-state-machine)) :name "nio-server") +; (nio:add-connection (nio:node ip 16323)) +; (sleep 60) - ;;shouldn't be listenting on the client hence nil for accept SM to start-server - (nio:start-server 'nio-yarpc:yarpc-client-state-machine)) + (setf sb-ext:*invoke-debugger-hook* + (lambda (condition hook) + (declare (ignore hook)) + (with-open-file (out (format nil "error-from-pid~A-thread-~A" (sb-posix:getpid) (sb-thread:thread-name sb-thread:*current-thread*)) + :direction :output :external-format :utf-8 :if-exists :append :if-does-not-exist :create) + (format out "Toplevel catch (~A):~%" (nio-utils:get-readable-time)) + (format out "~A - ~A~%" (type-of condition) condition) + (sb-debug:backtrace 20 out)) + (quit))) + + + (nio-logger:tail-log log-file ip) +) 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 Sun Feb 11 18:53:09 2007 @@ -25,7 +25,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -;(push :nio-debug *features*) +(push :nio-debug *features*) (require :asdf) (require :nio-logger) Modified: 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/utils/nio-utils-package.lisp Sun Feb 11 18:53:09 2007 @@ -29,5 +29,5 @@ (:export ;;utils - format-log get-universal-high-res + format-log get-universal-high-res get-readable-time )) From psmith at common-lisp.net Mon Feb 12 03:29:07 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 11 Feb 2007 22:29:07 -0500 (EST) Subject: [nio-cvs] r86 - branches/home/psmith/restructure/src/io Message-ID: <20070212032907.4C5185834A@common-lisp.net> Author: psmith Date: Sun Feb 11 22:29:06 2007 New Revision: 86 Modified: branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/nio-server.lisp Log: tidied up close TODO detect remote close properly 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 Feb 11 22:29:06 2007 @@ -98,6 +98,7 @@ (cond ((eql errno +ERRNO_EAGAIN+) (setf (read-ready state-machine) nil)) (t + (close-fd (read-fd async-fd)) (error 'read-error :errno errno))))) ((= new-bytes 0) nil);;(throw 'end-of-file nil) @@ -148,7 +149,7 @@ (unless (eql err 11) ;; eagain - failed to write whole buffer need to wait for next notify (perror) (let ((err-cond (make-instance 'write-error :error err))) - (close-fd (write-fd async-fd)) + (close-fd (write-fd async-fd)); - deal with in nio-server? (error err-cond)))) ;;update buffers (if (eql (remaining foreign-write-buffer) 0) 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 Feb 11 22:29:06 2007 @@ -43,12 +43,14 @@ (maphash #'(lambda (k async-fd) #+nio-debug (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) - (process-read async-fd)) - - ;process-writes +;process reads + (handler-case + (progn + (when (read-ready async-fd) (read-more async-fd)) + (when (> (buffer-position (foreign-read-buffer async-fd)) 0) + (process-read async-fd))) + (read-error (re) (push async-fd removals))) +;process-writes (handler-case (progn (process-write async-fd) @@ -63,6 +65,7 @@ client-hash) (dolist (async-fd removals) (format-log t "nio-server:process-async-fds processing remove for ~a~%" async-fd) + (close-sm async-fd) (setf (active-conn (socket async-fd)) nil) (remhash (async-fd-read-fd async-fd) client-hash)))) From psmith at common-lisp.net Mon Feb 12 03:38:09 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 11 Feb 2007 22:38:09 -0500 (EST) Subject: [nio-cvs] r87 - branches/home/psmith/restructure/src/nio-logger Message-ID: <20070212033809.980C66011F@common-lisp.net> Author: psmith Date: Sun Feb 11 22:38:09 2007 New Revision: 87 Modified: branches/home/psmith/restructure/src/nio-logger/run-logging-client.lisp branches/home/psmith/restructure/src/nio-logger/run-logging-server.lisp Log: turned off debug 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 Sun Feb 11 22:38:09 2007 @@ -25,7 +25,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -(push :nio-debug *features*) +;(push :nio-debug *features*) (require :asdf) (require :nio-logger) 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 Sun Feb 11 22:38:09 2007 @@ -25,7 +25,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -(push :nio-debug *features*) +;(push :nio-debug *features*) (require :asdf) (require :nio-logger) From psmith at common-lisp.net Thu Feb 15 23:07:00 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Thu, 15 Feb 2007 18:07:00 -0500 (EST) Subject: [nio-cvs] r88 - in branches/home/psmith/restructure/src: io nio-logger Message-ID: <20070215230700.EBEB55200A@common-lisp.net> Author: psmith Date: Thu Feb 15 18:06:59 2007 New Revision: 88 Modified: branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/nio-server.lisp branches/home/psmith/restructure/src/nio-logger/run-logging-client.lisp Log: clean up close after error 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 Feb 15 18:06:59 2007 @@ -94,7 +94,7 @@ (cond ((< new-bytes 0) (let ((errno (get-errno))) - (format t "read-error - Errno: ~A~%" errno) + (format-log t "async-fd:read-more - read-error, Errno: ~A~%" errno) (cond ((eql errno +ERRNO_EAGAIN+) (setf (read-ready state-machine) 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 Thu Feb 15 18:06:59 2007 @@ -48,19 +48,17 @@ (progn (when (read-ready async-fd) (read-more async-fd)) (when (> (buffer-position (foreign-read-buffer async-fd)) 0) - (process-read async-fd))) - (read-error (re) (push async-fd removals))) + (process-read async-fd)) ;process-writes - (handler-case - (progn (process-write async-fd) (when (and (write-ready async-fd) (> (buffer-position (foreign-write-buffer async-fd)) 0)) (write-more async-fd)) - +;process normal close (when (close-pending async-fd) (write-more async-fd) (push async-fd removals))) + (read-error (re) (push async-fd removals)) (write-error (we) (push async-fd removals)))) client-hash) (dolist (async-fd removals) 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 Thu Feb 15 18:06:59 2007 @@ -33,7 +33,6 @@ (let ((log-file (second sb-ext:*posix-argv*)) (ip (third sb-ext:*posix-argv*))) (format t "Starting logging client with ~A ~A~%" log-file ip) - (sb-thread:make-thread #'(lambda()(nio:start-server 'nio-yarpc:yarpc-client-state-machine)) :name "nio-server") ; (nio:add-connection (nio:node ip 16323)) ; (sleep 60) @@ -47,6 +46,8 @@ (sb-debug:backtrace 20 out)) (quit))) + (sb-thread:make-thread #'(lambda()(nio:start-server 'nio-yarpc:yarpc-client-state-machine)) :name "nio-server") + (nio-logger:tail-log log-file ip) ) From psmith at common-lisp.net Sat Feb 17 23:42:29 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sat, 17 Feb 2007 18:42:29 -0500 (EST) Subject: [nio-cvs] r89 - in branches/home/psmith/restructure/src: event io nio-logger Message-ID: <20070217234229.B968D5605C@common-lisp.net> Author: psmith Date: Sat Feb 17 18:42:28 2007 New Revision: 89 Modified: branches/home/psmith/restructure/src/event/epoll-cffi.lisp branches/home/psmith/restructure/src/event/epoll.lisp branches/home/psmith/restructure/src/event/event-notification.lisp branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/nio-server.lisp branches/home/psmith/restructure/src/nio-logger/run-logging-client.lisp branches/home/psmith/restructure/src/nio-logger/run-logging-server.lisp Log: Hopefully fixes epollhup not handled properly on close Modified: branches/home/psmith/restructure/src/event/epoll-cffi.lisp ============================================================================== --- branches/home/psmith/restructure/src/event/epoll-cffi.lisp (original) +++ branches/home/psmith/restructure/src/event/epoll-cffi.lisp Sat Feb 17 18:42:28 2007 @@ -57,10 +57,15 @@ (fd :int) (pad :uint32)) +;;See man epoll_ctl +;;See /usr/include/sys/epoll.h + (defconstant +epoll-event-size+ #.(+ 4 4 4)) (defconstant +epoll-in+ #x001) (defconstant +epoll-out+ #x004) + (defconstant +epoll-error+ #x008) + (defconstant +epoll-hup+ #x010) (defconstant +epoll-et+ #.(ash 1 31)) (defconstant +epoll-ctl-add+ 1) 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 Sat Feb 17 18:42:28 2007 @@ -40,7 +40,11 @@ (defun write-event-p (event) (not (eql (logand event +epoll-out+) 0))) + (defun error-event-p (event) + (not (eql (logand event +epoll-error+) 0))) + (defun hup-event-p (event) + (not (eql (logand event +epoll-hup+) 0))) (defun add-fd (event-queue fd mode &key (trigger :edge)) (with-foreign-object (ev 'epoll-event) 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 Sat Feb 17 18:42:28 2007 @@ -26,4 +26,4 @@ |# (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 + make-event-queue add-fd remove-fd poll-events poll-error read-event-p write-event-p error-event-p hup-event-p)) \ No newline at end of file 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 Feb 17 18:42:28 2007 @@ -98,7 +98,7 @@ (cond ((eql errno +ERRNO_EAGAIN+) (setf (read-ready state-machine) nil)) (t - (close-fd (read-fd async-fd)) + (close-fd (read-fd state-machine)) (error 'read-error :errno errno))))) ((= new-bytes 0) nil);;(throw 'end-of-file nil) 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 Sat Feb 17 18:42:28 2007 @@ -147,8 +147,11 @@ (force-close-async-fd async-fd) (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))))))))) + (if (error-event-p event) + (close-sm async-fd) + (progn + (when (read-event-p event) (setf (read-ready async-fd) t)) + (when (write-event-p event) (setf (write-ready async-fd) t))))))))))) ;add outgoing sockets to event queue #+nio-debug2 (format-log t "nio-server:start-server - Processing new connections queue ~A~%" +connected-sockets-queue+) 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 Sat Feb 17 18:42:28 2007 @@ -25,7 +25,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -;(push :nio-debug *features*) +(push :nio-debug *features*) (require :asdf) (require :nio-logger) @@ -39,7 +39,7 @@ (setf sb-ext:*invoke-debugger-hook* (lambda (condition hook) (declare (ignore hook)) - (with-open-file (out (format nil "error-from-pid~A-thread-~A" (sb-posix:getpid) (sb-thread:thread-name sb-thread:*current-thread*)) + (with-open-file (out (format nil "client-error-from-pid~A-thread-~A" (sb-posix:getpid) (sb-thread:thread-name sb-thread:*current-thread*)) :direction :output :external-format :utf-8 :if-exists :append :if-does-not-exist :create) (format out "Toplevel catch (~A):~%" (nio-utils:get-readable-time)) (format out "~A - ~A~%" (type-of condition) condition) 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 Sat Feb 17 18:42:28 2007 @@ -25,7 +25,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -;(push :nio-debug *features*) +(push :nio-debug *features*) (require :asdf) (require :nio-logger) @@ -33,4 +33,17 @@ (out-file (third sb-ext:*posix-argv*)) (allowed-ips-filename (fourth sb-ext:*posix-argv*))) (format t "Starting logging Server with ~A ~A ~A~%" listen-ip out-file allowed-ips-filename) + + (setf sb-ext:*invoke-debugger-hook* + (lambda (condition hook) + (declare (ignore hook)) + (with-open-file (out (format nil "server-error-from-pid~A-thread-~A" (sb-posix:getpid) (sb-thread:thread-name sb-thread:*current-thread*)) + :direction :output :external-format :utf-8 :if-exists :append :if-does-not-exist :create) + (format out "Toplevel catch (~A):~%" (nio-utils:get-readable-time)) + (format out "~A - ~A~%" (type-of condition) condition) + (sb-debug:backtrace 20 out)) + (quit))) + + + (nio-logger:run-logging-server listen-ip out-file allowed-ips-filename)) From psmith at common-lisp.net Sun Feb 18 00:37:52 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sat, 17 Feb 2007 19:37:52 -0500 (EST) Subject: [nio-cvs] r90 - branches/home/psmith/restructure/src/io Message-ID: <20070218003752.7500C2D01D@common-lisp.net> Author: psmith Date: Sat Feb 17 19:37:51 2007 New Revision: 90 Modified: branches/home/psmith/restructure/src/io/async-fd.lisp Log: close on EOF 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 Feb 17 19:37:51 2007 @@ -101,7 +101,8 @@ (close-fd (read-fd state-machine)) (error 'read-error :errno errno))))) ((= new-bytes 0) - nil);;(throw 'end-of-file nil) + (format-log t "async-fd:read-more - EOF on ~A~%" state-machine) + (error 'read-error));;(throw 'end-of-file nil) (t ;;Update buffer position (inc-position foreign-read-buffer new-bytes) From psmith at common-lisp.net Sun Feb 18 00:45:13 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sat, 17 Feb 2007 19:45:13 -0500 (EST) Subject: [nio-cvs] r91 - branches/home/psmith/restructure/src/io Message-ID: <20070218004513.EE87F33080@common-lisp.net> Author: psmith Date: Sat Feb 17 19:45:13 2007 New Revision: 91 Modified: branches/home/psmith/restructure/src/io/nio-server.lisp Log: moved very verbose to another level 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 Sat Feb 17 19:45:13 2007 @@ -41,7 +41,7 @@ (defun process-async-fds (client-hash) (let ((removals nil)) (maphash #'(lambda (k async-fd) -#+nio-debug (format-log t "Dealing with ~a => ~a~%" k async-fd) +#+nio-debug2 (format-log t "Dealing with ~a => ~a~%" k async-fd) ;process reads (handler-case From psmith at common-lisp.net Sun Feb 18 00:57:27 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sat, 17 Feb 2007 19:57:27 -0500 (EST) Subject: [nio-cvs] r92 - in branches/home/psmith/restructure/src: protocol/yarpc statemachine Message-ID: <20070218005727.3DC2D34020@common-lisp.net> Author: psmith Date: Sat Feb 17 19:57:24 2007 New Revision: 92 Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp branches/home/psmith/restructure/src/statemachine/state-machine.lisp Log: tidy up logging 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 Feb 17 19:57:24 2007 @@ -68,7 +68,7 @@ (defmethod process-outgoing-packet((sm yarpc-state-machine)) -#+nio-debug (format-log t "yarpc-state-machine:process-outgoing-packet - called, polling the results-queue ~%" ) +#+nio-debug2 (format-log t "yarpc-state-machine:process-outgoing-packet - called, polling the results-queue ~%" ) (let ((server-job (nio-compat:take (result-queue sm) :blocking-call nil))) (when server-job (destructuring-bind (request-id result) server-job 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 Feb 17 19:57:24 2007 @@ -62,10 +62,10 @@ (buffer-too-small-error (read-err) (if (recommend-buffer-size sm :read (recommended-size read-err)) (progn - (format-log t "resized incomming buffer ~A~%"foreign-read-buffer) +#+nio-debug (format-log t "state-machine::process-read - resized incomming buffer ~A~%"foreign-read-buffer) nil) (error 'not-implemented-yet-read-resize-failure)))))) - (format-log t "state-machine::process-read - incoming packet: ~A~%" incoming-packet) +#+nio-debug (format-log t "state-machine::process-read - incoming packet: ~A~%" incoming-packet) (when incoming-packet (process-incoming-packet sm incoming-packet))))) From psmith at common-lisp.net Wed Feb 21 06:38:58 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Wed, 21 Feb 2007 01:38:58 -0500 (EST) Subject: [nio-cvs] r93 - in branches/home/psmith/restructure/src: io protocol/yarpc Message-ID: <20070221063858.4CA4F3201F@common-lisp.net> Author: psmith Date: Wed Feb 21 01:38:56 2007 New Revision: 93 Modified: branches/home/psmith/restructure/src/io/async-fd.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 Log: Eval whole string on rpc, allow user defined writer, increase default buffer size 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 Feb 21 01:38:56 2007 @@ -33,9 +33,9 @@ :accessor write-fd) (read-fd :initarg :read-fd :accessor read-fd) - (foreign-read-buffer :initform (byte-buffer 1024) + (foreign-read-buffer :initform (byte-buffer 2096) :accessor foreign-read-buffer) - (foreign-write-buffer :initform (byte-buffer 1024) + (foreign-write-buffer :initform (byte-buffer 2096) :accessor foreign-write-buffer) (read-ready :initform nil :accessor read-ready 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 Feb 21 01:38:56 2007 @@ -32,7 +32,7 @@ yarpc-state-machine-factory get-packet-factory ;; yarpc-state-machine - yarpc-state-machine job-queue run-job +process-jobs-inline+ + yarpc-state-machine job-queue run-job +process-jobs-inline+ +serialise-packet-fn+ ;to be moved test-rpc test-rpc-list test-rpc-string execute-call defremote 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 Wed Feb 21 01:38:56 2007 @@ -115,6 +115,8 @@ (defmethod print-object ((packet method-response-packet) stream) (format stream "#" (response packet))) +(defparameter +serialise-packet-fn+ #'(lambda (result)(write-to-string result))) + (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:mark buf) @@ -123,7 +125,7 @@ (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-32 buf (request-id packet)) - (nio-buffer:bytebuffer-write-string buf (write-to-string (response packet))) + (nio-buffer:bytebuffer-write-string buf (funcall +serialise-packet-fn+ (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) ) 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 Feb 21 01:38:56 2007 @@ -109,7 +109,7 @@ (fn (member (symbol-function (first rpc-call-list)) *remote-fns* ))) #+nio-debug (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)) + (eval rpc-call-list) (error 'authorization-error))) (reader-error (re) (format-log t "yarpc-state-machine:execute-call - reader error on call-string ~A ~%" re)))) From psmith at common-lisp.net Thu Feb 22 22:50:57 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Thu, 22 Feb 2007 17:50:57 -0500 (EST) Subject: [nio-cvs] r94 - in branches/home/psmith/restructure/src: compat io protocol/yarpc utils Message-ID: <20070222225057.55C552D165@common-lisp.net> Author: psmith Date: Thu Feb 22 17:50:56 2007 New Revision: 94 Added: branches/home/psmith/restructure/src/utils/concurrent-queue.lisp - copied, changed from r93, branches/home/psmith/restructure/src/compat/concurrent-queue.lisp Removed: branches/home/psmith/restructure/src/compat/concurrent-queue.lisp Modified: 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-server.lisp branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc.asd 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/utils/nio-utils-package.lisp branches/home/psmith/restructure/src/utils/nio-utils.asd branches/home/psmith/restructure/src/utils/utils.lisp Log: moved threadsafe queue and added more tests. 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 Feb 22 17:50:56 2007 @@ -30,7 +30,6 @@ ;; errno.lisp get-errno +ERRNO_EAGAIN+ perror - - ;;concurrent-queue - concurrent-queue add take + ;;threading + with-mutex make-mutex )) 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 Feb 22 17:50:56 2007 @@ -6,7 +6,7 @@ :components ((:file "nio-compat-package") (:file "errno" :depends-on ("nio-compat-package")) - (:file "concurrent-queue" :depends-on ("nio-compat-package")) + (:file "threading" :depends-on ("nio-compat-package")) ) :depends-on (:cffi)) 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 Feb 22 17:50:56 2007 @@ -34,7 +34,7 @@ t) ;TODO thread safety -(defparameter +connected-sockets-queue+ (nio-compat:concurrent-queue) +(defparameter +connected-sockets-queue+ (nio-utils:concurrent-queue) "List of node objects that are to be connected to") ;loop over hashtable @@ -155,7 +155,7 @@ ;add outgoing sockets to event queue #+nio-debug2 (format-log t "nio-server:start-server - Processing new connections queue ~A~%" +connected-sockets-queue+) - (loop for node = (nio-compat:take +connected-sockets-queue+ :blocking-call nil) until (null node) do + (loop for node = (nio-utils:take +connected-sockets-queue+ :blocking-call nil) until (null node) do #+nio-debug (format-log t "nio-server:start-server - adding node to nodes-list ~A~%" node) (push node *nodes-list*)) @@ -192,4 +192,4 @@ (format t "Connect failed!!~A ~%" (get-errno))))) (defun add-connection(node) - (nio-compat:add +connected-sockets-queue+ node)) \ No newline at end of file + (nio-utils:add +connected-sockets-queue+ node)) \ No newline at end of file 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 Thu Feb 22 17:50:56 2007 @@ -10,4 +10,4 @@ (:file "yarpc-client-state-machine" :depends-on ("yarpc-packet-factory")) ) - :depends-on (:nio :nio-sm :nio-compat)) \ No newline at end of file + :depends-on (:nio :nio-sm :nio-utils)) \ 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 Thu Feb 22 17:50:56 2007 @@ -33,7 +33,7 @@ ;; A client that accepts jobs to be run via a threadsafe queue and then submits them to the remote end for execution ;; (defclass yarpc-client-state-machine (state-machine) - ((job-queue :initform (nio-compat:concurrent-queue) + ((job-queue :initform (nio-utils:concurrent-queue) :accessor job-queue :documentation "The queue used to hand off work from an external thread to the io thread") (request-map :initform (make-hash-table) @@ -74,7 +74,7 @@ (defmethod process-outgoing-packet((sm yarpc-client-state-machine)) #+nio-debug (format-log t "yarpc-client-state-machine:process-outgoing-packet called, polling the job-queue ~%") - (let ((ttd (nio-compat:take (job-queue sm) :blocking-call nil))) + (let ((ttd (nio-utils:take (job-queue sm) :blocking-call nil))) (when ttd #+nio-debug (format-log t "yarpc-client-state-machine:process-outgoing-packet got job ~A ~%" ttd) (destructuring-bind (job call-string) ttd @@ -94,4 +94,4 @@ ;Execute the call-string on the remote node and call callback with the result (defmethod remote-execute ((sm yarpc-client-state-machine) call-string callback) #+nio-debug (format-log t "yarpc-client-state-machine:remote-execute called :sm ~A :call-string ~A :callback ~A~%" sm call-string callback) - (nio-compat:add (job-queue sm) (list (remote-job callback) call-string))) + (nio-utils:add (job-queue sm) (list (remote-job callback) call-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 Thu Feb 22 17:50:56 2007 @@ -34,11 +34,11 @@ ;; (defclass yarpc-state-machine (state-machine) ( - (result-queue :initform (nio-compat:concurrent-queue) + (result-queue :initform (nio-utils:concurrent-queue) :accessor result-queue :documentation "The queue used to return results from an external thread to the nio thread"))) -(defparameter job-queue (nio-compat:concurrent-queue) +(defparameter job-queue (nio-utils: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)) @@ -60,16 +60,16 @@ (defun run-job(&key (blocking t)) #+nio-debug (format-log t "yarpc-state-machine:run-job - Server toplevel waiting for job~%") - (let ((server-job (nio-compat:take nio-yarpc:job-queue :blocking-call blocking))) + (let ((server-job (nio-utils:take nio-yarpc:job-queue :blocking-call blocking))) (when server-job (destructuring-bind (job request-id result-queue) server-job #+nio-debug (format-log t "yarpc-state-machine:run-job - Server received job ~A~%" job) - (nio-compat:add result-queue (list request-id (nio-yarpc:execute-call job))))))) + (nio-utils:add result-queue (list request-id (nio-yarpc:execute-call job))))))) (defmethod process-outgoing-packet((sm yarpc-state-machine)) #+nio-debug2 (format-log t "yarpc-state-machine:process-outgoing-packet - called, polling the results-queue ~%" ) - (let ((server-job (nio-compat:take (result-queue sm) :blocking-call nil))) + (let ((server-job (nio-utils:take (result-queue sm) :blocking-call nil))) (when server-job (destructuring-bind (request-id result) server-job #+nio-debug (format-log t "yarpc-state-machine:process-outgoing-packet - got :request-id ~A result ~A ~%" request-id result) @@ -78,7 +78,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)) #+nio-debug (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) (request-id call) (result-queue sm))) + (nio-utils:add job-queue (list (call-string call) (request-id call) (result-queue sm))) (when +process-jobs-inline+ (run-job :blocking nil))) Copied: branches/home/psmith/restructure/src/utils/concurrent-queue.lisp (from r93, branches/home/psmith/restructure/src/compat/concurrent-queue.lisp) ============================================================================== --- branches/home/psmith/restructure/src/compat/concurrent-queue.lisp (original) +++ branches/home/psmith/restructure/src/utils/concurrent-queue.lisp Thu Feb 22 17:50:56 2007 @@ -25,16 +25,19 @@ 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))) ;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-queue-mutex :initform (sb-thread:make-mutex :name "buffer queue mutex") +; :reader buffer-queue-mutex) (buffer-lock :initform (sb-thread:make-mutex :name "buffer lock") :reader buffer-lock) (buffer :initform nil @@ -43,47 +46,80 @@ (defun concurrent-queue() (make-instance 'concurrent-queue)) + + (defmacro pop-elt(a-buffer loc) `(if ,a-buffer (let ((head (car ,a-buffer))) (setf ,a-buffer (cdr ,a-buffer)) -#+nio-debug (format t "concurent-queue:take - (~A) read ~A at ~A~%" sb-thread:*current-thread* head ,loc) +#+nio-debug (format-threadsafe t "concurent-queue:take - (~A,~A) read ~A at ~A~%" sb-thread:*current-thread* (length (buffer queue)) head ,loc) head) nil)) + ;Do an (optionally blocking) remove of the element at the head of this queue (defmethod take ((queue concurrent-queue) &key (blocking-call t)) +#+nio-debug (format-threadsafe t "concurent-queue:take - (~A) attempting to obtain mutex ~A~%" sb-thread:*current-thread* (buffer-lock queue)) (sb-thread:with-mutex ((buffer-lock queue)) +#+nio-debug (format-threadsafe t "concurent-queue:take - (~A) aquired mutex mutex ~A~%" sb-thread:*current-thread* (buffer-lock queue)) ;if its there, pop it (let ((ret (pop-elt (buffer queue) "1sttry"))) (if (or ret (not blocking-call)) ret (progn +#+nio-debug (format-threadsafe t "concurent-queue:take - (~A) about to wait on queue~%" sb-thread:*current-thread*) (sb-thread:condition-wait (buffer-queue queue) (buffer-lock queue)) +#+nio-debug (format-threadsafe t "concurent-queue:take - (~A) notified on queue~%" sb-thread:*current-thread*) (pop-elt (buffer queue) "2ndtry")))))) ;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) +#+nio-debug (format-threadsafe 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)))) - + (sb-thread:condition-broadcast (buffer-queue queue)))) (defun test-writer(queue) - (loop for i from 0 to 999 do - (sleep 0.1) + (loop for i from 0 to 100 do +; (sleep (random 0.1)) + (format-threadsafe t "Adding ~A~%" i) (add queue i))) -(defun test-reader(queue) +(defun test-reader(queue results) + (format-threadsafe t "Started reader ~A~%" sb-thread:*current-thread*) (loop - (format t "reader on ~A got elt ~A~%" - sb-thread:*current-thread* (take queue)))) + (let ((elt (take queue))) + (push elt results) + (format-threadsafe t "reader on ~A got elt ~A~%" + sb-thread:*current-thread* + results)))) + +(defparameter *results1* (list 999999)) +(defparameter *results2* (list 888888)) (defun test-queue() (let ((queue (make-instance 'concurrent-queue))) (sb-thread:make-thread #'(lambda()(test-writer queue))) - (sleep 10) +; (sleep 10) + (let ((t1 (sb-thread:make-thread #'(lambda()(test-reader queue *results1*))))) + ;(t2 (sb-thread:make-thread #'(lambda()(test-reader queue *results2*))))) + (sleep 5) ;;wait for it to probably complete + (format-threadsafe t "t1 got: ~A~%" *results1*) + (format-threadsafe t "t2 got: ~A~%" *results2*) + (sb-thread:destroy-thread t1) +; (sb-thread:destroy-thread t2) +) + (sb-thread:with-mutex ((buffer-lock queue)) + (assert (eql (length (buffer queue)) 0))))) + +(defun test-queue2() + (let ((queue (make-instance 'concurrent-queue))) + (sb-thread:make-thread #'(lambda()(test-reader queue))) + (sb-thread:make-thread #'(lambda()(test-writer queue))) (sb-thread:make-thread #'(lambda()(test-reader queue))) - (sb-thread:make-thread #'(lambda()(test-reader queue))))) + (sb-thread:make-thread #'(lambda()(test-writer queue))) + (sleep 10) + (format-threadsafe t "running asserts") + (sb-thread:with-mutex ((buffer-lock queue)) + (assert (eql (length (buffer queue)) 0))))) Modified: 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/utils/nio-utils-package.lisp Thu Feb 22 17:50:56 2007 @@ -30,4 +30,9 @@ ;;utils format-log get-universal-high-res get-readable-time + + ;;concurrent-queue + concurrent-queue add take + + )) Modified: branches/home/psmith/restructure/src/utils/nio-utils.asd ============================================================================== --- branches/home/psmith/restructure/src/utils/nio-utils.asd (original) +++ branches/home/psmith/restructure/src/utils/nio-utils.asd Thu Feb 22 17:50:56 2007 @@ -6,7 +6,8 @@ :components ((:file "nio-utils-package") (:file "utils" :depends-on ("nio-utils-package")) + (:file "concurrent-queue" :depends-on ("utils")) ) - :depends-on ()) + :depends-on (:nio-compat)) Modified: branches/home/psmith/restructure/src/utils/utils.lisp ============================================================================== --- branches/home/psmith/restructure/src/utils/utils.lisp (original) +++ branches/home/psmith/restructure/src/utils/utils.lisp Thu Feb 22 17:50:56 2007 @@ -59,6 +59,9 @@ ) +(defparameter *format-mutex* (nio-compat:make-mutex "format lock")) + ;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)) + `(nio-compat:with-mutex (*format-mutex*) + (format ,destination (concatenate 'string "~A - " ,control-string) (get-readable-high-res-time) , at format-arguments))) From psmith at common-lisp.net Fri Feb 23 00:18:58 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Thu, 22 Feb 2007 19:18:58 -0500 (EST) Subject: [nio-cvs] r95 - branches/home/psmith/restructure/src/utils Message-ID: <20070223001858.0F5FE5C0E2@common-lisp.net> Author: psmith Date: Thu Feb 22 19:18:57 2007 New Revision: 95 Modified: branches/home/psmith/restructure/src/utils/concurrent-queue.lisp Log: Fixed problem with NIL being read from queue and then waiting when we should have returned Modified: branches/home/psmith/restructure/src/utils/concurrent-queue.lisp ============================================================================== --- branches/home/psmith/restructure/src/utils/concurrent-queue.lisp (original) +++ branches/home/psmith/restructure/src/utils/concurrent-queue.lisp Thu Feb 22 19:18:57 2007 @@ -47,51 +47,42 @@ (make-instance 'concurrent-queue)) - -(defmacro pop-elt(a-buffer loc) - `(if ,a-buffer - (let ((head (car ,a-buffer))) - (setf ,a-buffer (cdr ,a-buffer)) -#+nio-debug (format-threadsafe t "concurent-queue:take - (~A,~A) read ~A at ~A~%" sb-thread:*current-thread* (length (buffer queue)) head ,loc) - head) - nil)) - - ;Do an (optionally blocking) remove of the element at the head of this queue (defmethod take ((queue concurrent-queue) &key (blocking-call t)) -#+nio-debug (format-threadsafe t "concurent-queue:take - (~A) attempting to obtain mutex ~A~%" sb-thread:*current-thread* (buffer-lock queue)) +#+nio-debug (format-log t "concurent-queue:take - (~A) attempting to obtain mutex ~A~%" sb-thread:*current-thread* (buffer-lock queue)) (sb-thread:with-mutex ((buffer-lock queue)) -#+nio-debug (format-threadsafe t "concurent-queue:take - (~A) aquired mutex mutex ~A~%" sb-thread:*current-thread* (buffer-lock queue)) +#+nio-debug (format-log t "concurent-queue:take - (~A) aquired mutex mutex ~A~%" sb-thread:*current-thread* (buffer-lock queue)) ;if its there, pop it - (let ((ret (pop-elt (buffer queue) "1sttry"))) - (if (or ret (not blocking-call)) - ret - (progn -#+nio-debug (format-threadsafe t "concurent-queue:take - (~A) about to wait on queue~%" sb-thread:*current-thread*) - (sb-thread:condition-wait (buffer-queue queue) (buffer-lock queue)) -#+nio-debug (format-threadsafe t "concurent-queue:take - (~A) notified on queue~%" sb-thread:*current-thread*) - (pop-elt (buffer queue) "2ndtry")))))) + (if (> (length (buffer queue)) 0) + (pop (buffer queue)) + (when blocking-call + (loop +#+nio-debug (format-log t "concurent-queue:take - (~A) about to wait on queue~%" sb-thread:*current-thread*) + (sb-thread:condition-wait (buffer-queue queue) (buffer-lock queue)) +#+nio-debug (format-log t "concurent-queue:take - (~A) notified on queue~%" sb-thread:*current-thread*) + (if (> (length (buffer queue)) 0) + (return-from take (pop (buffer queue))))))))) ;Append the element to the tail of this queue (defmethod add ((queue concurrent-queue) elt) -#+nio-debug (format-threadsafe t "concurent-queue:add - (~A) adding ~A~%" sb-thread:*current-thread* elt) +#+nio-debug (format-log 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-broadcast (buffer-queue queue)))) + (sb-thread:condition-notify (buffer-queue queue)))) (defun test-writer(queue) (loop for i from 0 to 100 do ; (sleep (random 0.1)) - (format-threadsafe t "Adding ~A~%" i) + (format-log t "Adding ~A~%" i) (add queue i))) (defun test-reader(queue results) - (format-threadsafe t "Started reader ~A~%" sb-thread:*current-thread*) + (format-log t "Started reader ~A~%" sb-thread:*current-thread*) (loop (let ((elt (take queue))) (push elt results) - (format-threadsafe t "reader on ~A got elt ~A~%" + (format-log t "reader on ~A got elt ~A~%" sb-thread:*current-thread* results)))) @@ -105,8 +96,8 @@ (let ((t1 (sb-thread:make-thread #'(lambda()(test-reader queue *results1*))))) ;(t2 (sb-thread:make-thread #'(lambda()(test-reader queue *results2*))))) (sleep 5) ;;wait for it to probably complete - (format-threadsafe t "t1 got: ~A~%" *results1*) - (format-threadsafe t "t2 got: ~A~%" *results2*) + (format-log t "t1 got: ~A~%" *results1*) + (format-log t "t2 got: ~A~%" *results2*) (sb-thread:destroy-thread t1) ; (sb-thread:destroy-thread t2) ) @@ -120,6 +111,6 @@ (sb-thread:make-thread #'(lambda()(test-reader queue))) (sb-thread:make-thread #'(lambda()(test-writer queue))) (sleep 10) - (format-threadsafe t "running asserts") + (format-log t "running asserts") (sb-thread:with-mutex ((buffer-lock queue)) (assert (eql (length (buffer queue)) 0))))) From psmith at common-lisp.net Fri Feb 23 16:58:30 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Fri, 23 Feb 2007 11:58:30 -0500 (EST) Subject: [nio-cvs] r96 - branches/home/psmith/restructure/src/compat Message-ID: <20070223165830.11B287C03B@common-lisp.net> Author: psmith Date: Fri Feb 23 11:58:29 2007 New Revision: 96 Added: branches/home/psmith/restructure/src/compat/threading.lisp Log: Added missing file Added: branches/home/psmith/restructure/src/compat/threading.lisp ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/src/compat/threading.lisp Fri Feb 23 11:58:29 2007 @@ -0,0 +1,40 @@ +#| +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) + + +(defun make-mutex (name) + (sb-thread:make-mutex :name name)) + +(defmacro with-mutex ((mutex) &body body) + `(sb-thread:with-mutex (,mutex) + , at body)) + + + + From psmith at common-lisp.net Sun Feb 25 17:59:03 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Sun, 25 Feb 2007 12:59:03 -0500 (EST) Subject: [nio-cvs] r97 - branches/home/psmith/restructure/src/io Message-ID: <20070225175903.3853E1A0A6@common-lisp.net> Author: psmith Date: Sun Feb 25 12:59:02 2007 New Revision: 97 Modified: branches/home/psmith/restructure/src/io/nio-package.lisp branches/home/psmith/restructure/src/io/nodes.lisp Log: Added nio util for parsing sockets into nodes 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 Feb 25 12:59:02 2007 @@ -44,5 +44,5 @@ check-ip load-ips ;;nodes - node with-connected-nodes active-conn + node with-connected-nodes active-conn node-from-socket-repn )) Modified: branches/home/psmith/restructure/src/io/nodes.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/nodes.lisp (original) +++ branches/home/psmith/restructure/src/io/nodes.lisp Sun Feb 25 12:59:02 2007 @@ -55,7 +55,7 @@ (defun node-from-socket-repn(socket) (let ((colon-idx (search ":" socket))) (if colon-idx - (node (subseq socket 0 colon-idx) (subseq socket (+ colon-idx 1))) + (node (subseq socket 0 colon-idx) (parse-integer (subseq socket (+ colon-idx 1)))) (error 'parse-error)))) From psmith at common-lisp.net Mon Feb 26 22:57:14 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Mon, 26 Feb 2007 17:57:14 -0500 (EST) Subject: [nio-cvs] r98 - branches/home/psmith/restructure/src/protocol/yarpc Message-ID: <20070226225714.CFD801901D@common-lisp.net> Author: psmith Date: Mon Feb 26 17:57:14 2007 New Revision: 98 Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp Log: Use +serialise-packaet-fn+ to calculate size of packet when resizing 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 Feb 26 17:57:14 2007 @@ -135,4 +135,4 @@ (defmethod get-packet-size ((packet method-response-packet)) (+ +yarpc-packet-header-size+ - (length (sb-ext:string-to-octets (write-to-string (response packet)))))) + (length (funcall +serialise-packet-fn+ (response packet))))) From psmith at common-lisp.net Mon Feb 26 23:13:58 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Mon, 26 Feb 2007 18:13:58 -0500 (EST) Subject: [nio-cvs] r99 - branches/home/psmith/restructure/src/protocol/yarpc Message-ID: <20070226231358.909F71E001@common-lisp.net> Author: psmith Date: Mon Feb 26 18:13:58 2007 New Revision: 99 Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp Log: Changed method-response-packet to write utf-8 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 Feb 26 18:13:58 2007 @@ -125,7 +125,7 @@ (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-32 buf (request-id packet)) - (nio-buffer:bytebuffer-write-string buf (funcall +serialise-packet-fn+ (response packet))) + (nio-buffer:bytebuffer-write-string buf (funcall +serialise-packet-fn+ (response packet)) :utf-8) (nio-buffer:bytebuffer-insert-32 buf (buffer-position buf) 1) #+nio-debug (format-log t "yarpc-packet-factory:write-bytes - written ~A~%" buf) ) @@ -135,4 +135,4 @@ (defmethod get-packet-size ((packet method-response-packet)) (+ +yarpc-packet-header-size+ - (length (funcall +serialise-packet-fn+ (response packet))))) + (length (sb-ext:string-to-octets (funcall +serialise-packet-fn+ (response packet)) :external-format :utf-8)))) From psmith at common-lisp.net Tue Feb 27 03:00:16 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Mon, 26 Feb 2007 22:00:16 -0500 (EST) Subject: [nio-cvs] r100 - in branches/home/psmith/restructure/src: buffer io protocol/yarpc statemachine Message-ID: <20070227030016.E5ECA140B7@common-lisp.net> Author: psmith Date: Mon Feb 26 22:00:16 2007 New Revision: 100 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/protocol/yarpc/yarpc-packet-factory.lisp branches/home/psmith/restructure/src/statemachine/state-machine.lisp Log: Fixed large packet problems: calculated header size correctly; use buffer-pointer to take into account buffer-position on write and moved external format to UTF-8 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 Mon Feb 26 22:00:16 2007 @@ -197,7 +197,7 @@ ; 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)) +(defmethod bytebuffer-read-string((bb byte-buffer) &optional (num-bytes-to-read (remaining bb)) (external-format :utf-8)) (sb-ext:octets-to-string (bytebuffer-read-vector bb num-bytes-to-read) :external-format external-format)) ; Read a byte from bytebuffer and return it incrementing the byte-buffers position @@ -246,7 +246,7 @@ ;; 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)) +(defmethod bytebuffer-write-string((bb byte-buffer) str &optional (external-format :utf-8)) :documentation "Returns number of bytes written to bytebuffer" (bytebuffer-write-vector bb (sb-ext:string-to-octets str :external-format external-format))) 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 Mon Feb 26 22:00:16 2007 @@ -31,6 +31,6 @@ 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 compact mark reset + flip unflip clear buffer-position buffer-limit copy-buffer buffer-capacity compact mark reset buffer-too-small-error recommended-size buffer-pointer )) 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 Feb 26 22:00:16 2007 @@ -106,6 +106,7 @@ (t ;;Update buffer position (inc-position foreign-read-buffer new-bytes) +#+nio-debug (format t "read-more : Updated buffer ~A~%" foreign-read-buffer) (when (> (remaining foreign-read-buffer) 0) (setf (read-ready state-machine) nil))))))) @@ -138,7 +139,7 @@ (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))) + (setf now-written (%write write-fd (buffer-pointer 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))) @@ -166,7 +167,7 @@ (defmacro realloc-buffer(async-fd accessor size) `(let ((buffer (,accessor ,async-fd))) - (if (>= (buffer-capacity buffer) size) + (if (>= (buffer-capacity buffer) ,size) t (let ((new-buffer (byte-buffer ,size))) (copy-buffer buffer new-buffer) @@ -181,7 +182,6 @@ (ecase mode (:read (realloc-buffer async-fd foreign-read-buffer size)) (:write (realloc-buffer async-fd foreign-write-buffer size))))) - (defun force-close-async-fd (async-fd) @@ -208,3 +208,12 @@ (defun async-fd-write-fd (async-fd) (slot-value async-fd 'write-fd)) + +(defun test-realloc() + (let* ((sm (create-state-machine 'async-fd 1 1 6)) + (pos-b4-resize (bytebuffer-write-string (foreign-read-buffer sm) "this string is OK"))) + (recommend-buffer-size sm :read 4096) + (assert (eql 4096 (buffer-capacity (foreign-read-buffer sm)))) + (assert (eql 4096 (nio-buffer:buffer-limit (foreign-read-buffer sm)))) + (assert (eql pos-b4-resize (nio-buffer:buffer-position (foreign-read-buffer sm)))))) + 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 Feb 26 22:00:16 2007 @@ -45,6 +45,8 @@ (defconstant +yarpc-packet-header-size+ (+ +PACKET-ID-SIZE+ +PACKET-LENGTH-SIZE+)) +(defconstant +yarpc-rpc-packet-header-size+ (+ +yarpc-packet-header-size+ +PACKET-REQUEST-ID-SIZE+)) + (defmethod get-packet ((pf yarpc-packet-factory) buf) (flip buf) (if (>= (remaining buf) +yarpc-packet-header-size+) ;; First byte denotes packet ID ;;bytes 2,3,4,5 denote packet size ;; 6,7,8,9 request-id @@ -92,7 +94,7 @@ (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-32 buf (request-id packet)) - (nio-buffer:bytebuffer-write-string buf (call-string packet)) + (nio-buffer:bytebuffer-write-string buf (call-string packet) :utf-8) (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) ) @@ -102,8 +104,8 @@ (defmethod get-packet-size ((packet call-method-packet)) - (+ +yarpc-packet-header-size+ - (length (sb-ext:string-to-octets (write-to-string (call-string packet)))))) + (+ +yarpc-rpc-packet-header-size+ + (length (sb-ext:string-to-octets (call-string packet) :external-format :utf-8)))) (defclass method-response-packet (yarpc-packet) ((response :initarg :response @@ -131,8 +133,9 @@ ) (buffer-too-small-error (err) (nio-buffer:reset buf) +#+nio-debug (format-log t "yarpc-packet-factory:write-bytes - buffer too small caught, reset to ~A~%" buf) (error err)))) (defmethod get-packet-size ((packet method-response-packet)) - (+ +yarpc-packet-header-size+ + (+ +yarpc-rpc-packet-header-size+ (length (sb-ext:string-to-octets (funcall +serialise-packet-fn+ (response packet)) :external-format :utf-8)))) 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 Mon Feb 26 22:00:16 2007 @@ -79,11 +79,13 @@ (handler-case (write-bytes outgoing-packet foreign-write-buffer) (buffer-too-small-error (write-error1) - (if (recommend-buffer-size sm :write (get-packet-size outgoing-packet)) + (let ((new-size (get-packet-size outgoing-packet))) + (format-log t "state-machine::process-write - write-error1 trying resize to ~A" new-size) + (if (recommend-buffer-size sm :write new-size) (handler-case (write-bytes outgoing-packet foreign-write-buffer) - (buffer-too-small-error (write-error1) (format t "Failed to write packet after resize (something already in write buffer?, dropping packet ~A~% out buffer:~%~A~%" outgoing-packet foreign-write-buffer))) - (format t "Failed to resize io buffer, dropping packet: ~A~%" outgoing-packet)))))))) + (buffer-too-small-error (write-error2) (format t "Failed to write packet after resize (something already in write buffer?, dropping packet ~A~% out buffer:~%~A~%" outgoing-packet foreign-write-buffer))) + (format t "Failed to resize io buffer, dropping packet: ~A~%" outgoing-packet))))))))) From psmith at common-lisp.net Wed Feb 28 03:42:29 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Tue, 27 Feb 2007 22:42:29 -0500 (EST) Subject: [nio-cvs] r101 - branches/home/psmith/restructure/src/protocol/yarpc Message-ID: <20070228034229.C63EB710D2@common-lisp.net> Author: psmith Date: Tue Feb 27 22:42:29 2007 New Revision: 101 Modified: branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp Log: Allow simulated remote calls for testing 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 Feb 27 22:42:29 2007 @@ -37,5 +37,5 @@ test-rpc test-rpc-list test-rpc-string execute-call defremote ;;yarpc-client-state-machine - yarpc-client-state-machine remote-execute + yarpc-client-state-machine remote-execute simulate-connection )) 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 Tue Feb 27 22:42:29 2007 @@ -91,7 +91,19 @@ (let ((remote-job (gethash request-id (request-map sm)))) (funcall (callback remote-job) result)))) +(defparameter *simulate-calls* nil) + ;Execute the call-string on the remote node and call callback with the result (defmethod remote-execute ((sm yarpc-client-state-machine) call-string callback) #+nio-debug (format-log t "yarpc-client-state-machine:remote-execute called :sm ~A :call-string ~A :callback ~A~%" sm call-string callback) - (nio-utils:add (job-queue sm) (list (remote-job callback) call-string))) + (if *simulate-calls* + (funcall callback (execute-call call-string)) + (nio-utils:add (job-queue sm) (list (remote-job callback) call-string)))) + + +(defun simulate-connection() + (setf *simulate-calls* t) + (let* ((node (nio:node "127.0.0.1" 9999))) + (setf (nio:active-conn node) (nio::create-state-machine 'yarpc-client-state-machine 1 1 6)) + (push node nio::*nodes-list*))) + From psmith at common-lisp.net Wed Feb 28 23:24:32 2007 From: psmith at common-lisp.net (psmith at common-lisp.net) Date: Wed, 28 Feb 2007 18:24:32 -0500 (EST) Subject: [nio-cvs] r102 - branches/home/psmith/restructure/src/io Message-ID: <20070228232432.5276E1B@common-lisp.net> Author: psmith Date: Wed Feb 28 18:24:31 2007 New Revision: 102 Modified: branches/home/psmith/restructure/src/io/nio-server.lisp Log: Set outgoing connections to be non-blocking 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 Feb 28 18:24:31 2007 @@ -166,6 +166,7 @@ (update-last-connect-attempt a-node) (when new-fd #+nio-debug (format-log t "nio-server:start-server - adding connection to nio thread ~A~%" new-fd) + (set-fd-nonblocking (async-fd-read-fd new-fd)) (setf (gethash (async-fd-read-fd new-fd) client-hash) new-fd) (setf (active-conn a-node) new-fd) (add-async-fd event-queue new-fd :read-write))))