March 2011 - usocket-cvs@common-lisp.net - mailman3.common-lisp.net

[usocket-cvs] r627 - usocket/branches/0.5.x/backend
by Chun Tian 31 Mar '11

31 Mar '11

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 -

1 0

[usocket-cvs] r626 - usocket/branches/0.5.x/backend
by Chun Tian 31 Mar '11

31 Mar '11

Author: ctian Date: Thu Mar 31 10:40:15 2011 New Revision: 626 Log: [CLISP] GET-SOCK-NAME / GET-PEER-NAME now works on Datagram usockets (FFI version) 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 10:40:15 2011 @@ -146,7 +146,7 @@ (remove-waiter (wait-list usocket) usocket)) (socket:socket-server-close (socket usocket))) -(defmethod get-local-name ((usocket usocket)) +(defmethod get-local-name ((usocket stream-usocket)) (multiple-value-bind (address port) (socket:socket-stream-local (socket usocket) t) @@ -161,13 +161,13 @@ (defmethod get-local-address ((usocket usocket)) (nth-value 0 (get-local-name usocket))) -(defmethod get-peer-address ((usocket stream-usocket)) +(defmethod get-peer-address ((usocket usocket)) (nth-value 0 (get-peer-name usocket))) (defmethod get-local-port ((usocket usocket)) (nth-value 1 (get-local-name usocket))) -(defmethod get-peer-port ((usocket stream-usocket)) +(defmethod get-peer-port ((usocket usocket)) (nth-value 1 (get-peer-name usocket))) (defun %setup-wait-list (wait-list) @@ -436,6 +436,26 @@ #+win32 :stdc-stdcall) (:return-type ffi:uint16)) + (ffi:def-call-out %getsockname (:name "getsockname") + (:arguments (sockfd ffi:int) + (localaddr (ffi:c-ptr sockaddr) :in-out) + (addrlen (ffi:c-ptr socklen_t) :in-out)) + #+win32 (:library "WS2_32") + #-win32 (:library :default) + (:language #-win32 :stdc + #+win32 :stdc-stdcall) + (:return-type ffi:int)) + + (ffi:def-call-out %getpeername (:name "getpeername") + (:arguments (sockfd ffi:int) + (peeraddr (ffi:c-ptr sockaddr) :in-out) + (addrlen (ffi:c-ptr socklen_t) :in-out)) + #+win32 (:library "WS2_32") + #-win32 (:library :default) + (:language #-win32 :stdc + #+win32 :stdc-stdcall) + (:return-type ffi:int)) + ;; socket constants (defconstant +socket-af-inet+ 2) (defconstant +socket-sock-dgram+ 2) @@ -567,12 +587,35 @@ (when remote-address (ffi:foreign-free remote-address)) nbytes))) + + (declaim (inline get-socket-name)) + (defun get-socket-name (socket function) + (let ((address (ffi:allocate-shallow 'sockaddr_in)) + (address-length (ffi:allocate-shallow 'ffi:int)) + (host 0) (port 0)) + (setf (ffi:foreign-value address-length) *length-of-sockaddr_in*) + (unwind-protect + (multiple-value-bind (rv return-address return-address-length) + (funcall function socket + (ffi:cast (ffi:foreign-value address) 'sockaddr) + (ffi:foreign-value address-length)) + (declare (ignore return-address-length)) + (if (zerop rv) + (let ((data (sockaddr-sa_data return-address))) + (setq host (ip-from-octet-buffer data :start 2) + port (port-from-octet-buffer data))) + (error "get-socket-name error"))) ; TODO: convert this + (ffi:foreign-free address) + (ffi:foreign-free address-length)) + (values (hbo-to-vector-quad host) port))) + + (defmethod get-local-name ((usocket datagram-usocket)) + (get-socket-name (socket usocket) '%getsockname)) + + (defmethod get-peer-name ((usocket datagram-usocket)) + (get-socket-name (socket usocket) '%getpeername)) + ) ; progn ;;; TODO: get-local-name & get-peer-name -(defmethod get-local-name ((usocket datagram-usocket)) - ) - -(defmethod get-peer-name ((usocket datagram-usocket)) - )

1 0

[usocket-cvs] r625 - usocket/branches/0.5.x/backend
by Chun Tian 31 Mar '11

31 Mar '11

Author: ctian Date: Thu Mar 31 10:39:07 2011 New Revision: 625 Log: [CMUCL] clean compilation warnings (the VALUES declaration works) Modified: usocket/branches/0.5.x/backend/cmucl.lisp Modified: usocket/branches/0.5.x/backend/cmucl.lisp ============================================================================== --- usocket/branches/0.5.x/backend/cmucl.lisp (original) +++ usocket/branches/0.5.x/backend/cmucl.lisp Thu Mar 31 10:39:07 2011 @@ -194,8 +194,7 @@ (multiple-value-bind (nbytes remote-host remote-port) (with-mapped-conditions (usocket) (ext:inet-recvfrom (socket usocket) real-buffer real-length)) - (when (plusp nbytes) - (values real-buffer nbytes remote-host remote-port))))) + (values real-buffer nbytes remote-host remote-port)))) (defmethod get-local-name ((usocket usocket)) (multiple-value-bind @@ -273,17 +272,17 @@ (multiple-value-bind (secs musecs) (split-timeout (or timeout 1)) - (multiple-value-bind - (count err) - (unix:unix-fast-select (1+ (reduce #'max - (wait-list-%wait wait-list))) - (alien:addr rfds) nil nil - (when timeout secs) musecs) + (multiple-value-bind (count err) + (unix:unix-fast-select (1+ (reduce #'max + (wait-list-%wait wait-list))) + (alien:addr rfds) nil nil + (when timeout secs) musecs) + (declare (ignore err)) (if (<= 0 count) ;; process the result... (dolist (x (wait-list-waiters wait-list)) (when (unix:fd-isset (socket x) rfds) (setf (state x) :READ))) - (progn - ;;###FIXME generate an error, except for EINTR - ))))))) + (progn + ;;###FIXME generate an error, except for EINTR + )))))))

1 0

[usocket-cvs] r624 - usocket/branches/0.5.x/backend
by Chun Tian 31 Mar '11

31 Mar '11

Author: ctian Date: Thu Mar 31 08:55:20 2011 New Revision: 624 Log: [LispWorks] minor fixes for version <= 5.0; use predefined *length-of-sockaddr_in*. Modified: usocket/branches/0.5.x/backend/lispworks.lisp Modified: usocket/branches/0.5.x/backend/lispworks.lisp ============================================================================== --- usocket/branches/0.5.x/backend/lispworks.lisp (original) +++ usocket/branches/0.5.x/backend/lispworks.lisp Thu Mar 31 08:55:20 2011 @@ -358,15 +358,14 @@ :element-type '(unsigned-byte 8) :allocation :static))) +(defvar *length-of-sockaddr_in* + (fli:size-of '(:struct comm::sockaddr_in))) + (defun send-message (socket-fd message buffer &optional (length (length buffer)) host service) "Send message to a socket, using sendto()/send()" (declare (type integer socket-fd) (type sequence buffer)) - (fli:with-dynamic-foreign-objects ((client-addr (:struct comm::sockaddr_in)) - (len :int - #-(or lispworks4 lispworks5.0) ; <= 5.0 - :initial-element - (fli:size-of '(:struct comm::sockaddr_in)))) + (fli:with-dynamic-foreign-objects ((client-addr (:struct comm::sockaddr_in))) (fli:with-dynamic-lisp-array-pointer (ptr message :type '(:unsigned :byte)) (replace message buffer :end2 length) (if (and host service) @@ -374,7 +373,7 @@ (comm::initialize-sockaddr_in client-addr comm::*socket_af_inet* host service "udp") (%sendto socket-fd ptr (min length +max-datagram-packet-size+) 0 (fli:copy-pointer client-addr :type '(:struct comm::sockaddr)) - (fli:dereference len))) + *length-of-sockaddr_in*)) (comm::%send socket-fd ptr (min length +max-datagram-packet-size+) 0))))) (defmethod socket-send ((socket datagram-usocket) buffer length &key host port) @@ -397,8 +396,9 @@ (fli:with-dynamic-foreign-objects ((client-addr (:struct comm::sockaddr_in)) (len :int #-(or lispworks4 lispworks5.0) ; <= 5.0 - :initial-element - (fli:size-of '(:struct comm::sockaddr_in)))) + :initial-element *length-of-sockaddr_in*)) + #+(or lispworks4 lispworks5.0) ; <= 5.0 + (setf (fli:dereference len) *length-of-sockaddr_in*) (fli:with-dynamic-lisp-array-pointer (ptr message :type '(:unsigned :byte)) ;; setup new read timeout (when read-timeout

1 0

[usocket-cvs] r623 - usocket/branches/0.5.x/backend
by Chun Tian 31 Mar '11

31 Mar '11

Author: ctian Date: Thu Mar 31 08:32:56 2011 New Revision: 623 Log: [CLISP] fixed SOCKET-SEND & SOCKET-RECEIVE for handling any data, confirmed by CL-NET-SNMP 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 08:32:56 2011 @@ -233,10 +233,6 @@ (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." - (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer - (integer 0) ; size - (unsigned-byte 32) ; host - (unsigned-byte 16))) ; port (let* ((sock (socket socket)) (sockaddr (unless (connected-p socket) (rawsock:make-sockaddr :inet))) @@ -311,9 +307,7 @@ ;; foreign functions (ffi:def-call-out %sendto (:name "sendto") (:arguments (socket ffi:int) - (buffer (ffi:c-ptr (ffi:c-array-max ffi:uint8 - #.+max-datagram-packet-size+)) - :in) + (buffer ffi:c-pointer) (length ffi:int) (flags ffi:int) (address (ffi:c-ptr sockaddr)) @@ -326,9 +320,7 @@ (ffi:def-call-out %send (:name "send") (:arguments (socket ffi:int) - (buffer (ffi:c-ptr (ffi:c-array-max ffi:uint8 - #.+max-datagram-packet-size+)) - :in) + (buffer ffi:c-pointer) (length ffi:int) (flags ffi:int)) #+win32 (:library "WS2_32") @@ -339,9 +331,7 @@ (ffi:def-call-out %recvfrom (:name "recvfrom") (:arguments (socket ffi:int) - (buffer (ffi:c-ptr (ffi:c-array-max ffi:uint8 - #.+max-datagram-packet-size+)) - :in-out) + (buffer ffi:c-pointer) (length ffi:int) (flags ffi:int) (address (ffi:c-ptr sockaddr) :in-out) @@ -509,35 +499,31 @@ (zerop (%close socket)))) (defmethod socket-receive ((usocket datagram-usocket) buffer length &key) - (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer - (integer 0) ; size - (unsigned-byte 32) ; host - (unsigned-byte 16))) ; port (let ((remote-address (ffi:allocate-shallow 'sockaddr_in)) (remote-address-length (ffi:allocate-shallow 'ffi:int)) nbytes (host 0) (port 0)) (setf (ffi:foreign-value remote-address-length) *length-of-sockaddr_in*) (unwind-protect - (multiple-value-bind (n return-buffer address address-length) + (multiple-value-bind (n address address-length) (%recvfrom (socket usocket) - (ffi:foreign-value (slot-value usocket 'recv-buffer)) + (ffi:foreign-address (slot-value usocket 'recv-buffer)) +max-datagram-packet-size+ 0 ; flags (ffi:cast (ffi:foreign-value remote-address) 'sockaddr) (ffi:foreign-value remote-address-length)) - (assert (= n (length return-buffer))) (setq nbytes n) (when (= address-length *length-of-sockaddr_in*) (let ((data (sockaddr-sa_data address))) (setq host (ip-from-octet-buffer data :start 2) port (port-from-octet-buffer data)))) (cond ((plusp n) - (if buffer ; replace exist buffer of create new return buffer - (let ((end-1 (min (or length (length buffer)) +max-datagram-packet-size+)) - (end-2 (min n +max-datagram-packet-size+))) - (replace buffer return-buffer :end1 end-1 :end2 end-2)) - (setq buffer (subseq return-buffer 0 (min n +max-datagram-packet-size+))))) + (let ((return-buffer (ffi:foreign-value (slot-value usocket 'recv-buffer)))) + (if buffer ; replace exist buffer of create new return buffer + (let ((end-1 (min (or length (length buffer)) +max-datagram-packet-size+)) + (end-2 (min n +max-datagram-packet-size+))) + (replace buffer return-buffer :end1 end-1 :end2 end-2)) + (setq buffer (subseq return-buffer 0 (min n +max-datagram-packet-size+)))))) ((zerop n)) ; do nothing (t))) ; TODO: handle error here. (ffi:foreign-free remote-address) @@ -564,12 +550,13 @@ (unwind-protect (let ((n (if remote-address (%sendto (socket usocket) - (ffi:foreign-value send-buffer) + (ffi:foreign-address send-buffer) (min length +max-datagram-packet-size+) 0 (ffi:cast (ffi:foreign-value remote-address) 'sockaddr) *length-of-sockaddr_in*) (%send (socket usocket) - (ffi:foreign-value send-buffer) + ;; (ffi:cast (ffi:foreign-value send-buffer) 'ffi:c-pointer) + (ffi:foreign-address send-buffer) (min length +max-datagram-packet-size+) 0)))) (cond ((plusp n) (setq nbytes n))

1 0

[usocket-cvs] r622 - usocket/branches/0.5.x/backend
by Chun Tian 31 Mar '11

31 Mar '11

Author: ctian Date: Thu Mar 31 07:56:14 2011 New Revision: 622 Log: [CLISP] fixed SOCKET-RECEIVE, now all four values correctly returned. 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 07:56:14 2011 @@ -516,6 +516,8 @@ (let ((remote-address (ffi:allocate-shallow 'sockaddr_in)) (remote-address-length (ffi:allocate-shallow 'ffi:int)) nbytes (host 0) (port 0)) + (setf (ffi:foreign-value remote-address-length) + *length-of-sockaddr_in*) (unwind-protect (multiple-value-bind (n return-buffer address address-length) (%recvfrom (socket usocket) @@ -527,9 +529,9 @@ (assert (= n (length return-buffer))) (setq nbytes n) (when (= address-length *length-of-sockaddr_in*) - (let ((in (ffi:cast (ffi:foreign-value address) 'sockaddr_in))) - (setq host (%ntohl (ffi:slot (ffi:foreign-value in) 'sin_addr)) - port (%ntohs (ffi:slot (ffi:foreign-value in) 'sin_port))))) + (let ((data (sockaddr-sa_data address))) + (setq host (ip-from-octet-buffer data :start 2) + port (port-from-octet-buffer data)))) (cond ((plusp n) (if buffer ; replace exist buffer of create new return buffer (let ((end-1 (min (or length (length buffer)) +max-datagram-packet-size+)) @@ -579,3 +581,11 @@ (ffi:foreign-free remote-address)) nbytes))) ) ; progn + +;;; TODO: get-local-name & get-peer-name + +(defmethod get-local-name ((usocket datagram-usocket)) + ) + +(defmethod get-peer-name ((usocket datagram-usocket)) + )

1 0

[usocket-cvs] r621 - usocket/branches/0.5.x
by Chun Tian 31 Mar '11

31 Mar '11

Author: ctian Date: Thu Mar 31 07:06:20 2011 New Revision: 621 Log: [CLISP] remove SEND-BUFFER slot from USOCKET class, no need Modified: usocket/branches/0.5.x/usocket.lisp Modified: usocket/branches/0.5.x/usocket.lisp ============================================================================== --- usocket/branches/0.5.x/usocket.lisp (original) +++ usocket/branches/0.5.x/usocket.lisp Thu Mar 31 07:06:20 2011 @@ -111,8 +111,7 @@ #+(or lispworks (and clisp ffi (not rawsock))) (recv-buffer :documentation "Private RECV buffer.") - #+(or lispworks - (and clisp ffi (not rawsock))) + #+lispworks (send-buffer :documentation "Private SEND buffer.")) (:documentation "UDP (inet-datagram) socket"))

1 0

[usocket-cvs] r620 - usocket/branches/0.5.x/backend
by Chun Tian 31 Mar '11

31 Mar '11

Author: ctian Date: Thu Mar 31 07:05:05 2011 New Revision: 620 Log: [CLISP] SOCKET-SEND & SOCKET-RECEIVE (FFI version), partly tested. 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 07:05:05 2011 @@ -77,7 +77,8 @@ (defun socket-connect (host port &key (protocol :stream) (element-type 'character) timeout deadline (nodelay t nodelay-specified) local-host local-port) - (declare (ignore nodelay)) + (declare (ignore nodelay) + (ignorable timeout local-host local-port)) (when deadline (unsupported 'deadline 'socket-connect)) (when nodelay-specified (unsupported 'nodelay 'socket-connect)) (case protocol @@ -310,7 +311,9 @@ ;; foreign functions (ffi:def-call-out %sendto (:name "sendto") (:arguments (socket ffi:int) - (buffer (ffi:c-ptr ffi:uint8)) + (buffer (ffi:c-ptr (ffi:c-array-max ffi:uint8 + #.+max-datagram-packet-size+)) + :in) (length ffi:int) (flags ffi:int) (address (ffi:c-ptr sockaddr)) @@ -321,9 +324,24 @@ #+win32 :stdc-stdcall) (:return-type ffi:int)) + (ffi:def-call-out %send (:name "send") + (:arguments (socket ffi:int) + (buffer (ffi:c-ptr (ffi:c-array-max ffi:uint8 + #.+max-datagram-packet-size+)) + :in) + (length ffi:int) + (flags ffi:int)) + #+win32 (:library "WS2_32") + #-win32 (:library :default) + (:language #-win32 :stdc + #+win32 :stdc-stdcall) + (:return-type ffi:int)) + (ffi:def-call-out %recvfrom (:name "recvfrom") (:arguments (socket ffi:int) - (buffer (ffi:c-ptr ffi:uint8) :in-out) + (buffer (ffi:c-ptr (ffi:c-array-max ffi:uint8 + #.+max-datagram-packet-size+)) + :in-out) (length ffi:int) (flags ffi:int) (address (ffi:c-ptr sockaddr) :in-out) @@ -437,7 +455,7 @@ (declaim (inline fill-sockaddr_in)) (defun fill-sockaddr_in (sockaddr host port) - (let ((hbo (host-to-hbo #(127 0 0 1)))) + (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+ @@ -473,16 +491,20 @@ (ffi:foreign-free rsock_addr))) (make-datagram-socket sock :connected-p (if rsock_addr t nil)))) + (defun finalize-datagram-usocket (object) + (when (datagram-usocket-p object) + (socket-close object))) + (defmethod initialize-instance :after ((usocket datagram-usocket) &key) - (with-slots (send-buffer recv-buffer) usocket - (setf send-buffer (ffi:allocate-shallow 'ffi:uint8 :count +max-datagram-packet-size+) - recv-buffer (ffi:allocate-shallow 'ffi:uint8 :count +max-datagram-packet-size+)))) + (setf (slot-value usocket 'recv-buffer) + (ffi:allocate-shallow 'ffi:uint8 :count +max-datagram-packet-size+)) + ;; finalize the object + (ext:finalize usocket 'finalize-datagram-usocket)) (defmethod socket-close ((usocket datagram-usocket)) (when (wait-list usocket) (remove-waiter (wait-list usocket) usocket)) - (with-slots (send-buffer recv-buffer socket) usocket - (ffi:foreign-free send-buffer) + (with-slots (recv-buffer socket) usocket (ffi:foreign-free recv-buffer) (zerop (%close socket)))) @@ -493,30 +515,67 @@ (unsigned-byte 16))) ; port (let ((remote-address (ffi:allocate-shallow 'sockaddr_in)) (remote-address-length (ffi:allocate-shallow 'ffi:int)) - nbytes) + nbytes (host 0) (port 0)) (unwind-protect - (with-slots (recv-buffer) usocket - (multiple-value-bind (n buffer address address-len) - (%recvfrom (socket usocket) - recv-buffer - +max-datagram-packet-size+ - 0 ; flags - remote-address - remote-address-length) - (setq nbytes n) - (cond ((plusp n) - (if buffer ; replace exist buffer of create new return buffer - (replace buffer (ffi:foreign-value recv-buffer) - :end1 (min length +max-datagram-packet-size+) - :end2 (min n +max-datagram-packet-size+)) - (setq buffer (subseq (ffi:foreign-value recv-buffer) - 0 (min n +max-datagram-packet-size+))))) - ((zerop n)) ; do nothing - (t)))) ; TODO: handle error here. + (multiple-value-bind (n return-buffer address address-length) + (%recvfrom (socket usocket) + (ffi:foreign-value (slot-value usocket 'recv-buffer)) + +max-datagram-packet-size+ + 0 ; flags + (ffi:cast (ffi:foreign-value remote-address) 'sockaddr) + (ffi:foreign-value remote-address-length)) + (assert (= n (length return-buffer))) + (setq nbytes n) + (when (= address-length *length-of-sockaddr_in*) + (let ((in (ffi:cast (ffi:foreign-value address) 'sockaddr_in))) + (setq host (%ntohl (ffi:slot (ffi:foreign-value in) 'sin_addr)) + port (%ntohs (ffi:slot (ffi:foreign-value in) 'sin_port))))) + (cond ((plusp n) + (if buffer ; replace exist buffer of create new return buffer + (let ((end-1 (min (or length (length buffer)) +max-datagram-packet-size+)) + (end-2 (min n +max-datagram-packet-size+))) + (replace buffer return-buffer :end1 end-1 :end2 end-2)) + (setq buffer (subseq return-buffer 0 (min n +max-datagram-packet-size+))))) + ((zerop n)) ; do nothing + (t))) ; TODO: handle error here. (ffi:foreign-free remote-address) (ffi:foreign-free remote-address-length)) - (values buffer nbytes 0 0))) ; TODO: remote-host and remote-port needed + (values buffer nbytes host port))) - (defmethod socket-send ((socket datagram-usocket) buffer length &key host port) - ) + ;; implementation note: different from socket-receive, we know how many bytes we want to send everytime, + ;; so, a send buffer will not needed, and if there is a buffer, it's hard to fill its content like those + ;; in LispWorks. So, we allocate new foreign buffer for holding data (unknown sequence subtype) every time. + ;; + ;; I don't know if anyone is watching my coding work, but I think this design is reasonable for CLISP. + (defmethod socket-send ((usocket datagram-usocket) buffer length &key host port) + (declare (type sequence buffer) + (type integer length)) + (let ((remote-address (when (and host port) + (fill-sockaddr_in (ffi:allocate-shallow 'sockaddr_in) host port))) + (send-buffer (let ((buffer-length (length buffer))) + (if (> buffer-length (* length 2)) + ;; if buffer is too big, then we copy out a subseq and only allocate as need + (ffi:allocate-deep 'ffi:uint8 (subseq buffer 0 length) :count length :read-only t) + ;; then we allocate the whole buffer directly, that should be faster. + (ffi:allocate-deep 'ffi:uint8 buffer :count (length buffer) :read-only t)))) + nbytes) + (unwind-protect + (let ((n (if remote-address + (%sendto (socket usocket) + (ffi:foreign-value send-buffer) + (min length +max-datagram-packet-size+) 0 + (ffi:cast (ffi:foreign-value remote-address) 'sockaddr) + *length-of-sockaddr_in*) + (%send (socket usocket) + (ffi:foreign-value send-buffer) + (min length +max-datagram-packet-size+) 0)))) + (cond ((plusp n) + (setq nbytes n)) + ((zerop n) + (setq nbytes n)) + (t))) ; TODO: error handling + (ffi:foreign-free send-buffer) + (when remote-address + (ffi:foreign-free remote-address)) + nbytes))) ) ; progn

1 0

[usocket-cvs] r619 - in usocket/branches/0.5.x: . backend
by Chun Tian 31 Mar '11

31 Mar '11

Author: ctian Date: Thu Mar 31 02:25:43 2011 New Revision: 619 Log: [CLISP] SOCKET-RECEIVE (FFI version), untested. 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 Thu Mar 31 02:25:43 2011 @@ -323,11 +323,11 @@ (ffi:def-call-out %recvfrom (:name "recvfrom") (:arguments (socket ffi:int) - (buffer (ffi:c-ptr ffi:uint8) :out) + (buffer (ffi:c-ptr ffi:uint8) :in-out) (length ffi:int) (flags ffi:int) - (address (ffi:c-ptr sockaddr) :out) - (address-len (ffi:c-ptr ffi:int) :out)) + (address (ffi:c-ptr sockaddr) :in-out) + (address-len (ffi:c-ptr ffi:int) :in-out)) #+win32 (:library "WS2_32") #-win32 (:library :default) (:language #-win32 :stdc @@ -438,10 +438,16 @@ (declaim (inline fill-sockaddr_in)) (defun fill-sockaddr_in (sockaddr host port) (let ((hbo (host-to-hbo #(127 0 0 1)))) + #+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+ + (ffi:slot place 'sin_port) (%htons port) + (ffi:slot place 'sin_addr) (%htonl hbo))) sockaddr)) (defun socket-create-datagram (local-port @@ -467,17 +473,49 @@ (ffi:foreign-free rsock_addr))) (make-datagram-socket sock :connected-p (if rsock_addr t nil)))) + (defmethod initialize-instance :after ((usocket datagram-usocket) &key) + (with-slots (send-buffer recv-buffer) usocket + (setf send-buffer (ffi:allocate-shallow 'ffi:uint8 :count +max-datagram-packet-size+) + recv-buffer (ffi:allocate-shallow 'ffi:uint8 :count +max-datagram-packet-size+)))) + (defmethod socket-close ((usocket datagram-usocket)) (when (wait-list usocket) (remove-waiter (wait-list usocket) usocket)) - (zerop (%close (socket usocket)))) + (with-slots (send-buffer recv-buffer socket) usocket + (ffi:foreign-free send-buffer) + (ffi:foreign-free recv-buffer) + (zerop (%close socket)))) - (defmethod socket-receive ((socket datagram-usocket) buffer length &key) + (defmethod socket-receive ((usocket datagram-usocket) buffer length &key) (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer (integer 0) ; size (unsigned-byte 32) ; host (unsigned-byte 16))) ; port - ) + (let ((remote-address (ffi:allocate-shallow 'sockaddr_in)) + (remote-address-length (ffi:allocate-shallow 'ffi:int)) + nbytes) + (unwind-protect + (with-slots (recv-buffer) usocket + (multiple-value-bind (n buffer address address-len) + (%recvfrom (socket usocket) + recv-buffer + +max-datagram-packet-size+ + 0 ; flags + remote-address + remote-address-length) + (setq nbytes n) + (cond ((plusp n) + (if buffer ; replace exist buffer of create new return buffer + (replace buffer (ffi:foreign-value recv-buffer) + :end1 (min length +max-datagram-packet-size+) + :end2 (min n +max-datagram-packet-size+)) + (setq buffer (subseq (ffi:foreign-value recv-buffer) + 0 (min n +max-datagram-packet-size+))))) + ((zerop n)) ; do nothing + (t)))) ; TODO: handle error here. + (ffi:foreign-free remote-address) + (ffi:foreign-free remote-address-length)) + (values buffer nbytes 0 0))) ; TODO: remote-host and remote-port needed (defmethod socket-send ((socket datagram-usocket) buffer length &key 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 Thu Mar 31 02:25:43 2011 @@ -99,18 +99,21 @@ ((connected-p :type boolean :accessor connected-p :initarg :connected-p) - #+(or cmu scl lispworks) + #+(or cmu + scl + lispworks + (and clisp ffi (not rawsock))) (%open-p :type boolean :accessor %open-p :initform t :documentation "Flag to indicate if usocket is open, for GC on implementions operate on raw socket fd.") - #+lispworks - (recv-buffer - :documentation "Private RECV buffer.") - #+lispworks - (send-buffer - :documentation "Private SEND buffer.")) + #+(or lispworks + (and clisp ffi (not rawsock))) + (recv-buffer :documentation "Private RECV buffer.") + #+(or lispworks + (and clisp ffi (not rawsock))) + (send-buffer :documentation "Private SEND buffer.")) (:documentation "UDP (inet-datagram) socket")) (defun usocket-p (socket)

1 0

[usocket-cvs] r618 - usocket/branches/0.5.x/backend
by Chun Tian 31 Mar '11

31 Mar '11

Author: ctian Date: Wed Mar 30 23:22:37 2011 New Revision: 618 Log: Add VALUES declaration for SOCKET-RECEIVE, and I doubt not all backends currently return all four values correctly. Modified: usocket/branches/0.5.x/backend/abcl.lisp usocket/branches/0.5.x/backend/allegro.lisp usocket/branches/0.5.x/backend/clisp.lisp usocket/branches/0.5.x/backend/cmucl.lisp usocket/branches/0.5.x/backend/lispworks.lisp usocket/branches/0.5.x/backend/openmcl.lisp usocket/branches/0.5.x/backend/sbcl.lisp usocket/branches/0.5.x/backend/scl.lisp Modified: usocket/branches/0.5.x/backend/abcl.lisp ============================================================================== --- usocket/branches/0.5.x/backend/abcl.lisp (original) +++ usocket/branches/0.5.x/backend/abcl.lisp Wed Mar 30 23:22:37 2011 @@ -343,6 +343,10 @@ ;;; TODO: return-host and return-port cannot be get ... (defmethod socket-receive ((usocket datagram-usocket) buffer length &key (element-type '(unsigned-byte 8))) + (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer + (integer 0) ; size + (unsigned-byte 32) ; host + (unsigned-byte 16))) ; port (let* ((socket (socket usocket)) (real-length (or length +max-datagram-packet-size+)) (byte-array (jnew-array $*byte real-length)) Modified: usocket/branches/0.5.x/backend/allegro.lisp ============================================================================== --- usocket/branches/0.5.x/backend/allegro.lisp (original) +++ usocket/branches/0.5.x/backend/allegro.lisp Wed Mar 30 23:22:37 2011 @@ -155,6 +155,10 @@ (socket:send-to s buffer length :remote-host host :remote-port port)))) (defmethod socket-receive ((socket datagram-usocket) buffer length &key) + (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer + (integer 0) ; size + (unsigned-byte 32) ; host + (unsigned-byte 16))) ; port (with-mapped-conditions (socket) (let ((s (socket socket))) (socket:receive-from s length :buffer buffer :extract t)))) 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 23:22:37 2011 @@ -232,6 +232,10 @@ (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." + (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer + (integer 0) ; size + (unsigned-byte 32) ; host + (unsigned-byte 16))) ; port (let* ((sock (socket socket)) (sockaddr (unless (connected-p socket) (rawsock:make-sockaddr :inet))) @@ -468,4 +472,13 @@ (remove-waiter (wait-list usocket) usocket)) (zerop (%close (socket usocket)))) + (defmethod socket-receive ((socket datagram-usocket) buffer length &key) + (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer + (integer 0) ; size + (unsigned-byte 32) ; host + (unsigned-byte 16))) ; port + ) + + (defmethod socket-send ((socket datagram-usocket) buffer length &key host port) + ) ) ; progn Modified: usocket/branches/0.5.x/backend/cmucl.lisp ============================================================================== --- usocket/branches/0.5.x/backend/cmucl.lisp (original) +++ usocket/branches/0.5.x/backend/cmucl.lisp Wed Mar 30 23:22:37 2011 @@ -183,6 +183,10 @@ (%unix-send (socket usocket) buffer length 0)))) (defmethod socket-receive ((usocket datagram-usocket) buffer length &key) + (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer + (integer 0) ; size + (unsigned-byte 32) ; host + (unsigned-byte 16))) ; port (let ((real-buffer (or buffer (make-array length :element-type '(unsigned-byte 8)))) (real-length (or length Modified: usocket/branches/0.5.x/backend/lispworks.lisp ============================================================================== --- usocket/branches/0.5.x/backend/lispworks.lisp (original) +++ usocket/branches/0.5.x/backend/lispworks.lisp Wed Mar 30 23:22:37 2011 @@ -433,6 +433,10 @@ (values nil n 0 0))))))) (defmethod socket-receive ((socket datagram-usocket) buffer length &key timeout) + (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer + (integer 0) ; size + (unsigned-byte 32) ; host + (unsigned-byte 16))) ; port (multiple-value-bind (buffer size host port) (receive-message (socket socket) (slot-value socket 'recv-buffer) Modified: usocket/branches/0.5.x/backend/openmcl.lisp ============================================================================== --- usocket/branches/0.5.x/backend/openmcl.lisp (original) +++ usocket/branches/0.5.x/backend/openmcl.lisp Wed Mar 30 23:22:37 2011 @@ -157,6 +157,10 @@ (ccl::send-for-usocket (socket usocket) buffer length)))) (defmethod socket-receive ((usocket datagram-usocket) buffer length &key) + (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer + (integer 0) ; size + (unsigned-byte 32) ; host + (unsigned-byte 16))) ; port (with-mapped-conditions (usocket) (openmcl-socket:receive-from (socket usocket) length :buffer buffer))) Modified: usocket/branches/0.5.x/backend/sbcl.lisp ============================================================================== --- usocket/branches/0.5.x/backend/sbcl.lisp (original) +++ usocket/branches/0.5.x/backend/sbcl.lisp Wed Mar 30 23:22:37 2011 @@ -387,6 +387,10 @@ (defmethod socket-receive ((socket datagram-usocket) buffer length &key (element-type '(unsigned-byte 8))) + (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer + (integer 0) ; size + (unsigned-byte 32) ; host + (unsigned-byte 16))) ; port (with-mapped-conditions (socket) (let ((s (socket socket))) (sb-bsd-sockets:socket-receive s buffer length :element-type element-type)))) Modified: usocket/branches/0.5.x/backend/scl.lisp ============================================================================== --- usocket/branches/0.5.x/backend/scl.lisp (original) +++ usocket/branches/0.5.x/backend/scl.lisp Wed Mar 30 23:22:37 2011 @@ -145,6 +145,10 @@ (scl-map-socket-error errno :socket socket))))) (defmethod socket-receive ((socket datagram-usocket) buffer length &key) + (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer + (integer 0) ; size + (unsigned-byte 32) ; host + (unsigned-byte 16))) ; port (let ((s (socket socket))) (let ((real-buffer (or buffer (make-array length :element-type '(unsigned-byte 8))))

1 0