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

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

30 Mar '11

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

1 0

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

30 Mar '11

Author: ctian Date: Wed Mar 30 02:05:35 2011 New Revision: 607 Log: Fixed wrong macro expansions of {IP|PORT}-{FROM|TO}-OCTET-BUFFER functions! 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 Wed Mar 30 02:05:35 2011 @@ -367,16 +367,16 @@ (aref buffer b))))) (defmacro port-to-octet-buffer (port buffer &key (start 0)) - `(integer-to-octet-buffer ,port ,buffer 2 ,start)) + `(integer-to-octet-buffer ,port ,buffer 2 :start ,start)) (defmacro ip-to-octet-buffer (ip buffer &key (start 0)) - `(integer-to-octet-buffer (host-byte-order ,ip) ,buffer 4 ,start)) + `(integer-to-octet-buffer (host-byte-order ,ip) ,buffer 4 :start ,start)) (defmacro port-from-octet-buffer (buffer &key (start 0)) - `(octet-buffer-to-integer ,buffer 2 ,start)) + `(octet-buffer-to-integer ,buffer 2 :start ,start)) (defmacro ip-from-octet-buffer (buffer &key (start 0)) - `(octet-buffer-to-integer ,buffer 4 ,start)) + `(octet-buffer-to-integer ,buffer 4 :start ,start)) ;; ;; IP(v4) utility functions

1 0

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

30 Mar '11

Author: ctian Date: Wed Mar 30 01:49:11 2011 New Revision: 606 Log: [CLISP] more FFI basic definitions. 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 Wed Mar 30 01:49:11 2011 @@ -270,12 +270,35 @@ #+(and ffi (not rawsock)) (progn + ;; C primitive types + (ffi:def-c-type size_t) + (ffi:def-c-type in_addr_t ffi:uint32) + (ffi:def-c-type in_port_t ffi:uint16) + (ffi:def-c-type sa_family_t ffi:uint8) + (ffi:def-c-type socklen_t ffi:uint32) + + ;; C structures (ffi:def-c-struct sockaddr - ) + (sa_len ffi:uint8) + (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) + (sin_port in_port_t) + (sin_addr in_addr_t) ; should be struct in_addr + (sin_zero (ffi:c-array ffi:char 8))) + + (ffi:def-c-struct timeval + (tv_sec ffi:long) + (tv_usec ffi:long)) + ;; foreign functions (ffi:def-call-out %sendto (:name "sendto") (:arguments (socket ffi:int) (buffer (ffi:c-ptr ffi:uint8)) @@ -301,4 +324,53 @@ (:language #-win32 :stdc #+win32 :stdc-stdcall) (:return-type ffi:int)) + + (ffi:def-call-out %socket (:name "socket") + (:arguments (family ffi:int) + (type ffi:int) + (protocol ffi:int)) + #+win32 (:library "WS2_32") + #-win32 (:library :default) + (:language #-win32 :stdc + #+win32 :stdc-stdcall) + (:return-type ffi:int)) + + (ffi:def-call-out %getsockopt (:name "getsockopt") + (:arguments (sockfd ffi:int) + (level ffi:int) + (optname ffi:int) + (optval ffi:c-pointer) + (optlen (ffi:c-ptr socklen_t) :out)) + #+win32 (:library "WS2_32") + #-win32 (:library :default) + (:language #-win32 :stdc + #+win32 :stdc-stdcall) + (:return-type ffi:int)) + + (ffi:def-call-out %setsockopt (:name "setsockopt") + (:arguments (sockfd ffi:int) + (level ffi:int) + (optname ffi:int) + (optval ffi:c-pointer) + (optlen socklen_t)) + #+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-pf-unspec+ 0) + (defconstant +socket-sock-dgram+ 2) + (defconstant +sockopt-so-rcvtimeo+ #-linux #x1006 #+linux 20 "Socket receive timeout") + + (defun open-udp-socket (&key local-address local-port read-timeout) + "Open a unconnected UDP socket. For binding on address ANY(*), just not set LOCAL-ADDRESS (NIL), +for binding on random free unused port, set LOCAL-PORT to 0." + (let ((socket-fd (%socket +socket-af-inet+ +socket-sock-dgram+ +socket-pf-unspec+))) + (if socket-fd + (progn + ) + (error "cannot create socket")))) ) ; progn

1 0

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

30 Mar '11

Author: ctian Date: Wed Mar 30 01:41:42 2011 New Revision: 605 Log: [LispWorks] fixed HANDLE-CONDITION on win32, should be (wsa-get-last-error) instead of (lw:errno-value) 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 Wed Mar 30 01:41:42 2011 @@ -74,14 +74,15 @@ (defun handle-condition (condition &optional (socket nil)) "Dispatch correct usocket condition." (typecase condition - (condition (let ((errno (lispworks:errno-value))) + (condition (let ((errno #-win32 (lw:errno-value) + #+win32 (wsa-get-last-error))) (raise-usock-err errno socket condition))))) (defconstant *socket_sock_dgram* 2 "Connectionless, unreliable datagrams of fixed maximum length.") (defconstant *sockopt_so_rcvtimeo* - #+(not linux) #x1006 + #-linux #x1006 #+linux 20 "Socket receive timeout")

1 0

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

29 Mar '11

Author: ctian Date: Tue Mar 29 13:04:30 2011 New Revision: 604 Log: [CLISP] Fixed SOCKET-CONNECT / UDP for RAWSOCK; Basic FFI framework. 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 Tue Mar 29 13:04:30 2011 @@ -5,9 +5,15 @@ (in-package :usocket) +(eval-when (:compile-toplevel :load-toplevel :execute) + #-ffi + (warn "This image doesn't contain FFI package, GET-HOST-NAME won't work.") + #-(or ffi rawsock) + (warn "This image doesn't contain either FFI or RAWSOCK package, no UDP support.")) + ;; utility routine for looking up the current host name #+ffi -(FFI:DEF-CALL-OUT get-host-name-internal +(ffi:def-call-out get-host-name-internal (:name "gethostname") (:arguments (name (FFI:C-PTR (FFI:C-ARRAY-MAX ffi:character 256)) :OUT :ALLOCA) @@ -61,26 +67,36 @@ timeout deadline (nodelay t nodelay-specified) local-host local-port) (declare (ignore nodelay)) - (when timeout (unsupported 'timeout 'socket-connect)) (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)) - - (let ((socket) - (hostname (host-to-hostname host))) - (with-mapped-conditions (socket) - (setf socket - (if timeout - (socket:socket-connect port hostname - :element-type element-type - :buffered t - :timeout timeout) - (socket:socket-connect port hostname - :element-type element-type - :buffered t)))) - (make-stream-socket :socket socket - :stream socket))) ;; the socket is a stream too + (case protocol + (:stream + (let ((socket) + (hostname (host-to-hostname host))) + (with-mapped-conditions (socket) + (setf socket + (if timeout + (socket:socket-connect port hostname + :element-type element-type + :buffered t + :timeout timeout) + (socket:socket-connect port hostname + :element-type element-type + :buffered t)))) + (make-stream-socket :socket socket + :stream socket))) ;; the socket is a stream too + (:datagram + #+rawsock + (socket-create-datagram (or local-port *auto-port*) + :local-host (or local-host *wildcard-host*) + :remote-host host + :remote-port port) + #+(and ffi (not rawsock)) + () + #-(or rawsock ffi) + (unsupported '(protocol :datagram) 'socket-connect)))) (defun socket-listen (host port &key reuseaddress @@ -146,7 +162,6 @@ (defmethod get-peer-port ((usocket stream-usocket)) (nth-value 1 (get-peer-name usocket))) - (defun %setup-wait-list (wait-list) (declare (ignore wait-list))) @@ -176,14 +191,12 @@ (setf (state x) :READ))) wait-list)))) - -;; -;; UDP/Datagram sockets! -;; +;;; +;;; UDP/Datagram sockets (RAWSOCK version) +;;; #+rawsock (progn - (defun make-sockaddr_in () (make-array 16 :element-type '(unsigned-byte 8) :initial-element 0)) @@ -209,7 +222,7 @@ (connect sock rsock_addr)) (make-datagram-socket sock :connected-p (if rsock_addr t nil)))) - (defun socket-receive (socket buffer &key (size (length buffer))) + (defun socket-receive (socket 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)) @@ -218,44 +231,74 @@ (rv (if sockaddr (rawsock:recvfrom sock buffer sockaddr :start 0 - :end size) + :end length) (rawsock:recv sock buffer :start 0 - :end size)))) + :end length)))) (values buffer rv - (list (ip-from-octet-buffer (sockaddr-data sockaddr) 4) - (port-from-octet-buffer (sockaddr-data sockaddr) 2))))) + (ip-from-octet-buffer (sockaddr-data sockaddr) 4) + (port-from-octet-buffer (sockaddr-data sockaddr) 2)))) - (defun socket-send (socket buffer &key address (size (length buffer))) + (defun socket-send (socket buffer length &key host port) "Returns the number of octets sent." (let* ((sock (socket socket)) - (sockaddr (when address + (sockaddr (when (and host port) (rawsock:make-sockaddr :INET (fill-sockaddr_in (make-sockaddr_in) - (host-byte-order - (second address)) - (first address))))) - (rv (if address + (host-byte-order host) + port)))) + (rv (if (and host port) (rawsock:sendto sock buffer sockaddr :start 0 - :end size) + :end length) (rawsock:send sock buffer :start 0 - :end size)))) + :end length)))) rv)) (defmethod socket-close ((usocket datagram-usocket)) (when (wait-list usocket) (remove-waiter (wait-list usocket) usocket)) (rawsock:sock-close (socket usocket))) - - ) +) ; progn + +;;; +;;; UDP/Datagram sockets (FFI version) +;;; -#-rawsock +#+(and ffi (not rawsock)) (progn - (warn "This image doesn't contain the RAWSOCK package. -To enable UDP socket support, please be sure to use the -Kfull parameter -at startup, or to enable RAWSOCK support during compilation.") - ) + (ffi:def-c-struct sockaddr + ) + + (ffi:def-c-struct sockaddr_in + ) + + (ffi:def-call-out %sendto (:name "sendto") + (:arguments (socket ffi:int) + (buffer (ffi:c-ptr ffi:uint8)) + (length ffi:int) + (flags ffi:int) + (address (ffi:c-ptr sockaddr)) + (address-len 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) :out) + (length ffi:int) + (flags ffi:int) + (address (ffi:c-ptr sockaddr) :out) + (address-len (ffi:c-ptr ffi:int) :out)) + #+win32 (:library "WS2_32") + #-win32 (:library :default) + (:language #-win32 :stdc + #+win32 :stdc-stdcall) + (:return-type ffi:int)) +) ; progn

1 0

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

29 Mar '11

Author: ctian Date: Tue Mar 29 09:32:14 2011 New Revision: 603 Log: Update ChangeLog Modified: usocket/branches/0.5.x/CHANGES Modified: usocket/branches/0.5.x/CHANGES ============================================================================== --- usocket/branches/0.5.x/CHANGES (original) +++ usocket/branches/0.5.x/CHANGES Tue Mar 29 09:32:14 2011 @@ -12,7 +12,9 @@ * Bugfix: SOCKET-CONNECT didn't set CONNECTED-P for datagram usockets on most backends. * Bugfix: [SBCL] Fixed SOCKET-SERVER (UDP) on SBCL due to a issue in SOCKET-CONNECT when HOST is NIL. * Bugfix: [SBCL] SOCKET-CONNECT's TIMEOUT argument now works as a "connection timeout". +* Bugfix: [CMUCL] Fixed SOCKET-SEND on unconnected usockets under Unicode version of CMUCL. * Enhancement: [LispWorks] Better network error type detection on LispWorks. +* Enhancement: SOCKET-SERVER return a second value to indicate the created underlying usocket object when running in new thread mode. This make server debugging work easier. [TODO]

1 0

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

29 Mar '11

Author: ctian Date: Tue Mar 29 09:31:40 2011 New Revision: 602 Log: SOCKET-SERVER return a second value to indicate the created underlying usocket object when running in new thread mode. This make server debugging work easier. Modified: usocket/branches/0.5.x/server.lisp Modified: usocket/branches/0.5.x/server.lisp ============================================================================== --- usocket/branches/0.5.x/server.lisp (original) +++ usocket/branches/0.5.x/server.lisp Tue Mar 29 09:31:40 2011 @@ -31,8 +31,8 @@ :timeout timeout :max-buffer-size max-buffer-size))))) (if in-new-thread - (spawn-thread "USOCKET Server" #'real-call) - (real-call))))) + (values (spawn-thread "USOCKET Server" #'real-call) socket) + (real-call))))) (defvar *remote-host*) (defvar *remote-port*)

1 0

[usocket-cvs] r601 - usocket/branches/0.5.x/test
by Chun Tian 29 Mar '11

29 Mar '11

Author: ctian Date: Tue Mar 29 09:29:33 2011 New Revision: 601 Log: Unit test: using random echo server port on test, this allow multiple tests running at the same time on different platforms. Modified: usocket/branches/0.5.x/test/test-datagram.lisp Modified: usocket/branches/0.5.x/test/test-datagram.lisp ============================================================================== --- usocket/branches/0.5.x/test/test-datagram.lisp (original) +++ usocket/branches/0.5.x/test/test-datagram.lisp Tue Mar 29 09:29:33 2011 @@ -3,10 +3,16 @@ (in-package :usocket-test) -(defvar *echo-server* - (usocket:socket-server "127.0.0.1" 10243 #'identity nil - :in-new-thread t - :protocol :datagram)) +(defvar *echo-server*) +(defvar *echo-server-port*) + +(eval-when (:load-toplevel :execute) + (multiple-value-bind (thread socket) + (usocket:socket-server "127.0.0.1" 0 #'identity nil + :in-new-thread t + :protocol :datagram) + (setq *echo-server* thread + *echo-server-port* (usocket:get-local-port socket)))) (defparameter *max-buffer-size* 32) @@ -22,13 +28,14 @@ ;;; UDP Send Test #1: connected socket (deftest udp-send.1 - (let ((s (usocket:socket-connect "127.0.0.1" 10243 :protocol :datagram))) + (let ((s (usocket:socket-connect "127.0.0.1" *echo-server-port* :protocol :datagram))) (clean-buffers) (replace *send-buffer* #(1 2 3 4 5)) (usocket:socket-send s *send-buffer* 5) (usocket:wait-for-input s :timeout 3) (multiple-value-bind (buffer size host port) (usocket:socket-receive s *receive-buffer* *max-buffer-size*) + (declare (ignore buffer size host port)) (reduce #'+ *receive-buffer* :start 0 :end 5))) 15) @@ -37,9 +44,10 @@ (let ((s (usocket:socket-connect nil nil :protocol :datagram))) (clean-buffers) (replace *send-buffer* #(1 2 3 4 5)) - (usocket:socket-send s *send-buffer* 5 :host "127.0.0.1" :port 10243) + (usocket:socket-send s *send-buffer* 5 :host "127.0.0.1" :port *echo-server-port*) (usocket:wait-for-input s :timeout 3) (multiple-value-bind (buffer size host port) (usocket:socket-receive s *receive-buffer* *max-buffer-size*) + (declare (ignore buffer size host port)) (reduce #'+ *receive-buffer* :start 0 :end 5))) 15)

1 0

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

29 Mar '11

Author: ctian Date: Tue Mar 29 09:28:30 2011 New Revision: 600 Log: [CCL] remove the useless OPENMCL-SOCKET:SOCKET-CONNECT call in SOCKET-CONNECT; set :input-timeout to TIMEOUT keyword argument. Modified: usocket/branches/0.5.x/backend/openmcl.lisp 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 Tue Mar 29 09:28:30 2011 @@ -97,7 +97,6 @@ :deadline deadline :nodelay nodelay :connect-timeout timeout))) - (openmcl-socket:socket-connect mcl-sock) (make-stream-socket :stream mcl-sock :socket mcl-sock))) (:datagram (let* ((mcl-sock @@ -105,6 +104,7 @@ :type :datagram :local-host (when local-host (host-to-hostname local-host)) :local-port local-port + :input-timeout timeout :format :binary)) (usocket (make-datagram-socket mcl-sock))) (when (and host port)

1 0

[usocket-cvs] r599 - in usocket/branches/0.5.x: . test
by Chun Tian 29 Mar '11

29 Mar '11

Author: ctian Date: Tue Mar 29 09:04:27 2011 New Revision: 599 Log: Add some Unit Tests for Datagram sockets Added: usocket/branches/0.5.x/test/test-datagram.lisp (contents, props changed) Modified: usocket/branches/0.5.x/test/test-condition.lisp usocket/branches/0.5.x/usocket-test.asd Modified: usocket/branches/0.5.x/test/test-condition.lisp ============================================================================== --- usocket/branches/0.5.x/test/test-condition.lisp (original) +++ usocket/branches/0.5.x/test/test-condition.lisp Tue Mar 29 09:04:27 2011 @@ -11,7 +11,7 @@ (deftest timeout-error.1 (with-caught-conditions (usocket:timeout-error nil) - (usocket:socket-connect "common-lisp.net" 81 :timeout 1) + (usocket:socket-connect "common-lisp.net" 81 :timeout 0) t) nil) Added: usocket/branches/0.5.x/test/test-datagram.lisp ============================================================================== --- (empty file) +++ usocket/branches/0.5.x/test/test-datagram.lisp Tue Mar 29 09:04:27 2011 @@ -0,0 +1,45 @@ +;;;; $Id$ +;;;; $URL$ + +(in-package :usocket-test) + +(defvar *echo-server* + (usocket:socket-server "127.0.0.1" 10243 #'identity nil + :in-new-thread t + :protocol :datagram)) + +(defparameter *max-buffer-size* 32) + +(defvar *send-buffer* + (make-array *max-buffer-size* :element-type '(unsigned-byte 8) :initial-element 0)) + +(defvar *receive-buffer* + (make-array *max-buffer-size* :element-type '(unsigned-byte 8) :initial-element 0)) + +(defun clean-buffers () + (fill *send-buffer* 0) + (fill *receive-buffer* 0)) + +;;; UDP Send Test #1: connected socket +(deftest udp-send.1 + (let ((s (usocket:socket-connect "127.0.0.1" 10243 :protocol :datagram))) + (clean-buffers) + (replace *send-buffer* #(1 2 3 4 5)) + (usocket:socket-send s *send-buffer* 5) + (usocket:wait-for-input s :timeout 3) + (multiple-value-bind (buffer size host port) + (usocket:socket-receive s *receive-buffer* *max-buffer-size*) + (reduce #'+ *receive-buffer* :start 0 :end 5))) + 15) + +;;; UDP Send Test #2: unconnected socket +(deftest udp-send.2 + (let ((s (usocket:socket-connect nil nil :protocol :datagram))) + (clean-buffers) + (replace *send-buffer* #(1 2 3 4 5)) + (usocket:socket-send s *send-buffer* 5 :host "127.0.0.1" :port 10243) + (usocket:wait-for-input s :timeout 3) + (multiple-value-bind (buffer size host port) + (usocket:socket-receive s *receive-buffer* *max-buffer-size*) + (reduce #'+ *receive-buffer* :start 0 :end 5))) + 15) Modified: usocket/branches/0.5.x/usocket-test.asd ============================================================================== --- usocket/branches/0.5.x/usocket-test.asd (original) +++ usocket/branches/0.5.x/usocket-test.asd Tue Mar 29 09:04:27 2011 @@ -21,11 +21,11 @@ :depends-on (:usocket :rt) :components ((:module "test" + :serial t :components ((:file "package") - (:file "test-usocket" - :depends-on ("package")) - (:file "test-condition" - :depends-on ("test-usocket")))))) + (:file "test-usocket") + (:file "test-condition") + (:file "test-datagram"))))) (defmethod perform ((op test-op) (c (eql (find-system :usocket-test)))) (funcall (intern "DO-TESTS" "USOCKET-TEST")))

1 0