Author: ctian Date: Thu Mar 31 12:05:17 2011 New Revision: 627

Log: [CLISP] GET-SOCK-NAME / GET-PEER-NAME now works on Datagram usockets (RAWSOCK version); various fixes for RAWSOCK.

Modified: usocket/branches/0.5.x/backend/clisp.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 Thu Mar 31 12:05:17 2011 @@ -101,7 +101,7 @@ #+(or rawsock ffi) (socket-create-datagram (or local-port *auto-port*) :local-host (or local-host *wildcard-host*) - :remote-host host + :remote-host (and host (host-to-vector-quad host)) :remote-port port) #-(or rawsock ffi) (unsupported '(protocol :datagram) 'socket-connect)))) @@ -234,17 +234,18 @@ "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 (unless (connected-p socket) - (rawsock:make-sockaddr :inet))) - (rv (if sockaddr - (rawsock:recvfrom sock buffer sockaddr :start 0 :end length) - (rawsock:recv sock buffer :start 0 :end length))) + (sockaddr (rawsock:make-sockaddr :inet)) + (real-length (or length +max-datagram-packet-size+)) + (real-buffer (or buffer + (make-array real-length :element-type '(unsigned-byte 8)))) + (rv (rawsock:recvfrom sock real-buffer sockaddr + :start 0 :end real-length)) (host 0) (port 0)) (unless (connected-p socket) (let ((data (rawsock:sockaddr-data sockaddr))) (setq host (ip-from-octet-buffer data :start 4) port (port-from-octet-buffer data :start 2)))) - (values buffer rv host port))) + (values real-buffer rv host port)))

(defmethod socket-send ((socket datagram-usocket) buffer length &key host port) "Returns the number of octets sent." @@ -255,19 +256,40 @@ (make-sockaddr_in) (host-byte-order host) port)))) + (real-length (or length (length buffer))) + (real-buffer (if (typep buffer '(simple-array (unsigned-byte 8) (*))) + buffer + (make-array real-length + :element-type '(unsigned-byte 8) + :initial-contents (subseq buffer 0 real-length)))) (rv (if (and host port) - (rawsock:sendto sock buffer sockaddr + (rawsock:sendto sock real-buffer sockaddr :start 0 - :end length) - (rawsock:send sock buffer + :end real-length) + (rawsock:send sock real-buffer :start 0 - :end length)))) + :end real-length)))) rv))

(defmethod socket-close ((usocket datagram-usocket)) (when (wait-list usocket) (remove-waiter (wait-list usocket) usocket)) (rawsock:sock-close (socket usocket))) + + (declaim (inline get-socket-name)) + (defun get-socket-name (socket function) + (let ((sockaddr (rawsock:make-sockaddr :inet (make-sockaddr_in)))) + (funcall function socket sockaddr) + (let ((data (rawsock:sockaddr-data sockaddr))) + (values (hbo-to-vector-quad (ip-from-octet-buffer data :start 2)) + (port-from-octet-buffer data :start 0))))) + + (defmethod get-local-name ((usocket datagram-usocket)) + (get-socket-name (socket usocket) 'rawsock:getsockname)) + + (defmethod get-peer-name ((usocket datagram-usocket)) + (get-socket-name (socket usocket) 'rawsock:getpeername)) + ) ; progn

;;; @@ -289,10 +311,6 @@ (sa_family sa_family_t) (sa_data (ffi:c-array ffi:char 14)))

- #+ignore - (ffi:def-c-struct in_addr - (s_addr in_addr_t)) - (ffi:def-c-struct sockaddr_in (sin_len ffi:uint8) (sin_family sa_family_t) @@ -466,11 +484,6 @@ (declaim (inline fill-sockaddr_in)) (defun fill-sockaddr_in (sockaddr host port) (let ((hbo (host-to-hbo host))) - #+ignore - (setf (ffi:slot (ffi:foreign-value sockaddr) 'sin_len) *length-of-sockaddr_in* - (ffi:slot (ffi:foreign-value sockaddr) 'sin_family) +socket-af-inet+ - (ffi:slot (ffi:foreign-value sockaddr) 'sin_port) (%htons port) - (ffi:slot (ffi:foreign-value sockaddr) 'sin_addr) (%htonl hbo)) (ffi:with-c-place (place sockaddr) (setf (ffi:slot place 'sin_len) *length-of-sockaddr_in* (ffi:slot place 'sin_family) +socket-af-inet+ @@ -616,6 +629,3 @@ (get-socket-name (socket usocket) '%getpeername))

) ; progn - -;;; TODO: get-local-name & get-peer-name -