Menu
▾
▴
[Sbcl-commits] master: Add SOCKET-SHUTDOWN in contrib/sb-bsd-sockets
|
From: stassats <sta...@us...> - 2013-09-02 14:17:57
|
The branch "master" has been updated in SBCL:
via 3044d2a42fd6730eb8a6c74b4cadb0555bc14e31 (commit)
from cd1b14acf6f548b28b8a14e554d779f0473122ec (commit)
- Log -----------------------------------------------------------------
commit 3044d2a42fd6730eb8a6c74b4cadb0555bc14e31
Author: Jan Moringen <jmo...@te...>
Date: Thu Aug 1 18:54:12 2013 +0200
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
---
NEWS | 2 +
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 | 60 +++++++++++++++++++++++++
6 files changed, 94 insertions(+), 4 deletions(-)
diff --git a/NEWS b/NEWS
index a8a97e8..34b238a 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,7 @@
;;;; -*- coding: utf-8; fill-column: 78 -*-
changes relative to sbcl-1.1.11:
+ * enhancement: Add sb-bsd-sockets:socket-shutdown, for calling
+ shutdown(3). (lp#1207483 patch by Jan Moringen)
* bug fix: probe-file now can access symlinks to pipes and sockets in
/proc/pid/fd on Linux. (reported by Eric Schulte)
* bug fix: SBCL can now be built on Solaris x86-64.
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..95fcf43 100644
--- a/contrib/sb-bsd-sockets/tests.lisp
+++ b/contrib/sb-bsd-sockets/tests.lisp
@@ -362,3 +362,63 @@
(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
+ (sb-ext:with-timeout 2
+ (,(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)
+ (sb-ext:timeout () :timeout)))
+ :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))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
|