X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Fsockets.lisp;h=9118a6ad805a76a7bf0d0b448ba5fea849182ac7;hb=78eea0607fb44f620a8192e173f91860d3622967;hp=9788cf2bcae674f6c86394f5767cec7938c6174c;hpb=808457cb2af9dac048727de6b089d6d81235d29e;p=sbcl.git diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp index 9788cf2..9118a6a 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,7 +225,7 @@ 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")) @@ -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) @@ -320,12 +329,14 @@ grow to before new connection attempts are refused. See also listen(2)")) (open-stream-p (slot-value socket 'stream)) (/= -1 (socket-file-descriptor socket)))) -(defgeneric socket-close (socket) - (:documentation "Close SOCKET. May throw any kind of error that -write(2) would have thrown. If SOCKET-MAKE-STREAM has been called, -calls CLOSE on that stream instead")) +(defgeneric socket-close (socket &key abort) + (:documentation + "Close SOCKET, unless it was already closed. + +If SOCKET-MAKE-STREAM has been called, calls CLOSE using ABORT on that stream. +Otherwise closes the socket file descriptor using close(2).")) -(defmethod socket-close ((socket socket)) +(defmethod socket-close ((socket socket) &key abort) ;; the close(2) manual page has all kinds of warning about not ;; checking the return value of close, on the grounds that an ;; earlier write(2) might have returned successfully w/o actually @@ -338,25 +349,30 @@ calls CLOSE on that stream instead")) ;; the socket will avoid doing anything to close the fd in case ;; the stream has done it already - if so, it may have been ;; reassigned to some other file, and closing it would be bad - (let ((fd (socket-file-descriptor socket))) - (cond ((eql fd -1) ; already closed - nil) - ((slot-boundp socket 'stream) - (unwind-protect (close (slot-value socket 'stream)) ;; closes fd + (flet ((drop-it (&optional streamp) (setf (slot-value socket 'file-descriptor) -1) - (slot-makunbound socket 'stream))) - (t - (sb-ext:cancel-finalization socket) - (handler-case - (if (= (sockint::close fd) -1) - (socket-error "close")) - (bad-file-descriptor-error (c) (declare (ignore c)) nil) - (:no-error (c) - (declare (ignore c)) - (setf (slot-value socket 'file-descriptor) -1) - nil)))))) - + (if streamp + (slot-makunbound socket 'stream) + (sb-ext:cancel-finalization socket)) + t)) + (cond ((eql fd -1) + ;; already closed + nil) + ((slot-boundp socket 'stream) + (close (slot-value socket 'stream) :abort abort) + ;; Don't do this if there was an error from CLOSE -- the stream is + ;; still live. + (drop-it t)) + (t + (handler-case + (when (minusp (sockint::close fd)) + (socket-error "close")) + (bad-file-descriptor-error () + (drop-it)) + (:no-error (r) + (declare (ignore r)) + (drop-it)))))))) (defgeneric socket-make-stream (socket &key input output element-type external-format @@ -374,17 +390,33 @@ for the stream.")) (buffering :full) (external-format :default) timeout - auto-close) - "Default method for SOCKET objects. An ELEMENT-TYPE of :DEFAULT will -construct a bivalent stream. 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. - -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\)." + auto-close + serve-events) + "Default method for SOCKET objects. + +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 @@ -400,8 +432,9 @@ and get an output stream in response\)." :buffering buffering :external-format external-format :timeout timeout - :auto-close auto-close))) - (setf (slot-value socket 'stream) stream) + :auto-close auto-close + :serve-events serve-events)) + (setf (slot-value socket 'stream) stream)) (sb-ext:cancel-finalization socket) stream)) @@ -473,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)))