dns-client-mirage support udp (#322)

* dns_client: connect provides the protocol and context

* dns_client: connect provides the protocol

* dns-client-mirage: allow UDP resolvers

This adds support for either all udp or all tcp|tls resolvers. At a later stage,
we can of course support mixed sets of resolvers (especially with the previous
commit paving this path).

* dns-stub / dns-client-mirage: add ?size and ?edns in Dns_client_mirage.connect

This avoids the need to unmarshal the arguments for a Dns_stub.t instantiation,
and makes the surface more uniform.

* dns_mirage_client: randomize udp port

similar to qubes-mirage-firewall (thanks @palainp), at initialization time a
single udp_port is reserved as last resort.

In general, the UDP source port is randomized, and UDP.listen/unlisten are
executed on that port (which is as well registered / unregistered). If the port
allocation fails, the last_udp_port is used, which is always listened to.

* dns-client-mirage: in nameserver_of_string, describe the desired format.

* Update mirage/client/dns_client_mirage.ml

Co-authored-by: Reynir Björnsson <reynir@reynir.dk>

* Update mirage/client/dns_client_mirage.ml

Co-authored-by: Reynir Björnsson <reynir@reynir.dk>

* dns-client: size is now cache_size (suggested by @reynir)

* dns-client-mirage: unlisten in all cases (as suggested by @reynir)

* dns-client-mirage: read_udp: only do something if the minimum DNS length was received (as reviewed by @reynir)

* dns-client-mirage: simplify Set.Make by using OCaml 4.08 introduced Int module

* dns-client-mirage: fix code for read_udp

previously, the source port of the remote (usually 53) was checked against our
source port (some random ephemeral), leading to no accepted reply. the mirage
udp interface does not provide the destination port in the callback (report as
mirage/mirage-tcpip#497).

* dns-client-mirage: remove "last_udp_port" complexity, instead fail on no free port

* Check dst in read_udp

Co-authored-by: Reynir Björnsson <reynir@reynir.dk>

client/dns_client.ml

@@ -186,7 +186,7 @@ module type S = sig
   val rng : int -> Cstruct.t
   val clock : unit -> int64
 
-  val connect : t -> (context, [> `Msg of string ]) result io
+  val connect : t -> (Dns.proto * context, [> `Msg of string ]) result io
   val send_recv : context -> Cstruct.t -> (Cstruct.t, [> `Msg of string ]) result io
   val close : context -> unit io
 
@@ -222,8 +222,8 @@ struct
   }
 
   (* TODO eventually use Auto, and retry without on FormErr *)
-  let create ?(size = 32) ?(edns = `None) ?nameservers ?(timeout = Duration.of_sec 5) stack =
-    { cache = Dns_cache.empty size ;
+  let create ?(cache_size = 32) ?(edns = `None) ?nameservers ?(timeout = Duration.of_sec 5) stack =
+    { cache = Dns_cache.empty cache_size ;
       transport = Transport.create ?nameservers ~timeout stack ;
       edns ;
     }
@@ -254,12 +254,11 @@ struct
       | Error _ -> Error (`Msg "")
 
   let get_raw_reply t query_type name =
-    let proto, _ = Transport.nameservers t.transport in
+    Transport.connect t.transport >>| fun (proto, socket) ->
+    Log.debug (fun m -> m "Connected to NS.");
     let tx, state =
       Pure.make_query Transport.rng proto ~dnssec:true t.edns name query_type
     in
-    Transport.connect t.transport >>| fun socket ->
-    Log.debug (fun m -> m "Connected to NS.");
     (Transport.send_recv socket tx >>| fun recv_buffer ->
      Log.debug (fun m -> m "Read @[<v>%d bytes@]"
                     (Cstruct.length recv_buffer)) ;
@@ -285,12 +284,11 @@ struct
       | Ok _ as ok -> Transport.lift ok
       | Error ((`No_data _ | `No_domain _) as nod) -> Error nod |> Transport.lift
       | Error `Msg _ ->
-        let proto, _ = Transport.nameservers t.transport in
+        Transport.connect t.transport >>| fun (proto, socket) ->
+        Log.debug (fun m -> m "Connected to NS.");
         let tx, state =
           Pure.make_query Transport.rng proto t.edns name query_type
         in
-        Transport.connect t.transport >>| fun socket ->
-        Log.debug (fun m -> m "Connected to NS.");
         (Transport.send_recv socket tx >>| fun recv_buffer ->
          Log.debug (fun m -> m "Read @[<v>%d bytes@]"
                         (Cstruct.length recv_buffer)) ;

client/dns_client.mli

@@ -46,8 +46,8 @@ module type S = sig
   val clock : unit -> int64
   (** [clock t] is the monotonic clock. *)
 
-  val connect : t -> (context, [> `Msg of string ]) result io
-  (** [connect addr] is a new connection ([context]) to [addr], or an error. *)
+  val connect : t -> (Dns.proto * context, [> `Msg of string ]) result io
+  (** [connect t] is a new connection ([context]) to [t], or an error. *)
 
   val send_recv : context -> Cstruct.t -> (Cstruct.t, [> `Msg of string ]) result io
   (** [send_recv context buffer] sends [buffer] to the [context] upstream, and
@@ -67,12 +67,13 @@ sig
 
   type t
 
-  val create : ?size:int -> ?edns:[ `None | `Auto | `Manual of Dns.Edns.t ] ->
+  val create : ?cache_size:int ->
+    ?edns:[ `None | `Auto | `Manual of Dns.Edns.t ] ->
     ?nameservers:(Dns.proto * T.io_addr list) -> ?timeout:int64 ->
     T.stack -> t
-  (** [create ~size ~edns ~nameservers ~timeout stack] creates the state of the
-      DNS client. We use [timeout] (ns, default 5s) as a time budget for connect
-      and request timeouts. To specify a timeout, use
+  (** [create ~cache_size ~edns ~nameservers ~timeout stack] creates the state
+      of the DNS client. We use [timeout] (ns, default 5s) as a time budget for
+      connect and request timeouts. To specify a timeout, use
       [create ~timeout:(Duration.of_sec 3)]. Whether or not to use
       {{:https://tools.ietf.org/html/rfc6891}EDNS} in queries is controlled
       by [~edns] (defaults to [`None]): if [None], no EDNS will be present,

lwt/client/dns_client_lwt.ml

@@ -395,7 +395,7 @@ module Transport : Dns_client.S
 
   let connect t =
     connect_via_tcp_to_ns t >|= function
-    | Ok () -> Ok t
+    | Ok () -> Ok (`Tcp, t)
     | Error `Msg msg -> Error (`Msg msg)
 end