February 2006 - usocket-cvs@common-lisp.net

[usocket-cvs] r84 - in usocket/trunk: backend test
by ehuelsmann＠common-lisp.net 12 Feb '06

12 Feb '06

Author: ehuelsmann Date: Sun Feb 12 14:17:34 2006 New Revision: 84 Modified: usocket/trunk/backend/openmcl.lisp usocket/trunk/test/test-usocket.lisp Log: More OpenMCL fixes. Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Sun Feb 12 14:17:34 2006 @@ -23,15 +23,20 @@ (:access-denied . operation-not-permitted-error))) +(defun raise-error-from-id (condition-id socket real-condition) + (let ((usock-err (cdr (assoc condition-id +openmcl-error-map+)))) + (if usock-err + (error usock-err :socket socket) + (error 'unknown-error :socket socket :real-error real-condition))) + (defun handle-condition (condition &optional socket) (typecase condition (openmcl-socket:socket-error - (let ((usock-err - (cdr (assoc (openmcl-socket:socket-error-identifier condition) - +openmcl-error-map+)))) - (if usock-err - (error usock-err :socket socket) - (error 'unknown-error :socket socket :real-error condition)))) + (raise-error-from-id (openmcl-socket:socket-error-identifier condition) + socket condition)) + (ccl::socket-creation-error #| ugh! |# + (raise-error-from-id (ccl::socket-creationg-error-idenitifier condition) + socket condition)) (error (error 'unknown-error :socket socket :real-error condition)) (condition (signal 'unknown-condition :real-condition condition)))) Modified: usocket/trunk/test/test-usocket.lisp ============================================================================== --- usocket/trunk/test/test-usocket.lisp (original) +++ usocket/trunk/test/test-usocket.lisp Sun Feb 12 14:17:34 2006 @@ -58,10 +58,12 @@ nil) (deftest socket-failure.1 - (with-caught-conditions (#-(or cmu lispworks armedbear) + (with-caught-conditions (#-(or cmu lispworks armedbear openmcl) 'usocket:network-unreachable-error #+(or cmu lispworks armedbear) 'usocket:unknown-error + #+openmcl + 'usocket:timeout-error nil) (usocket:socket-connect 2130706432 80) ;; == #(127 0 0 0) :unreach) @@ -71,7 +73,9 @@ 'usocket:unknown-error #+cmu 'usocket:network-unreachable-error - #-(or lispworks armedbear cmu) + #+openmcl + 'usocket:timeout-error + #-(or lispworks armedbear cmu openmcl) 'usocket:host-unreachable-error nil) (usocket:socket-connect +non-existing-host+ 80) ;; == #(127 0 0 0)

1 0

[usocket-cvs] r83 - in usocket/trunk: . backend test
by ehuelsmann＠common-lisp.net 12 Feb '06

12 Feb '06

Author: ehuelsmann Date: Sun Feb 12 13:27:25 2006 New Revision: 83 Modified: usocket/trunk/ (props changed) usocket/trunk/backend/ (props changed) usocket/trunk/test/ (props changed) Log: Add OpenMCL fasls to ignores list.

1 0

[usocket-cvs] r82 - public_html
by ehuelsmann＠common-lisp.net 12 Feb '06

12 Feb '06

Author: ehuelsmann Date: Sun Feb 12 07:39:23 2006 New Revision: 82 Modified: public_html/index.shtml Log: Update website. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Sun Feb 12 07:39:23 2006 @@ -20,6 +20,9 @@ possible, while keeping the abstraction and portability layer as thin as possible. </p> +<p>If your lisp isn't mentioned in the table below, please feel free to +submit a request for it at the mailing list mentioned below.</p> + <h2>Community</h2> <p>This project has recently started. There isn't much of a community @@ -135,11 +138,11 @@ <td class="PASS">PASS</td> <td class="PASS">PASS</td> <td class="PASS">PASS</td> - <td class="UNTESTED" title="Untested">?</td> + <td class="FAIL">FAIL</td> </tr> <tr> - <td rowspan="2">Add functions to retrieve socket properties.<br /> - Such as local and remote IP address and port.</td> + <td rowspan="2">Add functions to retrieve socket properties:<br /> + Local and remote IP address and port.</td> <td>Investigate interfaces provided</td> <td class="TODO">TODO</td> <td class="TODO">TODO</td> @@ -172,7 +175,7 @@ <td class="TODO">TODO</td> </tr> <tr> - <td>Implement more uncommon api calls such as send, sendto and read + <td>Implement more uncommon api calls such as send and recv for tcp streams.</td> <td class="TODO">TODO</td> <td class="TODO">TODO</td>

1 0

[usocket-cvs] r81 - public_html
by ehuelsmann＠common-lisp.net 12 Feb '06

12 Feb '06

Author: ehuelsmann Date: Sun Feb 12 04:13:16 2006 New Revision: 81 Modified: public_html/index.shtml Log: Update website with more explicit plans. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Sun Feb 12 04:13:16 2006 @@ -172,7 +172,20 @@ <td class="TODO">TODO</td> </tr> <tr> - <td>Implement passive socket support.</td> + <td>Implement more uncommon api calls such as send, sendto and read + for tcp streams.</td> + <td class="TODO">TODO</td> + <td class="TODO">TODO</td> + <td class="TODO">TODO</td> + <td class="TODO">TODO</td> + <td class="TODO">TODO</td> + <td class="TODO">TODO</td> + <td class="TODO">TODO</td> + </tr> + <tr> + <td>Implement udp socket support.</td> + <td>Investigate API's provided and build on top of that + (or custom ffi).</td> <td class="TODO">TODO</td> <td class="TODO">TODO</td> <td class="TODO">TODO</td>

1 0

[usocket-cvs] r80 - usocket/trunk
by ehuelsmann＠common-lisp.net 12 Feb '06

12 Feb '06

Author: ehuelsmann Date: Sun Feb 12 04:09:49 2006 New Revision: 80 Modified: usocket/trunk/Makefile (contents, props changed) Log: Ajust for use with svn and set keywords. Modified: usocket/trunk/Makefile ============================================================================== --- usocket/trunk/Makefile (original) +++ usocket/trunk/Makefile Sun Feb 12 04:09:49 2006 @@ -1,9 +1,9 @@ # $Id$ -# $Source$ +# $URL$ clean: - find -name -o -name "*~" -o -name "*.err" -o -name "*.x86f" -o -name "*.lib" -o -name "*.fas" -o -name "*.fasl" -o -name "*.faslmt" -o -name "*.ufsl" -o -name "*.abcl" | xargs rm + find -name -o -name "*~" -o -name "*.err" -o -name "*.x86f" -o -name "*.lib" -o -name "*.fas" -o -name "*.fasl" -o -name "*.faslmt" -o -name "*.ufsl" -o -name "*.abcl" | xargs rm commit: - make clean; cvs up; cvs ci + make clean; svn up; svn ci

1 0

[usocket-cvs] r79 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 11 Feb '06

11 Feb '06

Author: ehuelsmann Date: Sat Feb 11 17:27:34 2006 New Revision: 79 Modified: usocket/trunk/backend/openmcl.lisp Log: Fix return type of socket-connect. Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Sat Feb 11 17:27:34 2006 @@ -36,12 +36,12 @@ (condition (signal 'unknown-condition :real-condition condition)))) (defun socket-connect (host port) - (let ((sock)) - (with-mapped-conditions (sock) - (setf sock - (openmcl-socket:make-socket :remote-host (host-to-hostname host) - :remote-port port)) - (openmcl-socket:socket-connect sock)))) + (with-mapped-conditions () + (let ((mcl-sock (openmcl-socket:make-socket :remote-host + (host-to-hostname host) + :remote-port port))) + (openmcl-socket:socket-connect mcl-sock) + (make-socket :stream mcl-sock :socket mcl-sock)))) (defmethod socket-close ((usocket usocket)) (with-mapped-conditions (usocket)

1 0

[usocket-cvs] r78 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 11 Feb '06

11 Feb '06

Author: ehuelsmann Date: Sat Feb 11 17:18:52 2006 New Revision: 78 Modified: usocket/trunk/backend/openmcl.lisp Log: Adjust package prefixes. Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Sat Feb 11 17:18:52 2006 @@ -25,9 +25,10 @@ (defun handle-condition (condition &optional socket) (typecase condition - (socket-error - (let ((usock-err (cdr (assoc (socket:socket-error-identifier condition) - +openmcl-error-map+)))) + (openmcl-socket:socket-error + (let ((usock-err + (cdr (assoc (openmcl-socket:socket-error-identifier condition) + +openmcl-error-map+)))) (if usock-err (error usock-err :socket socket) (error 'unknown-error :socket socket :real-error condition)))) @@ -38,10 +39,10 @@ (let ((sock)) (with-mapped-conditions (sock) (setf sock - (socket:make-socket :remote-host (host-to-hostname host) - :remote-port port)) - (socket:socket-connect sock)))) + (openmcl-socket:make-socket :remote-host (host-to-hostname host) + :remote-port port)) + (openmcl-socket:socket-connect sock)))) (defmethod socket-close ((usocket usocket)) (with-mapped-conditions (usocket) - (socket:close (socket usocket)))) + (close (socket usocket))))

1 0

[usocket-cvs] r77 - in usocket/trunk: . test
by ehuelsmann＠common-lisp.net 11 Feb '06

11 Feb '06

Author: ehuelsmann Date: Sat Feb 11 16:57:04 2006 New Revision: 77 Added: usocket/trunk/test/abcl.conf.in usocket/trunk/test/allegro.conf.in usocket/trunk/test/clisp.conf.in usocket/trunk/test/cmucl.conf.in usocket/trunk/test/sbcl.conf.in usocket/trunk/test/your-lisp.conf.in Modified: usocket/trunk/run-usocket-tests.sh usocket/trunk/test/ (props changed) Log: Change test script to take arguments from .conf files and add those. Modified: usocket/trunk/run-usocket-tests.sh ============================================================================== --- usocket/trunk/run-usocket-tests.sh (original) +++ usocket/trunk/run-usocket-tests.sh Sat Feb 11 16:57:04 2006 @@ -9,21 +9,31 @@ # I have installed: cmucl, ABCL, clisp, allegro and lispworks cd `dirname $0`/test +rm tests.log if test -z "$1" ; then - lisps="sbcl clisp $HOME/src/acl/acl70_trial/alisp" + lisps=*.conf else lisps=$1 fi -for my_lisp in $lisps ; do +for my_lisp_conf in $lisps ; do -# *.fasl are used by both sbcl and allegro, -# so remove them to prevent choking either args= -if test "`basename $my_lisp`" == "alisp" ; then - args=-batch +lisp_bin= +lisp_name= +lisp_exit="(quit result)" + +. $my_lisp_conf + +if test -z "$lisp_bin" ; then + echo "YOU NEED TO SET A LISP BINARY IN YOUR CONF FILE" + exit 1 +fi + +if test -z "$lisp_name" ; then + lisp_name="`basename \"$lisp_bin\"`" fi echo " @@ -32,11 +42,16 @@ (asdf:operate #-sbcl 'asdf:load-source-op #+sbcl 'asdf:load-op :usocket-test) -(usocket-test:do-tests) +(let ((result (if (usocket-test:do-tests) 1 0))) + $lisp_exit) +" | $lisp_bin $args -#-allegro (quit) -" | $my_lisp $args +if test $? -eq 1 ; then + echo "PASS: $lisp_name" >> tests.log +else + echo "FAIL: $lisp_name" >> tests.log +fi -echo "Above test results for $my_lisp." +echo "Above the test results gathered for $lisp_name." done Added: usocket/trunk/test/abcl.conf.in ============================================================================== --- (empty file) +++ usocket/trunk/test/abcl.conf.in Sat Feb 11 16:57:04 2006 @@ -0,0 +1,10 @@ +# lisp binary test setup file + +args= + +# lisp_bin is required! +lisp_bin=~/src/abcl-0.0.9/abcl +lisp_name=ArmedBear + +# lisp_exit is required! +lisp_exit="(quit :status result)" Added: usocket/trunk/test/allegro.conf.in ============================================================================== --- (empty file) +++ usocket/trunk/test/allegro.conf.in Sat Feb 11 16:57:04 2006 @@ -0,0 +1,10 @@ +# lisp binary test setup file + +args="-batch" + +# lisp_bin is required! +lisp_bin="~/src/acl/acl70_trial/alisp" +lisp_name=Allegro + +# lisp_exit is required! +lisp_exit="(exit result :no-unwind t)" Added: usocket/trunk/test/clisp.conf.in ============================================================================== --- (empty file) +++ usocket/trunk/test/clisp.conf.in Sat Feb 11 16:57:04 2006 @@ -0,0 +1,10 @@ +# lisp binary test setup file + +args= + +# lisp_bin is required! +lisp_bin=clisp +lisp_name=clisp + +# lisp_exit is required! +lisp_exit="(quit result)" Added: usocket/trunk/test/cmucl.conf.in ============================================================================== --- (empty file) +++ usocket/trunk/test/cmucl.conf.in Sat Feb 11 16:57:04 2006 @@ -0,0 +1,10 @@ +# lisp binary test setup file + +args= + +# lisp_bin is required! +lisp_bin="~/src/bin/lisp" +lisp_name=CMUCL + +# lisp_exit is required! +lisp_exit="(unix:unix-exit result)" Added: usocket/trunk/test/sbcl.conf.in ============================================================================== --- (empty file) +++ usocket/trunk/test/sbcl.conf.in Sat Feb 11 16:57:04 2006 @@ -0,0 +1,10 @@ +# lisp binary test setup file + +args= + +# lisp_bin is required! +lisp_bin=sbcl +lisp_name=SBCL + +# lisp_exit is required! +lisp_exit="(quit status :recklessly-p t)" Added: usocket/trunk/test/your-lisp.conf.in ============================================================================== --- (empty file) +++ usocket/trunk/test/your-lisp.conf.in Sat Feb 11 16:57:04 2006 @@ -0,0 +1,10 @@ +# lisp binary test setup file + +args= + +# lisp_bin is required! +lisp_bin=<path-to-your-lisp-binary-here> +lisp_name= + +# lisp_exit is required! +lisp_exit=

1 0

[usocket-cvs] r76 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 11 Feb '06

11 Feb '06

Author: ehuelsmann Date: Sat Feb 11 16:39:07 2006 New Revision: 76 Modified: usocket/trunk/backend/openmcl.lisp Log: Add package prefixes. Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Sat Feb 11 16:39:07 2006 @@ -26,7 +26,7 @@ (defun handle-condition (condition &optional socket) (typecase condition (socket-error - (let ((usock-err (cdr (assoc (socket-error-identifier condition) + (let ((usock-err (cdr (assoc (socket:socket-error-identifier condition) +openmcl-error-map+)))) (if usock-err (error usock-err :socket socket) @@ -38,10 +38,10 @@ (let ((sock)) (with-mapped-conditions (sock) (setf sock - (make-socket :remote-host (host-to-hostname host) - :remote-port port)) - (socket-connect sock)))) + (socket:make-socket :remote-host (host-to-hostname host) + :remote-port port)) + (socket:socket-connect sock)))) (defmethod socket-close ((usocket usocket)) (with-mapped-conditions (usocket) - (close (socket usocket)))) + (socket:close (socket usocket))))

1 0

[usocket-cvs] r75 - usocket/trunk/test
by ehuelsmann＠common-lisp.net 11 Feb '06

11 Feb '06

Author: ehuelsmann Date: Sat Feb 11 16:09:28 2006 New Revision: 75 Modified: usocket/trunk/test/test-usocket.lisp Log: Always print error information. Modified: usocket/trunk/test/test-usocket.lisp ============================================================================== --- usocket/trunk/test/test-usocket.lisp (original) +++ usocket/trunk/test/test-usocket.lisp Sat Feb 11 16:09:28 2006 @@ -5,6 +5,34 @@ (in-package :usocket-test) +(defmacro with-caught-conditions ((expect throw) &body body) + `(catch 'caught-error + (handler-case + (progn ,@body) + (usocket:unknown-error (c) (if (typep c ,expect) + (throw 'caught-error ,throw) + (progn + (describe c) + (describe + (usocket::usocket-real-error c)) + c))) + (error (c) (if (typep c ,expect) + (throw 'caught-error ,throw) + (progn + (describe c) + c))) + (usocket:unknown-condition (c) (if (typep c ,expect) + (throw 'caught-error ,throw) + (progn + (describe c) + (describe + (usocket::usocket-real-condition c)) + c))) + (condition (c) (if (typep c ,expect) + (throw 'caught-error ,throw) + (progn + (describe c) + c)))))) (defparameter +non-existing-host+ "10.0.0.13") (defparameter *soc1* (usocket::make-socket :socket :my-socket @@ -14,87 +42,79 @@ (deftest make-socket.2 (usocket:socket-stream *soc1*) :my-stream) (deftest socket-no-connect.1 - (catch 'caught-error - (handler-bind ((usocket:socket-error - #'(lambda (c) (throw 'caught-error nil)))) + (with-caught-conditions ('usocket:socket-error nil) (usocket:socket-connect "127.0.0.0" 80) - t)) + t) nil) (deftest socket-no-connect.2 - (catch 'caught-error - (handler-bind ((usocket:socket-error - #'(lambda (c) (throw 'caught-error nil)))) - (usocket:socket-connect #(127 0 0 0) 80) - t)) + (with-caught-conditions ('usocket:socket-error nil) + (usocket:socket-connect #(127 0 0 0) 80) + t) nil) (deftest socket-no-connect.3 - (catch 'caught-error - (handler-bind ((usocket:socket-error - #'(lambda (c) (throw 'caught-error nil)))) - (usocket:socket-connect 2130706432 80) ;; == #(127 0 0 0) - t)) + (with-caught-conditions ('usocket:socket-error nil) + (usocket:socket-connect 2130706432 80) ;; == #(127 0 0 0) + t) nil) (deftest socket-failure.1 - (catch 'caught-error - (handler-bind ((usocket:network-unreachable-error - #'(lambda (c) (throw 'caught-error nil))) - ;; some lisps don't report as specific as above - #+(or cmu lispworks armedbear) - (usocket:unknown-error - #'(lambda (c) (throw 'caught-error nil))) - (condition - #'(lambda (c) (throw 'caught-error t)))) - (usocket:socket-connect 2130706432 80) ;; == #(127 0 0 0) - :unreach)) + (with-caught-conditions (#-(or cmu lispworks armedbear) + 'usocket:network-unreachable-error + #+(or cmu lispworks armedbear) + 'usocket:unknown-error + nil) + (usocket:socket-connect 2130706432 80) ;; == #(127 0 0 0) + :unreach) nil) (deftest socket-failure.2 - (catch 'caught-error - (handler-bind ((usocket:host-unreachable-error - #'(lambda (c) (throw 'caught-error nil))) - ;; some lisps don't report as specific as above - #+(or cmu lispworks armedbear) - (usocket:unknown-error - #'(lambda (c) (throw 'caught-error nil))) - (condition - #'(lambda (c) (throw 'caught-error t)))) + (with-caught-conditions (#+(or lispworks armedbear) + 'usocket:unknown-error + #+cmu + 'usocket:network-unreachable-error + #-(or lispworks armedbear cmu) + 'usocket:host-unreachable-error + nil) (usocket:socket-connect +non-existing-host+ 80) ;; == #(127 0 0 0) - :unreach)) + :unreach) nil) ;; let's hope c-l.net doesn't move soon, or that people start to ;; test usocket like crazy.. (deftest socket-connect.1 - (let ((sock (usocket:socket-connect "common-lisp.net" 80))) - (unwind-protect - (typep sock 'usocket:usocket) - (usocket:socket-close sock))) - t) + (with-caught-conditions (nil nil) + (let ((sock (usocket:socket-connect "common-lisp.net" 80))) + (unwind-protect + (typep sock 'usocket:usocket) + (usocket:socket-close sock)))) + t) (deftest socket-connect.2 - (let ((sock (usocket:socket-connect #(65 110 12 237) 80))) - (unwind-protect - (typep sock 'usocket:usocket) - (usocket:socket-close sock))) + (with-caught-conditions (nil nil) + (let ((sock (usocket:socket-connect #(65 110 12 237) 80))) + (unwind-protect + (typep sock 'usocket:usocket) + (usocket:socket-close sock)))) t) (deftest socket-connect.3 - (let ((sock (usocket:socket-connect 1097731309 80))) - (unwind-protect - (typep sock 'usocket:usocket) - (usocket:socket-close sock))) + (with-caught-conditions (nil nil) + (let ((sock (usocket:socket-connect 1097731309 80))) + (unwind-protect + (typep sock 'usocket:usocket) + (usocket:socket-close sock)))) t) ;; let's hope c-l.net doesn't change its software any time soon (deftest socket-stream.1 - (let ((sock (usocket:socket-connect "common-lisp.net" 80))) - (unwind-protect - (progn - (format (usocket:socket-stream sock) - "GET / HTTP/1.0~A~A~A~A" - #\Return #\Newline #\Return #\Newline) - (force-output (usocket:socket-stream sock)) - (read-line (usocket:socket-stream sock))) - (usocket:socket-close sock))) + (with-caught-conditions (nil nil) + (let ((sock (usocket:socket-connect "common-lisp.net" 80))) + (unwind-protect + (progn + (format (usocket:socket-stream sock) + "GET / HTTP/1.0~A~A~A~A" + #\Return #\Newline #\Return #\Newline) + (force-output (usocket:socket-stream sock)) + (read-line (usocket:socket-stream sock))) + (usocket:socket-close sock)))) #+clisp "HTTP/1.1 200 OK" #-clisp #.(format nil "HTTP/1.1 200 OK~A" #\Return) nil)

1 0