X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=sockets.lisp;h=f105501777be5e122c3cdf012c5c44ff6ca0b1e9;hp=6af47d86c92ed7b6292c9f861001704425f7a661;hb=ea921dd2ce51a46bb3ca92a07df095d5ace99dcf;hpb=9c61ca103ddac473a3f91ac5baedd45335c369e3 diff --git a/sockets.lisp b/sockets.lisp index 6af47d8..f105501 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$ ;;;; ************************************************************************* (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 @@ -46,7 +46,10 @@ setsockopt SO_REUSEADDR if :reuse is not nil" #+sbcl (listen-to-inet-port :port port :reuse reuse-address) #+clisp (ext:socket-server port) - #-(or allegro clisp cmu sbcl) + #+openmcl + (ccl:make-socket :connect :passive :local-port port + :reuse-address reuse-address) + #-(or allegro clisp cmu sbcl openmcl) (warn "create-inet-listener not supported on this implementation") ) @@ -63,24 +66,30 @@ 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))) + (values 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)) - #-(or allegro clisp cmu sbcl) + (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))) + #+openmcl + (let ((sock (ccl:accept-connection listener :wait t))) + (values sock sock)) + #-(or allegro clisp cmu sbcl openmcl) (warn "accept-tcp-connection not supported on this implementation") ) @@ -99,7 +108,8 @@ setsockopt SO_REUSEADDR if :reuse is not nil" #+cmu (unix:unix-close socket) #+sbcl (sb-unix:unix-close (sb-bsd-sockets:socket-file-descriptor socket)) - #-(or allegro clisp cmu sbcl) + #+openmcl (close socket) + #-(or allegro clisp cmu sbcl openmcl) (warn "close-passive-socket not supported on this implementation") ) @@ -107,7 +117,6 @@ setsockopt SO_REUSEADDR if :reuse is not nil" (defun close-active-socket (socket) (close socket)) -#+sbcl (defun ipaddr-to-dotted (ipaddr &key values) "Convert from 32-bit integer to dotted string." (declare (type (unsigned-byte 32) ipaddr)) @@ -119,18 +128,17 @@ setsockopt SO_REUSEADDR if :reuse is not nil" (values a b c d) (format nil "~d.~d.~d.~d" a b c d)))) -#+sbcl (defun dotted-to-ipaddr (dotted &key (errorp t)) "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 +159,45 @@ 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 server port))) + (values + (sys:make-fd-stream sock :input t :output t :element-type 'base-char) + sock)) + #+openmcl + (let ((sock (ccl:make-socket :remote-host server :remote-port port ))) + (values sock 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)) + #+openmcl (ccl:remote-host socket) ) +