Skip to content

DNS: support for Extended DNS error (RFC 8914) #374

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open

DNS: support for Extended DNS error (RFC 8914) #374

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
138 changes: 137 additions & 1 deletion src/dns.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2896,20 +2896,146 @@ module Tsig = struct
| Dnskey.Unknown x -> Error (`Msg ("Unknown DNSKEY algorithm " ^ string_of_int x))
end

module Extended_error = struct
type t =
[ `Other | `Unsupported_Dnskey_algorithm | `Unsupported_Ds_digest
| `Stale_answer | `Forged_answer | `Dnssec_indeterminate
| `Dnssec_bogus | `Signature_expired | `Signature_not_yet_valid
| `Dnskey_missing | `Rrsigs_missing | `No_zone_key_bit_set
| `Nsec_missing | `Cached_error | `Not_ready | `Blocked
| `Censored | `Filtered | `Prohibited | `Stale_Nxdomain_answer
| `Not_authoritative | `Not_supported | `No_reachable_authority
| `Network_error | `Invalid_data | `Unknown of int ] *
string option

let to_int = function
| `Other -> 0
| `Unsupported_Dnskey_algorithm -> 1
| `Unsupported_Ds_digest -> 2
| `Stale_answer -> 3
| `Forged_answer -> 4
| `Dnssec_indeterminate -> 5
| `Dnssec_bogus -> 6
| `Signature_expired -> 7
| `Signature_not_yet_valid -> 8
| `Dnskey_missing -> 9
| `Rrsigs_missing -> 10
| `No_zone_key_bit_set -> 11
| `Nsec_missing -> 12
| `Cached_error -> 13
| `Not_ready -> 14
| `Blocked -> 15
| `Censored -> 16
| `Filtered -> 17
| `Prohibited -> 18
| `Stale_Nxdomain_answer -> 19
| `Not_authoritative -> 20
| `Not_supported -> 21
| `No_reachable_authority -> 22
| `Network_error -> 23
| `Invalid_data -> 24
| `Unknown i -> i

let of_int = function
| 0 -> `Other
| 1 -> `Unsupported_Dnskey_algorithm
| 2 -> `Unsupported_Ds_digest
| 3 -> `Stale_answer
| 4 -> `Forged_answer
| 5 -> `Dnssec_indeterminate
| 6 -> `Dnssec_bogus
| 7 -> `Signature_expired
| 8 -> `Signature_not_yet_valid
| 9 -> `Dnskey_missing
| 10 -> `Rrsigs_missing
| 11 -> `No_zone_key_bit_set
| 12 -> `Nsec_missing
| 13 -> `Cached_error
| 14 -> `Not_ready
| 15 -> `Blocked
| 16 -> `Censored
| 17 -> `Filtered
| 18 -> `Prohibited
| 19 -> `Stale_Nxdomain_answer
| 20 -> `Not_authoritative
| 21 -> `Not_supported
| 22 -> `No_reachable_authority
| 23 -> `Network_error
| 24 -> `Invalid_data
| i -> `Unknown i

let pp ppf (t, data) =
let prefix =
match t with
| `Other -> "other"
| `Unsupported_Dnskey_algorithm -> "unsupported DNSKEY algorithm"
| `Unsupported_Ds_digest -> "unsupported DS digest"
| `Stale_answer -> "stale answer"
| `Forged_answer -> "forged answer"
| `Dnssec_indeterminate -> "DNSSEC indeterminate"
| `Dnssec_bogus -> "DNSSEC bogus"
| `Signature_expired -> "signature expired"
| `Signature_not_yet_valid -> "signature not yet valid"
| `Dnskey_missing -> "DNSKEY missing"
| `Rrsigs_missing -> "RRSIGs missing"
| `No_zone_key_bit_set -> "no zone key bit set"
| `Nsec_missing -> "NSEC missing"
| `Cached_error -> "cached error"
| `Not_ready -> "not ready"
| `Blocked -> "blocked"
| `Censored -> "censored"
| `Filtered -> "filtered"
| `Prohibited -> "prohibited"
| `Stale_Nxdomain_answer -> "stale NXDOMAIN answer"
| `Not_authoritative -> "not authoritative"
| `Not_supported -> "not supported"
| `No_reachable_authority -> "no reachable authority"
| `Network_error -> "network error"
| `Invalid_data -> "invalid data"
| `Unknown t -> "unknown (" ^ string_of_int t ^ ")"
in
Fmt.pf ppf "%s%s" prefix (match data with None -> "" | Some s -> " " ^ s)

let compare (t, d) (t', d') =
andThen (Int.compare (to_int t) (to_int t'))
(match d, d' with
| None, None -> 0
| None, Some _ -> -1
| Some _, None -> 1
| Some s, Some s' -> String.compare s s')

let encode (t, v) =
let buf = Bytes.create 2 in
Bytes.set_uint16_be buf 0 (to_int t);
Bytes.unsafe_to_string buf ^ Option.value ~default:"" v

let decode buf =
let t = of_int (String.get_uint16_be buf 0) in
let v =
if String.length buf > 2 then
Some (String.sub buf 2 (String.length buf - 2))
else
None
in
t, v
end

module Edns = struct

type extension =
| Nsid of string
| Cookie of string
| Tcp_keepalive of int option
| Padding of int
| Extended_error of Extended_error.t
| Extension of int * string

let pp_extension ppf = function
| Nsid cs -> Fmt.pf ppf "nsid %a" (Ohex.pp_hexdump ()) cs
| Cookie cs -> Fmt.pf ppf "cookie %a" (Ohex.pp_hexdump ()) cs
| Tcp_keepalive i -> Fmt.pf ppf "keepalive %a" Fmt.(option ~none:(any "none") int) i
| Padding i -> Fmt.pf ppf "padding %d" i
| Extended_error e -> Extended_error.pp ppf e
| Extension (t, v) -> Fmt.pf ppf "unknown option %d: %a" t (Ohex.pp_hexdump ()) v

let compare_extension a b = match a, b with
Expand All @@ -2927,6 +3053,8 @@ module Edns = struct
| Tcp_keepalive _, _ -> 1 | _, Tcp_keepalive _ -> -1
| Padding a, Padding b -> Int.compare a b
| Padding _, _ -> 1 | _, Padding _ -> -1
| Extended_error e, Extended_error e' -> Extended_error.compare e e'
| Extended_error _, _ -> 1 | _, Extended_error _ -> -1
| Extension (t, v), Extension (t', v') ->
andThen (Int.compare t t') (String.compare v v')

Expand All @@ -2936,13 +3064,15 @@ module Edns = struct
| Cookie _ -> 10
| Tcp_keepalive _ -> 11
| Padding _ -> 12
| Extended_error _ -> 15
| Extension (tag, _) -> tag

let int_to_extension = function
| 3 -> Some `nsid
| 10 -> Some `cookie
| 11 -> Some `tcp_keepalive
| 12 -> Some `padding
| 15 -> Some `extended_error
| _ -> None

let extension_payload = function
Expand All @@ -2956,6 +3086,7 @@ module Edns = struct
Bytes.set_uint16_be buf 0 i ;
Bytes.unsafe_to_string buf)
| Padding i -> String.make i '\x00'
| Extended_error e -> Extended_error.encode e
| Extension (_, v) -> v

let encode_extension t buf off =
Expand Down Expand Up @@ -2985,6 +3116,7 @@ module Edns = struct
in
Ok (Tcp_keepalive i, len)
| Some `padding -> Ok (Padding tl, len)
| Some `extended_error -> Ok (Extended_error (Extended_error.decode v), len)
| None -> Ok (Extension (code, v), len)

type t = {
Expand All @@ -2999,7 +3131,7 @@ module Edns = struct

let min_payload_size = 512 (* from RFC 6891 Section 6.2.3 *)

let create ?(extended_rcode = 0) ?(version = 0) ?(dnssec_ok = false)
let create ?extended_error ?(extended_rcode = 0) ?(version = 0) ?(dnssec_ok = false)
?(payload_size = min_payload_size) ?(extensions = []) () =
let payload_size =
if payload_size < min_payload_size then begin
Expand All @@ -3009,6 +3141,10 @@ module Edns = struct
end else
payload_size
in
let extensions = match extended_error with
| None -> extensions
| Some e -> Extended_error e :: extensions
in
{ extended_rcode ; version ; dnssec_ok ; payload_size ; extensions }

(* once we handle cookies, dnssec, or other extensions, need to adjust *)
Expand Down
26 changes: 23 additions & 3 deletions src/dns.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -805,6 +805,24 @@ module Tsig : sig
matches [ts]. *)
end

(** Extended DNS errors

Standardized in RFC 8914, this is a payload for Edns with a additional
information about the cause of a DNS error.
*)
module Extended_error : sig
type t =
[ `Other | `Unsupported_Dnskey_algorithm | `Unsupported_Ds_digest
| `Stale_answer | `Forged_answer | `Dnssec_indeterminate
| `Dnssec_bogus | `Signature_expired | `Signature_not_yet_valid
| `Dnskey_missing | `Rrsigs_missing | `No_zone_key_bit_set
| `Nsec_missing | `Cached_error | `Not_ready | `Blocked
| `Censored | `Filtered | `Prohibited | `Stale_Nxdomain_answer
| `Not_authoritative | `Not_supported | `No_reachable_authority
| `Network_error | `Invalid_data | `Unknown of int ] *
string option
end

(** Extensions to DNS

An extension record (EDNS) is extendable, includes a version number, payload
Expand All @@ -817,6 +835,7 @@ module Edns : sig
| Cookie of string
| Tcp_keepalive of int option
| Padding of int
| Extended_error of Extended_error.t
| Extension of int * string
(** The type of supported extensions. *)

Expand All @@ -829,9 +848,10 @@ module Edns : sig
}
(** The type of an EDNS record. *)

val create : ?extended_rcode:int -> ?version:int -> ?dnssec_ok:bool ->
?payload_size:int -> ?extensions:extension list -> unit -> t
(** [create ~extended_rcode ~version ~dnssec_ok ~payload_size ~extensions ()]
val create : ?extended_error:Extended_error.t -> ?extended_rcode:int ->
?version:int -> ?dnssec_ok:bool -> ?payload_size:int ->
?extensions:extension list -> unit -> t
(** [create ~extended_erro ~extended_rcode ~version ~dnssec_ok ~payload_size ~extensions ()]
constructs an EDNS record with the optionally provided data. The
[extended_rcode] defaults to 0, [version] defaults to 0, [dnssec_ok] to
false, [payload_size] to the minimum payload size (512 byte), [extensions]
Expand Down