/*
 * Copyright (c) 2005-2006 Tim Deegan <tjd@phlegethon.org>
 * Copyright (c) 2017, 2018 Hannes Mehnert <hannes@mehnert.org>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *
 *  dnsparser.mly -- ocamlyacc parser for DNS "Master zone file" format
 */

%{

open Dns_zone_state
open Dns

let parse_error s = raise (Zone_parse_problem s)

(* Parsers for numbers *)
let parse_uint8 s =
  try let d = int_of_string s in
  if d < 0 || d > 255 then raise Parsing.Parse_error;
  d
  with Failure _ -> raise Parsing.Parse_error

let parse_uint16 s =
  try
    let n = int_of_string s in
    if n > 65535 then raise Parsing.Parse_error;
    n
  with Failure _ -> raise Parsing.Parse_error

let parse_uint32 s =
  try
    let n = Int64.of_string s in
    if n >= 4294967296L then raise Parsing.Parse_error;
    Int64.to_int32 n
  with Failure _ -> raise Parsing.Parse_error

(* Parse an IPv6 address.  (RFC 3513 section 2.2) *)
let parse_ipv6 s =
  Ipaddr.V6.of_string_exn s

let add_to_map name ~ttl (Rr_map.B (k, v)) =
  let v = Rr_map.with_ttl k v ttl in
  Name_rr_map.add name k v

%}

%token EOF
%token EOL
%token SORIGIN
%token STTL
%token AT
%token DOT
%token SPACE
%token GENERIC
%token <string> NUMBER
%token <string> NEG_NUMBER
%token <string> CHARSTRING
%token <string> SVCBPARAM

%token <string> TYPE_A
%token <string> TYPE_NS
%token <string> TYPE_CNAME
%token <string> TYPE_SOA
%token <string> TYPE_PTR
%token <string> TYPE_MX
%token <string> TYPE_TXT
%token <string> TYPE_AAAA
%token <string> TYPE_SRV
%token <string> TYPE_SVCB
%token <string> TYPE_HTTPS
%token <string> TYPE_CAA
%token <string> TYPE_DNSKEY
%token <string> TYPE_TLSA
%token <string> TYPE_SSHFP
%token <string> TYPE_DS
%token <string> TYPE_LOC
%token <string> TYPE_GENERIC

%token <string> CLASS_IN
%token <string> CLASS_CS
%token <string> CLASS_CH
%token <string> CLASS_HS

%token <string> METERS
%token <string> LAT_DIR
%token <string> LONG_DIR

%start zfile
%type <Dns.Name_rr_map.t> zfile

%%

zfile: lines EOF { state.zone }

lines:
   /* nothing */ { }
 | lines EOL { }
 | lines origin EOL { }
 | lines ttl EOL { }
 | lines rrline EOL { }

s: SPACE {} | s SPACE {}

origin: SORIGIN s domain { state.origin <- $3 }

ttl: STTL s int32 { state.ttl <- $3 }

rrline:
   owner s int32 s rrclass s rr { state.zone <- add_to_map $1 ~ttl:$3 $7 state.zone }
 | owner s rrclass s int32 s rr { state.zone <- add_to_map $1 ~ttl:$5 $7 state.zone  }
 | owner s rrclass s rr { state.zone <- add_to_map $1 ~ttl:state.ttl $5 state.zone }
 | owner s int32 s rr { state.zone <- add_to_map $1 ~ttl:$3 $5 state.zone }
 | owner s rr { state.zone <- add_to_map $1 ~ttl:state.ttl $3 state.zone }

rrclass:
   CLASS_IN {}
 | CLASS_CS { parse_error "class must be \"IN\"" }
 | CLASS_CH { parse_error "class must be \"IN\"" }
 | CLASS_HS { parse_error "class must be \"IN\"" }

rr:
generic_type s generic_rdata {
  match Rr_map.I.of_int $1 with
  | Ok i -> B (Unknown i, (0l, Rr_map.Txt_set.singleton $3))
  | Error _ -> parse_error "type code reserved, not generic"
}
     /* RFC 1035 */
 | TYPE_A s ipv4 { B (A, (0l, Ipaddr.V4.Set.singleton $3)) }
 | TYPE_NS s hostname { B (Ns, (0l, Domain_name.Host_set.singleton $3)) }
 | TYPE_CNAME s domain { B (Cname, (0l, $3)) }
 | TYPE_SOA s domain s domain s int32 s int32 s int32 s int32 s int32
     { B (Soa, { Soa.nameserver = $3 ; hostmaster = $5 ; serial = $7 ;
                 refresh = $9 ; retry = $11 ; expiry = $13 ; minimum = $15 }) }
 | TYPE_PTR s hostname { B (Ptr, (0l, $3)) }
 | TYPE_MX s int16 s hostname
     { let mx = { Mx.preference = $3 ; mail_exchange = $5 } in
       B (Mx, (0l, Rr_map.Mx_set.singleton mx)) }
 | TYPE_TXT s charstrings
     { let txt = String.concat "" $3 in
       if String.length txt > 65279 then
         (* there's only so much space for a RR - TXT needs for each 255 byte an extra length byte *)
         parse_error "A single TXT rdata may not exceed 65279 bytes";
       B (Txt, (0l, Rr_map.Txt_set.singleton txt)) }
     /* RFC 2782 */
 | TYPE_SRV s int16 s int16 s int16 s hostname
     { let srv = { Srv.priority = $3 ; weight = $5 ; port = $7 ; target = $9 } in
       B (Srv, (0l, Rr_map.Srv_set.singleton srv)) }
     /* RFC 9460 */
 | TYPE_SVCB s int16 s hostname
     {  let svc_priority = $3 in
        let target_name = $5 in
        let svc_params = [] in
        let svcb = { Svcb.svc_priority ; target_name ; svc_params } in
        B (Svcb, (0l, Rr_map.Svcb_set.singleton svcb))
      }
 | TYPE_SVCB s int16 s hostname s svcbparams
     {  let svc_priority = $3 in
        let target_name = $5 in
        let svc_params =
          List.fold_left (fun acc s ->
            let tokens = String.split_on_char '=' s in
            if List.length tokens = 1 then (
              let key = List.nth tokens 0 in
              match key with
              | "no-default-alpn" -> Svcb.No_default_alpn::acc
              | "ech" -> parse_error "SVCB 'ech' parameter currently reserved"
              | _ -> parse_error ("Unknown SVCB parameter: "^key)
            ) else if List.length tokens = 2 then (
              let key = List.nth tokens 0 in
              let value = List.nth tokens 1 in
              match key with
              | "mandatory" -> (
                let values = String.split_on_char ',' value in
                let mandatories =
                  List.fold_left (fun a p ->
                    match p with
                    | "mandatory" ->
                      parse_error "SVCB param : mandatory not allowed as a mandatory parameter"
                    | "alpn" -> 1::a
                    | "no-default-alpn" -> 2::a
                    | "port" -> 3::a
                    | "ipv4hint" -> 4::a
                    | "ech" ->
                      parse_error "SVCB param : ech is a reserved parameter"
                    | "ipv6hint" -> 6::a
                    | _ -> (
                      if String.starts_with ~prefix:"key" p then (
                        let len = String.length p in
                        let key_num = int_of_string (String.sub p 3 (len-3)) in
                        if key_num <= 6 then (
                          parse_error ("SVCB mandatory key value should be greater than 6: "^p)
                        ) else key_num::a
                      ) else parse_error ("Unknown mandatory parameter: "^p)
                    )
                  ) [] values
                in
                Mandatory mandatories::acc
              )
              | "alpn" -> (
                let values = String.split_on_char ',' value in
                Alpn values::acc
              )
              | "port" -> (
                Port (int_of_string value)::acc
              )
              | "ipv4hint" -> (
                let value = String.fold_left (fun a' c -> if c = '"' then a' else a'^(Char.escaped c)) "" value in
                let values = String.split_on_char ',' value in
                let ipv4s =
                  List.fold_left (fun a ipv4 ->
                    (Ipaddr.V4.of_string_exn ipv4)::a
                  ) [] values
                in
                Ipv4_hint ipv4s::acc
              )
              | "ipv6hint" -> (
                let value = String.fold_left (fun a' c -> if c = '"' then a' else a'^(Char.escaped c)) "" value in
                let values = String.split_on_char ',' value in
                let ipv6s =
                  List.fold_left (fun a ipv6 ->
                    (parse_ipv6 ipv6)::a
                  ) [] values
                in
                Ipv6_hint ipv6s::acc
              )
              | _ -> (
                if String.starts_with ~prefix:"key" key then (
                  let len = String.length key in
                  let key_num = int_of_string (String.sub key 3 (len-3)) in
                  if key_num <= 6 then (
                    parse_error ("SVCB key parameter should be greater than 6: "^key)
                  ) else Key (key_num,value)::acc
                ) else parse_error ("Unknown mandatory parameter: "^key)
              )
            ) else parse_error "Cannot have more than one '=' in a SVCB param field"
          ) [] $7
        in
        let mandatory_opt,svc_params =
          List.fold_left (fun (m,ps) p ->
            match p with
            | Svcb.Mandatory mandatory_list -> (
              (* check for multiple instances of same SvcParamKey in mandatory list *)
              let multiple_exists,_ =
                List.fold_left 
                  (fun (flag,a') k ->
                    if flag then (flag,(k::a')) else (List.exists (fun k' -> k = k') a'),(k::a')) (false,[]) mandatory_list
              in
              if multiple_exists then parse_error ("SVCB : multiple instances of the same SvcParamKey in mandatory list");
              (Some p),ps
            )
            | _ -> (
              (* check for multiple instances of the same SvcParamKey*)
              if List.exists
                (fun k ->
                  match k, p with
                  | Svcb.Mandatory _, Mandatory _ -> true
                  | Alpn _, Alpn _ -> true
                  | No_default_alpn, No_default_alpn -> true
                  | Port _, Port _ -> true
                  | Ipv4_hint _, Ipv4_hint _ -> true
                  | Ipv6_hint _, Ipv6_hint _ -> true
                  | Key (k',_), Key (p',_) -> (k' = p')
                  | _, _ -> false
                ) ps then parse_error ("SVCB : multiple instances of the same SvcParamKey");
              m,(p::ps)
            )
          ) (None,[]) svc_params
        in
        let svc_params = if Option.is_some mandatory_opt then (Option.get mandatory_opt)::svc_params else svc_params in
        let svcb = { Svcb.svc_priority ; target_name ; svc_params } in
        B (Svcb, (0l, Rr_map.Svcb_set.singleton svcb))
        }
 | TYPE_HTTPS s int16 s hostname
     {  let svc_priority = $3 in
        let target_name = $5 in
        let svc_params = [] in
        let https = { Https.svc_priority ; target_name ; svc_params } in
        B (Https, (0l, Rr_map.Https_set.singleton https))
      }
  | TYPE_HTTPS s int16 s hostname s svcbparams
      {  let svc_priority = $3 in
          let target_name = $5 in
          let svc_params =
            List.fold_left (fun acc s ->
              let tokens = String.split_on_char '=' s in
              if List.length tokens = 1 then (
                let key = List.nth tokens 0 in
                match key with
                | "no-default-alpn" -> Https.No_default_alpn::acc
                | "ech" -> parse_error "HTTPS 'ech' parameter currently reserved"
                | _ -> parse_error ("Unknown HTTPS parameter: "^key)
              ) else if List.length tokens = 2 then (
                let key = List.nth tokens 0 in
                let value = List.nth tokens 1 in
                match key with
                | "mandatory" -> (
                  let values = String.split_on_char ',' value in
                  let mandatories =
                    List.fold_left (fun a p ->
                      match p with
                      | "mandatory" ->
                        parse_error "HTTPS param : mandatory not allowed as a mandatory parameter"
                      | "alpn" -> 1::a
                      | "no-default-alpn" -> 2::a
                      | "port" -> 3::a
                      | "ipv4hint" -> 4::a
                      | "ech" ->
                        parse_error "HTTPS param : ech is a reserved parameter"
                      | "ipv6hint" -> 6::a
                      | _ -> (
                        if String.starts_with ~prefix:"key" p then (
                          let len = String.length p in
                          let key_num = int_of_string (String.sub p 3 (len-3)) in
                          if key_num <= 6 then (
                            parse_error ("HTTPS mandatory key value should be greater than 6: "^p)
                          ) else key_num::a
                        ) else parse_error ("Unknown mandatory parameter: "^p)
                      )
                    ) [] values
                  in
                  Mandatory mandatories::acc
                )
                | "alpn" -> (
                  let values = String.split_on_char ',' value in
                  Alpn values::acc
                )
                | "port" -> (
                  Port (int_of_string value)::acc
                )
                | "ipv4hint" -> (
                  let value = String.fold_left (fun a' c -> if c = '"' then a' else a'^(Char.escaped c)) "" value in
                  let values = String.split_on_char ',' value in
                  let ipv4s =
                    List.fold_left (fun a ipv4 ->
                    (Ipaddr.V4.of_string_exn ipv4)::a
                    ) [] values
                  in
                  Ipv4_hint ipv4s::acc
                )
                | "ipv6hint" -> (
                  let value = String.fold_left (fun a' c -> if c = '"' then a' else a'^(Char.escaped c)) "" value in
                  let values = String.split_on_char ',' value in
                  let ipv6s =
                    List.fold_left (fun a ipv6 ->
                    (parse_ipv6 ipv6)::a
                    ) [] values
                  in
                  Ipv6_hint ipv6s::acc
                )
                | _ -> (
                  if String.starts_with ~prefix:"key" key then (
                    let len = String.length key in
                    let key_num = int_of_string (String.sub key 3 (len-3)) in
                    if key_num <= 6 then (
                      parse_error ("HTTPS key parameter should be greater than 6: "^key)
                    ) else Key (key_num,value)::acc
                  ) else parse_error ("Unknown mandatory paramter: "^key)
                )
              ) else parse_error "Cannot have more than one '=' in a HTTPS param field"
            ) [] $7
          in
          let mandatory_opt,svc_params =
            List.fold_left (fun (m,ps) p ->
              match p with
              | Https.Mandatory mandatory_list -> (
                (* check for multiple instances of same SvcParamKey in mandatory list *)
                let multiple_exists,_ =
                  List.fold_left 
                    (fun (flag,a') k ->
                      if flag then (flag,(k::a')) else (List.exists (fun k' -> k = k') a'),(k::a')) (false,[]) mandatory_list
                in
                if multiple_exists then parse_error ("HTTPS : multiple instances of the same SvcParamKey in mandatory list");
                (Some p),ps
              )
              | _ -> (
                (* check for multiple instances of the same SvcParamKey*)
                if List.exists
                  (fun k ->
                    match k, p with
                    | Https.Mandatory _, Mandatory _ -> true
                    | Alpn _, Alpn _ -> true
                    | No_default_alpn, No_default_alpn -> true
                    | Port _, Port _ -> true
                    | Ipv4_hint _, Ipv4_hint _ -> true
                    | Ipv6_hint _, Ipv6_hint _ -> true
                    | Key (k',_), Key (p',_) -> (k' = p')
                    | _, _ -> false
                  ) ps then parse_error ("HTTPS : multiple instances of the same SvcParamKey");
                m,(p::ps)
              )
            ) (None,[]) svc_params
          in
          let svc_params = if Option.is_some mandatory_opt then (Option.get mandatory_opt)::svc_params else svc_params in
          let https = { Https.svc_priority ; target_name ; svc_params } in
          B (Https, (0l, Rr_map.Https_set.singleton https))
          }
     /* RFC 3596 */
 | TYPE_TLSA s int8 s int8 s int8 s hex
     { try
         let cert_usage = Tlsa.int_to_cert_usage $3
         and selector = Tlsa.int_to_selector $5
         and matching_type = Tlsa.int_to_matching_type $7
         in
         if String.length $9 > max_rdata_length - 3 then
           parse_error "TLSA payload exceeds maximum rdata size";
         let tlsa = { Tlsa.cert_usage ; selector ; matching_type ; data = $9 } in
         B (Tlsa, (0l, Rr_map.Tlsa_set.singleton tlsa ))
       with
       | Invalid_argument err -> parse_error err
     }
 | TYPE_SSHFP s int8 s int8 s hex
     { try
         let algorithm = Sshfp.int_to_algorithm $3
         and typ = Sshfp.int_to_typ $5
         in
         if String.length $7 > max_rdata_length - 2 then
           parse_error "SSHFP payload exceeds maximum rdata size";
         let sshfp = { Sshfp.algorithm ; typ ; fingerprint = $7 } in
         B (Sshfp, (0l, Rr_map.Sshfp_set.singleton sshfp))
       with
       | Invalid_argument err -> parse_error err
     }
 | TYPE_DS s int16 s int8 s int8 s hex
     { try
         let key_tag = $3
         and algorithm = Dnskey.int_to_algorithm $5
         and digest_type = Ds.int_to_digest_type $7
         in
         if String.length $9 > max_rdata_length - 4 then
           parse_error "DS payload exceeds maximum rdata size";
         let ds = { Ds.key_tag ; algorithm ; digest_type ; digest = $9 } in
         B (Ds, (0l, Rr_map.Ds_set.singleton ds))
       with
       | Invalid_argument err -> parse_error err
     }
 | TYPE_AAAA s ipv6 { B (Aaaa, (0l, Ipaddr.V6.Set.singleton $3)) }
 | TYPE_DNSKEY s int16 s int8 s int8 s charstring
     { if not ($5 = 3) then
         parse_error ("DNSKEY protocol is not 3, but " ^ string_of_int $5) ;
       try
         let algorithm = Dnskey.int_to_algorithm $7 in
         if String.length $9 > max_rdata_length - 4 then
           parse_error "DNSKEY exceeds maximum rdata size";
         let flags = Dnskey.decode_flags $3 in
         let dnskey = { Dnskey.flags ; algorithm ; key = $9 } in
         B (Dnskey, (0l, Rr_map.Dnskey_set.singleton dnskey))
       with
       | Invalid_argument err -> parse_error err
     }
 | TYPE_CAA s int8 s charstring s charstrings
     { let critical = if $3 = 0x80 then true else false in
       if String.length $5 <= 0 || String.length $5 >= 16 then
         parse_error "CAA tag length must be > 0 and < 16";
       let size =
         (* the values are ';' separated (thus + 1 here) *)
         List.fold_left (fun acc s -> acc + 1 + String.length s)
           (String.length $5) $7
       in
       (* actually flag + tag length = 2, but we already added one for the first
          value above *)
       if size > max_rdata_length - 1 then
         parse_error "CAA exceeds maximum rdata size";
       let caa = { Caa.critical ; tag = $5 ; value = $7 } in
       B (Caa, (0l, Rr_map.Caa_set.singleton caa)) }
     /* RFC 1876 */
 | TYPE_LOC s deg_min_sec LAT_DIR s deg_min_sec LONG_DIR s altitude precision
     { let loc = Loc.parse
        ~latitude:($3, if $4 = "N" then `North else `South )
        ~longitude:($6, if $7 = "E" then `East else `West )
        ~altitude:$9
        ~precision:$10
       in
       B (Loc, (0l, Rr_map.Loc_set.singleton loc)) }
 | CHARSTRING s { parse_error ("TYPE " ^ $1 ^ " not supported") }

single_hex: charstring
  { Ohex.decode $1 }

hex:
   single_hex { $1 }
 | hex s single_hex { $1 ^ $3 }

generic_type: TYPE_GENERIC
     { try parse_uint16 (String.sub $1 4 (String.length $1 - 4))
       with Parsing.Parse_error -> parse_error ($1 ^ " is not a 16-bit number")
     }

generic_rdata: GENERIC s NUMBER s hex
     { try
         let len = int_of_string $3
         and data = $5
         in
         if not (String.length data = len) then
           parse_error ("generic data length field is "
			   ^ $3 ^ " but actual length is "
			      ^ string_of_int (String.length data));
         if len > max_rdata_length then
           parse_error ("generic data length field exceeds maximum rdata size: " ^ $3);
	 data
       with Failure _ ->
	 parse_error ("\\# should be followed by a number")
     }

ipv4: NUMBER DOT NUMBER DOT NUMBER DOT NUMBER
     { try
	 let a = parse_uint8 $1 in
	 let b = parse_uint8 $3 in
	 let c = parse_uint8 $5 in
	 let d = parse_uint8 $7 in
         Ipaddr.V4.make a b c d
       with Failure _ | Parsing.Parse_error ->
	 parse_error ("invalid IPv4 address " ^ $1 ^ "." ^ $3 ^ "." ^ $5 ^ "." ^ $7)
     }

ipv6: charstring
     { try parse_ipv6 $1 with
       | Failure _ | Parsing.Parse_error ->
	  parse_error ("invalid IPv6 address " ^ $1)
     }

int8: NUMBER
     { try parse_uint8 $1
       with Parsing.Parse_error ->
	 parse_error ($1 ^ " is not a 8-bit number") }

int16: NUMBER
     { try parse_uint16 $1
       with Parsing.Parse_error ->
	 parse_error ($1 ^ " is not a 16-bit number") }

int32: NUMBER
     { try parse_uint32 $1
       with Failure _ ->
	 parse_error ($1 ^ " is not a 32-bit number") }

float:
    NUMBER                { ($1, "0") }
  | NUMBER DOT            { ($1, "0") }
  | NUMBER DOT NUMBER     { ($1, $3) }

secs: float
     { let integer, decimal = $1 in
       let decimal = decimal ^ String.make (3 - String.length decimal) '0' in
       let ( * ), (+) = Int32.mul, Int32.add in
       (parse_uint32 integer) * 1000l + (parse_uint32 decimal)
      }

deg_min_sec:
    int32 s int32 s secs s   { $1, $3, $5 }
  | int32 s int32 s          { $1, $3, 0l }
  | int32 s                  { $1, 0l, 0l }

meters:
    METERS {
      match String.split_on_char '.' $1 with
        | [integers ; decimal] -> (integers, decimal)
        | [integers] -> (integers, "0")
        | _ -> parse_error "invalid altitude"
    }
  | NUMBER                { ($1, "") }
  | NEG_NUMBER            { ($1, "") }
  | NUMBER DOT            { ($1, "") }
  | NEG_NUMBER DOT        { ($1, "") }
  | NUMBER DOT NUMBER     { ($1, $3) }
  | NEG_NUMBER DOT NUMBER { ($1, $3) }

centimetres: meters
     { let integers, decimal = $1 in
       (* note parsing only allows 2 decimal places,
         will throw an exception if String.length decimal > 2 *)
       let decimal = decimal ^ String.make (2 - String.length decimal) '0' in
       let centimetres = integers ^ decimal in
       Int64.of_string centimetres
     }

altitude: centimetres { $1 }

precision:
                                              { (100L, 1000000L, 1000L) }
  | s centimetres s centimetres s centimetres { ($2,  $4,        $6   ) }
  | s centimetres s centimetres               { ($2,  $4,        1000L) }
  | s centimetres                             { ($2,  1000000L,  1000L) }

/* The owner of an RR is more restricted than a general domain name: it
   can't be a pure number or a type or class.  If we see one of those we
   assume the owner field was omitted */
owner:
   /* nothing */ { state.owner }
 | domain { state.owner <- $1 ; state.owner }

domain:
   DOT { Domain_name.root }
 | AT { state.origin }
 | label_except_at { Domain_name.prepend_label_exn state.origin $1 }
 | label DOT { Domain_name.of_strings_exn [$1] }
 | label DOT domain_labels { Domain_name.of_strings_exn ($1 :: $3 @ (Domain_name.to_strings state.origin)) }
 | label DOT domain_labels DOT { Domain_name.of_strings_exn ($1 :: $3) }

domain_labels:
   label { [$1] }
 | domain_labels DOT label { $1 @ [$3] }

hostname: domain { Domain_name.host_exn $1 }

/* It's acceptable to re-use numbers and keywords as character-strings.
   This is pretty ugly: we need special cases to distinguish a domain
   that's made up of just an '@'. */

charstrings: charstring { [$1] } | charstrings s charstring { $1 @ [$3] }

charstring: CHARSTRING { $1 } | keyword_or_number { $1 } | AT { "@" }

svcbparams: svcbparam { [$1] } | svcbparams s svcbparam { $1 @ [$3] }

svcbparam: SVCBPARAM { $1 }

label_except_specials: CHARSTRING
    { if String.length $1 > 63 then
        parse_error "label is longer than 63 bytes";
      $1 }

label_except_at: label_except_specials { $1 } | keyword_or_number { $1 }

label: label_except_at { $1 } | AT { "@" }

keyword_or_number:
   NUMBER { $1 }
 | NEG_NUMBER { $1 }
 | TYPE_GENERIC { $1 }
 | TYPE_A { $1 }
 | TYPE_NS { $1 }
 | TYPE_CNAME { $1 }
 | TYPE_SOA { $1 }
 | TYPE_PTR { $1 }
 | TYPE_MX { $1 }
 | TYPE_TXT { $1 }
 | TYPE_AAAA { $1 }
 | TYPE_SRV { $1 }
 | TYPE_SVCB { $1 }
 | TYPE_HTTPS { $1 }
 | TYPE_DNSKEY { $1 }
 | TYPE_CAA { $1 }
 | TYPE_TLSA { $1 }
 | TYPE_SSHFP { $1 }
 | TYPE_DS { $1 }
 | TYPE_LOC { $1 }
 | CLASS_IN { $1 }
 | CLASS_CS { $1 }
 | CLASS_CH { $1 }
 | CLASS_HS { $1 }
 | LAT_DIR { $1 }
 | LONG_DIR { $1 }
 | METERS { $1 ^ "m" }

%%