unikernel/duniverse/ocaml-dns/zone/dns_zone.ml

@@ -0,0 +1,192 @@
+(*
+ * Copyright (c) 2005-2006 Tim Deegan <tjd@phlegethon.org>
+ * Copyright (c) 2017 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.
+ *
+ * dnsserver.ml -- an authoritative DNS server
+ *
+ *)
+
+let parse buf =
+  Dns_zone_state.reset ();
+  try
+    let buf =
+      if String.(get buf (pred (length buf))) = '\n' then buf else buf ^ "\n"
+    in
+    let lexbuf = Lexing.from_string buf in
+    Ok (Dns_zone_parser.zfile Dns_zone_lexer.token lexbuf)
+  with
+    | Parsing.Parse_error -> Error (`Msg (Fmt.str "zone parse error at line %d" Dns_zone_state.(state.lineno)))
+    | Dns_zone_state.Zone_parse_problem s -> Error (`Msg (Fmt.str "zone parse problem at line %d: %s" Dns_zone_state.(state.lineno) s))
+    | exn -> Error (`Msg (Printexc.to_string exn))
+
+let src = Logs.Src.create "dns_zone" ~doc:"DNS zone parse"
+module Log = (val Logs.src_log src : Logs.LOG)
+
+let decode_zone trie zone data =
+  match parse data with
+  | Error `Msg msg ->
+    Log.warn (fun m -> m "ignoring zone %a: %s (data %s)"
+                 Domain_name.pp zone msg data);
+    trie, Dns.Name_rr_map.empty
+  | Ok rrs ->
+    (* we take all resource records within the zone *)
+    (* TODO should we add RR one by one, and avoid to add RRs where we have
+       delegations? (e.g. a NS ? ; a TXT foo <- the TXT should be discarded) *)
+    let in_zone subdomain = Domain_name.is_subdomain ~domain:zone ~subdomain in
+    let zone_rrs, other_rrs =
+      Domain_name.Map.partition (fun name _ -> in_zone name) rrs
+    in
+    let trie' = Dns_trie.insert_map zone_rrs trie in
+    match Dns_trie.lookup zone Dns.Rr_map.Soa trie', Dns_trie.check trie' with
+    | Error _, _ ->
+      Log.warn (fun m -> m "ignoring %a: no SOA" Domain_name.pp zone);
+      trie, Dns.Name_rr_map.empty
+    | _, Error ze ->
+      Log.warn (fun m -> m "ignoring %a: zone check failed %a"
+                   Domain_name.pp zone Dns_trie.pp_zone_check ze);
+      trie, Dns.Name_rr_map.empty
+    | Ok _, Ok () -> trie', other_rrs
+
+let add_additional_glue trie (zone, other_rrs) =
+  (* collect potential glue:
+     - find NS entries for zone
+     - find A and AAAA records for name servers in other rrs
+       (Dns_trie.check ensures that the NS in zone have an address record)
+     - only if the other names are not in zones, they are picked from
+       this zone file *)
+  match Dns_trie.lookup zone Dns.Rr_map.Ns trie with
+  | Error _ ->
+    Log.warn (fun m -> m "no NS entries for %a" Domain_name.pp zone);
+    trie
+  | Ok (_, name_servers) ->
+    let not_authoritative nameserver =
+      match Dns_trie.lookup nameserver Dns.Rr_map.A trie with
+      | Error (`NotAuthoritative | `Delegation _) -> true
+      | _ -> false
+    in
+    let need_glue =
+      Domain_name.Host_set.filter not_authoritative name_servers
+    in
+    let raw_need_glue =
+      Domain_name.Host_set.fold (fun ns acc ->
+          Domain_name.Set.add (Domain_name.raw ns) acc)
+        need_glue Domain_name.Set.empty
+    in
+    let trie =
+      Domain_name.Host_set.fold (fun ns trie ->
+          let dn = Domain_name.raw ns in
+          match
+            Dns.Name_rr_map.find dn Dns.Rr_map.A other_rrs,
+            Dns.Name_rr_map.find dn Dns.Rr_map.Aaaa other_rrs
+          with
+          | Some v4, Some v6 ->
+            let trie = Dns_trie.insert ns Dns.Rr_map.A v4 trie in
+            Dns_trie.insert ns Dns.Rr_map.Aaaa v6 trie
+          | Some v4, None -> Dns_trie.insert ns Dns.Rr_map.A v4 trie
+          | None, Some v6 -> Dns_trie.insert ns Dns.Rr_map.Aaaa v6 trie
+          | None, None ->
+            Log.info (fun m -> m "unknown IP for NS %a (used in zone %a)"
+                          Domain_name.pp ns Domain_name.pp zone);
+            trie)
+        need_glue trie
+    in
+    Domain_name.Map.iter (fun name value ->
+        let leftover =
+          if Domain_name.Set.mem name raw_need_glue then
+            Dns.Rr_map.remove A (Dns.Rr_map.remove Aaaa value)
+          else
+            value
+        in
+        if Dns.Rr_map.is_empty leftover then
+          ()
+        else begin
+          Log.warn (fun m -> m "ignoring %d entries in zone file %a"
+                       (Dns.Rr_map.cardinal leftover) Domain_name.pp zone);
+          Dns.Rr_map.iter (fun b ->
+              Log.warn (fun m -> m "%s" (Dns.Rr_map.text_b name b)))
+            leftover
+        end)
+      other_rrs;
+    trie
+
+let decode_keys zone keys =
+  match parse keys with
+  | Error `Msg msg ->
+    Log.warn (fun m -> m "ignoring keys for %a: %s (data: %s)"
+                 Domain_name.pp zone msg keys);
+    Domain_name.Map.empty
+  | Ok rrs ->
+    let tst subdomain = Domain_name.is_subdomain ~domain:zone ~subdomain in
+    Domain_name.Map.fold (fun n data acc ->
+        if not (tst n) then begin
+          Log.warn (fun m -> m "ignoring key %a (not in zone %a)"
+                       Domain_name.pp n Domain_name.pp zone);
+          acc
+        end else
+          match Dns.Rr_map.(find Dnskey data) with
+          | None ->
+            Log.warn (fun m -> m "no dnskey found %a" Domain_name.pp n);
+            acc
+          | Some (_, keys) ->
+            match Dns.Rr_map.Dnskey_set.elements keys with
+            | [ x ] -> Domain_name.Map.add n x acc
+            | xs ->
+              Log.warn (fun m -> m "ignoring %d dnskeys for %a (only one supported)"
+                           (List.length xs) Domain_name.pp n);
+              acc)
+      rrs Domain_name.Map.empty
+
+let decode_zones bindings =
+  let trie, zones, glue =
+    List.fold_left (fun (trie, zones, glues) (name, data) ->
+        match Domain_name.of_string name with
+        | Error `Msg msg ->
+          Log.warn (fun m -> m "ignoring %s, not a domain name %s" name msg);
+          trie, zones, glues
+        | Ok name ->
+          let trie, glue = decode_zone trie name data in
+          trie, Domain_name.Set.add name zones, (name, glue) :: glues)
+      (Dns_trie.empty, Domain_name.Set.empty, [])
+      bindings
+  in
+  let trie = List.fold_left add_additional_glue trie glue in
+  zones, trie
+
+let decode_zones_keys bindings =
+  let key_domain = Domain_name.of_string_exn "_keys" in
+  let trie, keys, zones, glue =
+    List.fold_left (fun (trie, keys, zones, glues) (name, data) ->
+        match Domain_name.of_string name with
+        | Error `Msg msg ->
+          Log.warn (fun m -> m "ignoring %s, not a domain name %s" name msg);
+          trie, keys, zones, glues
+        | Ok name ->
+          if Domain_name.is_subdomain ~domain:key_domain ~subdomain:name then
+            let domain = Domain_name.drop_label_exn ~rev:true name in
+            let keys' = decode_keys domain data in
+            let f key a _b =
+              Log.warn (fun m -> m "encountered key %a also in %a"
+                           Domain_name.pp key Domain_name.pp domain);
+              Some a
+            in
+            trie, Domain_name.Map.union f keys keys', zones, glues
+          else
+            let trie, glue = decode_zone trie name data in
+            trie, keys, Domain_name.Set.add name zones, (name, glue) :: glues)
+      (Dns_trie.empty, Domain_name.Map.empty, Domain_name.Set.empty, [])
+      bindings
+  in
+  let trie = List.fold_left add_additional_glue trie glue in
+  zones, trie, Domain_name.Map.bindings keys

unikernel/duniverse/ocaml-dns/zone/dns_zone.mli

@@ -0,0 +1,38 @@
+(*
+ * Copyright (c) 2005-2006 Tim Deegan <tjd@phlegethon.org>
+ * Copyright (c) 2017 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.
+ *
+ *)
+
+val parse : string -> (Dns.Name_rr_map.t, [> `Msg of string ]) result
+(** [parse data] attempts to parse the [data], given in [zone file format].
+    It either returns the content as a map, or an error. *)
+
+val decode_keys : 'a Domain_name.t -> string -> Dns.Dnskey.t Domain_name.Map.t
+(** [decode_keys zone data] decodes DNSKEY in [data], and ensure that all are
+    within [zone]. Errors are logged via the logs library. *)
+
+val decode_zones : (string * string) list -> Domain_name.Set.t * Dns_trie.t
+(** [decode_zones (name, data)] parses the zones [data] with the names
+    [name], and constructs a trie that has been checked for consistency.
+    The set of zones are returned, together with the constructed trie.
+    Errors and inconsistencies are logged via the logs library, and the
+    respective zone data is ignored. *)
+
+val decode_zones_keys : (string * string) list ->
+  Domain_name.Set.t * Dns_trie.t * ([`raw] Domain_name.t * Dns.Dnskey.t) list
+(** [decode_zones_keys (name, data)] is [decode_zones], but also if a [name]
+    ends with "_keys", the Dnskey records are decoded (using [decode_keys] and
+    are added to the last part of the return value. *)

unikernel/duniverse/ocaml-dns/zone/dns_zone_lexer.mll

@@ -0,0 +1,116 @@
+(*
+ * 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 }

unikernel/duniverse/ocaml-dns/zone/dns_zone_parser.mly

@@ -0,0 +1,666 @@
+/*
+ * 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" }
+
+%%

unikernel/duniverse/ocaml-dns/zone/dns_zone_state.ml

@@ -0,0 +1,49 @@
+(*
+ * Copyright (c) 2005-2006 Tim Deegan <tjd@phlegethon.org>
+ * Copyright (c) 2017 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.
+ *
+ * dnsloader.ml -- how to build up a DNS trie from separate RRs
+ *
+ *)
+
+(* State variables for the parser & lexer *)
+type parserstate = {
+  mutable paren : int ;
+  mutable lineno : int ;
+  mutable origin : [ `raw ] Domain_name.t ;
+  mutable ttl : int32 ;
+  mutable owner : [ `raw ] Domain_name.t ;
+  mutable zone : Dns.Name_rr_map.t ;
+}
+
+let state = {
+  paren = 0 ;
+  lineno = 1 ;
+  ttl = Int32.of_int 3600 ;
+  origin = Domain_name.root ;
+  owner = Domain_name.root ;
+  zone = Domain_name.Map.empty ;
+}
+
+let reset () =
+  state.paren <- 0 ;
+  state.lineno <- 1 ;
+  state.ttl <- Int32.of_int 3600 ;
+  state.origin <- Domain_name.root ;
+  state.owner <- Domain_name.root ;
+  state.zone <- Dns.Name_rr_map.empty
+
+exception Zone_parse_problem of string
+

unikernel/duniverse/ocaml-dns/zone/dns_zone_state.mli

@@ -0,0 +1,32 @@
+(*
+ * Copyright (c) 2005-2006 Tim Deegan <tjd@phlegethon.org>
+ * Copyright (c) 2017 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.
+ *
+ *)
+
+type parserstate = {
+    mutable paren : int;
+    mutable lineno : int;
+    mutable origin : [ `raw ] Domain_name.t;
+    mutable ttl : int32;
+    mutable owner : [ `raw ] Domain_name.t;
+    mutable zone : Dns.Name_rr_map.t ;
+  }
+
+val state : parserstate
+
+val reset : unit -> unit
+
+exception Zone_parse_problem of string

unikernel/duniverse/ocaml-dns/zone/dune

@@ -0,0 +1,9 @@
+(library
+ (name dns_zone)
+ (public_name dns-server.zone)
+ (private_modules dns_zone_state dns_zone_parser dns_zone_lexer)
+ (libraries dns dns-server logs)
+ (wrapped false))
+
+(ocamlyacc dns_zone_parser)
+(ocamllex dns_zone_lexer)