r7061: initial property settings

[kmrcl.git] / sockets.lisp

diff --git a/sockets.lisp b/sockets.lisp
index 6af47d86c92ed7b6292c9f861001704425f7a661..1f1f3734f4614c289dba17029fa11601e61da072 100644 (file)
--- 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$
 ;;;; *************************************************************************
 
 (in-package #:kmrcl)
@@ -35,7 +35,7 @@ setsockopt SO_REUSEADDR if :reuse is not nil"
 (defun create-inet-listener (port &key (format :text) (reuse-address t))
   #+cmu (ext:create-inet-listener port)
   #+allegro
-  (socket:make-socket :connect :passive :local-port port :format :binary
+  (socket:make-socket :connect :passive :local-port port :format format
                      :address-family 
                      (if (stringp port)
                          :file
@@ -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")
   )
@@ -124,13 +127,13 @@ setsockopt SO_REUSEADDR if :reuse is not nil"
   "Convert from dotted string to 32-bit integer."
   (declare (string dotted))
   (if errorp
-      (let ((ll (string-tokens (substitute #\Space #\. dotted))))
+      (let ((ll (delimited-string-to-list dotted #\.)))
        (+ (ash (first ll) 24) (ash (second ll) 16)
           (ash (third ll) 8) (fourth ll)))
     (ignore-errors
-       (let ((ll (string-tokens (substitute #\Space #\. dotted))))
-         (+ (ash (first ll) 24) (ash (second ll) 16)
-            (ash (third ll) 8) (fourth ll))))))
+      (let ((ll (delimited-string-to-list dotted #\.)))
+       (+ (ash (first ll) 24) (ash (second ll) 16)
+          (ash (third ll) 8) (fourth ll))))))
 
 #+sbcl
 (defun ipaddr-to-hostname (ipaddr &key ignore-cache)
@@ -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))
   )
+