unikernel/duniverse/arp/bench/bench.ml

@@ -0,0 +1,187 @@
+(* derived from ISC-licensed mirage-tcpip/lib_test/test_arp.ml *)
+
+let count2 = ref 0
+
+let generate l =
+  let buf = Cstruct.create l in
+  for i = 0 to pred l do
+    Cstruct.set_uint8 buf i (Random.int 256)
+  done;
+  buf
+
+let hdr buf =
+  Cstruct.BE.set_uint16 buf 0 1 ;
+  Cstruct.BE.set_uint16 buf 2 0x0800 ;
+  Cstruct.set_uint8 buf 4 6 ;
+  Cstruct.set_uint8 buf 5 4
+
+let gen_int () =
+  let buf = generate 1 in
+  Cstruct.get_uint8 buf 0
+
+let gen_op buf off =
+  let op = gen_int () in
+  let op = 1 + op mod 2 in
+  Cstruct.BE.set_uint16 buf off op
+
+let gen_arp buf =
+  hdr buf ;
+  gen_op buf 6 ;
+  let addresses = generate 20 in
+  Cstruct.blit addresses 0 buf 8 20 ;
+  28
+
+let gen_req buf =
+  hdr buf ;
+  Cstruct.BE.set_uint16 buf 6 1 ;
+  let addresses = generate 20 in
+  Cstruct.blit addresses 0 buf 8 20 ;
+  28
+
+let gen_ip () =
+  let last = generate 1 in
+  let ip = "\010\000\000" ^ (Cstruct.to_string last) in
+  Ipaddr.V4.of_octets_exn ip
+
+let ip = Ipaddr.V4.of_string_exn "10.0.0.0"
+let mac = Macaddr.of_string_exn "00:de:ad:be:ef:00"
+
+let gen_rep buf =
+  hdr buf ;
+  Cstruct.BE.set_uint16 buf 6 2 ;
+  let omac = generate 6 in
+  Cstruct.blit omac 0 buf 8 6 ;
+  let oip = gen_ip () in
+  Cstruct.blit_from_string (Ipaddr.V4.to_octets oip) 0 buf 14 4 ;
+  Cstruct.blit_from_string (Macaddr.to_octets mac) 0 buf 18 6 ;
+  Cstruct.blit_from_string (Ipaddr.V4.to_octets ip) 0 buf 24 4 ;
+  28
+
+let other_ip = Ipaddr.V4.of_string_exn "10.0.0.1"
+let other_mac = Macaddr.of_string_exn "00:de:ad:be:ef:01"
+
+let myreq buf =
+  hdr buf ;
+  Cstruct.BE.set_uint16 buf 6 1 ;
+  Cstruct.blit_from_string (Macaddr.to_octets other_mac) 0 buf 8 6 ;
+  Cstruct.blit_from_string (Ipaddr.V4.to_octets other_ip) 0 buf 14 4 ;
+  Cstruct.blit_from_string (Macaddr.to_octets mac) 0 buf 18 6 ;
+  Cstruct.blit_from_string (Ipaddr.V4.to_octets ip) 0 buf 24 4 ;
+  28
+
+open Lwt.Infix
+
+module B = Basic_backend.Make
+module V = Vnetif.Make(B)
+module E = Ethernet.Make(V)
+module A = Arp.Make(E)
+
+let c = ref 0
+let gen arp buf =
+  c := !c mod 100 ;
+  match !c with
+  | x when x >= 00 && x < 10 ->
+    let len = gen_int () mod 28 in
+    let r = generate len in
+    Cstruct.blit r 0 buf 0 len ;
+    len
+  | x when x >= 10 && x < 20 -> gen_req buf
+  | x when x >= 20 && x < 50 -> myreq buf
+  | x when x >= 50 && x < 80 ->
+    if x mod 2 = 0 then
+      (let rand = gen_int () in
+       for _i = 0 to rand do
+         let ip = gen_ip () in
+         Lwt.async (fun () -> A.query arp ip >|= fun _ -> ())
+       done) ;
+    gen_rep buf
+  | x when x >= 80 && x < 100 -> gen_arp buf
+  | _ -> invalid_arg "bla"
+
+let rec query arp () =
+  incr count2 ;
+  let ip = gen_ip () in
+  Lwt.async (fun () -> A.query arp ip >|= fun _ -> ());
+  Mirage_sleep.ns (Duration.of_us 100) >>= fun () ->
+  query arp ()
+
+type arp_stack = {
+  backend : B.t;
+  netif: V.t;
+  ethif: E.t;
+  arp: A.t;
+}
+
+let get_arp ?(backend = B.create ~use_async_readers:true
+                ~yield:(fun() -> Lwt.pause ()) ()) () =
+  V.connect backend >>= fun netif ->
+  E.connect netif >>= fun ethif ->
+  A.connect ethif >>= fun arp ->
+  Lwt.return { backend; netif; ethif; arp }
+
+let rec send ethernet gen () =
+  E.write ethernet Macaddr.broadcast `ARP ~size:Arp_packet.size gen >>= function
+  | Ok _ -> send ethernet gen ()
+  | Error _ -> Lwt.return_unit
+
+let header_size = Ethernet.Packet.sizeof_ethernet
+
+let runit () =
+  Printf.printf "starting\n%!";
+  get_arp () >>= fun stack ->
+  get_arp ~backend:stack.backend () >>= fun other ->
+  A.set_ips stack.arp [ip] >>= fun () ->
+  let count = ref 0 in
+  Lwt.pick [
+    (V.listen stack.netif ~header_size (fun b -> incr count ; A.input stack.arp b) >|= fun _ -> ());
+    send other.ethif (fun b ->
+        let res = generate 28 in
+        Cstruct.blit res 0 b 0 28 ;
+        28) () ;
+    Mirage_sleep.ns (Duration.of_sec 5)
+  ] >>= fun () ->
+  Printf.printf "%d random input\n%!" !count ;
+  count := 0 ;
+  Lwt.pick [
+    (V.listen stack.netif ~header_size (fun b -> incr count ; A.input stack.arp b) >|= fun _ -> ());
+    send other.ethif gen_arp () ;
+    Mirage_sleep.ns (Duration.of_sec 5)
+  ] >>= fun () ->
+  Printf.printf "%d random ARP input\n%!" !count ;
+  count := 0 ;
+  Lwt.pick [
+    (V.listen stack.netif ~header_size (fun b -> incr count ; A.input stack.arp b) >|= fun _ -> ());
+    send other.ethif gen_req () ;
+    Mirage_sleep.ns (Duration.of_sec 5)
+  ] >>= fun () ->
+  Printf.printf "%d requests\n%!" !count ;
+  count := 0 ;
+  Lwt.pick [
+    (V.listen stack.netif ~header_size (fun b -> incr count ; A.input stack.arp b) >|= fun _ -> ());
+    send other.ethif gen_rep () ;
+    Mirage_sleep.ns (Duration.of_sec 5)
+  ] >>= fun () ->
+  Printf.printf "%d replies\n%!" !count ;
+  count := 0 ;
+  Lwt.pick [
+    (V.listen stack.netif ~header_size (fun b -> incr count ; A.input stack.arp b) >|= fun _ -> ());
+    send other.ethif (gen stack.arp) () ;
+    Mirage_sleep.ns (Duration.of_sec 5)
+  ] >>= fun () ->
+  Printf.printf "%d mixed\n%!" !count ;
+  count := 0 ;
+  Lwt.pick [
+    (V.listen stack.netif ~header_size (fun b -> incr count ; A.input stack.arp b) >|= fun _ -> ());
+    send other.ethif gen_rep  () ;
+    query stack.arp () ;
+    Mirage_sleep.ns (Duration.of_sec 5)
+  ] >|= fun () ->
+  Printf.printf "%d queries (%d qs)\n%!" !count !count2
+
+let () =
+  Random.self_init ();
+  Lwt_main.run (runit ()) ;
+  count2 := 0 ;
+  Lwt_main.run (runit ()) ;
+  count2 := 0 ;
+  Lwt_main.run (runit ())

unikernel/duniverse/arp/bench/dune

@@ -0,0 +1,3 @@
+(executable
+ (name bench)
+ (libraries arp.mirage mirage-vnetif lwt ipaddr ethernet mirage-sleep lwt.unix))