diff --git a/ipaddr.opam b/ipaddr.opam index 5b47f89..88b0f16 100644 --- a/ipaddr.opam +++ b/ipaddr.opam @@ -30,6 +30,8 @@ depends: [ "ocaml" {>= "4.04.0"} "dune" {build} "macaddr" + "sexplib0" + "domain-name" {>= "0.3.0"} "ounit" {with-test} "ppx_sexp_conv" {with-test & >= "v0.9.0"} ] diff --git a/lib/dune b/lib/dune index bdea15c..1a82853 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..dc4ec5d 100644 --- a/lib/ipaddr.ml +++ b/lib/ipaddr.ml @@ -233,15 +233,36 @@ 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)) + + let of_domain_name n = + match Domain_name.to_strings n with + | [ a ; b ; c ; d ; in_addr ; arpa ] when + Domain_name.(equal_label arpa "arpa" && equal_label in_addr "in-addr") -> + begin + 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)) + else + i None + end + | _ -> None (* constant *) @@ -652,43 +673,78 @@ 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)) + + 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 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 = + 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 *) @@ -920,6 +976,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 7568986..d4c5f5e 100644 --- a/lib/ipaddr.mli +++ b/lib/ipaddr.mli @@ -131,8 +131,12 @@ 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 + + (** [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} *) @@ -383,8 +387,12 @@ 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 + + (** [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} *) @@ -609,8 +617,12 @@ 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 + +(** [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 c0662e0..c5ad005 100644 --- a/lib_test/test_ipaddr.ml +++ b/lib_test/test_ipaddr.ml @@ -285,9 +285,12 @@ 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:"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; @@ -602,10 +605,12 @@ 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:"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