mte/unikernel/duniverse/mirage-tcpip/test/mock-clock/test_tcp_window.ml
2025-11-11 02:07:51 +01:00

126 lines
5.5 KiB
OCaml

let default_window () =
Tcp.Window.t ~tx_wnd_scale:2 ~rx_wnd_scale:2 ~rx_wnd:65535 ~tx_wnd:65535 ~rx_isn:Tcp.Sequence.zero ~tx_mss:1460 ~tx_isn:Tcp.Sequence.zero
let fresh_window () =
let window = default_window () in
Alcotest.(check bool) "should be no data in flight" false @@ Tcp.Window.tx_inflight window;
Alcotest.(check bool) "no rexmits yet" false @@ Tcp.Window.max_rexmits_done window;
Alcotest.(check int) "no traffic transferred yet" 0 @@ Tcp.Window.tx_totalbytes window;
Alcotest.(check int) "no traffic received yet" 0 @@ Tcp.Window.rx_totalbytes window;
Alcotest.(check int32) "should be able to send 65535 <<= 2 bytes" Int32.(mul 65535l 4l) @@ Tcp.Window.tx_wnd window;
Alcotest.(check int32) "should be able to receive 65535 <<= 2 bytes" Int32.(mul 65535l 4l) @@ Tcp.Window.rx_wnd window;
Alcotest.(check int64) "initial rto is 2/3 second" (Duration.of_ms 667) @@ Tcp.Window.rto window;
Lwt.return_unit
let increase_congestion_window window goal =
(* simulate a successful slow start, which primes the congestion window to be relatively large *)
let receive_window = Tcp.Window.ack_win window in
let rec successful_transmission goal =
let max_send = Tcp.Window.tx_available window |> Tcp.Sequence.of_int32 in
match Tcp.Sequence.geq max_send goal with
| true -> max_send
| false ->
let sz = Tcp.Sequence.add max_send @@ Tcp.Window.tx_nxt window in
Mirage_mtime_set.tick ();
Tcp.Window.tx_advance window @@ Tcp.Window.tx_nxt window;
Mirage_mtime_set.tick ();
(* need to acknowledge the full size of the data *)
Tcp.Window.tx_ack window sz receive_window;
successful_transmission goal
in
successful_transmission goal
let n_segments window n =
Int32.mul n @@ Int32.of_int @@ Tcp.Window.tx_mss window |> Tcp.Sequence.of_int32
(* attempt to ensure that fast recovery is working as described in rfc5681 *)
let recover_fast () =
let window = default_window () in
let receive_window = Tcp.Window.ack_win window in
Alcotest.(check bool) "don't start in fast recovery" false @@ Tcp.Window.fast_rec window;
(* get a large congestion window to avoid confounding factors *)
let cwnd_goal = 262140l in
let _ = increase_congestion_window window (Tcp.Sequence.of_int32 cwnd_goal) in
let available_to_send = Tcp.Window.tx_available window in
let big_enough x = Int32.compare x cwnd_goal > 0 in
Alcotest.(check bool) "congestion window is big enough" true @@ big_enough available_to_send;
(* get ready to send another burst of data *)
let seq = Tcp.Window.tx_nxt window in
Mirage_mtime_set.tick ();
(* say that we sent the full amount of data *)
let sz = Tcp.Sequence.(add (of_int32 available_to_send) seq) in
Tcp.Window.tx_advance window sz;
(* but receive an ack indicating that we missed a segment *)
let nonfull_ack = Tcp.Sequence.add seq @@ n_segments window 4l in
(* 1st ack *)
Mirage_mtime_set.tick ();
Tcp.Window.tx_ack window nonfull_ack receive_window;
(* 1st duplicate ack *)
Mirage_mtime_set.tick ();
Tcp.Window.tx_ack window nonfull_ack receive_window;
(* 2nd duplicate ack *)
Mirage_mtime_set.tick ();
Tcp.Window.tx_ack window nonfull_ack receive_window;
(* 3rd duplicate ack *)
Mirage_mtime_set.tick ();
Tcp.Window.tx_ack window nonfull_ack receive_window;
(* request that we go into fast retransmission *)
Tcp.Window.alert_fast_rexmit window @@ n_segments window 4l;
Alcotest.(check bool) "fast retransmit when we wanted it" true @@ Tcp.Window.fast_rec window;
Alcotest.(check bool) "once entering fast recovery, we can send >0 packets" true ((Int32.compare (Tcp.Window.tx_available window) 0l) > 0);
Lwt.return_unit
let rto_calculation () =
let window = default_window () in
(* RFC 2988 2.1 *)
Alcotest.(check int64) "initial rto is 2/3 second" (Duration.of_ms 667) @@ Tcp.Window.rto window;
let receive_window = Tcp.Window.ack_win window in
Tcp.Window.tx_advance window (Tcp.Window.tx_nxt window);
Mirage_mtime_set.tick_for (Duration.of_ms 400);
let max_size = Tcp.Window.tx_available window |> Tcp.Sequence.of_int32 in
let sz = Tcp.Sequence.add max_size @@ (Tcp.Window.tx_nxt window) in
Tcp.Window.tx_ack window sz receive_window;
(* RFC 2988 2.2 *)
Alcotest.(check int64) "After one RTT measurement, the calculated rto is 400 + (4 * 200) = 1200ms" (Duration.of_ms 1200) @@ Tcp.Window.rto window;
(* RFC 2988 2.3 *)
Tcp.Window.tx_advance window (Tcp.Window.tx_nxt window);
let receive_window = Tcp.Window.ack_win window in
Mirage_mtime_set.tick_for (Duration.of_ms 300);
let max_size = Tcp.Window.tx_available window |> Tcp.Sequence.of_int32 in
let sz = Tcp.Sequence.add max_size @@ (Tcp.Window.tx_nxt window) in
Tcp.Window.tx_ack window sz receive_window;
Alcotest.(check int64) "After subsequent RTT measurement, the calculated rto is 1087.5ms" (Duration.of_us 1087500) @@ Tcp.Window.rto window;
Lwt.return_unit
let suite = [
"fresh window is sensible", `Quick, fresh_window;
"fast recovery recovers fast", `Quick, recover_fast;
"smoothed rtt, rtt variation and retransmission timer are calculated according to RFC2988", `Quick, rto_calculation;
]
let suite = [
"tcp_window" , suite ;
]
let run test () =
Lwt_main.run (test ())
let () =
Printexc.record_backtrace true;
Mirage_crypto_rng_unix.use_default ();
(* enable logging to stdout for all modules *)
Logs.set_reporter (Logs_fmt.reporter ());
Logs.set_level ~all:true (Some Logs.Debug);
let suite = List.map (fun (n, s) ->
n, List.map (fun (d, s, f) -> d, s, run f) s
) suite
in
Alcotest.run "tcpip" suite