- usocket-cvs@common-lisp.net - mailman3.common-lisp.net

[usocket-cvs] r449 - usocket/branches/0.4.x/backend
by Chun Tian 21 Oct '08

21 Oct '08

Author: ctian Date: Tue Oct 21 19:48:16 2008 New Revision: 449 Log: Fix minimum local-bind support version of CMUCL Modified: usocket/branches/0.4.x/backend/cmucl.lisp Modified: usocket/branches/0.4.x/backend/cmucl.lisp ============================================================================== --- usocket/branches/0.4.x/backend/cmucl.lisp (original) +++ usocket/branches/0.4.x/backend/cmucl.lisp Tue Oct 21 19:48:16 2008 @@ -61,9 +61,9 @@ (when deadline (unsupported 'deadline 'socket-connect)) (when nodelay-specified (unsupported 'nodelay 'socket-connect)) (when (and local-host-p (not local-bind-p)) - (unsupported 'local-host 'socket-connect :minimum "Snapshot 2008-10 (19E)")) + (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-10 (19E)")) + (unsupported 'local-port 'socket-connect :minimum "Snapshot 2008-08 (19E)")) (let* ((socket)) (setf socket

1 0

[usocket-cvs] r448 - in usocket/branches/0.4.x: . backend
by Chun Tian 21 Oct '08

21 Oct '08

Author: ctian Date: Tue Oct 21 19:18:02 2008 New Revision: 448 Log: unsupport feature enhancements. Modified: usocket/branches/0.4.x/backend/armedbear.lisp usocket/branches/0.4.x/backend/clisp.lisp usocket/branches/0.4.x/backend/cmucl.lisp usocket/branches/0.4.x/backend/lispworks.lisp usocket/branches/0.4.x/backend/sbcl.lisp usocket/branches/0.4.x/backend/scl.lisp usocket/branches/0.4.x/condition.lisp Modified: usocket/branches/0.4.x/backend/armedbear.lisp ============================================================================== --- usocket/branches/0.4.x/backend/armedbear.lisp (original) +++ usocket/branches/0.4.x/backend/armedbear.lisp Tue Oct 21 19:18:02 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/branches/0.4.x/backend/clisp.lisp ============================================================================== --- usocket/branches/0.4.x/backend/clisp.lisp (original) +++ usocket/branches/0.4.x/backend/clisp.lisp Tue Oct 21 19:18:02 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/branches/0.4.x/backend/cmucl.lisp ============================================================================== --- usocket/branches/0.4.x/backend/cmucl.lisp (original) +++ usocket/branches/0.4.x/backend/cmucl.lisp Tue Oct 21 19:18:02 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-10 (19E)")) + (when (and local-port-p (not local-bind-p)) + (unsupported 'local-port 'socket-connect :minimum "Snapshot 2008-10 (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/branches/0.4.x/backend/lispworks.lisp ============================================================================== --- usocket/branches/0.4.x/backend/lispworks.lisp (original) +++ usocket/branches/0.4.x/backend/lispworks.lisp Tue Oct 21 19:18:02 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/branches/0.4.x/backend/sbcl.lisp ============================================================================== --- usocket/branches/0.4.x/backend/sbcl.lisp (original) +++ usocket/branches/0.4.x/backend/sbcl.lisp Tue Oct 21 19:18:02 2008 @@ -202,11 +202,14 @@ (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 - (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 @@ -221,8 +224,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/branches/0.4.x/backend/scl.lisp ============================================================================== --- usocket/branches/0.4.x/backend/scl.lisp (original) +++ usocket/branches/0.4.x/backend/scl.lisp Tue Oct 21 19:18:02 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/branches/0.4.x/condition.lisp ============================================================================== --- usocket/branches/0.4.x/condition.lisp (original) +++ usocket/branches/0.4.x/condition.lisp Tue Oct 21 19:18:02 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."))

1 0

[usocket-cvs] r447 - usocket/branches/0.4.x
by Chun Tian 21 Oct '08

21 Oct '08

Author: ctian Date: Tue Oct 21 15:25:12 2008 New Revision: 447 Log: bugfix: CERROR syntax need a string as its first argument (only SCL compiler find it). Modified: usocket/branches/0.4.x/condition.lisp Modified: usocket/branches/0.4.x/condition.lisp ============================================================================== --- usocket/branches/0.4.x/condition.lisp (original) +++ usocket/branches/0.4.x/condition.lisp Tue Oct 21 15:25:12 2008 @@ -208,8 +208,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))

1 0

[usocket-cvs] r446 - usocket/branches/0.4.x
by Chun Tian 21 Oct '08

21 Oct '08

Author: ctian Date: Tue Oct 21 14:02:59 2008 New Revision: 446 Log: bugfix: non-simple UNKNOWN-ERRORs should be report as usual. Modified: usocket/branches/0.4.x/condition.lisp Modified: usocket/branches/0.4.x/condition.lisp ============================================================================== --- usocket/branches/0.4.x/condition.lisp (original) +++ usocket/branches/0.4.x/condition.lisp Tue Oct 21 14:02:59 2008 @@ -110,13 +110,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 +143,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."))

1 0

[usocket-cvs] r445 - in usocket/branches/experimental-udp: . backend
by Chun Tian 21 Oct '08

21 Oct '08

Author: ctian Date: Tue Oct 21 13:48:27 2008 New Revision: 445 Log: [udp] merge last changes from trunk Modified: usocket/branches/experimental-udp/backend/lispworks.lisp usocket/branches/experimental-udp/backend/openmcl.lisp usocket/branches/experimental-udp/condition.lisp Modified: usocket/branches/experimental-udp/backend/lispworks.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/lispworks.lisp (original) +++ usocket/branches/experimental-udp/backend/lispworks.lisp Tue Oct 21 13:48:27 2008 @@ -8,6 +8,22 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (require "comm")) +;;; --------------------------------------------------------------------------- +;;; Warn if multiprocessing is not running on Lispworks + +#-win32 +(defun check-for-multiprocessing-started (&optional errorp) + (unless mp:*current-process* + (funcall (if errorp 'error 'warn) + "You must start multiprocessing on Lispworks by calling~ + ~%~3t(~s)~ + ~%for ~s function properly." + 'mp:initialize-multiprocessing + 'wait-for-input))) + +#-win32 +(check-for-multiprocessing-started) + #+win32 (fli:register-module "ws2_32") @@ -245,7 +261,7 @@ (unsupported 'local-port 'socket-connect :minimum "LispWorks 5.0+ (verified)")) (ecase protocol - ((:stream :tcp) + (:stream (let ((hostname (host-to-hostname host)) (stream)) (setf stream @@ -263,7 +279,7 @@ (make-stream-socket :socket (comm:socket-stream-socket stream) :stream stream) (error 'unknown-error)))) - ((:datagram :udp) + (:datagram (let ((usocket (make-datagram-socket (if (and host port) (connect-to-udp-server host port Modified: usocket/branches/experimental-udp/backend/openmcl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/openmcl.lisp (original) +++ usocket/branches/experimental-udp/backend/openmcl.lisp Tue Oct 21 13:48:27 2008 @@ -64,7 +64,7 @@ (ccl:input-timeout (error 'timeout-error :socket socket :real-error condition)) (ccl:communication-deadline-expired - (error 'timeout-error :socket socket :real-error condition)) + (error 'deadline-error :socket socket :real-error condition)) (ccl::socket-creation-error #| ugh! |# (raise-error-from-id (ccl::socket-creation-error-identifier condition) socket condition)))) Modified: usocket/branches/experimental-udp/condition.lisp ============================================================================== --- usocket/branches/experimental-udp/condition.lisp (original) +++ usocket/branches/experimental-udp/condition.lisp Tue Oct 21 13:48:27 2008 @@ -109,6 +109,10 @@ (define-condition unknown-error (socket-error) ((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))))) (:documentation "Error raised when there's no other - more applicable - error available.")) @@ -135,6 +139,10 @@ (define-condition ns-unknown-error (ns-error) ((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))))) (:documentation "Error raised when there's no other - more applicable - error available.")) @@ -193,7 +201,7 @@ (defmacro unsupported (feature context &key minimum) - `(signal 'unsupported :feature ,feature + `(cerror 'unsupported :feature ,feature :context ,context :minimum ,minimum)) (defmacro unimplemented (feature context)

1 0

[usocket-cvs] r444 - usocket/branches/experimental-udp
by Chun Tian 21 Oct '08

21 Oct '08

Author: ctian Date: Tue Oct 21 13:47:47 2008 New Revision: 444 Log: [udp] revert changes to HOST-TO-HOSTNAME and HOST-TO-HBO, just bad idea. Modified: usocket/branches/experimental-udp/usocket.lisp Modified: usocket/branches/experimental-udp/usocket.lisp ============================================================================== --- usocket/branches/experimental-udp/usocket.lisp (original) +++ usocket/branches/experimental-udp/usocket.lisp Tue Oct 21 13:47:47 2008 @@ -407,7 +407,6 @@ (defun host-to-hostname (host) "Translate a string or vector quad to a stringified hostname." (etypecase host - (null nil) (string host) ((or (vector t 4) (array (unsigned-byte 8) (4))) @@ -461,7 +460,6 @@ (defun host-to-hbo (host) (etypecase host - (null nil) (string (let ((ip (ignore-errors (dotted-quad-to-vector-quad host)))) (if (and ip (= 4 (length ip)))

1 0

[usocket-cvs] r443 - in usocket/trunk: . backend
by Chun Tian 21 Oct '08

21 Oct '08

Author: ctian Date: Tue Oct 21 13:34:39 2008 New Revision: 443 Log: Merge c441,442 from branch 0.4.x to trunk Modified: usocket/trunk/backend/lispworks.lisp usocket/trunk/condition.lisp Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Tue Oct 21 13:34:39 2008 @@ -8,6 +8,22 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (require "comm")) +;;; --------------------------------------------------------------------------- +;;; Warn if multiprocessing is not running on Lispworks + +#-win32 +(defun check-for-multiprocessing-started (&optional errorp) + (unless mp:*current-process* + (funcall (if errorp 'error 'warn) + "You must start multiprocessing on Lispworks by calling~ + ~%~3t(~s)~ + ~%for ~s function properly." + 'mp:initialize-multiprocessing + 'wait-for-input))) + +#-win32 +(check-for-multiprocessing-started) + #+win32 (fli:register-module "ws2_32") Modified: usocket/trunk/condition.lisp ============================================================================== --- usocket/trunk/condition.lisp (original) +++ usocket/trunk/condition.lisp Tue Oct 21 13:34:39 2008 @@ -109,6 +109,10 @@ (define-condition unknown-error (socket-error) ((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))))) (:documentation "Error raised when there's no other - more applicable - error available.")) @@ -135,6 +139,10 @@ (define-condition ns-unknown-error (ns-error) ((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))))) (:documentation "Error raised when there's no other - more applicable - error available.")) @@ -197,4 +205,4 @@ :context ,context :minimum ,minimum)) (defmacro unimplemented (feature context) - `(signal 'unimplemented :feature ,feature :context ,context)) \ No newline at end of file + `(signal 'unimplemented :feature ,feature :context ,context))

1 0

[usocket-cvs] r442 - usocket/branches/0.4.x
by Chun Tian 21 Oct '08

21 Oct '08

Author: ctian Date: Tue Oct 21 13:31:36 2008 New Revision: 442 Log: Report more details of a UNKNOWN-ERROR or NS-UNKNOWN-ERROR Modified: usocket/branches/0.4.x/condition.lisp Modified: usocket/branches/0.4.x/condition.lisp ============================================================================== --- usocket/branches/0.4.x/condition.lisp (original) +++ usocket/branches/0.4.x/condition.lisp Tue Oct 21 13:31:36 2008 @@ -109,6 +109,10 @@ (define-condition unknown-error (socket-error) ((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))))) (:documentation "Error raised when there's no other - more applicable - error available.")) @@ -135,6 +139,10 @@ (define-condition ns-unknown-error (ns-error) ((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))))) (:documentation "Error raised when there's no other - more applicable - error available.")) @@ -197,4 +205,4 @@ :context ,context :minimum ,minimum)) (defmacro unimplemented (feature context) - `(signal 'unimplemented :feature ,feature :context ,context)) \ No newline at end of file + `(signal 'unimplemented :feature ,feature :context ,context))

1 0

[usocket-cvs] r441 - usocket/branches/0.4.x/backend
by Chun Tian 21 Oct '08

21 Oct '08

Author: ctian Date: Tue Oct 21 13:30:16 2008 New Revision: 441 Log: [lispworks] on non-win32 platform, add a warn when MP is not enabled when load. Modified: usocket/branches/0.4.x/backend/lispworks.lisp Modified: usocket/branches/0.4.x/backend/lispworks.lisp ============================================================================== --- usocket/branches/0.4.x/backend/lispworks.lisp (original) +++ usocket/branches/0.4.x/backend/lispworks.lisp Tue Oct 21 13:30:16 2008 @@ -8,6 +8,22 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (require "comm")) +;;; --------------------------------------------------------------------------- +;;; Warn if multiprocessing is not running on Lispworks + +#-win32 +(defun check-for-multiprocessing-started (&optional errorp) + (unless mp:*current-process* + (funcall (if errorp 'error 'warn) + "You must start multiprocessing on Lispworks by calling~ + ~%~3t(~s)~ + ~%for ~s function properly." + 'mp:initialize-multiprocessing + 'wait-for-input))) + +#-win32 +(check-for-multiprocessing-started) + #+win32 (fli:register-module "ws2_32")

1 0

[usocket-cvs] r440 - usocket/branches/0.4.x/backend
by Erik Huelsmann 21 Oct '08

21 Oct '08

Author: ehuelsmann Date: Tue Oct 21 12:27:45 2008 New Revision: 440 Log: Merge c439: report deadline errors as DEADLINE-ERROR. Modified: usocket/branches/0.4.x/backend/openmcl.lisp Modified: usocket/branches/0.4.x/backend/openmcl.lisp ============================================================================== --- usocket/branches/0.4.x/backend/openmcl.lisp (original) +++ usocket/branches/0.4.x/backend/openmcl.lisp Tue Oct 21 12:27:45 2008 @@ -64,7 +64,7 @@ (ccl:input-timeout (error 'timeout-error :socket socket :real-error condition)) (ccl:communication-deadline-expired - (error 'timeout-error :socket socket :real-error condition)) + (error 'deadline-error :socket socket :real-error condition)) (ccl::socket-creation-error #| ugh! |# (raise-error-from-id (ccl::socket-creation-error-identifier condition) socket condition))))

1 0