X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=sockets.lisp;fp=sockets.lisp;h=259b7b0fc448fdb69b78f3fb9ad41e60bc62c2e6;hp=6af47d86c92ed7b6292c9f861001704425f7a661;hb=6e84de6e7bff9079d0b6ba62a3c85d2eb98f2eb4;hpb=5559333472a7a87c0df192897037926a75985c9b

diff --git a/sockets.lisp b/sockets.lisp
index 6af47d8..259b7b0 100644
--- a/sockets.lisp
+++ b/sockets.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg with excerpts from portableaserve
 ;;;; Date Started:  Jun 2003
 ;;;;
-;;;; $Id: sockets.lisp,v 1.3 2003/07/10 18:52:10 kevin Exp $
+;;;; $Id: sockets.lisp,v 1.4 2003/07/11 06:58:32 kevin Exp $
 ;;;; *************************************************************************
 
 (in-package #:kmrcl)
@@ -63,23 +63,26 @@ setsockopt SO_REUSEADDR if :reuse is not nil"
 
 
 (defun accept-tcp-connection (listener)
+  "Returns (VALUES stream socket)"
   #+allegro
-  (socket:accept-connection listener)
+  (let ((sock (socket:accept-connection listener)))
+    (values sock sock))
   #+clisp
-  (ext:socket-accept listener)
+  (let ((sock (ext:socket-accept listener)))
+    (value sock sock))
   #+cmu
   (progn
     (mp:process-wait-until-fd-usable listener :input)
-    (sys:make-fd-stream
-     (nth-value 0 (ext:accept-tcp-connection listener))
-     :input t :output t))
+    (let ((sock (nth-value 0 (ext:accept-tcp-connection listener))))
+      (values (sys:make-fd-stream sock :input t :output t) sock)))
   #+sbcl
   (when (sb-sys:wait-until-fd-usable
 	 (sb-bsd-sockets:socket-file-descriptor listener) :input)
-    (sb-bsd-sockets:socket-make-stream 
-     (sb-bsd-sockets:socket-accept listener)
-     :element-type 'base-char
-     :input t :output t))
+    (let ((sock (sb-bsd-sockets:socket-accept listener)))
+      (values
+       (sb-bsd-sockets:socket-make-stream
+	sock :element-type 'base-char :input t :output t)
+       sock)))
   #-(or allegro clisp cmu sbcl)
   (warn "accept-tcp-connection not supported on this implementation")
   )
@@ -151,19 +154,41 @@ setsockopt SO_REUSEADDR if :reuse is not nil"
 
 
 (defun make-active-socket (server port)
-  #+allegro (socket:make-socket :remote-host server
-				:remote-port port)
-  #+lispworks (comm:open-tcp-stream server port)
-  #+sbcl (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
-				      :type :stream
-				      :protocol :tcp)))
-	   (sb-bsd-sockets:socket-connect
-	    socket (lookup-hostname server) port)
-	   (sb-bsd-sockets:socket-make-stream socket
-					      :input t
-					      :output t
-					      :element-type 'base-char))
-  #+cmu 
-  (sys:make-fd-stream (ext:connect-to-inet-socket host port)
-		      :input t :output t :element-type 'base-char)
+  "Returns (VALUES STREAM SOCKET)"
+  #+allegro
+  (let ((sock (socket:make-socket :remote-host server
+				  :remote-port port)))
+    (values sock sock))
+  #+lispworks
+  (let ((sock (comm:open-tcp-stream server port)))
+    (values sock sock))
+  #+sbcl
+  (let ((sock (make-instance 'sb-bsd-sockets:inet-socket
+			     :type :stream
+			     :protocol :tcp)))
+    (sb-bsd-sockets:socket-connect sock (lookup-hostname server) port)
+    (values
+     (sb-bsd-sockets:socket-make-stream
+      sock :input t :output t :element-type 'base-char)
+     sock))
+  #+cmu
+  (let ((sock (ext:connect-to-inet-socket host port)))
+    (values
+     (sys:make-fd-stream sock :input t :output t :element-type 'base-char)
+     sock))
+  )
+
+(defun ipaddr-array-to-dotted (array)
+  (format nil "~{~D~^.~}" (coerce array 'list))
+  #+ignore
+  (format nil "~D.~D.~D.~D" 
+	  (aref 0 array) (aref 1 array) (aref 2 array) (array 3 array)))
+
+(defun remote-host (socket)
+  #+allegro (socket:ipaddr-to-dotted (socket:remote-host socket))
+  #+lispworks (nth-value 0 (comm:get-socket-peer-address socket))
+  #+sbcl (ipaddr-array-to-dotted 
+	  (nth-value 0 (sb-bsd-sockets:socket-peername socket)))
+  #+cmu (nth-value 0 (ext:get-peer-host-and-port socket))
   )
+