From f547caf3137b131b8e507951c1349614994c324b Mon Sep 17 00:00:00 2001 From: Sven Anderson Date: Wed, 5 Nov 2025 05:34:49 +0100 Subject: [PATCH 1/2] stabilize entries_expire in mirage tests This change stabilizes the `entries_expire` mirage test by removing timing dependencies, fixes it for CI environments with slow ticks (they seem to have up to ~20ms ticks) and re-enables it for all platforms again. --- test/mirage/tests.ml | 59 +++++++++++++++++++++++++------------------- 1 file changed, 34 insertions(+), 25 deletions(-) diff --git a/test/mirage/tests.ml b/test/mirage/tests.ml index 3980772..ba15952 100644 --- a/test/mirage/tests.ml +++ b/test/mirage/tests.ml @@ -312,7 +312,7 @@ let input_replaces_old () = V.disconnect listen.netif ) -let os_linux_bsd () = +let os_linux_freebsd () = 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 @@ -321,32 +321,41 @@ let os_linux_bsd () = | 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}) + 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 + (* start ARP listener that will stay active throughout the test *) + Lwt.async (fun () -> V.listen listen.netif ~header_size (start_arp_listener listen ()) >|= fun _ -> ()); + let for_listener = arp_reply ~from_netif:speak.netif ~to_netif:listen.netif + ~from_ip:first_ip ~to_ip:second_ip in + let establish_entry = + let query = A.query listen.arp first_ip >>= function + | Ok mac when Macaddr.compare mac (V.mac speak.netif) = 0 -> Lwt.return_unit + | Ok mac -> failf "got unexpected MAC %a, expected %a" + Macaddr.pp mac Macaddr.pp (V.mac speak.netif) + | Error e -> failf "query failed: %a" A.pp_error e 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 + let send_reply = + E.write speak.ethif (V.mac listen.netif) `ARP ~size for_listener >|= function + | Ok _ -> () + | Error _ -> failf "ethernet write failed" in - timeout ~time:7000 test + query >>= fun () -> send_reply + in + timeout ~time:1000 establish_entry >>= fun () -> + (* wait for cache entry to expire, entry is removed after timeout (800 ticks * + 2ms = 1600ms) from initial creation *) + (* CI for MacOS/OpenBSD/etc. has slower ticks, wait longer *) + let delay = if os_linux_freebsd () then 5 else 20 in + Mirage_sleep.ns (Duration.of_sec delay) >>= fun () -> + (* querying now should generate an ARP request since entry should be removed *) + timeout ~time:1000 (not_in_cache ~listen:speak.netif expected_arp_query listen.arp first_ip) (* RFC isn't strict on how many times to try, so we'll just say any number greater than 1 is fine *) From 21c6f077b7ce8450e7ebf8dc624ab6d01a3b266f Mon Sep 17 00:00:00 2001 From: Sven Anderson Date: Sun, 12 Oct 2025 20:25:54 +0200 Subject: [PATCH 2/2] improve ARP cache logic The old ARP cache implementation is very simple, and keeps entries of reachable but unused neighbors forever in the cache. Also it never probes if entries are still valid before the timeout is reached, which is by default a very long 20 minutes. Combined with the fact that gratuitous ARP requests for existing entries are accepted, this makes a simple DoS attack possible, that only recovers after these 20 minutes. This is an improved implementation of the ARP cache logic, which handles dynamic network changes a lot better. It is inspired by the NUD of IPv6, but a lot simpler. It only introduces two more cache entry states: Stale and Probing. After the `refresh` interval (default: 1 minute) a Dynamic entry goes into Stale state. If an entry changes its MAC address because of a gratuitous ARP request, it goes into Stale immediately. If a Stale entry is queried, it goes into Probing state, where it sends ARP requests similar to the Pending state, but as unicasts to the last known MAC address. If the probing is not successful, the entry is removed and further queries cause a normal broadcast request, otherwise it is replaced with a fresh Dynamic entry. If a Stale entry reaches `timeout` age (default 20 minutes), because it never has been queried, it is removed without further probing. Compared to the old implentation the default values create on the happy path only one more unicast ARP request per minute and ARP cache entry. --- src/arp_handler.ml | 100 +++++++++++++----- src/arp_handler.mli | 15 +-- test/mirage/tests.ml | 1 + test/tests.ml | 241 +++++++++++++++++++++++++++++++++++++++++-- 4 files changed, 314 insertions(+), 43 deletions(-) diff --git a/src/arp_handler.ml b/src/arp_handler.ml index d92cd0a..3a095e5 100644 --- a/src/arp_handler.ml +++ b/src/arp_handler.ml @@ -1,8 +1,10 @@ type 'a entry = | Static of Macaddr.t * bool - | Dynamic of Macaddr.t * int - | Pending of 'a * int + | Dynamic of Macaddr.t * int (* active dynamic entry *) + | Pending of 'a * int (* unresolved pending entry *) + | Stale of Macaddr.t * int (* stale dynamic entry *) + | Probing of Macaddr.t * int (* probing stale entry *) module M = struct module M = Map.Make(Ipaddr.V4) @@ -57,9 +59,10 @@ type 'a t = { cache : 'a M.t; mac : Macaddr.t ; ip : Ipaddr.V4.t ; - timeout : int ; - retries : int ; - epoch : int ; + timeout : int ; (* Stale entry expire interval in ticks *) + refresh : int ; (* Dynamic entry becomes stale interval in ticks *) + retries : int ; (* how many retries for ARP requests/probes *) + epoch : int ; (* current tick value *) logsrc : Logs.src } @@ -82,6 +85,12 @@ let[@coverage off] pp_entry now k pp = | Pending (_, retries) -> Format.fprintf pp "%a (incomplete, %d retries left)" Ipaddr.V4.pp k (retries - now) + | Stale (m, t) -> + Format.fprintf pp "%a at %a (stale, timeout in %d)" Ipaddr.V4.pp k + Macaddr.pp m (t - now) + | Probing (m, t) -> + Format.fprintf pp "%a at %a (probing, timeout in %d)" Ipaddr.V4.pp k + Macaddr.pp m (t - now) let[@coverage off] pp pp t = Format.fprintf pp "mac %a ip %a entries %d timeout %d retries %d@." @@ -113,7 +122,7 @@ let alias t ip = 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) +let create ?(cache_size=1024) ?(timeout = 800) ?(refresh = 40) ?(retries = 2) ?(logsrc = Logs.Src.create "arp" ~doc:"ARP handler") ?ipaddr mac = @@ -123,7 +132,7 @@ let create ?(cache_size=1024) ?(timeout = 800) ?(retries = 5) 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 + let t = { cache ; mac ; ip ; timeout ; refresh; retries ; epoch = 0 ; logsrc } in match ipaddr with | None -> t, None | Some ip -> @@ -144,9 +153,10 @@ let in_cache t ip = | Pending _ -> None | Static (m, _) -> Some m | Dynamic (m, _) -> Some m + | Stale (m, _) -> Some m + | Probing (m, _) -> Some m -let request t ip = - let target = Macaddr.broadcast in +let request t ?(target = Macaddr.broadcast) ip = let request = { Arp_packet.operation = Arp_packet.Request ; source_mac = t.mac ; source_ip = t.ip ; @@ -168,25 +178,42 @@ let tick t = 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)" + (fun pp -> pp "ARP entry %a (mac %a) timed out --> Stale" 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 + M.add k (Stale (m, t.epoch + t.timeout)) cache, 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 + | Pending (_, retry) -> + Logs.debug ~src:t.logsrc + (fun pp -> pp "resending ARP request for %a (%d left)" + Ipaddr.V4.pp k (retry - epoch)) ; + cache, request t k :: acc, r + | Stale (m, tick) when tick = epoch -> + Logs.debug ~src:t.logsrc + (fun pp -> pp "removing stale ARP entry %a (mac %a)" + Ipaddr.V4.pp k Macaddr.pp m) ; + M.remove k cache, acc, r + | Probing (m, retry) when retry = epoch -> + Logs.info ~src:t.logsrc + (fun pp -> pp "unicast ARP probe timeout after %d retries for %a/%a failed" + t.retries Ipaddr.V4.pp k Macaddr.pp m) ; + M.remove k cache, acc, r + | Probing (target, retry) -> + Logs.debug ~src:t.logsrc + (fun pp -> pp "sending unicast ARP probe for %a/%a (%d left)" + Ipaddr.V4.pp k Macaddr.pp target (retry - epoch)) ; + cache, request t ~target 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 + let update_cache () = + let cache = M.add source (Dynamic (mac, t.epoch + t.refresh)) t.cache in { t with cache } in match M.find source t.cache with @@ -205,16 +232,29 @@ let handle_reply t source mac = Ipaddr.V4.pp source (if adv then "advertised " else "")) [@coverage off] ; t, None, None - | Dynamic (m, _) -> - if Macaddr.compare mac m <> 0 then + | Dynamic (m, _) + | Stale (m, _) + | Probing (m, _) -> + let t = if Macaddr.compare mac m <> 0 then + let cache = M.add source (Stale (mac, t.epoch + t.timeout)) t.cache in Logs.warn ~src:t.logsrc - (fun pp -> pp "ARP for %a moved from %a to %a" + (fun pp -> pp "MAC address for %a moved from %a to %a, marked as stale" Ipaddr.V4.pp source Macaddr.pp m - Macaddr.pp mac) ; - extcache, None, None - | Pending (xs, _) -> extcache, None, Some (mac, xs) - + Macaddr.pp mac); + { t with cache } + else ( + Logs.debug ~src:t.logsrc + (fun pp -> pp "ARP reply received for %a/%a, refreshing cache entry" + Ipaddr.V4.pp source Macaddr.pp mac); + update_cache ()) + in + t, None, None + | Pending (xs, _) -> + Logs.debug ~src:t.logsrc + (fun pp -> pp "ARP reply received for %a/%a, adding cache entry" + Ipaddr.V4.pp source Macaddr.pp mac); + update_cache (), None, Some (mac, xs) let handle_request t arp = let dest = arp.Arp_packet.target_ip @@ -272,10 +312,20 @@ let query t ip a = | exception Not_found -> let a = a None in let cache = M.add ip (Pending (a, t.epoch + t.retries)) t.cache in + Logs.debug ~src:t.logsrc + (fun pp -> pp "sending ARP request for %a --> Pending" + Ipaddr.V4.pp ip) ; { 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 + | Stale (m, _) -> + Logs.debug ~src:t.logsrc + (fun pp -> pp "request for stale entry %a/%a --> Probing" + Ipaddr.V4.pp ip Macaddr.pp m) ; + let cache = M.add ip (Probing (m, t.epoch + t.retries + 1)) t.cache in + { t with cache }, Mac m + | Static (m, _) + | Dynamic (m, _) + | Probing (m, _) -> t, Mac m diff --git a/src/arp_handler.mli b/src/arp_handler.mli index e859c75..760b719 100644 --- a/src/arp_handler.mli +++ b/src/arp_handler.mli @@ -45,17 +45,18 @@ 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. +(** [create ~cache_size ~timeout ~refresh ~retries ~ipaddr mac)] is [t, garp]. The + constructor of the ARP handler, specifying timeout of stale cache entries + (defaults to 800), the refresh interval of active entries (defaults to 40) + and amount of retries for requests and probes (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] and [refresh] 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 -> +val create : ?cache_size: int -> ?timeout:int -> ?refresh: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 diff --git a/test/mirage/tests.ml b/test/mirage/tests.ml index ba15952..d4279de 100644 --- a/test/mirage/tests.ml +++ b/test/mirage/tests.ml @@ -309,6 +309,7 @@ let input_replaces_old () = 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 () -> + A.remove_ip listen.arp first_ip >>= fun () -> V.disconnect listen.netif ) diff --git a/test/tests.ml b/test/tests.ml index dd505c8..fa9d22b 100644 --- a/test/tests.ml +++ b/test/tests.ml @@ -424,11 +424,32 @@ module Handling = struct 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 = + let query source_mac source_ip ?(target_mac=Macaddr.broadcast) target_ip = { Arp_packet.operation = Arp_packet.Request ; source_mac ; source_ip ; - target_mac = Macaddr.broadcast ; target_ip }, - Macaddr.broadcast + target_mac; target_ip }, + target_mac + + let assert_probing t = + let _, outp, timeout = Arp_handler.tick t in + (match outp with + | [ { Arp_packet.operation ; + source_mac=_ ; source_ip=_ ; + target_mac; target_ip=_ }, _ ] when (operation = Arp_packet.Request && target_mac <> Macaddr.broadcast) -> (); + | _ -> Alcotest.failf "is unicast request"); + Alcotest.(check (list (list int)) "nothing timed out" [] timeout) + + let assert_stale t oip omac = + let t, res = Arp_handler.query t oip (merge 99) in + Alcotest.check qres "stale entry returns MAC" (Arp_handler.Mac omac) res; + assert_probing t + + let assert_dynamic t oip omac = + let t, res = Arp_handler.query t oip (merge 99) in + Alcotest.check qres "stale entry returns MAC" (Arp_handler.Mac omac) res; + let _, outp, timeout = Arp_handler.tick t in + Alcotest.(check (list out) "nada sent" [] outp) ; + Alcotest.(check (list (list int)) "nothing timed out" [] timeout) let handle_gen_request () = let mac = gen_mac () @@ -489,11 +510,11 @@ module Handling = struct let _, _, a = Arp_handler.tick t in Alcotest.(check (list (list int)) "tick timed out" [[1]] a) - let req_before_timeout () = + let probe_after_query_stale () = let mac = gen_mac () and ipaddr = gen_ip () in - let t, _garp = Arp_handler.create ~timeout:1 ~ipaddr mac in + let t, _garp = Arp_handler.create ~refresh:1 ~retries:2 ~ipaddr mac in let other = gen_ip () in let t, _ = Arp_handler.query t other (merge 1) in let omac = gen_mac () in @@ -506,9 +527,32 @@ module Handling = struct 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 + let t, outp, rs = Arp_handler.tick t in (* stays in Dynamic *) + Alcotest.(check bool "timeouts are empty" true (rs = [])) ; + Alcotest.(check (list out) "no arp request is sent" [] outp); + let t, res = Arp_handler.query t other (merge 1) in + Alcotest.check qres "dynamic entry can be queried" (Arp_handler.Mac omac) res; + let t, outp, rs = Arp_handler.tick t in (* Dynamic timeout --> Stale *) + Alcotest.(check bool "timeouts are empty" true (rs = [])) ; + Alcotest.(check (list out) "no arp request is sent" [] outp); + let t, res = Arp_handler.query t other (merge 2) in (* request for Stale entry --> Probing *) + Alcotest.check qres "stale entry can be queried" (Arp_handler.Mac omac) res; + let t, outp, rs = Arp_handler.tick t in (* Probe entry creates unicast request *) + Alcotest.(check bool "timeouts are empty" true (rs = [])) ; + Alcotest.(check (list out) "unicast arp request is sent" [query mac ipaddr ~target_mac:omac other] outp); + let t, res = Arp_handler.query t other (merge 3) in + Alcotest.check qres "probe entry can be queried" (Arp_handler.Mac omac) res; + let t, outp, rs = Arp_handler.tick t in (* Probe entry creates second unicast request *) + Alcotest.(check bool "timeouts are empty" true (rs = [])) ; + Alcotest.(check (list out) "unicast arp request is sent" [query mac ipaddr ~target_mac:omac other] outp); + let t, outp, rs = Arp_handler.tick t in (* Probe entry creates third unicast request *) + Alcotest.(check bool "timeouts are empty" true (rs = [])) ; + Alcotest.(check (list out) "unicast arp request is sent" [query mac ipaddr ~target_mac:omac other] outp); + let t, outp, rs = Arp_handler.tick t in (* Probe entry times out and gets deleted *) Alcotest.(check bool "timeouts are empty" true (rs = [])) ; - Alcotest.(check (list out) "arp request is sent" [query mac ipaddr other] outp) + Alcotest.(check (list out) "no arp request is sent" [] outp); + let _, res = Arp_handler.query t other (merge 4) in + Alcotest.check qres "entry was deleted" (Arp_handler.RequestWait (query mac ipaddr other, [4])) res let multiple_reqs () = let mac = gen_mac () @@ -755,13 +799,14 @@ module Handling = struct 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)) + (Arp_handler.in_cache t other)); + assert_stale t other omac 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 t, _garp = Arp_handler.create ~timeout:2 ~refresh:1 ~ipaddr mac in let other = gen_ip () in let omac = gen_mac () in let pkt = @@ -777,11 +822,17 @@ module Handling = struct 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 out) "nada sent" [] outp) ; + Alcotest.(check (list (list int)) "nothing timed out" [] timeout) ; + let t, outp, timeout = Arp_handler.tick t in (* -> Stale *) + Alcotest.(check (list out) "nada sent" [] 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) ; + let t, outp, timeout = Arp_handler.tick t in (* -> deleted *) + 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)) @@ -832,6 +883,170 @@ module Handling = struct Alcotest.(check (option out) "nothing out" None outp) ; Alcotest.(check (option (pair m (list int))) "something woken up" (Some (omac, [2;1])) w) + let stale_reply_same_mac () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~refresh: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 + (* Create Pending entry and get reply -> Dynamic *) + 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)) ; + (* Tick to expire refresh timer: Dynamic -> Stale *) + 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) ; + 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) ; + assert_stale t other omac; + (* Now in Stale state, send reply with same MAC: Stale -> Dynamic *) + 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 still in cache" (Some omac) (Arp_handler.in_cache t other)) ; + (* Query should return immediately with the MAC (not in Stale anymore) *) + assert_dynamic t other omac + + let stale_reply_different_mac () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~refresh: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 + (* Create Pending entry and get reply -> Dynamic *) + 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)) ; + (* Tick to expire refresh timer: Dynamic -> Stale *) + 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) ; + 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) ; + assert_stale t other omac; + (* Now in Stale state, send reply with DIFFERENT MAC: Stale -> Stale (but MAC changes) *) + let omac2 = gen_mac () in + let pkt2 = + Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ; + source_ip = other ; source_mac = omac2 ; + target_ip = ipaddr ; target_mac = mac } + in + let t, outp, w = Arp_handler.input t pkt2 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 updated with new MAC" (Some omac2) (Arp_handler.in_cache t other)) ; + (* Entry should still be Stale *) + assert_stale t other omac2 + + let probing_reply_same_mac () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~timeout:5 ~refresh:1 ~retries:3 ~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 + (* Create Pending entry and get reply -> Dynamic *) + 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) ; + (* Tick to expire refresh timer: Dynamic -> Stale *) + 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) ; + 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) ; + assert_stale t other omac; + (* Query stale entry: Stale -> Probing *) + let t, res = Arp_handler.query t other (merge 2) in + Alcotest.check qres "stale entry returns MAC" (Arp_handler.Mac omac) res ; + (* Verify we're in Probing state by checking a tick sends unicast request *) + assert_probing t; + (* Now in Probing state, send reply with same MAC: Probing -> Dynamic *) + 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 still in cache" (Some omac) (Arp_handler.in_cache t other)) ; + (* Verify we're back to Dynamic state *) + assert_dynamic t other omac + + let probing_reply_different_mac () = + let mac = gen_mac () + and ipaddr = gen_ip () + in + let t, _garp = Arp_handler.create ~timeout:5 ~refresh:1 ~retries:3 ~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 + (* Create Pending entry and get reply -> Dynamic *) + 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) ; + (* Tick to expire refresh timer: Dynamic -> Stale *) + 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) ; + 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) ; + assert_stale t other omac; + (* Query stale entry: Stale -> Probing *) + let t, res = Arp_handler.query t other (merge 2) in + Alcotest.check qres "stale entry returns MAC" (Arp_handler.Mac omac) res ; + (* Verify we're in Probing state by checking a tick sends unicast request *) + assert_probing t; + (* Now in Probing state, send reply with DIFFERENT MAC: Probing -> Stale *) + let omac2 = gen_mac () in + let pkt2 = + Arp_packet.encode { Arp_packet.operation = Arp_packet.Reply ; + source_ip = other ; source_mac = omac2 ; + target_ip = ipaddr ; target_mac = mac } + in + let t, outp, w = Arp_handler.input t pkt2 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 updated with new MAC" (Some omac2) (Arp_handler.in_cache t other)) ; + (* Verify we're back to Stale state *) + assert_stale t other omac2 + let handl_tsts = [ "create raises", `Quick, create_raises ; "basic tests", `Quick, basic_good ; @@ -848,7 +1063,7 @@ module Handling = struct "alias wakes", `Quick, alias_wakes ; "static wakes", `Quick, static_wakes ; "handle timeout", `Quick, handle_timeout ; - "request send before timeout", `Quick, req_before_timeout ; + "request send before timeout", `Quick, probe_after_query_stale ; "multiple requests are send", `Quick, multiple_reqs ; "multiple requests are send 2", `Quick, multiple_reqs_2 ; "handle reply", `Quick, handle_reply ; @@ -865,6 +1080,10 @@ module Handling = struct "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 ; + "stale to dynamic on same MAC reply", `Quick, stale_reply_same_mac ; + "stale stays stale on different MAC reply", `Quick, stale_reply_different_mac ; + "probing to dynamic on same MAC reply", `Quick, probing_reply_same_mac ; + "probing to stale on different MAC reply", `Quick, probing_reply_different_mac ; ] end