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

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

10 Feb '06

Author: ehuelsmann Date: Fri Feb 10 12:18:35 2006 New Revision: 68 Modified: public_html/index.shtml Log: Update website status diagram. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Fri Feb 10 12:18:35 2006 @@ -90,10 +90,10 @@ <td>Investigate interfaces provided.</td> <td class="DONE">DONE</td>  <td class="DONE">DONE</td>  - <td class="WIP" title="Work in progress">WIP</td>  + <td class="DONE">DONE</td>  <td class="DONE">DONE</td>  <td class="DONE">DONE</td>  - <td class="WIP" title="Work in progress">WIP</td>  + <td class="DONE">DONE</td>  <td class="DONE">DONE</td>  </tr> @@ -101,37 +101,37 @@ <td>Identify socket errors generated.</td> <td class="DONE" title="Implemented">DONE</td> <td class="DONE" title="Implemented">DONE</td> - <td class="WIP" title="Work in progress">WIP</td> + <td class="DONE" title="No specific errors available">DONE</td> + <td class="DONE" title="Implemented">DONE</td> <td class="DONE" title="Implemented">DONE</td> <td class="DONE" title="Implemented">DONE</td> <td class="DONE" title="Implemented">DONE</td> - <td class="TODO">TODO</td> </tr> <tr> <td>Implement active socket support.</td> <td class="DONE">DONE</td> <td class="DONE">DONE</td> - <td class="TODO">TODO</td> <td class="DONE">DONE</td> <td class="DONE">DONE</td> <td class="DONE">DONE</td> - <td class="TODO">TODO</td> + <td class="DONE">DONE</td> + <td class="WIP" title="Work in progress">WIP</td> </tr> <tr> <td>Implement remapping of implementation defined errors.</td> <td class="WIP" title="Work in progress">WIP</td> - <td class="WIP" title="Work in progress">WIP</td> - <td class="TODO">TODO</td> - <td class="WIP" title="Work in progress">WIP</td> + <td class="DONE">DONE</td> + <td class="DONE">DONE</td> + <td class="DONE">DONE</td> + <td class="DONE">DONE</td> <td class="DONE">DONE</td> <td class="WIP" title="Work in progress">WIP</td> - <td class="TODO">TODO</td> </tr> <tr> <td>Implementation test-suite status</td> <td class="PASS">PASS</td> <td class="PASS">PASS</td> - <td class="UNTESTED" title="Untested">?</td> + <td class="PASS">PASS</td> <td class="PASS">PASS</td> <td class="PASS">PASS</td> <td class="PASS">PASS</td>

1 0

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

10 Feb '06

Author: ehuelsmann Date: Fri Feb 10 11:41:41 2006 New Revision: 67 Modified: usocket/trunk/backend/armedbear.lisp Log: Remove debugging statement. Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Fri Feb 10 11:41:41 2006 @@ -8,7 +8,6 @@ (defun handle-condition (condition &optional socket) - (describe condition) (typecase condition (error (error 'unknown-error :socket socket :real-error condition))))

1 0

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

10 Feb '06

Author: ehuelsmann Date: Fri Feb 10 10:57:16 2006 New Revision: 66 Modified: usocket/trunk/backend/armedbear.lisp usocket/trunk/test/test-usocket.lisp Log: Fix Armedbear test failures. Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Fri Feb 10 10:57:16 2006 @@ -8,8 +8,9 @@ (defun handle-condition (condition &optional socket) + (describe condition) (typecase condition - (error (error 'unkown-error :socket socket :real-error condition)))) + (error (error 'unknown-error :socket socket :real-error condition)))) (defun socket-connect (host port) (let ((usock)) Modified: usocket/trunk/test/test-usocket.lisp ============================================================================== --- usocket/trunk/test/test-usocket.lisp (original) +++ usocket/trunk/test/test-usocket.lisp Fri Feb 10 10:57:16 2006 @@ -39,8 +39,8 @@ (catch 'caught-error (handler-bind ((usocket:network-unreachable-error #'(lambda (c) (throw 'caught-error nil))) - ;; cmu doesn't report as specific as above - #+(or cmu lispworks) + ;; some lisps don't report as specific as above + #+(or cmu lispworks armedbear) (usocket:unknown-error #'(lambda (c) (throw 'caught-error nil))) (condition @@ -52,8 +52,8 @@ (catch 'caught-error (handler-bind ((usocket:host-unreachable-error #'(lambda (c) (throw 'caught-error nil))) - ;; cmu doesn't report as specific as above - #+(or cmu lispworks) + ;; some lisps don't report as specific as above + #+(or cmu lispworks armedbear) (usocket:unknown-error #'(lambda (c) (throw 'caught-error nil))) (condition

1 0

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

09 Feb '06

Author: ehuelsmann Date: Thu Feb 9 16:08:30 2006 New Revision: 65 Modified: usocket/trunk/ (props changed) usocket/trunk/backend/ (props changed) usocket/trunk/test/ (props changed) Log: Update ignore patterns to accomodate Armedbear.

1 0

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

09 Feb '06

Author: ehuelsmann Date: Thu Feb 9 16:06:54 2006 New Revision: 64 Added: usocket/trunk/backend/armedbear.lisp (contents, props changed) usocket/trunk/backend/openmcl.lisp (contents, props changed) Modified: usocket/trunk/usocket.asd usocket/trunk/usocket.lisp Log: Add OpenMCL (untested) and Armedbear (tested with FAILures) support. Added: usocket/trunk/backend/armedbear.lisp ============================================================================== --- (empty file) +++ usocket/trunk/backend/armedbear.lisp Thu Feb 9 16:06:54 2006 @@ -0,0 +1,24 @@ +;;;; $Id$ +;;;; $URL$ + +;;;; See LICENSE for licensing information. + +(in-package :usocket) + + + +(defun handle-condition (condition &optional socket) + (typecase condition + (error (error 'unkown-error :socket socket :real-error condition)))) + +(defun socket-connect (host port) + (let ((usock)) + (with-mapped-conditions (usock) + (let ((sock (ext:make-socket (host-to-hostname host) port))) + (setf usock + (make-socket :socket sock + :stream (ext:get-socket-stream sock))))))) + +(defmethod socket-close ((usocket usocket)) + (with-mapped-conditions (usocket) + (ext:socket-close (socket usocket)))) Added: usocket/trunk/backend/openmcl.lisp ============================================================================== --- (empty file) +++ usocket/trunk/backend/openmcl.lisp Thu Feb 9 16:06:54 2006 @@ -0,0 +1,47 @@ +;;;; $Id$ +;;;; $URL$ + +;;;; See LICENSE for licensing information. + +(in-package :usocket) + + + +(defparameter +openmcl-error-map+ + '((:address-in-use . address-in-use-error) + (:connection-aborted . connection-aborted-error) + (:no-buffer-space . no-buffers-error) + (:connection-timed-out . timeout-error) + (:connection-refused . connection-refused-error) + (:host-unreachable . host-unreachable-error) + (:host-down . host-down-error) + (:network-down . network-down-error) + (:address-not-available . address-not-available-error) + (:network-reset . network-reset-error) + (:connection-reset . connection-reset-error) + (:shutdown . shutdown-error) + (:access-denied . operation-not-permitted-error))) + + +(defun handle-condition (condition &optional socket) + (typecase condition + (socket-error + (let ((usock-err (cdr (assoc (socket-error-identifier condition) + +openmcl-error-map+)))) + (if usock-err + (error usock-err :socket socket) + (error 'unknown-error :socket socket :real-erorr condition)))) + (error (error 'unknown-error :socket socket :real-erorr condition)) + (condition (signal 'unkown-condition :real-condition condition)))) + +(defun socket-connect (host port) + (let ((sock)) + (with-mapped-conditions (sock) + (setf sock + (make-socket :remote-host (host-to-hostname host) + :remote-port port)) + (socket-connect sock)))) + +(defmethod socket-close ((usocket usocket)) + (with-mapped-conditions (usocket) + (close (socket usocket)))) Modified: usocket/trunk/usocket.asd ============================================================================== --- usocket/trunk/usocket.asd (original) +++ usocket/trunk/usocket.asd Thu Feb 9 16:06:54 2006 @@ -36,4 +36,6 @@ :depends-on ("condition")) #+allegro (:file "allegro" :pathname "backend/allegro" :depends-on ("condition")) + #+armedbear (:file "armedbear" :pathname "backend/armedbear" + :depends-on ("condition")) )) Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Thu Feb 9 16:06:54 2006 @@ -98,29 +98,38 @@ ;; DNS helper functions ;; -#-clisp -(defun get-host-by-name (name) - (let ((hosts (get-hosts-by-name name))) - (car hosts))) - -#-clisp -(defun get-random-host-by-name (name) - (let ((hosts (get-hosts-by-name name))) - (elt hosts (random (length hosts))))) - -#-clisp -(defun host-to-vector-quad (host) - "Translate a host specification (vector quad, dotted quad or domain name) +#-(or clisp openmcl armedbear) +(progn + (defun get-host-by-name (name) + (let ((hosts (get-hosts-by-name name))) + (car hosts))) + + (defun get-random-host-by-name (name) + (let ((hosts (get-hosts-by-name name))) + (elt hosts (random (length hosts))))) + + (defun host-to-vector-quad (host) + "Translate a host specification (vector quad, dotted quad or domain name) to a vector quad." - (etypecase host - (string (let* ((ip (ignore-errors - (dotted-quad-to-vector-quad host)))) - (if (and ip (= 4 (length ip))) - ;; valid IP dotted quad? - ip - (get-random-host-by-name host)))) - ((vector t 4) host) - (integer (hbo-to-vector-quad host)))) + (etypecase host + (string (let* ((ip (ignore-errors + (dotted-quad-to-vector-quad host)))) + (if (and ip (= 4 (length ip))) + ;; valid IP dotted quad? + ip + (get-random-host-by-name host)))) + ((vector t 4) host) + (integer (hbo-to-vector-quad host)))) + + (defun host-to-hbo (host) + (etypecase host + (string (let ((ip (ignore-errors + (dotted-quad-to-vector-quad host)))) + (if (and ip (= 4 (length ip))) + ip + (host-to-hbo (get-host-by-name host))))) + ((vector t 4) (host-byte-order host)) + (integer host)))) (defun host-to-hostname (host) "Translate a string or vector quad to a stringified hostname." @@ -129,17 +138,6 @@ ((vector t 4) (vector-quad-to-dotted-quad host)) (integer (hbo-to-dotted-quad host)))) -#-clisp -(defun host-to-hbo (host) - (etypecase host - (string (let ((ip (ignore-errors - (dotted-quad-to-vector-quad host)))) - (if (and ip (= 4 (length ip))) - ip - (host-to-hbo (get-host-by-name host))))) - ((vector t 4) (host-byte-order host)) - (integer host))) - ;; ;; Setting of documentation for backend defined functions ;;

1 0

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

08 Feb '06

Author: ehuelsmann Date: Wed Feb 8 14:47:18 2006 New Revision: 63 Modified: usocket/trunk/usocket.lisp Log: Move function documentation out of the backend file. Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Wed Feb 8 14:47:18 2006 @@ -139,3 +139,15 @@ (host-to-hbo (get-host-by-name host))))) ((vector t 4) (host-byte-order host)) (integer host))) + +;; +;; Setting of documentation for backend defined functions +;; + +(setf (documentation 'socket-connect 'function) + "Connect to `host' on `port'. `host' is assumed to be a string of +an IP address represented in vector notation, such as #(192 168 1 1). +`port' is assumed to be an integer. + +Returns a usocket object.") +

1 0

[usocket-cvs] r62 - in usocket/trunk: . doc
by ehuelsmann＠common-lisp.net 08 Feb '06

08 Feb '06

Author: ehuelsmann Date: Wed Feb 8 14:45:56 2006 New Revision: 62 Added: usocket/trunk/TODO Modified: usocket/trunk/doc/design.txt Log: Add TODO and update design doc. Added: usocket/trunk/TODO ============================================================================== --- (empty file) +++ usocket/trunk/TODO Wed Feb 8 14:45:56 2006 @@ -0,0 +1,16 @@ + +- Check consistency of error translation for each of the backends + with the design document. + +- Move all function documentation from the backends to + (setf documentation) forms in usocket.lisp. + +- Extend ABCL socket support with the 4 java errors in java.net + so that they can map to our usocket errors instead of mapping + all errors to unknown-error. + +- Investigate which backends would support streams with other + elements than :element-type 'character, especially since + cl-irc chokes on characters which are non-UTF8 conforming... + Probably other clients do too (try that with a binary HTTP stream!) + Modified: usocket/trunk/doc/design.txt ============================================================================== --- usocket/trunk/doc/design.txt (original) +++ usocket/trunk/doc/design.txt Wed Feb 8 14:45:56 2006 @@ -101,6 +101,7 @@ 1) Map them to 'unknown-error 2) Give them their own errors and map to those + ... which implies that they are actually supported atm. 3) ... Given that the library doesn't now, but may in the future,

1 0

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

08 Feb '06

Author: ehuelsmann Date: Wed Feb 8 14:43:08 2006 New Revision: 61 Modified: usocket/trunk/test/test-usocket.lisp Log: One more test case. Modified: usocket/trunk/test/test-usocket.lisp ============================================================================== --- usocket/trunk/test/test-usocket.lisp (original) +++ usocket/trunk/test/test-usocket.lisp Wed Feb 8 14:43:08 2006 @@ -5,6 +5,8 @@ (in-package :usocket-test) + +(defparameter +non-existing-host+ "10.0.0.13") (defparameter *soc1* (usocket::make-socket :socket :my-socket :stream :my-stream)) @@ -46,6 +48,20 @@ (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))) + ;; cmu doesn't report as specific as above + #+(or cmu lispworks) + (usocket:unknown-error + #'(lambda (c) (throw 'caught-error nil))) + (condition + #'(lambda (c) (throw 'caught-error t)))) + (usocket:socket-connect +non-existing-host+ 80) ;; == #(127 0 0 0) + :unreach)) + nil) + ;; let's hope c-l.net doesn't move soon, or that people start to ;; test usocket like crazy..

1 0

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

08 Feb '06

Author: ehuelsmann Date: Wed Feb 8 14:42:28 2006 New Revision: 60 Modified: usocket/trunk/backend/sbcl.lisp Log: Clean up SBCL backend. Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Wed Feb 8 14:42:28 2006 @@ -12,28 +12,25 @@ '((interrupted-error . interrupted-condition))) (defparameter +sbcl-error-map+ - ;;### FIXME: sb-bsd-sockets also has a name-service-error - ;; which is signalled when a hostname can't be resolved... - ;; what to do with that? `((sb-bsd-sockets:address-in-use-error . address-in-use-error) (sb-bsd-sockets::no-address-error . address-not-available-error) (sb-bsd-sockets:bad-file-descriptor-error . bad-file-descriptor-error) (sb-bsd-sockets:connection-refused-error . connection-refused-error) (sb-bsd-sockets:invalid-argument-error . invalid-argument-error) (sb-bsd-sockets:no-buffers-error . no-buffers-error) - (sb-bsd-sockets:operation-not-supported-error . operation-not-supported-error) - (sb-bsd-sockets:operation-not-permitted-error . operation-not-permitted-error) - (sb-bsd-sockets:protocol-not-supported-error . protocol-not-supported-error) - (sb-bsd-sockets:socket-type-not-supported-error . socket-type-not-supported-error) + (sb-bsd-sockets:operation-not-supported-error + . operation-not-supported-error) + (sb-bsd-sockets:operation-not-permitted-error + . operation-not-permitted-error) + (sb-bsd-sockets:protocol-not-supported-error + . protocol-not-supported-error) + (sb-bsd-sockets:socket-type-not-supported-error + . socket-type-not-supported-error) (sb-bsd-sockets:network-unreachable-error . network-unreachable-error) - ;; (... . network-down-error) - ;; (... . host-down-error) - ;; (... . host-unreachable-error) - ;; (... . shutdown-error) (sb-bsd-sockets:operation-timeout-error . timeout-error) (sb-bsd-sockets:socket-error . ,#'map-socket-error) - ;; Nameservice errors - (sb-bsd-sockets:no-recovery-error . network-reset-error) + ;; Nameservice errors: mapped to unknown-error +;; (sb-bsd-sockets:no-recovery-error . network-reset-error) ;; (sb-bsd-sockets:try-again-condition ...) ;; (sb-bsd-sockets:host-not-found ...) )) @@ -63,11 +60,6 @@ (defun socket-connect (host port &optional (type :stream)) - "Connect to `host' on `port'. `host' is assumed to be a string of -an IP address represented in vector notation, such as #(192 168 1 1). -`port' is assumed to be an integer. - -Returns a usocket object." (let* ((socket (make-instance 'sb-bsd-sockets:inet-socket :type type :protocol :tcp)) (stream (sb-bsd-sockets:socket-make-stream socket @@ -83,7 +75,6 @@ usocket)) (defmethod socket-close ((usocket usocket)) - "Close socket." (with-mapped-conditions (usocket) (sb-bsd-sockets:socket-close (socket usocket))))

1 0

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

07 Feb '06

Author: ehuelsmann Date: Tue Feb 7 14:03:22 2006 New Revision: 59 Modified: public_html/index.shtml Log: Update website. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Tue Feb 7 14:03:22 2006 @@ -104,7 +104,7 @@ <td class="WIP" title="Work in progress">WIP</td> <td class="DONE" title="Implemented">DONE</td> <td class="DONE" title="Implemented">DONE</td> - <td class="WIP" title="Work in progress">WIP</td> + <td class="DONE" title="Implemented">DONE</td> <td class="TODO">TODO</td> </tr> <tr> @@ -113,8 +113,8 @@ <td class="DONE">DONE</td> <td class="TODO">TODO</td> <td class="DONE">DONE</td> - <td class="WIP" title="Work in progress">WIP</td> - <td class="WIP" title="Work in progress">WIP</td> + <td class="DONE">DONE</td> + <td class="DONE">DONE</td> <td class="TODO">TODO</td> </tr> <tr>

1 0