gazagnaire.org
DNS wire codec, cache, stub resolver and forwarder
1(* Throughput and per-query allocation of the I/O-free forwarder core. The
2 decision path -- decode, hosts/cache lookup, reply build -- is pure OCaml with
3 no syscalls, so it is measured directly in a tight loop. The forward path also
4 builds the upstream queries (0x20 + EDNS) without sending them. *)
5
6module F = Nox_dns.Forward
7module C = Nox_dns.Forward_config
8module Hosts = Nox_dns.Hosts
9module Pure = Nox_dns.Client.Pure
10
11let dn = Domain_name.of_string_exn
12let rng n = String.make n '\001'
13let clock () = 1_000_000_000L
14
15let single_upstream ip =
16 {
17 C.servers =
18 C.Server.Set.singleton
19 {
20 zones = C.Domain.Set.empty;
21 address = { ip = Ipaddr.of_string_exn ip; port = 53 };
22 timeout = None;
23 order = 0;
24 };
25 search = [];
26 assume_offline_after_drops = Some 4;
27 }
28
29(* A canned upstream A answer to an attempt's query, used to prime the cache. *)
30let canned_a attempt data =
31 match Dns.Packet.decode (F.attempt_query attempt) with
32 | Error _ -> failwith "attempt query did not decode"
33 | Ok q ->
34 let flags =
35 Dns.Packet.Flags.of_list [ `Recursion_desired; `Recursion_available ]
36 in
37 let name, _ = q.Dns.Packet.question in
38 let ans =
39 (Dns.Name_rr_map.singleton name Dns.Rr_map.A data, Dns.Name_rr_map.empty)
40 in
41 let reply =
42 Dns.Packet.create
43 (fst q.Dns.Packet.header, flags)
44 q.Dns.Packet.question (`Answer ans)
45 in
46 fst (Dns.Packet.encode `Udp reply)
47
48let measure name n f =
49 for _ = 1 to 10_000 do
50 ignore (Sys.opaque_identity (f ()))
51 done;
52 Gc.full_major ();
53 let a0 = Gc.allocated_bytes () in
54 let t0 = Unix.gettimeofday () in
55 for _ = 1 to n do
56 ignore (Sys.opaque_identity (f ()))
57 done;
58 let t1 = Unix.gettimeofday () in
59 let a1 = Gc.allocated_bytes () in
60 let dt = t1 -. t0 in
61 Fmt.pr "%-22s %10.0f q/s %6.0f ns/query %8.1f words/query@." name
62 (float_of_int n /. dt)
63 (dt *. 1e9 /. float_of_int n)
64 ((a1 -. a0) /. float_of_int n /. 8.)
65
66let () =
67 let n = 1_000_000 in
68 (* hosts hit: decode + hosts lookup + reply build *)
69 let hosts = Hosts.of_string "203.0.113.9 svc.local\n" in
70 let fw_hosts = F.v ~hosts ~rng ~clock () in
71 let hq, _ = Pure.make_query rng `Udp `None (dn "svc.local") Dns.Rr_map.A in
72 measure "hosts hit" n (fun () -> F.decide fw_hosts hq);
73
74 (* cache hit: decode + cache lookup + reply build *)
75 let fw = F.v ~cfg:(single_upstream "1.1.1.1") ~rng ~clock () in
76 let cq, _ = Pure.make_query rng `Udp `None (dn "example.com") Dns.Rr_map.A in
77 (match F.decide fw cq with
78 | F.Forward req ->
79 let att = List.hd (List.hd req.groups) in
80 let resp =
81 canned_a att
82 ( 300l,
83 Ipaddr.V4.Set.singleton (Ipaddr.V4.of_string_exn "93.184.216.34") )
84 in
85 ignore (F.on_reply fw req att resp)
86 | _ -> failwith "priming failed");
87 measure "cache hit" n (fun () -> F.decide fw cq);
88
89 (* forward decision: decode + select + 0x20 + EDNS query build (no I/O) *)
90 let fw2 = F.v ~cfg:(single_upstream "1.1.1.1") ~rng ~clock () in
91 let mq, _ =
92 Pure.make_query rng `Udp `None (dn "miss.example.org") Dns.Rr_map.A
93 in
94 measure "forward decision" n (fun () -> F.decide fw2 mq)