From 9e17e15caeafc2d724cde8ee4c57a613e7e273ca Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Mon, 8 Jul 2019 11:51:54 +0200 Subject: [PATCH 1/3] use domain-name library to produce domain names from ip addresses --- ipaddr.opam | 1 + lib/dune | 2 +- lib/ipaddr.ml | 95 +++++++++++++++++++++-------------------- lib/ipaddr.mli | 12 +++--- lib_test/test_ipaddr.ml | 15 ++++--- 5 files changed, 66 insertions(+), 59 deletions(-) diff --git a/ipaddr.opam b/ipaddr.opam index 2c2a3f0..0b930a1 100644 --- a/ipaddr.opam +++ b/ipaddr.opam @@ -31,6 +31,7 @@ depends: [ "dune" {build} "macaddr" "sexplib0" + "domain-name" {>= "0.2.0"} "ounit" {with-test} "ppx_sexp_conv" {with-test} ] diff --git a/lib/dune b/lib/dune index 41d99bb..527a78a 100644 --- a/lib/dune +++ b/lib/dune @@ -2,7 +2,7 @@ (name ipaddr) (public_name ipaddr) (modules ipaddr) - (libraries macaddr)) + (libraries macaddr domain-name)) (library (name macaddr) diff --git a/lib/ipaddr.ml b/lib/ipaddr.ml index 4ce6a2d..b43afd5 100644 --- a/lib/ipaddr.ml +++ b/lib/ipaddr.ml @@ -233,15 +233,16 @@ module V4 = struct Macaddr.of_bytes_exn (Bytes.to_string macb) (* Host *) - let to_domain_name i = [ - Int32.to_string (i >! 0); - Int32.to_string (i >! 8); - Int32.to_string (i >! 16); - Int32.to_string (i >! 24); - "in-addr"; - "arpa"; - ""; - ] + let to_domain_name i = + let name = [ + Int32.to_string (i >! 0); + Int32.to_string (i >! 8); + Int32.to_string (i >! 16); + Int32.to_string (i >! 24); + "in-addr"; + "arpa" ] + in + Domain_name.(host_exn (of_strings_exn name)) (* constant *) @@ -652,43 +653,45 @@ module V6 = struct Macaddr.of_bytes_exn (Bytes.to_string macb) (* Host *) - let to_domain_name (a,b,c,d) = [ - hex_string_of_int32 ((d >|> 0) &&& 0xF_l); - hex_string_of_int32 ((d >|> 4) &&& 0xF_l); - hex_string_of_int32 ((d >|> 8) &&& 0xF_l); - hex_string_of_int32 ((d >|> 12) &&& 0xF_l); - hex_string_of_int32 ((d >|> 16) &&& 0xF_l); - hex_string_of_int32 ((d >|> 20) &&& 0xF_l); - hex_string_of_int32 ((d >|> 24) &&& 0xF_l); - hex_string_of_int32 ((d >|> 28) &&& 0xF_l); - hex_string_of_int32 ((c >|> 0) &&& 0xF_l); - hex_string_of_int32 ((c >|> 4) &&& 0xF_l); - hex_string_of_int32 ((c >|> 8) &&& 0xF_l); - hex_string_of_int32 ((c >|> 12) &&& 0xF_l); - hex_string_of_int32 ((c >|> 16) &&& 0xF_l); - hex_string_of_int32 ((c >|> 20) &&& 0xF_l); - hex_string_of_int32 ((c >|> 24) &&& 0xF_l); - hex_string_of_int32 ((c >|> 28) &&& 0xF_l); - hex_string_of_int32 ((b >|> 0) &&& 0xF_l); - hex_string_of_int32 ((b >|> 4) &&& 0xF_l); - hex_string_of_int32 ((b >|> 8) &&& 0xF_l); - hex_string_of_int32 ((b >|> 12) &&& 0xF_l); - hex_string_of_int32 ((b >|> 16) &&& 0xF_l); - hex_string_of_int32 ((b >|> 20) &&& 0xF_l); - hex_string_of_int32 ((b >|> 24) &&& 0xF_l); - hex_string_of_int32 ((b >|> 28) &&& 0xF_l); - hex_string_of_int32 ((a >|> 0) &&& 0xF_l); - hex_string_of_int32 ((a >|> 4) &&& 0xF_l); - hex_string_of_int32 ((a >|> 8) &&& 0xF_l); - hex_string_of_int32 ((a >|> 12) &&& 0xF_l); - hex_string_of_int32 ((a >|> 16) &&& 0xF_l); - hex_string_of_int32 ((a >|> 20) &&& 0xF_l); - hex_string_of_int32 ((a >|> 24) &&& 0xF_l); - hex_string_of_int32 ((a >|> 28) &&& 0xF_l); - "ip6"; - "arpa"; - ""; - ] + let to_domain_name (a,b,c,d) = + let name = [ + hex_string_of_int32 ((d >|> 0) &&& 0xF_l); + hex_string_of_int32 ((d >|> 4) &&& 0xF_l); + hex_string_of_int32 ((d >|> 8) &&& 0xF_l); + hex_string_of_int32 ((d >|> 12) &&& 0xF_l); + hex_string_of_int32 ((d >|> 16) &&& 0xF_l); + hex_string_of_int32 ((d >|> 20) &&& 0xF_l); + hex_string_of_int32 ((d >|> 24) &&& 0xF_l); + hex_string_of_int32 ((d >|> 28) &&& 0xF_l); + hex_string_of_int32 ((c >|> 0) &&& 0xF_l); + hex_string_of_int32 ((c >|> 4) &&& 0xF_l); + hex_string_of_int32 ((c >|> 8) &&& 0xF_l); + hex_string_of_int32 ((c >|> 12) &&& 0xF_l); + hex_string_of_int32 ((c >|> 16) &&& 0xF_l); + hex_string_of_int32 ((c >|> 20) &&& 0xF_l); + hex_string_of_int32 ((c >|> 24) &&& 0xF_l); + hex_string_of_int32 ((c >|> 28) &&& 0xF_l); + hex_string_of_int32 ((b >|> 0) &&& 0xF_l); + hex_string_of_int32 ((b >|> 4) &&& 0xF_l); + hex_string_of_int32 ((b >|> 8) &&& 0xF_l); + hex_string_of_int32 ((b >|> 12) &&& 0xF_l); + hex_string_of_int32 ((b >|> 16) &&& 0xF_l); + hex_string_of_int32 ((b >|> 20) &&& 0xF_l); + hex_string_of_int32 ((b >|> 24) &&& 0xF_l); + hex_string_of_int32 ((b >|> 28) &&& 0xF_l); + hex_string_of_int32 ((a >|> 0) &&& 0xF_l); + hex_string_of_int32 ((a >|> 4) &&& 0xF_l); + hex_string_of_int32 ((a >|> 8) &&& 0xF_l); + hex_string_of_int32 ((a >|> 12) &&& 0xF_l); + hex_string_of_int32 ((a >|> 16) &&& 0xF_l); + hex_string_of_int32 ((a >|> 20) &&& 0xF_l); + hex_string_of_int32 ((a >|> 24) &&& 0xF_l); + hex_string_of_int32 ((a >|> 28) &&& 0xF_l); + "ip6"; + "arpa" + ] + in + Domain_name.(host_exn (of_strings_exn name)) (* constant *) diff --git a/lib/ipaddr.mli b/lib/ipaddr.mli index 7568986..e2456af 100644 --- a/lib/ipaddr.mli +++ b/lib/ipaddr.mli @@ -131,8 +131,8 @@ module V4 : sig (** {3 Host conversion} *) (** [to_domain_name ipv4] is the domain name label list for reverse - lookups of [ipv4]. This includes the [.in-addr.arpa.] suffix. *) - val to_domain_name : t -> string list + lookups of [ipv4]. This includes the [.in-addr.arpa] suffix. *) + val to_domain_name : t -> [ `host ] Domain_name.t (** {3 Common addresses} *) @@ -383,8 +383,8 @@ module V6 : sig (** {3 Host conversion} *) (** [to_domain_name ipv6] is the domain name label list for reverse - lookups of [ipv6]. This includes the [.ip6.arpa.] suffix. *) - val to_domain_name : t -> string list + lookups of [ipv6]. This includes the [.ip6.arpa] suffix. *) + val to_domain_name : t -> [ `host ] Domain_name.t (** {3 Common addresses} *) @@ -609,8 +609,8 @@ val is_private : t -> bool val multicast_to_mac : t -> Macaddr.t (** [to_domain_name addr] is the domain name label list for reverse - lookups of [addr]. This includes the [.arpa.] suffix. *) -val to_domain_name : t -> string list + lookups of [addr]. This includes the [.in-addr.arpa] or [.ip6.arpa] suffix. *) +val to_domain_name : t -> [ `host ] Domain_name.t module Prefix : sig type addr = t diff --git a/lib_test/test_ipaddr.ml b/lib_test/test_ipaddr.ml index c0662e0..ba222b6 100644 --- a/lib_test/test_ipaddr.ml +++ b/lib_test/test_ipaddr.ml @@ -285,9 +285,11 @@ module Test_v4 = struct let test_domain_name () = let ip = V4.of_string_exn "128.64.32.16" in - let name = "16.32.64.128.in-addr.arpa." in - assert_equal ~msg:"domain_name" - (String.concat "." (V4.to_domain_name ip)) name + let name = + Domain_name.(host_exn (of_string_exn "16.32.64.128.in-addr.arpa")) + in + assert_equal ~cmp:Domain_name.equal ~msg:"domain_name" + (V4.to_domain_name ip) name let suite = "Test V4" >::: [ "string_rt" >:: test_string_rt; @@ -602,10 +604,11 @@ module Test_v6 = struct let test_domain_name () = let ip = V6.of_string_exn "2a00:1450:4009:800::200e" in let name = - "e.0.0.2.0.0.0.0.0.0.0.0.0.0.0.0.0.0.8.0.9.0.0.4.0.5.4.1.0.0.a.2.ip6.arpa." + "e.0.0.2.0.0.0.0.0.0.0.0.0.0.0.0.0.0.8.0.9.0.0.4.0.5.4.1.0.0.a.2.ip6.arpa" in - assert_equal ~msg:"domain_name" - (String.concat "." (V6.to_domain_name ip)) name + let name = Domain_name.(host_exn (of_string_exn name)) in + assert_equal ~cmp:Domain_name.equal ~msg:"domain_name" + (V6.to_domain_name ip) name let test_link_address_of_mac () = let mac = Macaddr.of_string_exn "34-56-78-9A-BC-DE" in From 6cd61c9cabfa2506376ef3ae25e915554084282d Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Mon, 8 Jul 2019 12:33:11 +0200 Subject: [PATCH 2/3] provide of_domain_name --- ipaddr.opam | 2 +- lib/ipaddr.ml | 66 +++++++++++++++++++++++++++++++++++++++++ lib/ipaddr.mli | 12 ++++++++ lib_test/test_ipaddr.ml | 10 ++++--- 4 files changed, 85 insertions(+), 5 deletions(-) diff --git a/ipaddr.opam b/ipaddr.opam index 0b930a1..48f9ac3 100644 --- a/ipaddr.opam +++ b/ipaddr.opam @@ -31,7 +31,7 @@ depends: [ "dune" {build} "macaddr" "sexplib0" - "domain-name" {>= "0.2.0"} + "domain-name" {>= "0.2.1"} "ounit" {with-test} "ppx_sexp_conv" {with-test} ] diff --git a/lib/ipaddr.ml b/lib/ipaddr.ml index b43afd5..56e130e 100644 --- a/lib/ipaddr.ml +++ b/lib/ipaddr.ml @@ -244,6 +244,25 @@ module V4 = struct in Domain_name.(host_exn (of_strings_exn name)) + let of_domain_name n = + match Domain_name.to_strings n with + | [ a ; b ; c ; d ; in_addr ; arpa ] when + Domain_name.(compare_sub arpa "arpa" = 0 && compare_sub in_addr "in-addr" = 0) -> + begin + let conv_add bits data = + let i = Int32.of_int (parse_dec_int data (ref 0)) in + if i > 0xFFl then + raise (Parse_error ("label with a too big number", data)) + else + i None + end + | _ -> None + (* constant *) let any = make 0 0 0 0 @@ -693,6 +712,39 @@ module V6 = struct in Domain_name.(host_exn (of_strings_exn name)) + let of_domain_name n = + let open Domain_name in + if count_labels n = 34 then + let ip6 = get_label_exn n 32 and arpa = get_label_exn n 33 in + if compare_sub ip6 "ip6" = 0 && compare_sub arpa "arpa" = 0 then + let back = true in + let n' = drop_label_exn ~back ~amount:2 n in + let d = drop_label_exn ~back ~amount:24 n' + and c = drop_label_exn ~amount:8 (drop_label_exn ~back ~amount:16 n') + and b = drop_label_exn ~amount:16 (drop_label_exn ~back ~amount:8 n') + and a = drop_label_exn ~amount:24 n' + in + let t b d = + let v = Int32.of_int (parse_hex_int d (ref 0)) in + if v > 0xFl then + raise (Parse_error ("number in label too big", d)) + else + v <|< b + in + let f d = + List.fold_left (fun (acc, b) d -> Int32.add acc (t b d), b + 4) + (0l, 0) (to_strings d) + in + try + let a', _ = f a and b', _ = f b and c', _ = f c and d', _ = f d in + Some (a', b', c', d') + with + | Parse_error _ -> None + else + None + else + None + (* constant *) let unspecified = make 0 0 0 0 0 0 0 0 @@ -923,6 +975,20 @@ let to_domain_name = function | V4 v4 -> V4.to_domain_name v4 | V6 v6 -> V6.to_domain_name v6 +let of_domain_name n = + match Domain_name.count_labels n with + | 6 -> + begin match V4.of_domain_name n with + | None -> None + | Some x -> Some (V4 x) + end + | 34 -> + begin match V6.of_domain_name n with + | None -> None + | Some x -> Some (V6 x) + end + | _ -> None + module Prefix = struct module Addr = struct let to_v6 = to_v6 diff --git a/lib/ipaddr.mli b/lib/ipaddr.mli index e2456af..d4c5f5e 100644 --- a/lib/ipaddr.mli +++ b/lib/ipaddr.mli @@ -134,6 +134,10 @@ module V4 : sig lookups of [ipv4]. This includes the [.in-addr.arpa] suffix. *) val to_domain_name : t -> [ `host ] Domain_name.t + (** [of_domain_name name] is [Some t] if the [name] has an [.in-addr.arpa] + suffix, and an IPv4 address prefixed. *) + val of_domain_name : 'a Domain_name.t -> t option + (** {3 Common addresses} *) (** [any] is 0.0.0.0. *) @@ -386,6 +390,10 @@ module V6 : sig lookups of [ipv6]. This includes the [.ip6.arpa] suffix. *) val to_domain_name : t -> [ `host ] Domain_name.t + (** [of_domain_name name] is [Some t] if the [name] has an [.ip6.arpa] + suffix, and an IPv6 address prefixed. *) + val of_domain_name : 'a Domain_name.t -> t option + (** {3 Common addresses} *) (** [unspecified] is ::. *) @@ -612,6 +620,10 @@ val multicast_to_mac : t -> Macaddr.t lookups of [addr]. This includes the [.in-addr.arpa] or [.ip6.arpa] suffix. *) val to_domain_name : t -> [ `host ] Domain_name.t +(** [of_domain_name name] is [Some t] if the [name] has an [.in-addr.arpa] or + [ip6.arpa] suffix, and an IP address prefixed. *) +val of_domain_name : 'a Domain_name.t -> t option + module Prefix : sig type addr = t diff --git a/lib_test/test_ipaddr.ml b/lib_test/test_ipaddr.ml index ba222b6..c5ad005 100644 --- a/lib_test/test_ipaddr.ml +++ b/lib_test/test_ipaddr.ml @@ -288,8 +288,9 @@ module Test_v4 = struct let name = Domain_name.(host_exn (of_string_exn "16.32.64.128.in-addr.arpa")) in - assert_equal ~cmp:Domain_name.equal ~msg:"domain_name" - (V4.to_domain_name ip) name + assert_equal ~cmp:Domain_name.equal ~msg:"to_domain_name" + (V4.to_domain_name ip) name ; + assert_equal ~msg:"of_domain_name" (V4.of_domain_name name) (Some ip) let suite = "Test V4" >::: [ "string_rt" >:: test_string_rt; @@ -607,8 +608,9 @@ module Test_v6 = struct "e.0.0.2.0.0.0.0.0.0.0.0.0.0.0.0.0.0.8.0.9.0.0.4.0.5.4.1.0.0.a.2.ip6.arpa" in let name = Domain_name.(host_exn (of_string_exn name)) in - assert_equal ~cmp:Domain_name.equal ~msg:"domain_name" - (V6.to_domain_name ip) name + assert_equal ~cmp:Domain_name.equal ~msg:"to_domain_name" + (V6.to_domain_name ip) name ; + assert_equal ~msg:"of_domain_name" (V6.of_domain_name name) (Some ip) let test_link_address_of_mac () = let mac = Macaddr.of_string_exn "34-56-78-9A-BC-DE" in From f2c336c815a72c3ee1611244376324e0d49f5338 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Mon, 8 Jul 2019 17:32:27 +0200 Subject: [PATCH 3/3] domain-name 0.3.0 --- ipaddr.opam | 2 +- lib/ipaddr.ml | 19 ++++++++++--------- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/ipaddr.opam b/ipaddr.opam index 48f9ac3..67b05e3 100644 --- a/ipaddr.opam +++ b/ipaddr.opam @@ -31,7 +31,7 @@ depends: [ "dune" {build} "macaddr" "sexplib0" - "domain-name" {>= "0.2.1"} + "domain-name" {>= "0.3.0"} "ounit" {with-test} "ppx_sexp_conv" {with-test} ] diff --git a/lib/ipaddr.ml b/lib/ipaddr.ml index 56e130e..dc4ec5d 100644 --- a/lib/ipaddr.ml +++ b/lib/ipaddr.ml @@ -247,9 +247,9 @@ module V4 = struct let of_domain_name n = match Domain_name.to_strings n with | [ a ; b ; c ; d ; in_addr ; arpa ] when - Domain_name.(compare_sub arpa "arpa" = 0 && compare_sub in_addr "in-addr" = 0) -> + Domain_name.(equal_label arpa "arpa" && equal_label in_addr "in-addr") -> begin - let conv_add bits data = + let conv bits data = let i = Int32.of_int (parse_dec_int data (ref 0)) in if i > 0xFFl then raise (Parse_error ("label with a too big number", data)) @@ -257,7 +257,8 @@ module V4 = struct i None end @@ -716,12 +717,12 @@ module V6 = struct let open Domain_name in if count_labels n = 34 then let ip6 = get_label_exn n 32 and arpa = get_label_exn n 33 in - if compare_sub ip6 "ip6" = 0 && compare_sub arpa "arpa" = 0 then - let back = true in - let n' = drop_label_exn ~back ~amount:2 n in - let d = drop_label_exn ~back ~amount:24 n' - and c = drop_label_exn ~amount:8 (drop_label_exn ~back ~amount:16 n') - and b = drop_label_exn ~amount:16 (drop_label_exn ~back ~amount:8 n') + if equal_label ip6 "ip6" && equal_label arpa "arpa" then + let rev = true in + let n' = drop_label_exn ~rev ~amount:2 n in + let d = drop_label_exn ~rev ~amount:24 n' + and c = drop_label_exn ~amount:8 (drop_label_exn ~rev ~amount:16 n') + and b = drop_label_exn ~amount:16 (drop_label_exn ~rev ~amount:8 n') and a = drop_label_exn ~amount:24 n' in let t b d =