dns.ml

   1 (** {1 DNS packet parsing and unformating according to RFC 1035 } *)
   2
   3 module Buf = Buffer
   4 open Printf
   5 open ExtLib
   6 open Devkit
   7 open Bitstring
   8 open Inet
   9
  10 let log = Log.from "dns"
  11
  12 module SOA = struct
  13 type t = { id : int; name : string; ip : Network.ipv4; ns : string list }
  14 end
  15
  16 (* 4.1.1. Header section format *)
  17
  18 (*
  19                                     1  1  1  1  1  1
  20       0  1  2  3  4  5  6  7  8  9  0  1  2  3  4  5
  21     +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
  22     |                      ID                       |
  23     +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
  24     |QR|   Opcode  |AA|TC|RD|RA|   Z    |   RCODE   |
  25     +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
  26     |                    QDCOUNT                    |
  27     +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
  28     |                    ANCOUNT                    |
  29     +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
  30     |                    NSCOUNT                    |
  31     +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
  32     |                    ARCOUNT                    |
  33     +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
  34 *)
  35
  36 (* 6.1.2.  Wire Format - EDNS OPT RR Format*)
  37
  38 (*
  39   +------------+--------------+------------------------------+
  40   | Field Name | Field Type   | Description                  |
  41   +------------+--------------+------------------------------+
  42   | NAME       | domain name  | MUST be 0 (root domain)      |
  43   | TYPE       | u_int16_t    | OPT (41)                     |
  44   | CLASS      | u_int16_t    | requestor's UDP payload size |
  45   | TTL        | u_int32_t    | extended RCODE and flags     |
  46   | RDLEN      | u_int16_t    | length of all RDATA          |
  47   | RDATA      | octet stream | {attribute,value} pairs      |
  48   +------------+--------------+------------------------------+
  49
  50    The extended RCODE and flags, which OPT stores in the RR Time to Live
  51    (TTL) field, are structured as follows:
  52
  53                +0 (MSB)                            +1 (LSB)
  54     +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
  55  0: |         EXTENDED-RCODE        |            VERSION            |
  56     +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
  57  2: | DO|                           Z                               |
  58     +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
  59 *)
  60
  61 type pkt = bitstring
  62
  63 let to_pkt = bitstring_of_string
  64 let of_pkt = string_of_bitstring
  65
  66 let bitstring_of_bytes bytes = bytes, 0, (Bytes.length bytes lsl 3)
  67
  68 let domain_name input =
  69   let rec labels bstr acc =
  70     match%bitstring bstr with
  71     | {| 0:8; rest: -1 :bitstring |} -> Some (rest, List.rev acc)
  72     | {| 0:2; len:6; label : 8*len : string; rest: -1 :bitstring |} -> labels rest (label::acc)
  73     | {| 0b11:2; ofs:16-2; rest: -1 :bitstring |} -> (* pointer *)
  74         let (raw,_,_) = bstr in (* relies on full message bitstring *)
  75         begin match labels (dropbits (ofs*8) (bitstring_of_bytes raw)) acc with
  76         | Some (_,answer) -> Some (rest,answer)
  77         | None -> None
  78         end
  79     | {| _ |} -> None
  80   in
  81   labels input []
  82
  83 let character_strings_exn input =
  84   let rec loop bs acc =
  85     match bitstring_length bs with
  86     | 0 -> List.rev acc
  87     | _ ->
  88       match%bitstring bs with
  89       | {| n : 8; s : 8*n : string; rest: -1: bitstring |} -> loop rest (s :: acc)
  90       | {| _ |} -> Exn.fail "no match"
  91   in
  92   loop input []
  93
  94 let labels_of_domain domain =
  95   let b = Buf.create 100 in
  96   List.iter (fun label ->
  97     let len = min (String.length label) 63 in
  98     Buf.add_char b (Char.chr len);
  99     Buf.add_substring b label 0 len) domain;
 100   Buf.add_char b '\x00';
 101   Buf.contents b
 102
 103 exception InvalidHeader
 104
 105 let decode_dns_header header f =
 106   match%bitstring header with
 107   | {| id : 16;
 108       qr : 1; opc : 4; aa : 1; tc : 1; rd : 1; ra : 1; z : 3; rcode : 4;
 109       qdcount : 16;
 110       ancount : 16;
 111       arcount : 16;
 112       adcount : 16;
 113       rest: -1: bitstring
 114     |} -> f ~id ~qr ~opc ~aa ~tc ~rd ~ra ~z ~rcode ~qdcount ~ancount ~arcount ~adcount ~rest
 115   | {| _ |} -> raise InvalidHeader
 116
 117 type rcode = OK | FMTERROR | SERVFAIL | NXDOMAIN | NOTIMPL | REFUSED
 118
 119 exception Error of rcode * string
 120 let err rcode fmt = ksprintf (fun str -> raise (Error (rcode,str))) fmt
 121 let notimpl fmt = err NOTIMPL fmt
 122 let fmterror fmt = err FMTERROR fmt
 123 let servfail fmt = err SERVFAIL fmt
 124 let refused fmt = err REFUSED fmt
 125 let nxdomain fmt = err NXDOMAIN fmt
 126
 127 (** 3.2.2. TYPE values *)
 128
 129 type qtype = A | NS | CNAME | SOA | MX | TXT | AAAA | A6 | PTR
 130 let int_of_qtype = function
 131   | A -> 1
 132   | NS -> 2
 133   | CNAME -> 5
 134   | SOA -> 6
 135   | PTR -> 12
 136   | MX -> 15
 137   | TXT -> 16
 138   | AAAA -> 28 (* RFC 1886 *)
 139   | A6 -> 38 (* RFC 2874 *)
 140 let qtype_of_int = function
 141   | 1 -> A
 142   | 2 -> NS
 143   | 5 -> CNAME
 144   | 6 -> SOA
 145   | 12 -> PTR
 146   | 15 -> MX
 147   | 16 -> TXT
 148   | 28 -> AAAA
 149   | 38 -> A6
 150   | x -> notimpl "TYPE %u" x
 151 let string_of_qtype = function
 152   | A -> "A"
 153   | NS -> "NS"
 154   | CNAME -> "CNAME"
 155   | SOA -> "SOA"
 156   | PTR -> "PTR"
 157   | MX -> "MX"
 158   | TXT -> "TXT"
 159   | AAAA -> "AAAA"
 160   | A6 -> "A6"
 161
 162 let int_of_rcode = function
 163   | OK       -> 0
 164   | FMTERROR -> 1
 165   | SERVFAIL -> 2
 166   | NXDOMAIN -> 3
 167   | NOTIMPL  -> 4
 168   | REFUSED  -> 5
 169 let string_of_rcode = function
 170   | OK -> "OK"
 171   | FMTERROR -> "FMTERROR"
 172   | SERVFAIL -> "SERVFAIL"
 173   | NXDOMAIN -> "NXDOMAIN"
 174   | NOTIMPL -> "NOTIMPL"
 175   | REFUSED -> "REFUSED"
 176 let rcode_of_int = function
 177   | 0 -> OK
 178   | 1 -> FMTERROR
 179   | 2 -> SERVFAIL
 180   | 3 -> NXDOMAIN
 181   | 4 -> NOTIMPL
 182   | 5 -> REFUSED
 183   | x -> fmterror "RCODE %u" x
 184
 185 let describe_opcode = function
 186   | 0 -> "QUERY"
 187   | 1 -> "IQUERY"
 188   | 2 -> "STATUS"
 189   | n -> sprintf "OPCODE %d" n
 190 let describe_rcode  = Exn.default "?" (fun x -> string_of_rcode (rcode_of_int x))
 191
 192 let class_in = 1 (* CLASS IN *)
 193 let opcode_query = 0 (* OPCODE QUERY *)
 194
 195 (* 4.1.2. Question section format *)
 196
 197 let bits x = 8 * x
 198 let string_bits x = 8 * String.length x
 199
 200 let get_question refstr =
 201   match domain_name !refstr with
 202   | None -> fmterror "owner name"
 203   | Some (tail,domain) ->
 204      match%bitstring tail with
 205      | {| qtype : 16; qclass : 16; rest: -1 :bitstring |} ->
 206         let question = subbitstring !refstr 0 (32 + (domain |> labels_of_domain |> String.length |> bits)) in
 207         refstr := rest;
 208         if class_in = qclass then (qtype_of_int qtype, domain, question) else notimpl "QCLASS %u" qclass
 209      | {| _ |} -> fmterror "question section"
 210
 211 let just_get_question str = get_question (ref str)
 212
 213 (* 4.1.3. Resource record format *)
 214
 215 type domain = string list
 216 type rr_record =
 217   | RR_None
 218   | RR_A of domain * int32 * Network.ipv4
 219   | RR_CNAME of domain * domain
 220   | RR_MX of (int * domain) list
 221   | RR_Unknown of int
 222   | RR_TXT of string list
 223
 224 type info = { id : int; qtype : qtype; domain : domain; }
 225
 226 (* parse answer (incomplete) *)
 227 let get_answer refstr =
 228   match domain_name !refstr with
 229   | None -> RR_None
 230   | Some (tail,domain) ->
 231      match%bitstring tail with
 232      | {| 1 (* A *) : 16; 1 (* IN *) : 16; ttl : 32 : unsigned; 4 : 16; rdata : 32; rest: -1 :bitstring |} -> refstr := rest; RR_A (domain,ttl,Network.ipv4_of_int32 rdata)
 233      | {| 5 (* CNAME *) : 16; 1 : 16; _ttl : 32 : unsigned; n : 16; rdata : bits n : bitstring; rest: -1 :bitstring |} -> refstr := rest;
 234         begin match domain_name rdata with
 235         | Some (tail,cname) when bitstring_length tail = 0 -> RR_CNAME (domain, cname)
 236         | _ -> RR_None
 237         end
 238      | {| 16 (* TXT *) : 16; 1 : 16; _ttl : 32 : unsigned; n : 16; rdata : bits n : bitstring; rest: -1 :bitstring |} -> refstr := rest;
 239        RR_TXT (try character_strings_exn rdata with exn -> Exn.fail ~exn "bad TXT record %S" (string_of_bitstring rdata))
 240      | {| 15 (* MX *) : 16; 1 : 16; _ttl : 32 : unsigned; n : 16; rdata : bits n : bitstring; rest: -1 :bitstring |} -> refstr := rest;
 241         begin match%bitstring rdata with
 242         | {| preference : 16 : unsigned; exchange : -1 : bitstring |} ->
 243           begin match domain_name exchange with
 244           | Some (tail,mxname) when bitstring_length tail = 0 -> RR_MX [ preference, mxname; ]
 245           | _ -> RR_None
 246           end
 247         | {| _ |} -> RR_None
 248         end
 249      (* unknown record *)
 250      | {| typ : 16; _cls : 16; _ttl : 32 : unsigned; n : 16; _rdata : bits n : bitstring; rest: -1 :bitstring |} -> refstr := rest; RR_Unknown typ
 251      | {| _ |} -> RR_None
 252
 253 let hour = 3600l
 254 let hours = Int32.mul hour
 255 let day = hours 24l
 256 let days = Int32.mul day
 257 let default_ttl = hours 2l
 258
 259 let make_rr domain rtype ?(ttl=default_ttl) rdata =
 260   let name = labels_of_domain domain in
 261   let len = bitstring_length rdata in
 262   assert (0 = len mod 8);
 263   let len = len / 8 in
 264   [%bitstring {|
 265     name : string_bits name : string;
 266     int_of_qtype rtype : 16;
 267     class_in : 16;
 268     ttl : 32 : unsigned;
 269     len : 16 : unsigned;
 270     rdata : 8 * len : bitstring
 271    |}]
 272
 273 let make_rr_a domain ?(ttl=default_ttl) addr =
 274   let addr = Network.int32_of_ipv4 addr in
 275   make_rr domain A ~ttl ([%bitstring {| addr : 4*8 : unsigned |} ] )
 276
 277 let make_rr_txt domain ?ttl txt =
 278   assert (String.length txt < 256);
 279   make_rr domain TXT ?ttl ([%bitstring {| String.length txt : 8; txt : string_bits txt : string |} ])
 280
 281 let pkt_out out (pkt:pkt) =
 282   try
 283   decode_dns_header pkt begin fun ~id ~qr ~opc ~aa ~tc ~rd ~ra ~z:_ ~rcode ~qdcount ~ancount ~arcount ~adcount ~rest ->
 284       IO.printf out "DNS: id %u\n" id;
 285       let flags = [qr,"qr"; aa,"aa"; tc,"tc"; rd,"rd"; ra,"ra"] |> List.filter_map (function (true,s) -> Some s | _ -> None) in
 286       IO.printf out "%s %s %s\n" (describe_opcode opc) (String.concat " " flags) (describe_rcode rcode);
 287       IO.printf out "qd# %d an# %d ar# %d ad# %d\n" qdcount ancount arcount adcount;
 288       let rest = ref rest in
 289       if qdcount > 0 then
 290       begin
 291         IO.printf out "Query: ";
 292         try
 293           let (qtype,domain,_) = get_question rest in
 294           IO.printf out "%s : %s\n" (string_of_qtype qtype) (string_of_domain domain)
 295         with
 296         | Error (_,reason) -> IO.printf out "error : %s\n" reason
 297         | exn -> IO.printf out "ERROR : %s\n" (Exn.str exn)
 298       end;
 299       for _i = 1 to ancount do
 300         match get_answer rest with
 301         | RR_None -> IO.printf out "Answer: unrecognized\n"
 302         | RR_A (dom,ttl,addr) ->
 303             IO.printf out "Answer: A %s ip %s ttl %s\n" (string_of_domain dom) (Network.string_of_ipv4 addr) (Time.duration_str @@ Int32.to_float ttl)
 304         | RR_CNAME (dom,cname) ->
 305             IO.printf out "Answer: CNAME %s %s\n" (string_of_domain dom) (string_of_domain cname)
 306         | RR_MX l ->
 307           List.iter (fun (pref, mxname) -> IO.printf out "Answer: MX %d %s\n" pref (string_of_domain mxname)) l
 308         | RR_TXT l ->
 309             IO.printf out "Answer: TXT"; List.iter (IO.printf out " %S") l; IO.printf out "\n"
 310         | RR_Unknown n ->
 311             IO.printf out "Answer: Unknown (%d)\n" n
 312       done
 313   end
 314   with InvalidHeader -> IO.printf out "<?>\n"
 315
 316 let pkt_out_s pkt = Control.wrapped_outs @@ flip pkt_out pkt
 317
 318 let pkt_info (pkt:pkt) =
 319   let out = IO.output_string () in
 320    (try
 321      decode_dns_header pkt begin fun ~id:_ ~qr:_ ~opc ~aa:_ ~tc:_ ~rd:_ ~ra:_ ~z:_ ~rcode ~qdcount ~ancount ~arcount:_ ~adcount:_ ~rest ->
 322       IO.printf out "%s %s" (describe_opcode opc) (describe_rcode rcode);
 323       let rest = ref rest in
 324       if qdcount > 0 then
 325       begin
 326         try
 327           let (qtype,domain,_) = get_question rest in
 328           IO.printf out " %s for %s" (string_of_qtype qtype) (string_of_domain domain)
 329         with
 330         | Error (_,reason) -> IO.printf out " error : %s" reason
 331         | exn -> IO.printf out " ERROR : %s" (Exn.str exn)
 332       end;
 333       let ans = List.init ancount (fun _ ->
 334         match get_answer rest with
 335         | RR_None -> "?"
 336         | RR_A (_domain,_ttl,addr) -> "A " ^ Network.string_of_ipv4 addr
 337         | RR_CNAME (_domain,cname) -> "CNAME " ^ string_of_domain cname
 338         | RR_MX l -> "MX " ^ Stre.list (fun (pref, mxname) -> sprintf "%d %s" pref (string_of_domain mxname)) l
 339         | RR_TXT l -> sprintf "TXT %s" (Stre.list (sprintf "%S") l)
 340         | RR_Unknown n -> sprintf "? (%d)" n
 341         )
 342       in
 343       IO.printf out " {%s}" (String.concat "," ans)
 344      end
 345    with InvalidHeader -> IO.printf out "no dns header");
 346   IO.close_out out
 347
 348 (** parse DNS packet (only IN QUERY A and CNAME for now), extract question and answer sections *)
 349 let parse s =
 350   try
 351     decode_dns_header (to_pkt s) begin fun ~id ~qr ~opc ~aa ~tc:_ ~rd ~ra ~z:_ ~rcode ~qdcount ~ancount ~arcount:_ ~adcount:_ ~rest ->
 352       if qdcount <> 1 then Exn.fail "dns header: qdcount = %d" qdcount;
 353       if opc <> opcode_query then Exn.fail "Expected QUERY, got %s" (describe_opcode opc);
 354 (*       if tc then Exn.fail "TrunCated"; *)
 355       let rest = ref rest in
 356       let (qtype,domain,_) = get_question rest in
 357       let cname = ref None in
 358       let answers = List.init ancount (fun _ -> get_answer rest) in
 359       let addrs = answers |> List.filter_map
 360         (function
 361         | RR_None | RR_Unknown _ -> None
 362         | RR_A (_domain,ttl,addr) -> Some (addr, ttl)
 363         | RR_TXT _ -> None
 364         | RR_CNAME (_domain,name) -> cname := Some name; None
 365         | RR_MX [] -> None
 366         | RR_MX ((_pref, mxname) :: _) -> cname := Some mxname; None)
 367       in
 368       let txt = answers |> List.filter_map (function RR_TXT s -> Some s | _ -> None) in
 369       let typ = match qr with
 370       | false -> `Query rd
 371       | true -> `Reply (rcode_of_int rcode,aa,ra)
 372       in
 373       { id; qtype; domain; }, typ, !cname, addrs, txt
 374     end
 375   with InvalidHeader -> Exn.fail "no dns header"
 376
 377 (* --- From bitstring 2.0.0 *)
 378
 379 (* Concatenate bitstrings. *)
 380 let concat_bs bs =
 381   let buf = Buffer.create () in
 382   List.iter (construct_bitstring buf) bs;
 383   Buffer.contents buf
 384
 385 (* --- *)
 386
 387 let make_reply_packet rcode id opc rr_qd (rr_an,rr_ns,rr_ar) =
 388   let qr = true and aa = true and tc = false and rd = false and ra = false in
 389   let%bitstring hdr =
 390   {|
 391     id : 16;
 392     qr : 1; opc : 4; aa : 1; tc : 1; rd : 1; ra : 1; 0 : 3; int_of_rcode rcode : 4;
 393     List.length rr_qd : 16;
 394     List.length rr_an : 16;
 395     List.length rr_ns : 16;
 396     List.length rr_ar : 16
 397   |}
 398   in concat_bs (hdr :: List.flatten [rr_qd; rr_an; rr_ns; rr_ar])
 399
 400 let make_soa_rdata d =
 401   let mname = match d.SOA.ns with [] -> Exn.fail "SOA.ns empty" | h::_ -> h |> domain_of_string |> labels_of_domain in
 402   let rname = "hostmaster" :: (domain_of_string d.SOA.name) |> labels_of_domain in
 403   let serial = 1l
 404   and refresh = hour
 405   and retry = hour
 406   and expire = days 14l
 407   and minimum = default_ttl
 408   in
 409   [%bitstring {|
 410     mname : string_bits mname : string;
 411     rname : string_bits rname : string;
 412     serial : 32 : unsigned;
 413     refresh : 32 : unsigned;
 414     retry : 32 : unsigned;
 415     expire : 32 : unsigned;
 416     minimum : 32 : unsigned
 417    |}]
 418
 419 let make_rr_ns domain name =
 420   let ns = labels_of_domain (domain_of_string name) in (* FIXME *)
 421   make_rr domain NS ([%bitstring {| ns : string_bits ns : string |}])
 422
 423 let make_rr_soa d =
 424   make_rr (domain_of_string d.SOA.name) SOA (make_soa_rdata d)
 425
 426 (* FIXME global vars *)
 427
 428 (* replies with REFUSED *)
 429 let cnt_refused = ref 0
 430 (* not QUERY opcodes *)
 431 let cnt_opcode = ref 0
 432 (* bad packets *)
 433 let cnt_error = ref 0
 434
 435 module CC = Cache.Count
 436 let cnt_qtype = CC.create ()
 437 let qtypes () = CC.show cnt_qtype string_of_qtype
 438
 439 let answer_query resolve qtype domain =
 440   let open SOA in
 441   match resolve domain with
 442   | None ->
 443     incr cnt_refused;
 444     refused "couldn't resolve %s" (string_of_domain domain)
 445   | Some d ->
 446     CC.add cnt_qtype qtype;
 447     match qtype with
 448     | CNAME | SOA -> [make_rr_soa d],[],[]
 449     | NS ->
 450       if domain_equal domain (domain_of_string d.name) then
 451         List.map (make_rr_ns domain) d.ns (* check for empty? *) , [], []
 452       else (* subdomain *)
 453         [],[make_rr_soa d],[]
 454       (*List.map (fun (name,ip) -> make_rr_a name ip) nameservers*)
 455     | A -> [make_rr_a domain d.ip],[],[]
 456     | _ -> notimpl "QTYPE %s" (string_of_qtype qtype)
 457
 458 let describe_exn exn =
 459   let (rcode,reason) = match exn with Error (rc,s) -> rc,s | exn -> SERVFAIL, Exn.str exn in
 460   rcode, sprintf "%s : %s" (string_of_rcode rcode) reason
 461
 462 let show_exn exn =
 463   let (rcode,str) = describe_exn exn in
 464   log #warn "error %s" str;
 465   rcode
 466
 467 let make_reply_exn (query:pkt) answer ?(handle_err=show_exn) k =
 468   try
 469     decode_dns_header query begin fun ~id ~qr ~opc ~aa:_ ~tc:_ ~rd:_ ~ra:_ ~z:_ ~rcode:_ ~qdcount:_ ~ancount:_ ~arcount:_ ~adcount:_ ~rest ->
 470       match qr with
 471       | true -> failwith "response bit set"
 472       | false ->
 473         let question = ref [] in
 474         try
 475           match opc with
 476           | 0 -> (* QUERY *)
 477             let (qtype,domain,qn) = just_get_question rest in
 478             question := [qn];
 479             let f reply = k @@ make_reply_packet OK id opc !question reply in
 480             answer qtype domain f
 481           | n -> incr cnt_opcode; notimpl "opcode %d" n
 482         with
 483         | exn ->
 484           let rcode = handle_err exn in
 485           k @@ make_reply_packet rcode id opc !question ([],[],[])
 486     end
 487   with InvalidHeader -> failwith "no dns header"
 488
 489 let make_reply (query:pkt) answer =
 490   try
 491     make_reply_exn query answer some
 492   with
 493   | exn ->
 494     incr cnt_error;
 495     log #error "DNS error: %s" (Exn.str exn);
 496     None
 497
 498 let make_reply_s query answer =
 499   try
 500     make_reply_exn (to_pkt query) answer (fun p -> Some (of_pkt p))
 501   with
 502   | exn ->
 503     incr cnt_error;
 504     log #error "DNS error: %s" (Exn.str exn);
 505     None
 506
 507 (** DNS ID is 16-bit *)
 508 let max_id = 0xffff
 509
 510 (* build simplest IN query packet *)
 511 let query_pkt ?edns id qtype name =
 512   let qr = false and aa = false and tc = false and rd = true and ra = false in
 513   let dnssec_ok = false in
 514   let rcode = 0 in
 515   let id = id land max_id in
 516   let domain = labels_of_domain name in
 517   let qtype = int_of_qtype qtype and qclass = class_in and opc = opcode_query in
 518   let pkt =
 519     [%bitstring {|
 520       id : 16;
 521       qr : 1; opc : 4; aa : 1; tc : 1; rd : 1; ra : 1; 0 : 3; rcode : 4;
 522       1 : 16;
 523       0 : 16;
 524       0 : 16;
 525       if edns <> None then 1 else 0 : 16;
 526       domain : 8 * String.length domain : string;
 527       qtype : 16;
 528       qclass : 16
 529     |}]
 530   in
 531   match edns with
 532   | None -> pkt
 533   | Some len ->
 534     Bitstring.concat
 535       [
 536         pkt;
 537         [%bitstring {|
 538           0 : 8;
 539           41 : 16;
 540           len : 16;
 541           0 : 8; 0: 8; dnssec_ok : 1; 0 : 15;
 542           0 : 16
 543         |}]
 544       ]
 545
 546 let make_query ?edns id qtype domain = of_pkt @@ query_pkt ?edns id qtype (domain_of_string domain)