X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=sockets.lisp;h=a75d77dfe38953b56aa35a34aa10c21b7c5ba917;hp=41c751ccd496ad8934baa72ad3aa8721328af558;hb=54cd6cb1b9550ac2310e2c6dffc9cdecd2bdccd3;hpb=4b512145081c369cb1dbfe579a4dfd5a32476b92 diff --git a/sockets.lisp b/sockets.lisp index 41c751c..a75d77d 100644 --- a/sockets.lisp +++ b/sockets.lisp @@ -1,4 +1,4 @@ -;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*- +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; @@ -6,8 +6,6 @@ ;;;; Purpose: Socket functions ;;;; Programmer: Kevin M. Rosenberg with excerpts from portableaserve ;;;; Date Started: Jun 2003 -;;;; -;;;; $Id$ ;;;; ************************************************************************* (in-package #:kmrcl) @@ -22,9 +20,10 @@ (defun listen-to-inet-port (&key (port 0) (kind :stream) (reuse nil)) "Create, bind and listen to an inet socket on *:PORT. setsockopt SO_REUSEADDR if :reuse is not nil" + (declare (ignore kind)) (let ((socket (make-instance 'sb-bsd-sockets:inet-socket - :type :stream - :protocol :tcp))) + :type :stream + :protocol :tcp))) (if reuse (setf (sb-bsd-sockets:sockopt-reuse-address socket) t)) (sb-bsd-sockets:socket-bind @@ -37,13 +36,13 @@ setsockopt SO_REUSEADDR if :reuse is not nil" #+cmu (ext:create-inet-listener port) #+allegro (socket:make-socket :connect :passive :local-port port :format format - :address-family - (if (stringp port) - :file - (if (or (null port) (integerp port)) - :internet - (error "illegal value for port: ~s" port))) - :reuse-address reuse-address) + :address-family + (if (stringp port) + :file + (if (or (null port) (integerp port)) + :internet + (error "illegal value for port: ~s" port))) + :reuse-address reuse-address) #+sbcl (declare (ignore format)) #+sbcl (listen-to-inet-port :port port :reuse reuse-address) #+clisp (declare (ignore format reuse-address)) @@ -52,7 +51,7 @@ setsockopt SO_REUSEADDR if :reuse is not nil" (declare (ignore format)) #+openmcl (ccl:make-socket :connect :passive :local-port port - :reuse-address reuse-address) + :reuse-address reuse-address) #-(or allegro clisp cmu sbcl openmcl) (warn "create-inet-listener not supported on this implementation") ) @@ -60,10 +59,10 @@ setsockopt SO_REUSEADDR if :reuse is not nil" (defun make-fd-stream (socket &key input output element-type) #+cmu (sys:make-fd-stream socket :input input :output output - :element-type element-type) + :element-type element-type) #+sbcl (sb-bsd-sockets:socket-make-stream socket :input input :output output - :element-type element-type) + :element-type element-type) #-(or cmu sbcl) (declare (ignore input output element-type)) #-(or cmu sbcl) socket ) @@ -84,11 +83,11 @@ setsockopt SO_REUSEADDR if :reuse is not nil" (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-file-descriptor listener) :input) (let ((sock (sb-bsd-sockets:socket-accept listener))) (values (sb-bsd-sockets:socket-make-stream - sock :element-type :default :input t :output t) + sock :element-type :default :input t :output t) sock))) #+openmcl (let ((sock (ccl:accept-connection listener :wait t))) @@ -111,7 +110,7 @@ setsockopt SO_REUSEADDR if :reuse is not nil" #+clisp (ext:socket-server-close socket) #+cmu (unix:unix-close socket) #+sbcl (sb-unix:unix-close - (sb-bsd-sockets:socket-file-descriptor socket)) + (sb-bsd-sockets:socket-file-descriptor socket)) #+openmcl (close socket) #-(or allegro clisp cmu sbcl openmcl) (warn "close-passive-socket not supported on this implementation") @@ -126,11 +125,11 @@ setsockopt SO_REUSEADDR if :reuse is not nil" "Convert from 32-bit integer to dotted string." (declare (type (unsigned-byte 32) ipaddr)) (let ((a (logand #xff (ash ipaddr -24))) - (b (logand #xff (ash ipaddr -16))) - (c (logand #xff (ash ipaddr -8))) - (d (logand #xff ipaddr))) + (b (logand #xff (ash ipaddr -16))) + (c (logand #xff (ash ipaddr -8))) + (d (logand #xff ipaddr))) (if values - (values a b c d) + (values a b c d) (format nil "~d.~d.~d.~d" a b c d)))) (defun dotted-to-ipaddr (dotted &key (errorp t)) @@ -138,16 +137,16 @@ setsockopt SO_REUSEADDR if :reuse is not nil" (declare (string dotted)) (if errorp (let ((ll (delimited-string-to-list dotted #\.))) - (+ (ash (parse-integer (first ll)) 24) - (ash (parse-integer (second ll)) 16) - (ash (parse-integer (third ll)) 8) - (parse-integer (fourth ll)))) + (+ (ash (parse-integer (first ll)) 24) + (ash (parse-integer (second ll)) 16) + (ash (parse-integer (third ll)) 8) + (parse-integer (fourth ll)))) (ignore-errors (let ((ll (delimited-string-to-list dotted #\.))) - (+ (ash (parse-integer (first ll)) 24) - (ash (parse-integer (second ll)) 16) - (ash (parse-integer (third ll)) 8) - (parse-integer (fourth ll))))))) + (+ (ash (parse-integer (first ll)) 24) + (ash (parse-integer (second ll)) 16) + (ash (parse-integer (third ll)) 8) + (parse-integer (fourth ll))))))) #+sbcl (defun ipaddr-to-hostname (ipaddr &key ignore-cache) @@ -171,15 +170,15 @@ setsockopt SO_REUSEADDR if :reuse is not nil" "Returns (VALUES STREAM SOCKET)" #+allegro (let ((sock (socket:make-socket :remote-host server - :remote-port port))) + :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))) + :type :stream + :protocol :tcp))) (sb-bsd-sockets:socket-connect sock (lookup-hostname server) port) (values (sb-bsd-sockets:socket-make-stream @@ -202,13 +201,13 @@ setsockopt SO_REUSEADDR if :reuse is not nil" (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))) + (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))) + (nth-value 0 (sb-bsd-sockets:socket-peername socket))) #+cmu (nth-value 0 (ext:get-peer-host-and-port socket)) #+clisp (let* ((peer (ext:socket-stream-peer socket t)) (stop (position #\Space peer)))