Merge pull request #147 from MagnusS/packet-loss

Add vnetif backend with uniform packet loss and new iperf test

lib_test/test_iperf.ml

@@ -161,7 +161,13 @@ let test_tcp_iperf_two_stacks_trailing_bytes () =
   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
 
+let test_tcp_iperf_two_stacks_uniform_packet_loss () =
+  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
+
+
 let suite = [
   "test_tcp_iperf_two_stacks_basic" , test_tcp_iperf_two_stacks_basic;
   "test_tcp_iperf_two_stacks_trailing_bytes" , test_tcp_iperf_two_stacks_trailing_bytes;
+  "test_tcp_iperf_two_stacks_uniform_packet_loss" , test_tcp_iperf_two_stacks_uniform_packet_loss;
 ]

lib_test/vnetif_backends.ml

@@ -44,6 +44,30 @@ module Trailing_bytes : Backend = struct
 
 end 
 
+(** This backend drops packets *)
+module Uniform_packet_loss : Backend = struct
+  module X = Basic_backend.Make
+  include X
+
+  let drop_p = 0.01
+
+  let write t id buffer =
+    if Random.float 1.0 < drop_p then
+        Lwt.return_unit (* drop packet *)
+    else
+        X.write t id buffer (* pass to real write *)
+
+  let writev t id buffers =
+    if Random.float 1.0 < drop_p then
+        Lwt.return_unit (* drop packet *)
+    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

opam

@@ -19,7 +19,7 @@ build: [
   ]
   [make]
 ]
-build-test: [make "test"]
+build-test: [make "test" "TESTFLAGS=-v"]
 install: [make "install"]
 remove: ["ocamlfind" "remove" "tcpip"]
 depends: [