sb-bsd-sockets: Implement NON-BLOCKING-MODE on Windows

Thanks to Anton Kovalenko.

diff --git a/contrib/sb-bsd-sockets/misc.lisp b/contrib/sb-bsd-sockets/misc.lisp
index 2c0246b..e38a613 100644 (file)
--- a/contrib/sb-bsd-sockets/misc.lisp
+++ b/contrib/sb-bsd-sockets/misc.lisp
@@ -22,7 +22,8 @@
                             0))))
 
 #+win32
-(defmethod non-blocking-mode ((socket socket)) 0)
+(defmethod non-blocking-mode ((socket socket))
+  (slot-value socket 'non-blocking-p))
 
 (defgeneric (setf non-blocking-mode) (non-blocking-p socket)
   (:documentation "Put SOCKET in non-blocking mode - or not, according to NON-BLOCKING-P"))
@@ -43,8 +44,14 @@
     non-blocking-p))
 
 #+win32
-(defmethod (setf non-blocking-mode) (non-blocking-p (socket socket)) 0)
-;;  (sb-alien:with-alien ((mode (unsigned 32)))
-;;    (if non-blocking-p (setf mode 1))
-;;       (ioctlsocket socket FIONBIO mode)))
-
+(defmethod (setf non-blocking-mode)
+    (non-blocking-p (socket socket))
+  (declare (optimize (speed 3)))
+  (setf (slot-value socket 'non-blocking-p)
+        (when non-blocking-p t))
+  (let ((fd (socket-file-descriptor socket)))
+    (when (= (the (signed-byte 32) -1)
+             (the (signed-byte 32)
+               (sockint::ioctl fd sockint::FIONBIO (if non-blocking-p 1 0))))
+      (socket-error "ioctl(FIONBIO)"))
+    (when non-blocking-p t)))

diff --git a/contrib/sb-bsd-sockets/name-service.lisp b/contrib/sb-bsd-sockets/name-service.lisp
index 0b731db..d148373 100644 (file)
--- a/contrib/sb-bsd-sockets/name-service.lisp
+++ b/contrib/sb-bsd-sockets/name-service.lisp
@@ -164,8 +164,7 @@ GET-NAME-SERVICE-ERRNO")
   (let ((*name-service-errno* (get-name-service-errno errno)))
     ;; Comment next to NETDB_INTERNAL in netdb.h says "See errno.".
     ;; This special case treatment hasn't actually been tested yet.
-    #-win32
-    (if (= *name-service-errno* sockint::NETDB-INTERNAL)
+    (if (and #-win32 (= *name-service-errno* sockint::NETDB-INTERNAL))
         (socket-error where)
         (let ((condition
                (condition-for-name-service-errno *name-service-errno*)))

diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp
index 5d09d65..146d32b 100644 (file)
--- a/contrib/sb-bsd-sockets/sockets.lisp
+++ b/contrib/sb-bsd-sockets/sockets.lisp
@@ -26,6 +26,8 @@ protocol. Other values are used as-is.")
    (type  :initarg :type
           :reader socket-type
           :documentation "Type of the socket: :STREAM or :DATAGRAM.")
+   #+win32
+   (non-blocking-p :type (member t nil) :initform nil)
    (stream))
   (:documentation "Common base class of all sockets, not meant to be
 directly instantiated.")))
@@ -433,7 +435,7 @@ request an input stream and get an output stream in response\)."
                     :external-format external-format
                     :timeout timeout
                     :auto-close auto-close
-                    :serve-events serve-events))
+                    :serve-events (and serve-events #+win32 nil)))
       (setf (slot-value socket 'stream) stream))
     (sb-ext:cancel-finalization socket)
     stream))
@@ -454,7 +456,9 @@ request an input stream and get an output stream in response\)."
                        (socket-error-syscall c)
                        (or (socket-error-symbol c) (socket-error-errno c))
                        #+cmu (sb-unix:get-unix-error-msg num)
-                       #+sbcl (sb-int:strerror num)))))
+                       #+sbcl
+                       #+win32 (sb-win32::get-last-error-message num)
+                       #-win32 (sb-int:strerror num)))))
   (:documentation "Common base class of socket related conditions."))
 
 ;;; watch out for slightly hacky symbol punning: we use both the value

diff --git a/contrib/sb-bsd-sockets/sockopt.lisp b/contrib/sb-bsd-sockets/sockopt.lisp
index fb438f1..343fd18 100644 (file)
--- a/contrib/sb-bsd-sockets/sockopt.lisp
+++ b/contrib/sb-bsd-sockets/sockopt.lisp
@@ -55,7 +55,8 @@ Code for options that not every system has should be conditionalised:
                   (if (= -1 (sockint::getsockopt (socket-file-descriptor socket)
                                                  ,find-level ,number
                                                  (sb-alien:addr buffer)
-                                                 (sb-alien:addr size)))
+                                                 #+win32 size
+                                                 #-win32 (sb-alien:addr size)))
                       (socket-error "getsockopt")
                       (,mangle-return buffer size)))
              `(error 'unsupported-operator

diff --git a/contrib/sb-bsd-sockets/tests.lisp b/contrib/sb-bsd-sockets/tests.lisp
index 1ddb408..776878c 100644 (file)
--- a/contrib/sb-bsd-sockets/tests.lisp
+++ b/contrib/sb-bsd-sockets/tests.lisp
@@ -50,7 +50,7 @@
       (and (> (socket-file-descriptor s) 1) t))
   t)
 
-(deftest* (make-inet-socket-wrong :fails-on :win32)
+(deftest* (make-inet-socket-wrong)
     ;; fail to make a socket: check correct error return.  There's no nice
     ;; way to check the condition stuff on its own, which is a shame
     (handler-case
@@ -66,7 +66,7 @@
       (:no-error nil))
   t)
 
-(deftest* (make-inet-socket-keyword-wrong :fails-on :win32)
+(deftest* (make-inet-socket-keyword-wrong)
     ;; same again with keywords
     (handler-case
         (make-instance 'inet-socket :type :stream :protocol :udp)
@@ -83,7 +83,7 @@
   t)
 
 
-(deftest* (non-block-socket :fails-on :win32)
+(deftest* (non-block-socket)
   (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
     (setf (non-blocking-mode s) t)
     (non-blocking-mode s))
@@ -112,7 +112,7 @@
       (address-in-use-error () t)))
   t)
 
-(deftest* (simple-sockopt-test :fails-on :win32)
+(deftest* (simple-sockopt-test)
   ;; test we can set SO_REUSEADDR on a socket and retrieve it, and in
   ;; the process that all the weird macros in sockopt happened right.
   (let ((s (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp"))))

diff --git a/contrib/sb-bsd-sockets/win32-constants.lisp b/contrib/sb-bsd-sockets/win32-constants.lisp
index 4bf52d2..7b8e719 100644 (file)
--- a/contrib/sb-bsd-sockets/win32-constants.lisp
+++ b/contrib/sb-bsd-sockets/win32-constants.lisp
@@ -73,6 +73,7 @@
  (:integer ENETUNREACH "WSAENETUNREACH")
  (:integer ENOTCONN "WSAENOTCONN")
  (:integer inaddr-any "INADDR_ANY")
+ (:integer FIONBIO "FIONBIO")
 
 
  ;; for socket-receive