From ctian at common-lisp.net Thu Oct 2 22:48:46 2008 From: ctian at common-lisp.net (ctian at common-lisp.net) Date: Thu, 2 Oct 2008 18:48:46 -0400 (EDT) Subject: [usocket-cvs] r425 - in usocket/branches/experimental-udp: . backend Message-ID: <20081002224846.8FFBA1D17B@common-lisp.net> Author: ctian Date: Thu Oct 2 18:48:46 2008 New Revision: 425 Added: usocket/branches/experimental-udp/ - copied from r424, usocket/trunk/ Modified: usocket/branches/experimental-udp/backend/lispworks.lisp Log: New branch: experimental UDP support Modified: usocket/branches/experimental-udp/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/branches/experimental-udp/backend/lispworks.lisp Thu Oct 2 18:48:46 2008 @@ -216,15 +216,20 @@ ;; Can we have a sane -pref. complete [UDP!?]- API next time, please? (dolist (x (wait-list-waiters wait-list)) (mp:notice-fd (os-socket-handle x))) - (mp:process-wait-with-timeout "Waiting for a socket to become active" - (truncate timeout) - #'(lambda (socks) - (let (rv) - (dolist (x socks rv) - (when (usocket-listen x) - (setf (state x) :READ - rv t))))) - (wait-list-waiters wait-list)) + (labels ((wait-function (socks) + (let (rv) + (dolist (x socks rv) + (when (usocket-listen x) + (setf (state x) :READ + rv t)))))) + (if timeout + (mp:process-wait-with-timeout "Waiting for a socket to become active" + (truncate timeout) + #'wait-function + (wait-list-waiters wait-list)) + (mp:process-wait "Waiting for a socket to become active" + #'wait-function + (wait-list-waiters wait-list)))) (dolist (x (wait-list-waiters wait-list)) (mp:unnotice-fd (os-socket-handle x))) wait-list))) From ctian at common-lisp.net Fri Oct 3 12:49:41 2008 From: ctian at common-lisp.net (ctian at common-lisp.net) Date: Fri, 3 Oct 2008 08:49:41 -0400 (EDT) Subject: [usocket-cvs] r426 - in usocket/branches/experimental-udp: . backend Message-ID: <20081003124941.5BE5931036@common-lisp.net> Author: ctian Date: Fri Oct 3 08:49:40 2008 New Revision: 426 Added: usocket/branches/experimental-udp/rtt-client.lisp (contents, props changed) usocket/branches/experimental-udp/rtt.lisp (contents, props changed) usocket/branches/experimental-udp/server.lisp (contents, props changed) Modified: usocket/branches/experimental-udp/backend/allegro.lisp usocket/branches/experimental-udp/backend/cmucl.lisp usocket/branches/experimental-udp/backend/lispworks.lisp usocket/branches/experimental-udp/backend/openmcl.lisp usocket/branches/experimental-udp/backend/sbcl.lisp usocket/branches/experimental-udp/condition.lisp usocket/branches/experimental-udp/package.lisp usocket/branches/experimental-udp/usocket.asd usocket/branches/experimental-udp/usocket.lisp Log: [experimental-udp] initial commit, no support on scl/clisp/armedbear, buggy on others. Modified: usocket/branches/experimental-udp/backend/allegro.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/allegro.lisp (original) +++ usocket/branches/experimental-udp/backend/allegro.lisp Fri Oct 3 08:49:40 2008 @@ -49,7 +49,7 @@ :text :binary)) -(defun socket-connect (host port &key (element-type 'character) +(defun socket-connect (host port &key (protocol :tcp) (element-type 'character) timeout deadline (nodelay t) ;; nodelay == t is the ACL default local-host local-port) @@ -59,22 +59,38 @@ (let ((socket)) (setf socket (with-mapped-conditions (socket) - (if timeout - (mp:with-timeout (timeout nil) - (socket:make-socket :remote-host (host-to-hostname host) - :remote-port port - :local-host (when local-host (host-to-hostname local-host)) - :local-port local-port - :format (to-format element-type) - :nodelay nodelay)) - (socket:make-socket :remote-host (host-to-hostname host) - :remote-port port - :local-host local-host - :local-port local-port - :format (to-format element-type) - :nodelay nodelay)))) - (make-stream-socket :socket socket :stream socket))) - + (ecase protocol + (:tcp (if timeout + (mp:with-timeout (timeout nil) + (socket:make-socket :remote-host (host-to-hostname host) + :remote-port port + :local-host (when local-host (host-to-hostname local-host)) + :local-port local-port + :format (to-format element-type) + :nodelay nodelay)) + (socket:make-socket :remote-host (host-to-hostname host) + :remote-port port + :local-host (when local-host (host-to-hostname local-host)) + :local-port local-port + :format (to-format element-type) + :nodelay nodelay))) + (:udp (if (and host port) + (socket:make-socket :type :datagram + :address-family :internet + :connect :active + :remote-host (host-to-hostname host) + :remote-port port + :local-host (when local-host (host-to-hostname local-host)) + :local-port local-port + :format (to-format element-type)) + (socket:make-socket :type :datagram + :address-family :internet + :local-host local-host + :local-port (when local-host (host-to-hostname local-host)) + :format (to-format element-type))))))) + (ecase protocol + (:tcp (make-stream-socket :socket socket :stream socket)) + (:udp (make-datagram-socket socket))))) ;; One socket close method is sufficient, ;; because socket-streams are also sockets. @@ -113,6 +129,16 @@ (socket:accept-connection (socket socket))))) (make-stream-socket :socket stream-sock :stream stream-sock))) +(defmethod socket-send ((socket datagram-usocket) buffer length &key address port) + (with-mapped-conditions (socket) + (let ((s (socket socket))) + (socket:send-to s buffer length :remote-host address :remote-port port)))) + +(defmethod socket-receive ((socket datagram-usocket) buffer length) + (with-mapped-conditions (socket) + (let ((s (socket socket))) + (socket:receive-from s length :buffer buffer :extract t)))) + (defmethod get-local-address ((usocket usocket)) (hbo-to-vector-quad (socket:local-host (socket usocket)))) Modified: usocket/branches/experimental-udp/backend/cmucl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/cmucl.lisp (original) +++ usocket/branches/experimental-udp/backend/cmucl.lisp Fri Oct 3 08:49:40 2008 @@ -50,7 +50,7 @@ :socket socket :condition condition)))) -(defun socket-connect (host port &key (element-type 'character) +(defun socket-connect (host port &key (protocol :tcp) (element-type 'character) timeout deadline (nodelay t nodelay-specified) local-host local-port) (declare (ignore nodelay)) @@ -61,20 +61,43 @@ (unsupported 'local-host 'socket-connect) (unsupported 'local-port 'socket-connect)) - (let* ((socket)) - (setf socket - (with-mapped-conditions (socket) - (ext:connect-to-inet-socket (host-to-hbo host) port :stream))) - (if socket - (let* ((stream (sys:make-fd-stream socket :input t :output t - :element-type element-type - :buffering :full)) - ;;###FIXME the above line probably needs an :external-format - (usocket (make-stream-socket :socket socket - :stream stream))) - usocket) - (let ((err (unix:unix-errno))) - (when err (cmucl-map-socket-error err)))))) + (let ((socket)) + (ecase protocol + (:tcp (progn + (setf socket + (with-mapped-conditions (socket) + (ext:connect-to-inet-socket (host-to-hbo host) port + (cdr (assoc protocol +protocol-map+)) + :local-host (if local-host + (host-to-hbo local-host)) + :local-port local-port))) + (if socket + (let* ((stream (sys:make-fd-stream socket :input t :output t + :element-type element-type + :buffering :full)) + ;;###FIXME the above line probably needs an :external-format + (usocket (make-stream-socket :socket socket + :stream stream))) + usocket) + (let ((err (unix:unix-errno))) + (when err (cmucl-map-socket-error err)))))) + (:udp (progn + (if (and host port) + (setf socket (with-mapped-conditions (socket) + (ext:connect-to-inet-socket (host-to-hbo host) port :datagram + :local-host (if local-host + (host-to-hbo local-host)) + :local-port local-port))) + (progn + (setf socket (with-mapped-conditions (socket) + (ext:create-inet-socket :datagram))) + (when (and local-host local-port) + (with-mapped-conditions (socket) + (ext:bind-inet-socket socket local-host local-port))))) + (let ((usocket (make-datagram-socket socket))) + (ext:finalize usocket #'(lambda () (unless (%closed-p usocket) + (ext:close-socket socket)))) + usocket)))))) (defun socket-listen (host port &key reuseaddress @@ -119,6 +142,24 @@ (with-mapped-conditions (usocket) (ext:close-socket (socket usocket)))) +(defmethod socket-close :after ((socket datagram-usocket)) + (setf (%closed-p socket) t)) + +(defmethod socket-send ((usocket datagram-usocket) buffer length &key address port) + (with-mapped-conditions (usocket) + (ext:inet-sendto (socket usocket) buffer length (if address (host-to-hbo address)) port))) + +(defmethod socket-receive ((usocket datagram-usocket) buffer length) + (let ((real-buffer (or buffer + (make-array length :element-type '(unsigned-byte 8)))) + (real-length (or length + (length buffer)))) + (multiple-value-bind (nbytes remote-host remote-port) + (with-mapped-conditions (usocket) + (ext:inet-recvfrom (socket usocket) real-buffer real-length)) + (when (plusp nbytes) + (values real-buffer nbytes remote-host remote-port))))) + (defmethod get-local-name ((usocket usocket)) (multiple-value-bind (address port) Modified: usocket/branches/experimental-udp/backend/lispworks.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/lispworks.lisp (original) +++ usocket/branches/experimental-udp/backend/lispworks.lisp Fri Oct 3 08:49:40 2008 @@ -73,7 +73,7 @@ (declare (ignore host port err-msg)) (raise-usock-err errno socket condition))))) -(defun socket-connect (host port &key (element-type 'base-char) +(defun socket-connect (host port &key (protocol :tcp) (element-type 'base-char) timeout deadline (nodelay t nodelay-specified) local-host local-port) (declare (ignorable nodelay)) @@ -87,23 +87,36 @@ (unsupported 'local-host 'socket-connect :minimum "LispWorks 5.0+ (verified)") (unsupported 'local-port 'socket-connect :minimum "LispWorks 5.0+ (verified)")) - (let ((hostname (host-to-hostname host)) - (stream)) - (setf stream - (with-mapped-conditions () - (comm:open-tcp-stream hostname port - :element-type element-type - #-lispworks4 #-lispworks4 - #-lispworks4 #-lispworks4 - :local-address (when local-host (host-to-hostname local-host)) - :local-port local-port - #+(and (not lispworks4) (not lispworks5.0)) - #+(and (not lispworks4) (not lispworks5.0)) - :nodelay nodelay))) - (if stream - (make-stream-socket :socket (comm:socket-stream-socket stream) - :stream stream) - (error 'unknown-error)))) + (ecase protocol + (:tcp (let ((hostname (host-to-hostname host)) + (stream)) + (setf stream + (with-mapped-conditions () + (comm:open-tcp-stream hostname port + :element-type element-type + #-lispworks4 #-lispworks4 + #-lispworks4 #-lispworks4 + :local-address (when local-host (host-to-hostname local-host)) + :local-port local-port + #+(and (not lispworks4) (not lispworks5.0)) + #+(and (not lispworks4) (not lispworks5.0)) + :nodelay nodelay))) + (if stream + (make-stream-socket :socket (comm:socket-stream-socket stream) + :stream stream) + (error 'unknown-error)))) + (:udp (let ((usocket (make-datagram-socket + (if (and host port) + (comm:connect-to-udp-server host port + :errorp t + :local-address local-host + :local-port local-port) + (comm:open-udp-socket :errorp t + :local-address local-host + :local-port local-port)) + :connected-p t))) + (hcl:flag-special-free-action usocket) + usocket)))) (defun socket-listen (host port &key reuseaddress @@ -152,6 +165,27 @@ (with-mapped-conditions (usocket) (comm::close-socket (socket usocket)))) +(defmethod socket-close :after ((socket datagram-usocket)) + "Additional socket-close method for datagram-usocket" + (setf (%closed-p socket) t)) + +;; Register a special free action for closing datagram usocket when being GCed +(defun usocket-special-free-action (object) + (when (and (typep object 'datagram-usocket) + (not (closed-p object))) + (socket-close object))) + +(eval-when (:load-toplevel :execute) + (hcl:add-special-free-action 'usocket-special-free-action)) + +(defmethod socket-send ((socket datagram-usocket) buffer length &key address port) + (let ((s (socket socket))) + (comm:send-message s buffer length address port))) + +(defmethod socket-receive ((socket datagram-usocket) buffer length) + (let ((s (socket socket))) + (comm:receive-message s buffer length))) + (defmethod get-local-name ((usocket usocket)) (multiple-value-bind (address port) Modified: usocket/branches/experimental-udp/backend/openmcl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/openmcl.lisp (original) +++ usocket/branches/experimental-udp/backend/openmcl.lisp Fri Oct 3 08:49:40 2008 @@ -74,21 +74,36 @@ :text :binary)) -(defun socket-connect (host port &key (element-type 'character) timeout deadline nodelay +(defun socket-connect (host port &key (protocol :tcp) (element-type 'character) + timeout deadline nodelay local-host local-port) (with-mapped-conditions () - (let ((mcl-sock - (openmcl-socket:make-socket :remote-host (host-to-hostname host) - :remote-port port - :local-host (when local-host (host-to-hostname local-host)) - :local-port local-port - :format (to-format element-type) - :deadline deadline - :nodelay nodelay - :connect-timeout (and timeout - (* timeout internal-time-units-per-second))))) - (openmcl-socket:socket-connect mcl-sock) - (make-stream-socket :stream mcl-sock :socket mcl-sock)))) + (ecase protocol + (:tcp + (let ((mcl-sock + (openmcl-socket:make-socket :remote-host (host-to-hostname host) + :remote-port port + :local-host (when local-host (host-to-hostname local-host)) + :local-port local-port + :format (to-format element-type) + :deadline deadline + :nodelay nodelay + :connect-timeout (and timeout + (* timeout internal-time-units-per-second))))) + (openmcl-socket:socket-connect mcl-sock) + (make-stream-socket :stream mcl-sock :socket mcl-sock))) + (:udp + (let ((mcl-sock + (openmcl-socket:make-socket :address-family :internet + :type :datagram + :local-host (if local-host + (host-to-hbo local-host)) + :local-port local-port))) + (when (and host port) + (ccl::inet-connect (ccl::socket-device mcl-sock) + (ccl::host-as-inet-host host) + (ccl::port-as-inet-port port "udp"))) + (make-datagram-socket mcl-sock)))))) (defun socket-listen (host port &key reuseaddress @@ -122,6 +137,16 @@ (with-mapped-conditions (usocket) (close (socket usocket)))) +(defmethod socket-send ((usocket datagram-usocket) buffer length &key address port) + (with-mapped-conditions (usocket) + (openmcl-socket:send-to (socket usocket) buffer length + :remote-host (if address (host-to-hbo address)) + :remote-port port))) + +(defmethod socket-receive ((usocket datagram-usocket) buffer length) + (with-mapped-conditions (usocket) + (openmcl-socket:receive-from (socket usocket) length :buffer buffer))) + (defmethod get-local-address ((usocket usocket)) (hbo-to-vector-quad (openmcl-socket:local-host (socket usocket)))) Modified: usocket/branches/experimental-udp/backend/sbcl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/sbcl.lisp (original) +++ usocket/branches/experimental-udp/backend/sbcl.lisp Fri Oct 3 08:49:40 2008 @@ -199,8 +199,7 @@ (if usock-cond (signal usock-cond :socket socket)))))) - -(defun socket-connect (host port &key (element-type 'character) +(defun socket-connect (host port &key (protocol :tcp) (element-type 'character) timeout deadline (nodelay t nodelay-specified) local-host local-port) (when deadline (unsupported 'deadline 'socket-connect)) @@ -214,28 +213,38 @@ (unsupported 'nodelay 'socket-connect)) (let ((socket (make-instance 'sb-bsd-sockets:inet-socket - :type :stream :protocol :tcp))) + :type (cdr (assoc protocol +protocol-map+)) + :protocol protocol))) (handler-case - (let* ((stream - (sb-bsd-sockets:socket-make-stream socket - :input t - :output t - :buffering :full - :element-type element-type)) - ;;###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)) - (setf (sb-bsd-sockets:sockopt-tcp-nodelay socket) nodelay)) - (when (or local-host local-port) - (sb-bsd-sockets:socket-bind socket - (host-to-vector-quad - (or local-host *wildcard-host*)) - (or local-port *auto-port*))) - (with-mapped-conditions (usocket) - (sb-bsd-sockets:socket-connect socket ip port)) - usocket) + (ecase protocol + (:tcp (let* ((stream + (sb-bsd-sockets:socket-make-stream socket + :input t + :output t + :buffering :full + :element-type element-type)) + ;;###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)) + (setf (sb-bsd-sockets:sockopt-tcp-nodelay socket) nodelay)) + (when (or local-host local-port) + (sb-bsd-sockets:socket-bind socket + (host-to-vector-quad + (or local-host *wildcard-host*)) + (or local-port *auto-port*))) + (with-mapped-conditions (usocket) + (sb-bsd-sockets:socket-connect socket ip port)) + usocket)) + (:udp (progn + (when (and local-host local-port) + (sb-bsd-sockets:socket-bind socket + (host-to-vector-quad local-host) + local-port)) + (when (and host port) + (sb-bsd-sockets:socket-connect socket (host-to-hbo host) port)) + (make-datagram-socket socket)))) (t (c) ;; Make sure we don't leak filedescriptors (sb-bsd-sockets:socket-close socket) @@ -287,6 +296,18 @@ (with-mapped-conditions (usocket) (close (socket-stream usocket)))) +(defmethod socket-send ((socket datagram-usocket) buffer length &key address port) + (with-mapped-conditions (socket) + (let* ((s (socket socket)) + (dest (if (and address port) (list (host-to-vector-quad address) port) nil))) + (sb-bsd-sockets:socket-send s buffer length :address dest)))) + +(defmethod socket-receive ((socket datagram-usocket) buffer length + &key (element-type '(unsigned-byte 8))) + (with-mapped-conditions (socket) + (let ((s (socket socket))) + (sb-bsd-sockets:socket-receive s buffer length :element-type element-type)))) + (defmethod get-local-name ((usocket usocket)) (sb-bsd-sockets:socket-name (socket usocket))) Modified: usocket/branches/experimental-udp/condition.lisp ============================================================================== --- usocket/branches/experimental-udp/condition.lisp (original) +++ usocket/branches/experimental-udp/condition.lisp Fri Oct 3 08:49:40 2008 @@ -197,4 +197,44 @@ :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)) + +;;; binghe: socket-warning for UDP retransmit support + +(define-condition socket-warning (socket-condition warning) + () ;; no slots (yet) + (:documentation "Parent warning for all socket related warnings")) + +(define-condition rtt-timeout-warning (socket-warning) + ((old-rto :type short-float + :reader old-rto-of + :initarg :old-rto) + (new-rto :type short-float + :reader new-rto-of + :initarg :new-rto)) + (:report (lambda (condition stream) + (format stream "Receive timeout (~As), next: ~As.~%" + (old-rto-of condition) + (new-rto-of condition)))) + (:documentation "RTT timeout warning")) + +(define-condition rtt-seq-mismatch-warning (socket-warning) + ((send-seq :type integer + :reader send-seq-of + :initarg :send-seq) + (recv-seq :type integer + :reader recv-seq-of + :initarg :recv-seq)) + (:report (lambda (condition stream) + (format stream "Sequence number mismatch (~A -> ~A), try read again.~%" + (send-seq-of condition) + (recv-seq-of condition)))) + (:documentation "RTT sequence mismatch warning")) + +(define-condition rtt-timeout-error (socket-error) + () + (:report (lambda (condition stream) + (declare (ignore condition)) + (format stream "Max retransmit times (~A) reached, give up.~%" + *rtt-maxnrexmt*))) + (:documentation "RTT timeout error")) Modified: usocket/branches/experimental-udp/package.lisp ============================================================================== --- usocket/branches/experimental-udp/package.lisp (original) +++ usocket/branches/experimental-udp/package.lisp Fri Oct 3 08:49:40 2008 @@ -11,6 +11,9 @@ (:export #:*wildcard-host* #:*auto-port* + #:*remote-host* ; special variables (udp) + #:*remote-port* + #:socket-connect ; socket constructors and methods #:socket-listen #:socket-accept @@ -22,6 +25,11 @@ #:get-local-name #:get-peer-name + #:socket-send ; udp function (send) + #:socket-receive ; udp function (receive) + #:socket-sync ; udp client (high-level) + #:socket-server ; udp server + #:wait-for-input ; waiting for input-ready state (select() like) #:make-wait-list #:add-waiter @@ -65,6 +73,7 @@ #:ns-unknown-condition #:unknown-error #:ns-unknown-error + #:socket-warning ; warnings (udp) #:insufficient-implementation ; conditions regarding usocket support level #:unsupported Added: usocket/branches/experimental-udp/rtt-client.lisp ============================================================================== --- (empty file) +++ usocket/branches/experimental-udp/rtt-client.lisp Fri Oct 3 08:49:40 2008 @@ -0,0 +1,50 @@ +;;;; $Id$ +;;;; $URL$ + +(in-package :usocket) + +(defun default-rtt-function (message) (values message 0)) + +(defmethod socket-sync ((socket datagram-usocket) message &key address port + (max-receive-length +max-datagram-packet-size+) + (encode-function #'default-rtt-function) + (decode-function #'default-rtt-function)) + (rtt-newpack socket) + (multiple-value-bind (data send-seq) (funcall encode-function message) + (let ((data-length (length data))) + (loop + with send-ts = (rtt-ts socket) + and recv-message = nil + and recv-seq = -1 + and continue-p = t + do (progn + (socket-send socket data data-length :address address :port port) + (multiple-value-bind (sockets real-time) + (wait-for-input socket :timeout (rtt-start socket)) + (declare (ignore sockets)) + (if real-time + ;; message received + (loop + do (multiple-value-setq (recv-message recv-seq) + (funcall decode-function + (socket-receive socket nil max-receive-length))) + until (or (= recv-seq send-seq) + (warn 'rtt-seq-mismatch-warning + :socket socket + :send-seq send-seq + :recv-seq recv-seq)) + finally (let ((recv-ts (rtt-ts socket))) + (rtt-stop socket (- recv-ts send-ts)) + (return nil))) + ;; message not received + (let ((old-rto (slot-value socket 'rto))) + (setf continue-p (rtt-timeout socket)) + (warn 'rtt-timeout-warning + :socket socket + :old-rto old-rto + :new-rto (slot-value socket 'rto)) + (unless continue-p + (error 'rtt-timeout-error) + (rtt-init socket)))))) + until (or recv-message (not continue-p)) + finally (return recv-message))))) Added: usocket/branches/experimental-udp/rtt.lisp ============================================================================== --- (empty file) +++ usocket/branches/experimental-udp/rtt.lisp Fri Oct 3 08:49:40 2008 @@ -0,0 +1,80 @@ +;;;; $Id$ +;;;; $URL$ + +;;;; UDP retransmit support by Chun Tian (binghe) +;;;; See the LICENSE file for licensing information. + +(in-package :usocket) + +;;; UNIX Network Programming v1 - Networking APIs: Sockets and XTI +;;; Chapter 20: Advance UDP Sockets +;;; Adding Reliability to a UDP Application + +(defclass rtt-info-mixin () + ((rtt :type short-float + :documentation "most recent measured RTT, seconds") + (srtt :type short-float + :documentation "smoothed RTT estimator, seconds") + (rttvar :type short-float + :documentation "smoothed mean deviation, seconds") + (rto :type short-float + :documentation "current RTO to use, seconds") + (nrexmt :type fixnum + :documentation "#times retransmitted: 0, 1, 2, ...") + (base :type integer + :documentation "#sec since 1/1/1970 at start, but we use Lisp time here")) + (:documentation "RTT Info Class")) + +(defvar *rtt-rxtmin* 2.0 "min retransmit timeout value, seconds") +(defvar *rtt-rxtmax* 60.0 "max retransmit timeout value, seconds") +(defvar *rtt-maxnrexmt* 3 "max #times to retransmit") + +(defmethod rtt-rtocalc ((instance rtt-info-mixin)) + "Calculate the RTO value based on current estimators: + smoothed RTT plus four times the deviation." + (with-slots (srtt rttvar) instance + (+ srtt (* 4.0 rttvar)))) + +(defun rtt-minmax (rto) + "rtt-minmax makes certain that the RTO is between the upper and lower limits." + (declare (type short-float rto)) + (cond ((< rto *rtt-rxtmin*) *rtt-rxtmin*) + ((> rto *rtt-rxtmax*) *rtt-rxtmax*) + (t rto))) + +(defmethod initialize-instance :after ((instance rtt-info-mixin) &rest initargs + &key &allow-other-keys) + (declare (ignore initargs)) + (rtt-init instance)) + +(defmethod rtt-init ((instance rtt-info-mixin)) + (with-slots (base rtt srtt rttvar rto) instance + (setf base (get-internal-real-time) + rtt 0.0 + srtt 0.0 + rttvar 0.75 + rto (rtt-minmax (rtt-rtocalc instance))))) + +(defmethod rtt-ts ((instance rtt-info-mixin)) + (* (- (get-internal-real-time) (slot-value instance 'base)) + #.(/ 1000 internal-time-units-per-second))) + +(defmethod rtt-start ((instance rtt-info-mixin)) + "return value can be used as: alarm(rtt_start(&foo))" + (round (slot-value instance 'rto))) + +(defmethod rtt-stop ((instance rtt-info-mixin) (ms number)) + (with-slots (rtt srtt rttvar rto) instance + (setf rtt (/ ms 1000.0)) + (let ((delta (- rtt srtt))) + (incf srtt (/ delta 8.0)) + (incf rttvar (/ (- (abs delta) rttvar) 4.0))) + (setf rto (rtt-minmax (rtt-rtocalc instance))))) + +(defmethod rtt-timeout ((instance rtt-info-mixin)) + (with-slots (rto nrexmt) instance + (setf rto (* rto 2.0)) + (< (incf nrexmt) *rtt-maxnrexmt*))) + +(defmethod rtt-newpack ((instance rtt-info-mixin)) + (setf (slot-value instance 'nrexmt) 0)) Added: usocket/branches/experimental-udp/server.lisp ============================================================================== --- (empty file) +++ usocket/branches/experimental-udp/server.lisp Fri Oct 3 08:49:40 2008 @@ -0,0 +1,43 @@ +;;;; $Id$ +;;;; $URL$ + +(in-package :usocket) + +(defvar *remote-host*) +(defvar *remote-port*) + +(defun socket-server (host port function &optional arguments + &key (element-type '(unsigned-byte 8)) (timeout 1) + (max-buffer-size +max-datagram-packet-size+)) + (let ((socket (socket-connect nil nil + :protocol :udp + :local-host host + :local-port port + :element-type element-type)) + (buffer (make-array max-buffer-size + :element-type '(unsigned-byte 8) + :initial-element 0))) + (unwind-protect + (loop (progn + (multiple-value-bind (sockets real-time) + (wait-for-input socket :timeout timeout) + (declare (ignore sockets)) + (when real-time + (multiple-value-bind (recv n *remote-host* *remote-port*) + (socket-receive socket buffer max-buffer-size) + (declare (ignore recv)) + (if (plusp n) + (progn + (let ((reply + (apply function + (cons (subseq buffer 0 n) arguments)))) + (when reply + (replace buffer reply) + (let ((n (socket-send socket buffer (length reply) + :address *remote-host* + :port *remote-port*))) + (when (minusp n) + (error "send error: ~A~%" n)))))) + (error "receive error: ~A" n)))) + #+(and cmu mp) (mp:process-yield)))) + (socket-close socket)))) Modified: usocket/branches/experimental-udp/usocket.asd ============================================================================== --- usocket/branches/experimental-udp/usocket.asd (original) +++ usocket/branches/experimental-udp/usocket.asd Fri Oct 3 08:49:40 2008 @@ -1,4 +1,4 @@ - +;;;; -*- Mode: Lisp -*- ;;;; $Id$ ;;;; $URL$ @@ -18,26 +18,26 @@ :licence "MIT" :description "Universal socket library for Common Lisp" :depends-on (:split-sequence - #+sbcl :sb-bsd-sockets) + #+sbcl :sb-bsd-sockets + #+lispworks :lispworks-udp) :components ((:file "package") + (:file "rtt" + :depends-on ("package")) (:file "usocket" - :depends-on ("package")) + :depends-on ("package" "rtt")) (:file "condition" - :depends-on ("usocket")) - #+clisp (:file "clisp" :pathname "backend/clisp" - :depends-on ("condition")) - #+cmu (:file "cmucl" :pathname "backend/cmucl" - :depends-on ("condition")) - #+scl (:file "scl" :pathname "backend/scl" - :depends-on ("condition")) - #+(or sbcl ecl) (:file "sbcl" :pathname "backend/sbcl" - :depends-on ("condition")) - #+lispworks (:file "lispworks" :pathname "backend/lispworks" - :depends-on ("condition")) - #+openmcl (:file "openmcl" :pathname "backend/openmcl" - :depends-on ("condition")) - #+allegro (:file "allegro" :pathname "backend/allegro" - :depends-on ("condition")) - #+armedbear (:file "armedbear" :pathname "backend/armedbear" - :depends-on ("condition")) - )) + :depends-on ("usocket" "rtt")) + (:module "backend" + :components (#+clisp (:file "clisp") + #+cmu (:file "cmucl") + #+scl (:file "scl") + #+(or sbcl ecl) (:file "sbcl") + #+lispworks (:file "lispworks") + #+openmcl (:file "openmcl") + #+allegro (:file "allegro") + #+armedbear (:file "armedbear")) + :depends-on ("condition")) + (:file "rtt-client" + :depends-on ("rtt" "backend" "condition")) + (:file "server" + :depends-on ("backend")))) Modified: usocket/branches/experimental-udp/usocket.lisp ============================================================================== --- usocket/branches/experimental-udp/usocket.lisp (original) +++ usocket/branches/experimental-udp/usocket.lisp Fri Oct 3 08:49:40 2008 @@ -11,6 +11,9 @@ (defparameter *auto-port* 0 "Port number to pass when an auto-assigned port number is wanted.") +(defconstant +max-datagram-packet-size+ 65536) +(defconstant +protocol-map+ '((:tcp . :stream) (:udp . :datagram))) + (defclass usocket () ((socket :initarg :socket @@ -82,10 +85,17 @@ (:documentation "Socket which listens for stream connections to be initiated from remote sockets.")) -(defclass datagram-usocket (usocket) - ((connected-p :initarg :connected-p :accessor connected-p)) -;; ###FIXME: documentation to be added. - (:documentation "")) +(defclass datagram-usocket (usocket rtt-info-mixin) + ((connected-p :type boolean + :accessor connected-p + :initarg :connected-p) + #+(or cmu lispworks) + (%closed-p :type boolean + :accessor %closed-p + :initform nil + :documentation "Flag to indicate if this usocket is closed, +for GC on LispWorks/CMUCL")) + (:documentation "UDP (inet-datagram) socket")) (defun usocket-p (socket) (typep socket 'usocket)) From ctian at common-lisp.net Mon Oct 13 02:05:30 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Mon, 13 Oct 2008 02:05:30 +0000 Subject: [usocket-cvs] r431 - in usocket/branches/experimental-udp: . backend Message-ID: Author: ctian Date: Mon Oct 13 02:05:28 2008 New Revision: 431 Log: [udp] use :datagram instead of :udp, extend HOST-TO-HBO to support NIL Modified: usocket/branches/experimental-udp/backend/allegro.lisp usocket/branches/experimental-udp/backend/cmucl.lisp usocket/branches/experimental-udp/backend/openmcl.lisp usocket/branches/experimental-udp/backend/sbcl.lisp usocket/branches/experimental-udp/package.lisp usocket/branches/experimental-udp/server.lisp usocket/branches/experimental-udp/usocket.lisp Modified: usocket/branches/experimental-udp/backend/allegro.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/allegro.lisp (original) +++ usocket/branches/experimental-udp/backend/allegro.lisp Mon Oct 13 02:05:28 2008 @@ -64,7 +64,7 @@ (labels ((make-socket () (socket:make-socket :remote-host (host-to-hostname host) :remote-port port - :local-host (when local-host (host-to-hostname local-host)) + :local-host (host-to-hostname local-host) :local-port local-port :format (to-format element-type) :nodelay nodelay))) @@ -79,13 +79,13 @@ :connect :active :remote-host (host-to-hostname host) :remote-port port - :local-host (when local-host (host-to-hostname local-host)) + :local-host (host-to-hostname local-host) :local-port local-port :format (to-format element-type)) (socket:make-socket :type :datagram :address-family :internet :local-host local-host - :local-port (when local-host (host-to-hostname local-host)) + :local-port (host-to-hostname local-host) :format (to-format element-type))))))) (ecase protocol (:stream Modified: usocket/branches/experimental-udp/backend/cmucl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/cmucl.lisp (original) +++ usocket/branches/experimental-udp/backend/cmucl.lisp Mon Oct 13 02:05:28 2008 @@ -67,8 +67,7 @@ (setf socket (with-mapped-conditions (socket) (ext:connect-to-inet-socket (host-to-hbo host) port :stream - :local-host (if local-host - (host-to-hbo local-host)) + :local-host (host-to-hbo local-host) :local-port local-port))) (if socket (let* ((stream (sys:make-fd-stream socket :input t :output t @@ -84,8 +83,7 @@ (if (and host port) (setf socket (with-mapped-conditions (socket) (ext:connect-to-inet-socket (host-to-hbo host) port :datagram - :local-host (if local-host - (host-to-hbo local-host)) + :local-host (host-to-hbo local-host) :local-port local-port))) (progn (setf socket (with-mapped-conditions (socket) Modified: usocket/branches/experimental-udp/backend/openmcl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/openmcl.lisp (original) +++ usocket/branches/experimental-udp/backend/openmcl.lisp Mon Oct 13 02:05:28 2008 @@ -81,9 +81,9 @@ (ecase protocol (:stream (let ((mcl-sock - (openmcl-socket:make-socket :remote-host (host-to-hostname host) + (openmcl-socket:make-socket :remote-host (host-to-hbo host) :remote-port port - :local-host (when local-host (host-to-hostname local-host)) + :local-host (host-to-hbo local-host) :local-port local-port :format (to-format element-type) :deadline deadline @@ -96,8 +96,7 @@ (let ((mcl-sock (openmcl-socket:make-socket :address-family :internet :type :datagram - :local-host (if local-host - (host-to-hbo local-host)) + :local-host (host-to-hbo local-host) :local-port local-port))) (when (and host port) (ccl::inet-connect (ccl::socket-device mcl-sock) @@ -140,7 +139,7 @@ (defmethod socket-send ((usocket datagram-usocket) buffer length &key address port) (with-mapped-conditions (usocket) (openmcl-socket:send-to (socket usocket) buffer length - :remote-host (if address (host-to-hbo address)) + :remote-host (host-to-hbo address) :remote-port port))) (defmethod socket-receive ((usocket datagram-usocket) buffer length) Modified: usocket/branches/experimental-udp/backend/sbcl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/sbcl.lisp (original) +++ usocket/branches/experimental-udp/backend/sbcl.lisp Mon Oct 13 02:05:28 2008 @@ -240,10 +240,11 @@ (sb-bsd-sockets:socket-connect socket ip port)) usocket)) (:datagram - (when (and local-host local-port) + (when (or local-host local-port) (sb-bsd-sockets:socket-bind socket - (host-to-vector-quad local-host) - local-port)) + (host-to-vector-quad + (or local-host *wildcard-host*)) + (or local-port *auto-port*))) (when (and host port) (sb-bsd-sockets:socket-connect socket (host-to-hbo host) port)) (make-datagram-socket socket))) Modified: usocket/branches/experimental-udp/package.lisp ============================================================================== --- usocket/branches/experimental-udp/package.lisp (original) +++ usocket/branches/experimental-udp/package.lisp Mon Oct 13 02:05:28 2008 @@ -80,25 +80,4 @@ #:insufficient-implementation ; conditions regarding usocket support level #:unsupported - #:unimplemented) - - #+lispworks - (:import-from :comm - #:*socket_af_inet* - #:*socket_pf_unspec* - #:*sockopt_sol_socket* - #:%send - #:bind - #:close-socket - #:connect - #:getsockopt - #:in_addr - #:initialize-sockaddr_in - #:ntohl - #:ntohs - #:s_addr - #:setsockopt - #:sin_addr - #:sin_port - #:sockaddr - #:sockaddr_in)) + #:unimplemented)) Modified: usocket/branches/experimental-udp/server.lisp ============================================================================== --- usocket/branches/experimental-udp/server.lisp (original) +++ usocket/branches/experimental-udp/server.lisp Mon Oct 13 02:05:28 2008 @@ -10,7 +10,7 @@ &key (element-type '(unsigned-byte 8)) (timeout 1) (max-buffer-size +max-datagram-packet-size+)) (let ((socket (socket-connect nil nil - :protocol :udp + :protocol :datagram :local-host host :local-port port :element-type element-type)) Modified: usocket/branches/experimental-udp/usocket.lisp ============================================================================== --- usocket/branches/experimental-udp/usocket.lisp (original) +++ usocket/branches/experimental-udp/usocket.lisp Mon Oct 13 02:05:28 2008 @@ -407,6 +407,7 @@ (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))) @@ -460,6 +461,7 @@ (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))) From ctian at common-lisp.net Mon Oct 20 07:33:51 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Mon, 20 Oct 2008 07:33:51 +0000 Subject: [usocket-cvs] r432 - in usocket/branches/experimental-udp: . backend Message-ID: Author: ctian Date: Mon Oct 20 07:33:49 2008 New Revision: 432 Log: [udp] add SCL support, untested. Modified: usocket/branches/experimental-udp/backend/cmucl.lisp usocket/branches/experimental-udp/backend/scl.lisp usocket/branches/experimental-udp/rtt-client.lisp usocket/branches/experimental-udp/usocket.lisp Modified: usocket/branches/experimental-udp/backend/cmucl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/cmucl.lisp (original) +++ usocket/branches/experimental-udp/backend/cmucl.lisp Mon Oct 20 07:33:49 2008 @@ -80,21 +80,24 @@ (let ((err (unix:unix-errno))) (when err (cmucl-map-socket-error err))))) (:datagram - (if (and host port) - (setf socket (with-mapped-conditions (socket) - (ext:connect-to-inet-socket (host-to-hbo host) port :datagram - :local-host (host-to-hbo local-host) - :local-port local-port))) - (progn - (setf socket (with-mapped-conditions (socket) - (ext:create-inet-socket :datagram))) - (when (and local-host local-port) - (with-mapped-conditions (socket) - (ext:bind-inet-socket socket local-host local-port))))) - (let ((usocket (make-datagram-socket socket))) - (ext:finalize usocket #'(lambda () (when (%open-p usocket) - (ext:close-socket socket)))) - usocket))))) + (setf socket + (if (and host port) + (with-mapped-conditions (socket) + (ext:connect-to-inet-socket (host-to-hbo host) port :datagram + :local-host (host-to-hbo local-host) + :local-port local-port)) + (if (or local-host local-port) + (with-mapped-conditions (socket) + (ext:create-inet-listener (or local-port 0) :datagram :host local-host)) + (with-mapped-conditoins (socket) + (ext:create-inet-socket :datagram))))) + (if socket + (let ((usocket (make-datagram-socket socket))) + (ext:finalize usocket #'(lambda () (when (%open-p usocket) + (ext:close-socket socket)))) + usocket) + (let ((err (unix:unix-errno))) + (when err (cmucl-map-socket-error err)))))))) (defun socket-listen (host port &key reuseaddress Modified: usocket/branches/experimental-udp/backend/scl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/scl.lisp (original) +++ usocket/branches/experimental-udp/backend/scl.lisp Mon Oct 20 07:33:49 2008 @@ -28,7 +28,7 @@ :socket socket :condition condition)))) -(defun socket-connect (host port &key (element-type 'character) +(defun socket-connect (host port &key (protocol :stream) (element-type 'character) timeout deadline (nodelay t nodelay-specified) local-host local-port) (declare (ignore nodelay)) @@ -39,13 +39,41 @@ (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))) - (stream (sys:make-fd-stream socket :input t :output t - :element-type element-type - :buffering :full))) - (make-stream-socket :socket socket :stream stream))) + (let ((socket)) + (ecase protocol + (:stream + (setf socket (with-mapped-conditions () + (ext:connect-to-inet-socket (host-to-hbo host) port + :kind :stream + #+ignore #+ignore + #+ignore #+ignore + :local-host (if local-host + (host-to-hbo local-host)) + :local-port local-port))) + (let ((stream (sys:make-fd-stream socket :input t :output t + :element-type element-type + :buffering :full))) + (make-stream-socket :socket socket :stream stream))) + (:datagram + (setf socket + (if (and host port) + (with-mapped-conditions () + (ext:connect-to-inet-socket (host-to-hbo host) port + :kind :datagram + :local-host (host-to-hbo local-host) + :local-port local-port)) + (if (or local-port local-port) + (with-mapped-conditions () + (ext:create-inet-listener (or local-port 0) + :datagram + :host local-host)) + (with-mapped-conditions () + (ext:create-inet-socket :datagram))))) + (let ((usocket (make-datagram-socket socket))) + (ext:finalize usocket #'(lambda () + (when (%open-p usocket) + (ext:close-socket socket)))) + usocket))))) (defun socket-listen (host port &key reuseaddress @@ -91,6 +119,33 @@ (with-mapped-conditions (usocket) (close (socket-stream usocket)))) +(defmethod socket-close :after ((socket datagram-usocket)) + (setf (%open-p socket) nil)) + +(defmethod socket-send ((socket datagram-usocket) buffer length &key address port) + (let ((s (socket socket)) + (address (if address (host-to-hbo address)))) + (multiple-value-bind (result errno) + (ext:inet-socket-send-to s buffer length + :remote-host address :remote-port port) + (unless result + (error "~@" s + (unix:get-unix-error-msg errno))) + result))) + +(defmethod socket-receive ((socket datagram-usocket) buffer length) + (let ((s (socket socket))) + (let ((real-buffer (or buffer + (make-array length :element-type '(unsigned-byte 8)))) + (real-length (or length + (length buffer)))) + (multiple-value-bind (result errno remote-host remote-port) + (ext:inet-socket-receive-from s real-buffer real-length) + (unless result + (error "~@" s + (unix:get-unix-error-msg errno))) + (values real-buffer result remote-host remote-port))))) + (defmethod get-local-name ((usocket usocket)) (multiple-value-bind (address port) (with-mapped-conditions (usocket) Modified: usocket/branches/experimental-udp/rtt-client.lisp ============================================================================== --- usocket/branches/experimental-udp/rtt-client.lisp (original) +++ usocket/branches/experimental-udp/rtt-client.lisp Mon Oct 20 07:33:49 2008 @@ -44,7 +44,7 @@ :old-rto old-rto :new-rto (slot-value socket 'rto)) (unless continue-p - (error 'rtt-timeout-error) - (rtt-init socket)))))) + (rtt-init socket) + (error 'rtt-timeout-error)))))) until (or recv-message (not continue-p)) finally (return recv-message))))) Modified: usocket/branches/experimental-udp/usocket.lisp ============================================================================== --- usocket/branches/experimental-udp/usocket.lisp (original) +++ usocket/branches/experimental-udp/usocket.lisp Mon Oct 20 07:33:49 2008 @@ -88,12 +88,12 @@ ((connected-p :type boolean :accessor connected-p :initarg :connected-p) - #+(or cmu lispworks) + #+(or cmu scl lispworks) (%open-p :type boolean :accessor %open-p :initform t :documentation "Flag to indicate if usocket is open, -for GC on LispWorks/CMUCL")) +for GC on implementions operate on raw socket fd.")) (:documentation "UDP (inet-datagram) socket")) (defun usocket-p (socket) From ctian at common-lisp.net Mon Oct 20 07:40:44 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Mon, 20 Oct 2008 07:40:44 +0000 Subject: [usocket-cvs] r433 - usocket/branches/experimental-udp/backend Message-ID: Author: ctian Date: Mon Oct 20 07:40:43 2008 New Revision: 433 Log: [udp] minor fixes for CMUCL Modified: usocket/branches/experimental-udp/backend/cmucl.lisp Modified: usocket/branches/experimental-udp/backend/cmucl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/cmucl.lisp (original) +++ usocket/branches/experimental-udp/backend/cmucl.lisp Mon Oct 20 07:40:43 2008 @@ -89,7 +89,7 @@ (if (or local-host local-port) (with-mapped-conditions (socket) (ext:create-inet-listener (or local-port 0) :datagram :host local-host)) - (with-mapped-conditoins (socket) + (with-mapped-conditions (socket) (ext:create-inet-socket :datagram))))) (if socket (let ((usocket (make-datagram-socket socket))) @@ -248,5 +248,6 @@ (when (unix:fd-isset (socket x) rfds) (setf (state x) :READ))) (progn - ;;###FIXME generate an error, except for EINTR + ;;###FIXME generate an error, except for EINTR + (cmucl-map-socket-error err) ))))))) From ehuelsmann at common-lisp.net Mon Oct 20 22:14:12 2008 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 20 Oct 2008 22:14:12 +0000 Subject: [usocket-cvs] r434 - usocket/branches/0.4.x/backend Message-ID: Author: ehuelsmann Date: Mon Oct 20 22:14:12 2008 New Revision: 434 Log: Merge c428 from trunk: WAIT-FOR-INPUT without timeout (non-Win32). 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 Mon Oct 20 22:14:12 2008 @@ -216,15 +216,20 @@ ;; Can we have a sane -pref. complete [UDP!?]- API next time, please? (dolist (x (wait-list-waiters wait-list)) (mp:notice-fd (os-socket-handle x))) - (mp:process-wait-with-timeout "Waiting for a socket to become active" - (truncate timeout) - #'(lambda (socks) - (let (rv) - (dolist (x socks rv) - (when (usocket-listen x) - (setf (state x) :READ - rv t))))) - (wait-list-waiters wait-list)) + (labels ((wait-function (socks) + (let (rv) + (dolist (x socks rv) + (when (usocket-listen x) + (setf (state x) :READ + rv t)))))) + (if timeout + (mp:process-wait-with-timeout "Waiting for a socket to become active" + (truncate timeout) + #'wait-function + (wait-list-waiters wait-list)) + (mp:process-wait "Waiting for a socket to become active" + #'wait-function + (wait-list-waiters wait-list)))) (dolist (x (wait-list-waiters wait-list)) (mp:unnotice-fd (os-socket-handle x))) wait-list))) From ehuelsmann at common-lisp.net Mon Oct 20 22:18:00 2008 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 20 Oct 2008 22:18:00 +0000 Subject: [usocket-cvs] r435 - usocket/branches/0.4.x/backend Message-ID: Author: ehuelsmann Date: Mon Oct 20 22:17:59 2008 New Revision: 435 Log: Merge r418-423: Fix SBCL waiting backend. Modified: usocket/branches/0.4.x/backend/sbcl.lisp 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 Mon Oct 20 22:17:59 2008 @@ -330,7 +330,7 @@ (multiple-value-bind (count err) (sb-unix:unix-fast-select - (1+ (reduce #'max (mapcar #'socket (wait-list-waiters sockets)) + (1+ (reduce #'max (wait-list-%wait sockets) :key #'sb-bsd-sockets:socket-file-descriptor)) (sb-alien:addr rfds) nil nil (when timeout secs) musecs) @@ -340,9 +340,10 @@ (when (< 0 count) ;; process the result... (dolist (x (wait-list-waiters sockets)) - (when (not (sb-unix:fd-isset - (sb-bsd-sockets:socket-file-descriptor (socket x)) - rfds)) + (when (sb-unix:fd-isset + (sb-bsd-sockets:socket-file-descriptor + (socket x)) + rfds) (setf (state x) :READ)))))))))) #+win32 From ehuelsmann at common-lisp.net Mon Oct 20 22:21:08 2008 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 20 Oct 2008 22:21:08 +0000 Subject: [usocket-cvs] r436 - usocket/branches/0.4.x/backend Message-ID: Author: ehuelsmann Date: Mon Oct 20 22:21:08 2008 New Revision: 436 Log: Merge c424 from trunk: Stop leaking socket handles. Modified: usocket/branches/0.4.x/backend/sbcl.lisp 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 Mon Oct 20 22:21:08 2008 @@ -209,27 +209,33 @@ (not (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay))) (unsupported 'nodelay 'socket-connect)) - (let* ((socket (make-instance 'sb-bsd-sockets:inet-socket - :type :stream :protocol :tcp)) - (stream (sb-bsd-sockets:socket-make-stream socket - :input t - :output t - :buffering :full - :element-type element-type)) - ;;###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)) - (setf (sb-bsd-sockets:sockopt-tcp-nodelay socket) nodelay)) - (when (or local-host local-port) - (sb-bsd-sockets:socket-bind socket - (host-to-vector-quad - (or local-host *wildcard-host*)) - (or local-port *auto-port*))) - (with-mapped-conditions (usocket) - (sb-bsd-sockets:socket-connect socket ip port)) - usocket)) + (let ((socket (make-instance 'sb-bsd-sockets:inet-socket + :type :stream :protocol :tcp))) + (handler-case + (let* ((stream + (sb-bsd-sockets:socket-make-stream socket + :input t + :output t + :buffering :full + :element-type element-type)) + ;;###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)) + (setf (sb-bsd-sockets:sockopt-tcp-nodelay socket) nodelay)) + (when (or local-host local-port) + (sb-bsd-sockets:socket-bind socket + (host-to-vector-quad + (or local-host *wildcard-host*)) + (or local-port *auto-port*))) + (with-mapped-conditions (usocket) + (sb-bsd-sockets:socket-connect socket ip port)) + usocket) + (t (c) + ;; Make sure we don't leak filedescriptors + (sb-bsd-sockets:socket-close socket) + (error c))))) (defun socket-listen (host port &key reuseaddress @@ -240,11 +246,16 @@ (ip (host-to-vector-quad host)) (sock (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))) - (with-mapped-conditions () - (setf (sb-bsd-sockets:sockopt-reuse-address sock) reuseaddress) - (sb-bsd-sockets:socket-bind sock ip port) - (sb-bsd-sockets:socket-listen sock backlog) - (make-stream-server-socket sock :element-type element-type)))) + (handler-case + (with-mapped-conditions () + (setf (sb-bsd-sockets:sockopt-reuse-address sock) reuseaddress) + (sb-bsd-sockets:socket-bind sock ip port) + (sb-bsd-sockets:socket-listen sock backlog) + (make-stream-server-socket sock :element-type element-type)) + (t (c) + ;; Make sure we don't leak filedescriptors + (sb-bsd-sockets:socket-close sock) + (error c))))) (defmethod socket-accept ((socket stream-server-usocket) &key element-type) (with-mapped-conditions (socket) From ehuelsmann at common-lisp.net Tue Oct 21 09:59:53 2008 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Tue, 21 Oct 2008 09:59:53 +0000 Subject: [usocket-cvs] r437 - usocket/trunk Message-ID: Author: ehuelsmann Date: Tue Oct 21 09:59:52 2008 New Revision: 437 Log: Change the UNSUPPORTED macro to use CERROR instead of SIGNAL, for REPL users. Modified: usocket/trunk/condition.lisp Modified: usocket/trunk/condition.lisp ============================================================================== --- usocket/trunk/condition.lisp (original) +++ usocket/trunk/condition.lisp Tue Oct 21 09:59:52 2008 @@ -193,7 +193,7 @@ (defmacro unsupported (feature context &key minimum) - `(signal 'unsupported :feature ,feature + `(cerror 'unsupported :feature ,feature :context ,context :minimum ,minimum)) (defmacro unimplemented (feature context) From ehuelsmann at common-lisp.net Tue Oct 21 10:02:22 2008 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Tue, 21 Oct 2008 10:02:22 +0000 Subject: [usocket-cvs] r438 - usocket/branches/0.4.x Message-ID: Author: ehuelsmann Date: Tue Oct 21 10:02:22 2008 New Revision: 438 Log: Backport c437: Make UNSUPPORTED evaluate to a CERROR, for REPL users. 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 10:02:22 2008 @@ -193,7 +193,7 @@ (defmacro unsupported (feature context &key minimum) - `(signal 'unsupported :feature ,feature + `(cerror 'unsupported :feature ,feature :context ,context :minimum ,minimum)) (defmacro unimplemented (feature context) From ehuelsmann at common-lisp.net Tue Oct 21 12:25:54 2008 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Tue, 21 Oct 2008 12:25:54 +0000 Subject: [usocket-cvs] r439 - usocket/trunk/backend Message-ID: Author: ehuelsmann Date: Tue Oct 21 12:25:53 2008 New Revision: 439 Log: Report deadline errors as DEADLINE-ERROR instead of TIMEOUT-ERROR Modified: usocket/trunk/backend/openmcl.lisp Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Tue Oct 21 12:25:53 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)))) From ehuelsmann at common-lisp.net Tue Oct 21 12:27:45 2008 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Tue, 21 Oct 2008 12:27:45 +0000 Subject: [usocket-cvs] r440 - usocket/branches/0.4.x/backend Message-ID: 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)))) From ctian at common-lisp.net Tue Oct 21 13:30:18 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Tue, 21 Oct 2008 13:30:18 +0000 Subject: [usocket-cvs] r441 - usocket/branches/0.4.x/backend Message-ID: 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") From ctian at common-lisp.net Tue Oct 21 13:31:36 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Tue, 21 Oct 2008 13:31:36 +0000 Subject: [usocket-cvs] r442 - usocket/branches/0.4.x Message-ID: 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)) From ctian at common-lisp.net Tue Oct 21 13:34:39 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Tue, 21 Oct 2008 13:34:39 +0000 Subject: [usocket-cvs] r443 - in usocket/trunk: . backend Message-ID: 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)) From ctian at common-lisp.net Tue Oct 21 13:47:48 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Tue, 21 Oct 2008 13:47:48 +0000 Subject: [usocket-cvs] r444 - usocket/branches/experimental-udp Message-ID: 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))) From ctian at common-lisp.net Tue Oct 21 13:48:28 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Tue, 21 Oct 2008 13:48:28 +0000 Subject: [usocket-cvs] r445 - in usocket/branches/experimental-udp: . backend Message-ID: 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) From ctian at common-lisp.net Tue Oct 21 14:02:59 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Tue, 21 Oct 2008 14:02:59 +0000 Subject: [usocket-cvs] r446 - usocket/branches/0.4.x Message-ID: 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.")) From ctian at common-lisp.net Tue Oct 21 15:25:12 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Tue, 21 Oct 2008 15:25:12 +0000 Subject: [usocket-cvs] r447 - usocket/branches/0.4.x Message-ID: 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)) From ctian at common-lisp.net Tue Oct 21 19:18:03 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Tue, 21 Oct 2008 19:18:03 +0000 Subject: [usocket-cvs] r448 - in usocket/branches/0.4.x: . backend Message-ID: 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.")) From ctian at common-lisp.net Tue Oct 21 19:48:17 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Tue, 21 Oct 2008 19:48:17 +0000 Subject: [usocket-cvs] r449 - usocket/branches/0.4.x/backend Message-ID: 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 From ctian at common-lisp.net Wed Oct 22 01:07:48 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Wed, 22 Oct 2008 01:07:48 +0000 Subject: [usocket-cvs] r450 - usocket/branches/0.4.x/backend Message-ID: Author: ctian Date: Wed Oct 22 01:07:48 2008 New Revision: 450 Log: merge ECL document (r413) and build-fix for ECL (r427) from trunk. Modified: usocket/branches/0.4.x/backend/sbcl.lisp 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 Wed Oct 22 01:07:48 2008 @@ -50,6 +50,7 @@ "#include ") (ffi:clines + "#include " "#include ") #+:prefixed-api @@ -209,6 +210,10 @@ (when deadline (unsupported 'deadline 'socket-connect)) (when timeout (unsupported 'timeout 'socket-connect)) (when (and nodelay-specified + ;; 20080802: ECL added this function to its sockets + ;; 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 sockopt-tcp-nodelay-p)) (unsupported 'nodelay 'socket-connect)) From ctian at common-lisp.net Wed Oct 22 01:11:56 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Wed, 22 Oct 2008 01:11:56 +0000 Subject: [usocket-cvs] r451 - in usocket/trunk: . backend Message-ID: 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)) From ctian at common-lisp.net Wed Oct 22 07:18:08 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Wed, 22 Oct 2008 07:18:08 +0000 Subject: [usocket-cvs] r452 - usocket/branches/0.4.x Message-ID: Author: ctian Date: Wed Oct 22 07:18:07 2008 New Revision: 452 Log: Remove datagram-usocket from 0.4.x branch, we will support it in 0.5.x Modified: usocket/branches/0.4.x/package.lisp usocket/branches/0.4.x/usocket.lisp Modified: usocket/branches/0.4.x/package.lisp ============================================================================== --- usocket/branches/0.4.x/package.lisp (original) +++ usocket/branches/0.4.x/package.lisp Wed Oct 22 07:18:07 2008 @@ -38,7 +38,6 @@ #:stream-server-usocket #:socket #:socket-stream - #:datagram-usocket #:host-byte-order ; IP(v4) utility functions #:hbo-to-dotted-quad Modified: usocket/branches/0.4.x/usocket.lisp ============================================================================== --- usocket/branches/0.4.x/usocket.lisp (original) +++ usocket/branches/0.4.x/usocket.lisp Wed Oct 22 07:18:07 2008 @@ -82,11 +82,6 @@ (:documentation "Socket which listens for stream connections to be initiated from remote sockets.")) -(defclass datagram-usocket (usocket) - ((connected-p :initarg :connected-p :accessor connected-p)) -;; ###FIXME: documentation to be added. - (:documentation "")) - (defun usocket-p (socket) (typep socket 'usocket)) @@ -96,9 +91,6 @@ (defun stream-server-usocket-p (socket) (typep socket 'stream-server-usocket)) -(defun datagram-usocket-p (socket) - (typep socket 'datagram-usocket)) - (defun make-socket (&key socket) "Create a usocket socket type from implementation specific socket." (unless socket @@ -134,13 +126,6 @@ :socket socket :element-type element-type)) -(defun make-datagram-socket (socket &key connected-p) - (unless socket - (error 'invalid-socket-error)) - (make-instance 'datagram-usocket - :socket socket - :connected-p connected-p)) - (defgeneric socket-accept (socket &key element-type) (:documentation "Accepts a connection from `socket', returning a `stream-socket'. From ctian at common-lisp.net Wed Oct 22 07:21:50 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Wed, 22 Oct 2008 07:21:50 +0000 Subject: [usocket-cvs] r453 - usocket/branches/0.4.x/backend Message-ID: Author: ctian Date: Wed Oct 22 07:21:47 2008 New Revision: 453 Log: fix ABCL after datagram-usocket removed. Modified: usocket/branches/0.4.x/backend/armedbear.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 Wed Oct 22 07:21:47 2008 @@ -372,7 +372,7 @@ "java.nio.channels.SocketChannel") ((stream-server-usocket-p socket) "java.nio.channels.ServerSocketChannel") - ((datagram-usocket-p socket) + (t "java.nio.channels.DatagramChannel"))) (defun wait-for-input-internal (wait-list &key timeout) From ctian at common-lisp.net Wed Oct 22 13:35:23 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Wed, 22 Oct 2008 13:35:23 +0000 Subject: [usocket-cvs] r454 - usocket/branches/0.4.x/backend Message-ID: Author: ctian Date: Wed Oct 22 13:35:22 2008 New Revision: 454 Log: [0.4.x] minor fixes and enhancement Modified: usocket/branches/0.4.x/backend/cmucl.lisp usocket/branches/0.4.x/backend/sbcl.lisp usocket/branches/0.4.x/backend/scl.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 Wed Oct 22 13:35:22 2008 @@ -92,7 +92,7 @@ (server-sock (with-mapped-conditions () (apply #'ext:create-inet-listener - (append (list port :stream + (nconc (list port :stream :backlog backlog :reuse-address reuseaddress) (when (ip/= host *wildcard-host*) 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 Wed Oct 22 13:35:22 2008 @@ -319,9 +319,9 @@ (sb-bsd-sockets::host-ent-addresses (sb-bsd-sockets:get-host-by-name name)))) -#+sbcl +#+(and sbcl (not win32)) (progn - #-win32 + (defun %setup-wait-list (wait-list) (declare (ignore wait-list))) @@ -363,10 +363,10 @@ (socket x)) rfds) (setf (state x) :READ)))))))))) +) ; progn - #+win32 +#+(and sbcl win32) (warn "wait-for-input not (yet!) supported...") - ) #+ecl (progn 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 Wed Oct 22 13:35:22 2008 @@ -45,7 +45,8 @@ (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))) + (nconc args (list :local-host (host-to-hbo 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 From ctian at common-lisp.net Wed Oct 22 13:37:17 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Wed, 22 Oct 2008 13:37:17 +0000 Subject: [usocket-cvs] r455 - in usocket/branches/experimental-udp: . backend Message-ID: Author: ctian Date: Wed Oct 22 13:37:16 2008 New Revision: 455 Log: [udp] merge recent fix on 0.4 branch and manually refit for SOCKET-CONNECT (UDP version). Modified: usocket/branches/experimental-udp/backend/armedbear.lisp usocket/branches/experimental-udp/backend/clisp.lisp usocket/branches/experimental-udp/backend/cmucl.lisp usocket/branches/experimental-udp/backend/lispworks.lisp usocket/branches/experimental-udp/backend/sbcl.lisp usocket/branches/experimental-udp/backend/scl.lisp usocket/branches/experimental-udp/condition.lisp Modified: usocket/branches/experimental-udp/backend/armedbear.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/armedbear.lisp (original) +++ usocket/branches/experimental-udp/backend/armedbear.lisp Wed Oct 22 13:37:16 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/experimental-udp/backend/clisp.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/clisp.lisp (original) +++ usocket/branches/experimental-udp/backend/clisp.lisp Wed Oct 22 13:37:16 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/experimental-udp/backend/cmucl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/cmucl.lisp (original) +++ usocket/branches/experimental-udp/backend/cmucl.lisp Wed Oct 22 13:37:16 2008 @@ -52,23 +52,29 @@ (defun socket-connect (host port &key (protocol :stream) (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)) (ecase protocol (:stream (setf socket - (with-mapped-conditions (socket) - (ext:connect-to-inet-socket (host-to-hbo host) port :stream - :local-host (host-to-hbo local-host) - :local-port local-port))) + (let ((args (list (host-to-hbo host) port protocol))) + (when (and local-bind-p (or local-host-p local-port-p)) + (nconc args (list :local-host (host-to-hbo 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 @@ -82,15 +88,21 @@ (:datagram (setf socket (if (and host port) - (with-mapped-conditions (socket) - (ext:connect-to-inet-socket (host-to-hbo host) port :datagram - :local-host (host-to-hbo local-host) - :local-port local-port)) - (if (or local-host local-port) + (let ((args (list (host-to-hbo host) port protocol))) + (when (and local-bind-p (or local-host-p local-port-p)) + (nconc args (list :local-host (host-to-hbo local-host) + :local-port local-port))) + (with-mapped-conditions (socket) + (apply #'ext:connect-to-inet-socket args))) + (if (or local-host-p local-port-p) (with-mapped-conditions (socket) - (ext:create-inet-listener (or local-port 0) :datagram :host local-host)) + (apply #'ext:create-inet-listener + (nconc (list (or local-port 0) protocol) + (when (and local-host-p + (ip/= local-host *wildcard-host*)) + (list :host (host-to-hbo local-host)))))) (with-mapped-conditions (socket) - (ext:create-inet-socket :datagram))))) + (ext:create-inet-socket protocol))))) (if socket (let ((usocket (make-datagram-socket socket))) (ext:finalize usocket #'(lambda () (when (%open-p usocket) @@ -249,5 +261,4 @@ (setf (state x) :READ))) (progn ;;###FIXME generate an error, except for EINTR - (cmucl-map-socket-error err) ))))))) Modified: usocket/branches/experimental-udp/backend/lispworks.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/lispworks.lisp (original) +++ usocket/branches/experimental-udp/backend/lispworks.lisp Wed Oct 22 13:37:16 2008 @@ -255,10 +255,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")) (ecase protocol (:stream Modified: usocket/branches/experimental-udp/backend/sbcl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/sbcl.lisp (original) +++ usocket/branches/experimental-udp/backend/sbcl.lisp Wed Oct 22 13:37:16 2008 @@ -202,7 +202,10 @@ (defun socket-connect (host port &key (protocol :stream) (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 @@ -210,7 +213,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 @@ -228,8 +231,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 @@ -340,9 +342,9 @@ (sb-bsd-sockets::host-ent-addresses (sb-bsd-sockets:get-host-by-name name)))) -#+sbcl +#+(and sbcl (not win32)) (progn - #-win32 + (defun %setup-wait-list (wait-list) (declare (ignore wait-list))) @@ -384,10 +386,10 @@ (socket x)) rfds) (setf (state x) :READ)))))))))) +) ; progn - #+win32 +#+(and sbcl win32) (warn "wait-for-input not (yet!) supported...") - ) #+ecl (progn Modified: usocket/branches/experimental-udp/backend/scl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/scl.lisp (original) +++ usocket/branches/experimental-udp/backend/scl.lisp Wed Oct 22 13:37:16 2008 @@ -30,45 +30,55 @@ (defun socket-connect (host port &key (protocol :stream) (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)) + (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)) (ecase protocol (:stream - (setf socket (with-mapped-conditions () - (ext:connect-to-inet-socket (host-to-hbo host) port - :kind :stream - #+ignore #+ignore - #+ignore #+ignore - :local-host (if local-host - (host-to-hbo local-host)) - :local-port local-port))) + (setf socket (let ((args (list (host-to-hbo host) port :kind protocol))) + (when (and patch-udp-p (or local-host-p local-port-p)) + (nconc args (list :local-host (host-to-hbo local-host) + :local-port local-port))) + (with-mapped-conditions (socket) + (apply #'ext:connect-to-inet-socket args)))) (let ((stream (sys:make-fd-stream socket :input t :output t :element-type element-type :buffering :full))) (make-stream-socket :socket socket :stream stream))) (:datagram + (when (not patch-udp-p) + (error 'unsupported + :feature '(protocol :datagram) + :context 'socket-connect + :minumum "1.3.8.2 or ask a udp-patch from SCL maintainer")) (setf socket (if (and host port) - (with-mapped-conditions () - (ext:connect-to-inet-socket (host-to-hbo host) port - :kind :datagram - :local-host (host-to-hbo local-host) - :local-port local-port)) - (if (or local-port local-port) + (let ((args (list (host-to-hbo host) port :kind protocol))) + (when (and patch-udp-p (or local-host-p local-port-p)) + (nconc args (list :local-host (host-to-hbo local-host) + :local-port local-port))) + (with-mapped-conditions (socket) + (apply #'ext:connect-to-inet-socket args))) + (if (or local-host-p local-port-p) (with-mapped-conditions () (ext:create-inet-listener (or local-port 0) - :datagram - :host local-host)) + protocol + :host (if (ip= host *wildcard-host*) + 0 + (host-to-hbo local-host)))) (with-mapped-conditions () - (ext:create-inet-socket :datagram))))) + (ext:create-inet-socket protocol))))) (let ((usocket (make-datagram-socket socket))) (ext:finalize usocket #'(lambda () (when (%open-p usocket) @@ -128,10 +138,8 @@ (multiple-value-bind (result errno) (ext:inet-socket-send-to s buffer length :remote-host address :remote-port port) - (unless result - (error "~@" s - (unix:get-unix-error-msg errno))) - result))) + (or result + (scl-map-socket-error errno :socket socket))))) (defmethod socket-receive ((socket datagram-usocket) buffer length) (let ((s (socket socket))) @@ -141,10 +149,9 @@ (length buffer)))) (multiple-value-bind (result errno remote-host remote-port) (ext:inet-socket-receive-from s real-buffer real-length) - (unless result - (error "~@" s - (unix:get-unix-error-msg errno))) - (values real-buffer result remote-host remote-port))))) + (if result + (values real-buffer result remote-host remote-port) + (scl-map-socket-error errno :socket socket)))))) (defmethod get-local-name ((usocket usocket)) (multiple-value-bind (address port) Modified: usocket/branches/experimental-udp/condition.lisp ============================================================================== --- usocket/branches/experimental-udp/condition.lisp (original) +++ usocket/branches/experimental-udp/condition.lisp Wed Oct 22 13:37:16 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)) From ctian at common-lisp.net Wed Oct 22 13:51:20 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Wed, 22 Oct 2008 13:51:20 +0000 Subject: [usocket-cvs] r456 - usocket/branches/0.4.x/backend Message-ID: Author: ctian Date: Wed Oct 22 13:51:19 2008 New Revision: 456 Log: [0.4.x] clean acl code on SOCKET-CONNECT, the same way as experimental-udp branch. Modified: usocket/branches/0.4.x/backend/allegro.lisp Modified: usocket/branches/0.4.x/backend/allegro.lisp ============================================================================== --- usocket/branches/0.4.x/backend/allegro.lisp (original) +++ usocket/branches/0.4.x/backend/allegro.lisp Wed Oct 22 13:51:19 2008 @@ -58,24 +58,21 @@ (let ((socket)) (setf socket - (with-mapped-conditions (socket) - (if timeout - (mp:with-timeout (timeout nil) - (socket:make-socket :remote-host (host-to-hostname host) - :remote-port port - :local-host (when local-host (host-to-hostname local-host)) - :local-port local-port - :format (to-format element-type) - :nodelay nodelay)) - (socket:make-socket :remote-host (host-to-hostname host) - :remote-port port - :local-host local-host - :local-port local-port - :format (to-format element-type) - :nodelay nodelay)))) + (labels ((make-socket () + (socket:make-socket :remote-host (host-to-hostname host) + :remote-port port + :local-host (when local-host + (host-to-hostname local-host)) + :local-port local-port + :format (to-format element-type) + :nodelay nodelay))) + (with-mapped-conditions (socket) + (if timeout + (mp:with-timeout (timeout nil) + (make-socket)) + (make-socket))))) (make-stream-socket :socket socket :stream socket))) - ;; One socket close method is sufficient, ;; because socket-streams are also sockets. (defmethod socket-close ((usocket usocket)) From ctian at common-lisp.net Wed Oct 22 13:52:39 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Wed, 22 Oct 2008 13:52:39 +0000 Subject: [usocket-cvs] r457 - usocket/branches/experimental-udp/backend Message-ID: Author: ctian Date: Wed Oct 22 13:52:39 2008 New Revision: 457 Log: [udp] ACL's SOCKET-CONNECT: fix bugs and make it cleaner. Modified: usocket/branches/experimental-udp/backend/allegro.lisp Modified: usocket/branches/experimental-udp/backend/allegro.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/allegro.lisp (original) +++ usocket/branches/experimental-udp/backend/allegro.lisp Wed Oct 22 13:52:39 2008 @@ -64,7 +64,8 @@ (labels ((make-socket () (socket:make-socket :remote-host (host-to-hostname host) :remote-port port - :local-host (host-to-hostname local-host) + :local-host (when local-host + (host-to-hostname local-host)) :local-port local-port :format (to-format element-type) :nodelay nodelay))) @@ -73,20 +74,18 @@ (make-socket)) (make-socket)))) (:datagram - (if (and host port) - (socket:make-socket :type :datagram - :address-family :internet - :connect :active + (apply #'socket:make-socket + (nconc (list :type protocol + :address-family :internet + :local-host (when local-host + (host-to-hostname local-host)) + :local-port local-port + :format (to-format element-type)) + (if (and host port) + (list :connect :active :remote-host (host-to-hostname host) - :remote-port port - :local-host (host-to-hostname local-host) - :local-port local-port - :format (to-format element-type)) - (socket:make-socket :type :datagram - :address-family :internet - :local-host local-host - :local-port (host-to-hostname local-host) - :format (to-format element-type))))))) + :remote-port port) + (list :connect :passive)))))))) (ecase protocol (:stream (make-stream-socket :socket socket :stream socket)) From ctian at common-lisp.net Wed Oct 22 14:00:59 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Wed, 22 Oct 2008 14:00:59 +0000 Subject: [usocket-cvs] r458 - usocket/trunk/backend Message-ID: Author: ctian Date: Wed Oct 22 14:00:57 2008 New Revision: 458 Log: [trunk] merge changes on branch 0.4.x back to trunk. Modified: usocket/trunk/backend/allegro.lisp usocket/trunk/backend/cmucl.lisp usocket/trunk/backend/sbcl.lisp usocket/trunk/backend/scl.lisp Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp (original) +++ usocket/trunk/backend/allegro.lisp Wed Oct 22 14:00:57 2008 @@ -58,24 +58,21 @@ (let ((socket)) (setf socket - (with-mapped-conditions (socket) - (if timeout - (mp:with-timeout (timeout nil) - (socket:make-socket :remote-host (host-to-hostname host) - :remote-port port - :local-host (when local-host (host-to-hostname local-host)) - :local-port local-port - :format (to-format element-type) - :nodelay nodelay)) - (socket:make-socket :remote-host (host-to-hostname host) - :remote-port port - :local-host local-host - :local-port local-port - :format (to-format element-type) - :nodelay nodelay)))) + (labels ((make-socket () + (socket:make-socket :remote-host (host-to-hostname host) + :remote-port port + :local-host (when local-host + (host-to-hostname local-host)) + :local-port local-port + :format (to-format element-type) + :nodelay nodelay))) + (with-mapped-conditions (socket) + (if timeout + (mp:with-timeout (timeout nil) + (make-socket)) + (make-socket))))) (make-stream-socket :socket socket :stream socket))) - ;; One socket close method is sufficient, ;; because socket-streams are also sockets. (defmethod socket-close ((usocket usocket)) Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Wed Oct 22 14:00:57 2008 @@ -92,7 +92,7 @@ (server-sock (with-mapped-conditions () (apply #'ext:create-inet-listener - (append (list port :stream + (nconc (list port :stream :backlog backlog :reuse-address reuseaddress) (when (ip/= host *wildcard-host*) Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Wed Oct 22 14:00:57 2008 @@ -319,9 +319,9 @@ (sb-bsd-sockets::host-ent-addresses (sb-bsd-sockets:get-host-by-name name)))) -#+sbcl +#+(and sbcl (not win32)) (progn - #-win32 + (defun %setup-wait-list (wait-list) (declare (ignore wait-list))) @@ -363,10 +363,10 @@ (socket x)) rfds) (setf (state x) :READ)))))))))) +) ; progn - #+win32 +#+(and sbcl win32) (warn "wait-for-input not (yet!) supported...") - ) #+ecl (progn Modified: usocket/trunk/backend/scl.lisp ============================================================================== --- usocket/trunk/backend/scl.lisp (original) +++ usocket/trunk/backend/scl.lisp Wed Oct 22 14:00:57 2008 @@ -45,7 +45,8 @@ (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))) + (nconc args (list :local-host (host-to-hbo 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 From ehuelsmann at common-lisp.net Sun Oct 26 13:06:25 2008 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 26 Oct 2008 13:06:25 +0000 Subject: [usocket-cvs] r459 - usocket/trunk/backend Message-ID: Author: ehuelsmann Date: Sun Oct 26 13:06:24 2008 New Revision: 459 Log: Catch serious-conditions for re-raising through ERROR too. Found by: Attila Levendai PS: Other backends seem to use different assumptions. Modified: usocket/trunk/backend/sbcl.lisp Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Sun Oct 26 13:06:24 2008 @@ -185,7 +185,7 @@ (defun handle-condition (condition &optional (socket nil)) "Dispatch correct usocket condition." (typecase condition - (error (let* ((usock-error (cdr (assoc (type-of condition) + (serious-condition (let* ((usock-error (cdr (assoc (type-of condition) +sbcl-error-map+))) (usock-error (if (functionp usock-error) (funcall usock-error condition) From ehuelsmann at common-lisp.net Sun Oct 26 13:08:45 2008 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 26 Oct 2008 13:08:45 +0000 Subject: [usocket-cvs] r460 - usocket/branches/0.4.x/backend Message-ID: Author: ehuelsmann Date: Sun Oct 26 13:08:45 2008 New Revision: 460 Log: Backport c459 from trunk. Modified: usocket/branches/0.4.x/backend/sbcl.lisp 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 Sun Oct 26 13:08:45 2008 @@ -185,7 +185,7 @@ (defun handle-condition (condition &optional (socket nil)) "Dispatch correct usocket condition." (typecase condition - (error (let* ((usock-error (cdr (assoc (type-of condition) + (serious-condition (let* ((usock-error (cdr (assoc (type-of condition) +sbcl-error-map+))) (usock-error (if (functionp usock-error) (funcall usock-error condition) From ehuelsmann at common-lisp.net Sun Oct 26 13:19:29 2008 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 26 Oct 2008 13:19:29 +0000 Subject: [usocket-cvs] r461 - usocket/tags/0.4.0 Message-ID: Author: ehuelsmann Date: Sun Oct 26 13:19:29 2008 New Revision: 461 Log: Create 0.4.0 tag. Added: usocket/tags/0.4.0/ - copied from r460, /usocket/branches/0.4.x/ Modified: usocket/tags/0.4.0/usocket.asd Modified: usocket/tags/0.4.0/usocket.asd ============================================================================== --- /usocket/branches/0.4.x/usocket.asd (original) +++ usocket/tags/0.4.0/usocket.asd Sun Oct 26 13:19:29 2008 @@ -14,7 +14,7 @@ (defsystem usocket :name "usocket" :author "Erik Enge & Erik Huelsmann" - :version "0.5.0-dev" + :version "0.4.0" :licence "MIT" :description "Universal socket library for Common Lisp" :depends-on (:split-sequence From ehuelsmann at common-lisp.net Sun Oct 26 21:38:56 2008 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 26 Oct 2008 21:38:56 +0000 Subject: [usocket-cvs] r462 - usocket/tags/0.4.0/usocket-0.4.0-tag Message-ID: Author: ehuelsmann Date: Sun Oct 26 21:38:55 2008 New Revision: 462 Log: Create 0.4.0 tag. Added: usocket/tags/0.4.0/usocket-0.4.0-tag/ - copied from r461, /usocket/branches/0.4.x/ From ehuelsmann at common-lisp.net Sun Oct 26 21:43:41 2008 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 26 Oct 2008 21:43:41 +0000 Subject: [usocket-cvs] r463 - usocket/tags/0.4.0/usocket-0.4.0-tag Message-ID: Author: ehuelsmann Date: Sun Oct 26 21:43:41 2008 New Revision: 463 Log: Fix error in release script. Removed: usocket/tags/0.4.0/usocket-0.4.0-tag/ From ehuelsmann at common-lisp.net Sun Oct 26 21:45:35 2008 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 26 Oct 2008 21:45:35 +0000 Subject: [usocket-cvs] r464 - in public_html: . releases Message-ID: Author: ehuelsmann Date: Sun Oct 26 21:45:33 2008 New Revision: 464 Log: Publish 0.4.0 release. Added: public_html/releases/usocket-0.4.0.tar.gz (contents, props changed) public_html/releases/usocket-0.4.0.tar.gz.asc Modified: public_html/index.shtml Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Sun Oct 26 21:45:33 2008 @@ -281,15 +281,15 @@ Implement api calls get- and setsockopt (or equivalent). - TODO - TODO - TODO - TODO - TODO - TODO - TODO - TODO - TODO + WIP + WIP + WIP + WIP + WIP + WIP + WIP + WIP + WIP Implement efficient waiting for multiple sockets @@ -362,15 +362,15 @@ Build on top of that (or custom ffi). - TODO - TODO - TODO - TODO - TODO - TODO - TODO - TODO - TODO + WIP + WIP + WIP + WIP + WIP + WIP + WIP + WIP + WIP @@ -392,9 +392,11 @@ - - - + + +
Release history
DateReleaseSummary
Jun 28, 20080.3.7Fix of OpenMCL (Closure CL) backend.
Oct 28, 20080.4.0select()-like api: make a single thread wait for multiple sockets.
+ various socket options for socket-creation with SOCKET-CONNECT. +
Jun 21, 2008 0.3.6 Code fixups based on advice from the ECL and OpenMCL maintainers. Added: public_html/releases/usocket-0.4.0.tar.gz ============================================================================== Binary file. No diff available. Added: public_html/releases/usocket-0.4.0.tar.gz.asc ============================================================================== --- (empty file) +++ public_html/releases/usocket-0.4.0.tar.gz.asc Sun Oct 26 21:45:33 2008 @@ -0,0 +1,7 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.6 (GNU/Linux) + +iD8DBQBJBOSvi5O0Epaz9TkRAn56AJ97E4i0TpEbfDySWNKibc2r5l41/wCcCn1O +aZteNAha3LUwhK6MkN0r5n0= +=ixRK +-----END PGP SIGNATURE----- From ctian at common-lisp.net Tue Oct 28 05:58:16 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Tue, 28 Oct 2008 05:58:16 +0000 Subject: [usocket-cvs] r465 - usocket/branches/experimental-udp/backend Message-ID: Author: ctian Date: Tue Oct 28 05:58:15 2008 New Revision: 465 Log: [udp] SOCKET-SEND API Change: use keyword HOST instead of ADDRESS. Modified: usocket/branches/experimental-udp/backend/allegro.lisp usocket/branches/experimental-udp/backend/cmucl.lisp usocket/branches/experimental-udp/backend/lispworks.lisp usocket/branches/experimental-udp/backend/openmcl.lisp usocket/branches/experimental-udp/backend/sbcl.lisp usocket/branches/experimental-udp/backend/scl.lisp Modified: usocket/branches/experimental-udp/backend/allegro.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/allegro.lisp (original) +++ usocket/branches/experimental-udp/backend/allegro.lisp Tue Oct 28 05:58:15 2008 @@ -129,10 +129,10 @@ (socket:accept-connection (socket socket))))) (make-stream-socket :socket stream-sock :stream stream-sock))) -(defmethod socket-send ((socket datagram-usocket) buffer length &key address port) +(defmethod socket-send ((socket datagram-usocket) buffer length &key host port) (with-mapped-conditions (socket) (let ((s (socket socket))) - (socket:send-to s buffer length :remote-host address :remote-port port)))) + (socket:send-to s buffer length :remote-host host :remote-port port)))) (defmethod socket-receive ((socket datagram-usocket) buffer length) (with-mapped-conditions (socket) Modified: usocket/branches/experimental-udp/backend/cmucl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/cmucl.lisp (original) +++ usocket/branches/experimental-udp/backend/cmucl.lisp Tue Oct 28 05:58:15 2008 @@ -157,9 +157,9 @@ (defmethod socket-close :after ((socket datagram-usocket)) (setf (%open-p socket) nil)) -(defmethod socket-send ((usocket datagram-usocket) buffer length &key address port) +(defmethod socket-send ((usocket datagram-usocket) buffer length &key host port) (with-mapped-conditions (usocket) - (ext:inet-sendto (socket usocket) buffer length (if address (host-to-hbo address)) port))) + (ext:inet-sendto (socket usocket) buffer length (if host (host-to-hbo host)) port))) (defmethod socket-receive ((usocket datagram-usocket) buffer length) (let ((real-buffer (or buffer 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 28 05:58:15 2008 @@ -371,9 +371,9 @@ (fli:dereference len))) (comm::%send socket-fd ptr (min length +max-datagram-packet-size+) 0))))))) -(defmethod socket-send ((socket datagram-usocket) buffer length &key address port) +(defmethod socket-send ((socket datagram-usocket) buffer length &key host port) (let ((s (socket socket))) - (send-message s buffer length (host-to-hbo address) port))) + (send-message s buffer length (host-to-hbo host) port))) (defvar *message-receive-buffer* (make-array +max-datagram-packet-size+ 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 28 05:58:15 2008 @@ -136,10 +136,10 @@ (with-mapped-conditions (usocket) (close (socket usocket)))) -(defmethod socket-send ((usocket datagram-usocket) buffer length &key address port) +(defmethod socket-send ((usocket datagram-usocket) buffer length &key host port) (with-mapped-conditions (usocket) (openmcl-socket:send-to (socket usocket) buffer length - :remote-host (host-to-hbo address) + :remote-host (host-to-hbo host) :remote-port port))) (defmethod socket-receive ((usocket datagram-usocket) buffer length) Modified: usocket/branches/experimental-udp/backend/sbcl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/sbcl.lisp (original) +++ usocket/branches/experimental-udp/backend/sbcl.lisp Tue Oct 28 05:58:15 2008 @@ -301,10 +301,10 @@ (with-mapped-conditions (usocket) (close (socket-stream usocket)))) -(defmethod socket-send ((socket datagram-usocket) buffer length &key address port) +(defmethod socket-send ((socket datagram-usocket) buffer length &key host port) (with-mapped-conditions (socket) (let* ((s (socket socket)) - (dest (if (and address port) (list (host-to-vector-quad address) port) nil))) + (dest (if (and host port) (list (host-to-vector-quad host) port) nil))) (sb-bsd-sockets:socket-send s buffer length :address dest)))) (defmethod socket-receive ((socket datagram-usocket) buffer length Modified: usocket/branches/experimental-udp/backend/scl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/scl.lisp (original) +++ usocket/branches/experimental-udp/backend/scl.lisp Tue Oct 28 05:58:15 2008 @@ -132,12 +132,12 @@ (defmethod socket-close :after ((socket datagram-usocket)) (setf (%open-p socket) nil)) -(defmethod socket-send ((socket datagram-usocket) buffer length &key address port) +(defmethod socket-send ((socket datagram-usocket) buffer length &key host port) (let ((s (socket socket)) - (address (if address (host-to-hbo address)))) + (host (if host (host-to-hbo host)))) (multiple-value-bind (result errno) (ext:inet-socket-send-to s buffer length - :remote-host address :remote-port port) + :remote-host host :remote-port port) (or result (scl-map-socket-error errno :socket socket))))) From ctian at common-lisp.net Tue Oct 28 06:47:42 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Tue, 28 Oct 2008 06:47:42 +0000 Subject: [usocket-cvs] r466 - usocket/branches/experimental-udp Message-ID: Author: ctian Date: Tue Oct 28 06:47:42 2008 New Revision: 466 Log: [udp] more code change to match the API change on SOCKET-SEND Modified: usocket/branches/experimental-udp/rtt-client.lisp usocket/branches/experimental-udp/server.lisp Modified: usocket/branches/experimental-udp/rtt-client.lisp ============================================================================== --- usocket/branches/experimental-udp/rtt-client.lisp (original) +++ usocket/branches/experimental-udp/rtt-client.lisp Tue Oct 28 06:47:42 2008 @@ -5,7 +5,7 @@ (defun default-rtt-function (message) (values message 0)) -(defmethod socket-sync ((socket datagram-usocket) message &key address port +(defmethod socket-sync ((socket datagram-usocket) message &key host port (max-receive-length +max-datagram-packet-size+) (encode-function #'default-rtt-function) (decode-function #'default-rtt-function)) @@ -18,7 +18,7 @@ and recv-seq = -1 and continue-p = t do (progn - (socket-send socket data data-length :address address :port port) + (socket-send socket data data-length :host host :port port) (multiple-value-bind (sockets real-time) (wait-for-input socket :timeout (rtt-start socket)) (declare (ignore sockets)) Modified: usocket/branches/experimental-udp/server.lisp ============================================================================== --- usocket/branches/experimental-udp/server.lisp (original) +++ usocket/branches/experimental-udp/server.lisp Tue Oct 28 06:47:42 2008 @@ -12,8 +12,7 @@ (let ((socket (socket-connect nil nil :protocol :datagram :local-host host - :local-port port - :element-type element-type)) + :local-port port)) (buffer (make-array max-buffer-size :element-type '(unsigned-byte 8) :initial-element 0))) @@ -34,7 +33,7 @@ (when reply (replace buffer reply) (let ((n (socket-send socket buffer (length reply) - :address *remote-host* + :host *remote-host* :port *remote-port*))) (when (minusp n) (error "send error: ~A~%" n)))))) From ctian at common-lisp.net Tue Oct 28 07:03:05 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Tue, 28 Oct 2008 07:03:05 +0000 Subject: [usocket-cvs] r467 - usocket/branches/experimental-udp Message-ID: Author: ctian Date: Tue Oct 28 07:00:59 2008 New Revision: 467 Log: [udp] cancel unused ELEMENT-TYPE keyword in SOCKET-SERVER Modified: usocket/branches/experimental-udp/server.lisp Modified: usocket/branches/experimental-udp/server.lisp ============================================================================== --- usocket/branches/experimental-udp/server.lisp (original) +++ usocket/branches/experimental-udp/server.lisp Tue Oct 28 07:00:59 2008 @@ -7,7 +7,7 @@ (defvar *remote-port*) (defun socket-server (host port function &optional arguments - &key (element-type '(unsigned-byte 8)) (timeout 1) + &key (timeout 1) (max-buffer-size +max-datagram-packet-size+)) (let ((socket (socket-connect nil nil :protocol :datagram From ctian at common-lisp.net Tue Oct 28 10:37:24 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Tue, 28 Oct 2008 10:37:24 +0000 Subject: [usocket-cvs] r468 - usocket/branches/experimental-udp/backend Message-ID: Author: ctian Date: Tue Oct 28 10:37:24 2008 New Revision: 468 Log: [udp] merge from trunk and limit format of datagram to :binary Modified: usocket/branches/experimental-udp/backend/openmcl.lisp 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 28 10:37:24 2008 @@ -81,9 +81,9 @@ (ecase protocol (:stream (let ((mcl-sock - (openmcl-socket:make-socket :remote-host (host-to-hbo host) + (openmcl-socket:make-socket :remote-host (host-to-hostname host) :remote-port port - :local-host (host-to-hbo local-host) + :local-host (when local-host (host-to-hostname local-host)) :local-port local-port :format (to-format element-type) :deadline deadline @@ -96,8 +96,9 @@ (let ((mcl-sock (openmcl-socket:make-socket :address-family :internet :type :datagram - :local-host (host-to-hbo local-host) - :local-port local-port))) + :local-host (when local-host (host-to-hostname local-host)) + :local-port local-port + :format :binary))) (when (and host port) (ccl::inet-connect (ccl::socket-device mcl-sock) (ccl::host-as-inet-host host) From ctian at common-lisp.net Tue Oct 28 12:00:40 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Tue, 28 Oct 2008 12:00:40 +0000 Subject: [usocket-cvs] r469 - usocket/trunk/backend Message-ID: Author: ctian Date: Tue Oct 28 12:00:38 2008 New Revision: 469 Log: bugfix: ETYPECASE in HANDLE-CONDITION (SCL) should be TYPECASE, Call HOST-TO-HBO should detect NULL first. Modified: usocket/trunk/backend/cmucl.lisp usocket/trunk/backend/scl.lisp Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Tue Oct 28 12:00:38 2008 @@ -69,7 +69,9 @@ (setf socket (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))) + (nconc args (list :local-host (when local-host + (host-to-hbo local-host)) + :local-port local-port))) (with-mapped-conditions (socket) (apply #'ext:connect-to-inet-socket args)))) (if socket Modified: usocket/trunk/backend/scl.lisp ============================================================================== --- usocket/trunk/backend/scl.lisp (original) +++ usocket/trunk/backend/scl.lisp Tue Oct 28 12:00:38 2008 @@ -22,11 +22,11 @@ (defun handle-condition (condition &optional (socket nil)) "Dispatch correct usocket condition." - (etypecase condition + (typecase condition (ext::socket-error (scl-map-socket-error (ext::socket-errno condition) - :socket socket - :condition condition)))) + :socket socket + :condition condition)))) (defun socket-connect (host port &key (element-type 'character) timeout deadline (nodelay t nodelay-specified) @@ -45,7 +45,8 @@ (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 (host-to-hbo local-host) + (nconc args (list :local-host (when local-host + (host-to-hbo local-host)) :local-port local-port))) (with-mapped-conditions () (apply #'ext:connect-to-inet-socket args)))) From ctian at common-lisp.net Tue Oct 28 12:02:01 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Tue, 28 Oct 2008 12:02:01 +0000 Subject: [usocket-cvs] r470 - usocket/branches/0.4.x/backend Message-ID: Author: ctian Date: Tue Oct 28 12:02:01 2008 New Revision: 470 Log: [bugfix] merge from trunk (r469) Modified: usocket/branches/0.4.x/backend/cmucl.lisp usocket/branches/0.4.x/backend/scl.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 28 12:02:01 2008 @@ -69,7 +69,9 @@ (setf socket (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))) + (nconc args (list :local-host (when local-host + (host-to-hbo local-host)) + :local-port local-port))) (with-mapped-conditions (socket) (apply #'ext:connect-to-inet-socket args)))) (if 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 28 12:02:01 2008 @@ -22,11 +22,11 @@ (defun handle-condition (condition &optional (socket nil)) "Dispatch correct usocket condition." - (etypecase condition + (typecase condition (ext::socket-error (scl-map-socket-error (ext::socket-errno condition) - :socket socket - :condition condition)))) + :socket socket + :condition condition)))) (defun socket-connect (host port &key (element-type 'character) timeout deadline (nodelay t nodelay-specified) @@ -45,7 +45,8 @@ (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 (host-to-hbo local-host) + (nconc args (list :local-host (when local-host + (host-to-hbo local-host)) :local-port local-port))) (with-mapped-conditions () (apply #'ext:connect-to-inet-socket args)))) From ctian at common-lisp.net Tue Oct 28 12:02:39 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Tue, 28 Oct 2008 12:02:39 +0000 Subject: [usocket-cvs] r471 - usocket/branches/experimental-udp/backend Message-ID: Author: ctian Date: Tue Oct 28 12:02:38 2008 New Revision: 471 Log: [bugfix] merge from trunk (r469) Modified: usocket/branches/experimental-udp/backend/cmucl.lisp usocket/branches/experimental-udp/backend/scl.lisp Modified: usocket/branches/experimental-udp/backend/cmucl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/cmucl.lisp (original) +++ usocket/branches/experimental-udp/backend/cmucl.lisp Tue Oct 28 12:02:38 2008 @@ -71,7 +71,8 @@ (setf socket (let ((args (list (host-to-hbo host) port protocol))) (when (and local-bind-p (or local-host-p local-port-p)) - (nconc args (list :local-host (host-to-hbo local-host) + (nconc args (list :local-host (when local-host + (host-to-hbo local-host)) :local-port local-port))) (with-mapped-conditions (socket) (apply #'ext:connect-to-inet-socket args)))) @@ -90,7 +91,8 @@ (if (and host port) (let ((args (list (host-to-hbo host) port protocol))) (when (and local-bind-p (or local-host-p local-port-p)) - (nconc args (list :local-host (host-to-hbo local-host) + (nconc args (list :local-host (when local-host + (host-to-hbo local-host)) :local-port local-port))) (with-mapped-conditions (socket) (apply #'ext:connect-to-inet-socket args))) Modified: usocket/branches/experimental-udp/backend/scl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/scl.lisp (original) +++ usocket/branches/experimental-udp/backend/scl.lisp Tue Oct 28 12:02:38 2008 @@ -66,7 +66,8 @@ (if (and host port) (let ((args (list (host-to-hbo host) port :kind protocol))) (when (and patch-udp-p (or local-host-p local-port-p)) - (nconc args (list :local-host (host-to-hbo local-host) + (nconc args (list :local-host (when local-host + (host-to-hbo local-host)) :local-port local-port))) (with-mapped-conditions (socket) (apply #'ext:connect-to-inet-socket args))) @@ -74,9 +75,10 @@ (with-mapped-conditions () (ext:create-inet-listener (or local-port 0) protocol - :host (if (ip= host *wildcard-host*) - 0 - (host-to-hbo local-host)))) + :host (when local-host + (if (ip= host *wildcard-host*) + 0 + (host-to-hbo local-host))))) (with-mapped-conditions () (ext:create-inet-socket protocol))))) (let ((usocket (make-datagram-socket socket))) From ctian at common-lisp.net Fri Oct 31 17:16:38 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Fri, 31 Oct 2008 17:16:38 +0000 Subject: [usocket-cvs] r472 - usocket/branches/experimental-udp/backend Message-ID: Author: ctian Date: Fri Oct 31 17:16:35 2008 New Revision: 472 Log: [udp] bugfix for SCL. Modified: usocket/branches/experimental-udp/backend/scl.lisp Modified: usocket/branches/experimental-udp/backend/scl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/scl.lisp (original) +++ usocket/branches/experimental-udp/backend/scl.lisp Fri Oct 31 17:16:35 2008 @@ -22,11 +22,11 @@ (defun handle-condition (condition &optional (socket nil)) "Dispatch correct usocket condition." - (etypecase condition + (typecase condition (ext::socket-error (scl-map-socket-error (ext::socket-errno condition) - :socket socket - :condition condition)))) + :socket socket + :condition condition)))) (defun socket-connect (host port &key (protocol :stream) (element-type 'character) timeout deadline (nodelay t nodelay-specified) @@ -48,7 +48,8 @@ (:stream (setf socket (let ((args (list (host-to-hbo host) port :kind protocol))) (when (and patch-udp-p (or local-host-p local-port-p)) - (nconc args (list :local-host (host-to-hbo local-host) + (nconc args (list :local-host (when local-host + (host-to-hbo local-host)) :local-port local-port))) (with-mapped-conditions (socket) (apply #'ext:connect-to-inet-socket args)))) @@ -76,7 +77,7 @@ (ext:create-inet-listener (or local-port 0) protocol :host (when local-host - (if (ip= host *wildcard-host*) + (if (ip= local-host *wildcard-host*) 0 (host-to-hbo local-host))))) (with-mapped-conditions ()