[usocket-cvs] r608 - in usocket/branches/0.5.x: . backend

[Chun Tian (binghe)]

Author: ctian
Date: Wed Mar 30 02:43:34 2011
New Revision: 608

Log:
[CLISP] Full support of DNS helper functions (GET-HOST-BY-NAME, ...) added.

Modified:
   usocket/branches/0.5.x/backend/clisp.lisp
   usocket/branches/0.5.x/usocket.lisp

Modified: usocket/branches/0.5.x/backend/clisp.lisp
==============================================================================
--- usocket/branches/0.5.x/backend/clisp.lisp	(original)
+++ usocket/branches/0.5.x/backend/clisp.lisp	Wed Mar 30 02:43:34 2011
@@ -33,6 +33,17 @@
   #-ffi
   "localhost")
 
+(defun get-host-by-address (address)
+  (with-mapped-conditions ()
+    (let ((hostent (posix:resolve-host-ipaddr (host-to-hostname address))))
+      (posix:hostent-name hostent))))
+
+(defun get-hosts-by-name (name)
+  (with-mapped-conditions ()
+    (let ((hostent (posix:resolve-host-ipaddr name)))
+      (mapcar #'host-to-vector-quad
+              (posix:hostent-addr-list hostent)))))
+
 #+win32
 (defun remap-maybe-for-win32 (z)
   (mapcar #'(lambda (x)
@@ -69,8 +80,6 @@
   (declare (ignore nodelay))
   (when deadline (unsupported 'deadline 'socket-connect))
   (when nodelay-specified (unsupported 'nodelay 'socket-connect))
-  (when local-host (unsupported 'local-host 'socket-connect))
-  (when local-port (unsupported 'local-port 'socket-connect))
   (case protocol
     (:stream
      (let ((socket)
@@ -202,8 +211,8 @@
 
   (declaim (inline fill-sockaddr_in))
   (defun fill-sockaddr_in (sockaddr_in ip port)
-    (port-to-octet-buffer sockaddr_in port)
-    (ip-to-octet-buffer sockaddr_in ip :start 2)
+    (port-to-octet-buffer port sockaddr_in)
+    (ip-to-octet-buffer ip sockaddr_in :start 2)
     sockaddr_in)
 
   (defun socket-create-datagram (local-port
@@ -217,17 +226,17 @@
                         (fill-sockaddr_in (make-sockaddr_in)
                                           remote-host (or remote-port
                                                           local-port)))))
-      (bind sock lsock_addr)
+      (rawsock:bind sock lsock_addr)
       (when rsock_addr
-        (connect sock rsock_addr))
+        (rawsock:connect sock rsock_addr))
       (make-datagram-socket sock :connected-p (if rsock_addr t nil))))
 
-  (defun socket-receive (socket buffer length &key)
+  (defmethod socket-receive ((socket datagram-usocket) buffer length &key)
     "Returns the buffer, the number of octets copied into the buffer (received)
 and the address of the sender as values."
     (let* ((sock (socket socket))
            (sockaddr (when (not (connected-p socket))
-                       (rawsock:make-sockaddr)))
+                       (rawsock:make-sockaddr :inet)))
            (rv (if sockaddr
                    (rawsock:recvfrom sock buffer sockaddr
                                      :start 0
@@ -237,10 +246,10 @@
                                  :end length))))
       (values buffer
               rv
-              (ip-from-octet-buffer (sockaddr-data sockaddr) 4)
-              (port-from-octet-buffer (sockaddr-data sockaddr) 2))))
+              (ip-from-octet-buffer (rawsock:sockaddr-data sockaddr) :start 4)
+              (port-from-octet-buffer (rawsock:sockaddr-data sockaddr) :start 2))))
 
-  (defun socket-send (socket buffer length &key host port)
+  (defmethod socket-send ((socket datagram-usocket) buffer length &key host port)
     "Returns the number of octets sent."
     (let* ((sock (socket socket))
            (sockaddr (when (and host port)

Modified: usocket/branches/0.5.x/usocket.lisp
==============================================================================
--- usocket/branches/0.5.x/usocket.lisp	(original)
+++ usocket/branches/0.5.x/usocket.lisp	Wed Mar 30 02:43:34 2011
@@ -470,43 +470,41 @@
 ;; DNS helper functions
 ;;
 
-#-clisp
-(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)))
-      (when hosts
-        (elt hosts (random (length hosts))))))
+(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)))
+    (when hosts
+      (elt hosts (random (length hosts))))))
 
-  (defun host-to-vector-quad (host)
-    "Translate a host specification (vector quad, dotted quad or domain name)
+(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 (when (ip-address-string-p host)
-                           (dotted-quad-to-vector-quad host))))
-                (if (and ip (= 4 (length ip)))
-                    ;; valid IP dotted quad?
-                    ip
-                  (get-random-host-by-name host))))
-      ((or (vector t 4)
-           (array (unsigned-byte 8) (4)))
-       host)
-      (integer (hbo-to-vector-quad host))))
-
-  (defun host-to-hbo (host)
-    (etypecase host
-      (string (let ((ip (when (ip-address-string-p host)
-                          (dotted-quad-to-vector-quad host))))
-                (if (and ip (= 4 (length ip)))
-                    (host-byte-order ip)
-            (host-to-hbo (get-host-by-name host)))))
-      ((or (vector t 4)
-           (array (unsigned-byte 8) (4)))
-       (host-byte-order host))
-      (integer host))))
+  (etypecase host
+    (string (let* ((ip (when (ip-address-string-p host)
+                         (dotted-quad-to-vector-quad host))))
+              (if (and ip (= 4 (length ip)))
+                  ;; valid IP dotted quad?
+                  ip
+                (get-random-host-by-name host))))
+    ((or (vector t 4)
+         (array (unsigned-byte 8) (4)))
+     host)
+    (integer (hbo-to-vector-quad host))))
+
+(defun host-to-hbo (host)
+  (etypecase host
+    (string (let ((ip (when (ip-address-string-p host)
+                        (dotted-quad-to-vector-quad host))))
+              (if (and ip (= 4 (length ip)))
+                  (host-byte-order ip)
+                (host-to-hbo (get-host-by-name host)))))
+    ((or (vector t 4)
+         (array (unsigned-byte 8) (4)))
+     (host-byte-order host))
+    (integer host)))
 
 ;;
 ;; Other utility functions