;;;; -*- 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.
#+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")
(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))
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
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.
@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
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.
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.
(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
(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))
projects / sbcl.git / commitdiff