[usocket-devel] [usocket-cvs] r604 - usocket/branches/0.5.x/backend

Erik Huelsmann ehuels at gmail.com
Tue Mar 29 19:50:44 UTC 2011


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