[usocket-cvs] r513 - usocket/trunk/backend

[Chun Tian (binghe)]

Author: ctian
Date: Tue Jan  5 20:23:50 2010
New Revision: 513

Log:
Include MCL Issue 28.

Modified:
   usocket/trunk/backend/mcl.lisp

Modified: usocket/trunk/backend/mcl.lisp
==============================================================================
--- usocket/trunk/backend/mcl.lisp	(original)
+++ usocket/trunk/backend/mcl.lisp	Tue Jan  5 20:23:50 2010
@@ -6,35 +6,45 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (require :opentransport))
 
+;; MCL Issue 28: Passive TCP streams should be able to listen to the loopback interface
+;; see http://code.google.com/p/mcl/issues/detail?id=28 for details
+
+(defparameter *passive-interface-address* NIL
+  "Address to use for passive connections - optionally bind to loopback address while opening a tcp stream")
+
+(advise local-interface-ip-address
+  (or *passive-interface-address* (:do-it))
+  :when :around :name 'override-local-interface-ip-address)
+
 ;; MCL Issue 29: Passive TCP connections on OS assigned ports
 ;; see http://code.google.com/p/mcl/issues/detail?id=29 for details
-(ccl:advise ot-conn-tcp-passive-connect
-            (destructuring-bind (conn port &optional (allow-reuse t)) arglist
-              (declare (ignore allow-reuse))
-              (if (eql port #$kOTAnyInetAddress)
-		;; Avoids registering a proxy for port 0 but instead registers one for the true port:
-		(multiple-value-bind (proxy result)
-		    (let* ((*opentransport-class-proxies* NIL) ; makes ot-find-proxy return NIL
-			   (result (:do-it)) ;; pushes onto *opentransport-class-proxies*
-			   (proxy (prog1
-				      (pop *opentransport-class-proxies*)
-				    (assert (not *opentransport-class-proxies*))))
-			   (context (cdr proxy))
-			   (tmpconn (make-ot-conn :context context 
-						  :endpoint (pref context :ot-context.ref)))
-			   (localaddress (ot-conn-tcp-get-addresses tmpconn)))
-		      (declare (dynamic-extent tmpconn))
-		      ;; replace original set in body of function
-		      (setf (ot-conn-local-address conn) localaddress)
-		      (values
-		       (cons localaddress context)
-		       result))
-                  ;; need to be outside local binding of *opentransport-class-proxies* 
-                  (without-interrupts
-		      (push proxy *opentransport-class-proxies*))
-                  result)
-                (:do-it)))
-         :when :around :name 'ot-conn-tcp-passive-connect-any-address)
+(advise ot-conn-tcp-passive-connect
+  (destructuring-bind (conn port &optional (allow-reuse t)) arglist
+    (declare (ignore allow-reuse))
+    (if (eql port #$kOTAnyInetAddress)
+	;; Avoids registering a proxy for port 0 but instead registers one for the true port:
+	(multiple-value-bind (proxy result)
+	    (let* ((*opentransport-class-proxies* NIL) ; makes ot-find-proxy return NIL
+		   (result (:do-it)) ;; pushes onto *opentransport-class-proxies*
+		   (proxy (prog1
+			      (pop *opentransport-class-proxies*)
+			    (assert (not *opentransport-class-proxies*))))
+		   (context (cdr proxy))
+		   (tmpconn (make-ot-conn :context context 
+					  :endpoint (pref context :ot-context.ref)))
+		   (localaddress (ot-conn-tcp-get-addresses tmpconn)))
+	      (declare (dynamic-extent tmpconn))
+	      ;; replace original set in body of function
+	      (setf (ot-conn-local-address conn) localaddress)
+	      (values
+	       (cons localaddress context)
+	       result))
+	  ;; need to be outside local binding of *opentransport-class-proxies* 
+	  (without-interrupts
+	      (push proxy *opentransport-class-proxies*))
+	  result)
+	(:do-it)))
+  :when :around :name 'ot-conn-tcp-passive-connect-any-address)
 
 (in-package :usocket)