Hi, Erik
Thank you. And this is my plan:
I've fixed lots of bugs since 0.5.0, and I want to release 0.5.1 once the CLISP / FFI work is done.
And once 0.5.1 is out, I'll backport all changes on branch 0.5.x to trunk and start working on SOCKET-OPTION API on trunk, and once it's done again, consider this is new added API, I want to release 0.6.0, but the exact release date is unknown at this time.
--binghe
在 2011-3-30，03:50， Erik Huelsmann 写道：
Hi Chun,
Nice work (and great activity!).
Just a remark from personal experience: Don't forget to backport to trunk when you're working directly on the branch.
Bye,
Erik.
On Tue, Mar 29, 2011 at 7:04 PM, Chun Tian ctian@common-lisp.net wrote:
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
usocket-cvs mailing list usocket-cvs@common-lisp.net http://common-lisp.net/cgi-bin/mailman/listinfo/usocket-cvs