unikernel/duniverse/arp/.gitignore

@@ -0,0 +1,4 @@
+_build/
+.merlin
+*.install
+.*.swp

unikernel/duniverse/arp/CHANGES.md

@@ -0,0 +1,107 @@
+## v4.1.0 (2025-10-20)
+
+* Use LRU cache for Dynamic entries to avoid excessive memory consumption
+  (#35 @edwintorok)
+
+## v4.0.0 (2025-02-05)
+
+* Use mirage-sleep instead of mirage-time (no need to functorize over
+  Mirage_time.S) (#32 @hannesm)
+
+## v3.1.1 (2024-05-08)
+
+* Remove mirage-random and mirage-random-test dependency (#29 @hannesm)
+* Remove superfluous mirage-clock-unix and mirage-flow dependencies (#29 @hannesm)
+* Remove bisect-ppx dependency (#29 @hannesm)
+
+## v3.1.0 (2023-03-12)
+
+* Remove mirage-profile dependency (#28 @hannesm)
+
+## v3.0.0 (2021-12-10)
+
+* Include Mirage_protocols.ARP module type directly, remove dependency on
+  mirage-protocols (#27 @hannesm)
+
+## v2.3.2 (2021-04-22)
+
+* Compatibility with alcotest 1.4.0 (#22 @CraigFE)
+* Minor updates for CI (#23 @hannesm)
+
+## v2.3.1 (2020-11-25)
+
+* Fix opam file to include mirage-profile dependency (#21 @hannesm)
+
+## v2.3.0 (2020-11-25)
+
+* Update to dune 2 (#19 @hannesm)
+* Merge opam packages into a single one (#20 @hannesm)
+
+## v2.2.1 (2019-12-17)
+
+* adapt to lwt 5.0.0 change (#18 @hannesm)
+
+## v2.2.0 (2019-10-30)
+
+* adapt to mirage-protocols 4.0.0 changes (#17 @hannesm)
+
+## v2.1.0 (2019-07-16)
+
+* Update to ipaddr.4.0.0 interfaces (#16 @avsm)
+
+## v2.0.0 (2019-02-24)
+
+* provide Arp_packet.size
+* Arp_handler API changes: return Arp_packet.t instead of Cstruct.t
+* adapt to ethernet 2.0.0 changes
+
+## v1.0.0 (2019-02-02)
+
+* split opam package into two separate ones: a core
+  `arp` package and the `arp-mirage` implementation
+  for MirageOS that has more dependencies.  This
+  eliminates the use of depopts that was done previously
+  to build the Mirage layer. (#7 @avsm)
+
+* port build system to Dune (#7 @avsm). The `make coverage`
+  and `make bench` targets will do the job of the previous
+  topkg targets for those.
+
+* minor fixes to ocamldoc comments to be compatible with
+  odoc.
+
+* use mirage-random and mirage-random-test instead of a
+  nocrypto dependency in tests and bench (#7 @hannesm)
+
+* import tests from mirage-tcpip (#8 @hannesm)
+
+* depend on the ethernet opam package, no longer provided
+  by tcpip >3.7.0 (#9 @hannesm)
+
+## 0.2.3 (2019-01-04)
+
+* port to ipaddr 3.0.0
+
+## 0.2.2 (2018-08-25)
+
+* remove Arp_wire module, now integrated into Arp_packet
+* remove usage of ppx_cstruct
+
+## 0.2.1 (2018-05-06)
+
+* Avoid an initial gratitious ARP with Ipaddr.V4.any
+
+## 0.2.0 (2017-01-17)
+
+* MirageOS3 support
+* Don't ship with -warn-error +A, use it only in `./build`
+* Fix testsuite compilation on OCaml 4.02
+* Renamed `Marp` to `Arpv4` (same as MirageOS ARP handler in tcpip)
+
+## 0.1.1 (2016-07-13)
+
+* Minor nits for topkg
+
+## 0.1.0 (2016-07-12)
+
+* Initial release

unikernel/duniverse/arp/CODEOWNERS

@@ -0,0 +1 @@
+*       @hannesm

unikernel/duniverse/arp/LICENSE.md

@@ -0,0 +1,18 @@
+(*
+ * Copyright (c) 2016 Hannes Mehnert <hannes@mehnert.org>
+ * Portions copyright to MirageOS team under ISC license:
+ *   src/arp_packet.ml mirage/arpv4.mli mirage/arpv4.ml
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *
+ *)

unikernel/duniverse/arp/README.md

@@ -0,0 +1,24 @@
+## ARP - Address Resolution Protocol purely in OCaml
+
+v4.1.0
+
+ARP is an implementation of the address resolution protocol (RFC826) purely in
+OCaml.  It handles IPv4 protocol addresses and Ethernet hardware addresses only.
+
+A [MirageOS](https://mirage.io) ARP implementation is in the `mirage` subdirectory.
+
+Motivation for this implementation is [written up](https://hannes.robur.coop/Posts/ARP).
+
+## Documentation
+
+[API documentation](https://mirage.github.io/arp/arp/index.html) is available online.
+
+## Installation
+
+`opam install arp` will install this library, once you have installed OCaml (>=
+4.08.0) and opam (>= 2.0.0).
+
+Benchmarks require more opam libraries, namely `mirage-vnetif mirage-clock-unix
+mirage-unix`.  Use
+`dune build --release bench/bench.exe && _build/default/bench/bench.exe`
+to build and run it.

unikernel/duniverse/arp/arp.opam

@@ -0,0 +1,37 @@
+version: "4.1.0"
+opam-version: "2.0"
+maintainer: "Hannes Mehnert <hannes@mehnert.org>"
+authors: ["Hannes Mehnert <hannes@mehnert.org>"]
+homepage: "https://github.com/mirage/arp"
+doc: "https://mirage.github.io/arp/"
+dev-repo: "git+https://github.com/mirage/arp.git"
+bug-reports: "https://github.com/mirage/arp/issues"
+license: "ISC"
+depends: [
+  "ocaml" {>= "4.06.0"}
+  "dune" {>= "2.7.0"}
+  "cstruct" {>= "6.0.0"}
+  "ipaddr" {>= "4.0.0"}
+  "macaddr" {>= "4.0.0"}
+  "logs"
+  "mirage-sleep" {>= "4.0.0"}
+  "lru" {>= "0.3.0"}
+  "lwt"
+  "duration"
+  "ethernet" {>= "3.0.0"}
+  "fmt" {>= "0.8.7"}
+  "alcotest" {with-test}
+  "mirage-vnetif" {with-test & >= "0.5.0"}
+  "bos" {with-test & >= "0.2.1"}
+]
+build: [
+  ["dune" "subst"] {dev}
+  ["dune" "build" "-p" name "-j" jobs]
+  ["dune" "runtest" "-p" name "-j" jobs] {with-test & os != "macos"}
+]
+synopsis: "Address Resolution Protocol purely in OCaml"
+description: """
+ARP is an implementation of the address resolution protocol (RFC826) purely in
+OCaml.  It handles IPv4 protocol addresses and Ethernet hardware addresses only.
+"""
+x-maintenance-intent: [ "(latest)" ]

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))

unikernel/duniverse/arp/dune-project

@@ -0,0 +1,4 @@
+(lang dune 2.7)
+(name arp)
+(version v4.1.0)
+(formatting disabled)

unikernel/duniverse/arp/mirage/arp.ml

@@ -0,0 +1,148 @@
+(*
+ * Copyright (c) 2010-2011 Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2016 Hannes Mehnert <hannes@mehnert.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *
+ *)
+
+module type S = sig
+  type t
+  val disconnect : t -> unit Lwt.t
+  type error = private [> `Timeout ]
+  val pp_error: error Fmt.t
+  val pp : t Fmt.t
+  val get_ips : t -> Ipaddr.V4.t list
+  val set_ips : t -> Ipaddr.V4.t list -> unit Lwt.t
+  val remove_ip : t -> Ipaddr.V4.t -> unit Lwt.t
+  val add_ip : t -> Ipaddr.V4.t -> unit Lwt.t
+  val query : t -> Ipaddr.V4.t -> (Macaddr.t, error) result Lwt.t
+  val input : t -> Cstruct.t -> unit Lwt.t
+end
+
+open Lwt.Infix
+
+let logsrc = Logs.Src.create "ARP" ~doc:"Mirage ARP handler"
+
+module Make (Ethernet : Ethernet.S) = struct
+
+  type error = [
+    | `Timeout
+  ]
+  let pp_error ppf = function
+    | `Timeout -> Fmt.pf ppf "could not determine a link-level address for the IP address given"
+
+  type t = {
+    mutable state : ((Macaddr.t, error) result Lwt.t * (Macaddr.t, error) result Lwt.u) Arp_handler.t ;
+    ethif : Ethernet.t ;
+    mutable ticking : bool ;
+  }
+
+  let probe_repeat_delay = Duration.of_ms 1500 (* per rfc5227, 2s >= probe_repeat_delay >= 1s *)
+
+  let output t (arp, destination) =
+    let size = Arp_packet.size in
+    Ethernet.write t.ethif destination `ARP ~size
+      (fun b -> Arp_packet.encode_into arp b ; size) >|= function
+    | Ok () -> ()
+    | Error e ->
+      Logs.warn ~src:logsrc
+        (fun m -> m "error %a while outputting packet %a to %a"
+            Ethernet.pp_error e Arp_packet.pp arp Macaddr.pp destination)
+
+  let rec tick ~probe_delay t () =
+    if t.ticking then
+      Mirage_sleep.ns probe_delay >>= fun () ->
+      let state, requests, timeouts = Arp_handler.tick t.state in
+      t.state <- state ;
+      Lwt_list.iter_p (output t) requests >>= fun () ->
+      List.iter (fun (_, u) -> Lwt.wakeup u (Error `Timeout)) timeouts ;
+      tick ~probe_delay t ()
+    else
+      Lwt.return_unit
+
+  let pp ppf t = Arp_handler.pp ppf t.state
+
+  let input t frame =
+    let state, out, wake = Arp_handler.input t.state frame in
+    t.state <- state ;
+    (match out with
+     | None -> Lwt.return_unit
+     | Some pkt -> output t pkt) >|= fun () ->
+    match wake with
+    | None -> ()
+    | Some (mac, (_, u)) -> Lwt.wakeup u (Ok mac)
+
+  let get_ips t = Arp_handler.ips t.state
+
+  let create ?ipaddr t =
+    let mac = Arp_handler.mac t.state in
+    let state, out = Arp_handler.create ~logsrc ?ipaddr mac in
+    t.state <- state ;
+    match out with
+    | None -> Lwt.return_unit
+    | Some x -> output t x
+
+  let add_ip t ipaddr =
+    match Arp_handler.ips t.state with
+    | [] -> create ~ipaddr t
+    | _ ->
+      let state, out, wake = Arp_handler.alias t.state ipaddr in
+      t.state <- state ;
+      output t out >|= fun () ->
+      match wake with
+      | None -> ()
+      | Some (_, u) -> Lwt.wakeup u (Ok (Arp_handler.mac t.state))
+
+  let init_empty mac =
+    let state, _ = Arp_handler.create ~logsrc mac in
+    state
+
+  let set_ips t = function
+    | [] ->
+      let mac = Arp_handler.mac t.state in
+      let state = init_empty mac in
+      t.state <- state ;
+      Lwt.return_unit
+    | ipaddr::xs ->
+      create ~ipaddr t >>= fun () ->
+      Lwt_list.iter_s (add_ip t) xs
+
+  let remove_ip t ip =
+    let state = Arp_handler.remove t.state ip in
+    t.state <- state ;
+    Lwt.return_unit
+
+  let query t ip =
+    let merge = function
+      | None -> Lwt.wait ()
+      | Some a -> a
+    in
+    let state, res = Arp_handler.query t.state ip merge in
+    t.state <- state ;
+    match res with
+    | Arp_handler.RequestWait (pkt, (tr, _)) -> output t pkt >>= fun () -> tr
+    | Arp_handler.Wait (t, _) -> t
+    | Arp_handler.Mac mac -> Lwt.return (Ok mac)
+
+  let connect ?(probe_delay = probe_repeat_delay) ethif =
+    let mac = Ethernet.mac ethif in
+    let state = init_empty mac in
+    let t = { ethif; state; ticking = true} in
+    Lwt.async (tick ~probe_delay t);
+    Lwt.return t
+
+  let disconnect t =
+    t.ticking <- false ;
+    Lwt.return_unit
+end

unikernel/duniverse/arp/mirage/arp.mli

@@ -0,0 +1,72 @@
+(*
+ * Copyright (c) 2010-2011 Anil Madhavapeddy <anil@recoil.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *
+ *)
+
+(** {2 ARP} *)
+
+(** Address resolution protocol, translating network addresses (e.g. IPv4)
+    into link layer addresses (MAC). *)
+module type S = sig
+  type t
+  (** The type representing the internal state of the ARP layer. *)
+
+  val disconnect: t -> unit Lwt.t
+  (** Disconnect from the ARP layer. While this might take some time to
+      complete, it can never result in an error. *)
+
+  type error = private [> `Timeout ]
+  (** The type for ARP errors. *)
+
+  val pp_error: error Fmt.t
+  (** [pp_error] is the pretty-printer for errors. *)
+
+  (** Prettyprint cache contents *)
+  val pp : t Fmt.t
+
+  (** [get_ips arp] gets the bound IP address list in the [arp]
+      value. *)
+  val get_ips : t -> Ipaddr.V4.t list
+
+  (** [set_ips arp] sets the bound IP address list, which will transmit a
+      GARP packet also. *)
+  val set_ips : t -> Ipaddr.V4.t list -> unit Lwt.t
+
+  (** [remove_ip arp ip] removes [ip] to the bound IP address list in
+      the [arp] value, which will transmit a GARP packet for any remaining IPs in
+      the bound IP address list after the removal. *)
+  val remove_ip : t -> Ipaddr.V4.t -> unit Lwt.t
+
+  (** [add_ip arp ip] adds [ip] to the bound IP address list in the
+      [arp] value, which will transmit a GARP packet also. *)
+  val add_ip : t -> Ipaddr.V4.t -> unit Lwt.t
+
+  (** [query arp ip] queries the cache in [arp] for an ARP entry
+      corresponding to [ip], which may result in the sender sleeping
+      waiting for a response. *)
+  val query : t -> Ipaddr.V4.t -> (Macaddr.t, error) result Lwt.t
+
+  (** [input arp frame] will handle an ARP frame. If it is a response,
+      it will update its cache, otherwise will try to satisfy the
+      request. *)
+  val input : t -> Cstruct.t -> unit Lwt.t
+end
+
+
+module Make (Ethernet : Ethernet.S) : sig
+  include S
+
+  val connect : ?probe_delay:int64 -> Ethernet.t -> t Lwt.t
+end

unikernel/duniverse/arp/mirage/dune

@@ -0,0 +1,5 @@
+(library
+ (name arp_mirage)
+ (public_name arp.mirage)
+ (wrapped false)
+ (libraries arp ethernet mirage-sleep lwt logs duration))

unikernel/duniverse/arp/src/arp_handler.ml

@@ -0,0 +1,281 @@
+
+type 'a entry =
+  | Static of Macaddr.t * bool
+  | Dynamic of Macaddr.t * int
+  | Pending of 'a * int
+
+module M = struct
+  module M = Map.Make(Ipaddr.V4)
+  module Present = struct
+    type t = unit
+    let weight (_: t) = 1
+  end
+  module LRU = Lru.F.Make(Ipaddr.V4)(Present)
+
+  type 'a t =
+    { map: 'a entry M.t
+    ; mutable dynamic_lru: LRU.t
+    }
+
+  let empty capacity =
+    { map = M.empty; dynamic_lru = LRU.empty capacity }
+
+  let fold f t init =
+    M.fold f t.map init
+
+  let cardinal t = M.cardinal t.map
+
+  let iter f t = M.iter f t.map
+
+  let find k t =
+    let v = M.find k t.map in
+    t.dynamic_lru <- LRU.promote k t.dynamic_lru;
+    v
+
+  let add k v t =
+    let map = M.add k v t.map
+    and dynamic_lru = match v with
+    | Dynamic _ -> LRU.add k () t.dynamic_lru
+    | _ -> LRU.remove k t.dynamic_lru
+    in
+    let map, dynamic_lru =
+    if LRU.weight t.dynamic_lru > LRU.capacity t.dynamic_lru then begin
+      match LRU.pop_lru t.dynamic_lru with
+      | Some ((drop, ()), dynamic_lru) ->
+        M.remove drop t.map, dynamic_lru
+      | None -> map, dynamic_lru
+    end else
+      map, dynamic_lru
+    in
+    { map; dynamic_lru }
+
+  let remove k t =
+    { map = M.remove k t.map; dynamic_lru = LRU.remove k t.dynamic_lru }
+end
+
+type 'a t = {
+  cache : 'a M.t;
+  mac : Macaddr.t ;
+  ip : Ipaddr.V4.t ;
+  timeout : int ;
+  retries : int ;
+  epoch : int ;
+  logsrc : Logs.src
+}
+
+let ips t =
+  M.fold (fun ip entry acc -> match entry with
+      | Static (_, true) -> ip :: acc
+      | _ -> acc)
+    t.cache []
+
+let mac t = t.mac
+
+let[@coverage off] pp_entry now k pp =
+  function
+  | Static (m, adv) ->
+    let adv = if adv then " advertising" else "" in
+    Format.fprintf pp "%a at %a (static%s)" Ipaddr.V4.pp k Macaddr.pp m adv
+  | Dynamic (m, t) ->
+    Format.fprintf pp "%a at %a (timeout in %d)" Ipaddr.V4.pp k
+      Macaddr.pp m (t - now)
+  | Pending (_, retries) ->
+    Format.fprintf pp "%a (incomplete, %d retries left)"
+      Ipaddr.V4.pp k (retries - now)
+
+let[@coverage off] pp pp t =
+  Format.fprintf pp "mac %a ip %a entries %d timeout %d retries %d@."
+    Macaddr.pp t.mac
+    Ipaddr.V4.pp t.ip
+    (M.cardinal t.cache)
+    t.timeout t.retries ;
+  M.iter (fun k v -> pp_entry t.epoch k pp v ; Format.pp_print_space pp ()) t.cache
+
+let pending t ip =
+  match M.find ip t.cache with
+  | exception Not_found -> None
+  | Pending (a, _) -> Some a
+  | _ -> None
+
+let mac0 = Macaddr.of_octets_exn (String.make 6 '\000')
+
+let alias t ip =
+  let cache = M.add ip (Static (t.mac, true)) t.cache in
+  (* see RFC5227 Section 3 why we send out an ARP request *)
+  let garp = Arp_packet.({
+      operation = Request ;
+      source_mac = t.mac ;
+      target_mac = mac0 ;
+      source_ip = ip ; target_ip = ip })
+  in
+  Logs.info ~src:t.logsrc
+    (fun pp -> pp "Sending gratuitous ARP for %a (%a)"
+        Ipaddr.V4.pp ip Macaddr.pp t.mac) ;
+  { t with cache }, (garp, Macaddr.broadcast), pending t ip
+
+let create ?(cache_size=1024) ?(timeout = 800) ?(retries = 5)
+    ?(logsrc = Logs.Src.create "arp" ~doc:"ARP handler")
+    ?ipaddr
+    mac =
+  if timeout <= 0 then
+    invalid_arg "timeout must be strictly positive" ;
+  if retries < 0 then
+    invalid_arg "retries must be positive" ;
+  let cache = M.empty cache_size in
+  let ip = match ipaddr with None -> Ipaddr.V4.any | Some x -> x in
+  let t = { cache ; mac ; ip ; timeout ; retries ; epoch = 0 ; logsrc } in
+  match ipaddr with
+  | None -> t, None
+  | Some ip ->
+    let t, garp, _ = alias t ip in
+    t, Some garp
+
+let static t ip mac =
+  let cache = M.add ip (Static (mac, false)) t.cache in
+  { t with cache }, pending t ip
+
+let remove t ip =
+  let cache = M.remove ip t.cache in
+  { t with cache }
+
+let in_cache t ip =
+  match M.find ip t.cache with
+  | exception Not_found -> None
+  | Pending _ -> None
+  | Static (m, _) -> Some m
+  | Dynamic (m, _) -> Some m
+
+let request t ip =
+  let target = Macaddr.broadcast in
+  let request = {
+    Arp_packet.operation = Arp_packet.Request ;
+    source_mac = t.mac ; source_ip = t.ip ;
+    target_mac = target ; target_ip = ip
+  }
+  in
+  request, target
+
+let reply arp m =
+  let reply = {
+    Arp_packet.operation = Arp_packet.Reply ;
+    source_mac = m ; source_ip = arp.Arp_packet.target_ip ;
+    target_mac = arp.Arp_packet.source_mac ; target_ip = arp.Arp_packet.source_ip ;
+  } in
+  reply, arp.Arp_packet.source_mac
+
+let tick t =
+  let epoch = t.epoch in
+  let entry k v (cache, acc, r) = match v with
+    | Dynamic (m, tick) when tick = epoch ->
+      Logs.debug ~src:t.logsrc
+        (fun pp -> pp "removing ARP entry %a (mac %a)"
+            Ipaddr.V4.pp k Macaddr.pp m) ;
+      M.remove k cache, acc, r
+    | Dynamic (_, tick) when tick = succ epoch ->
+      cache, request t k :: acc, r
+    | Pending (a, retry) when retry = epoch ->
+      Logs.info ~src:t.logsrc
+        (fun pp -> pp "ARP timeout after %d retries for %a"
+            t.retries Ipaddr.V4.pp k) ;
+      M.remove k cache, acc, a :: r
+    | Pending _ -> cache, request t k :: acc, r
+    | _ -> cache, acc, r
+  in
+  let cache, outs, r = M.fold entry t.cache (t.cache, [], []) in
+  { t with cache ; epoch = succ epoch }, outs, r
+
+let handle_reply t source mac =
+  let extcache =
+    let cache = M.add source (Dynamic (mac, t.epoch + t.timeout)) t.cache in
+    { t with cache }
+  in
+  match M.find source t.cache with
+  | exception Not_found ->
+    t, None, None
+  | Static (_, adv) ->
+    if adv && Macaddr.compare mac mac0 = 0 then
+      Logs.info ~src:t.logsrc
+        (fun pp ->
+           pp "ignoring gratuitous ARP from %a using my IP address %a"
+             Macaddr.pp mac Ipaddr.V4.pp source)[@coverage off]
+    else
+      Logs.info ~src:t.logsrc
+        (fun pp ->
+           pp "ignoring ARP reply for %a (static %sarp entry in cache)"
+             Ipaddr.V4.pp source (if adv then "advertised " else ""))
+      [@coverage off] ;
+    t, None, None
+  | Dynamic (m, _) ->
+    if Macaddr.compare mac m <> 0 then
+      Logs.warn ~src:t.logsrc
+        (fun pp -> pp "ARP for %a moved from %a to %a"
+            Ipaddr.V4.pp source
+            Macaddr.pp m
+            Macaddr.pp mac) ;
+    extcache, None, None
+  | Pending (xs, _) -> extcache, None, Some (mac, xs)
+
+
+let handle_request t arp =
+  let dest = arp.Arp_packet.target_ip
+  and source = arp.Arp_packet.source_ip
+  in
+  match M.find dest t.cache with
+  | exception Not_found ->
+    Logs.debug ~src:t.logsrc
+      (fun pp -> pp "ignoring ARP request for %a from %a (mac %a)"
+          Ipaddr.V4.pp dest
+          Ipaddr.V4.pp source
+          Macaddr.pp arp.Arp_packet.source_mac) ;
+    t, None, None
+  | Static (m, true) ->
+    Logs.debug ~src:t.logsrc
+      (fun pp -> pp "replying to ARP request for %a from %a (mac %a)"
+          Ipaddr.V4.pp dest
+          Ipaddr.V4.pp source
+          Macaddr.pp arp.Arp_packet.source_mac) ;
+    t, Some (reply arp m), None
+  | _ ->
+    Logs.debug ~src:t.logsrc
+      (fun pp -> pp "ignoring ARP request for %a from %a (mac %a)"
+          Ipaddr.V4.pp dest
+          Ipaddr.V4.pp source
+          Macaddr.pp arp.Arp_packet.source_mac)
+    [@coverage off] ;
+    t, None, None
+
+let input t buf =
+  match Arp_packet.decode buf with
+  | Error e ->
+    Logs.info ~src:t.logsrc
+        (fun pp -> pp "Failed to parse ARP frame %a" Arp_packet.pp_error e) ;
+    t, None, None
+  | Ok arp ->
+    if
+      Ipaddr.V4.compare arp.Arp_packet.source_ip arp.Arp_packet.target_ip = 0 ||
+      arp.Arp_packet.operation = Arp_packet.Reply
+    then
+      let mac = arp.Arp_packet.source_mac
+      and source = arp.Arp_packet.source_ip
+      in
+      handle_reply t source mac
+    else (* must be a request *)
+      handle_request t arp
+
+type 'a qres =
+  | Mac of Macaddr.t
+  | Wait of 'a
+  | RequestWait of (Arp_packet.t * Macaddr.t) * 'a
+
+let query t ip a =
+  match M.find ip t.cache with
+  | exception Not_found ->
+    let a = a None in
+    let cache = M.add ip (Pending (a, t.epoch + t.retries)) t.cache in
+    { t with cache }, RequestWait (request t ip, a)
+  | Pending (x, r) ->
+    let a = a (Some x) in
+    let cache = M.add ip (Pending (a, r)) t.cache in
+    { t with cache }, Wait a
+  | Static (m, _) -> t, Mac m
+  | Dynamic (m, _) -> t, Mac m

unikernel/duniverse/arp/src/arp_handler.mli

@@ -0,0 +1,120 @@
+(** Protocol handler for the Address Resolution Protocol
+
+    This library provides a pure implementation of ARP, which handles only IPv4
+    addresses as protocol and Ethernet (MAC) addresses as hardware.  This is the
+    most common usage of ARP currently.  There is no support for other types of
+    addresses.  ARP is initially specified in
+    {{:https://tools.ietf.org/html/rfc826}, RFC826}, and further refined in
+    {{:https://tools.ietf.org/html/rfc1122}, RFC1122} and partially
+    {{:https://tools.ietf.org/html/rfc5227}, RFC5227}.
+
+    The ARP handler consists of a cache, which maps IPv4 addresses to Ethernet
+    addresses, and access to it.  Its configuration is set during
+    {{!create}construction}, together with the own IPv4 address and Ethernet
+    address.  The cache can be modified with {{!static}static} entries of other
+    hosts, {{!alias}IPv4 aliases}, {{!remove}removal} of entries.  Outgoing
+    frames always use its {{!ip}main IPv4 address}.  Whether an entry
+    {{!in_cache}is available} or not can be inspected.
+
+    The ARP handler can process {{!input}network input}, which may extend the
+    cache with dynamic ARP entries which time out after the configured period.
+    Periodic calls to {!tick} are required for the timeout and retry mechanisms.
+    Since ARP usually uses network communication, callers may {!query} the cache
+    and wait until either a response was received or a timeout occured after
+    several retries.
+
+    The embedded merge strategy is simple: static entries always win (and thus,
+    both {!alias} and {!static} overwrite existing entries).  Log messages at
+    the are generated if an ARP reply wants to overwrite a static entry, or the
+    Ethernet address of a dynamic entry changed.
+
+    ARP frames which should be send on the wire are given as a pair of buffer
+    and destination address, to be passed to the underlying layer (usually
+    Ethernet).  When adding entries, gratuitous ARP frames are to be sent.
+
+    While the {!Arp_packet} module is exposed, for normal operation it is not
+    needed, but this module should be sufficient.
+
+    {e v4.1.0 - {{:https://github.com/mirage/arp }homepage}}
+*)
+
+
+(** The type of an ARP handler.  It is polymorphic over the tasks waiting for
+    an ARP reply. *)
+type 'a t
+
+(** {2 Constructor} *)
+
+(** [create ~cache_size ~timeout ~retries ~ipaddr mac)] is [t, garp]. The constructor of
+    the ARP handler, specifying timeouts (defaults to 800) and amount of
+    retries (defaults to 5).  If [ipaddr] is provided, a gratuitous ARP
+    request will be encoded in [garp], otherwise {!Ipaddr.V4.any} is temporarily
+    used and [garp] is [None].    The value of [timeout] is the number of
+    [Tick] events.
+    [cache_size] limits the number of dynamic entries in the ARP cache.
+
+    @raise Invalid_argument is [timeout] is 0 or negative or [retries] is
+    negative.  *)
+val create : ?cache_size: int -> ?timeout:int -> ?retries:int -> ?logsrc:Logs.src ->
+  ?ipaddr:Ipaddr.V4.t -> Macaddr.t -> 'a t * (Arp_packet.t * Macaddr.t) option
+
+(** [pp ppf t] prints the ARP handler [t] on [ppf] by iterating over all cache
+    entries. *)
+val pp : Format.formatter -> 'a t -> unit
+
+(** {2 Predicates} *)
+
+(** [ips t] is [ips], the advertised IPv4 addresses. *)
+val ips : 'a t -> Ipaddr.V4.t list
+
+(** [mac t] is [mac], the mac address used by the ARP handler. *)
+val mac : 'a t -> Macaddr.t
+
+(** [in_cache t ip] is [mac option], a MAC address if the ARP cache contains an
+    entry, [None] otherwise. *)
+val in_cache : 'a t -> Ipaddr.V4.t -> Macaddr.t option
+
+(** {2 Operations on the cache} *)
+
+(** [static t ip mac] is [t', as], where [t'] is [t] extended with a static ARP
+    entry using the given [ip] and [mac].  The tasks waiting for [ip] are
+    [as]. *)
+val static : 'a t -> Ipaddr.V4.t -> Macaddr.t -> 'a t * 'a option
+
+(** [alias t ip] is [t', out, as], where [t'] is [t] extended by a static ARP
+    entry for [ip].  This entry will be used to answer further ARP requests.
+    [out] is a gratuitous ARP frame.  The tasks waiting for [ip] are [as]. *)
+val alias : 'a t -> Ipaddr.V4.t -> 'a t * (Arp_packet.t * Macaddr.t) * 'a option
+
+(** [remove t ip] is [t'], where [ip] is no longer in the cache. *)
+val remove : 'a t -> Ipaddr.V4.t -> 'a t
+
+(** {2 Events} *)
+
+(** [tick t] is [t', requests, timeouts], which advances the state [t] into
+    [t'].  Possibly retransmissions of ARP requests need to be done, provided in
+    the [requests] list.  Timed out queries are in the [timeouts] list. *)
+val tick : 'a t -> 'a t * (Arp_packet.t * Macaddr.t) list * 'a list
+
+(** [input t buf] is [t', reply, w], which handles the input buffer [buf] in the
+    state [t].  The state is transformed into [t'].  If it was an ARP request
+    for one of our IPv4 addresses, an ARP reply should be send out [reply].  If
+    the input was an awaited ARP reply, some elements [w] can be informed.  *)
+val input : 'a t -> Cstruct.t ->
+  ('a t * (Arp_packet.t * Macaddr.t) option * (Macaddr.t * 'a) option)
+
+(** The type returned by query, either a [Mac] and a mac address, or [Wait] for
+    a reply, or [RequestWait], consisting of an ARP request to be send on the wire,
+    and await its answer. *)
+type 'a qres =
+  | Mac of Macaddr.t
+  | Wait of 'a
+  | RequestWait of (Arp_packet.t * Macaddr.t) * 'a
+
+(** [query t ip merge] is [t', qres], which looks for the [ip] in the cache.  If
+    it is found, its value is [Mac mac].  If the [ip] is not in the cache,
+    either some ['a] is waiting for it already, then the value is [Wait a],
+    where [a] is produced by applying [merge (Some 'a)] to the waiting thing.
+    Otherwise, both an ARP request needs to be send out, and the value of
+    [merge None] is put into the cache, both as part of [RequestWait].  *)
+val query : 'a t -> Ipaddr.V4.t -> ('a option -> 'a) -> 'a t * 'a qres

unikernel/duniverse/arp/src/arp_packet.ml

@@ -0,0 +1,114 @@
+(* based on ISC-licensed mirage-tcpip module *)
+
+type op =
+  | Request
+  | Reply
+
+let op_to_int = function Request -> 1 | Reply -> 2
+let int_to_op = function 1 -> Some Request | 2 -> Some Reply | _ -> None
+
+(* ARP packet contains:
+   16 bit hardware type = ethernet = 0x01
+   16 bit protocol type = ipv4 = 0x0800
+   8 bit hardware address length = 6
+   8 bit protocol address length = 4
+   16 bit operation
+   sender hardware address = 6 byte
+   sender protocol address = 4 byte
+   target hardware address = 6 byte
+   target protocol address = 4 byte
+ *)
+
+type t = {
+  operation : op;
+  source_mac : Macaddr.t;
+  source_ip : Ipaddr.V4.t;
+  target_mac : Macaddr.t;
+  target_ip : Ipaddr.V4.t;
+}
+
+let equal a b =
+  op_to_int a.operation = op_to_int b.operation &&
+  Macaddr.compare a.source_mac b.source_mac = 0 &&
+  Ipaddr.V4.compare a.source_ip b.source_ip = 0 &&
+  Macaddr.compare a.target_mac b.target_mac = 0 &&
+  Ipaddr.V4.compare a.target_ip b.target_ip = 0
+
+type error =
+  | Too_short
+  | Unusable
+  | Unknown_operation of Cstruct.uint16
+
+let[@coverage off] pp fmt t =
+  if t.operation = Request then
+    Format.fprintf fmt "ARP request from %a to %a, who has %a tell %a"
+      Macaddr.pp t.source_mac Macaddr.pp t.target_mac
+      Ipaddr.V4.pp t.target_ip Ipaddr.V4.pp t.source_ip
+  else (* t.op = Reply *)
+    Format.fprintf fmt "ARP reply from %a to %a, %a is at %a"
+      Macaddr.pp t.source_mac Macaddr.pp t.target_mac
+      Ipaddr.V4.pp t.source_ip Macaddr.pp t.source_mac
+
+let[@coverage off] pp_error ppf = function
+  | Too_short -> Format.pp_print_string ppf "frame too short (below 28 bytes)"
+  | Unusable -> Format.pp_print_string ppf "ARP address types are not IPv4 and Ethernet"
+  | Unknown_operation i -> Format.fprintf ppf "ARP message has unsupported operation %d" i
+
+(* may be defined elsewhere *)
+let ipv4_ethertype = 0x0800
+and ipv4_size = 4
+and ether_htype = 1
+and ether_size = 6
+and size = 28
+
+let guard p e = if p then Ok () else Error e
+
+let (>>=) x f = match x with
+  | Ok y -> f y
+  | Error e -> Error e
+
+let decode buf =
+  let check_len buf = Cstruct.length buf >= size in
+  let check_hdr buf =
+    Cstruct.BE.get_uint16 buf 0 = ether_htype &&
+    Cstruct.BE.get_uint16 buf 2 = ipv4_ethertype &&
+    Cstruct.get_uint8 buf 4 = ether_size &&
+    Cstruct.get_uint8 buf 5 = ipv4_size
+  in
+  guard (check_len buf) Too_short >>= fun () ->
+  guard (check_hdr buf) Unusable >>= fun () ->
+  let op = Cstruct.BE.get_uint16 buf 6 in
+  match int_to_op op with
+  | None -> Error (Unknown_operation op)
+  | Some operation ->
+    let source_mac = Macaddr.of_octets_exn (Cstruct.to_string (Cstruct.sub buf 8 6))
+    and target_mac = Macaddr.of_octets_exn (Cstruct.to_string (Cstruct.sub buf 18 6))
+    and source_ip = Ipaddr.V4.of_int32 (Cstruct.BE.get_uint32 buf 14)
+    and target_ip = Ipaddr.V4.of_int32 (Cstruct.BE.get_uint32 buf 24) in
+    Ok {
+      operation ;
+      source_mac; source_ip ;
+      target_mac; target_ip
+    }
+
+let hdr =
+  let buf = Cstruct.create 6 in
+  Cstruct.BE.set_uint16 buf 0 ether_htype;
+  Cstruct.BE.set_uint16 buf 2 ipv4_ethertype;
+  Cstruct.set_uint8 buf 4 ether_size;
+  Cstruct.set_uint8 buf 5 ipv4_size;
+  buf
+
+let encode_into t buf =
+  Cstruct.blit hdr 0 buf 0 6 ;
+  Cstruct.BE.set_uint16 buf 6 (op_to_int t.operation) ;
+  Cstruct.blit_from_string (Macaddr.to_octets t.source_mac) 0 buf 8 6 ;
+  Cstruct.BE.set_uint32 buf 14 (Ipaddr.V4.to_int32 t.source_ip) ;
+  Cstruct.blit_from_string (Macaddr.to_octets t.target_mac) 0 buf 18 6 ;
+  Cstruct.BE.set_uint32 buf 24 (Ipaddr.V4.to_int32 t.target_ip)
+  [@@inline]
+
+let encode t =
+  let buf = Cstruct.create_unsafe size in
+  encode_into t buf;
+  buf

unikernel/duniverse/arp/src/arp_packet.mli

@@ -0,0 +1,61 @@
+(** Conversion between wire and high-level data
+
+    The {{!t}high-level datatype} can be decoded and encoded to bytes to be sent
+    on the wire.  ARP specifies hardware and protocol addresses, but this
+    implementation picks Ethernet and IPv4 statically. While decoding can result
+    in an error, encoding can not.  *)
+
+type op =
+  | Request
+  | Reply
+
+val op_to_int : op -> int
+val int_to_op : int -> op option
+
+(** The high-level ARP frame consisting of the two address pairs and an operation. *)
+type t = {
+  operation : op;
+  source_mac : Macaddr.t;
+  source_ip : Ipaddr.V4.t;
+  target_mac : Macaddr.t;
+  target_ip : Ipaddr.V4.t;
+}
+
+(** [size] is the size of an ARP frame. *)
+val size : int
+
+(** [pp ppf t] prints the frame [t] on [ppf]. *)
+val pp : Format.formatter -> t -> unit
+
+(** [equal a b] returns [true] if frames [a] and [b] are equal, [false] otherwise. *)
+val equal : t -> t -> bool
+
+(** The type of possible errors during decoding
+
+    - [Too_short] if the provided buffer is not long enough
+    - [Unusable] if the protocol or hardware address type is not IPv4 and Ethernet
+    - [Unknown_operation] if it is neither a request nor a reply
+  *)
+type error =
+  | Too_short
+  | Unusable
+  | Unknown_operation of Cstruct.uint16
+
+(** [pp_error ppf err] prints the error [err] on [ppf]. *)
+val pp_error : Format.formatter -> error -> unit
+
+(** {2 Decoding} *)
+
+(** [decode buf] attempts to decode the buffer into an ARP frame [t]. *)
+val decode : Cstruct.t -> (t, error) result
+
+(** {2 Encoding} *)
+
+(** [encode t] is a [buf], a freshly allocated buffer, which contains the
+    encoded ARP frame [t]. *)
+val encode : t -> Cstruct.t
+
+(** [encode_into t buf] encodes [t] into the buffer [buf] at offset 0.
+
+    @raise Invalid_argument if the buffer [buf] is too small (below 28 bytes). *)
+val encode_into : t -> Cstruct.t -> unit

unikernel/duniverse/arp/src/dune

@@ -0,0 +1,8 @@
+(library
+ (name arp)
+ (synopsis "Address Resolution Protocol purely in OCaml")
+ (public_name arp)
+ (wrapped false)
+ (instrumentation
+  (backend bisect_ppx))
+ (libraries cstruct logs ipaddr macaddr fmt lru))

unikernel/duniverse/arp/test/dune

@@ -0,0 +1,4 @@
+(test
+ (name tests)
+ (package arp)
+ (libraries arp macaddr cstruct alcotest))

unikernel/duniverse/arp/test/mirage/dune

@@ -0,0 +1,5 @@
+(test
+ (name tests)
+ (package arp)
+ (libraries alcotest lwt.unix logs logs.fmt fmt mirage-vnetif
+   duration ethernet arp arp.mirage cstruct bos))

unikernel/duniverse/arp/test/mirage/tests.ml

@@ -0,0 +1,530 @@
+open Lwt.Infix
+
+module B = Basic_backend.Make
+module V = Vnetif.Make(B)
+module E = Ethernet.Make(V)
+module A = Arp.Make(E)
+
+let src = Logs.Src.create "test_arp" ~doc:"Mirage ARP tester"
+module Log = (val Logs.src_log src : Logs.LOG)
+
+type arp_stack = {
+  backend : B.t;
+  netif: V.t;
+  ethif: E.t;
+  arp: A.t;
+}
+
+let first_ip = Ipaddr.V4.of_string_exn "192.168.3.1"
+let second_ip = Ipaddr.V4.of_string_exn "192.168.3.10"
+let sample_mac = Macaddr.of_string_exn "10:9a:dd:c0:ff:ee"
+
+let packet = (module Arp_packet : Alcotest.TESTABLE with type t = Arp_packet.t)
+
+let ip =
+  let module M = struct
+    type t = Ipaddr.V4.t
+    let pp = Ipaddr.V4.pp
+    let equal p q = (Ipaddr.V4.compare p q) = 0
+  end in
+  (module M : Alcotest.TESTABLE with type t = M.t)
+
+let macaddr =
+  let module M = struct
+    type t = Macaddr.t
+    let pp = Macaddr.pp
+    let equal p q = (Macaddr.compare p q) = 0
+  end in
+  (module M : Alcotest.TESTABLE with type t = M.t)
+
+let header_size = Ethernet.Packet.sizeof_ethernet
+let size = Arp_packet.size
+
+let check_header ~message expected actual =
+  Alcotest.(check packet) message expected actual
+
+let fail = Alcotest.fail
+let failf fmt = Fmt.kstr (fun s -> Alcotest.fail s) fmt
+
+let timeout ~time t =
+  let msg = Printf.sprintf "Timed out: didn't complete in %d milliseconds" time in
+  Lwt.pick [ t; Mirage_sleep.ns (Duration.of_ms time) >>= fun () -> fail msg; ]
+
+let check_response expected buf =
+  match Arp_packet.decode buf with
+  | Error s -> Alcotest.fail (Fmt.to_to_string Arp_packet.pp_error s)
+  | Ok actual ->
+    Alcotest.(check packet) "parsed packet comparison" expected actual
+
+let check_ethif_response expected buf =
+  let open Ethernet.Packet in
+  match of_cstruct buf with
+  | Error s -> Alcotest.fail s
+  | Ok ({ethertype; _}, arp) ->
+    match ethertype with
+    | `ARP -> check_response expected arp
+    | _ -> Alcotest.fail "Ethernet packet with non-ARP ethertype"
+
+let garp source_mac source_ip =
+  let open Arp_packet in
+  {
+    operation = Request;
+    source_mac;
+    target_mac = Macaddr.of_octets_exn "\000\000\000\000\000\000";
+    source_ip;
+    target_ip = source_ip;
+  }
+
+let fail_on_receipt netif buf =
+  Alcotest.fail (Format.asprintf "received traffic when none was expected on interface %a: %a"
+	  Macaddr.pp (V.mac netif) Cstruct.hexdump_pp buf)
+
+let single_check netif expected =
+  V.listen netif ~header_size (fun buf ->
+      match Ethernet.Packet.of_cstruct buf with
+      | Error _ -> failwith "sad face"
+      | Ok (_, payload) ->
+        check_response expected payload; V.disconnect netif) >|= fun _ -> ()
+
+(*  { Ethernet_packet.source = arp.source_mac;
+      destination = arp.target_mac;
+      ethertype = `ARP;
+    } *)
+
+let arp_reply ~from_netif ~to_netif ~from_ip ~to_ip arp =
+  let open Arp_packet in
+  let a =
+    { operation = Reply;
+      source_mac = V.mac from_netif;
+      target_mac = V.mac to_netif;
+      source_ip = from_ip;
+      target_ip = to_ip}
+  in
+  encode_into a arp ;
+  Arp_packet.size
+
+let arp_request ~from_netif ~to_mac ~from_ip ~to_ip arp =
+  let open Arp_packet in
+  let a =
+    { operation = Request;
+      source_mac = V.mac from_netif;
+      target_mac = to_mac;
+      source_ip = from_ip;
+      target_ip = to_ip}
+  in
+  encode_into a arp ;
+  Arp_packet.size
+
+let get_arp ?backend () =
+  let backend = match backend with
+    | None -> B.create ~use_async_readers:true ~yield:Lwt.pause ()
+    | Some b -> b
+  in
+  V.connect backend >>= fun netif ->
+  E.connect netif >>= fun ethif ->
+  A.connect ~probe_delay:(Duration.of_ms 2) ethif >>= fun arp ->
+  Lwt.return { backend; netif; ethif; arp }
+
+(* we almost always want two stacks on the same backend *)
+let two_arp () =
+  get_arp () >>= fun first ->
+  get_arp ~backend:first.backend () >>= fun second ->
+  Lwt.return (first, second)
+
+(* ...but sometimes we want three *)
+let three_arp () =
+  get_arp () >>= fun first ->
+  get_arp ~backend:first.backend () >>= fun second ->
+  get_arp ~backend:first.backend () >>= fun third ->
+  Lwt.return (first, second, third)
+
+let query_or_die arp ip expected_mac =
+  A.query arp ip >>= function
+  | Error `Timeout ->
+    Log.warn (fun f -> f "Timeout querying %a. Table contents: %a"
+                 Ipaddr.V4.pp ip A.pp arp);
+    fail "ARP query failed when success was mandatory";
+  | Ok mac ->
+    Alcotest.(check macaddr) "mismatch for expected query value" expected_mac mac;
+    Lwt.return_unit
+  | Error e -> failf "ARP query failed with %a" A.pp_error e
+
+let query_and_no_response arp ip =
+  A.query arp ip >>= function
+  | Error `Timeout ->
+    Log.warn (fun f -> f "Timeout querying %a. Table contents: %a" Ipaddr.V4.pp ip A.pp arp);
+    Lwt.return_unit
+  | Ok _ -> failf "expected nothing, found something in cache"
+  | Error e ->
+    Log.err (fun m -> m "another err");
+    failf "ARP query failed with %a" A.pp_error e
+
+let set_and_check ~listener ~claimant ip =
+  A.set_ips claimant.arp [ ip ] >>= fun () ->
+  Log.debug (fun f -> f "Set IP for %a to %a" Macaddr.pp (V.mac claimant.netif) Ipaddr.V4.pp ip);
+  Logs.debug (fun f -> f "Listener table contents after IP set on claimant: %a" A.pp listener);
+  query_or_die listener ip (V.mac claimant.netif)
+
+let start_arp_listener stack () =
+  let noop = (fun _ -> Lwt.return_unit) in
+  Log.debug (fun f -> f "starting arp listener for %a" Macaddr.pp (V.mac stack.netif));
+  let arpv4 frame =
+    Log.debug (fun f -> f "frame received for arpv4");
+    A.input stack.arp frame
+  in
+  E.input ~arpv4 ~ipv4:noop ~ipv6:noop stack.ethif
+
+let not_in_cache ~listen probe arp ip =
+  Lwt.pick [
+    single_check listen probe;
+    Mirage_sleep.ns (Duration.of_ms 100) >>= fun () ->
+    A.query arp ip >>= function
+    | Ok _ -> failf "entry in cache when it shouldn't be %a" Ipaddr.V4.pp ip
+    | Error `Timeout -> Lwt.return_unit
+    | Error e -> failf "error for %a while reading the cache: %a"
+                   Ipaddr.V4.pp ip A.pp_error e
+  ]
+
+let set_ip_sends_garp () =
+  two_arp () >>= fun (speak, listen) ->
+  let emit_garp =
+    Mirage_sleep.ns (Duration.of_ms 100) >>= fun () ->
+    A.set_ips speak.arp [ first_ip ] >>= fun () ->
+    Alcotest.(check (list ip)) "garp emitted when setting ip" [ first_ip ] (A.get_ips speak.arp);
+    Lwt.return_unit
+  in
+  let expected_garp = garp (V.mac speak.netif) first_ip in
+  timeout ~time:500 (
+  Lwt.join [
+    single_check listen.netif expected_garp;
+    emit_garp;
+  ]) >>= fun () ->
+  (* now make sure we have consistency when setting *)
+  A.set_ips speak.arp [] >>= fun () ->
+  Alcotest.(check (slist ip Ipaddr.V4.compare)) "list of bound IPs on initialization" [] (A.get_ips speak.arp);
+  A.set_ips speak.arp [ first_ip; second_ip ] >>= fun () ->
+  Alcotest.(check (slist ip Ipaddr.V4.compare)) "list of bound IPs after setting two IPs"
+    [ first_ip; second_ip ] (A.get_ips speak.arp);
+  Lwt.return_unit
+
+let add_get_remove_ips () =
+  get_arp () >>= fun stack ->
+  let check str expected =
+    Alcotest.(check (list ip)) str expected (A.get_ips stack.arp)
+  in
+  check "bound ips is an empty list on startup" [];
+  A.set_ips stack.arp [ first_ip; first_ip ] >>= fun () ->
+  check "set ips with duplicate elements result in deduplication" [first_ip];
+  A.remove_ip stack.arp first_ip >>= fun () ->
+  check "ip list is empty after removing only ip" [];
+  A.remove_ip stack.arp first_ip >>= fun () ->
+  check "ip list is empty after removing from empty list" [];
+  A.add_ip stack.arp first_ip >>= fun () ->
+  check "first ip is the only member of the set of bound ips" [first_ip];
+  A.add_ip stack.arp first_ip >>= fun () ->
+  check "adding ips is idempotent" [first_ip];
+  Lwt.return_unit
+
+let input_single_garp () =
+  two_arp () >>= fun (listen, speak) ->
+  (* set the IP on speak_arp, which should cause a GARP to be emitted which
+     listen_arp will hear and cache. *)
+  let one_and_done buf =
+    let arpbuf = Cstruct.shift buf 14 in
+    A.input listen.arp arpbuf >>= fun () ->
+    V.disconnect listen.netif
+  in
+  timeout ~time:500 (
+    Lwt.join [
+      (V.listen listen.netif ~header_size one_and_done >|= fun _ -> ());
+      Mirage_sleep.ns (Duration.of_ms 100) >>= fun () ->
+      Lwt.async (fun () -> A.query listen.arp first_ip >|= ignore) ;
+      A.set_ips speak.arp [ first_ip ];
+    ])
+    >>= fun () ->
+  (* try a lookup of the IP set by speak.arp, and fail if this causes listen_arp
+     to block or send an ARP query -- listen_arp should answer immediately from
+     the cache.  An attempt to resolve via query will result in a timeout, since
+     speak.arp has no listener running and therefore won't answer any arp
+     who-has requests. *)
+    timeout ~time:500 (query_or_die listen.arp first_ip (V.mac speak.netif)) (* >>= fun () ->
+                                                                                Time.sleep_ns (Duration.of_sec 5) *)
+
+let input_single_unicast () =
+  two_arp () >>= fun (listen, speak) ->
+  (* contrive to make a reply packet for the listener to hear *)
+  let for_listener =
+    arp_reply
+      ~from_netif:speak.netif ~to_netif:listen.netif
+      ~from_ip:first_ip ~to_ip:second_ip
+  in
+  let listener = start_arp_listener listen () in
+  timeout ~time:500 (
+  Lwt.choose [
+    (V.listen listen.netif ~header_size listener >|= fun _ -> ());
+    Mirage_sleep.ns (Duration.of_ms 2) >>= fun () ->
+    E.write speak.ethif (V.mac listen.netif) `ARP ~size for_listener >>= fun _ ->
+    query_and_no_response listen.arp first_ip
+  ])
+
+let input_resolves_wait () =
+  two_arp () >>= fun (listen, speak) ->
+  (* contrive to make a reply packet for the listener to hear *)
+  let for_listener = arp_reply ~from_netif:speak.netif ~to_netif:listen.netif
+                         ~from_ip:first_ip ~to_ip:second_ip in
+  (* initiate query when the cache is empty.  On resolution, fail for a timeout
+     and test the MAC if resolution was successful, then disconnect the
+     listening interface to ensure the test terminates.
+     Fail with a timeout message if the whole thing takes more than 5s. *)
+  let listener = start_arp_listener listen () in
+  let query_then_disconnect =
+    query_or_die listen.arp first_ip (V.mac speak.netif) >>= fun () ->
+    V.disconnect listen.netif
+  in
+  timeout ~time:5000 (
+    Lwt.join [
+      (V.listen listen.netif ~header_size listener >|= fun _ -> ());
+      query_then_disconnect;
+      Mirage_sleep.ns (Duration.of_ms 1) >>= fun () ->
+      E.write speak.ethif (V.mac listen.netif) `ARP ~size for_listener >|= function
+      | Ok x -> x
+      | Error _ -> failf "ethernet write failed"
+    ]
+  )
+
+let unreachable_times_out () =
+  get_arp () >>= fun speak ->
+  A.query speak.arp first_ip >>= function
+  | Ok _ -> failf "query claimed success when impossible for %a" Ipaddr.V4.pp first_ip
+  | Error `Timeout -> Lwt.return_unit
+  | Error e -> failf "error waiting for a timeout: %a" A.pp_error e
+
+let input_replaces_old () =
+  three_arp () >>= fun (listen, claimant_1, claimant_2) ->
+  (* query for IP to accept responses *)
+  Lwt.async (fun () -> A.query listen.arp first_ip >|= ignore) ;
+  Lwt.async (fun () ->
+      Log.debug (fun f -> f "arp listener started");
+      V.listen listen.netif ~header_size (start_arp_listener listen ()) >|= fun _ -> ());
+  timeout ~time:2000 (
+    set_and_check ~listener:listen.arp ~claimant:claimant_1 first_ip >>= fun () ->
+    set_and_check ~listener:listen.arp ~claimant:claimant_2 first_ip >>= fun () ->
+    V.disconnect listen.netif
+    )
+
+let os_linux_bsd () =
+  let cmd = Bos.Cmd.(v "uname" % "-s") in
+  match Bos.OS.Cmd.(run_out cmd |> out_string |> success) with
+  | Ok s when s = "FreeBSD" -> true
+  | Ok s when s = "Linux" -> true
+  | Ok _ -> false
+  | Error _ -> false
+
+let entries_expire () =
+  (* this test fails on windows and macOS for unknown reasons. please, if you
+     happen to have your hands on such a machine, investigate the issue. *)
+  if not (os_linux_bsd ()) then
+    Lwt.return_unit
+  else
+    two_arp () >>= fun (listen, speak) ->
+    A.set_ips listen.arp [ second_ip ] >>= fun () ->
+    (* here's what we expect listener to emit once its cache entry has expired *)
+    let expected_arp_query =
+      Arp_packet.({operation = Request;
+                   source_mac = V.mac listen.netif;
+                   target_mac = Macaddr.broadcast;
+                   source_ip = second_ip; target_ip = first_ip})
+    in
+    (* query for IP to accept responses *)
+    Lwt.async (fun () -> A.query listen.arp first_ip >|= ignore) ;
+    Lwt.async (fun () -> V.listen listen.netif ~header_size (start_arp_listener listen ()) >|= fun _ -> ());
+    let test =
+      Mirage_sleep.ns (Duration.of_ms 10) >>= fun () ->
+      set_and_check ~listener:listen.arp ~claimant:speak first_ip >>= fun () ->
+      (* sleep for 5s to make sure we hit `tick` often enough *)
+      Mirage_sleep.ns (Duration.of_sec 5) >>= fun () ->
+      (* asking now should generate a query *)
+      not_in_cache ~listen:speak.netif expected_arp_query listen.arp first_ip
+    in
+    timeout ~time:7000 test
+
+(* RFC isn't strict on how many times to try, so we'll just say any number
+   greater than 1 is fine *)
+let query_retries () =
+  two_arp () >>= fun (listen, speak) ->
+  let expected_query = Arp_packet.({source_mac = V.mac speak.netif;
+                                    target_mac = Macaddr.broadcast;
+                                    source_ip = Ipaddr.V4.any;
+                                    target_ip = first_ip;
+                                    operation = Request;})
+  in
+  let how_many = ref 0 in
+  let listener buf =
+    check_ethif_response expected_query buf;
+    if !how_many = 0 then begin
+      how_many := !how_many + 1;
+      Lwt.return_unit
+    end else V.disconnect listen.netif
+  in
+  let ask () =
+    A.query speak.arp first_ip >>= function
+    | Error e -> failf "Received error before >1 query: %a" A.pp_error e
+    | Ok _ -> failf "got result from query for %a, erroneously" Ipaddr.V4.pp first_ip
+  in
+  Lwt.pick [
+    (V.listen listen.netif ~header_size listener >|= fun _ -> ());
+    Mirage_sleep.ns (Duration.of_ms 2) >>= ask;
+    Mirage_sleep.ns (Duration.of_sec 6) >>= fun () ->
+    fail "query didn't succeed or fail within 6s"
+  ]
+
+(* requests for us elicit a reply *)
+let requests_are_responded_to () =
+  let (answerer_ip, inquirer_ip) = (first_ip, second_ip) in
+  two_arp () >>= fun (inquirer, answerer) ->
+  (* neither has a listener set up when we set IPs, so no GARPs in the cache *)
+  A.add_ip answerer.arp answerer_ip >>= fun () ->
+  A.add_ip inquirer.arp inquirer_ip >>= fun () ->
+  let request = arp_request ~from_netif:inquirer.netif ~to_mac:Macaddr.broadcast
+      ~from_ip:inquirer_ip ~to_ip:answerer_ip
+  in
+  let expected_reply =
+    Arp_packet.({ operation = Reply;
+                  source_mac = V.mac answerer.netif;
+                  target_mac = V.mac inquirer.netif;
+                  source_ip = answerer_ip; target_ip = inquirer_ip})
+  in
+  let listener close_netif buf =
+    check_ethif_response expected_reply buf;
+    V.disconnect close_netif
+  in
+  let arp_listener =
+    V.listen answerer.netif ~header_size (start_arp_listener answerer ()) >|= fun _ -> ()
+  in
+  timeout ~time:1000 (
+    Lwt.join [
+      (* listen for responses and check them against an expected result *)
+      (V.listen inquirer.netif ~header_size (listener inquirer.netif) >|= fun _ -> ());
+      (* start the usual ARP listener, which should respond to requests *)
+      arp_listener;
+      (* send a request for the ARP listener to respond to *)
+      Mirage_sleep.ns (Duration.of_ms 100) >>= fun () ->
+      E.write inquirer.ethif Macaddr.broadcast `ARP ~size request >>= fun _ ->
+      Mirage_sleep.ns (Duration.of_ms 100) >>= fun () ->
+      V.disconnect answerer.netif
+    ];
+  )
+
+let requests_not_us () =
+  let (answerer_ip, inquirer_ip) = (first_ip, second_ip) in
+  two_arp () >>= fun (answerer, inquirer) ->
+  A.add_ip answerer.arp answerer_ip >>= fun () ->
+  A.add_ip inquirer.arp inquirer_ip >>= fun () ->
+  let ask ip buf =
+    let open Arp_packet in
+    encode_into
+      { operation = Request;
+        source_mac = V.mac inquirer.netif; target_mac = Macaddr.broadcast;
+        source_ip = inquirer_ip; target_ip = ip }
+      buf ;
+    size
+  in
+  let requests = List.map ask [ inquirer_ip; Ipaddr.V4.any;
+                                Ipaddr.V4.of_string_exn "255.255.255.255" ] in
+  let make_requests =
+    Lwt_list.iter_s (fun b -> E.write inquirer.ethif Macaddr.broadcast `ARP ~size b >|= fun _ -> ())
+      requests
+  in
+  let disconnect_listeners () =
+    Lwt_list.iter_s (V.disconnect) [answerer.netif; inquirer.netif]
+  in
+  Lwt.join [
+    (V.listen answerer.netif ~header_size (start_arp_listener answerer ()) >|= fun _ -> ());
+    (V.listen inquirer.netif ~header_size (fail_on_receipt inquirer.netif) >|= fun _ -> ());
+    make_requests >>= fun _ ->
+    Mirage_sleep.ns (Duration.of_ms 100) >>=
+    disconnect_listeners
+  ]
+
+let nonsense_requests () =
+  let (answerer_ip, inquirer_ip) = (first_ip, second_ip) in
+  three_arp () >>= fun (answerer, inquirer, checker) ->
+  A.set_ips answerer.arp [ answerer_ip ] >>= fun () ->
+  let request number arp =
+    let open Arp_packet in
+    encode_into
+      { operation = Request;
+	source_mac = V.mac inquirer.netif;
+	target_mac = Macaddr.broadcast;
+	source_ip = inquirer_ip;
+	target_ip = answerer_ip } arp ;
+    Cstruct.BE.set_uint16 arp 6 number;
+    Arp_packet.size
+  in
+  let requests = List.map request [0; 3; -1; 255; 256; 257; 65536] in
+  let make_requests =
+    Lwt_list.iter_s (fun l -> E.write inquirer.ethif Macaddr.broadcast `ARP ~size l >|= fun _ -> ()) requests in
+  let expected_probe = Arp_packet.{ operation = Request;
+                                    source_mac = V.mac answerer.netif;
+                                    source_ip = answerer_ip;
+                                    target_mac = Macaddr.broadcast;
+                                    target_ip = inquirer_ip; }
+  in
+  Lwt.async (fun () -> V.listen answerer.netif ~header_size (start_arp_listener answerer ()) >|= fun _ -> ());
+  timeout ~time:1000 (
+    Lwt.join [
+      (V.listen inquirer.netif ~header_size (fail_on_receipt inquirer.netif) >|= fun _ -> ());
+      make_requests >>= fun () ->
+      V.disconnect inquirer.netif >>= fun () ->
+      (* not sufficient to just check to see whether we've replied; it's equally
+         possible that we erroneously make a cache entry.  Make sure querying
+         inquirer_ip results in an outgoing request. *)
+      not_in_cache ~listen:checker.netif expected_probe answerer.arp inquirer_ip
+    ] )
+
+let packet () =
+  let first_mac  = Macaddr.of_string_exn "10:9a:dd:01:23:45" in
+  let second_mac = Macaddr.of_string_exn "00:16:3e:ab:cd:ef" in
+  let example_request =
+    Arp_packet.{ operation = Request;
+                 source_mac = first_mac;
+                 target_mac = second_mac;
+                 source_ip = first_ip;
+                 target_ip = second_ip;
+               }
+  in
+  let marshalled = Arp_packet.encode example_request in
+  match Arp_packet.decode marshalled with
+  | Error _ -> Alcotest.fail "couldn't unmarshal something we made ourselves"
+  | Ok unmarshalled ->
+    Alcotest.(check packet) "serialize/deserialize" example_request unmarshalled;
+    Lwt.return_unit
+
+let suite =
+  [
+    "conversions neither lose nor gain information", `Quick, packet;
+    "nonsense requests are ignored", `Quick, nonsense_requests;
+    "requests are responded to", `Quick, requests_are_responded_to;
+    "entries expire", `Quick, entries_expire;
+    "irrelevant requests are ignored", `Quick, requests_not_us;
+    "set_ip sets ip, sends GARP", `Quick, set_ip_sends_garp;
+    "add_ip, get_ip and remove_ip as advertised", `Quick, add_get_remove_ips;
+    "GARPs are heard and not cached", `Quick, input_single_garp;
+    "unsolicited unicast replies are heard and not cached", `Quick, input_single_unicast;
+    "solicited unicast replies resolve pending threads", `Quick, input_resolves_wait;
+    "entries are replaced with new information", `Quick, input_replaces_old;
+    "unreachable IPs time out", `Quick, unreachable_times_out;
+    "queries are tried repeatedly before timing out", `Quick, query_retries;
+  ]
+
+let run test () =
+  Lwt_main.run (test ())
+
+let () =
+  (* enable logging to stdout for all modules *)
+  Logs.set_reporter (Logs_fmt.reporter ());
+  Logs.set_level ~all:true (Some Logs.Debug);
+  let suite =
+    [ "arp", List.map (fun (d, s, f) -> d, s, run f) suite ]
+  in
+  Alcotest.run "arp" suite

unikernel/duniverse/arp/test/tests.ml

@@ -0,0 +1,878 @@
+let generate n =
+  let data = Cstruct.create n in
+  for i = 0 to pred n do
+    Cstruct.set_uint8 data i (Random.int 256)
+  done;
+  data
+
+let rec gen_ip () =
+  let buf = generate 4 in
+  let ip = Ipaddr.V4.of_octets_exn (Cstruct.to_string buf) in
+  if ip = Ipaddr.V4.any || ip = Ipaddr.V4.broadcast then
+    gen_ip ()
+  else
+    buf, ip
+
+let rec gen_mac () =
+  let buf = generate 6 in
+  let mac = Macaddr.of_octets_exn (Cstruct.to_string buf) in
+  if mac = Macaddr.broadcast then
+    gen_mac ()
+  else
+    buf, mac
+
+let hdr = Cstruct.of_string "\000\001\008\000\006\004"
+
+let gen_int () =
+  let buf = generate 1 in
+  (buf, Cstruct.get_uint8 buf 0)
+
+let gen_op () =
+  let _, op = gen_int () in
+  let buf = Cstruct.create 2 in
+  let op = 1 + op mod 2 in
+  Cstruct.BE.set_uint16 buf 0 op ;
+  (if op = 1 then Arp_packet.Request else Arp_packet.Reply), buf
+
+let gen_arp () =
+  let sm, source_mac = gen_mac ()
+  and si, source_ip = gen_ip ()
+  and tm, target_mac = gen_mac ()
+  and ti, target_ip = gen_ip ()
+  and op, opb = gen_op ()
+  in
+  { Arp_packet.operation = op ; source_mac ; source_ip ; target_mac ; target_ip },
+  Cstruct.concat [ hdr ; opb ; sm ; si ; tm ; ti ]
+
+let p =
+  let module M = struct
+    type t = Arp_packet.t
+    let pp = Arp_packet.pp
+    let equal s t =
+        let open Arp_packet in
+        s.operation = t.operation &&
+        Macaddr.compare s.source_mac t.source_mac = 0 &&
+        Macaddr.compare s.target_mac t.target_mac = 0 &&
+        Ipaddr.V4.compare s.source_ip t.source_ip = 0 &&
+        Ipaddr.V4.compare s.target_ip t.target_ip = 0
+  end in
+  (module M : Alcotest.TESTABLE with type t = M.t)
+
+module Coding = struct
+  let gen_op_arp () =
+    let rec gen_op () =
+      let buf = generate 2 in
+      match Cstruct.BE.get_uint16 buf 0 with
+      | 1 | 2 -> gen_op ()
+      | x -> (x, buf)
+    in
+    let data = generate 20
+    and o, opb = gen_op ()
+    in
+    o, Cstruct.concat [ hdr ; opb ; data ]
+
+  let rec gen_unhandled_arp () =
+    (* some consistency -- hlen and plen *)
+    let htype = generate 2
+    and ptype = generate 2
+    in
+    (* if we don't have at least length m, we'll end up in Too_short *)
+    let rec i_min m () =
+      let buf, len = gen_int () in
+      if len < m then i_min m ()
+      else buf, len
+    in
+    let hl, hlen = i_min 6 ()
+    and pl, plen = i_min 4 ()
+    in
+    let my_hdr = Cstruct.concat [ htype ; ptype ; hl ; pl ] in
+    if Cstruct.equal my_hdr hdr then
+      gen_unhandled_arp ()
+    else
+      let rec gen_op () =
+        let buf = generate 2 in
+        match Cstruct.BE.get_uint16 buf 0 with
+        | 1 | 2 -> gen_op ()
+        | _ -> buf
+      in
+      let op = gen_op ()
+      and sha = generate hlen
+      and tha = generate hlen
+      and spa = generate plen
+      and tpa = generate plen
+      in
+      Cstruct.concat [ my_hdr ; op ; sha ; spa ; tha ; tpa ]
+
+  let gen_short_arp () =
+    let _, l = gen_int () in
+    generate (l mod 28)
+
+  let e =
+    let module M = struct
+      type t = Arp_packet.error
+      let pp = Arp_packet.pp_error
+      let equal a b =
+        let open Arp_packet in
+        match a, b with
+        | Too_short, Too_short -> true
+        | Unusable, Unusable -> true
+        | Unknown_operation x, Unknown_operation y -> x = y
+        | _ -> false
+    end in
+    (module M : Alcotest.TESTABLE with type t = M.t)
+
+  let repeat f n () =
+    for _i = 0 to n do
+      f ()
+    done
+
+  let check_r s res buf =
+    Alcotest.(check (result p e) s res (Arp_packet.decode buf))
+
+  let dec_valid_arp () =
+    let pkt, buf = gen_arp () in
+    check_r "decoding valid ARP frames" (Ok pkt) buf
+
+  let dec_unhandled_arp () =
+    let buf = gen_unhandled_arp () in
+    check_r "invalid header is error" (Error Arp_packet.Unusable) buf
+
+  let dec_short_arp () =
+    let buf = gen_short_arp () in
+    check_r "short is error" (Error Arp_packet.Too_short) buf
+
+  let dec_op_arp () =
+    let o, buf = gen_op_arp () in
+    check_r "invalid op is error" (Error (Arp_packet.Unknown_operation o)) buf
+
+  let dec_enc () =
+    let pkt, buf = gen_arp () in
+    let cbuf = Arp_packet.encode pkt in
+    Alcotest.(check bool "encoding produces same buffer" true (Cstruct.equal buf cbuf)) ;
+    match Arp_packet.decode buf with
+    | Error _ -> Alcotest.fail "decoding failed, should not happen"
+    | Ok pack ->
+      Alcotest.(check p "decoding worked" pkt pack) ;
+      let cbuf = Arp_packet.encode pack in
+      Alcotest.(check bool "encoding produces same buffer" true (Cstruct.equal buf cbuf))
+
+  let enc_into () =
+    let pkt, buf = gen_arp () in
+    let cbuf = Cstruct.create 28 in
+    Arp_packet.encode_into pkt cbuf ;
+    Alcotest.(check bool "encode_into works" true (Cstruct.equal cbuf buf))
+
+  let enc_fail () =
+    for i = 0 to 27 do
+      let buf = Cstruct.create i
+      and pkg, _ = gen_arp ()
+      in
+      Alcotest.check_raises "buffer is too small" (Invalid_argument "too small")
+        (fun () ->
+           try Arp_packet.encode_into pkg buf with Invalid_argument _ -> invalid_arg "too small")
+    done
+
+  let coder_tsts = [
+    "valid arp decoding", `Quick, (repeat dec_valid_arp 1000) ;
+    "unhandled arp decoding", `Quick, (repeat dec_unhandled_arp 1000) ;
+    "short arp decoding", `Quick, (repeat dec_short_arp 1000) ;
+    "invalid operation decoding", `Quick, (repeat dec_op_arp 1000) ;
+    "decoding is inverse of encoding", `Quick, (repeat dec_enc 1000) ;
+    "encode_into works", `Quick, (repeat enc_into 1000) ;
+    "encode_into fails with small bufs", `Quick, enc_fail ;
+  ]
+end
+
+module Handling = struct
+  let garp_of ip mac =
+    let mac0 = Macaddr.of_octets_exn (String.make 6 '\000') in
+    { Arp_packet.operation = Arp_packet.Request ;
+      source_ip = ip ; target_ip = ip ;
+      source_mac = mac ; target_mac = mac0 }
+
+  let gen_ip () = snd (gen_ip ())
+  and gen_mac () = snd (gen_mac ())
+
+  let m =
+    let module M = struct
+      type t = Macaddr.t
+      let pp = Macaddr.pp
+      let equal a b = Macaddr.compare a b = 0
+    end in
+    (module M : Alcotest.TESTABLE with type t = M.t)
+
+  let i =
+    let module M = struct
+      type t = Ipaddr.V4.t
+      let pp = Ipaddr.V4.pp
+      let equal a b = Ipaddr.V4.compare a b = 0
+    end in
+    (module M : Alcotest.TESTABLE with type t = M.t)
+
+  let create_raises () =
+    let mac = gen_mac () in
+    Alcotest.check_raises "timeout <= 0" (Invalid_argument "timeout must be strictly positive")
+      (fun () -> ignore(Arp_handler.create ~timeout:0 mac)) ;
+    Alcotest.check_raises "retries < 0" (Invalid_argument "retries must be positive")
+      (fun () -> ignore(Arp_handler.create ~retries:(-1) mac))
+
+  let basic_good () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, garp = Arp_handler.create ~ipaddr mac in
+    let garp = match garp with
+      | None -> Alcotest.fail "expected some garp"
+      | Some garp -> garp
+    in
+    Alcotest.(check bool "create has good GARP" true
+                (Cstruct.equal (Arp_packet.encode (garp_of ipaddr mac))
+                   (Arp_packet.encode (fst garp)))) ;
+    Alcotest.(check (list i) "ip is sensible" [ipaddr] (Arp_handler.ips t)) ;
+    Alcotest.(check (option m) "own entry is in cache"
+                (Some mac) (Arp_handler.in_cache t ipaddr)) ;
+    Alcotest.(check (option m) "any is not in cache" None
+                (Arp_handler.in_cache t Ipaddr.V4.any)) ;
+    Alcotest.(check (option m) "broadcast is not in cache" None
+                (Arp_handler.in_cache t Ipaddr.V4.broadcast))
+
+  let remove_good () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~ipaddr mac in
+    Alcotest.(check (list i) "ip is sensible" [ipaddr] (Arp_handler.ips t)) ;
+    Alcotest.(check (option m) "own entry is in cache"
+                (Some mac) (Arp_handler.in_cache t ipaddr)) ;
+    let t = Arp_handler.remove t ipaddr in
+    Alcotest.(check (option m) "own entry is no longer in cache" None
+                (Arp_handler.in_cache t ipaddr))
+
+  let remove_no () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~ipaddr mac in
+    Alcotest.(check (list i) "ip is sensible" [ipaddr] (Arp_handler.ips t)) ;
+    Alcotest.(check (option m) "own entry is in cache"
+                (Some mac) (Arp_handler.in_cache t ipaddr)) ;
+    let t = Arp_handler.remove t Ipaddr.V4.any in
+    Alcotest.(check (option m) "own entry is still in cache" (Some mac)
+                (Arp_handler.in_cache t ipaddr))
+
+  let alias_good () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~ipaddr mac in
+    Alcotest.(check (list i) "ip is sensible" [ipaddr] (Arp_handler.ips t)) ;
+    Alcotest.(check (option m) "own entry is in cache"
+                (Some mac) (Arp_handler.in_cache t ipaddr)) ;
+    let t, _, _ = Arp_handler.alias t ipaddr in
+    Alcotest.(check (option m) "own entry is still in cache" (Some mac)
+                (Arp_handler.in_cache t ipaddr)) ;
+    let ip' = gen_ip () in
+    let t, _, _ = Arp_handler.alias t ip' in
+    Alcotest.(check (option m) "own entry is still in cache" (Some mac)
+                (Arp_handler.in_cache t ipaddr)) ;
+    Alcotest.(check (option m) "aliased entry is in cache" (Some mac)
+                (Arp_handler.in_cache t ip'))
+
+  let alias_remove_inverse () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~ipaddr mac in
+    let ip' = gen_ip () in
+    let t, _, _ = Arp_handler.alias t ip' in
+    Alcotest.(check (option m) "own entry is in cache" (Some mac)
+                (Arp_handler.in_cache t ipaddr)) ;
+    Alcotest.(check (option m) "aliased entry is in cache" (Some mac)
+                (Arp_handler.in_cache t ip')) ;
+    let t = Arp_handler.remove t ip' in
+    Alcotest.(check (option m) "aliased entry is no longer in cache" None
+                (Arp_handler.in_cache t ip'))
+
+  let static_good () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~ipaddr mac in
+    let ip' = gen_ip () in
+    let mac' = gen_mac () in
+    let t, _ = Arp_handler.static t ip' mac' in
+    Alcotest.(check (option m) "own entry is in cache" (Some mac)
+                (Arp_handler.in_cache t ipaddr)) ;
+    Alcotest.(check (option m) "static entry is in cache" (Some mac')
+                (Arp_handler.in_cache t ip')) ;
+    let t = Arp_handler.remove t ip' in
+    Alcotest.(check (option m) "static entry is no longer in cache" None
+                (Arp_handler.in_cache t ip'))
+
+  let static_alias_good () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~ipaddr mac in
+    let ip' = gen_ip () in
+    let mac' = gen_mac () in
+    let t, _ = Arp_handler.static t ip' mac' in
+    Alcotest.(check (option m) "own entry is in cache" (Some mac)
+                (Arp_handler.in_cache t ipaddr)) ;
+    Alcotest.(check (option m) "static entry is in cache" (Some mac')
+                (Arp_handler.in_cache t ip')) ;
+    let t, _, _ = Arp_handler.alias t ip' in
+    Alcotest.(check (option m) "alias entry overwrote static one" (Some mac)
+                (Arp_handler.in_cache t ip')) ;
+    let t, _ = Arp_handler.static t ip' mac' in
+    Alcotest.(check (option m) "static entry overwrite aliased one" (Some mac')
+                (Arp_handler.in_cache t ip')) ;
+    let t = Arp_handler.remove t ip' in
+    Alcotest.(check (option m) "static entry is no longer in cache" None
+                (Arp_handler.in_cache t ip'))
+
+  let more_good () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~ipaddr mac in
+    let rec more_entries acc t = function
+      | 0 -> acc, t
+      | n ->
+        let ip' = gen_ip () in
+        if List.mem ip' (List.map fst acc) then
+          more_entries acc t n
+        else
+          let t, e =
+            if n mod 2 = 0 then
+              let mac' = gen_mac () in
+              let t, _ = Arp_handler.static t ip' mac' in
+              (t, (ip', mac'))
+            else
+              let t, _, _ = Arp_handler.alias t ip' in
+              (t, (ip', mac))
+          in
+          more_entries (e::acc) t (pred n)
+    in
+    let acc, t = more_entries [(ipaddr,mac)] t 100 in
+    List.iter (fun (ip, mac) ->
+        Alcotest.(check (option m) "entry is in cache" (Some mac)
+                    (Arp_handler.in_cache t ip)))
+      acc ;
+    List.iter (fun (ip, _) ->
+        let t = Arp_handler.remove t ip in
+        Alcotest.(check (option m) "entry is no longer in cache" None
+                    (Arp_handler.in_cache t ip)))
+      acc ;
+    let t = List.fold_left (fun t (ip, _) -> Arp_handler.remove t ip) t acc in
+    Alcotest.(check (option m) "own entry is no longer in cache" None
+                (Arp_handler.in_cache t ipaddr))
+
+  let packet =
+    let module M = struct
+      type t = Arp_packet.t
+      let pp = Arp_packet.pp
+      let equal = Arp_packet.equal
+    end in
+    (module M : Alcotest.TESTABLE with type t = M.t)
+
+  let out =
+    let module M = struct
+      type t = Arp_packet.t * Macaddr.t
+      let pp ppf (cs, mac) =
+        Format.fprintf ppf "out: %a to %a" Arp_packet.pp cs Macaddr.pp mac
+      let equal (acs, amac) (bcs, bmac) =
+        Arp_packet.equal acs bcs && Macaddr.compare amac bmac = 0
+    end in
+    (module M : Alcotest.TESTABLE with type t = M.t)
+
+  let qres =
+    let module M = struct
+      type t = int list Arp_handler.qres
+      let pp ppf = function
+        | Arp_handler.Mac mac -> Format.fprintf ppf "ok %a" Macaddr.pp mac
+        | Arp_handler.RequestWait ((cs, mac), xs) ->
+          Format.fprintf ppf "requestwait %a to %a, wait %s"
+            Arp_packet.pp cs Macaddr.pp mac
+            (String.concat ", " (List.map string_of_int xs))
+        | Arp_handler.Wait xs ->
+          Format.fprintf ppf "wait %s"
+            (String.concat ", " (List.map string_of_int xs))
+      let equal a b = match a, b with
+        | Arp_handler.Mac a, Arp_handler.Mac b -> Macaddr.compare a b = 0
+        | Arp_handler.RequestWait ((csa, maca), xsa),
+          Arp_handler.RequestWait ((csb, macb), xsb) ->
+          Arp_packet.equal csa csb && Macaddr.compare maca macb = 0 &&
+          List.length xsa = List.length xsb &&
+          List.for_all (fun x -> List.mem x xsb) xsa
+        | Arp_handler.Wait xsa, Arp_handler.Wait xsb ->
+          List.length xsa = List.length xsb &&
+          List.for_all (fun x -> List.mem x xsb) xsa
+        |  _ -> false
+    end in
+    (module M : Alcotest.TESTABLE with type t = M.t)
+
+  let merge v = function
+    | None -> [v]
+    | Some xs -> v::xs
+
+  let handle_good () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~ipaddr mac in
+    let _t, res = Arp_handler.query t ipaddr (merge 1) in
+    Alcotest.check qres "own IP can be queried" (Arp_handler.Mac mac) res
+
+  let query source_mac source_ip target_ip =
+    { Arp_packet.operation = Arp_packet.Request ;
+      source_mac ; source_ip ;
+      target_mac = Macaddr.broadcast ; target_ip },
+    Macaddr.broadcast
+
+  let handle_gen_request () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~retries:1 ~ipaddr mac in
+    let other = gen_ip () in
+    let _, res = Arp_handler.query t other (merge 1) in
+    let out = query mac ipaddr other in
+    Alcotest.check qres "res is requestwait" (Arp_handler.RequestWait (out, [1])) res
+
+  let handle_gen_request_twice () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~ipaddr ~retries:1 mac in
+    let other = gen_ip () in
+    let t, res = Arp_handler.query t other (merge 1) in
+    let out = query mac ipaddr other in
+    Alcotest.check qres "res is requestwait" (Arp_handler.RequestWait (out, [1])) res ;
+    let _, res = Arp_handler.query t other (merge 2) in
+    Alcotest.check qres "res is wait" (Arp_handler.Wait [2;1]) res
+
+  let alias_wakes () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~ipaddr mac in
+    let other = gen_ip () in
+    let t, res = Arp_handler.query t other (merge 1) in
+    let out = query mac ipaddr other in
+    Alcotest.check qres "res is requestwait!" (Arp_handler.RequestWait (out, [1])) res ;
+    Alcotest.(check (option m) "query is not cache" None (Arp_handler.in_cache t other)) ;
+    let _, _, a = Arp_handler.alias t other in
+    Alcotest.(check (option (list int)) "alias wakes up" (Some [1]) a)
+
+  let static_wakes () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~ipaddr mac in
+    let other = gen_ip () in
+    let t, res = Arp_handler.query t other (merge 1) in
+    let out = query mac ipaddr other in
+    Alcotest.check qres "res is requestwait" (Arp_handler.RequestWait (out, [1])) res ;
+    let _, a = Arp_handler.static t other mac in
+    Alcotest.(check (option (list int)) "alias wakes up" (Some [1]) a)
+
+  let handle_timeout () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~retries:1 ~ipaddr mac in
+    let other = gen_ip () in
+    let t, _ = Arp_handler.query t other (merge 1) in
+    let t, _, a = Arp_handler.tick t in
+    Alcotest.(check (list (list int)) "tick didn't timeout" [] a) ;
+    let _, _, a = Arp_handler.tick t in
+    Alcotest.(check (list (list int)) "tick timed out" [[1]] a)
+
+  let req_before_timeout () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in
+    let other = gen_ip () in
+    let t, _ = Arp_handler.query t other (merge 1) in
+    let omac = gen_mac () in
+    let pkt =
+      Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ;
+                          source_ip = other ; source_mac = omac ;
+                          target_ip = ipaddr ; target_mac = mac }
+    in
+    let t, outp, wake = Arp_handler.input t pkt in
+    Alcotest.(check (option out) "out is none" None outp) ;
+    Alcotest.(check (option (pair m (list int))) "wake is correct"
+                (Some (omac, [1])) wake) ;
+    let _, outp, rs = Arp_handler.tick t in
+    Alcotest.(check bool "timeouts are empty" true (rs = [])) ;
+    Alcotest.(check (list out) "arp request is sent" [query mac ipaddr other] outp)
+
+  let multiple_reqs () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~retries:1 ~ipaddr mac in
+    let other = gen_ip () in
+    let t, res = Arp_handler.query t other (merge 1) in
+    let q = query mac ipaddr other in
+    Alcotest.check qres "query generates ARP request" (Arp_handler.RequestWait (q, [1])) res ;
+    let t, outs, touts = Arp_handler.tick t in
+    Alcotest.(check (list out) "tick generates second ARP request" [q] outs) ;
+    Alcotest.(check (list (list int)) "tick generated no timeout yet" [] touts) ;
+    let _, outs, touts = Arp_handler.tick t in
+    Alcotest.(check (list out) "tick generated no other request" [] outs) ;
+    Alcotest.(check (list (list int)) "tick generated a timeout" [[1]] touts)
+
+  let multiple_reqs_2 () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~retries:4 ~ipaddr mac in
+    let other = gen_ip () in
+    let t, res = Arp_handler.query t other (merge 1) in
+    let q = query mac ipaddr other in
+    Alcotest.check qres "query generates ARP request" (Arp_handler.RequestWait (q, [1])) res ;
+    let t, outs, touts = Arp_handler.tick t in
+    Alcotest.(check (list out) "tick generates second ARP request" [q] outs) ;
+    Alcotest.(check (list (list int)) "tick generated no timeout yet" [] touts) ;
+    let t, outs, touts = Arp_handler.tick t in
+    Alcotest.(check (list out) "tick generates third ARP request" [q] outs) ;
+    Alcotest.(check (list (list int)) "tick generated no timeout yet" [] touts) ;
+    let t, outs, touts = Arp_handler.tick t in
+    Alcotest.(check (list out) "tick generates fourth ARP request" [q] outs) ;
+    Alcotest.(check (list (list int)) "tick generated no timeout yet" [] touts) ;
+    let t, outs, touts = Arp_handler.tick t in
+    Alcotest.(check (list out) "tick generates fifth ARP request" [q] outs) ;
+    Alcotest.(check (list (list int)) "tick generated no timeout yet" [] touts) ;
+    let _, outs, touts = Arp_handler.tick t in
+    Alcotest.(check (list out) "tick generated no other request" [] outs) ;
+    Alcotest.(check (list (list int)) "tick generated a timeout" [[1]] touts)
+
+  let handle_reply () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in
+    let other = gen_ip () in
+    let omac = gen_mac () in
+    let pkt =
+      Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ;
+                          source_ip = other ; source_mac = omac ;
+                          target_ip = ipaddr ; target_mac = mac }
+    in
+    let t, outp, w = Arp_handler.input t pkt in
+    Alcotest.(check (option out) "nothing to be sent" None outp) ;
+    Alcotest.(check (option (pair m (list int))) "noone wakes up" None w) ;
+    Alcotest.(check (option m) "received entry is not in cache" None
+                (Arp_handler.in_cache t other))
+
+  let handle_garp () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in
+    let other = gen_ip () in
+    let omac = gen_mac () in
+    let pkt = Arp_packet.encode (garp_of other omac) in
+    let t, outp, w = Arp_handler.input t pkt in
+    Alcotest.(check (option out) "nothing out" None outp) ;
+    Alcotest.(check (option (pair m (list int))) "nothin woken up" None w) ;
+    Alcotest.(check (option m) "received garp entry is not in cache" None
+                (Arp_handler.in_cache t other))
+
+  let answer_req_broadcast () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in
+    let other = gen_ip () in
+    let omac = gen_mac () in
+    let pkt, _ = query omac other ipaddr in
+    let _, outp, w = Arp_handler.input t (Arp_packet.encode pkt) in
+    Alcotest.(check (option (pair m (list int))) "nothin woken up" None w) ;
+    Alcotest.(check (option out) "request to us provokes a reply"
+                (Some ({ Arp_packet.operation = Arp_packet.Reply ;
+                         source_mac = mac ; source_ip = ipaddr ;
+                         target_mac = omac ; target_ip = other },
+                       omac)) outp)
+
+  let answer_req_unicast () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in
+    let other = gen_ip () in
+    let omac = gen_mac () in
+    let pkt =
+      Arp_packet.encode { Arp_packet.operation = Arp_packet.Request ;
+                          source_ip = other ; source_mac = omac ;
+                          target_ip = ipaddr ; target_mac = mac }
+    in
+    let _, outp, w = Arp_handler.input t pkt in
+    Alcotest.(check (option (pair m (list int))) "nothin woken up" None w) ;
+    Alcotest.(check (option out) "request to us provokes a reply"
+                (Some ({ Arp_packet.operation = Arp_packet.Reply ;
+                         source_mac = mac ; source_ip = ipaddr ;
+                         target_mac = omac ; target_ip = other },
+                       omac)) outp)
+
+  let not_answer_req () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in
+    let other = gen_ip () in
+    let third = gen_ip () in
+    let omac = gen_mac () in
+    let pkt, _ = query omac other third in
+    let _, outp, w = Arp_handler.input t (Arp_packet.encode pkt) in
+    Alcotest.(check (option out) "nothing out" None outp) ;
+    Alcotest.(check (option (pair m (list int))) "nothin woken up" None w)
+
+  let ignoring_random () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in
+    let pkt = generate 24 in
+    let _, outp, w = Arp_handler.input t pkt in
+    Alcotest.(check (option out) "nothing out" None outp) ;
+    Alcotest.(check (option (pair m (list int))) "nothin woken up" None w)
+
+  let reply_does_not_override () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in
+    let omac = gen_mac () in
+    let pkt =
+      Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ;
+                          source_ip = ipaddr ; source_mac = omac ;
+                          target_ip = ipaddr ; target_mac = mac }
+    in
+    let t, outp, w = Arp_handler.input t pkt in
+    Alcotest.(check (option out) "nothing out" None outp) ;
+    Alcotest.(check (option (pair m (list int))) "nothin woken up" None w) ;
+    Alcotest.(check (option m) "our entry is still in cache" (Some mac)
+                (Arp_handler.in_cache t ipaddr))
+
+  let reply_query () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in
+    let other = gen_ip () in
+    let omac = gen_mac () in
+    let pkt =
+      Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ;
+                          source_ip = other ; source_mac = omac ;
+                          target_ip = ipaddr ; target_mac = mac }
+    in
+    let q = query mac ipaddr other in
+    let t, r = Arp_handler.query t other (merge 1) in
+    Alcotest.check qres "r is request wait" (Arp_handler.RequestWait (q, [1])) r ;
+    let t, outp, w = Arp_handler.input t pkt in
+    Alcotest.(check (option out) "nothing out" None outp) ;
+    Alcotest.(check (option (pair m (list int))) "something woken up" (Some (omac, [1])) w) ;
+    let _t, res = Arp_handler.query t other (merge 2) in
+    Alcotest.check qres "dynamic entry can be queried" (Arp_handler.Mac omac) res
+
+  let reply_in_cache () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in
+    let other = gen_ip () in
+    let omac = gen_mac () in
+    let pkt =
+      Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ;
+                          source_ip = other ; source_mac = omac ;
+                          target_ip = ipaddr ; target_mac = mac }
+    in
+    let q = query mac ipaddr other in
+    let t, r = Arp_handler.query t other (merge 1) in
+    Alcotest.check qres "r is request wait" (Arp_handler.RequestWait (q, [1])) r ;
+    let t, outp, w = Arp_handler.input t pkt in
+    Alcotest.(check (option out) "nothing out" None outp) ;
+    Alcotest.(check (option (pair m (list int))) "something woken up" (Some (omac, [1])) w) ;
+    Alcotest.(check (option m) "entry in cache" (Some omac) (Arp_handler.in_cache t other)) ;
+    Alcotest.(check (list i) "ips do not include dynamic entries" [ipaddr] (Arp_handler.ips t))
+
+
+  let reply_overriden () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in
+    let other = gen_ip () in
+    let omac = gen_mac () in
+    let pkt =
+      Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ;
+                          source_ip = other ; source_mac = omac ;
+                          target_ip = ipaddr ; target_mac = mac }
+    in
+    let q = query mac ipaddr other in
+    let t, r = Arp_handler.query t other (merge 1) in
+    Alcotest.check qres "r is request wait" (Arp_handler.RequestWait (q, [1])) r ;
+    let t, outp, w = Arp_handler.input t pkt in
+    Alcotest.(check (option out) "nothing out" None outp) ;
+    Alcotest.(check (option (pair m (list int))) "something woken up" (Some (omac, [1])) w) ;
+    Alcotest.(check (option m) "entry in cache" (Some omac) (Arp_handler.in_cache t other)) ;
+    let t, outp, w = Arp_handler.input t pkt in
+    Alcotest.(check (option out) "nothing out" None outp) ;
+    Alcotest.(check (option (pair m (list int))) "nothing woken up" None w) ;
+    Alcotest.(check (option m) "entry in cache" (Some omac) (Arp_handler.in_cache t other))
+
+  let reply_overriden_other () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in
+    let other = gen_ip () in
+    let omac = gen_mac () in
+    let pkt =
+      Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ;
+                          source_ip = other ; source_mac = omac ;
+                          target_ip = ipaddr ; target_mac = mac }
+    in
+    let q = query mac ipaddr other in
+    let t, r = Arp_handler.query t other (merge 1) in
+    Alcotest.check qres "r is request wait" (Arp_handler.RequestWait (q, [1])) r ;
+    let t, outp, w = Arp_handler.input t pkt in
+    Alcotest.(check (option out) "nothing out" None outp) ;
+    Alcotest.(check (option (pair m (list int))) "something woken up" (Some (omac, [1])) w) ;
+    Alcotest.(check (option m) "entry in cache" (Some omac) (Arp_handler.in_cache t other)) ;
+    let omac = gen_mac () in
+    let pkt =
+      Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ;
+                          source_ip = other ; source_mac = omac ;
+                          target_ip = ipaddr ; target_mac = mac }
+    in
+    let t, outp, w = Arp_handler.input t pkt in
+    Alcotest.(check (option out) "nothing out" None outp) ;
+    Alcotest.(check (option (pair m (list int))) "nothing woken up" None w) ;
+    Alcotest.(check (option m) "overriden entry in cache" (Some omac)
+                (Arp_handler.in_cache t other))
+
+  let reply_times_out () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in
+    let other = gen_ip () in
+    let omac = gen_mac () in
+    let pkt =
+      Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ;
+                          source_ip = other ; source_mac = omac ;
+                          target_ip = ipaddr ; target_mac = mac }
+    in
+    let q = query mac ipaddr other in
+    let t, r = Arp_handler.query t other (merge 1) in
+    Alcotest.check qres "r is request wait" (Arp_handler.RequestWait (q, [1])) r ;
+    let t, outp, w = Arp_handler.input t pkt in
+    Alcotest.(check (option out) "nothing out" None outp) ;
+    Alcotest.(check (option (pair m (list int))) "something woken up" (Some (omac, [1])) w) ;
+    Alcotest.(check (option m) "entry in cache" (Some omac) (Arp_handler.in_cache t other)) ;
+    let t, outp, timeout = Arp_handler.tick t in
+    Alcotest.(check (list out) "request sent" [q] outp) ;
+    Alcotest.(check (list (list int)) "nothing timed out" [] timeout) ;
+    let t, outp, timeout = Arp_handler.tick t in
+    Alcotest.(check (list out) "nada sent" [] outp) ;
+    Alcotest.(check (list (list int)) "nothing timed out" [] timeout) ;
+    Alcotest.(check (option m) "entry no longer in cache" None
+                (Arp_handler.in_cache t other))
+
+  let dyn_not_advertised () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in
+    let other = gen_ip () in
+    let omac = gen_mac () in
+    let pkt =
+      Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ;
+                          source_ip = other ; source_mac = omac ;
+                          target_ip = ipaddr ; target_mac = mac }
+    in
+    let q = query mac ipaddr other in
+    let t, r = Arp_handler.query t other (merge 1) in
+    Alcotest.check qres "r is request wait" (Arp_handler.RequestWait (q, [1])) r ;
+    let t, outp, w = Arp_handler.input t pkt in
+    Alcotest.(check (option out) "nothing out" None outp) ;
+    Alcotest.(check (option (pair m (list int))) "something woken up" (Some (omac, [1])) w) ;
+    let third = gen_ip ()
+    and third_mac = gen_mac ()
+    in
+    let q, _ = query third_mac third other in
+    let _, outp, w = Arp_handler.input t (Arp_packet.encode q) in
+    Alcotest.(check (option out) "request a dynamic entry is not answered" None outp) ;
+    Alcotest.(check (option (pair m (list int))) "nothing woken up" None w)
+
+  let handle_reply_wakesup () =
+    let mac = gen_mac ()
+    and ipaddr = gen_ip ()
+    in
+    let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in
+    let other = gen_ip () in
+    let omac = gen_mac () in
+    let pkt =
+      Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ;
+                          source_ip = other ; source_mac = omac ;
+                          target_ip = ipaddr ; target_mac = mac }
+    in
+    let q = query mac ipaddr other in
+    let t, r = Arp_handler.query t other (merge 1) in
+    Alcotest.check qres "r is request wait" (Arp_handler.RequestWait (q, [1])) r ;
+    let t, r = Arp_handler.query t other (merge 2) in
+    Alcotest.check qres "r is wait" (Arp_handler.Wait [2;1]) r ;
+    let _, outp, w = Arp_handler.input t pkt in
+    Alcotest.(check (option out) "nothing out" None outp) ;
+    Alcotest.(check (option (pair m (list int))) "something woken up" (Some (omac, [2;1])) w)
+
+  let handl_tsts = [
+    "create raises", `Quick, create_raises ;
+    "basic tests", `Quick, basic_good ;
+    "remove test", `Quick, remove_good ;
+    "remove no test", `Quick, remove_no ;
+    "alias test", `Quick, alias_good ;
+    "alias remove test", `Quick, alias_remove_inverse ;
+    "static test", `Quick, static_good ;
+    "static alias test", `Quick, static_alias_good ;
+    "more tests", `Quick, more_good ;
+    "handle good", `Quick, handle_good ;
+    "handle generates req", `Quick, handle_gen_request ;
+    "handle generates req, next doesn't", `Quick, handle_gen_request_twice ;
+    "alias wakes", `Quick, alias_wakes ;
+    "static wakes", `Quick, static_wakes ;
+    "handle timeout", `Quick, handle_timeout ;
+    "request send before timeout", `Quick, req_before_timeout ;
+    "multiple requests are send", `Quick, multiple_reqs ;
+    "multiple requests are send 2", `Quick, multiple_reqs_2 ;
+    "handle reply", `Quick, handle_reply ;
+    "handle garp", `Quick, handle_garp ;
+    "answers broadcast request", `Quick, answer_req_broadcast ;
+    "answers unicast request", `Quick, answer_req_unicast ;
+    "not answering random request", `Quick, not_answer_req ;
+    "ignoring random", `Quick, ignoring_random ;
+    "reply does not harm static entries", `Quick, reply_does_not_override ;
+    "reply is in cache", `Quick, reply_in_cache ;
+    "dynamic entry can be queried", `Quick, reply_query ;
+    "reply times out", `Quick, reply_times_out ;
+    "dynamic entry overriden by same", `Quick, reply_overriden ;
+    "dynamic entry overriden by other", `Quick, reply_overriden_other ;
+    "dynamic entry is not advertised", `Quick, dyn_not_advertised ;
+    "reply wakes tasks", `Quick, handle_reply_wakesup ;
+  ]
+end
+
+let tests = [
+  "Coder", Coding.coder_tsts ;
+  "Handler", Handling.handl_tsts ;
+]
+
+let () =
+  Random.self_init ();
+  Alcotest.run "ARP tests" tests