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