[usocket-cvs] r432 - in usocket/branches/experimental-udp: . backend
Chun Tian (binghe)
ctian at common-lisp.net
Mon Oct 20 07:33:51 UTC 2008
Author: ctian
Date: Mon Oct 20 07:33:49 2008
New Revision: 432
Log:
[udp] add SCL support, untested.
Modified:
usocket/branches/experimental-udp/backend/cmucl.lisp
usocket/branches/experimental-udp/backend/scl.lisp
usocket/branches/experimental-udp/rtt-client.lisp
usocket/branches/experimental-udp/usocket.lisp
Modified: usocket/branches/experimental-udp/backend/cmucl.lisp
==============================================================================
--- usocket/branches/experimental-udp/backend/cmucl.lisp (original)
+++ usocket/branches/experimental-udp/backend/cmucl.lisp Mon Oct 20 07:33:49 2008
@@ -80,21 +80,24 @@
(let ((err (unix:unix-errno)))
(when err (cmucl-map-socket-error err)))))
(:datagram
- (if (and host port)
- (setf socket (with-mapped-conditions (socket)
- (ext:connect-to-inet-socket (host-to-hbo host) port :datagram
- :local-host (host-to-hbo local-host)
- :local-port local-port)))
- (progn
- (setf socket (with-mapped-conditions (socket)
- (ext:create-inet-socket :datagram)))
- (when (and local-host local-port)
- (with-mapped-conditions (socket)
- (ext:bind-inet-socket socket local-host local-port)))))
- (let ((usocket (make-datagram-socket socket)))
- (ext:finalize usocket #'(lambda () (when (%open-p usocket)
- (ext:close-socket socket))))
- usocket)))))
+ (setf socket
+ (if (and host port)
+ (with-mapped-conditions (socket)
+ (ext:connect-to-inet-socket (host-to-hbo host) port :datagram
+ :local-host (host-to-hbo local-host)
+ :local-port local-port))
+ (if (or local-host local-port)
+ (with-mapped-conditions (socket)
+ (ext:create-inet-listener (or local-port 0) :datagram :host local-host))
+ (with-mapped-conditoins (socket)
+ (ext:create-inet-socket :datagram)))))
+ (if socket
+ (let ((usocket (make-datagram-socket socket)))
+ (ext:finalize usocket #'(lambda () (when (%open-p usocket)
+ (ext:close-socket socket))))
+ usocket)
+ (let ((err (unix:unix-errno)))
+ (when err (cmucl-map-socket-error err))))))))
(defun socket-listen (host port
&key reuseaddress
Modified: usocket/branches/experimental-udp/backend/scl.lisp
==============================================================================
--- usocket/branches/experimental-udp/backend/scl.lisp (original)
+++ usocket/branches/experimental-udp/backend/scl.lisp Mon Oct 20 07:33:49 2008
@@ -28,7 +28,7 @@
:socket socket
:condition condition))))
-(defun socket-connect (host port &key (element-type 'character)
+(defun socket-connect (host port &key (protocol :stream) (element-type 'character)
timeout deadline (nodelay t nodelay-specified)
local-host local-port)
(declare (ignore nodelay))
@@ -39,13 +39,41 @@
(unsupported 'local-host 'socket-connect)
(unsupported 'local-port 'socket-connect))
- (let* ((socket (with-mapped-conditions ()
- (ext:connect-to-inet-socket (host-to-hbo host) port
- :kind :stream)))
- (stream (sys:make-fd-stream socket :input t :output t
- :element-type element-type
- :buffering :full)))
- (make-stream-socket :socket socket :stream stream)))
+ (let ((socket))
+ (ecase protocol
+ (:stream
+ (setf socket (with-mapped-conditions ()
+ (ext:connect-to-inet-socket (host-to-hbo host) port
+ :kind :stream
+ #+ignore #+ignore
+ #+ignore #+ignore
+ :local-host (if local-host
+ (host-to-hbo local-host))
+ :local-port local-port)))
+ (let ((stream (sys:make-fd-stream socket :input t :output t
+ :element-type element-type
+ :buffering :full)))
+ (make-stream-socket :socket socket :stream stream)))
+ (:datagram
+ (setf socket
+ (if (and host port)
+ (with-mapped-conditions ()
+ (ext:connect-to-inet-socket (host-to-hbo host) port
+ :kind :datagram
+ :local-host (host-to-hbo local-host)
+ :local-port local-port))
+ (if (or local-port local-port)
+ (with-mapped-conditions ()
+ (ext:create-inet-listener (or local-port 0)
+ :datagram
+ :host local-host))
+ (with-mapped-conditions ()
+ (ext:create-inet-socket :datagram)))))
+ (let ((usocket (make-datagram-socket socket)))
+ (ext:finalize usocket #'(lambda ()
+ (when (%open-p usocket)
+ (ext:close-socket socket))))
+ usocket)))))
(defun socket-listen (host port
&key reuseaddress
@@ -91,6 +119,33 @@
(with-mapped-conditions (usocket)
(close (socket-stream usocket))))
+(defmethod socket-close :after ((socket datagram-usocket))
+ (setf (%open-p socket) nil))
+
+(defmethod socket-send ((socket datagram-usocket) buffer length &key address port)
+ (let ((s (socket socket))
+ (address (if address (host-to-hbo address))))
+ (multiple-value-bind (result errno)
+ (ext:inet-socket-send-to s buffer length
+ :remote-host address :remote-port port)
+ (unless result
+ (error "~@<Error sending on socket ~D: ~A~@:>" s
+ (unix:get-unix-error-msg errno)))
+ result)))
+
+(defmethod socket-receive ((socket datagram-usocket) buffer length)
+ (let ((s (socket socket)))
+ (let ((real-buffer (or buffer
+ (make-array length :element-type '(unsigned-byte 8))))
+ (real-length (or length
+ (length buffer))))
+ (multiple-value-bind (result errno remote-host remote-port)
+ (ext:inet-socket-receive-from s real-buffer real-length)
+ (unless result
+ (error "~@<Error receiving on socket ~D: ~A~@:>" s
+ (unix:get-unix-error-msg errno)))
+ (values real-buffer result remote-host remote-port)))))
+
(defmethod get-local-name ((usocket usocket))
(multiple-value-bind (address port)
(with-mapped-conditions (usocket)
Modified: usocket/branches/experimental-udp/rtt-client.lisp
==============================================================================
--- usocket/branches/experimental-udp/rtt-client.lisp (original)
+++ usocket/branches/experimental-udp/rtt-client.lisp Mon Oct 20 07:33:49 2008
@@ -44,7 +44,7 @@
:old-rto old-rto
:new-rto (slot-value socket 'rto))
(unless continue-p
- (error 'rtt-timeout-error)
- (rtt-init socket))))))
+ (rtt-init socket)
+ (error 'rtt-timeout-error))))))
until (or recv-message (not continue-p))
finally (return recv-message)))))
Modified: usocket/branches/experimental-udp/usocket.lisp
==============================================================================
--- usocket/branches/experimental-udp/usocket.lisp (original)
+++ usocket/branches/experimental-udp/usocket.lisp Mon Oct 20 07:33:49 2008
@@ -88,12 +88,12 @@
((connected-p :type boolean
:accessor connected-p
:initarg :connected-p)
- #+(or cmu lispworks)
+ #+(or cmu scl lispworks)
(%open-p :type boolean
:accessor %open-p
:initform t
:documentation "Flag to indicate if usocket is open,
-for GC on LispWorks/CMUCL"))
+for GC on implementions operate on raw socket fd."))
(:documentation "UDP (inet-datagram) socket"))
(defun usocket-p (socket)
More information about the usocket-cvs
mailing list