[isidorus-cvs] r700 - trunk/playground

[lgiessmann at common-lisp.net]

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