Source file mnet_dns_cli.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
let s_dns = "DOMAIN NAME SYSTEM"
open Cmdliner
type nameserver =
[ `Tls of Tls.Config.client * Ipaddr.t * int | `Plaintext of Ipaddr.t * int ]
let nameserver_of_string str =
let ( let* ) = Result.bind in
begin match String.split_on_char ':' str with
| "tls" :: rest -> (
let str = String.concat ":" rest in
match String.split_on_char '!' str with
| [ nameserver ] ->
let* ipaddr, port =
Ipaddr.with_port_of_string ~default:853 nameserver
in
let* authenticator = Ca_certs_nss.authenticator () in
let* tls = Tls.Config.client ~authenticator () in
Ok (`Tcp, `Tls (tls, ipaddr, port))
| nameserver :: opt_hostname :: authenticator ->
let* ipaddr, port =
Ipaddr.with_port_of_string ~default:853 nameserver
in
let peer_name, data =
match
let* dn = Domain_name.of_string opt_hostname in
Domain_name.host dn
with
| Ok hostname -> (Some hostname, String.concat "!" authenticator)
| Error _ ->
(None, String.concat "!" (opt_hostname :: authenticator))
in
let* authenticator =
match data with
| "" -> Ca_certs_nss.authenticator ()
| data ->
let* a = X509.Authenticator.of_string data in
Ok (a (fun () -> Some (Mkernel.now ())))
in
let* tls = Tls.Config.client ~authenticator ?peer_name () in
Ok (`Tcp, `Tls (tls, ipaddr, port))
| [] -> assert false)
| "tcp" :: nameserver ->
let str = String.concat ":" nameserver in
let* ipaddr, port = Ipaddr.with_port_of_string ~default:53 str in
Ok (`Tcp, `Plaintext (ipaddr, port))
| "udp" :: nameserver ->
let str = String.concat ":" nameserver in
let* ipaddr, port = Ipaddr.with_port_of_string ~default:53 str in
Ok (`Udp, `Plaintext (ipaddr, port))
| _ -> Error (`Msg ("Unable to decode nameserver " ^ str))
end
let uncensoreddns_org =
let ipaddr = Ipaddr.of_string_exn "89.233.43.71" in
let authenticator =
X509.Authenticator.of_string
"key-fp:SHA256:INSZEZpDoWKiavosV2/xVT8O83vk/RRwS+LTiL+IpHs="
in
let authenticator = Result.get_ok authenticator in
let authenticator = authenticator (fun () -> Some (Mkernel.now ())) in
let cfg = Tls.Config.client ~authenticator () in
let cfg = Result.get_ok cfg in
(`Tcp, `Tls (cfg, ipaddr, 853))
let nameservers ?(default = [ uncensoreddns_org ]) () =
let doc = "A DNS nameserver." in
let parser = nameserver_of_string in
let pp ppf (proto, nameserver) =
match (proto, nameserver) with
| `Udp, `Plaintext (ipaddr, port) ->
Fmt.pf ppf "udp:%a:%d" Ipaddr.pp ipaddr port
| `Tcp, `Plaintext (ipaddr, port) ->
Fmt.pf ppf "tcp:%a:%d" Ipaddr.pp ipaddr port
| `Tcp, `Tls (_, ipaddr, port) ->
Fmt.pf ppf "tls:%a:%d" Ipaddr.pp ipaddr port
| `Udp, _ -> assert false
in
let open Arg in
value
& opt_all (conv (parser, pp)) default
& info [ "n"; "nameserver" ] ~doc ~docs:s_dns ~docv:"NAMESERVER"
let setup nameservers =
let fn = function
| `Udp, ns -> Either.Left ns
| `Tcp, ns -> Either.Right ns
in
match List.partition_map fn nameservers with
| nss, [] -> (`Udp, nss)
| [], nss -> (`Tcp, nss)
| _ ->
Fmt.failwith
"It is impossible to mix multiple nameservers over TCP and UDP"
let setup ?default () =
let open Term in
const setup $ nameservers ?default ()