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)