[usocket-devel] [usocket-cvs] r604 - usocket/branches/0.5.x/backend
Chun Tian (binghe)
binghe.lisp at gmail.com
Wed Mar 30 02:15:19 UTC 2011
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 at 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 at common-lisp.net
>> http://common-lisp.net/cgi-bin/mailman/listinfo/usocket-cvs
>>
More information about the usocket-devel
mailing list