Author: lgiessmann Date: Mon Aug 1 07:56:39 2011 New Revision: 700 Log: trunk: playground: added a client-acceptor function that accepts new client connections and starts a thread for each client Modified: trunk/playground/tcp-connector.lisp Modified: trunk/playground/tcp-connector.lisp ============================================================================== --- trunk/playground/tcp-connector.lisp Mon Aug 1 06:57:28 2011 (r699) +++ trunk/playground/tcp-connector.lisp Mon Aug 1 07:56:39 2011 (r700) @@ -9,6 +9,9 @@ ;; source: http://mihai.bazon.net/blog/howto-multi-threaded-tcp-server-in-common-lisp +(asdf:operate 'asdf:load-op :usocket) +(asdf:operate 'asdf:load-op :bordeaux-threads) + (defun make-server (&key (hostname "localhost") (port 8000)) (declare (string hostname) (number port)) @@ -68,3 +71,42 @@ (usocket:socket-close client-socket)) +(defun task (client-socket mega-loops name) + (declare (String name) + (integer mega-loops) + (usocket:stream-usocket client-socket)) + (let ((loops (* 1000000 mega-loops))) + (dotimes (counter loops) + (/ (* loops loops) loops)) + (read-from-client client-socket) ;ignore cient data + (send-to-client client-socket (format nil "~a finished ~a loops" name loops)))) + + +(defvar *stop-listen* nil "if tis variable is set to t, te listener stops to listen after the next client is accepted") + + +(defun stop-listen-for-clients () + (setf *stop-listen* t)) + + +(defun listen-for-clients (server) + (declare (usocket:stream-server-usocket server)) + (setf *stop-listen* nil) + (sb-thread:make-thread + (lambda() + (funcall (lambda(srv) + (do ((stop-p *stop-listen*) (counter 0)) ((not (null stop-p))) + (let ((client (wait-for-client srv))) + (format t "client # ~a connected~%" counter) + (sb-thread:make-thread + (lambda() + (funcall (lambda(client-socket thread-name) + (declare (usocket:stream-usocket client-socket) + (String thread-name)) + (read-from-client client-socket) ;ignore client data + (send-to-client client-socket thread-name)) + client (format nil "thread-~a" counter))) + :name (format nil "worker-thread: ~a" counter))) + (incf counter) + (setf stop-p *stop-listen*))) + server))))