Author: ctian Date: Sat Feb 4 07:56:00 2012 New Revision: 685

Log: [UDP] SOCKET-SEND now support an CCL-like OFFSET keyword for sending only parts of the whole buffer.

Modified: usocket/trunk/CHANGES usocket/trunk/backend/abcl.lisp usocket/trunk/backend/allegro.lisp usocket/trunk/backend/clisp.lisp usocket/trunk/backend/cmucl.lisp usocket/trunk/backend/lispworks.lisp usocket/trunk/backend/openmcl.lisp usocket/trunk/backend/sbcl.lisp usocket/trunk/backend/scl.lisp

Modified: usocket/trunk/CHANGES ============================================================================== --- usocket/trunk/CHANGES Sat Feb 4 02:35:44 2012 (r684) +++ usocket/trunk/CHANGES Sat Feb 4 07:56:00 2012 (r685) @@ -1,6 +1,7 @@ 0.6.0:

* New feature: SOCKET-OPTION and (setf SOCKET-OPTION) for seting and geting various socket options. +* New feature: [UDP] SOCKET-SEND now support an CCL-like OFFSET keyword for sending only parts of the whole buffer. * (on the way) New feature: SOCKET-SHUTDOWN for TCP and UDP sockets. * Enhancement: SOCKET-CONNECT argument :nodelay now support :if-supported as value (patch from Anton Vodonosov). * Enhancement: Add *remote-host* *remote-port* to SOCKET-SERVER stream handler (suggested by Matthew Curry).

Modified: usocket/trunk/backend/abcl.lisp ============================================================================== --- usocket/trunk/backend/abcl.lisp Sat Feb 4 02:35:44 2012 (r684) +++ usocket/trunk/backend/abcl.lisp Sat Feb 4 07:56:00 2012 (r685) @@ -335,19 +335,17 @@ (code-char ub8) ub8)))

-(defmethod socket-send ((usocket datagram-usocket) buffer length &key host port) +(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0)) (let* ((socket (socket usocket)) - (real-length (or length (length buffer))) - (byte-array (jnew-array $*byte real-length)) + (byte-array (jnew-array $*byte size)) (packet (if (and host port) - (jnew $%DatagramPacket/5 byte-array 0 real-length (host-to-inet4 host) port) - (jnew $%DatagramPacket/3 byte-array 0 real-length)))) + (jnew $%DatagramPacket/5 byte-array 0 size (host-to-inet4 host) port) + (jnew $%DatagramPacket/3 byte-array 0 size)))) ;; prepare sending data - (loop for i from 0 below real-length + (loop for i from offset below (+ size offset) do (setf (jarray-ref byte-array i) (*->byte (aref buffer i)))) (with-mapped-conditions (usocket) - (jcall $@send/1 socket packet)) - real-length)) + (jcall $@send/1 socket packet))))

;;; TODO: return-host and return-port cannot be get ... (defmethod socket-receive ((usocket datagram-usocket) buffer length

Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp Sat Feb 4 02:35:44 2012 (r684) +++ usocket/trunk/backend/allegro.lisp Sat Feb 4 07:56:00 2012 (r685) @@ -151,10 +151,16 @@ (values (get-peer-address usocket) (get-peer-port usocket)))

-(defmethod socket-send ((socket datagram-usocket) buffer length &key host port) +(defmethod socket-send ((socket datagram-usocket) buffer size &key host port (offset 0)) (with-mapped-conditions (socket) (let ((s (socket socket))) - (socket:send-to s buffer length :remote-host host :remote-port port)))) + (socket:send-to s + (if (zerop offset) + buffer + (subseq buffer offset (+ offset size))) + size + :remote-host host + :remote-port port))))

(defmethod socket-receive ((socket datagram-usocket) buffer length &key) (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer

Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp Sat Feb 4 02:35:44 2012 (r684) +++ usocket/trunk/backend/clisp.lisp Sat Feb 4 07:56:00 2012 (r685) @@ -93,10 +93,12 @@ "Dispatch correct usocket condition." (let (error-keyword error-string) (typecase condition + #+ffi ; because OS:ERRNO and OS:STRERROR is only present if FFI is present. (system::simple-os-error (let ((errno (car (simple-condition-format-arguments condition)))) (setq error-keyword (os:errno errno) error-string (os:strerror errno)))) + #+ffi ; because OS:ERRNO and OS:STRERROR is only present if FFI is present. (simple-error (let ((keyword (car (simple-condition-format-arguments condition)))) @@ -302,7 +304,7 @@ host port))))

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

(defmethod socket-close ((usocket datagram-usocket)) @@ -631,30 +633,31 @@ ;; 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) + (defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0)) (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)))) - (real-length (min length +max-datagram-packet-size+)) + (type (integer 0 *) size offset)) + (let ((remote-address + (when (and host port) + (fill-sockaddr_in (ffi:allocate-shallow 'sockaddr_in) host port))) + (send-buffer + (ffi:allocate-deep 'ffi:uint8 + (if (zerop offset) + buffer + (subseq buffer offset (+ offset size))) + :count size :read-only t)) + (real-size (min size +max-datagram-packet-size+)) (nbytes 0)) (unwind-protect (let ((n (if remote-address (%sendto (socket usocket) (ffi:foreign-address send-buffer) - real-length + real-size 0 ; flags (ffi:cast (ffi:foreign-value remote-address) 'sockaddr) *length-of-sockaddr_in*) (%send (socket usocket) (ffi:foreign-address send-buffer) - real-length + real-size 0)))) (cond ((plusp n) (setq nbytes n))

Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp Sat Feb 4 02:35:44 2012 (r684) +++ usocket/trunk/backend/cmucl.lisp Sat Feb 4 07:56:00 2012 (r685) @@ -174,14 +174,17 @@ length flags))

-(defmethod socket-send ((usocket datagram-usocket) buffer length &key host port) +(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0) + &aux (real-buffer (if (zerop offset) + buffer + (subseq buffer offset (+ offset size))))) (with-mapped-conditions (usocket) (if (and host port) - (ext:inet-sendto (socket usocket) buffer length (host-to-hbo host) port) + (ext:inet-sendto (socket usocket) real-buffer size (host-to-hbo host) port) #-unicode - (unix:unix-send (socket usocket) buffer length 0) + (unix:unix-send (socket usocket) real-buffer size 0) #+unicode - (%unix-send (socket usocket) buffer length 0)))) + (%unix-send (socket usocket) real-buffer size 0))))

(defmethod socket-receive ((usocket datagram-usocket) buffer length &key) (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer

Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp Sat Feb 4 02:35:44 2012 (r684) +++ usocket/trunk/backend/lispworks.lisp Sat Feb 4 07:56:00 2012 (r685) @@ -423,28 +423,27 @@ (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) +(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0) + &aux (socket-fd (socket usocket)) + (message (slot-value usocket 'send-buffer))) "Send message to a socket, using sendto()/send()" (declare (type integer socket-fd) (type sequence buffer)) + (when host (setq host (host-to-hbo host))) (fli:with-dynamic-lisp-array-pointer (ptr message :type '(:unsigned :byte)) - (replace message buffer :end2 length) - (if (and host service) + (replace message buffer :start2 offset :end2 (+ offset size)) + (if (and host port) (fli:with-dynamic-foreign-objects () (multiple-value-bind (error family client-addr client-addr-length) - (initialize-dynamic-sockaddr host service "udp") + (initialize-dynamic-sockaddr host port "udp") + (declare (ignore family)) (when error - (error "cannot resolve hostname ~S, service ~S: ~A" - host service error)) - (%sendto socket-fd ptr (min length +max-datagram-packet-size+) 0 + (error "cannot resolve hostname ~S, port ~S: ~A" + host port error)) + (%sendto socket-fd ptr (min size +max-datagram-packet-size+) 0 (fli:copy-pointer client-addr :type '(:struct comm::sockaddr)) client-addr-length))) - (comm::%send socket-fd ptr (min length +max-datagram-packet-size+) 0)))) - -(defmethod socket-send ((socket datagram-usocket) buffer length &key host port) - (send-message (socket socket) - (slot-value socket 'send-buffer) - buffer length (and host (host-to-hbo host)) port)) + (comm::%send socket-fd ptr (min size +max-datagram-packet-size+) 0))))

(defun receive-message (socket-fd message &optional buffer (length (length buffer)) &key read-timeout (max-buffer-size +max-datagram-packet-size+))

Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp Sat Feb 4 02:35:44 2012 (r684) +++ usocket/trunk/backend/openmcl.lisp Sat Feb 4 07:56:00 2012 (r685) @@ -149,24 +149,25 @@ (with-mapped-conditions (usocket) (close (socket usocket))))

-(defmethod socket-send ((usocket datagram-usocket) buffer length &key host port offset) +(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0)) (with-mapped-conditions (usocket) (if (and host port) - (openmcl-socket:send-to (socket usocket) buffer length + (openmcl-socket:send-to (socket usocket) buffer size :remote-host (host-to-hbo host) - :remote-port port) + :remote-port port + :offset offset) ;; Clozure CL's socket function SEND-TO doesn't support operations on connected UDP sockets, ;; so we have to define our own. (let* ((socket (socket usocket)) (fd (ccl::socket-device socket))) (multiple-value-setq (buffer offset) - (ccl::verify-socket-buffer buffer offset length)) - (ccl::%stack-block ((bufptr length)) - (ccl::%copy-ivector-to-ptr buffer offset bufptr 0 length) + (ccl::verify-socket-buffer buffer offset size)) + (ccl::%stack-block ((bufptr size)) + (ccl::%copy-ivector-to-ptr buffer offset bufptr 0 size) (ccl::socket-call socket "send" (ccl::with-eagain fd :output (ccl::ignoring-eintr - (ccl::check-socket-error (#_send fd bufptr length 0)))))))))) + (ccl::check-socket-error (#_send fd bufptr size 0))))))))))

(defmethod socket-receive ((usocket datagram-usocket) buffer length &key) (with-mapped-conditions (usocket)

Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp Sat Feb 4 02:35:44 2012 (r684) +++ usocket/trunk/backend/sbcl.lisp Sat Feb 4 07:56:00 2012 (r685) @@ -398,11 +398,14 @@ (with-mapped-conditions (usocket) (close (socket-stream usocket))))

-(defmethod socket-send ((socket datagram-usocket) buffer length &key host port) +(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0)) (with-mapped-conditions (socket) - (let* ((s (socket socket)) - (dest (if (and host port) (list (host-to-vector-quad host) port) nil))) - (sb-bsd-sockets:socket-send s buffer length :address dest)))) + (let* ((s (socket usocket)) + (dest (if (and host port) (list (host-to-vector-quad host) port) nil)) + (real-buffer (if (zerop offset) + buffer + (subseq buffer offset (+ offset size))))) + (sb-bsd-sockets:socket-send s real-buffer size :address dest))))

(defmethod socket-receive ((socket datagram-usocket) buffer length &key (element-type '(unsigned-byte 8)))

Modified: usocket/trunk/backend/scl.lisp ============================================================================== --- usocket/trunk/backend/scl.lisp Sat Feb 4 02:35:44 2012 (r684) +++ usocket/trunk/backend/scl.lisp Sat Feb 4 07:56:00 2012 (r685) @@ -136,14 +136,17 @@ (defmethod socket-close :after ((socket datagram-usocket)) (setf (%open-p socket) nil))

-(defmethod socket-send ((socket datagram-usocket) buffer length &key host port) - (let ((s (socket socket)) - (host (if host (host-to-hbo host)))) +(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port) + (let ((s (socket usocket)) + (host (if host (host-to-hbo host))) + (real-buffer (if (zerop offset) + buffer + (subseq buffer offset (+ offset size))))) (multiple-value-bind (result errno) - (ext:inet-socket-send-to s buffer length + (ext:inet-socket-send-to s real-buffer size :remote-host host :remote-port port) (or result - (scl-map-socket-error errno :socket socket))))) + (scl-map-socket-error errno :socket usocket)))))

(defmethod socket-receive ((socket datagram-usocket) buffer length &key) (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer