Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

use domain-name library to produce domain names from ip addresses #88

Merged
merged 4 commits into from
Jul 9, 2019
Merged
Show file tree
Hide file tree
Changes from 2 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions ipaddr.opam
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,7 @@ depends: [
"dune" {build}
"macaddr"
"sexplib0"
"domain-name" {>= "0.2.1"}
"ounit" {with-test}
"ppx_sexp_conv" {with-test}
]
Expand Down
2 changes: 1 addition & 1 deletion lib/dune
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
(name ipaddr)
(public_name ipaddr)
(modules ipaddr)
(libraries macaddr))
(libraries macaddr domain-name))

(library
(name macaddr)
Expand Down
161 changes: 115 additions & 46 deletions lib/ipaddr.ml
Original file line number Diff line number Diff line change
Expand Up @@ -233,15 +233,35 @@ 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.(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 <! bits
in
try
Some Int32.(add (conv_add 0 a) (add (conv_add 8 b) (add (conv_add 16 c) (conv_add 24 d))))
with
| Parse_error _ -> None
end
| _ -> None

(* constant *)

Expand Down Expand Up @@ -652,43 +672,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 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 *)

Expand Down Expand Up @@ -920,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
Expand Down
24 changes: 18 additions & 6 deletions lib/ipaddr.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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} *)

Expand Down Expand Up @@ -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} *)

Expand Down Expand Up @@ -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
Expand Down
17 changes: 11 additions & 6 deletions lib_test/test_ipaddr.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -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
Expand Down