X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Fsockets.lisp;h=5d09d65eafe839c345b71de6b1666b5192f783cd;hb=1483e561a090d9f07687da27f8dd10fcd4152be1;hp=886dd6e6064fa6e87b791616ba4fd208e28139f2;hpb=6e02a5455aeef5a4642a2334348544c1f19775ad;p=sbcl.git

diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp
index 886dd6e..5d09d65 100644
--- a/contrib/sb-bsd-sockets/sockets.lisp
+++ b/contrib/sb-bsd-sockets/sockets.lisp
@@ -5,6 +5,13 @@
 
 (eval-when (:load-toplevel :compile-toplevel :execute)
 
+
+;;; Winsock is different w.r.t errno
+(defun socket-errno ()
+  "Get socket error code, usually from errno, but see #+win32."
+  #+win32 (sockint::wsa-get-last-error)
+  #-win32 (sb-unix::get-errno))
+
 (defclass socket ()
   ((file-descriptor :initarg :descriptor
                     :reader socket-file-descriptor)
@@ -59,7 +66,8 @@ directly instantiated.")))
       (setf (slot-value socket 'file-descriptor) fd
             (slot-value socket 'protocol) proto-num
             (slot-value socket 'type) type)
-      (sb-ext:finalize socket (lambda () (sockint::close fd)))))
+      (sb-ext:finalize socket (lambda () (sockint::close fd))
+                       :dont-save t)))
 
 
 
@@ -108,7 +116,7 @@ values"))
                                (size-of-sockaddr socket))))
       (cond
         ((and (= fd -1)
-              (member (sb-unix::get-errno)
+              (member (socket-errno)
                       (list sockint::EAGAIN sockint::EINTR)))
          nil)
         ((= fd -1) (socket-error "accept"))
@@ -117,7 +125,8 @@ values"))
                               :type (socket-type socket)
                               :protocol (socket-protocol socket)
                               :descriptor fd)))
-                    (sb-ext:finalize s (lambda () (sockint::close fd))))
+                    (sb-ext:finalize s (lambda () (sockint::close fd))
+                                     :dont-save t))
                   (multiple-value-list (bits-of-sockaddr socket sockaddr))))))))
 
 (defgeneric socket-connect (socket &rest address)
@@ -216,11 +225,11 @@ buffer was too small."))
                                         (sb-alien:addr sa-len))))
                 (cond
                   ((and (= len -1)
-                        (member (sb-unix::get-errno)
+                        (member (socket-errno)
                                 (list sockint::EAGAIN sockint::EINTR)))
                    nil)
                   ((= len -1) (socket-error "recvfrom"))
-                  (t (loop for i from 0 below len
+                  (t (loop for i from 0 below (min len length)
                            do (setf (elt buffer i)
                                     (cond
                                       ((or (eql element-type 'character) (eql element-type 'base-char))
@@ -293,7 +302,7 @@ send(2) will be called instead. Returns the number of octets written."))
                                    flags)))))
     (cond
       ((and (= len -1)
-            (member (sb-unix::get-errno)
+            (member (socket-errno)
                     (list sockint::EAGAIN sockint::EINTR)))
        nil)
       ((= len -1)
@@ -382,21 +391,32 @@ for the stream."))
                                (external-format :default)
                                timeout
                                auto-close
-                               (serve-events t))
+                               serve-events)
   "Default method for SOCKET objects.
 
-An ELEMENT-TYPE of :DEFAULT will construct a bivalent stream, capable of both
-binary and character IO. Acceptable values for BUFFERING are :FULL, :LINE
-and :NONE. Streams will have no TIMEOUT by default. If AUTO-CLOSE is true, the
-underlying OS socket is automatically closed after the stream and the socket
-have been garbage collected. If SERVE-EVENTS is true, blocking IO on the
-socket will dispatch to the recursive event loop -- the default is currently
-true, but this liable to change.
-
-The stream for SOCKET will be cached, and a second invocation of this method
-will return the same stream. This may lead to oddities if this function is
-invoked with inconsistent arguments \(e.g., one might request an input stream
-and get an output stream in response\)."
+ELEMENT-TYPE defaults to CHARACTER, to construct a bivalent stream,
+capable of both binary and character IO use :DEFAULT.
+
+Acceptable values for BUFFERING are :FULL, :LINE and :NONE, default
+is :FULL, ie. output is buffered till it is explicitly flushed using
+CLOSE or FINISH-OUTPUT. (FORCE-OUTPUT forces some output to be
+flushed: to ensure all buffered output is flused use FINISH-OUTPUT.)
+
+Streams have no TIMEOUT by default. If one is provided, it is the
+number of seconds the system will at most wait for input to appear on
+the socket stream when trying to read from it.
+
+If AUTO-CLOSE is true, the underlying OS socket is automatically
+closed after the stream and the socket have been garbage collected.
+Default is false.
+
+If SERVE-EVENTS is true, blocking IO on the socket will dispatch to
+the recursive event loop. Default is false.
+
+The stream for SOCKET will be cached, and a second invocation of this
+method will return the same stream. This may lead to oddities if this
+function is invoked with inconsistent arguments \(e.g., one might
+request an input stream and get an output stream in response\)."
   (let ((stream
          (and (slot-boundp socket 'stream) (slot-value socket 'stream))))
     (unless stream
@@ -486,7 +506,7 @@ and get an output stream in response\)."
   ;; FIXME: Our Texinfo documentation extracter need at least his to spit
   ;; out the signature. Real documentation would be better...
   ""
-  (let* ((errno  (sb-unix::get-errno))
+  (let* ((errno (socket-errno))
          (condition (condition-for-errno errno)))
     (error condition :errno errno  :syscall where)))