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

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

07 Feb '06

Author: ehuelsmann Date: Tue Feb 7 13:40:37 2006 New Revision: 58 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 13:40:37 2006 @@ -134,7 +134,7 @@ <td class="UNTESTED" title="Untested">?</td> <td class="PASS">PASS</td> <td class="PASS">PASS</td> - <td class="UNTESTED" title="Untested">?</td> + <td class="PASS">PASS</td> <td class="UNTESTED" title="Untested">?</td> </tr> <tr>

1 0

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

07 Feb '06

Author: ehuelsmann Date: Tue Feb 7 13:39:46 2006 New Revision: 57 Modified: usocket/trunk/ (props changed) usocket/trunk/backend/ (props changed) usocket/trunk/backend/lispworks.lisp usocket/trunk/condition.lisp usocket/trunk/test/ (props changed) usocket/trunk/test/package.lisp usocket/trunk/test/test-usocket.lisp usocket/trunk/usocket.asd Log: Make LispWorks work. Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Tue Feb 7 13:39:46 2006 @@ -5,6 +5,8 @@ (in-package :usocket) +(eval-when (:compile-toplevel :load-toplevel :execute) + (require "comm")) #+win32 (defun remap-maybe-for-win32 (z) @@ -51,13 +53,15 @@ (stream)) (setf stream (with-mapped-conditions () - (comm:open-tcp-stream host port))) - (make-socket :socket (comm:socket-stream-socket stream) - :stream stream))) + (comm:open-tcp-stream hostname port))) + (if stream + (make-socket :socket (comm:socket-stream-socket stream) + :stream stream) + (error 'unknown-error)))) ;; :host host ;; :port port)) (defmethod socket-close ((usocket usocket)) "Close socket." - (close (stream usocket))) + (close (socket-stream usocket))) Modified: usocket/trunk/condition.lisp ============================================================================== --- usocket/trunk/condition.lisp (original) +++ usocket/trunk/condition.lisp Tue Feb 7 13:39:46 2006 @@ -18,7 +18,7 @@ (define-condition usocket-condition (condition) ((socket :initarg :socket - :accessor :usocket-socket)) + :accessor usocket-socket)) ;;###FIXME: no slots (yet); should at least be the affected usocket... (:documentation "")) Modified: usocket/trunk/test/package.lisp ============================================================================== --- usocket/trunk/test/package.lisp (original) +++ usocket/trunk/test/package.lisp Tue Feb 7 13:39:46 2006 @@ -7,7 +7,7 @@ (eval-when (:execute :load-toplevel :compile-toplevel) (defpackage :usocket-test - (:use :cl :rt) + (:use :cl :regression-test) (:nicknames :usoct) (:export :do-tests :run-usocket-tests))) Modified: usocket/trunk/test/test-usocket.lisp ============================================================================== --- usocket/trunk/test/test-usocket.lisp (original) +++ usocket/trunk/test/test-usocket.lisp Tue Feb 7 13:39:46 2006 @@ -38,7 +38,7 @@ (handler-bind ((usocket:network-unreachable-error #'(lambda (c) (throw 'caught-error nil))) ;; cmu doesn't report as specific as above - #+cmu + #+(or cmu lispworks) (usocket:unknown-error #'(lambda (c) (throw 'caught-error nil))) (condition Modified: usocket/trunk/usocket.asd ============================================================================== --- usocket/trunk/usocket.asd (original) +++ usocket/trunk/usocket.asd Tue Feb 7 13:39:46 2006 @@ -18,8 +18,7 @@ :licence "MIT" :description "Universal socket library for Common Lisp" :depends-on (:split-sequence - #+sbcl :sb-bsd-sockets - #+lispworks "comm") + #+sbcl :sb-bsd-sockets) :components ((:file "package") (:file "usocket" :depends-on ("package"))

1 0

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

07 Feb '06

Author: ehuelsmann Date: Tue Feb 7 12:36:58 2006 New Revision: 56 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 12:36:58 2006 @@ -133,7 +133,7 @@ <td class="PASS">PASS</td> <td class="UNTESTED" title="Untested">?</td> <td class="PASS">PASS</td> - <td class="UNTESTED" title="Untested">?</td> + <td class="PASS">PASS</td> <td class="UNTESTED" title="Untested">?</td> <td class="UNTESTED" title="Untested">?</td> </tr>

1 0

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

07 Feb '06

Author: ehuelsmann Date: Tue Feb 7 12:27:50 2006 New Revision: 55 Modified: usocket/trunk/backend/allegro.lisp usocket/trunk/usocket.asd Log: Make Allegro work. Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp (original) +++ usocket/trunk/backend/allegro.lisp Tue Feb 7 12:27:50 2006 @@ -10,6 +10,7 @@ (:address-not-available . address-not-available-error) (:network-down . network-down-error) (:network-reset . network-reset-error) + (:network-unreachable . network-unreachable-error) (:connection-aborted . connection-aborted-error) (:connection-reset . connection-reset-error) (:no-buffer-space . no-buffers-error) @@ -22,14 +23,15 @@ (defun handle-condition (condition &optional (socket nil)) "Dispatch correct usocket condition." (typecase condition - (socket-error (let ((usock-err - (cdr (assoc (stream-error-identifier condition) - +allegro-identifier-error-map+)))) - (if usock-err - (error usock-err :socket socket) - (error 'unknown-error - :real-condition condition - :socket socket)))))) + (excl:socket-error + (let ((usock-err + (cdr (assoc (excl:stream-error-identifier condition) + +allegro-identifier-error-map+)))) + (if usock-err + (error usock-err :socket socket) + (error 'unknown-error + :real-error condition + :socket socket)))))) (defun socket-connect (host port &optional (type :stream)) (declare (ignore type)) Modified: usocket/trunk/usocket.asd ============================================================================== --- usocket/trunk/usocket.asd (original) +++ usocket/trunk/usocket.asd Tue Feb 7 12:27:50 2006 @@ -18,7 +18,6 @@ :licence "MIT" :description "Universal socket library for Common Lisp" :depends-on (:split-sequence - #+allegro :socket #+sbcl :sb-bsd-sockets #+lispworks "comm") :components ((:file "package")

1 0

[usocket-cvs] r54 - public_html usocket/trunk usocket/trunk/backend usocket/trunk/test
by ehuelsmann＠common-lisp.net 07 Feb '06

07 Feb '06

Author: ehuelsmann Date: Tue Feb 7 01:53:52 2006 New Revision: 54 Modified: public_html/index.shtml usocket/trunk/ (props changed) usocket/trunk/backend/ (props changed) usocket/trunk/backend/clisp.lisp usocket/trunk/condition.lisp usocket/trunk/test/ (props changed) usocket/trunk/test/test-usocket.lisp Log: Make clisp work, adjusting ignore patterns and update website. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Tue Feb 7 01:53:52 2006 @@ -132,7 +132,7 @@ <td class="PASS">PASS</td> <td class="PASS">PASS</td> <td class="UNTESTED" title="Untested">?</td> - <td class="UNTESTED" title="Untested">?</td> + <td class="PASS">PASS</td> <td class="UNTESTED" title="Untested">?</td> <td class="UNTESTED" title="Untested">?</td> <td class="UNTESTED" title="Untested">?</td> Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Tue Feb 7 01:53:52 2006 @@ -29,7 +29,7 @@ (system::simple-os-error (let ((usock-err (cdr (assoc (car (simple-condition-format-arguments condition)) - +clisp-error-map+ :test member)))) + +clisp-error-map+ :test #'member)))) (if usock-err (if (subtypep usock-err 'error) (error usock-err :socket socket) Modified: usocket/trunk/condition.lisp ============================================================================== --- usocket/trunk/condition.lisp (original) +++ usocket/trunk/condition.lisp Tue Feb 7 01:53:52 2006 @@ -111,7 +111,7 @@ ((1) . operation-not-permitted-error) ((43 92) . protocol-not-supported-error) ((44 93) . socket-type-not-supported-error) - ((51 102) . network-unreachable-error) + ((51 101) . network-unreachable-error) ((50 100) . network-down-error) ((52 102) . network-reset-error) ((58 108) . already-shutdown-error) Modified: usocket/trunk/test/test-usocket.lisp ============================================================================== --- usocket/trunk/test/test-usocket.lisp (original) +++ usocket/trunk/test/test-usocket.lisp Tue Feb 7 01:53:52 2006 @@ -79,7 +79,8 @@ (force-output (usocket:socket-stream sock)) (read-line (usocket:socket-stream sock))) (usocket:socket-close sock))) - #.(format nil "HTTP/1.1 200 OK~A" #\Return) nil) + #+clisp "HTTP/1.1 200 OK" + #-clisp #.(format nil "HTTP/1.1 200 OK~A" #\Return) nil) (defun run-usocket-tests ()

1 0

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

06 Feb '06

Author: ehuelsmann Date: Mon Feb 6 17:30:09 2006 New Revision: 53 Modified: public_html/index.shtml Log: Update website. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Mon Feb 6 17:30:09 2006 @@ -130,7 +130,7 @@ <tr> <td>Implementation test-suite status</td> <td class="PASS">PASS</td> - <td class="UNTESTED" title="Untested">?</td> + <td class="PASS">PASS</td> <td class="UNTESTED" title="Untested">?</td> <td class="UNTESTED" title="Untested">?</td> <td class="UNTESTED" title="Untested">?</td>

1 0

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

06 Feb '06

Author: ehuelsmann Date: Mon Feb 6 17:28:51 2006 New Revision: 52 Modified: usocket/trunk/backend/cmucl.lisp usocket/trunk/test/test-usocket.lisp Log: Make CMUCL pass the test-suite. Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Mon Feb 6 17:28:51 2006 @@ -5,8 +5,8 @@ (in-package :usocket) - -(defun remap-maybe-for-win32 (z) +#+win32 +(defun remap-for-win32 (z) (mapcar #'(lambda (x) (cons (mapcar #'(lambda (y) (+ 10000 y)) @@ -16,12 +16,22 @@ (defparameter +cmucl-error-map+ #+win32 - (append (remap-for-win32 +unix-errno-condition-map+) + (append (remap-for-win32 +unix-errno-condition-map+) (remap-for-win32 +unix-errno-error-map+)) #-win32 (append +unix-errno-condition-map+ +unix-errno-error-map+)) +(defun cmucl-map-socket-error (err &key condition socket) + (let ((usock-err + (cdr (assoc err +cmucl-error-map+ :test #'member)))) + (if usock-err + (if (subtypep usock-err 'error) + (error usock-err :socket socket) + (signal usock-err :socket socket)) + (error 'unknown-error + :socket socket + :real-error condition)))) ;; CMUCL error handling is brain-dead: it doesn't preserve any ;; information other than the OS error string from which the @@ -36,17 +46,9 @@ (defun handle-condition (condition &optional (socket nil)) "Dispatch correct usocket condition." (typecase condition - (ext::simple-error - (let ((usock-err - (cdr (assoc (ext::socket-errno c) - +cmucl-error-map+ :test member)))) - (if usock-err - (if (subtypep usock-err 'error) - (error usock-err :socket socket) - (signal usock-err :socket socket)) - (error 'unknown-error - :socket socket - :real-error condition)))) + (ext::socket-error (cmucl-map-socket-error (ext::socket-errno condition) + :socket socket + :condition condition)) (simple-error (error 'unknown-error :real-condition condition :socket socket)))) @@ -56,13 +58,16 @@ (setf socket (with-mapped-conditions (socket) (ext:connect-to-inet-socket (host-to-hbo host) port type))) - (let* ((stream (sys:make-fd-stream socket :input t :output t - :element-type 'character - :buffering :full)) - ;;###FIXME the above line probably needs an :external-format - (usocket (make-socket :socket socket - :host host :port port :stream stream))) - usocket))) + (if socket + (let* ((stream (sys:make-fd-stream socket :input t :output t + :element-type 'character + :buffering :full)) + ;;###FIXME the above line probably needs an :external-format + (usocket (make-socket :socket socket + :stream stream))) + usocket) + (let ((err (unix:unix-errno))) + (when err (cmucl-map-socket-error err)))))) (defmethod socket-close ((usocket usocket)) "Close socket." @@ -76,7 +81,7 @@ (ext::lookup-host-entry (host-byte-order address))) (condition (condition) (handle-condition condition)))) -(defun get-host-by-name (name) +(defun get-hosts-by-name (name) (handler-case (mapcar #'hbo-to-vector-quad (ext:host-entry-addr-list (ext:lookup-host-entry name))) Modified: usocket/trunk/test/test-usocket.lisp ============================================================================== --- usocket/trunk/test/test-usocket.lisp (original) +++ usocket/trunk/test/test-usocket.lisp Mon Feb 6 17:28:51 2006 @@ -37,10 +37,14 @@ (catch 'caught-error (handler-bind ((usocket:network-unreachable-error #'(lambda (c) (throw 'caught-error nil))) + ;; cmu doesn't report as specific as above + #+cmu + (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) - t)) + :unreach)) nil) ;; let's hope c-l.net doesn't move soon, or that people start to @@ -50,7 +54,7 @@ (unwind-protect (typep sock 'usocket:usocket) (usocket:socket-close sock))) - t) + t) (deftest socket-connect.2 (let ((sock (usocket:socket-connect #(65 110 12 237) 80))) (unwind-protect

1 0

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

06 Feb '06

Author: ehuelsmann Date: Mon Feb 6 17:28:23 2006 New Revision: 51 Modified: usocket/trunk/package.lisp Log: Adjust to new naming. Modified: usocket/trunk/package.lisp ============================================================================== --- usocket/trunk/package.lisp (original) +++ usocket/trunk/package.lisp Mon Feb 6 17:28:23 2006 @@ -27,6 +27,6 @@ :usocket-condition ; conditions :usocket-error ; errors - :usocket-unknown-condition - :usocket-unknown-error))) + :unknown-condition + :unknown-error)))

1 0

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

06 Feb '06

Author: ehuelsmann Date: Mon Feb 6 17:27:37 2006 New Revision: 50 Modified: usocket/trunk/usocket.lisp Log: Limit hostname resolution to non-dotted quad strings. Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Mon Feb 6 17:27:37 2006 @@ -80,6 +80,7 @@ (let ((list (list-of-strings-to-integers (split-sequence:split-sequence #\. string)))) (vector (first list) (second list) (third list) (fourth list)))) +(defgeneric host-byte-order (address)) (defmethod host-byte-order ((string string)) "Convert a string, such as 192.168.1.1, to host-byte-order, such as 3232235777." @@ -128,9 +129,13 @@ ((vector t 4) (vector-quad-to-dotted-quad host)) (integer (hbo-to-dotted-quad host)))) - +#-clisp (defun host-to-hbo (host) (etypecase host - (string (host-to-hbo (get-host-by-name 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)))

1 0

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

06 Feb '06

Author: ehuelsmann Date: Mon Feb 6 17:25:14 2006 New Revision: 49 Modified: usocket/trunk/ (props changed) usocket/trunk/backend/ (props changed) usocket/trunk/test/ (props changed) Log: Change ignore patterns to accomodate CMUCL.

1 0