From 7552e75f9ce806b0d155818d3ff8c2df725ecd55 Mon Sep 17 00:00:00 2001 From: Jan Moringen Date: Thu, 1 Aug 2013 18:54:12 +0200 Subject: [PATCH] Add SOCKET-SHUTDOWN in contrib/sb-bsd-sockets * The new generic function SOCKET-SHUTDOWN shuts down a socket for input, output or both. Calls shutdown(3posix) * Test shutdown.{client,server}.{ub8,character}.{output,io} test shutting down TCP stream sockets from the client and server side for different element-types and directions --- contrib/sb-bsd-sockets/constants.lisp | 8 ++++ contrib/sb-bsd-sockets/defpackage.lisp | 2 +- contrib/sb-bsd-sockets/sb-bsd-sockets.texinfo | 8 ++-- contrib/sb-bsd-sockets/sockets.lisp | 18 ++++++++ contrib/sb-bsd-sockets/tests.lisp | 58 +++++++++++++++++++++++++ 5 files changed, 90 insertions(+), 4 deletions(-) diff --git a/contrib/sb-bsd-sockets/constants.lisp b/contrib/sb-bsd-sockets/constants.lisp index 92c017e..bb5bcbb 100644 --- a/contrib/sb-bsd-sockets/constants.lisp +++ b/contrib/sb-bsd-sockets/constants.lisp @@ -67,6 +67,12 @@ #+linux (:integer so-bindtodevice "SO_BINDTODEVICE") (:integer ifnamsiz "IFNAMSIZ") +;; socket shutdown flags +(:integer SHUT_RD "SHUT_RD") +(:integer SHUT_WR "SHUT_WR") +(:integer SHUT_RDWR "SHUT_RDWR") + +;; errors (:integer EADDRINUSE "EADDRINUSE") (:integer EAGAIN "EAGAIN") (:integer EBADF "EBADF") @@ -214,6 +220,8 @@ (addrlen socklen-t))) (:function close ("close" int (fd int))) + (:function shutdown ("shutdown" int + (fd int) (how int))) (:function recvfrom ("recvfrom" ssize-t (socket int) (buf (* t)) diff --git a/contrib/sb-bsd-sockets/defpackage.lisp b/contrib/sb-bsd-sockets/defpackage.lisp index 0c86552..0dc18cd 100644 --- a/contrib/sb-bsd-sockets/defpackage.lisp +++ b/contrib/sb-bsd-sockets/defpackage.lisp @@ -10,7 +10,7 @@ socket-bind socket-accept socket-connect socket-send socket-receive socket-name socket-peername socket-listen - socket-close socket-file-descriptor + socket-close socket-shutdown socket-file-descriptor socket-family socket-protocol socket-open-p socket-type socket-make-stream get-protocol-by-name diff --git a/contrib/sb-bsd-sockets/sb-bsd-sockets.texinfo b/contrib/sb-bsd-sockets/sb-bsd-sockets.texinfo index 760c5f0..cad46a4 100644 --- a/contrib/sb-bsd-sockets/sb-bsd-sockets.texinfo +++ b/contrib/sb-bsd-sockets/sb-bsd-sockets.texinfo @@ -36,7 +36,7 @@ Where the C API would typically return -1 and set @code{errno}, of @code{sb-bsd-sockets:socket-condition} and generally correspond one for one with possible @code{errno} values. -@item +@item We use multiple return values in many places where the C API would use pass-by-reference values. @@ -75,6 +75,8 @@ than "network-endian integers". @include fun-sb-bsd-sockets-socket-close.texinfo +@include fun-sb-bsd-sockets-socket-shutdown.texinfo + @include fun-sb-bsd-sockets-socket-make-stream.texinfo @include fun-sb-bsd-sockets-socket-error.texinfo @@ -141,7 +143,7 @@ port, so for example, (socket-connect s #(192 168 1 1) 80). Local domain (@code{AF_LOCAL}) sockets are also known as Unix-domain sockets, but were renamed by POSIX presumably on the basis that they may be available on other systems too. - + A local socket address is a string, which is used to create a node in the local filesystem. This means of course that they cannot be used across a network. @@ -157,7 +159,7 @@ Presently name service is implemented by calling out to the the preferred functions are not available. The exact details of the name resolving process (for example the choice of whether DNS or a hosts file is used for lookup) are platform dependent. - + @c Direct links to the asynchronous @code{resolver(3)} routines would be @c nice to have eventually, so that we can do DNS lookups in parallel @c with other things. diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp index 146d32b..8cf96d5 100644 --- a/contrib/sb-bsd-sockets/sockets.lisp +++ b/contrib/sb-bsd-sockets/sockets.lisp @@ -376,6 +376,24 @@ Otherwise closes the socket file descriptor using close(2).")) (declare (ignore r)) (drop-it)))))))) +(defgeneric socket-shutdown (socket &key direction) + (:documentation + "Indicate that no communication in DIRECTION will be performed on SOCKET. + +DIRECTION has to be one of :INPUT, :OUTPUT or :IO. + +After a shutdown, no input and/or output of the indicated DIRECTION +can be performed on SOCKET.")) + +(defmethod socket-shutdown ((socket socket) &key direction) + (let* ((fd (socket-file-descriptor socket)) + (how (ecase direction + (:input sockint::SHUT_RD) + (:output sockint::SHUT_WR) + (:io sockint::SHUT_RDWR)))) + (when (minusp (sockint::shutdown fd how)) + (socket-error "shutdown")))) + (defgeneric socket-make-stream (socket &key input output element-type external-format buffering diff --git a/contrib/sb-bsd-sockets/tests.lisp b/contrib/sb-bsd-sockets/tests.lisp index 7ce9d39..8116597 100644 --- a/contrib/sb-bsd-sockets/tests.lisp +++ b/contrib/sb-bsd-sockets/tests.lisp @@ -362,3 +362,61 @@ (server)) result) :ok) + +(defmacro with-client-and-server ((server-socket-var client-socket-var) &body body) + (let ((listen-socket (gensym "LISTEN-SOCKET"))) + `(let ((,listen-socket (make-instance 'inet-socket + :type :stream + :protocol :tcp)) + (,client-socket-var (make-instance 'inet-socket + :type :stream + :protocol :tcp)) + (,server-socket-var)) + (unwind-protect + (progn + (setf (sockopt-reuse-address ,listen-socket) t) + (socket-bind ,listen-socket (make-inet-address "127.0.0.1") 0) + (socket-listen ,listen-socket 5) + (socket-connect ,client-socket-var (make-inet-address "127.0.0.1") + (nth-value 1 (socket-name ,listen-socket))) + (setf ,server-socket-var (socket-accept ,listen-socket)) + ,@body) + (socket-close ,client-socket-var) + (socket-close ,listen-socket) + (when ,server-socket-var + (socket-close ,server-socket-var)))))) + +;; For stream sockets, make sure a shutdown of the output direction +;; translates into an END-OF-FILE on the other end, no matter which +;; end performs the shutdown and independent of the element-type of +;; the stream. +(macrolet + ((define-shutdown-test (name who-shuts-down who-reads element-type direction) + `(deftest ,name + (with-client-and-server (client server) + (socket-shutdown ,who-shuts-down :direction ,direction) + (handler-case + (,(if (eql element-type 'character) + 'read-char 'read-byte) + (socket-make-stream + ,who-reads :input t :output t + :element-type ',element-type)) + (end-of-file () + :ok))) + :ok)) + (define-shutdown-tests (direction) + (flet ((make-name (name) + (intern (concatenate + 'string (string name) "." (string direction))))) + `(progn + (define-shutdown-test ,(make-name 'shutdown.server.character) + server client character ,direction) + (define-shutdown-test ,(make-name 'shutdown.server.ub8) + server client (unsigned-byte 8) ,direction) + (define-shutdown-test ,(make-name 'shutdown.client.character) + client server character ,direction) + (define-shutdown-test ,(make-name 'shutdown.client.ub8) + client server (unsigned-byte 8) ,direction))))) + + (define-shutdown-tests :output) + (define-shutdown-tests :io)) -- 1.7.9.5