dns-toy/lib/response.ml

open Types
open Utils

let parse_header (reader : reader) =
  let max_size = 6 in
  match List.init max_size (fun offset -> unpack_short_be reader.data (offset * 2)) with
  | [ id; flags; num_questions; num_answers; num_authorities; num_additionals ] ->
    ( { reader with pointer = reader.pointer + (max_size * 2) }
    , { id; flags; num_questions; num_answers; num_authorities; num_additionals } )
  | _ -> failwith "Invalid number of fields"
;;

let rec parse_question (reader : reader) =
  let name, offset_name = decode_name reader in
  let data = bytes_forward reader.data (reader.pointer + offset_name) in
  let max_size = 2 in
  match List.init max_size (fun offset -> unpack_short_be data (offset * 2)) with
  | [ type_; class_ ] ->
    ( { reader with pointer = reader.pointer + offset_name + (max_size * 2) }
    , { name; type_; class_ } )
  | _ -> failwith "Invalid number of fields"

and decode_name reader =
  let rec read_parts parts pos =
    let length = int_of_char (Bytes.get reader.data (reader.pointer + pos)) in
    if length = 0
    then 1, parts
    else if length land 0b1100_0000 <> 0
    then (
      let decoded_name =
        decode_compressed_name { reader with pointer = reader.pointer + pos } length
      in
      2, decoded_name :: parts)
    else (
      let part = Bytes.sub_string reader.data (reader.pointer + pos + 1) length in
      let last_length, parts' = read_parts (parts @ [ part ]) (pos + 1 + length) in
      last_length + length + 1, parts')
  in
  let offset, parts = read_parts [] 0 in
  String.to_bytes (String.concat "." parts), offset

and decode_compressed_name reader length =
  let pointer_bytes =
    Bytes.cat
      (int_to_bytes (length land 0b0011_1111))
      (Bytes.sub reader.data (reader.pointer + 1) 1)
  in
  let pointer = unpack_short_be pointer_bytes 0 in
  String.of_bytes (fst (decode_name { reader with pointer }))
;;

let parse_record reader =
  let name, offset_name = decode_name reader in
  let data = bytes_forward reader.data (offset_name + reader.pointer) in
  let data_len = unpack_short_be data 8 in
  let record_len = 10 in
  let type_ = unpack_short_be data 0 in
  ( { reader with pointer = reader.pointer + offset_name + record_len + data_len }
  , { name
    ; type_
    ; class_ = unpack_short_be data 2
    ; ttl = unpack_int_be data 4
    ; data =
        (let raw_data = Bytes.sub data record_len data_len in
         match type_ with
         | t when t = DNSType.ns ->
           fst
             (decode_name
                { reader with pointer = reader.pointer + offset_name + record_len })
         | t when t = DNSType.a -> String.to_bytes (get_ip raw_data)
         | _ -> raw_data)
    } )
;;

let parse_dns_packet data =
  let rec create_list reader n fn acc =
    if n = 0
    then reader, List.rev acc
    else (
      let next_reader, res = fn reader in
      create_list next_reader (n - 1) fn (res :: acc))
  in
  let reader, header = parse_header { data; pointer = 0 } in
  let reader2, questions = create_list reader header.num_questions parse_question [] in
  let reader3, answers = create_list reader2 header.num_answers parse_record [] in
  let reader4, authorities = create_list reader3 header.num_authorities parse_record [] in
  let _, additionals = create_list reader4 header.num_additionals parse_record [] in
  (* print_endline (Debug.dns_header header);
  List.iter (fun el -> print_endline (Debug.dns_question el)) questions;
  List.iter (fun el -> print_endline (Debug.dns_record el)) answers;
  List.iter (fun el -> print_endline (Debug.dns_record el)) authorities;
  List.iter (fun el -> print_endline (Debug.dns_record el)) additionals; *)
  { header; questions; answers; authorities; additionals }
;;