Commit 485cb287 authored by ctian's avatar ctian
Browse files

Clean UDP code (remove less used RTT stuff: SOCKET-SYNC)

parent e9673d79
......@@ -225,42 +225,6 @@ error available."))
(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"))
......@@ -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)
......
;;;; $Id$
;;;; $URL$
(in-package :usocket)
(defun default-rtt-function (message) (values message 0))
(defmethod socket-sync ((socket datagram-usocket) message &key host port
(max-receive-length +max-datagram-packet-size+)
(encode-function #'default-rtt-function)
(decode-function #'default-rtt-function))
(rtt-newpack socket)
(multiple-value-bind (data send-seq) (funcall encode-function message)
(let ((data-length (length data)))
(loop
with send-ts = (rtt-ts socket)
and recv-message = nil
and recv-seq = -1
and continue-p = t
do (progn
(socket-send socket data data-length :host host :port port)
(multiple-value-bind (sockets real-time)
(wait-for-input socket :timeout (rtt-start socket))
(declare (ignore sockets))
(if real-time
;; message received
(loop
do (multiple-value-setq (recv-message recv-seq)
(funcall decode-function
(socket-receive socket nil max-receive-length)))
until (or (= recv-seq send-seq)
(warn 'rtt-seq-mismatch-warning
:socket socket
:send-seq send-seq
:recv-seq recv-seq))
finally (let ((recv-ts (rtt-ts socket)))
(rtt-stop socket (- recv-ts send-ts))
(return nil)))
;; message not received
(let ((old-rto (slot-value socket 'rto)))
(setf continue-p (rtt-timeout socket))
(warn 'rtt-timeout-warning
:socket socket
:old-rto old-rto
:new-rto (slot-value socket 'rto))
(unless continue-p
(rtt-init socket)
(error 'rtt-timeout-error))))))
until (or recv-message (not continue-p))
finally (return recv-message)))))
;;;; $Id$
;;;; $URL$
;;;; UDP retransmit support by Chun Tian (binghe)
;;;; See the LICENSE file for licensing information.
(in-package :usocket)
;;; UNIX Network Programming v1 - Networking APIs: Sockets and XTI
;;; Chapter 20: Advance UDP Sockets
;;; Adding Reliability to a UDP Application
(defclass rtt-info-mixin ()
((rtt :type short-float
:documentation "most recent measured RTT, seconds")
(srtt :type short-float
:documentation "smoothed RTT estimator, seconds")
(rttvar :type short-float
:documentation "smoothed mean deviation, seconds")
(rto :type short-float
:documentation "current RTO to use, seconds")
(nrexmt :type fixnum
:documentation "#times retransmitted: 0, 1, 2, ...")
(base :type integer
:documentation "#sec since 1/1/1970 at start, but we use Lisp time here"))
(:documentation "RTT Info Class"))
(defvar *rtt-rxtmin* 2.0s0 "min retransmit timeout value, seconds")
(defvar *rtt-rxtmax* 60.0s0 "max retransmit timeout value, seconds")
(defvar *rtt-maxnrexmt* 3 "max #times to retransmit")
(defmethod rtt-rtocalc ((instance rtt-info-mixin))
"Calculate the RTO value based on current estimators:
smoothed RTT plus four times the deviation."
(with-slots (srtt rttvar) instance
(+ srtt (* 4.0s0 rttvar))))
(defun rtt-minmax (rto)
"rtt-minmax makes certain that the RTO is between the upper and lower limits."
(declare (type short-float rto))
(cond ((< rto *rtt-rxtmin*) *rtt-rxtmin*)
((> rto *rtt-rxtmax*) *rtt-rxtmax*)
(t rto)))
(defmethod initialize-instance :after ((instance rtt-info-mixin) &rest initargs
&key &allow-other-keys)
(declare (ignore initargs))
(rtt-init instance))
(defmethod rtt-init ((instance rtt-info-mixin))
(with-slots (base rtt srtt rttvar rto) instance
(setf base (get-internal-real-time)
rtt 0.0s0
srtt 0.0s0
rttvar 0.75s0
rto (rtt-minmax (rtt-rtocalc instance)))))
(defmethod rtt-ts ((instance rtt-info-mixin))
(* (- (get-internal-real-time) (slot-value instance 'base))
#.(/ 1000 internal-time-units-per-second)))
(defmethod rtt-start ((instance rtt-info-mixin))
"return value can be used as: alarm(rtt_start(&foo))"
(round (slot-value instance 'rto)))
(defmethod rtt-stop ((instance rtt-info-mixin) (ms number))
(with-slots (rtt srtt rttvar rto) instance
(setf rtt (/ ms 1000.0s0))
(let ((delta (- rtt srtt)))
(incf srtt (/ delta 8.0s0))
(incf rttvar (/ (- (abs delta) rttvar) 4.0)))
(setf rto (rtt-minmax (rtt-rtocalc instance)))))
(defmethod rtt-timeout ((instance rtt-info-mixin))
(with-slots (rto nrexmt) instance
(setf rto (* rto 2.0s0))
(< (incf nrexmt) *rtt-maxnrexmt*)))
(defmethod rtt-newpack ((instance rtt-info-mixin))
(setf (slot-value instance 'nrexmt) 0))
......@@ -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"))))
......@@ -84,7 +84,7 @@ with the `socket-close' method or by closing the associated stream
(: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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment