[usocket-cvs] r28 - in usocket/trunk: . backend - usocket-cvs@common-lisp.net - mailman3.common-lisp.net

3 Feb 2006

Author: ehuelsmann
Date: Fri Feb  3 15:24:31 2006
New Revision: 28
Modified:
   usocket/trunk/backend/sbcl.lisp
   usocket/trunk/usocket.lisp
Log:
Fix error where hostnames were erroneously not translated to vector quads.
Modified: usocket/trunk/backend/sbcl.lisp
==============================================================================

--- usocket/trunk/backend/sbcl.lisp	(original)
+++ usocket/trunk/backend/sbcl.lisp	Fri Feb  3 15:24:31 2006
@@ -41,7 +41,9 @@
                                  usock-error)))
              (if usock-error
                  (error usock-error :socket socket)
-               (error 'usocket-unknown-error :real-error condition))))
+               (error 'usocket-unknown-error
+                      :socket socket
+                      :real-error condition))))
     (condition (let* ((usock-cond (cdr (assoc (type-of condition)
                                               +sbcl-condition-map+)))
                       (usock-cond (if (functionp usock-cond)
@@ -67,9 +69,10 @@
                                                     :buffering :full
                                                     :element-type 'character))
          ;;###FIXME: The above line probably needs an :external-format
-         (usocket (make-instance 'usocket :stream stream :socket socket)))
+         (usocket (make-instance 'usocket :stream stream :socket socket))
+         (ip (host-to-vector-quad host)))
     (with-mapped-conditions (usocket)
-      (sb-bsd-sockets:socket-connect socket host port))
+      (sb-bsd-sockets:socket-connect socket ip port))
     usocket))
(defmethod socket-close ((usocket usocket))
Modified: usocket/trunk/usocket.lisp
==============================================================================
--- usocket/trunk/usocket.lisp	(original)
+++ usocket/trunk/usocket.lisp	Fri Feb  3 15:24:31 2006
@@ -97,11 +97,30 @@
 ;; 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)
+to a vector quad."
+  (if (vectorp host)
+      host
+    (let* ((ip (ignore-errors
+                 (dotted-quad-to-vector-quad host))))
+      (if (and ip (= 4 (length ip)))
+          ip
+        (get-random-host-by-name host)))))
+
+(defun host-to-hostname (host)
+  "Translate a string or vector quad to a stringified hostname."
+  (if (stringp host)
+      host
+    (vector-quad-to-dotted-quad host)))

    