Merge branch 'master' of git://github.com/mirage/mirage-net

direct/lib/tcp/segment.ml

@@ -142,8 +142,24 @@ module Rx = struct
       (* If the segment has an ACK, tell the transmit side *)
       let tx_ack =
         if seg.ack then begin
-	  tick q.state (Recv_ack seg.ack_number);
-          Lwt_mvar.put q.tx_ack (seg.ack_number, (window ready))
+          tick q.state (Recv_ack seg.ack_number);
+          let win = window ready in
+          let data_in_flight = Window.tx_inflight q.wnd in
+          let seq_has_changed = (Window.ack_seq q.wnd) <> seg.ack_number in
+          let win_has_changed = (Window.ack_win q.wnd) <> win in
+          if ((data_in_flight && (Window.ack_serviced q.wnd || not seq_has_changed)) ||
+              (not data_in_flight && win_has_changed)) then begin
+            Lwt_mvar.put q.tx_ack (seg.ack_number, win) >>
+            (Window.set_ack_serviced q.wnd false;
+             Window.set_ack_seq q.wnd seg.ack_number;
+             Window.set_ack_win q.wnd win;
+             return ())
+          end else begin
+             if (Sequence.gt seg.ack_number (Window.ack_seq q.wnd)) then
+               Window.set_ack_seq q.wnd seg.ack_number;
+             Window.set_ack_win q.wnd win;
+            return ()
+          end
         end else
           return () in
 
@@ -308,6 +324,9 @@ module Tx = struct
             q.dup_acks <- 0
       in
       lwt (seq, win) = Lwt_mvar.take tx_ack in
+      Window.set_ack_serviced q.wnd true;
+      let seq = Window.ack_seq q.wnd in
+      let win = Window.ack_win q.wnd in
       let ack_len = Sequence.sub seq (Window.tx_una q.wnd) in
       let dupacktest () = ((0l = (Sequence.to_int32 ack_len)) &&
                            ((Window.tx_wnd_unscaled q.wnd) = (Int32.of_int win)) &&

direct/lib/tcp/window.ml

@@ -24,6 +24,11 @@ type t = {
   max_rx_wnd: int32;               (* Max RX Window size after scaling *)
   tx_wnd_scale: int;               (* TX Window scaling option     *)
   rx_wnd_scale: int;               (* RX Window scaling option     *)
+
+  mutable ack_serviced: bool;
+  mutable ack_seq: Sequence.t;
+  mutable ack_win: int;
+
   mutable snd_una: Sequence.t;
   mutable tx_nxt: Sequence.t;
   mutable rx_nxt: Sequence.t;
@@ -72,6 +77,9 @@ let t ~rx_wnd_scale ~tx_wnd_scale ~rx_wnd ~tx_wnd ~rx_isn ~tx_mss ~tx_isn =
   let tx_mss = match tx_mss with |None -> default_mss |Some mss -> min mss max_mss in
   let snd_una = tx_nxt in
   let fast_rec_th = tx_nxt in
+  let ack_serviced = true in
+  let ack_seq = tx_nxt in
+  let ack_win = rx_wnd in
   let rx_wnd = Int32.(shift_left (of_int rx_wnd) rx_wnd_scale) in
   let max_rx_wnd = rx_wnd in
   let tx_wnd = Int32.(shift_left (of_int tx_wnd) tx_wnd_scale) in
@@ -88,7 +96,9 @@ let t ~rx_wnd_scale ~tx_wnd_scale ~rx_wnd ~tx_wnd ~rx_isn ~tx_mss ~tx_isn =
   let rttvar = 0.0 in
   let rto = 3.0 in
   let backoff_count = 0 in
-  { tx_isn; rx_isn; max_rx_wnd; snd_una; tx_nxt; tx_wnd; rx_nxt; rx_nxt_inseq;
+  { tx_isn; rx_isn; max_rx_wnd; 
+    ack_serviced; ack_seq; ack_win;
+    snd_una; tx_nxt; tx_wnd; rx_nxt; rx_nxt_inseq;
     fast_rec_th; rx_wnd; tx_wnd_scale; rx_wnd_scale;
     ssthresh; cwnd; tx_mss; fast_recovery;
     rtt_timer_on; rtt_timer_reset;
@@ -119,6 +129,14 @@ let rx_nxt_inseq t = t.rx_nxt_inseq
 let rx_wnd t = t.rx_wnd
 let rx_wnd_unscaled t = Int32.shift_right t.rx_wnd t.rx_wnd_scale
 
+let ack_serviced t = t.ack_serviced
+let ack_seq t = t.ack_seq
+let ack_win t = t.ack_win
+
+let set_ack_serviced t v = t.ack_serviced <- v
+let set_ack_seq t s = t.ack_seq <- s
+let set_ack_win t w = t.ack_win <- w
+
 (* TODO: scale the window down so we can advertise it correctly with
    window scaling on the wire *)
 let set_rx_wnd t sz =

direct/lib/tcp/window.mli

@@ -34,6 +34,14 @@ val tx_una : t -> Sequence.t
 val tx_mss : t -> int
 val fast_rec : t -> bool
 
+val ack_serviced : t -> bool
+val ack_seq : t -> Sequence.t
+val ack_win : t -> int
+
+val set_ack_serviced : t -> bool -> unit
+val set_ack_seq : t -> Sequence.t -> unit
+val set_ack_win : t -> int -> unit
+
 (* rx_wnd: number of bytes we are willing to accept *)
 val rx_wnd : t -> int32
 val rx_wnd_unscaled : t -> int32