swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Browse source
This commit is contained in:
swrup 2025-11-11 02:07:51 +01:00
parent aa2ff7b2f0
commit 2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

201
unikernel/duniverse/ocaml-dns/test/cache.ml Normal file
View file

@ -0,0 +1,201 @@
open Dns
let ip = Ipaddr.V4.of_string_exn
let name = Domain_name.of_string_exn
let invalid_soa name =
let p pre =
Domain_name.(prepend_label_exn name "invalid" |> fun n -> prepend_label_exn n pre)
in
{
Soa.nameserver = p "ns" ; hostmaster = p "hostmaster" ;
serial = 1l ; refresh = 16384l ; retry = 2048l ;
expiry = 1048576l ; minimum = 300l
}
let cached_err =
let module M = struct
type t = [ `Cache_miss | `Cache_drop ]
let pp ppf = function
| `Cache_miss -> Fmt.string ppf "cache miss"
| `Cache_drop -> Fmt.string ppf "cache drop"
let equal a b = match a, b with
| `Cache_miss, `Cache_miss -> true
| `Cache_drop, `Cache_drop -> true
| _ -> false
end in
(module M: Alcotest.TESTABLE with type t = M.t)
let entry_eq t a b =
match a, b with
| `Entry b, `Entry b' -> Rr_map.equal_rr t b b'
| `No_data (name, soa), `No_data (name', soa') -> Domain_name.equal name name' && Dns.Soa.compare soa soa' = 0
| `No_domain (name, soa), `No_domain (name', soa') -> Domain_name.equal name name' && Dns.Soa.compare soa soa' = 0
| `Serv_fail (name, soa), `Serv_fail (name', soa') -> Domain_name.equal name name' && Dns.Soa.compare soa soa' = 0
| _, _ -> false
let cached_ok (t : 'a Rr_map.key) =
let pp ppf res = Dns_cache.pp_entry t ppf (fst res)
and equal (r, rank) (r', rank') =
entry_eq t r r' && Dns_cache.compare_rank rank rank' = 0
in
Alcotest.testable pp equal
let cached_r t = Alcotest.(result (cached_ok t) cached_err)
let empty_cache () =
let cache = Dns_cache.empty 100 in
Alcotest.check (cached_r Rr_map.A) "empty cache results in Cache_miss"
(Error `Cache_miss)
(snd (Dns_cache.get cache 0L (name "an-actual-website.com") A))
let cache_a () =
let cache = Dns_cache.empty 100 in
let name = name "an-actual-website.com" in
let a = 250l, Ipaddr.V4.Set.singleton (ip "1.2.3.4") in
let cache = Dns_cache.set cache 0L name A (AuthoritativeAnswer None) (`Entry a) in
Alcotest.check (cached_r Rr_map.A) "cache with A results in res"
(Ok (`Entry a, AuthoritativeAnswer None))
(snd (Dns_cache.get cache 0L name A)) ;
Alcotest.check (cached_r Rr_map.Cname) "cache with A results in CacheMiss"
(Error `Cache_miss) (snd (Dns_cache.get cache 0L name Cname))
let cache_nodata () =
let cache = Dns_cache.empty 100 in
let name = name "an-alias.com"
and subname = name "another-domain.an-alias.com"
in
let soa = invalid_soa name in
let nodata = `No_data (subname, soa) in
let a = 250l, Ipaddr.V4.Set.singleton (ip "1.2.3.4") in
let cache = Dns_cache.set cache 0L name A (AuthoritativeAnswer None) (`Entry a) in
let cache = Dns_cache.set cache 0L subname A (AuthoritativeAnswer None) nodata in
Alcotest.check (cached_r Rr_map.A) "cache with A nodata results in nodata"
(Ok (nodata, AuthoritativeAnswer None)) (snd (Dns_cache.get cache 0L subname A)) ;
Alcotest.check (cached_r Rr_map.Ns) "cache with A nodata results in cache miss for NS"
(Error `Cache_miss) (snd (Dns_cache.get cache 0L subname Ns)) ;
Alcotest.check (cached_r Rr_map.A) "cache with A nodata results in a record"
(Ok (`Entry a, AuthoritativeAnswer None)) (snd (Dns_cache.get cache 0L name A)) ;
Alcotest.check (cached_r Rr_map.Ns) "cache with A nodata results in cache miss for NS'"
(Error `Cache_miss) (snd (Dns_cache.get cache 0L name Ns)) ;
let cache = Dns_cache.set cache 0L subname A (AuthoritativeAnswer None) (`Entry a) in
Alcotest.check (cached_r Rr_map.A) "cache with A nodata results in nodata"
(Ok (`Entry a, AuthoritativeAnswer None)) (snd (Dns_cache.get cache 0L subname A))
let cache_nodom () =
let cache = Dns_cache.empty 100 in
let name = name "an-alias.com"
and subname = name "another-domain.an-alias.com"
and subsubname = name "fo.another-domain.an-alias.com"
in
let soa = invalid_soa name in
let nodom = `No_domain (subname, soa) in
let a = 250l, Ipaddr.V4.Set.singleton (ip "1.2.3.4") in
let cache = Dns_cache.set cache 0L name A (AuthoritativeAnswer None) (`Entry a) in
let cache = Dns_cache.set cache 0L subname A (AuthoritativeAnswer None) nodom in
Alcotest.check (cached_r Rr_map.A) "cache with A nodom results in nodom"
(Ok (nodom, AuthoritativeAnswer None)) (snd (Dns_cache.get cache 0L subname A)) ;
Alcotest.check (cached_r Rr_map.Ns) "cache with A nodom results in nodom for NS"
(Ok (nodom, AuthoritativeAnswer None)) (snd (Dns_cache.get cache 0L subname Ns)) ;
Alcotest.check (cached_r Rr_map.Ns) "cache with A nodom results in nodom for Ns and subsub"
(Ok (nodom, AuthoritativeAnswer None)) (snd (Dns_cache.get cache 0L subsubname Ns)) ;
Alcotest.check (cached_r Rr_map.A) "cache with A nodom results in nodom for A and subsub"
(Ok (nodom, AuthoritativeAnswer None)) (snd (Dns_cache.get cache 0L subsubname A)) ;
Alcotest.check (cached_r Rr_map.A) "cache with A nodom results in a record"
(Ok (`Entry a, AuthoritativeAnswer None)) (snd (Dns_cache.get cache 0L name A)) ;
Alcotest.check (cached_r Rr_map.Ns) "cache with A nodom results in cache miss for NS'"
(Error `Cache_miss) (snd (Dns_cache.get cache 0L name Ns)) ;
let cache = Dns_cache.set cache 0L subname A (AuthoritativeAnswer None) (`Entry a) in
Alcotest.check (cached_r Rr_map.A) "cache with A nodata results in nodom"
(Ok (`Entry a, AuthoritativeAnswer None)) (snd (Dns_cache.get cache 0L subname A))
let cache_tests = [
"empty cache", `Quick, empty_cache ;
"cache with A", `Quick, cache_a ;
"cache nodata", `Quick, cache_nodata ;
"cache nodom", `Quick, cache_nodom ;
]
let entry_or_cname t a b = match a, b with
| (`Alias (ttl, name), r),
(`Alias (ttl', name'), r') ->
ttl = ttl' && Domain_name.equal name name' && Dns_cache.compare_rank r r' = 0
| (#Dns_cache.entry as e1, r1), (#Dns_cache.entry as e2, r2) ->
entry_eq t e1 e2 && Dns_cache.compare_rank r1 r2 = 0
| _ -> false
let pp_or_cname t ppf = function
| `Alias (ttl, name), _ -> Fmt.pf ppf "alias %lu %a" ttl Domain_name.pp name
| #Dns_cache.entry as e, _ -> Dns_cache.pp_entry t ppf e
let cname_or_cached t =
Alcotest.testable (pp_or_cname t) (entry_or_cname t)
let cached_cname_r t = Alcotest.result (cname_or_cached t) cached_err
let empty = Dns_cache.empty 100
let cname_empty_cache () =
Alcotest.check (cached_cname_r Rr_map.A) "empty cache results in Cache_miss"
(Error `Cache_miss)
(snd (Dns_cache.get_or_cname empty 0L (name "foo.com") A))
let cname_cache_a () =
let name = name "foo.com" in
let a = 250l, Ipaddr.V4.Set.singleton (ip "1.2.3.4") in
let cache = Dns_cache.set empty 0L name A (AuthoritativeAnswer None) (`Entry a) in
Alcotest.check (cached_cname_r Rr_map.A) "cache with A results in res"
(Ok (`Entry a, AuthoritativeAnswer None))
(snd (Dns_cache.get_or_cname cache 0L name A)) ;
Alcotest.check (cached_cname_r Rr_map.Cname) "cache with A results in CacheMiss"
(Error `Cache_miss)
(snd (Dns_cache.get_or_cname cache 0L name Cname))
let cname_cache_cname () =
let rel = name "bar.com" in
let name = name "foo.com" in
let cname = 250l, rel in
let cache = Dns_cache.set empty 0L name Cname (AuthoritativeAnswer None) (`Entry cname) in
Alcotest.check (cached_cname_r Rr_map.Cname) "cache with CNAME results in res"
(Ok (`Alias cname, AuthoritativeAnswer None))
(snd (Dns_cache.get_or_cname cache 0L name Cname)) ;
Alcotest.check (cached_cname_r Rr_map.A) "cache with CNAME results in res for A"
(Ok (`Alias cname, AuthoritativeAnswer None))
(snd (Dns_cache.get_or_cname cache 0L name A)) ;
Alcotest.check (cached_cname_r Rr_map.Ns) "cache with CNAME results in res for NS"
(Ok (`Alias cname, AuthoritativeAnswer None))
(snd (Dns_cache.get_or_cname cache 0L name Ns))
let cname_cache_cname_nodata () =
let rel = name "bar.com" in
let name = name "foo.com" in
let cname = 250l, rel in
let bad_soa = invalid_soa name in
let cache =
Dns_cache.set
(Dns_cache.set empty 0L name Cname (AuthoritativeAnswer None) (`Entry cname))
0L name Ns (AuthoritativeAnswer None) (`No_data (name, bad_soa))
in
Alcotest.check (cached_cname_r Rr_map.Cname) "cache with CNAME results in res"
(Ok (`Alias cname, AuthoritativeAnswer None))
(snd (Dns_cache.get_or_cname cache 0L name Cname)) ;
Alcotest.check (cached_cname_r Rr_map.Ns) "cache with CNAME results in res for NS"
(Ok (`Alias cname, AuthoritativeAnswer None))
(snd (Dns_cache.get_or_cname cache 0L name Ns)) ;
Alcotest.check (cached_cname_r Rr_map.A) "cache with CNAME results in res for A"
(Ok (`Alias cname, AuthoritativeAnswer None))
(snd (Dns_cache.get_or_cname cache 0L name A))
let cname_cache_tests = [
"empty cache", `Quick, cname_empty_cache ;
"cache with A", `Quick, cname_cache_a ;
"cache with CNAME", `Quick, cname_cache_cname ;
"cache with another cname", `Quick, cname_cache_cname_nodata ;
]
let tests = [
"cache tests", cache_tests;
"cname cache tests", cname_cache_tests;
]
let () = Alcotest.run "DNS cache tests" tests

328
unikernel/duniverse/ocaml-dns/test/client.ml Normal file
View file

@ -0,0 +1,328 @@
let ip =
let module M = struct
type t = Ipaddr.V4.t
let pp = Ipaddr.V4.pp
let equal a b = Ipaddr.V4.compare a b = 0
end in
(module M : Alcotest.TESTABLE with type t = M.t)
let ipset = Alcotest.(slist ip Ipaddr.V4.compare)
let p_cs = Alcotest.testable (Ohex.pp_hexdump ()) String.equal
module Make_query_tests = struct
let produces_same_output () =
let rng n = String.make n '\x00' in
let name:'a Domain_name.t = Domain_name.of_string_exn "example.com" in
let actual, _state = Dns_client.Pure.make_query rng `Tcp `Auto name Dns.Rr_map.A in
let expected = Ohex.decode
"00 2e 00 00 01 00 00 01 00 00 00 00 00 01 07 65
78 61 6d 70 6c 65 03 63 6f 6d 00 00 01 00 01 00
00 29 02 00 00 00 00 00 00 06 00 0b 00 02 04 b0" in
Alcotest.check p_cs "produces cool stuff" expected actual
let tests = [
"produces same output", `Quick, produces_same_output;
"fails on unspported query_type", `Quick, produces_same_output;
]
end
module Parse_response_tests = struct
let unpacks_response () =
(* Bytes 3, 4 are set to `00 00` - these represent query ID *)
let ipv4_buf = Ohex.decode
"00 77 00 00 81 80 00 01 00 01 00 02 00 02 03 66
6f 6f 03 63 6f 6d 00 00 01 00 01 c0 0c 00 01 00
01 00 00 02 2a 00 04 17 17 56 2c c0 0c 00 02 00
01 00 01 87 ae 00 10 03 6e 73 31 09 64 69 67 69
6d 65 64 69 61 c0 10 c0 0c 00 02 00 01 00 01 87
ae 00 06 03 6e 73 32 c0 39 c0 35 00 01 00 01 00
02 40 8a 00 04 17 15 f2 58 c0 51 00 01 00 01 00
02 40 8a 00 04 17 15 f3 77" in
(* This `rng` generates zeros, used for the query ID above *)
let rng n = String.make n '\x00' in
let name:'a Domain_name.t = Domain_name.of_string_exn "foo.com" in
let _actual, state = Dns_client.Pure.make_query rng `Tcp `Auto name Dns.Rr_map.A in
match Dns_client.Pure.handle_response state ipv4_buf with
| Ok `Data _ -> () (* TODO: Alcotest TESTABLE for this return value *)
| _ -> ignore(failwith "error")
let fails_to_unpack_mismatched () =
(* TODO: It is possible to use crowbar here, to generate the ipv4_buf *)
(* Bytes 3, 4 are set to `aa aa` - these represent query ID *)
let ipv4_buf = Ohex.decode
"00 77 aa aa 81 80 00 01 00 01 00 02 00 02 03 66
6f 6f 03 63 6f 6d 00 00 01 00 01 c0 0c 00 01 00
01 00 00 02 2a 00 04 17 17 56 2c c0 0c 00 02 00
01 00 01 87 ae 00 10 03 6e 73 31 09 64 69 67 69
6d 65 64 69 61 c0 10 c0 0c 00 02 00 01 00 01 87
ae 00 06 03 6e 73 32 c0 39 c0 35 00 01 00 01 00
02 40 8a 00 04 17 15 f2 58 c0 51 00 01 00 01 00
02 40 8a 00 04 17 15 f3 77" in
(* This `rng` generates zeros, used for the query ID above *)
let rng n = String.make n '\x00' in
let name:'a Domain_name.t = Domain_name.of_string_exn "foo.com" in
let _actual, state = Dns_client.Pure.make_query rng `Tcp `Auto name Dns.Rr_map.A in
match Dns_client.Pure.parse_response state ipv4_buf with
| Error `Msg _ -> ()
| __ -> failwith "should have rejected mismatched input"
(* TODO: Alcotest TESTABLE for this return value *)
let tests = [
"unpacks some kind of response", `Quick, unpacks_response;
"fails to unpack response with mismatching query ID", `Quick, fails_to_unpack_mismatched;
]
end
(* {!Transport} provides a mock implementation of the transport used by
Dns_client.Make. The mock data uses the default_debug_info reference cell.
*)
type debug_info = string
let default_debug_info = ref []
module Transport (*: Dns_client.S
with type io_addr = debug_info
and type stack = unit
and type +'a io = 'a *)
= struct
type io_addr = debug_info
type stack = Dns.proto
type context = debug_info list ref
type t = Dns.proto
type +'a io = 'a
let create ?nameservers:_ ~timeout:_ proto = proto
let nameservers proto = proto, !default_debug_info
let rng n = String.make n '\x00'
let clock () = 0L
let bind a b = b a
let lift v = v
let close _ = ()
let connect a = Ok (a, default_debug_info)
let send_recv (mock_responses : context) _ =
match !mock_responses with
| [] -> failwith("nothing to recv from the wire")
| hd::tail -> mock_responses := tail; Ok hd
end
(* Now that we have our {!Transport} implementation we can include the logic
that goes on top of it: *)
include Dns_client.Make(Transport)
module Transport_with_time_machine = struct
include Transport
(* the timestamps are for: cache lookup1, cache upate, cache lookup2, cache update2 *)
let timestamps = ref [0L; 0L; Duration.of_sec 601 ; Duration.of_sec 601]
let clock () =
match !timestamps with
| [] -> assert false
| head::tail -> timestamps := tail; head
end
module Dns_client_with_time_machine = Dns_client.Make(Transport_with_time_machine)
module Gethostbyname_tests = struct
let foo_com_is_valid () =
let domain_name = Domain_name.(of_string_exn "foo.com" |> host_exn) in
(* Bytes 3, 4 are set to `00 00` - these represent query ID *)
let ipv4_buf = Ohex.decode
"00 77 00 00 81 80 00 01 00 01 00 02 00 02 03 66
6f 6f 03 63 6f 6d 00 00 01 00 01 c0 0c 00 01 00
01 00 00 02 2a 00 04 17 17 56 2c c0 0c 00 02 00
01 00 01 87 ae 00 10 03 6e 73 31 09 64 69 67 69
6d 65 64 69 61 c0 10 c0 0c 00 02 00 01 00 01 87
ae 00 06 03 6e 73 32 c0 39 c0 35 00 01 00 01 00
02 40 8a 00 04 17 15 f2 58 c0 51 00 01 00 01 00
02 40 8a 00 04 17 15 f3 77" in
let t = create `Tcp in
default_debug_info := [ipv4_buf];
match gethostbyname t domain_name with
| Ok _ip -> ()
| Error _ -> failwith "foo.com should have been returned"
let returns_from_the_cache () =
let domain_name = Domain_name.(of_string_exn "foo.com" |> host_exn) in
(* Bytes 3, 4 are set to `00 00` - these represent query ID *)
let ipv4_buf = Ohex.decode
"00 77 00 00 81 80 00 01 00 01 00 02 00 02 03 66
6f 6f 03 63 6f 6d 00 00 01 00 01 c0 0c 00 01 00
01 00 00 02 2a 00 04 17 17 56 2c c0 0c 00 02 00
01 00 01 87 ae 00 10 03 6e 73 31 09 64 69 67 69
6d 65 64 69 61 c0 10 c0 0c 00 02 00 01 00 01 87
ae 00 06 03 6e 73 32 c0 39 c0 35 00 01 00 01 00
02 40 8a 00 04 17 15 f2 58 c0 51 00 01 00 01 00
02 40 8a 00 04 17 15 f3 77" in
let t = create `Tcp in
default_debug_info := [ipv4_buf];
match gethostbyname t domain_name with
| Error _ -> failwith "foo.com should have been returned"
| Ok _ip ->
default_debug_info := [];
match gethostbyname t domain_name with
| Error _ -> failwith "should have been cached"
| Ok _ -> () (* we returned content, but the wire stayed silent *)
let uses_network_when_cache_evicted () =
let domain_name = Domain_name.(of_string_exn "foo.com" |> host_exn) in
(* Bytes 3, 4 are set to `00 00` - these represent query ID *)
let ipv4_buf = Ohex.decode
"00 77 00 00 81 80 00 01 00 01 00 02 00 02 03 66
6f 6f 03 63 6f 6d 00 00 01 00 01 c0 0c 00 01 00
01 00 00 02 2a 00 04 17 17 56 2c c0 0c 00 02 00
01 00 01 87 ae 00 10 03 6e 73 31 09 64 69 67 69
6d 65 64 69 61 c0 10 c0 0c 00 02 00 01 00 01 87
ae 00 06 03 6e 73 32 c0 39 c0 35 00 01 00 01 00
02 40 8a 00 04 17 15 f2 58 c0 51 00 01 00 01 00
02 40 8a 00 04 17 15 f3 77" in
let t = Dns_client_with_time_machine.create `Tcp in
default_debug_info := [ipv4_buf];
match Dns_client_with_time_machine.gethostbyname t domain_name with
| Error _ -> failwith "foo.com should have been returned"
| Ok _ip ->
default_debug_info := [ipv4_buf];
match Dns_client_with_time_machine.gethostbyname t domain_name with
| Error _ -> failwith "should have been cached"
| Ok _ -> (* we returned content, AND the wire was used *)
assert (!default_debug_info = [])
let tests = [
"foo.com is valid", `Quick, foo_com_is_valid;
"when cache is populated, return from cache", `Quick, returns_from_the_cache;
"when content evicted, use network", `Quick, uses_network_when_cache_evicted;
]
end
module Getaddrinfo_tests = struct
let supports_mx_packets () =
let domain_name = Domain_name.(of_string_exn "google.com" |> host_exn) in
(* a google.com MX record - bytes 3,4 are set to the query ID 00 00 *)
let ipv4_buf = Ohex.decode
"02 1e 00 00 81 80 00 01 00 05 00 04 00 0f 06 67
6f 6f 67 6c 65 03 63 6f 6d 00 00 0f 00 01 c0 0c
00 0f 00 01 00 00 02 58 00 11 00 1e 04 61 6c 74
32 05 61 73 70 6d 78 01 6c c0 0c c0 0c 00 0f 00
01 00 00 02 58 00 04 00 0a c0 2f c0 0c 00 0f 00
01 00 00 02 58 00 09 00 28 04 61 6c 74 33 c0 2f
c0 0c 00 0f 00 01 00 00 02 58 00 09 00 14 04 61
6c 74 31 c0 2f c0 0c 00 0f 00 01 00 00 02 58 00
09 00 32 04 61 6c 74 34 c0 2f c0 0c 00 02 00 01
00 00 ad 8c 00 06 03 6e 73 31 c0 0c c0 0c 00 02
00 01 00 00 ad 8c 00 06 03 6e 73 34 c0 0c c0 0c
00 02 00 01 00 00 ad 8c 00 06 03 6e 73 33 c0 0c
c0 0c 00 02 00 01 00 00 ad 8c 00 06 03 6e 73 32
c0 0c c0 2f 00 01 00 01 00 00 00 e0 00 04 6c b1
77 1b c0 6c 00 01 00 01 00 00 00 0d 00 04 ac d9
c2 1b 04 41 4c 54 32 c0 2f 00 01 00 01 00 00 00
0d 00 04 6c b1 61 1b c0 81 00 01 00 01 00 00 00
e0 00 04 6c b1 08 1a c0 94 00 01 00 01 00 03 8b
b6 00 04 d8 ef 20 0a c0 ca 00 01 00 01 00 03 8f
54 00 04 d8 ef 22 0a c0 b8 00 01 00 01 00 03 8b
b6 00 04 d8 ef 24 0a c0 a6 00 01 00 01 00 03 97
5d 00 04 d8 ef 26 0a c0 2f 00 1c 00 01 00 00 00
f9 00 10 2a 00 14 50 40 13 0c 01 00 00 00 00 00
00 00 1b c0 6c 00 1c 00 01 00 00 00 f9 00 10 24
04 68 00 40 03 0c 04 00 00 00 00 00 00 00 1b 04
41 4c 54 33 c0 2f 00 1c 00 01 00 00 01 1b 00 10
26 07 f8 b0 40 0e 0c 00 00 00 00 00 00 00 00 1b
c0 94 00 1c 00 01 00 02 64 96 00 10 20 01 48 60
48 02 00 32 00 00 00 00 00 00 00 0a c0 ca 00 1c
00 01 00 04 54 3a 00 10 20 01 48 60 48 02 00 34
00 00 00 00 00 00 00 0a c0 b8 00 1c 00 01 00 01
79 ea 00 10 20 01 48 60 48 02 00 36 00 00 00 00
00 00 00 0a c0 a6 00 1c 00 01 00 01 d1 ba 00 10
20 01 48 60 48 02 00 38 00 00 00 00 00 00 00 0a" in
let mock_state = create `Tcp in
default_debug_info := [ipv4_buf];
match getaddrinfo mock_state Dns.Rr_map.Mx domain_name with
| Ok (_ttl, mx_set) ->
let make_mx_record (preference, domain_name) =
Dns.Mx.{
preference;
mail_exchange = Domain_name.host_exn (Domain_name.of_string_exn domain_name)
} in
(* assert this is Google MX *)
Alcotest.(check bool __LOC__ true (Dns.Rr_map.Mx_set.equal mx_set
(Dns.Rr_map.Mx_set.of_list
(List.map make_mx_record [
(10, "aspmx.l.google.com");
(20, "alt1.aspmx.l.google.com");
(30, "alt2.aspmx.l.google.com");
(40, "alt3.aspmx.l.google.com");
(50, "alt4.aspmx.l.google.com")
]))))
| Error _ -> failwith "foo.com should have been returned"
let fails_on_partial_udp_packet () =
let domain_name = Domain_name.(of_string_exn "google.com" |> host_exn) in
(* A partial google.com MX record
first two bytes identify this as a TCP packet - dropped here
bytes 3,4 are set to the query ID 00 00
*)
let udp_buf = Ohex.decode
" 00 00 81 80 00 01 00 05 00 04 00 0f 06 67
6f 6f 67 6c 65 03 63 6f " in
let mock_state = create `Udp in
default_debug_info := [udp_buf];
match getaddrinfo mock_state Dns.Rr_map.Mx domain_name with
| Error `Msg actual ->
let expected = "Truncated UDP response" in
Alcotest.(check string "reports the truncated UDP packet failure" expected actual)
| Ok (_, _) -> failwith "Should have reported the Truncated UDP packet"
let cname_and_nodata_packet () =
(* we request a non-existing record type of existing domain name, which is
an alias - the reply is a CNAME with NoData *)
(* concretely, requesting AAAA raw.githubusercontent.com, reply is
AN: raw.githubusercontent.com CNAME github.map.fastly.net
AU: SOA fastly.net *)
let domain_name =
Domain_name.(of_string_exn "raw.githubusercontent.com" |> host_exn)
in
let udp_buf = Ohex.decode {|
00 00 81 80 00 01 00 01 00 01 00 00 03 72
61 77 11 67 69 74 68 75 62 75 73 65 72 63 6f 6e
74 65 6e 74 03 63 6f 6d 00 00 1c 00 01 c0 0c 00
05 00 01 00 00 00 16 00 17 06 67 69 74 68 75 62
03 6d 61 70 06 66 61 73 74 6c 79 03 6e 65 74 00
c0 42 00 06 00 01 00 00 00 14 00 2e 03 6e 73 31
c0 42 0a 68 6f 73 74 6d 61 73 74 65 72 06 66 61
73 74 6c 79 c0 22 78 39 c6 29 00 00 0e 10 00 00
02 58 00 09 3a 80 00 00 00 1e|}
in
let mock_state = create `Udp in
default_debug_info := [udp_buf];
match getaddrinfo mock_state Dns.Rr_map.Aaaa domain_name with
| Error `Msg actual ->
let expected = "DNS cache error no data fastly.net" in
let len = String.length expected in
Alcotest.(check string __LOC__ expected (String.sub actual 0 len))
| Ok (_, _) -> Alcotest.fail "Should have returned nodata"
let tests = [
"supports_mx_packets", `Quick, supports_mx_packets;
"a partial UDP response packet fails", `Quick, fails_on_partial_udp_packet;
"cname and nodata in packet", `Quick, cname_and_nodata_packet;
]
end
let tests = [
"make_query tests", Make_query_tests.tests;
"parse_response tests", Parse_response_tests.tests;
"gethostbyname tests", Gethostbyname_tests.tests;
"getaddrinfo tests", Getaddrinfo_tests.tests;
]
let () = Alcotest.run "DNS client tests" tests

53
unikernel/duniverse/ocaml-dns/test/dune Normal file
View file

@ -0,0 +1,53 @@
(test
(name tests)
(package dns)
(libraries dns alcotest)
(modules tests))
(test
(name server)
(package dns-server)
(libraries base64 dns-server dns-server.zone dns-tsig alcotest mirage-crypto-rng.unix)
(modules server))
(test
(name tsig)
(package dns-tsig)
(libraries dns-tsig alcotest)
(modules tsig))
(test
(name resolver)
(package dns-resolver)
(libraries dns-resolver alcotest logs.fmt)
(modules resolver))
(test
(name client)
(package dns-client)
(libraries dns-client alcotest)
(modules client))
(test
(name cache)
(package dns)
(libraries dns.cache alcotest)
(modules cache))
(test
(name resolvconf)
(package dns-client)
(libraries dns-client.resolvconf ipaddr alcotest)
(modules resolvconf))
(test
(name test_dnssec)
(package dnssec)
(libraries dns dnssec mirage-crypto-pk base64 logs.fmt alcotest)
(modules test_dnssec))
(test
(name test_rfc9460)
(package dns-server)
(libraries dns-server dns-server.zone logs.fmt alcotest)
(modules test_rfc9460))

118
unikernel/duniverse/ocaml-dns/test/resolvconf.ml Normal file
View file

@ -0,0 +1,118 @@
let ok =
let module M = struct
type t = [ `Nameserver of Ipaddr.t ] list
let pp =
let pp_one ppf = function
| `Nameserver ip -> Fmt.pf ppf "nameserver %a" Ipaddr.pp ip
in
Fmt.(list ~sep:(any "\n") pp_one)
let equal a b = compare a b = 0 (* TODO polymorphic equality *)
end in
(module M: Alcotest.TESTABLE with type t = M.t)
let err =
let module M = struct
type t = [ `Msg of string ]
let pp ppf = function
| `Msg m -> Fmt.string ppf m
let equal _ _ = true
end in
(module M: Alcotest.TESTABLE with type t = M.t)
let test_one test_name (data, expected) () =
Alcotest.(check (result ok err)
("resolvconf " ^ test_name) expected (Dns_resolvconf.parse data))
let v4_ns = [ "8.8.8.8" ; "8.8.4.4" ]
and v6_ns = [ "2001:4860:4860::8888" ; "2001:4860:4860::8844" ]
let ok_result ns =
Ok (List.map (fun s -> `Nameserver (Ipaddr.of_string_exn s)) ns)
let linux =
{|
# Not all of these are supported by TRust-DNS
# They are testing that they don't break parsing
options ndots:8 timeout:8 attempts:8
domain example.com
search example.com sub.example.com
nameserver 2001:4860:4860::8888
nameserver 2001:4860:4860::8844
nameserver 8.8.8.8
nameserver 8.8.4.4
# some options not supported by TRust-DNS
options rotate
options inet6 no-tld-query
# A basic option not supported
sortlist 130.155.160.0/255.255.240.0 130.155.0.0
|}
let macos =
{|
#
# Mac OS X Notice
#
# This file is not used by the host name and address resolution
# or the DNS query routing mechanisms used by most processes on
# this Mac OS X system.
#
# This file is automatically generated.
#
options ndots:8 timeout:8 attempts:8
domain example.com.
search example.com. sub.example.com.
nameserver 2001:4860:4860::8888
nameserver 2001:4860:4860::8844
nameserver 8.8.8.8
nameserver 8.8.4.4
|}
let openbsd =
{|
# Generated by em0 dhclient
nameserver 8.8.8.8
nameserver 8.8.4.4
lookup file bind
|}
let simple =
{|
nameserver 8.8.8.8
nameserver 8.8.4.4
|}
let nixos =
{|
nameserver fe80::c2d7:aaff:fe96:8d82%wlp3s0
|}
let nixos2 =
{|
nameserver 8.8.8.8
nameserver 8.8.4.4
nameserver fe80::c2d7:aaff:fe96:8d82%wlp3s0
nameserver 8.8.8.8
nameserver 8.8.4.4
|}
let local_ns = [ "fe80::c2d7:aaff:fe96:8d82" ]
let tests = [
"linux", `Quick, test_one "linux" (linux, ok_result (v6_ns @ v4_ns)) ;
"macos", `Quick, test_one "macos" (macos, ok_result (v6_ns @ v4_ns)) ;
"openbsd", `Quick, test_one "openbsd" (openbsd, ok_result v4_ns) ;
"simple", `Quick, test_one "simple" (simple, ok_result v4_ns) ;
"nixos", `Quick, test_one "nixos (with zone index)"
(nixos, ok_result local_ns) ;
"nixos 2", `Quick, test_one "nixos 2 (with zone index)"
(nixos2, ok_result (v4_ns @ local_ns @ v4_ns)) ;
]
let () = Alcotest.run "DNS resolvconf tests" [ "resolvconf tests", tests ]

1149
unikernel/duniverse/ocaml-dns/test/resolver.ml Normal file
View file

File diff suppressed because it is too large Load diff

2163
unikernel/duniverse/ocaml-dns/test/server.ml Normal file
View file

File diff suppressed because it is too large Load diff

2039
unikernel/duniverse/ocaml-dns/test/test_dnssec.ml Normal file
View file

File diff suppressed because it is too large Load diff

663
unikernel/duniverse/ocaml-dns/test/test_rfc9460.ml Normal file
View file

@ -0,0 +1,663 @@
open Dns
(* a useful reference : https://kalfeher.com/https-records-simple/*)
let n_of_s = Domain_name.of_string_exn
let name_map_ok =
let module M = struct
type t = Name_rr_map.t
let pp = Name_rr_map.pp
let equal = Name_rr_map.equal
end in
(module M: Alcotest.TESTABLE with type t = M.t)
let err =
let module M = struct
type t = [ `Msg of string ]
let pp ppf (`Msg s) = Fmt.string ppf s
let equal _ _ = true
end in
(module M: Alcotest.TESTABLE with type t = M.t)
module Passing = struct
(*
From appendix D - test vectors
D.1. AliasMode
--------------
; AliasMode
example.com. HTTPS 0 foo.example.com.
\# 19 (
00 00 ; priority
03 66 6f 6f 07 65 78 61 6d 70 6c 65 03 63 6f 6d 00 ; target
)
\x00\x00 # priority
\x03foo\x07example\x03com\x00 # target
*)
let alias_mode = {|
; AliasMode
example.com. HTTPS 0 foo.example.com.
|}
let parse_alias_mode () =
let rrs =
(* let tld = n_of_s "com" in *)
let ttl = 3600l in
let example = n_of_s "example.com" in
let foo_example = n_of_s "foo.example.com" in
let https = Https.{
svc_priority = 0 ;
target_name = Domain_name.host_exn foo_example ;
svc_params = [] ;
} in
let https' = Rr_map.Https_set.singleton https in
Name_rr_map.add example Rr_map.Https (ttl,https') Name_rr_map.empty
in
Alcotest.(check (result name_map_ok err) "alias mode"
(Ok rrs) (Dns_zone.parse alias_mode))
(*
D.2. ServiceMode
----------------
; TargetName Is "."
example.com. SVCB 1 .
\# 3 (
00 01 ; priority
00 ; target (root label)
)
\x00\x01 # priority
\x00 # target (root label)
*)
let service_mode = {|
; TargetName Is "."
example.com. SVCB 1 .
|}
(*
let parse_service_mode () =
let rrs =
(* let tld = n_of_s "com" in *)
let ttl = 3600l in
let example = n_of_s "example.com" in
let dot = n_of_s "." in
let svcb = Svcb.{
svc_priority = 0 ;
(* target_name = Domain_name.host_exn dot ; *)
target_name = Domain_name. dot ;
svc_params = [] ;
} in
let svcb' = Rr_map.Svcb_set.singleton svcb in
Name_rr_map.add example Rr_map.Svcb (ttl,svcb') Name_rr_map.empty
in
Alcotest.(check (result name_map_ok err) "service mode"
(Ok rrs) (Dns_zone.parse alias_mode))
*)
(*
; Specifies a port
example.com. SVCB 16 foo.example.com. port=53
\# 25 (
00 10 ; priority
03 66 6f 6f 07 65 78 61 6d 70 6c 65 03 63 6f 6d 00 ; target
00 03 ; key 3
00 02 ; length 2
00 35 ; value
)
\x00\x10 # priority
\x03foo\x07example\x03com\x00 # target
\x00\x03 # key 3
\x00\x02 # length 2
\x00\x35 # value
*)
let port_specification = {|
; Specifies a port
example.com. SVCB 16 foo.example.com. port=53
|}
let parse_port_specification () =
let rrs =
(* let tld = n_of_s "com" in *)
let ttl = 3600l in
let example = n_of_s "example.com" in
let foo_example = n_of_s "foo.example.com" in
let svcb = Svcb.{
svc_priority = 16 ;
target_name = Domain_name.host_exn foo_example ;
svc_params = [
Port 53
] ;
} in
let svcb' = Rr_map.Svcb_set.singleton svcb in
Name_rr_map.add example Rr_map.Svcb (ttl,svcb') Name_rr_map.empty
in
Alcotest.(check (result name_map_ok err) "port specification"
(Ok rrs) (Dns_zone.parse port_specification))
(*
; A Generic Key and Unquoted Value
example.com. SVCB 1 foo.example.com. key667=hello
\# 28 (
00 01 ; priority
03 66 6f 6f 07 65 78 61 6d 70 6c 65 03 63 6f 6d 00 ; target
02 9b ; key 667
00 05 ; length 5
68 65 6c 6c 6f ; value
)
\x00\x01 # priority
\x03foo\x07example\x03com\x00 # target
\x02\x9b # key 667
\x00\x05 # length 5
hello # value
*)
let value_unquoted = {|
; A Generic Key and Unquoted Value
example.com. SVCB 1 foo.example.com. key667=hello
|}
let parse_value_unquoted () =
let rrs =
(* let tld = n_of_s "com" in *)
let ttl = 3600l in
let example = n_of_s "example.com" in
let foo_example = n_of_s "foo.example.com" in
let svcb = Svcb.{
svc_priority = 1 ;
target_name = Domain_name.host_exn foo_example ;
svc_params = [
Key (667,"hello")
] ;
} in
let svcb' = Rr_map.Svcb_set.singleton svcb in
Name_rr_map.add example Rr_map.Svcb (ttl,svcb') Name_rr_map.empty
in
Alcotest.(check (result name_map_ok err) "value unquoted"
(Ok rrs) (Dns_zone.parse value_unquoted))
(*
; A Generic Key and Quoted Value with a Decimal Escape
example.com. SVCB 1 foo.example.com. key667="hello\210qoo"
\# 32 (
00 01 ; priority
03 66 6f 6f 07 65 78 61 6d 70 6c 65 03 63 6f 6d 00 ; target
02 9b ; key 667
00 09 ; length 9
68 65 6c 6c 6f d2 71 6f 6f ; value
)
\x00\x01 # priority
\x03foo\x07example\x03com\x00 # target
\x02\x9b # key 667
\x00\x09 # length 9
hello\xd2qoo # value
*)
(*
let quoted = {|
; A Generic Key and Quoted Value with a Decimal Escape
example.com. SVCB 1 foo.example.com. key667="hello\210qoo"
|}
let parse_quoted () =
let rrs =
(* let tld = n_of_s "com" in *)
let ttl = 3600l in
let example = n_of_s "example.com" in
let foo_example = n_of_s "foo.example.com" in
let svcb = Svcb.{
svc_priority = 1 ;
target_name = Domain_name.host_exn foo_example ;
svc_params = [
Key (667,"hello\\210qoo")
] ;
} in
let svcb' = Rr_map.Svcb_set.singleton svcb in
Name_rr_map.add example Rr_map.Svcb (ttl,svcb') Name_rr_map.empty
in
Alcotest.(check (result name_map_ok err) "value quoted"
(Ok rrs) (Dns_zone.parse value_unquoted))
*)
(*
; Two Quoted IPv6 Hints
example.com. SVCB 1 foo.example.com. (
ipv6hint="2001:db8::1,2001:db8::53:1"
)
\# 55 (
00 01 ; priority
03 66 6f 6f 07 65 78 61 6d 70 6c 65 03 63 6f 6d 00 ; target
00 06 ; key 6
00 20 ; length 32
20 01 0d b8 00 00 00 00 00 00 00 00 00 00 00 01 ; first address
20 01 0d b8 00 00 00 00 00 00 00 00 00 53 00 01 ; second address
)
\x00\x01 # priority
\x03foo\x07example\x03com\x00 # target
\x00\x06 # key 6
\x00\x20 # length 32
\x20\x01\x0d\xb8\x00\x00\x00\x00
\x00\x00\x00\x00\x00\x00\x00\x01 # first address
\x20\x01\x0d\xb8\x00\x00\x00\x00
\x00\x00\x00\x00\x00\x53\x00\x01 # second address
*)
let quoted_hints = {|
; Two Quoted IPv6 Hints
example.com. SVCB 1 foo.example.com. (
ipv6hint="2001:db8::1,2001:db8::53:1"
)
|}
let parse_quoted_hints () =
(* let ip1 = Result.get_ok (Ipaddr.V6.of_string "2001:db8::1") in
let ip2 = Result.get_ok (Ipaddr.V6.of_string "2001:db8::53:1") in *)
let ip1 = Ipaddr.V6.of_string_exn "2001:db8::1" in
let ip2 = Ipaddr.V6.of_string_exn "2001:db8::53:1" in
let rrs =
(* let tld = n_of_s "com" in *)
let ttl = 3600l in
let example = n_of_s "example.com" in
let foo_example = n_of_s "foo.example.com" in
let svcb = Svcb.{
svc_priority = 1 ;
target_name = Domain_name.host_exn foo_example ;
svc_params = [
Ipv6_hint [ip1;ip2]
] ;
} in
let svcb' = Rr_map.Svcb_set.singleton svcb in
Name_rr_map.add example Rr_map.Svcb (ttl,svcb') Name_rr_map.empty
in
Alcotest.(check (result name_map_ok err) "quoted hints"
(Ok rrs) (Dns_zone.parse quoted_hints))
(*
; An IPv6 Hint Using the Embedded IPv4 Syntax
example.com. SVCB 1 example.com. (
ipv6hint="2001:db8:122:344::192.0.2.33"
)
\# 35 (
00 01 ; priority
07 65 78 61 6d 70 6c 65 03 63 6f 6d 00 ; target
00 06 ; key 6
00 10 ; length 16
20 01 0d b8 01 22 03 44 00 00 00 00 c0 00 02 21 ; address
)
\x00\x01 # priority
\x07example\x03com\x00 # target
\x00\x06 # key 6
\x00\x10 # length 16
\x20\x01\x0d\xb8\x01\x22\x03\x44
\x00\x00\x00\x00\xc0\x00\x02\x21 # address
*)
(*
let generic_key_and_quoted_hints = {|
; An IPv6 Hint Using the Embedded IPv4 Syntax
example.com. SVCB 1 example.com. (
ipv6hint="2001:db8:122:344::192.0.2.33"
)
|}
let parse_generic_key_and_quoted_hints () =
let ip1 = Result.get_ok (Ipaddr.V6.of_string "2001:db8:122:344") in
let ip2 = Result.get_ok (Ipaddr.V4.of_string "192.0.2.33") in
let rrs =
(* let tld = n_of_s "com" in *)
let ttl = 3600l in
let example = n_of_s "example.com" in
let foo_example = n_of_s "foo.example.com" in
let svcb = Svcb.{
svc_priority = 1 ;
target_name = Domain_name.host_exn foo_example ;
svc_params = [
Ipv6_hint [ip1;ip2]
] ;
} in
let svcb' = Rr_map.Svcb_set.singleton svcb in
Name_rr_map.add example Rr_map.Svcb (ttl,svcb') Name_rr_map.empty
in
Alcotest.(check (result name_map_ok err) "generic key and quoted hints"
(Ok rrs) (Dns_zone.parse generic_key_and_quoted_hints))
*)
(*
; SvcParamKey Ordering Is Arbitrary in Presentation Format but Sorted in Wire Format
example.com. SVCB 16 foo.example.org. (
alpn=h2,h3-19 mandatory=ipv4hint,alpn
ipv4hint=192.0.2.1
)
\# 48 (
00 10 ; priority
03 66 6f 6f 07 65 78 61 6d 70 6c 65 03 6f 72 67 00 ; target
00 00 ; key 0
00 04 ; param length 4
00 01 ; value: key 1
00 04 ; value: key 4
00 01 ; key 1
00 09 ; param length 9
02 ; alpn length 2
68 32 ; alpn value
05 ; alpn length 5
68 33 2d 31 39 ; alpn value
00 04 ; key 4
00 04 ; param length 4
c0 00 02 01 ; param value
)
\x00\x10 # priority
\x03foo\x07example\x03org\x00 # target
\x00\x00 # key 0
\x00\x04 # param length 4
\x00\x01 # value: key 1
\x00\x04 # value: key 4
\x00\x01 # key 1
\x00\x09 # param length 9
\x02 # alpn length 2
h2 # alpn value
\x05 # alpn length 5
h3-19 # alpn value
\x00\x04 # key 4
\x00\x04 # param length 4
\xc0\x00\x02\x01 # param value
*)
(*
(
alpn=h2,h3-19 mandatory=ipv4hint,alpn
ipv4hint=192.0.2.1
)
*)
let svc_param_key_ordering = {|
; SvcParamKey Ordering Is Arbitrary in Presentation Format but Sorted in Wire Format
example.com. SVCB 16 foo.example.org. (
alpn=h2,h3-19 mandatory=ipv4hint,alpn
ipv4hint=192.0.2.1
)
|}
let parse_svc_param_key_ordering () =
let ip = Ipaddr.V4.of_string_exn "192.0.2.1" in
let rrs =
(* let tld = n_of_s "com" in *)
let ttl = 3600l in
let example = n_of_s "example.com" in
let foo_example = n_of_s "foo.example.org" in
let svcb = Svcb.{
svc_priority = 16 ;
target_name = Domain_name.host_exn foo_example ;
svc_params = [
Mandatory [1;4];
Alpn ["h2"; "h3-19"];
Ipv4_hint [ip]
] ;
} in
let svcb' = Rr_map.Svcb_set.singleton svcb in
Name_rr_map.add example Rr_map.Svcb (ttl,svcb') Name_rr_map.empty
in
Alcotest.(check (result name_map_ok err) "svc param key ordering"
(Ok rrs) (Dns_zone.parse svc_param_key_ordering))
(*
Mandatory [1;4];
Alpn ["h2"; "h3-19"];
Ipv4_hint [ip]
*)
(*
; An "alpn" Value with an Escaped Comma and an Escaped Backslash in Two Presentation Formats
example.com. SVCB 16 foo.example.org. alpn="f\\\\oo\\,bar,h2"
example.com. SVCB 16 foo.example.org. alpn=f\\\092oo\092,bar,h2
\# 35 (
00 10 ; priority
03 66 6f 6f 07 65 78 61 6d 70 6c 65 03 6f 72 67 00 ; target
00 01 ; key 1
00 0c ; param length 12
08 ; alpn length 8
66 5c 6f 6f 2c 62 61 72 ; alpn value
02 ; alpn length 2
68 32 ; alpn value
)
\x00\x10 # priority
\x03foo\x07example\x03org\x00 # target
\x00\x01 # key 1
\x00\x0c # param length 12
\x08 # alpn length 8
f\oo,bar # alpn value
\x02 # alpn length 2
h2 # alpn value
*)
let escaped_comma_backslash = {|
; An "alpn" Value with an Escaped Comma and an Escaped Backslash in Two Presentation Formats
example.com. SVCB 16 foo.example.org. alpn="f\\\\oo\\,bar,h2"
example.com. SVCB 16 foo.example.org. alpn=f\\\092oo\092,bar,h2
|}
let parse_escaped_comma_backslash () =
let rrs =
let ttl = 3600l in
let example = n_of_s "example.com" in
let foo_example = n_of_s "foo.example.org" in
let svcb1 = Svcb.{
svc_priority = 16 ;
target_name = Domain_name.host_exn foo_example ;
svc_params = [
Alpn ["\"f\\\\\\\\oo\\\\"; "bar"; "h2\""]
] ;
} in
let svcb1' = Rr_map.Svcb_set.singleton svcb1 in
let svcb2 = Svcb.{
svc_priority = 16 ;
target_name = Domain_name.host_exn foo_example ;
svc_params = [
Alpn ["f\\\\\\092oo\\092"; "bar"; "h2"]
] ;
} in
let svcb2' = Rr_map.Svcb_set.singleton svcb2 in
Name_rr_map.(add example Rr_map.Svcb (ttl,svcb2') (singleton example Rr_map.Svcb (ttl,svcb1')));
in
Alcotest.(check (result name_map_ok err) "escaped comma backslash"
(Ok rrs) (Dns_zone.parse escaped_comma_backslash))
let tests = [
"parse alias mode", `Quick, parse_alias_mode;
(* "parse service mode", `Quick, parse_service_mode; *) (* failing on target = '.' *)
"parse port specification", `Quick, parse_port_specification;
"parse value unquoted", `Quick, parse_value_unquoted;
(* "parse quoted", `Quick, parse_quoted; *)
"quoted hints", `Quick, parse_quoted_hints;
(* "generic key and quoted hints", `Quick, parse_generic_key_and_quoted_hints; *) (* need to implement happy eyeballs v2 synthesis*)
"svc param key ordering", `Quick, parse_svc_param_key_ordering;
"escaped comma backslash", `Quick, parse_escaped_comma_backslash
]
end
module Failing = struct
(*
Failure Cases
-------------
; Multiple Instances of the Same SvcParamKey
example.com. SVCB 1 foo.example.com. (
key123=abc key123=def
)
*)
let failure_svc_param_key = {|
; Multiple Instances of the Same SvcParamKey
example.com. SVCB 1 foo.example.com. (
key123=abc key123=def
)
|}
let parse_failure_svc_param_key () =
let _rrs =
let ttl = 3600l in
let example = n_of_s "example.com" in
let foo_example = n_of_s "foo.example.com" in
let svcb = Svcb.{
svc_priority = 1 ;
target_name = Domain_name.host_exn foo_example ;
svc_params = [
Key (123,"abc");
Key (123,"def")
]
} in
let svcb' = Rr_map.Svcb_set.singleton svcb in
Name_rr_map.add example Rr_map.Svcb (ttl,svcb') Name_rr_map.empty
in
Alcotest.(check (result name_map_ok err) "failure svc param key"
(Error (`Msg "SVCB : multiple instances of the same SvcParamKey")) (Dns_zone.parse failure_svc_param_key))
(*
; Missing SvcParamValues That Must Be Non-Empty
example.com. SVCB 1 foo.example.com. mandatory
example.com. SVCB 1 foo.example.com. alpn
example.com. SVCB 1 foo.example.com. port
example.com. SVCB 1 foo.example.com. ipv4hint
example.com. SVCB 1 foo.example.com. ipv6hint
*)
(*
let failure_missing_svc_param_values = {|
; Missing SvcParamValues That Must Be Non-Empty
example.com. SVCB 1 foo.example.com. mandatory
example.com. SVCB 1 foo.example.com. alpn
example.com. SVCB 1 foo.example.com. port
example.com. SVCB 1 foo.example.com. ipv4hint
example.com. SVCB 1 foo.example.com. ipv6hint
|}
Unable to build the key
*)
(*
; The "no-default-alpn" SvcParamKey Value Must Be Empty
example.com. SVCB 1 foo.example.com. no-default-alpn=abc
*)
(*
let failure_no_default_alpn_not_empty = {|
; The "no-default-alpn" SvcParamKey Value Must Be Empty
example.com. SVCB 1 foo.example.com. no-default-alpn=abc
|}
Unable to build the key
*)
(*
; A Mandatory SvcParam Is Missing
example.com. SVCB 1 foo.example.com. mandatory=key123
*)
(*
let failure_mandatory_svc_param_missing = {|
; A Mandatory SvcParam Is Missing
example.com. SVCB 1 foo.example.com. mandatory=key123
|}
Unable to build the key
*)
(*
; The "mandatory" SvcParamKey Must Not Be Included in the Mandatory List
example.com. SVCB 1 foo.example.com. mandatory=mandatory
*)
(*
let failure_mandatory_in_mandatory_list = {|
; The "mandatory" SvcParamKey Must Not Be Included in the Mandatory List
example.com. SVCB 1 foo.example.com. mandatory=mandatory
)
|}
Unable to build the key
*)
(*
; Multiple Instances of the Same SvcParamKey in the Mandatory List
example.com. SVCB 1 foo.example.com. (
mandatory=key123,key123 key123=abc
)
*)
let failure_key_repitition_in_mandatory_list = {|
; Multiple Instances of the Same SvcParamKey in the Mandatory List
example.com. SVCB 1 foo.example.com. (
mandatory=key123,key123 key123=abc
)
|}
let parse_key_repitition_in_mandatory_list () =
let _rrs =
let ttl = 3600l in
let example = n_of_s "example.com" in
let foo_example = n_of_s "foo.example.com" in
let svcb = Svcb.{
svc_priority = 1 ;
target_name = Domain_name.host_exn foo_example ;
svc_params = [
Mandatory [123;123];
Key (123,"abc")
]
} in
let svcb' = Rr_map.Svcb_set.singleton svcb in
Name_rr_map.add example Rr_map.Svcb (ttl,svcb') Name_rr_map.empty
in
Alcotest.(check (result name_map_ok err) "failure key repitition in mandatory list"
(Error (`Msg "")) (Dns_zone.parse failure_key_repitition_in_mandatory_list))
let tests = [
"failure_svc_param_key", `Quick, parse_failure_svc_param_key;
"key repitition in mandatory list", `Quick, parse_key_repitition_in_mandatory_list
]
end
let tests = [
"rfc9460 passing", Passing.tests ;
"rfc9460 failing", Failing.tests
]
let () =
Printexc.record_backtrace true;
Logs.set_reporter (Logs_fmt.reporter ());
Logs.set_level ~all:true (Some Logs.Debug);
Alcotest.run "rfc9460 tests" tests

2521
unikernel/duniverse/ocaml-dns/test/tests.ml Normal file
View file

File diff suppressed because it is too large Load diff

87
unikernel/duniverse/ocaml-dns/test/tsig.ml Normal file
View file

@ -0,0 +1,87 @@
(* (c) 2017 Hannes Mehnert, all rights reserved *)
let cs =
let module M = struct
type t = string
let pp = Ohex.pp
let equal = String.equal
end in
(module M: Alcotest.TESTABLE with type t = M.t)
let msg =
let module M = struct
type t = [ `Msg of string ]
let pp ppf = function `Msg str -> Fmt.string ppf str
let equal _ _ = true
end in
(module M: Alcotest.TESTABLE with type t = M.t)
let key =
match Base64.decode "GSnQJ+fHuzwj5yKzCOkXdISyGQXBUxMrjEjL4Kr1WIs=" with
| Error _ -> assert false
| Ok x -> x
let key_name = Domain_name.of_string_exn "mykey.bla.example"
let of_h = Ohex.decode
let tsig ?(fudge = 300) algorithm signed =
let fudge = Ptime.Span.of_int_s fudge in
let signed =
match Ptime.of_float_s signed with
| None -> assert false
| Some x -> x
in
match Dns.Tsig.tsig ~algorithm ~signed ~fudge () with
| None -> assert false
| Some x -> x
let example0 () =
let buf = of_h {__|62 d7 28 00 00 01 00 00 00 02 00 00 07 65 78 61
6d 70 6c 65 03 63 6f 6d 00 00 06 00 01 03 66 6f
6f c0 0c 00 ff 00 ff 00 00 00 00 00 00 03 62 61
72 c0 0c 00 01 00 01 00 00 01 2c 00 04 01 02 03
04|__}
and now = 1506887417.
and mac = of_h {__|bf 5d 77 ba 97 ba 7b 95 9e 1b 0d 95 64 a7 5b a6
95 bf 24 15 3b 9d a2 1b bf 6f ae 61 9d 0f 28 a1|__}
in
Alcotest.(check cs "tsig is the same" mac
(Dns_tsig.compute_tsig key_name (tsig Dns.Tsig.SHA256 now) ~key buf))
let example1 () =
let buf = of_h {__|4c 56 28 00 00 01 00 00 00 01 00 00 07 45 78 41
6d 50 6c 45 03 63 6f 6d 00 00 06 00 01 03 66 6f
6f 07 65 78 61 6d 70 6c 65 c0 14 00 ff 00 ff 00
00 00 00 00 00|__}
and now = 1506887742.
and mac = of_h {__|70 67 ae 70 9e fd 22 9e ce d9 65 25 8a db 8c 96
10 95 80 89 a7 ee 4f bb 13 81 e7 38 e3 a0 78 80|__}
in
Alcotest.(check cs "tsig is the same" mac
(Dns_tsig.compute_tsig key_name (tsig Dns.Tsig.SHA256 now) ~key buf))
let example2 () =
let buf = of_h {__|76 8a 28 00 00 01 00 00 00 01 00 00 07 65 78 61
6d 70 6c 65 00 00 06 00 01 03 66 6f 6f c0 0c 00
ff 00 ff 00 00 00 00 00 00|__}
and now = 1506888104.
and mac = of_h {__|e7 76 e6 df 4e 73 14 c8 eb ba 4c c7 a5 39 b3 93
a7 df 6d de 47 b6 fa cc 81 c8 47 29 20 77 40 44|__}
in
Alcotest.(check cs "tsig is the same" mac
(Dns_tsig.compute_tsig key_name (tsig Dns.Tsig.SHA256 now) ~key buf))
let tsig_tests = [
"example0", `Quick, example0 ;
"example1", `Quick, example1 ;
"example2", `Quick, example2 ;
]
let tests = [
"Tsig example", tsig_tests ;
]
let () = Alcotest.run "DNS name tests" tests