Author: ctian Date: Wed Oct 22 01:11:56 2008 New Revision: 451 Log: Merge all changes on branch 0.4.x so far back to trunk, seems the only different between trunk and branch 0.4.x is the file backend/clisp.lisp which also contains some udp-related code. Modified: usocket/trunk/backend/armedbear.lisp usocket/trunk/backend/clisp.lisp usocket/trunk/backend/cmucl.lisp usocket/trunk/backend/lispworks.lisp usocket/trunk/backend/sbcl.lisp usocket/trunk/backend/scl.lisp usocket/trunk/condition.lisp Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Wed Oct 22 01:11:56 2008 @@ -190,9 +190,8 @@ timeout deadline (nodelay nil nodelay-specified) local-host local-port) (when deadline (unsupported 'deadline 'socket-connect)) - (when (or local-host local-port) - (unimplemented 'local-host 'socket-connect) - (unimplemented 'local-port 'socket-connect)) + (when local-host (unimplemented 'local-host 'socket-connect)) + (when local-port (unimplemented 'local-port 'socket-connect)) (let ((usock)) (with-mapped-conditions (usock) Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Wed Oct 22 01:11:56 2008 @@ -62,9 +62,8 @@ (when timeout (unsupported 'timeout 'socket-connect)) (when deadline (unsupported 'deadline 'socket-connect)) (when nodelay-specified (unsupported 'nodelay 'socket-connect)) - (when (or local-host local-port) - (unsupported 'local-host 'socket-connect) - (unsupported 'local-port 'socket-connect)) + (when local-host (unsupported 'local-host 'socket-connect)) + (when local-port (unsupported 'local-port 'socket-connect)) (let ((socket) (hostname (host-to-hostname host))) Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Wed Oct 22 01:11:56 2008 @@ -52,19 +52,26 @@ (defun socket-connect (host port &key (element-type 'character) timeout deadline (nodelay t nodelay-specified) - local-host local-port) + (local-host nil local-host-p) + (local-port nil local-port-p) + &aux + (local-bind-p (fboundp 'ext::bind-inet-socket))) (declare (ignore nodelay)) (when timeout (unsupported 'timeout 'socket-connect)) (when deadline (unsupported 'deadline 'socket-connect)) (when nodelay-specified (unsupported 'nodelay 'socket-connect)) - (when (or local-host local-port) - (unsupported 'local-host 'socket-connect) - (unsupported 'local-port 'socket-connect)) + (when (and local-host-p (not local-bind-p)) + (unsupported 'local-host 'socket-connect :minimum "Snapshot 2008-08 (19E)")) + (when (and local-port-p (not local-bind-p)) + (unsupported 'local-port 'socket-connect :minimum "Snapshot 2008-08 (19E)")) (let* ((socket)) (setf socket - (with-mapped-conditions (socket) - (ext:connect-to-inet-socket (host-to-hbo host) port :stream))) + (let ((args (list (host-to-hbo host) port :stream))) + (when (and local-bind-p (or local-host-p local-port-p)) + (nconc args (list :local-host local-host :local-port local-port))) + (with-mapped-conditions (socket) + (apply #'ext:connect-to-inet-socket args)))) (if socket (let* ((stream (sys:make-fd-stream socket :input t :output t :element-type element-type Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Wed Oct 22 01:11:56 2008 @@ -98,10 +98,11 @@ #+(and (not lispworks4) (not lispworks5.0)) (when nodelay-specified (unimplemented 'nodelay 'socket-connect)) - #+lispworks4 - (when (or local-host local-port) - (unsupported 'local-host 'socket-connect :minimum "LispWorks 5.0+ (verified)") - (unsupported 'local-port 'socket-connect :minimum "LispWorks 5.0+ (verified)")) + #+lispworks4 #+lispworks4 + (when local-host + (unsupported 'local-host 'socket-connect :minimum "LispWorks 5.0")) + (when local-port + (unsupported 'local-port 'socket-connect :minimum "LispWorks 5.0")) (let ((hostname (host-to-hostname host)) (stream)) Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Wed Oct 22 01:11:56 2008 @@ -203,7 +203,10 @@ (defun socket-connect (host port &key (element-type 'character) timeout deadline (nodelay t nodelay-specified) - local-host local-port) + local-host local-port + &aux + (sockopt-tcp-nodelay-p + (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay))) (when deadline (unsupported 'deadline 'socket-connect)) (when timeout (unsupported 'timeout 'socket-connect)) (when (and nodelay-specified @@ -211,7 +214,7 @@ ;; package today. There's no guarantee the functions ;; we need are available, but we can make sure not to ;; call them if they aren't - (not (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay))) + (not sockopt-tcp-nodelay-p)) (unsupported 'nodelay 'socket-connect)) (let ((socket (make-instance 'sb-bsd-sockets:inet-socket @@ -226,8 +229,7 @@ ;;###FIXME: The above line probably needs an :external-format (usocket (make-stream-socket :stream stream :socket socket)) (ip (host-to-vector-quad host))) - (when (and nodelay-specified - (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay)) + (when (and nodelay-specified sockopt-tcp-nodelay-p) (setf (sb-bsd-sockets:sockopt-tcp-nodelay socket) nodelay)) (when (or local-host local-port) (sb-bsd-sockets:socket-bind socket Modified: usocket/trunk/backend/scl.lisp ============================================================================== --- usocket/trunk/backend/scl.lisp (original) +++ usocket/trunk/backend/scl.lisp Wed Oct 22 01:11:56 2008 @@ -30,18 +30,24 @@ (defun socket-connect (host port &key (element-type 'character) timeout deadline (nodelay t nodelay-specified) - local-host local-port) + (local-host nil local-host-p) + (local-port nil local-port-p) + &aux + (patch-udp-p (fboundp 'ext::inet-socket-send-to))) (declare (ignore nodelay)) (when nodelay-specified (unsupported 'nodelay 'socket-connect)) (when deadline (unsupported 'deadline 'socket-connect)) (when timeout (unsupported 'timeout 'socket-connect)) - (when (or local-host local-port) - (unsupported 'local-host 'socket-connect) - (unsupported 'local-port 'socket-connect)) - - (let* ((socket (with-mapped-conditions () - (ext:connect-to-inet-socket (host-to-hbo host) port - :kind :stream))) + (when (and local-host-p (not patch-udp-p)) + (unsupported 'local-host 'socket-connect :minimum "1.3.8.2")) + (when (and local-port-p (not patch-udp-p)) + (unsupported 'local-port 'socket-connect :minimum "1.3.8.2")) + + (let* ((socket (let ((args (list (host-to-hbo host) port :kind :stream))) + (when (and patch-udp-p (or local-host-p local-port-p)) + (nconc args (list :local-host local-host :local-port local-port))) + (with-mapped-conditions () + (apply #'ext:connect-to-inet-socket args)))) (stream (sys:make-fd-stream socket :input t :output t :element-type element-type :buffering :full))) Modified: usocket/trunk/condition.lisp ============================================================================== --- usocket/trunk/condition.lisp (original) +++ usocket/trunk/condition.lisp Wed Oct 22 01:11:56 2008 @@ -25,6 +25,12 @@ ((minimum :initarg :minimum :reader minimum :documentation "Indicates the minimal version of the implementation required to support the requested feature.")) + (:report (lambda (c stream) + (format stream "~A in ~A is unsupported." + (feature c) (context c)) + (when (minimum c) + (format stream " Minimum version (~A) is required." + (minimum c))))) (:documentation "Signalled when the underlying implementation doesn't allow supporting the requested feature. @@ -32,6 +38,9 @@ (define-condition unimplemented (insufficient-implementation) () + (:report (lambda (c stream) + (format stream "~A in ~A is unimplemented." + (feature c) (context c)))) (:documentation "Signalled if a certain feature might be implemented, based on the features of the underlying implementation, but hasn't been implemented yet.")) @@ -110,13 +119,16 @@ ((real-error :initarg :real-error :accessor usocket-real-error)) (:report (lambda (c stream) - (format stream - (simple-condition-format-control (usocket-real-error c)) - (simple-condition-format-arguments (usocket-real-error c))))) + (typecase c + (simple-condition + (format stream + (simple-condition-format-control (usocket-real-error c)) + (simple-condition-format-arguments (usocket-real-error c)))) + (otherwise + (format stream "The condition ~A occurred." (usocket-real-error c)))))) (:documentation "Error raised when there's no other - more applicable - error available.")) - (define-usocket-condition-classes (ns-try-again) (ns-condition)) @@ -140,9 +152,13 @@ ((real-error :initarg :real-error :accessor ns-real-error)) (:report (lambda (c stream) - (format stream - (simple-condition-format-control (ns-real-error c)) - (simple-condition-format-arguments (ns-real-error c))))) + (typecase c + (simple-condition + (format stream + (simple-condition-format-control (usocket-real-error c)) + (simple-condition-format-arguments (usocket-real-error c)))) + (otherwise + (format stream "The condition ~A occurred." (usocket-real-error c)))))) (:documentation "Error raised when there's no other - more applicable - error available.")) @@ -201,8 +217,10 @@ (defmacro unsupported (feature context &key minimum) - `(cerror 'unsupported :feature ,feature - :context ,context :minimum ,minimum)) + `(cerror "Ignore it and continue" 'unsupported + :feature ,feature + :context ,context + :minimum ,minimum)) (defmacro unimplemented (feature context) `(signal 'unimplemented :feature ,feature :context ,context))