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

[usocket-cvs] r336 - usocket/branches/hans
by hhubner＠common-lisp.net 23 Apr '08

23 Apr '08

Author: hhubner Date: Wed Apr 23 17:33:32 2008 New Revision: 336 Modified: usocket/branches/hans/ (props changed) Log: Initialized merge tracking via "svnmerge" with revisions "1-332" from svn+ssh://common-lisp.net/project/usocket/svn/usocket/trunk

1 0

[usocket-cvs] r335 - in usocket/branches/hans: . backend
by hhubner＠common-lisp.net 23 Apr '08

23 Apr '08

Author: hhubner Date: Wed Apr 23 17:29:50 2008 New Revision: 335 Modified: usocket/branches/hans/backend/allegro.lisp usocket/branches/hans/backend/armedbear.lisp usocket/branches/hans/backend/clisp.lisp usocket/branches/hans/backend/cmucl.lisp usocket/branches/hans/backend/lispworks.lisp usocket/branches/hans/backend/openmcl.lisp usocket/branches/hans/backend/sbcl.lisp usocket/branches/hans/backend/scl.lisp usocket/branches/hans/usocket.lisp Log: Merging from ITA branch: CCL fixes, timeout argument to SOCKET-CONNECT. Modified: usocket/branches/hans/backend/allegro.lisp ============================================================================== --- usocket/branches/hans/backend/allegro.lisp (original) +++ usocket/branches/hans/backend/allegro.lisp Wed Apr 23 17:29:50 2008 @@ -49,7 +49,9 @@ :text :binary)) -(defun socket-connect (host port &key (element-type 'character)) +(defun socket-connect (host port &key (element-type 'character) timeout) + (when timeout + (warn "SOCKET-CONNECT timeout not supported in Allegro CL")) (let ((socket)) (setf socket (with-mapped-conditions (socket) Modified: usocket/branches/hans/backend/armedbear.lisp ============================================================================== --- usocket/branches/hans/backend/armedbear.lisp (original) +++ usocket/branches/hans/backend/armedbear.lisp Wed Apr 23 17:29:50 2008 @@ -185,7 +185,9 @@ (typecase condition (error (error 'unknown-error :socket socket :real-error condition)))) -(defun socket-connect (host port &key (element-type 'character)) +(defun socket-connect (host port &key (element-type 'character) timeout) + (when timeout + (warn "SOCKET-CONNECT timeout not supported in ABCL")) (let ((usock)) (with-mapped-conditions (usock) (let* ((sock-addr (jdi:jcoerce Modified: usocket/branches/hans/backend/clisp.lisp ============================================================================== --- usocket/branches/hans/backend/clisp.lisp (original) +++ usocket/branches/hans/backend/clisp.lisp Wed Apr 23 17:29:50 2008 @@ -55,7 +55,9 @@ (error usock-err :socket socket) (signal usock-err :socket socket))))))) -(defun socket-connect (host port &key (element-type 'character)) +(defun socket-connect (host port &key (element-type 'character) timeout) + (when timeout + (warn "SOCKET-CONNECT timeout not supported in CLISP")) (let ((socket) (hostname (host-to-hostname host))) (with-mapped-conditions (socket) @@ -217,7 +219,7 @@ (defmethod socket-close ((usocket datagram-usocket)) (rawsock:sock-close (socket usocket))) - + ) #-rawsock @@ -226,4 +228,4 @@ To enable UDP socket support, please be sure to use the -Kfull parameter at startup, or to enable RAWSOCK support during compilation.") - ) \ No newline at end of file + ) Modified: usocket/branches/hans/backend/cmucl.lisp ============================================================================== --- usocket/branches/hans/backend/cmucl.lisp (original) +++ usocket/branches/hans/backend/cmucl.lisp Wed Apr 23 17:29:50 2008 @@ -50,7 +50,9 @@ :socket socket :condition condition)))) -(defun socket-connect (host port &key (element-type 'character)) +(defun socket-connect (host port &key (element-type 'character) timeout) + (when timeout + (warn "SOCKET-CONNECT timeout not supported in CMUCL")) (let* ((socket)) (setf socket (with-mapped-conditions (socket) Modified: usocket/branches/hans/backend/lispworks.lisp ============================================================================== --- usocket/branches/hans/backend/lispworks.lisp (original) +++ usocket/branches/hans/backend/lispworks.lisp Wed Apr 23 17:29:50 2008 @@ -73,7 +73,9 @@ (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 (element-type 'base-char) timeout) + (when timeout + (warn "SOCKET-CONNECT timeout not supported in Lispworks")) (let ((hostname (host-to-hostname host)) (stream)) (setf stream Modified: usocket/branches/hans/backend/openmcl.lisp ============================================================================== --- usocket/branches/hans/backend/openmcl.lisp (original) +++ usocket/branches/hans/backend/openmcl.lisp Wed Apr 23 17:29:50 2008 @@ -57,25 +57,30 @@ (defun handle-condition (condition &optional socket) (typecase condition (openmcl-socket:socket-error - (raise-error-from-id (openmcl-socket:socket-error-identifier condition) - socket condition)) + (raise-error-from-id (openmcl-socket:socket-error-identifier condition) + socket condition)) + (ccl:communication-deadline-expired + (error 'timeout-error :socket socket :real-error condition)) (ccl::socket-creation-error #| ugh! |# - (raise-error-from-id (ccl::socket-creation-error-identifier condition) - socket condition)))) + (raise-error-from-id (ccl::socket-creation-error-identifier condition) + socket condition)))) (defun to-format (element-type) (if (subtypep element-type 'character) :text :binary)) -(defun socket-connect (host port &key (element-type 'character)) +(defun socket-connect (host port &key (element-type 'character) timeout deadline) (with-mapped-conditions () - (let ((mcl-sock - (openmcl-socket:make-socket :remote-host (host-to-hostname host) - :remote-port port - :format (to-format element-type)))) - (openmcl-socket:socket-connect mcl-sock) - (make-stream-socket :stream mcl-sock :socket mcl-sock)))) + (let ((mcl-sock + (openmcl-socket:make-socket :remote-host (host-to-hostname host) + :remote-port port + :format (to-format element-type) + :deadline deadline + :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)))) (defun socket-listen (host port &key reuseaddress Modified: usocket/branches/hans/backend/sbcl.lisp ============================================================================== --- usocket/branches/hans/backend/sbcl.lisp (original) +++ usocket/branches/hans/backend/sbcl.lisp Wed Apr 23 17:29:50 2008 @@ -184,7 +184,10 @@ (signal usock-cond :socket socket)))))) -(defun socket-connect (host port &key (element-type 'character)) +(defun socket-connect (host port &key (element-type 'character) timeout deadline) + (declare (ignore deadline)) + (when timeout + (warn "SOCKET-CONNECT timeout not supported in SBCL")) (let* ((socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp)) (stream (sb-bsd-sockets:socket-make-stream socket Modified: usocket/branches/hans/backend/scl.lisp ============================================================================== --- usocket/branches/hans/backend/scl.lisp (original) +++ usocket/branches/hans/backend/scl.lisp Wed Apr 23 17:29:50 2008 @@ -28,7 +28,9 @@ :socket socket :condition condition)))) -(defun socket-connect (host port &key (element-type 'character)) +(defun socket-connect (host port &key (element-type 'character) timeout) + (when timeout + (warn "SOCKET-CONNECT timeout not supported in SCL")) (let* ((socket (with-mapped-conditions () (ext:connect-to-inet-socket (host-to-hbo host) port :kind :stream))) Modified: usocket/branches/hans/usocket.lisp ============================================================================== --- usocket/branches/hans/usocket.lisp (original) +++ usocket/branches/hans/usocket.lisp Wed Apr 23 17:29:50 2008 @@ -77,7 +77,6 @@ (defclass datagram-usocket (usocket) ((connected-p :initarg :connected-p :accessor connected-p)) -;; ###FIXME: documentation to be added. (:documentation "")) (defun make-socket (&key socket)

1 0

[usocket-cvs] r334 - usocket/branches/hans
by hhubner＠common-lisp.net 23 Apr '08

23 Apr '08

Author: hhubner Date: Wed Apr 23 17:24:15 2008 New Revision: 334 Modified: usocket/branches/hans/README usocket/branches/hans/usocket.lisp Log: Add set-socket-timeouts stub and documentation. Modified: usocket/branches/hans/README ============================================================================== --- usocket/branches/hans/README (original) +++ usocket/branches/hans/README Wed Apr 23 17:24:15 2008 @@ -95,8 +95,6 @@ the return value of which satisfies the normal stream interface - - Errors: - address-in-use-error - address-not-available-error Modified: usocket/branches/hans/usocket.lisp ============================================================================== --- usocket/branches/hans/usocket.lisp (original) +++ usocket/branches/hans/usocket.lisp Wed Apr 23 17:24:15 2008 @@ -159,6 +159,13 @@ "Returns the IP address and port of the peer the socket is connected to as values.")) +(defgeneric set-socket-timeouts (socket read-timeout write-timeout) + (:documentation "Set the SO_RCVTIMEO and SO_SNDTIMEO socket options +for the SOCKET. Both READ-TIMEOUT and WRITE-TIMEOUT are speficied in +\(fractional) seconds.") + (:method ((usocket usocket) read-timeout write-timeout) + (set-socket-timeouts (socket usocket) read-timeout write-timeout))) + (defmacro with-connected-socket ((var socket) &body body) "Bind `socket' to `var', ensuring socket destruction on exit.

1 0

[usocket-cvs] r333 - usocket/branches/hans
by hhubner＠common-lisp.net 23 Apr '08

23 Apr '08

Author: hhubner Date: Wed Apr 23 17:21:02 2008 New Revision: 333 Added: usocket/branches/hans/ - copied from r332, usocket/trunk/ Log: Create branch to receive ITA changes

1 0

[usocket-cvs] r332 - in usocket/branches: 0.3.x/backend 0.4.x/backend
by ehuelsmann＠common-lisp.net 11 Apr '08

11 Apr '08

Author: ehuelsmann Date: Fri Apr 11 17:52:19 2008 New Revision: 332 Modified: usocket/branches/0.3.x/backend/openmcl.lisp usocket/branches/0.4.x/backend/openmcl.lisp Log: Backport r328 to 0.3.x and 0.4.x branches. Modified: usocket/branches/0.3.x/backend/openmcl.lisp ============================================================================== --- usocket/branches/0.3.x/backend/openmcl.lisp (original) +++ usocket/branches/0.3.x/backend/openmcl.lisp Fri Apr 11 17:52:19 2008 @@ -39,10 +39,10 @@ (dolist (sock sockets) (ccl::fd-set (socket-os-fd sock infds)) (ccl::fd-set (socket-os-fd sock errfds))) - (let* ((res (ccl::syscall syscalls::select - (1+ (apply #'max fds)) - infds (ccl::%null-ptr) errfds - (if ticks-to-wait tv (ccl::%null-ptr))))) + (let* ((res (#_select + (1+ (apply #'max fds)) + infds (ccl::%null-ptr) errfds + (if ticks-to-wait tv (ccl::%null-ptr))))) (when (> res 0) (remove-if #'(lambda (x) (not (ccl::fd-is-set (socket-os-fd x) infds))) 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 Fri Apr 11 17:52:19 2008 @@ -5,15 +5,6 @@ (in-package :usocket) -(eval-when (:compile-toplevel :load-toplevel :execute) - ;; also present in OpenMCL l1-sockets.lisp - #+linuxppc-target - (require "LINUX-SYSCALLS") - #+darwinppc-target - (require "DARWIN-SYSCALLS") - #+darwinx86-target - (require "DARWINX8664-SYSCALLS")) - (defun get-host-name () (ccl::%stack-block ((resultbuf 256)) (when (zerop (#_gethostname resultbuf 256)) @@ -48,9 +39,9 @@ (let ((fd (openmcl-socket:socket-os-fd sock))) (setf max-fd (max max-fd fd)) (ccl::fd-set fd infds))) - (let* ((res (ccl::syscall syscalls::select (1+ max-fd) - infds (ccl::%null-ptr) (ccl::%null-ptr) - (if ticks-to-wait tv (ccl::%null-ptr))))) + (let* ((res (#_select (1+ max-fd) + infds (ccl::%null-ptr) (ccl::%null-ptr) + (if ticks-to-wait tv (ccl::%null-ptr))))) (when (> res 0) (remove-if #'(lambda (x) (not (ccl::fd-is-set (openmcl-socket:socket-os-fd x)

1 0

[usocket-cvs] r331 - in usocket/branches: 0.3.x 0.4.x
by ehuelsmann＠common-lisp.net 11 Apr '08

11 Apr '08

Author: ehuelsmann Date: Fri Apr 11 17:48:26 2008 New Revision: 331 Modified: usocket/branches/0.3.x/usocket.lisp usocket/branches/0.4.x/usocket.lisp Log: Backport r327 to 0.3.x and 0.4.x branches. Modified: usocket/branches/0.3.x/usocket.lisp ============================================================================== --- usocket/branches/0.3.x/usocket.lisp (original) +++ usocket/branches/0.3.x/usocket.lisp Fri Apr 11 17:48:26 2008 @@ -128,7 +128,8 @@ `(let ((,var ,socket)) (unwind-protect (when ,var - ,@body) + (with-mapped-conditions (,var) + ,@body)) (when ,var (socket-close ,var))))) Modified: usocket/branches/0.4.x/usocket.lisp ============================================================================== --- usocket/branches/0.4.x/usocket.lisp (original) +++ usocket/branches/0.4.x/usocket.lisp Fri Apr 11 17:48:26 2008 @@ -162,7 +162,8 @@ `(let ((,var ,socket)) (unwind-protect (when ,var - ,@body) + (with-mapped-conditions (,var) + ,@body)) (when ,var (socket-close ,var)))))

1 0

[usocket-cvs] r330 - in usocket/branches: 0.3.x 0.4.x
by ehuelsmann＠common-lisp.net 11 Apr '08

11 Apr '08

Author: ehuelsmann Date: Fri Apr 11 17:47:32 2008 New Revision: 330 Modified: usocket/branches/0.3.x/package.lisp usocket/branches/0.4.x/package.lisp Log: Backport r326 to 0.3.x and 0.4.x branches. Modified: usocket/branches/0.3.x/package.lisp ============================================================================== --- usocket/branches/0.3.x/package.lisp (original) +++ usocket/branches/0.3.x/package.lisp Fri Apr 11 17:47:32 2008 @@ -40,6 +40,7 @@ #:ip= #:ip/= + #:with-mapped-conditions #:socket-condition ; conditions #:ns-condition #:socket-error ; errors Modified: usocket/branches/0.4.x/package.lisp ============================================================================== --- usocket/branches/0.4.x/package.lisp (original) +++ usocket/branches/0.4.x/package.lisp Fri Apr 11 17:47:32 2008 @@ -42,6 +42,7 @@ #:ip= #:ip/= + #:with-mapped-conditions #:socket-condition ; conditions #:ns-condition #:socket-error ; errors

1 0

[usocket-cvs] r329 - in usocket/branches: 0.3.x 0.4.x
by ehuelsmann＠common-lisp.net 11 Apr '08

11 Apr '08

Author: ehuelsmann Date: Fri Apr 11 17:46:29 2008 New Revision: 329 Modified: usocket/branches/0.3.x/condition.lisp usocket/branches/0.4.x/condition.lisp Log: Backport r325 to 0.3.x and 0.4.x branches. Modified: usocket/branches/0.3.x/condition.lisp ============================================================================== --- usocket/branches/0.3.x/condition.lisp (original) +++ usocket/branches/0.3.x/condition.lisp Fri Apr 11 17:46:29 2008 @@ -149,7 +149,7 @@ ((50 100) . network-down-error) ((52 102) . network-reset-error) ((58 108) . already-shutdown-error) - ((60 110) . connection-timeout-error) + ((60 110) . timeout-error) ((64 112) . host-down-error) ((65 113) . host-unreachable-error))) Modified: usocket/branches/0.4.x/condition.lisp ============================================================================== --- usocket/branches/0.4.x/condition.lisp (original) +++ usocket/branches/0.4.x/condition.lisp Fri Apr 11 17:46:29 2008 @@ -148,7 +148,7 @@ ((50 100) . network-down-error) ((52 102) . network-reset-error) ((58 108) . already-shutdown-error) - ((60 110) . connection-timeout-error) + ((60 110) . timeout-error) ((64 112) . host-down-error) ((65 113) . host-unreachable-error)))

1 0

[usocket-cvs] r328 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 11 Apr '08

11 Apr '08

Author: ehuelsmann Date: Fri Apr 11 17:24:24 2008 New Revision: 328 Modified: usocket/trunk/backend/openmcl.lisp Log: Use #_select instead of syscalls; by Hans Huebner (hans at huebner dot org). Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Fri Apr 11 17:24:24 2008 @@ -5,15 +5,6 @@ (in-package :usocket) -(eval-when (:compile-toplevel :load-toplevel :execute) - ;; also present in OpenMCL l1-sockets.lisp - #+linuxppc-target - (require "LINUX-SYSCALLS") - #+darwinppc-target - (require "DARWIN-SYSCALLS") - #+darwinx86-target - (require "DARWINX8664-SYSCALLS")) - (defun get-host-name () (ccl::%stack-block ((resultbuf 256)) (when (zerop (#_gethostname resultbuf 256)) @@ -48,9 +39,9 @@ (let ((fd (openmcl-socket:socket-os-fd sock))) (setf max-fd (max max-fd fd)) (ccl::fd-set fd infds))) - (let* ((res (ccl::syscall syscalls::select (1+ max-fd) - infds (ccl::%null-ptr) (ccl::%null-ptr) - (if ticks-to-wait tv (ccl::%null-ptr))))) + (let* ((res (#_select (1+ max-fd) + infds (ccl::%null-ptr) (ccl::%null-ptr) + (if ticks-to-wait tv (ccl::%null-ptr))))) (when (> res 0) (remove-if #'(lambda (x) (not (ccl::fd-is-set (openmcl-socket:socket-os-fd x)

1 0

[usocket-cvs] r327 - usocket/trunk
by ehuelsmann＠common-lisp.net 11 Apr '08

11 Apr '08

Author: ehuelsmann Date: Fri Apr 11 17:17:32 2008 New Revision: 327 Modified: usocket/trunk/usocket.lisp Log: Wrap section with WITH-MAPPED-CONDITIONS; by Hans Huebner (hans at huebner dot org). Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Fri Apr 11 17:17:32 2008 @@ -168,7 +168,8 @@ `(let ((,var ,socket)) (unwind-protect (when ,var - ,@body) + (with-mapped-conditions (,var) + ,@body)) (when ,var (socket-close ,var)))))

1 0