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