diff --git a/mirage/stub/dns_stub_mirage.ml b/mirage/stub/dns_stub_mirage.ml index 7b42e1c8..9532e2ab 100644 --- a/mirage/stub/dns_stub_mirage.ml +++ b/mirage/stub/dns_stub_mirage.ml @@ -89,6 +89,7 @@ module Make (S : Tcpip.Stack.V4V6) = struct mutable update_tls : Tls.Config.server -> unit ; mutable clients : Ipaddr.Set.t ; record_clients : bool ; + require_domain : bool ; } let primary_data { server ; _ } = @@ -265,7 +266,14 @@ module Make (S : Tcpip.Stack.V4V6) = struct (* check header flags: recursion desired (and send recursion available) *) (server t proto ip packet header question data buf >>= function | Some data -> Lwt.return (Some data) - | None -> resolve t question data header proto) >|= fun reply -> + | None -> + let dn, qtyp = question in + if Domain_name.count_labels dn = 1 && (qtyp = `K (Rr_map.K A) || qtyp = `K (Rr_map.K Aaaa)) then + let data = `Rcode_error (Rcode.NXDomain, Opcode.Query, None) in + let reply = build_reply header question proto data in + Lwt.return (Some reply) + else + resolve t question data header proto) >|= fun reply -> let stop = Mirage_mtime.elapsed_ns () in Dns_resolver_metrics.response_metric (Int64.sub stop start); reply @@ -302,7 +310,7 @@ module Make (S : Tcpip.Stack.V4V6) = struct let len = Cstruct.BE.get_uint16 k 0 in read_tls f len - let create ?(add_reserved = true) ?(record_clients = true) ?(cache_size = 10000) ?(udp = true) ?(tcp = true) ?(port = 53) ?tls ?(tls_port = 853) ?edns ?nameservers ?timeout ?(on_update = fun ~old:_ ?authenticated_key:_ ~update_source:_ _trie -> Lwt.return_unit) primary ~happy_eyeballs stack : t Lwt.t = + let create ?(require_domain = false) ?(add_reserved = true) ?(record_clients = true) ?(cache_size = 10000) ?(udp = true) ?(tcp = true) ?(port = 53) ?tls ?(tls_port = 853) ?edns ?nameservers ?timeout ?(on_update = fun ~old:_ ?authenticated_key:_ ~update_source:_ _trie -> Lwt.return_unit) primary ~happy_eyeballs stack : t Lwt.t = Client.connect ~cache_size ?edns ?nameservers ?timeout (stack, happy_eyeballs) >|= fun client -> let primary = if add_reserved then @@ -315,7 +323,7 @@ module Make (S : Tcpip.Stack.V4V6) = struct let server = Dns_server.Primary.server primary in let stream, push = Lwt_stream.create () in let update_tls _ = () in - let t = { client ; server ; on_update ; push ; update_tls ; record_clients ; clients = Ipaddr.Set.empty } in + let t = { client ; server ; on_update ; push ; update_tls ; record_clients ; clients = Ipaddr.Set.empty ; require_domain } in let udp_cb ~src ~dst:_ ~src_port buf = let buf = Cstruct.to_string buf in metrics `Udp_queries; diff --git a/mirage/stub/dns_stub_mirage.mli b/mirage/stub/dns_stub_mirage.mli index 01bbdb2b..9ee51b9c 100644 --- a/mirage/stub/dns_stub_mirage.mli +++ b/mirage/stub/dns_stub_mirage.mli @@ -10,7 +10,7 @@ module Make (S : Tcpip.Stack.V4V6) : sig ?timer_interval:int64 -> ?getaddrinfo:getaddrinfo -> stack -> t Lwt.t end - val create : ?add_reserved:bool -> ?record_clients:bool -> ?cache_size:int -> ?udp:bool -> ?tcp:bool -> ?port:int -> + val create : ?require_domain:bool -> ?add_reserved:bool -> ?record_clients:bool -> ?cache_size:int -> ?udp:bool -> ?tcp:bool -> ?port:int -> ?tls:Tls.Config.server -> ?tls_port:int -> ?edns:[ `Auto | `Manual of Dns.Edns.t | `None ] -> ?nameservers:string list -> @@ -18,7 +18,7 @@ module Make (S : Tcpip.Stack.V4V6) : sig ?on_update:(old:Dns_trie.t -> ?authenticated_key:[ `raw ] Domain_name.t -> update_source:Ipaddr.t -> Dns_trie.t -> unit Lwt.t) -> Dns_server.Primary.s -> happy_eyeballs:H.t -> S.t -> t Lwt.t - (** [create ~add_reserved ~record_clients ~cache_size ~edns ~nameservers ~timeout ~on_update server ~happy_eyeballs stack] + (** [create ~require_domain ~add_reserved ~record_clients ~cache_size ~edns ~nameservers ~timeout ~on_update server ~happy_eyeballs stack] registers a stub resolver on the provided protocols [udp], [tcp], [tls] using [port] for udp and tcp (defaults to 53), [tls_port] for tls (defaults to 853) using the [resolver] configuration. The [timer] is in milliseconds @@ -30,7 +30,11 @@ module Make (S : Tcpip.Stack.V4V6) : sig The [add_reserved] is by default [true], and adds reserved zones (from RFC 6303, 6761, 6762) to the primary server - (see {!Dns_resolver_root.reserved_zones}). *) + (see {!Dns_resolver_root.reserved_zones}). + + The [require_domain] is by default [false]. If enabled, single-label + queries for address records (A or AAAA) are immediately replied to with a + no data reply. *) include Dns_resolver_mirage_shared.S with type t := t end diff --git a/resolver/dns_resolver.ml b/resolver/dns_resolver.ml index 541fd170..c34659c5 100644 --- a/resolver/dns_resolver.ml +++ b/resolver/dns_resolver.ml @@ -78,9 +78,10 @@ type t = { queried : awaiting list QM.t ; mutable clients : Ipaddr.Set.t ; record_clients : bool ; + require_domain : bool ; } -let create ?(add_reserved = true) ?(record_clients = true) ?(cache_size = 10000) ?(ip_protocol = `Both) features now ts rng primary = +let create ?(require_domain = false) ?(add_reserved = true) ?(record_clients = true) ?(cache_size = 10000) ?(ip_protocol = `Both) features now ts rng primary = let cache = Dns_cache.empty cache_size in let cache = List.fold_left (fun cache (name, b) -> @@ -116,7 +117,7 @@ let create ?(add_reserved = true) ?(record_clients = true) ?(cache_size = 10000) primary in { ip_protocol ; features ; rng ; cache ; primary ; transit = TM.empty ; queried = QM.empty ; - clients = Ipaddr.Set.empty ; record_clients } + clients = Ipaddr.Set.empty ; record_clients ; require_domain } let features t = FS.elements t.features @@ -575,9 +576,16 @@ let handle_buf t now ts query_allowed proto sender sport buf = Log.debug (fun m -> m "handled delegation %a:%d" Ipaddr.pp sender sport) ; handle_delegation t ts proto sender sport res dele | `None -> - Log.debug (fun m -> m "resolving %a:%d" Ipaddr.pp sender sport) ; - (* DNSSEC request DS / DNSKEY / NS from auth *) - resolve t ts proto sender sport res + let dn, qtyp = res.question in + if Domain_name.count_labels dn = 1 && (qtyp = `K (Rr_map.K A) || qtyp = `K (Rr_map.K Aaaa)) then + let reply = Packet.create res.header res.question (`Answer (Name_rr_map.empty, Name_rr_map.empty)) in + let data, _ = Packet.encode proto reply in + t, [ proto, sender, sport, 0l, data ], [] + else begin + Log.debug (fun m -> m "resolving %a:%d" Ipaddr.pp sender sport) ; + (* DNSSEC request DS / DNSKEY / NS from auth *) + resolve t ts proto sender sport res + end end | _ -> Log.err (fun m -> m "ignoring unsolicited packet (query allowed? %b) %a" query_allowed Packet.pp res); diff --git a/resolver/dns_resolver.mli b/resolver/dns_resolver.mli index 12a65f6d..40bdbbac 100644 --- a/resolver/dns_resolver.mli +++ b/resolver/dns_resolver.mli @@ -6,11 +6,11 @@ type t type feature = [ `Dnssec | `Qname_minimisation | `Opportunistic_tls_authoritative ] -val create : ?add_reserved:bool -> ?record_clients:bool -> ?cache_size:int -> +val create : ?require_domain:bool -> ?add_reserved:bool -> ?record_clients:bool -> ?cache_size:int -> ?ip_protocol:[ `Both | `Ipv4_only | `Ipv6_only ] -> feature list -> Ptime.t -> int64 -> (int -> string) -> Dns_server.Primary.s -> t -(** [create ~add_reserved ~record_clients ~cache_size ~ip_protocol features now ts rng primary] +(** [create ~require_domain ~add_reserved ~record_clients ~cache_size ~ip_protocol features now ts rng primary] creates the value of a resolver, pre-filled with root NS and their IP addresses. If [ip_protocol] is provided, and set to [`V4_only], only IPv4 packets will be emitted. If [`V6_only] is set, only IPv6 packets will be @@ -24,6 +24,10 @@ val create : ?add_reserved:bool -> ?record_clients:bool -> ?cache_size:int -> 6303, 6761, 6762) to the primary server (see {!Dns_resolver_root.reserved_zones}). + The [require_domain] is by default [false]. If enabled, single-label queries + for address records (A or AAAA) are immediately replied to with a no data + reply. + Some features can be specified, whether DNSSec validation should be done, whether query name minimisation should be done, and whether opportunistic encryption using TLS to the authoritative should be done.