From ctian at common-lisp.net Fri Dec 11 13:36:09 2009 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Fri, 11 Dec 2009 08:36:09 -0500 Subject: [usocket-cvs] r501 - in usocket/branches/experimental-udp: . backend Message-ID: Author: ctian Date: Fri Dec 11 08:36:08 2009 New Revision: 501 Log: Update ignore patterns Modified: usocket/branches/experimental-udp/ (props changed) usocket/branches/experimental-udp/backend/ (props changed) From ctian at common-lisp.net Fri Dec 11 13:37:33 2009 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Fri, 11 Dec 2009 08:37:33 -0500 Subject: [usocket-cvs] r502 - usocket/branches/experimental-udp Message-ID: Author: ctian Date: Fri Dec 11 08:37:33 2009 New Revision: 502 Log: Clean UDP code (remove less used RTT stuff: SOCKET-SYNC) Removed: usocket/branches/experimental-udp/rtt-client.lisp usocket/branches/experimental-udp/rtt.lisp Modified: usocket/branches/experimental-udp/condition.lisp usocket/branches/experimental-udp/package.lisp usocket/branches/experimental-udp/usocket.asd usocket/branches/experimental-udp/usocket.lisp Modified: usocket/branches/experimental-udp/condition.lisp ============================================================================== --- usocket/branches/experimental-udp/condition.lisp (original) +++ usocket/branches/experimental-udp/condition.lisp Fri Dec 11 08:37:33 2009 @@ -225,42 +225,6 @@ (defmacro unimplemented (feature context) `(signal 'unimplemented :feature ,feature :context ,context)) -;;; binghe: socket-warning for UDP retransmit support - (define-condition socket-warning (socket-condition warning) () ;; no slots (yet) (:documentation "Parent warning for all socket related warnings")) - -(define-condition rtt-timeout-warning (socket-warning) - ((old-rto :type short-float - :reader old-rto-of - :initarg :old-rto) - (new-rto :type short-float - :reader new-rto-of - :initarg :new-rto)) - (:report (lambda (condition stream) - (format stream "Receive timeout (~As), next: ~As.~%" - (old-rto-of condition) - (new-rto-of condition)))) - (:documentation "RTT timeout warning")) - -(define-condition rtt-seq-mismatch-warning (socket-warning) - ((send-seq :type integer - :reader send-seq-of - :initarg :send-seq) - (recv-seq :type integer - :reader recv-seq-of - :initarg :recv-seq)) - (:report (lambda (condition stream) - (format stream "Sequence number mismatch (~A -> ~A), try read again.~%" - (send-seq-of condition) - (recv-seq-of condition)))) - (:documentation "RTT sequence mismatch warning")) - -(define-condition rtt-timeout-error (socket-error) - () - (:report (lambda (condition stream) - (declare (ignore condition)) - (format stream "Max retransmit times (~A) reached, give up.~%" - *rtt-maxnrexmt*))) - (:documentation "RTT timeout error")) Modified: usocket/branches/experimental-udp/package.lisp ============================================================================== --- usocket/branches/experimental-udp/package.lisp (original) +++ usocket/branches/experimental-udp/package.lisp Fri Dec 11 08:37:33 2009 @@ -30,7 +30,6 @@ #:socket-send ; udp function (send) #:socket-receive ; udp function (receive) - #:socket-sync ; udp client (high-level) #:socket-server ; udp server #:wait-for-input ; waiting for input-ready state (select() like) Modified: usocket/branches/experimental-udp/usocket.asd ============================================================================== --- usocket/branches/experimental-udp/usocket.asd (original) +++ usocket/branches/experimental-udp/usocket.asd Fri Dec 11 08:37:33 2009 @@ -20,12 +20,8 @@ :depends-on (:split-sequence #+sbcl :sb-bsd-sockets) :components ((:file "package") - (:file "rtt" - :depends-on ("package")) - (:file "usocket" - :depends-on ("package" "rtt")) - (:file "condition" - :depends-on ("usocket" "rtt")) + (:file "usocket" :depends-on ("package")) + (:file "condition" :depends-on ("usocket")) (:module "backend" :components (#+clisp (:file "clisp") #+cmu (:file "cmucl") @@ -36,7 +32,5 @@ #+allegro (:file "allegro") #+armedbear (:file "armedbear")) :depends-on ("condition")) - (:file "rtt-client" - :depends-on ("rtt" "backend" "condition")) (:file "server" :depends-on ("backend")))) Modified: usocket/branches/experimental-udp/usocket.lisp ============================================================================== --- usocket/branches/experimental-udp/usocket.lisp (original) +++ usocket/branches/experimental-udp/usocket.lisp Fri Dec 11 08:37:33 2009 @@ -84,7 +84,7 @@ (:documentation "Socket which listens for stream connections to be initiated from remote sockets.")) -(defclass datagram-usocket (usocket rtt-info-mixin) +(defclass datagram-usocket (usocket) ((connected-p :type boolean :accessor connected-p :initarg :connected-p) From ctian at common-lisp.net Sat Dec 12 21:57:41 2009 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Sat, 12 Dec 2009 16:57:41 -0500 Subject: [usocket-cvs] r503 - usocket/branches/experimental-udp/backend Message-ID: Author: ctian Date: Sat Dec 12 16:57:40 2009 New Revision: 503 Log: Buggy UDP support for ABCL (only socket-connect works now) Modified: usocket/branches/experimental-udp/backend/armedbear.lisp Modified: usocket/branches/experimental-udp/backend/armedbear.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/armedbear.lisp (original) +++ usocket/branches/experimental-udp/backend/armedbear.lisp Sat Dec 12 16:57:40 2009 @@ -6,7 +6,7 @@ (in-package :usocket) -;;;;; Proposed contribution to the JAVA package +;;; Proposed contribution to the JAVA package (defpackage :jdi (:use :cl) @@ -186,24 +186,36 @@ (typecase condition (error (error 'unknown-error :socket socket :real-error condition)))) -(defun socket-connect (host port &key (element-type 'character) +(defun socket-connect (host port &key (protocol :stream) (element-type 'character) timeout deadline (nodelay nil nodelay-specified) local-host local-port) (when deadline (unsupported 'deadline 'socket-connect)) - (when local-host (unimplemented 'local-host 'socket-connect)) - (when local-port (unimplemented 'local-port 'socket-connect)) (let ((usock)) (with-mapped-conditions (usock) - (let* ((sock-addr (jdi:jcoerce - (jdi:do-jnew-call "java.net.InetSocketAddress" - (host-to-hostname host) - (jdi:jcoerce port :int)) - "java.net.SocketAddress")) - (jchan (jdi:do-jstatic-call "java.nio.channels.SocketChannel" - "open" sock-addr)) + (let* ((sock-addr (when (and host port) + (jdi:jcoerce + (jdi:do-jnew-call "java.net.InetSocketAddress" + (host-to-hostname host) + (jdi:jcoerce port :int)) + "java.net.SocketAddress"))) + (local-addr (when (or local-host local-port) + (jdi:jcoerce + (jdi:do-jnew-call "java.net.InetSocketAddress" + (host-to-hostname (or host *wildcard-host*)) + (jdi:jcoerce (or port *auto-port*) :int)) + "java.net.SocketAddress"))) + (jchan (jdi:do-jstatic-call (ecase protocol + (:stream "java.nio.channels.SocketChannel") + (:datagram "java.nio.channels.DatagramChannel")) + "open")) (sock (jdi:do-jmethod-call jchan "socket"))) - (when nodelay-specified + ;; TODO: Fix it + (when (or local-host local-port) + (jdi:do-jmethod-call sock "bind" local-addr)) + (when (and host port) + (jdi:do-jmethod-call jchan "connect" sock-addr)) + (when (and (eq protocol 'stream) nodelay-specified) (jdi:do-jmethod-call sock "setTcpNoDelay" (if nodelay (java:make-immediate-object t :boolean) @@ -212,10 +224,14 @@ (jdi:do-jmethod-call sock "setSoTimeout" (truncate (* 1000 timeout)))) (setf usock - (make-stream-socket - :socket jchan - :stream (ext:get-socket-stream (jdi:jop-deref sock) - :element-type element-type))))))) + (ecase protocol + (:stream + (make-stream-socket + :socket jchan + :stream (ext:get-socket-stream (jdi:jop-deref sock) + :element-type element-type))) + (:datagram + (make-datagram-socket jchan)))))))) (defun socket-listen (host port &key reuseaddress @@ -447,4 +463,29 @@ w)) (defun %remove-waiter (wl w) - (remhash (socket w) (wait-list-%wait wl))) \ No newline at end of file + (remhash (socket w) (wait-list-%wait wl))) + +;; +;; UDP support +;; + +(defmethod socket-send ((socket datagram-usocket) buffer length &key host port) + (let ((jchan (socket socket))) + (let ((srcs (jdi:jcoerce buffer "java.nio.ByteBuffer")) + (offset (jdi:jcoerce 0 :int)) + (length (jdi:jcoerce length :int))) + (if (and host port) + (let ((target (jdi:jcoerce + (jdi:do-jnew-call "java.net.InetSocketAddress" + (host-to-hostname host) + (jdi:jcoerce port :int)) + "java.net.SocketAddress"))) + ;; how to use "length" argument here? --binghe, 2009/12/12 + (jdi:do-jmethod-call jchan "send" buffer target)) + (jdi:do-jmethod-call jchan "write" srcs offset length))))) + +(defmethod socket-receive ((socket datagram-usocket) buffer length) + (let ((jchan (socket socket))) + (multiple-value-bind (buffer size host port) + 0 + (values buffer size host port)))) From ctian at common-lisp.net Thu Dec 31 11:36:58 2009 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Thu, 31 Dec 2009 06:36:58 -0500 Subject: [usocket-cvs] r504 - usocket/trunk/backend Message-ID: Author: ctian Date: Thu Dec 31 06:36:56 2009 New Revision: 504 Log: Fix build on ECL/msvc, found by Seth Burleigh. However, due to no "select()" on win32, WAIT-FOT-INPUT not working on ECL/win32, need more work here. Modified: usocket/trunk/backend/sbcl.lisp Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Thu Dec 31 06:36:56 2009 @@ -50,7 +50,8 @@ "#include ") (ffi:clines - "#include " + #+:msvc "#include " + #-:msvc "#include " "#include ") #+:prefixed-api