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

[usocket-cvs] r288 - in usocket/trunk: . backend
by ehuelsmann＠common-lisp.net 17 Sep '07

17 Sep '07

Author: ehuelsmann Date: Mon Sep 17 14:59:29 2007 New Revision: 288 Modified: usocket/trunk/backend/allegro.lisp usocket/trunk/backend/armedbear.lisp usocket/trunk/backend/clisp.lisp usocket/trunk/backend/lispworks.lisp usocket/trunk/backend/openmcl.lisp usocket/trunk/backend/sbcl.lisp usocket/trunk/usocket.lisp Log: Define datagram-usocket-p; ArmedBear depends on it. Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp (original) +++ usocket/trunk/backend/allegro.lisp Mon Sep 17 14:59:29 2007 @@ -89,7 +89,9 @@ (defmethod socket-accept ((socket stream-server-usocket) &key element-type) (declare (ignore element-type)) ;; allegro streams are multivalent - (let ((stream-sock (socket:accept-connection (socket socket)))) + (let ((stream-sock + (with-mapped-conditions (socket) + (socket:accept-connection (socket socket))))) (make-stream-socket :socket stream-sock :stream stream-sock))) (defmethod get-local-address ((usocket usocket)) Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Mon Sep 17 14:59:29 2007 @@ -216,19 +216,22 @@ "open")) (sock (jdi:do-jmethod-call chan "socket"))) (when reuseaddress + (with-mapped-conditions () + (jdi:do-jmethod-call sock + "setReuseAddress" + (jdi:jcoerce reuseaddress :boolean)))) + (with-mapped-conditions () (jdi:do-jmethod-call sock - "setReuseAddress" - (jdi:jcoerce reuseaddress :boolean))) - (jdi:do-jmethod-call sock - "bind" - (jdi:jcoerce sock-addr - "java.net.SocketAddress") - (jdi:jcoerce backlog :int)) + "bind" + (jdi:jcoerce sock-addr + "java.net.SocketAddress") + (jdi:jcoerce backlog :int))) (make-stream-server-socket chan :element-type element-type))) (defmethod socket-accept ((socket stream-server-usocket) &key element-type) (let* ((jsock (socket socket)) - (jacc-chan (jdi:do-jmethod-call jsock "accept")) + (jacc-chan (with-mapped-conditions (socket) + (jdi:do-jmethod-call jsock "accept"))) (jacc-stream (ext:get-socket-stream (jdi:jop-deref (jdi:do-jmethod-call jacc-chan "socket")) @@ -243,7 +246,7 @@ (defmethod socket-close ((usocket usocket)) (with-mapped-conditions (usocket) - (jdi:do-method (socket usocket) "close"))) + (jdi:do-jmethod (socket usocket) "close"))) ;; Socket streams are different objects than ;; socket streams. Closing the stream flushes Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Mon Sep 17 14:59:29 2007 @@ -81,13 +81,15 @@ :backlog backlog) (when (ip/= host *wildcard-host*) (list :interface host)))))) - (make-stream-server-socket sock :element-type element-type))) + (with-mapped-conditions () + (make-stream-server-socket sock :element-type element-type)))) (defmethod socket-accept ((socket stream-server-usocket) &key element-type) (let ((stream - (socket:socket-accept (socket socket) - :element-type (or element-type - (element-type socket))))) + (with-mapped-conditions (socket) + (socket:socket-accept (socket socket) + :element-type (or element-type + (element-type socket)))))) (make-stream-socket :socket stream :stream stream))) Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Mon Sep 17 14:59:29 2007 @@ -88,7 +88,8 @@ (make-stream-server-socket sock :element-type element-type))) (defmethod socket-accept ((usocket stream-server-usocket) &key element-type) - (let* ((sock (comm::get-fd-from-socket (socket usocket))) + (let* ((sock (with-mapped-conditions (usocket) + (comm::get-fd-from-socket (socket usocket)))) (stream (make-instance 'comm:socket-stream :socket sock :direction :io Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Mon Sep 17 14:59:29 2007 @@ -94,19 +94,21 @@ (backlog 5) (element-type 'character)) (let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress)) - (sock (apply #'openmcl-socket:make-socket - (append (list :connect :passive - :reuse-address reuseaddress - :local-port port - :backlog backlog - :format (to-format element-type)) - (when (ip/= host *wildcard-host*) - (list :local-host host)))))) + (sock (with-mapped-conditions () + (apply #'openmcl-socket:make-socket + (append (list :connect :passive + :reuse-address reuseaddress + :local-port port + :backlog backlog + :format (to-format element-type)) + (when (ip/= host *wildcard-host*) + (list :local-host host))))))) (make-stream-server-socket sock :element-type element-type))) (defmethod socket-accept ((usocket stream-server-usocket) &key element-type) (declare (ignore element-type)) ;; openmcl streams are bi/multivalent - (let ((sock (openmcl-socket:accept-connection (socket usocket)))) + (let ((sock (with-mapped-conditions (usocket) + (openmcl-socket:accept-connection (socket usocket))))) (make-stream-socket :socket sock :stream sock))) ;; One close method is sufficient because sockets Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Mon Sep 17 14:59:29 2007 @@ -207,18 +207,22 @@ (ip (host-to-vector-quad host)) (sock (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))) - (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))) + (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)))) (defmethod socket-accept ((socket stream-server-usocket) &key element-type) (let ((sock (sb-bsd-sockets:socket-accept (socket socket)))) - (make-stream-socket :socket sock - :stream (sb-bsd-sockets:socket-make-stream sock - :input t :output t :buffering :full - :element-type (or element-type - (element-type socket)))))) + (with-mapped-conditions (socket) + (make-stream-socket + :socket sock + :stream (sb-bsd-sockets:socket-make-stream + sock + :input t :output t :buffering :full + :element-type (or element-type + (element-type socket))))))) ;; Sockets and their associated streams are modelled as ;; different objects. Be sure to close the stream (which Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Mon Sep 17 14:59:29 2007 @@ -58,6 +58,10 @@ (defun stream-server-usocket-p (socket) (typep socket 'stream-server-usocket)) +(defun datagram-usocket-p (socket) + (declare (ignore socket)) + nil) + ;;Not in use yet: ;;(defclass datagram-usocket (usocket) ;; ()

1 0

[usocket-cvs] r287 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 04 Sep '07

04 Sep '07

Author: ehuelsmann Date: Tue Sep 4 18:54:28 2007 New Revision: 287 Modified: usocket/trunk/backend/clisp.lisp Log: Fix clisp problem pointed out by Matthew Kennedy and Yaroslav Kavenchuk. Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Tue Sep 4 18:54:28 2007 @@ -13,6 +13,8 @@ :OUT :ALLOCA) (len ffi:int)) #+win32 (:library "WS2_32") + (:language #-win32 :stdc + #+win32 :stdc-stdcall) (:return-type ffi:int)) @@ -73,7 +75,7 @@ (element-type 'character)) ;; clisp 2.39 sets SO_REUSEADDRESS to 1 by default; no need to ;; to explicitly turn it on; unfortunately, there's no way to turn it off... - (declare (ignore reuseaddress reuse-address)) + (declare (ignore reuseaddress reuse-address reuse-address-supplied-p)) (let ((sock (apply #'socket:socket-server (append (list port :backlog backlog)

1 0

[usocket-cvs] r286 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 04 Sep '07

04 Sep '07

Author: ehuelsmann Date: Tue Sep 4 18:52:04 2007 New Revision: 286 Modified: usocket/trunk/backend/sbcl.lisp Log: Fix sbcl/ecl problems pointed out by Yaroslav Kavenchuk <kavenchuk(a)gmail.com>. Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Tue Sep 4 18:52:04 2007 @@ -32,7 +32,7 @@ (sb-alien:cast buf (* sb-alien:char)) 256))) (when (= result 0) - (cast buf sb-alien:c-string)))))) + (sb-alien:cast buf sb-alien:c-string)))))) #+ecl @@ -48,8 +48,7 @@ "#include <winsock2.h>") (ffi:clines - "#include <ecl/ecl-inl.h>" - "#include <string.h>") + "#include <ecl/ecl-inl.h>") #+:prefixed-api (ffi:clines @@ -67,13 +66,12 @@ (defun get-host-name () (ffi:c-inline () () :object - "{ char buf[256]; - int r = gethostname(&buf,256); + "{ char *buf = GC_malloc(256); - if (r == 0) - @(return) = make_simple_base_string(strndup(&buf,255)); + if (gethostname(buf,256) == 0) + @(return) = make_simple_base_string(buf); else - @(return) = Cnil; + @(return) = Cnil; }" :one-liner nil :side-effects nil)) (defun read-select (read-fds to-secs &optional (to-musecs 0))

1 0

[usocket-cvs] r285 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 12 Aug '07

12 Aug '07

Author: ehuelsmann Date: Sun Aug 12 19:09:55 2007 New Revision: 285 Modified: usocket/trunk/backend/openmcl.lisp Log: Fix eval-when evaluation conditions (fixing non-bound syscalls function). Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Sun Aug 12 19:09:55 2007 @@ -5,7 +5,7 @@ (in-package :usocket) -(eval-when (:compile-toplevel :execute) +(eval-when (:compile-toplevel :load-toplevel :execute) ;; also present in OpenMCL l1-sockets.lisp #+linuxppc-target (require "LINUX-SYSCALLS")

1 0

[usocket-cvs] r284 - usocket/trunk
by ehuelsmann＠common-lisp.net 12 Aug '07

12 Aug '07

Author: ehuelsmann Date: Sun Aug 12 18:38:57 2007 New Revision: 284 Modified: usocket/trunk/usocket.lisp Log: Fix error in wait-for-input where no timeout is specified: don't do number (real) comparison with NIL. Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Sun Aug 12 18:38:57 2007 @@ -203,10 +203,11 @@ (list socket-or-sockets)) :timeout timeout))) (values result - (let ((elapsed (/ (- (get-internal-real-time) start) - internal-time-units-per-second))) - (when (< elapsed timeout) - (- timeout elapsed)))))) + (when timeout + (let ((elapsed (/ (- (get-internal-real-time) start) + internal-time-units-per-second))) + (when (< elapsed timeout) + (- timeout elapsed))))))) ;; ;; IP(v4) utility functions

1 0

[usocket-cvs] r283 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 10 Aug '07

10 Aug '07

Author: ehuelsmann Date: Fri Aug 10 16:02:49 2007 New Revision: 283 Modified: usocket/trunk/backend/openmcl.lisp Log: Add support for Darwin x86. Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Fri Aug 10 16:02:49 2007 @@ -10,7 +10,9 @@ #+linuxppc-target (require "LINUX-SYSCALLS") #+darwinppc-target - (require "DARWIN-SYSCALLS")) + (require "DARWIN-SYSCALLS") + #+darwinx86-target + (require "DARWINX8664-SYSCALLS")) (defun get-host-name () (ccl::%stack-block ((resultbuf 256))

1 0

[usocket-cvs] r282 - usocket/branches/0.3.x
by ehuelsmann＠common-lisp.net 25 Jul '07

25 Jul '07

Author: ehuelsmann Date: Wed Jul 25 17:07:23 2007 New Revision: 282 Modified: usocket/branches/0.3.x/usocket.asd Log: Bump development version number. Modified: usocket/branches/0.3.x/usocket.asd ============================================================================== --- usocket/branches/0.3.x/usocket.asd (original) +++ usocket/branches/0.3.x/usocket.asd Wed Jul 25 17:07:23 2007 @@ -14,7 +14,7 @@ (defsystem usocket :name "usocket" :author "Erik Enge & Erik Huelsmann" - :version "0.3.4-dev" + :version "0.3.5-dev" :licence "MIT" :description "Universal socket library for Common Lisp" :depends-on (:split-sequence

1 0

[usocket-cvs] r281 - in public_html: . releases
by ehuelsmann＠common-lisp.net 25 Jul '07

25 Jul '07

Author: ehuelsmann Date: Wed Jul 25 17:06:55 2007 New Revision: 281 Added: public_html/releases/usocket-0.3.4.tar.gz (contents, props changed) public_html/releases/usocket-0.3.4.tar.gz.asc Modified: public_html/index.shtml Log: Publish 0.3.4 release. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Wed Jul 25 17:06:55 2007 @@ -391,6 +391,9 @@ <table> <caption>Release history</caption> <tr><th>Date</th><th>Release</th><th>Summary</th></tr> +<tr><td>Jul 25, 2007</td> + <td>0.3.4</td> + <td>Fix clisp get-host-name, multiple ECL fixes.</td></tr> <tr><td>Jun 05, 2007</td> <td>0.3.3</td> <td>Fix where host resolution routine was unable to resolve would return Added: public_html/releases/usocket-0.3.4.tar.gz ============================================================================== Binary file. No diff available. Added: public_html/releases/usocket-0.3.4.tar.gz.asc ============================================================================== --- (empty file) +++ public_html/releases/usocket-0.3.4.tar.gz.asc Wed Jul 25 17:06:55 2007 @@ -0,0 +1,7 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.6 (GNU/Linux) + +iD8DBQBGp7poi5O0Epaz9TkRAquYAJ0caUuBSktNHDyOm70Ob5iFQolOSQCfbA2x +HvXP91yO10XdOfmSjh0TWCA= +=u4fI +-----END PGP SIGNATURE-----

1 0

[usocket-cvs] r280 - usocket/tags/0.3.4
by ehuelsmann＠common-lisp.net 25 Jul '07

25 Jul '07

Author: ehuelsmann Date: Wed Jul 25 17:01:31 2007 New Revision: 280 Added: usocket/tags/0.3.4/ - copied from r279, usocket/branches/0.3.x/ Modified: usocket/tags/0.3.4/usocket.asd Log: Create 0.3.4 tag. Modified: usocket/tags/0.3.4/usocket.asd ============================================================================== --- usocket/branches/0.3.x/usocket.asd (original) +++ usocket/tags/0.3.4/usocket.asd Wed Jul 25 17:01:31 2007 @@ -14,7 +14,7 @@ (defsystem usocket :name "usocket" :author "Erik Enge & Erik Huelsmann" - :version "0.3.4-dev" + :version "0.3.4" :licence "MIT" :description "Universal socket library for Common Lisp" :depends-on (:split-sequence

1 0

[usocket-cvs] r279 - usocket/branches/0.3.x/backend
by ehuelsmann＠common-lisp.net 25 Jul '07

25 Jul '07

Author: ehuelsmann Date: Wed Jul 25 16:56:39 2007 New Revision: 279 Modified: usocket/branches/0.3.x/backend/sbcl.lisp Log: Backport r278 from trunk (fix use of stack allocated value in ECL). Modified: usocket/branches/0.3.x/backend/sbcl.lisp ============================================================================== --- usocket/branches/0.3.x/backend/sbcl.lisp (original) +++ usocket/branches/0.3.x/backend/sbcl.lisp Wed Jul 25 16:56:39 2007 @@ -42,19 +42,21 @@ "#include <sys/socket.h>" #+:wsock "#include <winsock2.h>" + + "#include <string.h>" ) (defun get-host-name () (ffi:c-inline - () () t + () () :object "{ char buf[256]; - int r = gethostname(&buf,256); + int = gethostname(&buf,256); if (r == 0) - @(return) = make_simple_base_string(&buf); + @(return) = make_simple_base_string(strndup(&buf,255)); else @(return) = Cnil; - }"))) + }" :one-liner nil :side-effects nil))) (defun map-socket-error (sock-err) (map-errno-error (sb-bsd-sockets::socket-error-errno sock-err)))

1 0