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

[nio-cvs] r115 - branches/home/psmith/restructure/src/io
by psmith＠common-lisp.net 27 Apr '07

27 Apr '07

Author: psmith Date: Fri Apr 27 18:39:46 2007 New Revision: 115 Modified: branches/home/psmith/restructure/src/io/nio-package.lisp Log: export connected-nodes-count 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 Fri Apr 27 18:39:46 2007 @@ -44,5 +44,5 @@ check-ip load-ips allow-ips ;;nodes - node with-connected-nodes active-conn node-from-socket-repn remote-host remote-port + node with-connected-nodes active-conn node-from-socket-repn remote-host remote-port connected-nodes-count ))

1 0

[nio-cvs] r114 - branches/home/psmith/restructure/src/io
by psmith＠common-lisp.net 27 Apr '07

27 Apr '07

Author: psmith Date: Fri Apr 27 14:44:47 2007 New Revision: 114 Modified: branches/home/psmith/restructure/src/io/nodes.lisp Log: Added connected nodes count io/nio-package.lisp 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 Fri Apr 27 14:44:47 2007 @@ -98,3 +98,10 @@ (defmacro with-connected-nodes ((node) &rest body) `(dolist (,node *nodes-list*) (when (active-conn ,node) ,@body))) + +(defun connected-nodes-count() + (let ((count 0)) + (with-connected-nodes (node) + (incf count)) + count)) + \ No newline at end of file

1 0

[nio-cvs] r113 - branches/home/psmith/restructure/src/io
by psmith＠common-lisp.net 26 Apr '07

26 Apr '07

Author: psmith Date: Thu Apr 26 18:33:49 2007 New Revision: 113 Modified: branches/home/psmith/restructure/src/io/ip-authorisation.lisp branches/home/psmith/restructure/src/io/nio-package.lisp Log: Added allow-ips to ip-authorisation Modified: branches/home/psmith/restructure/src/io/ip-authorisation.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/ip-authorisation.lisp (original) +++ branches/home/psmith/restructure/src/io/ip-authorisation.lisp Thu Apr 26 18:33:49 2007 @@ -35,8 +35,18 @@ (setf +ip-list+ (read stream))) (format t "Loaded allowed ips:~A~% " +ip-list+)) +;(allow-ips '("127.0.0.1")) +(defun allow-ips (ip-list) + "Add each ip in the allow ips list to our list" + (dolist (item ip-list) + (when (not (check-ip-str item)) (push item +ip-list+)))) + + +(defun check-ip-str(ip-string) + (member ip-string +ip-list+ :test 'string-equal)) + (defun check-ip (async-fd) (with-slots (remote-host) (socket async-fd) (let ((str-rep (format nil "~{~a~^.~}" (reverse remote-host)))) (format t "ip-authorisation:check-ip ~A ~A~%" str-rep +ip-list+) - (member str-rep +ip-list+ :test 'string-equal)))) \ No newline at end of file + (check-ip-str str-rep)))) 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 Thu Apr 26 18:33:49 2007 @@ -41,7 +41,7 @@ packet write-bytes get-packet-size ;;ip-authorisation - check-ip load-ips + check-ip load-ips allow-ips ;;nodes node with-connected-nodes active-conn node-from-socket-repn remote-host remote-port

1 0

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

26 Apr '07

Author: psmith Date: Thu Apr 26 16:43:14 2007 New Revision: 112 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 configurable timeout Modified: branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp Thu Apr 26 16:43:14 2007 @@ -37,5 +37,5 @@ test-rpc test-rpc-list test-rpc-string execute-call defremote process-timeout ;;yarpc-client-state-machine - yarpc-client-state-machine remote-execute simulate-connection + yarpc-client-state-machine remote-execute simulate-connection +rpc-timeout+ )) 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 Apr 26 16:43:14 2007 @@ -48,11 +48,13 @@ :reader start-time :documentation "The (floating point) start time") (timeout :initarg :timeout - :initform 15 :reader timeout :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 &key (timeout 15)) +(defparameter +rpc-timeout+ 60 + "The number of seconds before a remote call is considered timedout") + +(defun remote-job(callback &key (timeout +rpc-timeout+)) (make-instance 'remote-job :callback callback :timeout timeout))

1 0

[nio-cvs] r111 - branches/home/psmith/restructure/src/io
by psmith＠common-lisp.net 26 Apr '07

26 Apr '07

Author: psmith Date: Thu Apr 26 16:34:42 2007 New Revision: 111 Modified: branches/home/psmith/restructure/src/io/ip-authorisation.lisp Log: log allowed ips Modified: branches/home/psmith/restructure/src/io/ip-authorisation.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/ip-authorisation.lisp (original) +++ branches/home/psmith/restructure/src/io/ip-authorisation.lisp Thu Apr 26 16:34:42 2007 @@ -32,7 +32,8 @@ (defun load-ips (filename) (with-open-file (stream filename) - (setf +ip-list+ (read stream)))) + (setf +ip-list+ (read stream))) + (format t "Loaded allowed ips:~A~% " +ip-list+)) (defun check-ip (async-fd) (with-slots (remote-host) (socket async-fd)

1 0

[nio-cvs] r110 - branches/home/psmith/restructure/src/io
by psmith＠common-lisp.net 23 Apr '07

23 Apr '07

Author: psmith Date: Mon Apr 23 23:44:31 2007 New Revision: 110 Modified: branches/home/psmith/restructure/src/io/nio-package.lisp Log: export remote-host remote-port 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 Apr 23 23:44:31 2007 @@ -44,5 +44,5 @@ check-ip load-ips ;;nodes - node with-connected-nodes active-conn node-from-socket-repn + node with-connected-nodes active-conn node-from-socket-repn remote-host remote-port ))

1 0

[nio-cvs] r109 - in branches/home/psmith/restructure/src: io nio-logger protocol/yarpc
by psmith＠common-lisp.net 16 Apr '07

16 Apr '07

Author: psmith Date: Tue Apr 17 00:26:29 2007 New Revision: 109 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.lisp branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Log: Remove +process-jobs-inline+ as can't work like this. Added timeout mechanism Modified: branches/home/psmith/restructure/src/io/async-fd.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/async-fd.lisp (original) +++ branches/home/psmith/restructure/src/io/async-fd.lisp Tue Apr 17 00:26:29 2007 @@ -62,6 +62,9 @@ ;;Implement this in concrete SM for read (defgeneric process-write (async-fd)) +;;Implement this in concrete SM for timeout processing +(defgeneric process-timeout (async-fd)) + ;;SM factory (defun create-state-machine(sm-type read-fd write-fd socket) (let ((sm (make-instance sm-type :read-fd read-fd :write-fd write-fd :socket socket))) 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 Tue Apr 17 00:26:29 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 close-pending + recommend-buffer-size close-pending process-timeout ;; 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 Tue Apr 17 00:26:29 2007 @@ -46,6 +46,7 @@ ;process reads (handler-case (progn + (process-timeout async-fd) (when (read-ready async-fd) (read-more async-fd)) (when (> (buffer-position (foreign-read-buffer async-fd)) 0) (process-read async-fd)) @@ -63,7 +64,8 @@ (write-more async-fd) (push async-fd removals))) (read-error (re) (push async-fd removals)) - (write-error (we) (push async-fd removals)))) + (write-error (we) (push async-fd removals)) + (timeout (to) (push async-fd removals)))) client-hash) (dolist (async-fd removals) (format-log t "nio-server:process-async-fds processing remove for ~a~%" async-fd) 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 Apr 17 00:26:29 2007 @@ -63,7 +63,6 @@ (defparameter +log-file-name+ "./out") (defun run-logging-server(listen-ip out-file &optional (allowed-ips "ips.txt")) - (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 :port 16323 :accept-connection 'nio:check-ip)) :name "nio-server") 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 Apr 17 00:26:29 2007 @@ -32,9 +32,9 @@ yarpc-state-machine-factory get-packet-factory ;; yarpc-state-machine - yarpc-state-machine job-queue run-job +process-jobs-inline+ +serialise-packet-fn+ + yarpc-state-machine job-queue run-job +process-jobs-inline+ +serialise-packet-fn+ process-timeout ;to be moved - test-rpc test-rpc-list test-rpc-string execute-call defremote + test-rpc test-rpc-list test-rpc-string execute-call defremote process-timeout ;;yarpc-client-state-machine 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 Apr 17 00:26:29 2007 @@ -48,11 +48,12 @@ :reader start-time :documentation "The (floating point) start time") (timeout :initarg :timeout - :initform 1.5 + :initform 15 + :reader timeout :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 remote-job(callback &key (timeout 15)) + (make-instance 'remote-job :callback callback :timeout timeout)) (defun yarpc-client-state-machine () @@ -67,11 +68,37 @@ (defmethod print-object ((sm yarpc-client-state-machine) stream) (format stream "#<YARPC-CLIENT-STATE-MACHINE ~A >" (call-next-method sm nil))) +(defmethod print-object ((job remote-job) stream) + (format stream "#<REMOTE-JOB :start-time ~A :timeout ~A>" (start-time job) (timeout job))) + + (defconstant STATE-INITIALISED 0) (defconstant STATE-SENT-REQUEST 1) (defparameter +request-id+ 0) + +(defun check-timeouts(id job) +; (format-log t "Checking timeout on ~A~%" job) + (when (> (get-universal-high-res) (+ (start-time job) (timeout job))) + (format-log t "Timeout detected ~A ~A~%" id job) + t)) + +(defun finish-job (request-id sm result) + "Remove the job from the request map and call the callback with the result" + (let ((remote-job (gethash request-id (request-map sm)))) + (when remote-job + (remhash request-id (request-map sm)) + (funcall (callback remote-job) result)))) + +(defmethod process-timeout((sm yarpc-client-state-machine)) + (let ((requests (request-map sm))) +#+nio-debug (format-log t "yarpc-client-state-machine:process-outgoing-packet called, searching for timeouts in ~A ~%" requests) + (maphash #'(lambda (id job) + (when (check-timeouts id job) (finish-job id sm nil))) + requests))) + + (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-utils:take (job-queue sm) :blocking-call nil))) @@ -88,8 +115,7 @@ (request-id (request-id response))) #+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)))) + (finish-job request-id sm result))) (defparameter *simulate-calls* nil) @@ -107,3 +133,14 @@ (setf (nio:active-conn node) (nio::create-state-machine 'yarpc-client-state-machine 1 1 6)) (push node nio::*nodes-list*))) + + +(defun test-timeout() + (let* ((done nil) + (job (remote-job #'(lambda(x) (format-log t "~A finished~%" x) (setf done t)) :timeout 30))) + (format-log t "Job: ~A~%" job) + (loop while (not done) do + (check-timeouts 99 job) + (format-log t ".~%") + (sleep 1)) + (format-log t "done test~%"))) \ No newline at end of file Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Tue Apr 17 00:26:29 2007 @@ -52,12 +52,6 @@ (defconstant STATE-INITIALISED 0) (defconstant STATE-SEND-RESPONSE 1) - -(defparameter +process-jobs-inline+ t - "Set this to make the NIO thread process the RPC calls - warning the procedure should not block!") - - - (defun run-job(&key (blocking t)) #+nio-debug (format-log t "yarpc-state-machine:run-job - Server toplevel waiting for job~%") (let ((server-job (nio-utils:take nio-yarpc:job-queue :blocking-call blocking))) @@ -66,6 +60,7 @@ #+nio-debug (format-log t "yarpc-state-machine:run-job - Server received job ~A~%" job) (nio-utils:add result-queue (list request-id (nio-yarpc:execute-call job))))))) +(defmethod process-timeout((sm yarpc-state-machine))) (defmethod process-outgoing-packet((sm yarpc-state-machine)) #+nio-debug2 (format-log t "yarpc-state-machine:process-outgoing-packet - called, polling the results-queue ~%" ) @@ -78,8 +73,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-utils:add job-queue (list (call-string call) (request-id call) (result-queue sm))) - (when +process-jobs-inline+ (run-job :blocking nil))) + (nio-utils:add job-queue (list (call-string call) (request-id call) (result-queue sm))))

1 0

[nio-cvs] r108 - branches/home/psmith/restructure/src/event
by psmith＠common-lisp.net 16 Apr '07

16 Apr '07

Author: psmith Date: Tue Apr 17 00:22:56 2007 New Revision: 108 Modified: branches/home/psmith/restructure/src/event/epoll.lisp Log: Print out interruptions 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 Apr 17 00:22:56 2007 @@ -89,7 +89,9 @@ (-1 (let ((errno (get-errno))) (if (eql errno 4) ;EINTR - interrupted by a system call - (return nil) + (progn + (format t "epoll-wait interrupted~%") + (return nil)) (progn (format t "-1 returned from epoll-wait, errno:") (perror)

1 0

[nio-cvs] r107 - branches/home/psmith/restructure/src/io
by psmith＠common-lisp.net 18 Mar '07

18 Mar '07

Author: psmith Date: Sun Mar 18 19:27:10 2007 New Revision: 107 Modified: branches/home/psmith/restructure/src/io/async-fd.lisp Log: up max 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 Sun Mar 18 19:27:10 2007 @@ -168,7 +168,7 @@ (when close-pending (close-async-fd async-fd))))) -(defconstant +MAX-BUFFER-SIZE-BYTES+ (* 1024 1024)) +(defconstant +MAX-BUFFER-SIZE-BYTES+ (* 1024 1024 15)) (defmacro realloc-buffer(async-fd accessor size) `(let ((buffer (,accessor ,async-fd)))

1 0

[nio-cvs] r106 - branches/home/psmith/restructure/src/io
by psmith＠common-lisp.net 17 Mar '07

17 Mar '07

Author: psmith Date: Sat Mar 17 20:07:13 2007 New Revision: 106 Modified: branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/nio-server.lisp Log: Corrected return from connect and utilised write eagain in async-fd 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 Mar 17 20:07:13 2007 @@ -129,7 +129,9 @@ ((error-number :initarg :error))) (defun write-more (async-fd) - "Write data from ASYNC-FD's write bytebuffer" + "Write data from ASYNC-FD's foreign-write-buffer to the network \ + Leaves foreign-write-buffer in state ready to be written to \ + Sets write-ready appropriatly" #+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) @@ -143,21 +145,24 @@ (when (not (eql now-written -1)) (inc-position foreign-write-buffer now-written) (incf total-written now-written))) -#+nio-debug (format t "async-fd:write-more - after write :foreign-write-buffer ~A :now-written ~A :total-written ~A ~%" foreign-write-buffer now-written total-written)) - (if (eql now-written -1) +#+nio-debug (format t "async-fd:write-more - after write :foreign-write-buffer ~A :now-written ~A :total-written ~A ~%" foreign-write-buffer now-written total-written) + ) + + (when (eql now-written -1) ;;Deal with failure (let ((err (get-errno))) - (format t "write-more - write returned -1 :errno ~A~%" err) - (unless (eql err 11) ;; eagain - failed to write whole buffer need to wait for next notify - (perror) - (let ((err-cond (make-instance 'write-error :error err))) - (close-fd (write-fd async-fd)); - deal with in nio-server? - (error err-cond)))) - ;;update buffers - (if (eql (remaining foreign-write-buffer) 0) - (clear foreign-write-buffer) - (error 'not-implemented-yet)))) - +#+nio-debug (format t "write-more - write returned -1 :errno ~A~%" err) + (if (eql err 11) ;; eagain - failed to write whole buffer need to wait for next notify + (setf (write-ready async-fd) nil) + (progn + (perror) + (let ((err-cond (make-instance 'write-error :error err))) + (close-fd (write-fd async-fd)); - deal with in nio-server? + (error err-cond)))))) + ;;update buffers + (if (eql (remaining foreign-write-buffer) 0) + (clear foreign-write-buffer) + (compact foreign-write-buffer))) #+nio-debug (format t "write buffer after write :~A~%" foreign-write-buffer) (when (eql (buffer-position foreign-write-buffer) 0) (when close-pending (close-async-fd async-fd))))) 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 Mar 17 20:07:13 2007 @@ -50,10 +50,14 @@ (when (> (buffer-position (foreign-read-buffer async-fd)) 0) (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)) + (loop + (when (and (write-ready async-fd) (> (buffer-position (foreign-write-buffer async-fd)) 0)) + (write-more async-fd)) + (when (write-ready async-fd) + (assert (eql (buffer-position (foreign-write-buffer async-fd)) 0)) + (process-write async-fd)) + (unless (and (write-ready async-fd) (> (buffer-position (foreign-write-buffer async-fd)) 0)) (return))) + ;process normal close (when (close-pending async-fd) (write-more async-fd) @@ -192,7 +196,8 @@ (return-from connect sm)) (progn (format t "Connect failed!!~A ~%" (get-errno)) - (close-fd sock))))) + (close-fd sock) + nil)))) (defun add-connection(node) (nio-utils:add +connected-sockets-queue+ node)) \ No newline at end of file

1 0