Unverified Commit 02cfb4e3 authored by Anton Vodonosov's avatar Anton Vodonosov Committed by GitHub
Browse files

Support (SOCKET-SHUTDOWN ... :DIRECTION :IO) as the generic function documentation advertises (#76)

contributed by Anton Vodonosov
parent 5c0c2629
...@@ -284,6 +284,9 @@ ...@@ -284,6 +284,9 @@
(:input (:input
(jcall $@shutdownInput/Socket/0 (socket usocket))) (jcall $@shutdownInput/Socket/0 (socket usocket)))
(:output (:output
(jcall $@shutdownOutput/Socket/0 (socket usocket)))
(:io
(jcall $@shutdownInput/Socket/0 (socket usocket))
(jcall $@shutdownOutput/Socket/0 (socket usocket)))))) (jcall $@shutdownOutput/Socket/0 (socket usocket))))))
;;; GET-LOCAL/PEER-NAME/ADDRESS/PORT ;;; GET-LOCAL/PEER-NAME/ADDRESS/PORT
......
...@@ -114,7 +114,11 @@ ...@@ -114,7 +114,11 @@
(defmethod socket-shutdown ((usocket stream-usocket) direction) (defmethod socket-shutdown ((usocket stream-usocket) direction)
(with-mapped-conditions (usocket) (with-mapped-conditions (usocket)
(socket:shutdown (socket usocket) :direction direction))) (if (eq :io direction)
(progn
(socket:shutdown (socket usocket) :direction :input)
(socket:shutdown (socket usocket) :direction :output))
(socket:shutdown (socket usocket) :direction direction))))
(defun socket-listen (host port (defun socket-listen (host port
&key reuseaddress &key reuseaddress
......
...@@ -198,7 +198,11 @@ ...@@ -198,7 +198,11 @@
(defmethod socket-shutdown ((usocket stream-usocket) direction) (defmethod socket-shutdown ((usocket stream-usocket) direction)
(with-mapped-conditions (usocket) (with-mapped-conditions (usocket)
(socket:socket-stream-shutdown (socket usocket) direction))) (if (eq :io direction)
(progn
(socket:socket-stream-shutdown (socket usocket) :input)
(socket:socket-stream-shutdown (socket usocket) :output))
(socket:socket-stream-shutdown (socket usocket) direction))))
(defmethod get-local-name ((usocket stream-usocket)) (defmethod get-local-name ((usocket stream-usocket))
(multiple-value-bind (multiple-value-bind
......
...@@ -178,7 +178,8 @@ ...@@ -178,7 +178,8 @@
(with-mapped-conditions (usocket) (with-mapped-conditions (usocket)
(ext:inet-shutdown (socket usocket) (ecase direction (ext:inet-shutdown (socket usocket) (ecase direction
(:input ext:shut-rd) (:input ext:shut-rd)
(:output ext:shut-wr))))) (:output ext:shut-wr)
(:io ext:shut-rdwr)))))
(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0) (defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0)
&aux (real-buffer (if (zerop offset) &aux (real-buffer (if (zerop offset)
......
...@@ -158,8 +158,19 @@ ...@@ -158,8 +158,19 @@
(close (socket usocket) :abort t))) ; see "sbcl.lisp" for (:abort t) (close (socket usocket) :abort t))) ; see "sbcl.lisp" for (:abort t)
(defmethod socket-shutdown ((usocket usocket) direction) (defmethod socket-shutdown ((usocket usocket) direction)
(with-mapped-conditions (usocket) (let ((ccl-direction (case direction
(openmcl-socket:shutdown (socket usocket) :direction direction))) (:io :both)
(otherwise direction))))
(with-mapped-conditions (usocket)
(if (and (eq ccl-direction :both)
;; The :BOTH support was introduced in CCL 1.11.5,
;; and CCL's *FEATURES* allow to distignguish only major version,
;; so we use it starting with 1.12.
(not (member :ccl-1.12 *features*)))
(progn
(openmcl-socket:shutdown (socket usocket) :direction :input)
(openmcl-socket:shutdown (socket usocket) :direction :output))
(openmcl-socket:shutdown (socket usocket) :direction ccl-direction)))))
#-ipv6 #-ipv6
(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0)) (defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
......
...@@ -554,7 +554,8 @@ happen. Use with care." ...@@ -554,7 +554,8 @@ happen. Use with care."
(let ((sock-fd (sb-bsd-sockets:socket-file-descriptor (socket usocket))) (let ((sock-fd (sb-bsd-sockets:socket-file-descriptor (socket usocket)))
(direction-flag (ecase direction (direction-flag (ecase direction
(:input 0) (:input 0)
(:output 1)))) (:output 1)
(:io 2))))
(unless (zerop (ffi:c-inline (sock-fd direction-flag) (:int :int) :int (unless (zerop (ffi:c-inline (sock-fd direction-flag) (:int :int) :int
"shutdown(#0, #1)" :one-liner t)) "shutdown(#0, #1)" :one-liner t))
(error (map-errno-error (cerrno)))))) (error (map-errno-error (cerrno))))))
...@@ -564,7 +565,8 @@ happen. Use with care." ...@@ -564,7 +565,8 @@ happen. Use with care."
(let ((sock-fd (sb-bsd-sockets:socket-file-descriptor (socket usocket))) (let ((sock-fd (sb-bsd-sockets:socket-file-descriptor (socket usocket)))
(direction-flag (ecase direction (direction-flag (ecase direction
(:input 0) (:input 0)
(:output 1)))) (:output 1)
(:io 2))))
(unless (zerop (sockets-internal:shutdown sock-fd direction-flag)) (unless (zerop (sockets-internal:shutdown sock-fd direction-flag))
(error (map-errno-error (cerrno)))))) (error (map-errno-error (cerrno))))))
......
...@@ -177,5 +177,15 @@ ...@@ -177,5 +177,15 @@
t)) t))
t) t)
(deftest socket-shutdown.3
(with-caught-conditions (nil nil)
(let ((sock (socket-connect *common-lisp-net* 80)))
(unwind-protect
(usocket::ignore-unsupported-warnings
(socket-shutdown sock :io))
(socket-close sock))
t))
t)
(defun run-usocket-tests () (defun run-usocket-tests ()
(do-tests)) (do-tests))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment