mte/unikernel/duniverse/ocaml-dns/zone/dns_zone_lexer.mll
2025-11-11 02:07:51 +01:00

116 lines
4.4 KiB
OCaml

(*
* Copyright (c) 2006 Tim Deegan <tjd@phlegethon.org>
* Copyright (c) 2010-12 Anil Madhavapeddy <anil@recoil.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.
*
* dnslexer.mll -- ocamllex lexer for DNS "Master zone file" format
*
* DNS master zonefile format is defined in RFC 1035, section 5.
* Escapes and octets are clarified in RFC 4343
*)
{
open Dns_zone_state
open Dns_zone_parser
open Lexing
(* Disambiguate keywords and generic character strings -- when updating this,
please ensure to update the keyword_or_number rule in dns_zone_parser.mly
and add it to the testuite in test/server.ml *)
let kw_or_cs s = match (String.uppercase_ascii s) with
"A" -> TYPE_A s
| "NS" -> TYPE_NS s
| "CNAME" -> TYPE_CNAME s
| "SOA" -> TYPE_SOA s
| "PTR" -> TYPE_PTR s
| "MX" -> TYPE_MX s
| "TXT" -> TYPE_TXT s
| "AAAA" -> TYPE_AAAA s
| "SRV" -> TYPE_SRV s
| "SVCB" -> TYPE_SVCB s
| "HTTPS" -> TYPE_HTTPS s
| "DNSKEY" -> TYPE_DNSKEY s
| "CAA" -> TYPE_CAA s
| "TLSA" -> TYPE_TLSA s
| "SSHFP" -> TYPE_SSHFP s
| "DS" -> TYPE_DS s
| "LOC" -> TYPE_LOC s
| "IN" -> CLASS_IN s
| "CS" -> CLASS_CS s
| "CH" -> CLASS_CH s
| "HS" -> CLASS_HS s
| "N" -> LAT_DIR s
| "S" -> LAT_DIR s
| "E" -> LONG_DIR s
| "W" -> LONG_DIR s
| _ -> CHARSTRING s
(* Scan an accepted token for linebreaks *)
let count_linebreaks s =
String.iter (function '\n' -> state.lineno <- state.lineno + 1 | _ -> ()) s
}
let eol = [' ''\t']* (';' [^'\n']*)? '\n'
let octet = '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
let escape = '\\' _ (* Strictly \0 is not an escape, but be liberal *)
let qstring = '"' ((([^'\\''"']|octet|escape)*) as contents) '"'
let label = (([^'\\'' ''\t''\n''.''('')']|octet|escape)*) as contents
let number = (['0'-'9']+) as contents
let neg_number = ('-' ['0'-'9']+) as contents
let meters = ('-'? ['0'-'9']+ ('.' ['0'-'9']? ['0'-'9']?)? as contents) 'm'
let openpar = [' ''\t']* '(' ([' ''\t''\n'] | eol)*
let closepar = (eol | [' ''\t''\n'])* ')' [' ''\t']*
let typefoo = (['T''t']['Y''y']['P''p']['E''e'] number) as contents
(* Rfc9460 Appendix A *)
let svcb_non_special = '!' | ['#'-'\''] | ['*'-':'] | ['<'-'['] | [']'-'~']
let svcb_non_digit = ['!'-'/'] | [':'-'~']
let svcb_dec_octet = (('0' | '1') ['0'-'9'] ['0'-'9']) | ('2' ((['0'-'4'] ['0'-'9']) ('5' ['0'-'5'])))
let svcb_escaped = '\\' (svcb_non_digit | svcb_dec_octet)
let svcb_contigious = (svcb_non_special | svcb_escaped)+
let svcb_quoted = '"' (svcb_contigious | (['\\']? ' ')) '"'
let svcb_char_string = svcb_contigious | svcb_quoted
(* Rfc9460 2.1 *)
let svcbkey = (['a'-'z']|['0'-'9']|'-')*
let svcbval = svcb_char_string
let svcbvalq = '"' svcbval '"'
let svcbparam = (svcbkey '=' (svcbval | svcbvalq)) as contents
rule token = parse
eol { state.lineno <- state.lineno + 1;
if state.paren > 0 then SPACE else EOL }
| openpar { state.paren <- state.paren + 1;
count_linebreaks (lexeme lexbuf); SPACE }
| closepar { if state.paren > 0 then state.paren <- state.paren - 1;
count_linebreaks (lexeme lexbuf); SPACE }
| closepar eol { if state.paren > 0 then state.paren <- state.paren - 1;
count_linebreaks (lexeme lexbuf); EOL }
| "\\#" { GENERIC }
| "$ORIGIN" { SORIGIN }
| "$TTL" { STTL }
| '.' { DOT }
| '@' { AT }
| number { NUMBER contents }
| neg_number { NEG_NUMBER contents }
| meters { METERS contents }
| typefoo { TYPE_GENERIC contents }
| qstring { count_linebreaks contents; CHARSTRING contents }
| svcbparam { count_linebreaks contents; SVCBPARAM contents }
| label { count_linebreaks contents; kw_or_cs contents }
| [' ''\t']+ { SPACE }
| eof { EOF }