usocket-cvs February 2006

usocket-cvs@common-lisp.net

1 participants
98 discussions

[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

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

06 Feb '06

Author: ehuelsmann Date: Mon Feb 6 15:15:34 2006 New Revision: 48 Modified: public_html/index.shtml public_html/style.css Log: Update website. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Mon Feb 6 15:15:34 2006 @@ -83,41 +83,61 @@ </thead> <tbody> <tr style="border-width:2px;border-color:#000;"> - <td rowspan="3">Minimal active sockets support + <td rowspan="5">Minimal active sockets support at the same level as provided by <a href="http://cliki.net/trivial-sockets">trivial-sockets</a>.<br /> (Meaning streamed tcp traffic on connected sockets.)</td> <td>Investigate interfaces provided.</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="WIP" title="Work in progress">WIP</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="TODO">TODO</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>  </tr> <tr> <td>Identify socket errors generated.</td> <td class="DONE" title="Implemented">DONE</td> <td class="DONE" title="Implemented">DONE</td> - <td class="TODO">TODO</td> + <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="TODO">TODO</td> + <td class="WIP" title="Work in progress">WIP</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="WIP" title="Work in progress">WIP</td> <td class="WIP" title="Work in progress">WIP</td> <td class="TODO">TODO</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="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="UNTESTED" title="Untested">?</td> + <td class="UNTESTED" title="Untested">?</td> + <td class="UNTESTED" title="Untested">?</td> + <td class="UNTESTED" title="Untested">?</td> + <td class="UNTESTED" title="Untested">?</td> + <td class="UNTESTED" title="Untested">?</td> + </tr> + <tr> <td rowspan="2">Add functions to retrieve socket properties.<br /> Such as local and remote IP address and port.</td> <td>Investigate interfaces provided</td> Modified: public_html/style.css ============================================================================== --- public_html/style.css (original) +++ public_html/style.css Mon Feb 6 15:15:34 2006 @@ -74,3 +74,14 @@ .DONE { background-color: #080; color: #000; text-align: center; } + +.UNTESTED { text-align: center; } + +.PASS { background-color: #080; + color: #000; + text-align: center; } + +.FAIL { background-color: #b00; + color: #fff; + text-align: center; + font-weight: bold }

1 0

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

06 Feb '06

Author: ehuelsmann Date: Mon Feb 6 14:51:50 2006 New Revision: 47 Modified: usocket/trunk/backend/lispworks.lisp Log: Update LispWorks backend. Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Mon Feb 6 14:51:50 2006 @@ -5,33 +5,59 @@ (in-package :usocket) + +#+win32 +(defun remap-maybe-for-win32 (z) + (mapcar #'(lambda (x) + (cons (mapcar #'(lambda (y) + (+ 10000 y)) + (car x)) + (cdr x))) + z)) + +(defparameter +lispworks-error-map+ + #+win32 + (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 handle-condition (condition &optional (socket nil)) "Dispatch correct usocket condition." (typecase condition - (condition (error 'usocket-error - :real-condition condition - :socket socket)))) + (simple-error (destructuring-bind (&optional host port err-msg errno) + (simple-condition-format-arguments condition) + (declare (ignore host port err-msg)) + (let* ((usock-err + (cdr (assoc errno +lispworks-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))))))) +;; (condition (error 'usocket-error +;; :real-condition condition +;; :socket socket)))) -(defun open (host port &optional (type :stream)) +(defun socket-connect (host port &optional (type :stream)) (declare (ignore type)) - (make-socket :socket (comm:open-tcp-stream host port) - :host host - :port port)) - -(defmethod close ((socket socket)) - "Close socket." - (cl:close (real-socket socket))) - -(defmethod read-line ((socket socket)) - (cl:read-line (real-socket socket))) + (let ((hostname (host-to-hostname host)) + (stream)) + (setf stream + (with-mapped-conditions () + (comm:open-tcp-stream host port))) + (make-socket :socket (comm:socket-stream-socket stream) + :stream stream))) +;; :host host +;; :port port)) -(defmethod write-sequence ((socket socket) sequence) - (cl:write-sequence sequence (real-socket socket))) - -(defun get-host-by-address (address) - (comm:get-host-entry (vector-quad-to-dotted-quad address) - :fields '(:name))) +(defmethod socket-close ((usocket usocket)) + "Close socket." + (close (stream usocket))) -(defun get-host-by-name (name) - (mapcar #'hbo-to-vector-quad - (comm:get-host-entry name :fields '(:addresses))))

1 0

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

06 Feb '06

Author: ehuelsmann Date: Mon Feb 6 14:50:07 2006 New Revision: 46 Added: usocket/trunk/run-usocket-tests.sh (contents, props changed) Modified: usocket/trunk/ (props changed) usocket/trunk/package.lisp usocket/trunk/test/package.lisp (contents, props changed) usocket/trunk/test/test-usocket.lisp (contents, props changed) usocket/trunk/test/usocket-test.asd (contents, props changed) Log: Commit test script update. Modified: usocket/trunk/package.lisp ============================================================================== --- usocket/trunk/package.lisp (original) +++ usocket/trunk/package.lisp Mon Feb 6 14:50:07 2006 @@ -16,6 +16,7 @@ :with-connected-socket ; macros :usocket ; socket object and accessors + :socket :socket-stream :host-byte-order ; IPv4 utility functions Added: usocket/trunk/run-usocket-tests.sh ============================================================================== --- (empty file) +++ usocket/trunk/run-usocket-tests.sh Mon Feb 6 14:50:07 2006 @@ -0,0 +1,23 @@ +#!/bin/sh + +# Test script to be run from the usocket source root +# +# Unfortunately, it currently works only with SBCL +# in my setup... +# +# I need to figure out how to setup ASDF with the other lisps +# I have installed: cmucl, ABCL, clisp, allegro and lispworks + +for my_lisp in sbcl ; do + +echo " +(require 'usocket-test) + +(usocket-test:run-usocket-tests) + +(quit) +" | $my_lisp + +echo "Above test results for $my_lisp." + +done Modified: usocket/trunk/test/package.lisp ============================================================================== --- usocket/trunk/test/package.lisp (original) +++ usocket/trunk/test/package.lisp Mon Feb 6 14:50:07 2006 @@ -1,5 +1,5 @@ ;;;; $Id$ -;;;; $Source$ +;;;; $URL$ ;;;; See the LICENSE file for licensing information. @@ -9,5 +9,5 @@ (defpackage :usocket-test (:use :cl :rt) (:nicknames :usoct) - (:export :do-tests))) + (: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 Mon Feb 6 14:50:07 2006 @@ -1,17 +1,82 @@ ;;;; $Id$ -;;;; $Source$ +;;;; $URL$ ;;;; See LICENSE for licensing information. (in-package :usocket-test) -(defvar *soc1* (usoc:make-socket :socket :stream - :host #(1 2 3 4) - :port 80 - :stream :my-stream)) - -(deftest make-socket.1 (usoc::real-socket usoct::*soc1*) :my-socket) -(deftest make-socket.2 (usoc::real-stream usoct::*soc1*) :my-stream) -(deftest make-socket.3 (usoc:host usoct::*soc1*) #(1 2 3 4)) -(deftest make-socket.4 (usoc:host usoct::*soc1*) 80) +(defparameter *soc1* (usocket::make-socket :socket :my-socket + :stream :my-stream)) +(deftest make-socket.1 (usocket:socket *soc1*) :my-socket) +(deftest make-socket.2 (usocket:socket-stream *soc1*) :my-stream) + +(deftest socket-no-connect.1 + (catch 'caught-error + (handler-bind ((usocket:usocket-error + #'(lambda (c) (throw 'caught-error nil)))) + (usocket:socket-connect "127.0.0.0" 80) + t)) + nil) +(deftest socket-no-connect.2 + (catch 'caught-error + (handler-bind ((usocket:usocket-error + #'(lambda (c) (throw 'caught-error nil)))) + (usocket:socket-connect #(127 0 0 0) 80) + t)) + nil) +(deftest socket-no-connect.3 + (catch 'caught-error + (handler-bind ((usocket:usocket-error + #'(lambda (c) (throw 'caught-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))) + (condition + #'(lambda (c) (throw 'caught-error t)))) + (usocket:socket-connect 2130706432 80) ;; == #(127 0 0 0) + t)) + 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) +(deftest socket-connect.2 + (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))) + 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))) + #.(format nil "HTTP/1.1 200 OK~A" #\Return) nil) + + +(defun run-usocket-tests () + (do-tests)) Modified: usocket/trunk/test/usocket-test.asd ============================================================================== --- usocket/trunk/test/usocket-test.asd (original) +++ usocket/trunk/test/usocket-test.asd Mon Feb 6 14:50:07 2006 @@ -1,5 +1,5 @@ ;;;; $Id$ -;;;; $Source$ +;;;; $URL$ ;;;; See the LICENSE file for licensing information.

1 0

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

05 Feb '06

Author: ehuelsmann Date: Sun Feb 5 15:50:41 2006 New Revision: 45 Modified: usocket/trunk/backend/cmucl.lisp Log: Introduce error handling for cmucl 19b and later. Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Sun Feb 5 15:50:41 2006 @@ -6,15 +6,47 @@ (in-package :usocket) +(defun remap-maybe-for-win32 (z) + (mapcar #'(lambda (x) + (cons (mapcar #'(lambda (y) + (+ 10000 y)) + (car x)) + (cdr x))) + z)) + +(defparameter +cmucl-error-map+ + #+win32 + (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+)) + + ;; CMUCL error handling is brain-dead: it doesn't preserve any ;; information other than the OS error string from which the ;; error can be determined. The OS error string isn't good enough ;; given that it may have been localized (l10n). ;; +;; The above applies to versions pre 19b; 19d and newer are expected to +;; contain even better error reporting. +;; +;; ;; Just catch the errors and encapsulate them in an unknown-error (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)))) (simple-error (error 'unknown-error :real-condition condition :socket socket)))) @@ -23,7 +55,7 @@ (let* ((socket)) (setf socket (with-mapped-conditions (socket) - (ext:connect-to-inet-socket (host-byte-order host) port type))) + (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))

1 0

← Newer
1
2
3
4
5
6
7
8
9
10
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

usocket-cvs February 2006