X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Fsockets.lisp;h=146d32b4d13286ce03c03d91fec7466e6a0aaa28;hb=b9691ef5009d3669c4f87f4dfbd2baf4538e60f8;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..146d32b 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) @@ -19,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."))) @@ -59,7 +68,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 +118,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 +127,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 +227,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 +304,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 +393,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 @@ -413,7 +435,7 @@ 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)) @@ -434,7 +456,9 @@ 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 @@ -486,7 +510,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)))