Merge pull request #246 from MagnusS/test-improvements

Test improvements

lib_test/test_connect.ml

@@ -93,6 +93,19 @@ let test_tcp_connect_two_stacks_basic () =
     "tests/pcap/tcp_connect_two_stacks_basic.pcap"
     Test.test_tcp_connect_two_stacks
 
+let test_tcp_connect_two_stacks_x100_uniform_no_payload_packet_loss () =
+  let rec loop = function
+      | 0 -> Lwt.return_unit
+      | n -> Logs.info (fun f -> f "%d/100" (101-n));
+             let module Test = Test_connect(Vnetif_backends.Uniform_no_payload_packet_loss) in
+             Test.record_pcap
+               (Printf.sprintf
+               "tests/pcap/tcp_connect_two_stacks_no_payload_packet_loss_%d_of_100.pcap" n)
+               Test.test_tcp_connect_two_stacks >>= fun () ->
+             loop (n - 1) 
+  in
+  loop 100
+
 let test_tcp_connect_two_stacks_trailing_bytes () =
   let module Test = Test_connect(Vnetif_backends.Trailing_bytes) in
   Test.record_pcap
@@ -104,6 +117,9 @@ let suite = [
   "connect two stacks, basic test", `Quick,
   test_tcp_connect_two_stacks_basic;
 
+  "connect two stacks, uniform packet loss of packets with no payload x 100", `Slow,
+  test_tcp_connect_two_stacks_x100_uniform_no_payload_packet_loss;
+
   "connect two stacks, with trailing bytes", `Quick,
   test_tcp_connect_two_stacks_trailing_bytes;
 

lib_test/test_iperf.ml

@@ -170,12 +170,11 @@ module Test_iperf (B : Vnetif_backends.Backend) = struct
     Lwt.wakeup server_done_u ();
     Lwt.return_unit
 
-  let tcp_iperf amt () =
+  let tcp_iperf amt timeout () =
     let port = 5001 in
 
     let server_ready, server_ready_u = Lwt.wait () in
     let server_done, server_done_u = Lwt.wait () in
-    let timeout = 120.0 in
 
     Lwt.pick [
       (Lwt_unix.sleep timeout >>= fun () -> (* timeout *)
@@ -205,42 +204,54 @@ module Test_iperf (B : Vnetif_backends.Backend) = struct
     V.record_pcap backend
 end
 
-let test_tcp_iperf_two_stacks_basic amt () =
+let test_tcp_iperf_two_stacks_basic amt timeout () =
   let module Test = Test_iperf (Vnetif_backends.Basic) in
   Test.record_pcap
-    "tests/pcap/tcp_iperf_two_stacks_basic.pcap"
-    (Test.tcp_iperf amt)
+    (Printf.sprintf "tests/pcap/tcp_iperf_two_stacks_basic_%d.pcap" amt)
+    (Test.tcp_iperf amt timeout)
 
-let test_tcp_iperf_two_stacks_trailing_bytes amt () =
+let test_tcp_iperf_two_stacks_trailing_bytes amt timeout () =
   let module Test = Test_iperf (Vnetif_backends.Trailing_bytes) in
   Test.record_pcap
-    "tests/pcap/tcp_iperf_two_stacks_trailing_bytes.pcap"
-    (Test.tcp_iperf amt)
+    (Printf.sprintf "tests/pcap/tcp_iperf_two_stacks_trailing_bytes_%d.pcap" amt)
+    (Test.tcp_iperf amt timeout)
 
-let test_tcp_iperf_two_stacks_uniform_packet_loss amt () =
+let test_tcp_iperf_two_stacks_uniform_packet_loss amt timeout () =
   let module Test = Test_iperf (Vnetif_backends.Uniform_packet_loss) in
   Test.record_pcap
-    "tests/pcap/tcp_iperf_two_stacks_uniform_packet_loss.pcap"
-    (Test.tcp_iperf amt)
+    (Printf.sprintf "tests/pcap/tcp_iperf_two_stacks_uniform_packet_loss_%d.pcap" amt)
+    (Test.tcp_iperf amt timeout)
+
+let test_tcp_iperf_two_stacks_uniform_packet_loss_no_payload amt timeout () =
+  let module Test = Test_iperf (Vnetif_backends.Uniform_no_payload_packet_loss) in
+  Test.record_pcap
+    (Printf.sprintf "tests/pcap/tcp_iperf_two_stacks_uniform_packet_loss_no_payload_%d.pcap" amt)
+    (Test.tcp_iperf amt timeout)
 
 let amt_quick = 10_000_000
 let amt_slow  = amt_quick * 100
 
 let suite = [
 
   "iperf with two stacks, basic tests", `Quick,
-  test_tcp_iperf_two_stacks_basic amt_quick;
+  test_tcp_iperf_two_stacks_basic amt_quick 120.0;
 
   "iperf with two stacks, testing trailing_bytes", `Quick,
-  test_tcp_iperf_two_stacks_trailing_bytes amt_quick;
+  test_tcp_iperf_two_stacks_trailing_bytes amt_quick 120.0;
 
   "iperf with two stacks and uniform packet loss", `Quick,
-  test_tcp_iperf_two_stacks_uniform_packet_loss amt_quick;
+  test_tcp_iperf_two_stacks_uniform_packet_loss amt_quick 120.0;
+
+  "iperf with two stacks and uniform packet loss of packets with no payload", `Quick,
+  test_tcp_iperf_two_stacks_uniform_packet_loss_no_payload amt_quick 120.0;
+
+  "iperf with two stacks and uniform packet loss of packets with no payload, longer", `Slow,
+  test_tcp_iperf_two_stacks_uniform_packet_loss_no_payload amt_slow 240.0;
 
   "iperf with two stacks, basic tests, longer", `Slow,
-  test_tcp_iperf_two_stacks_basic amt_slow;
+  test_tcp_iperf_two_stacks_basic amt_slow 240.0;
 
   "iperf with two stacks and uniform packet loss, longer", `Slow,
-  test_tcp_iperf_two_stacks_uniform_packet_loss amt_slow;
+  test_tcp_iperf_two_stacks_uniform_packet_loss amt_slow 240.0;
 
 ]

lib_test/vnetif_backends.ml

@@ -72,6 +72,39 @@ module Uniform_packet_loss : Backend = struct
 
 end 
 
+(** This backend uniformly drops packets with no payload *)
+module Uniform_no_payload_packet_loss : Backend = struct
+  module X = Basic_backend.Make
+  include X
+
+  (* We assume that packets with payload are usually filled. We could make the
+   * payload check more accurate by parsing the packet properly. *)
+  let no_payload_len = 100
+  (* Drop probability, if no payload *)
+  let drop_p = 0.10
+
+  let write t id buffer =
+    if Cstruct.len buffer <= no_payload_len && Random.float 1.0 < drop_p then
+    begin
+        MProf.Trace.label "pkt_drop";
+        Lwt.return_unit (* drop packet *)
+    end else
+        X.write t id buffer (* pass to real write *)
+
+  let writev t id buffers =
+    let total_len bufs = List.fold_left (fun a b -> a + Cstruct.len b) 0 bufs in
+    if total_len buffers <= no_payload_len && Random.float 1.0 < drop_p then
+    begin
+        MProf.Trace.label "pkt_drop";
+        Lwt.return_unit (* drop packet *)
+    end else
+        X.writev t id buffers (* pass to real writev *)
+
+  let create () =
+    X.create ~use_async_readers:true ~yield:(fun() -> Lwt_main.yield () ) ()
+
+end
+
 (** This backend delivers all packets unmodified *)
 module Basic : Backend = struct
   module X = Basic_backend.Make

lib_test/vnetif_common.ml

@@ -39,7 +39,7 @@ sig
   (** Add a listener function to the backend *)
   val create_backend_listener : backend -> (buffer -> unit io) -> id
   (** Disable a listener function *)
-  val disable_backend_listener : backend -> id -> unit
+  val disable_backend_listener : backend -> id -> unit io
   (** Records pcap data from the backend while running the specified function. Disables the pcap recorder when the function exits. *)
   val record_pcap : backend -> string -> (unit -> unit Lwt.t) -> unit Lwt.t
 end
@@ -85,7 +85,7 @@ module VNETIF_STACK ( B : Vnetif_backends.Backend) : (VNETIF_STACK with type bac
     | `Ok id -> (B.set_listen_fn backend id listenf); id
 
   let disable_backend_listener backend id =
-    B.set_listen_fn backend id (fun _buf -> Lwt.return_unit)
+    B.unregister_and_flush backend id
 
   let create_pcap_recorder backend channel =
     let header_buf = Cstruct.create Pcap.sizeof_pcap_header in
@@ -122,7 +122,7 @@ module VNETIF_STACK ( B : Vnetif_backends.Backend) : (VNETIF_STACK with type bac
         Lwt_io.with_file ~mode:Lwt_io.output pcap_file (fun oc ->
         create_pcap_recorder backend oc >>= fun recorder_id ->
         fn () >>= fun () ->
-        disable_backend_listener backend recorder_id;
+        disable_backend_listener backend recorder_id >>= fun () ->
         Lwt.return_unit
         )
       )

opam

@@ -50,7 +50,7 @@ depends: [
   "ipaddr" {>= "2.2.0"}
   "mirage-profile" {>= "0.5"}
   "mirage-flow" {test}
-  "mirage-vnetif" {test}
+  "mirage-vnetif" {test & >= "0.2.0"}
   "alcotest" {test}
   "pcap-format" {test}
   "fmt" {test}