From 5dd3a7254e5113ec03c4860a05e4300b002353db Mon Sep 17 00:00:00 2001 From: Vadim Radovel Date: Fri, 12 Jun 2020 14:49:21 +0300 Subject: [PATCH] Utility functions (#94) * Add utility functions: succ, pred, Prefix.first and Prefix.last. * Add forgotten Ipaddr_sexp.Prefix. * Add tests for B128. --- lib/ipaddr.ml | 111 +++++++++++++++++++++++++++++++++++ lib/ipaddr.mli | 46 +++++++++++++++ lib/ipaddr_sexp.ml | 14 +++++ lib/ipaddr_sexp.mli | 12 ++++ lib_test/dune | 8 +++ lib_test/test_ipaddr.ml | 97 ++++++++++++++++++++++++++++++ lib_test/test_ipaddr_b128.ml | 59 +++++++++++++++++++ lib_test/test_ppx.ml | 1 + 8 files changed, 348 insertions(+) create mode 100644 lib_test/test_ipaddr_b128.ml diff --git a/lib/ipaddr.ml b/lib/ipaddr.ml index 9558641..7e7e89d 100644 --- a/lib/ipaddr.ml +++ b/lib/ipaddr.ml @@ -30,6 +30,12 @@ let try_with_result fn a = try Ok (fn a) with Parse_error (msg, _) -> Error (`Msg ("Ipaddr: " ^ msg)) +let failwith_msg = function + | Ok x -> x + | Error (`Msg m) -> failwith m + +let map_result v f = match v with Ok v -> Ok (f v) | Error _ as e -> e + let string_of_scope = function | Point -> "point" | Interface -> "interface" @@ -266,6 +272,18 @@ module V4 = struct end | _ -> None + let succ t = + if Int32.equal t 0xFF_FF_FF_FFl then + Error (`Msg "Ipaddr: highest address has been reached") + else + Ok (Int32.succ t) + + let pred t = + if Int32.equal t 0x00_00_00_00l then + Error (`Msg "Ipaddr: lowest address has been reached") + else + Ok (Int32.pred t) + (* constant *) let any = make 0 0 0 0 @@ -388,6 +406,18 @@ module V4 = struct let network (pre,_) = pre let bits (_,sz) = sz let netmask subnet = mask (bits subnet) + + let first (pre,sz) = + if sz > 30 then + pre + else + succ pre |> failwith_msg + + let last (_,sz as t) = + if sz > 30 then + broadcast t + else + broadcast t |> pred |> failwith_msg end (* TODO: this could be optimized with something trie-like *) @@ -466,6 +496,59 @@ module B128 = struct (a1 ||| a2, b1 ||| b2, c1 ||| c2, d1 ||| d2) let lognot (a,b,c,d) = Int32.(lognot a, lognot b, lognot c, lognot d) + + let succ (a,b,c,d) = + let cb (n,tl) v = + match n with + | 0l -> (0l,v::tl) + | n -> + let n = + if Int32.equal v 0xFF_FF_FF_FFl then + n + else + 0l + in + (n,Int32.succ v::tl) + in + match List.fold_left cb (1l,[]) [d;c;b;a] with + | 0l, [a;b;c;d] -> Ok (of_int32 (a,b,c,d)) + | n, [_;_;_;_] when n > 0l -> + Error (`Msg "Ipaddr: highest address has been reached") + | _ -> Error (`Msg "Ipaddr: unexpected error with B128") + + let pred (a,b,c,d) = + let cb (n,tl) v = + match n with + | 0l -> (0l,v::tl) + | n -> + let n = + if v = 0x00_00_00_00l then + n + else + 0l + in + (n,Int32.pred v::tl) + in + match List.fold_left cb (-1l,[]) [d;c;b;a] with + | 0l, [a;b;c;d] -> Ok (of_int32 (a,b,c,d)) + | n, [_;_;_;_] when n < 0l -> + Error (`Msg "Ipaddr: lowest address has been reached") + | _ -> Error (`Msg "Ipaddr: unexpected error with B128") + + let shift_right (a,b,c,d) sz = + let rec loop (a,b,c,d) sz = + if sz < 32 then (sz, (a,b,c,d)) + else loop (0l,a,b,c) (sz - 32) + in + let (sz, (a,b,c,d)) = loop (a,b,c,d) sz in + let fn (saved,tl) part = + let new_saved = Int32.logand part (0xFF_FF_FF_FFl >|> sz) in + let new_part = (part >|> sz) ||| (saved <|< 32 - sz) in + (new_saved, new_part::tl) + in + match List.fold_left fn (0l,[]) [a;b;c;d] with + | _, [d;c;b;a] -> Ok (of_int32 (a, b, c, d)) + | _ -> Error (`Msg "Ipaddr: unexpected error with B128.shift_right") end module V6 = struct @@ -862,6 +945,17 @@ module V6 = struct let network (pre,_) = pre let bits (_,sz) = sz let netmask subnet = mask (bits subnet) + + let first (pre,sz) = + if sz > 126 then + pre + else + succ pre |> failwith_msg + + let last (pre,sz) = + let ffff = ip 0xffff 0xffff 0xffff 0xffff + 0xffff 0xffff 0xffff 0xffff in + logor pre (shift_right ffff sz |> failwith_msg) end (* TODO: This could be optimized with something trie-like *) @@ -995,6 +1089,14 @@ let of_domain_name n = end | _ -> None +let succ = function + | V4 addr -> map_result (V4.succ addr) (fun v -> V4 v) + | V6 addr -> map_result (V6.succ addr) (fun v -> V6 v) + +let pred = function + | V4 addr -> map_result (V4.pred addr) (fun v -> V4 v) + | V6 addr -> map_result (V6.pred addr) (fun v -> V6 v) + module Prefix = struct module Addr = struct let to_v6 = to_v6 @@ -1069,4 +1171,13 @@ module Prefix = struct let pp ppf i = Format.fprintf ppf "%s" (to_string i) + + let first = function + | V4 p -> V4 (V4.Prefix.first p) + | V6 p -> V6 (V6.Prefix.first p) + + let last = function + | V4 p -> V4 (V4.Prefix.last p) + | V6 p -> V6 (V6.Prefix.last p) + end diff --git a/lib/ipaddr.mli b/lib/ipaddr.mli index c22cfb1..6a39395 100644 --- a/lib/ipaddr.mli +++ b/lib/ipaddr.mli @@ -148,6 +148,16 @@ module V4 : sig suffix, and an IPv4 address prefixed. *) val of_domain_name : 'a Domain_name.t -> t option + (** {3 Utility functions} *) + + (** [succ ipv4] is ip address next to [ipv4]. + Returns a human-readable error string if it's already the highest address. *) + val succ : t -> (t, [> `Msg of string ]) result + + (** [pred ipv4] is ip address before [ipv4]. + Returns a human-readable error string if it's already the lowest address. *) + val pred : t -> (t, [> `Msg of string ]) result + (** {3 Common addresses} *) (** [any] is 0.0.0.0. *) @@ -290,6 +300,12 @@ module V4 : sig (** [bits subnet] is the bit size of the [subnet] prefix. *) val bits : t -> int + (** [first subnet] is first valid unicast address in this [subnet]. *) + val first : t -> addr + + (** [last subnet] is last valid unicast address in this [subnet]. *) + val last : t -> addr + include Map.OrderedType with type t := t end @@ -412,6 +428,16 @@ module V6 : sig suffix, and an IPv6 address prefixed. *) val of_domain_name : 'a Domain_name.t -> t option + (** {3 Utility functions} *) + + (** [succ ipv6] is ip address next to [ipv6]. Returns a human-readable + error string if it's already the highest address. *) + val succ : t -> (t, [> `Msg of string ]) result + + (** [pred ipv6] is ip address before [ipv6]. Returns a human-readable + error string if it's already the lowest address. *) + val pred : t -> (t, [> `Msg of string ]) result + (** {3 Common addresses} *) (** [unspecified] is ::. *) @@ -546,6 +572,12 @@ module V6 : sig (** [bits subnet] is the bit size of the [subnet] prefix. *) val bits : t -> int + (** [first subnet] is first valid unicast address in this [subnet]. *) + val first : t -> addr + + (** [last subnet] is last valid unicast address in this [subnet]. *) + val last : t -> addr + include Map.OrderedType with type t := t end @@ -647,6 +679,14 @@ val to_domain_name : t -> [ `host ] Domain_name.t [ip6.arpa] suffix, and an IP address prefixed. *) val of_domain_name : 'a Domain_name.t -> t option +(** [succ addr] is ip address next to [addr]. Returns a human-readable + error string if it's already the highest address. *) +val succ : t -> (t, [> `Msg of string ]) result + +(** [pred addr] is ip address before [addr]. Returns a human-readable + error string if it's already the lowest address. *) +val pred : t -> (t, [> `Msg of string ]) result + module Prefix : sig type addr = t @@ -706,6 +746,12 @@ module Prefix : sig (** [netmask subnet] is the netmask for [subnet]. *) val netmask : t -> addr + (** [first subnet] is first valid unicast address in this [subnet]. *) + val first : t -> addr + + (** [last subnet] is last valid unicast address in this [subnet]. *) + val last : t -> addr + include Map.OrderedType with type t := t end diff --git a/lib/ipaddr_sexp.ml b/lib/ipaddr_sexp.ml index 29d13c9..31cd99f 100644 --- a/lib/ipaddr_sexp.ml +++ b/lib/ipaddr_sexp.ml @@ -91,3 +91,17 @@ type scope = I.scope let sexp_of_scope = to_sexp I.string_of_scope let scope_of_sexp = of_sexp I.scope_of_string + +module Prefix = struct + module I = Ipaddr.Prefix + + type addr = I.addr + + type t = I.t + + let sexp_of_t = to_sexp I.to_string + + let t_of_sexp = of_sexp I.of_string + + let compare = I.compare +end diff --git a/lib/ipaddr_sexp.mli b/lib/ipaddr_sexp.mli index 0f37518..06e6241 100644 --- a/lib/ipaddr_sexp.mli +++ b/lib/ipaddr_sexp.mli @@ -99,3 +99,15 @@ module V6 : sig val compare : Ipaddr.V6.Prefix.t -> Ipaddr.V6.Prefix.t -> int end end + +module Prefix : sig + type addr = Ipaddr.Prefix.addr + + type t = Ipaddr.Prefix.t + + val sexp_of_t : Ipaddr.Prefix.t -> Sexplib0.Sexp.t + + val t_of_sexp : Sexplib0.Sexp.t -> Ipaddr.Prefix.t + + val compare : Ipaddr.Prefix.t -> Ipaddr.Prefix.t -> int +end diff --git a/lib_test/dune b/lib_test/dune index 07f8c2a..b50f0e1 100644 --- a/lib_test/dune +++ b/lib_test/dune @@ -1,5 +1,7 @@ (rule (copy# ../lib/ipaddr_sexp.ml ipaddr_sexp.ml)) (rule (copy# ../lib/macaddr_sexp.ml macaddr_sexp.ml)) +(rule (copy# ../lib/ipaddr.ml ipaddr_internal.ml)) + (library (name test_macaddr_sexp) @@ -21,6 +23,12 @@ (modules test_ipaddr) (libraries ipaddr ipaddr-cstruct test_ipaddr_sexp oUnit)) +(test + (name test_ipaddr_b128) + (package ipaddr-sexp) + (modules test_ipaddr_b128 ipaddr_internal) + (libraries ipaddr ipaddr-cstruct test_ipaddr_sexp oUnit)) + (test (name test_macaddr) (package macaddr-sexp) diff --git a/lib_test/test_ipaddr.ml b/lib_test/test_ipaddr.ml index e2697b5..049f27d 100644 --- a/lib_test/test_ipaddr.ml +++ b/lib_test/test_ipaddr.ml @@ -23,6 +23,8 @@ let need_more s = error s "not enough data" let bad_char i s = error s (Printf.sprintf "invalid character '%c' at %d" s.[i] i) +let (>>=) v f = match v with Ok v -> f v | Error _ as e -> e + let assert_raises ~msg exn test_fn = assert_raises ~msg exn (fun () -> try test_fn () @@ -325,6 +327,48 @@ module Test_v4 = struct assert_equal ~msg (V4.Prefix.mem addr subnet) is_mem ) ships + let test_succ_pred () = + let open V4 in + let printer = function + | Ok v -> Printf.sprintf "Ok %s" (to_string v) + | Error (`Msg e) -> Printf.sprintf "Error `Msg \"%s\"" e + in + let assert_equal = assert_equal ~printer in + let ip1 = of_string_exn "0.0.0.0" in + let ip2 = of_string_exn "255.255.255.255" in + assert_equal ~msg:"succ 0.0.0.0" + (of_string "0.0.0.1") (succ ip1); + assert_equal ~msg:"succ 255.255.255.255" + (Error (`Msg "Ipaddr: highest address has been reached")) (succ ip2); + assert_equal ~msg:"succ (succ 255.255.255.255)" + (Error (`Msg "Ipaddr: highest address has been reached")) + (succ ip2 >>= succ); + assert_equal ~msg:"pred 0.0.0.0" + (Error (`Msg "Ipaddr: lowest address has been reached")) (pred ip1); + () + + let test_prefix_first_last () = + let open V4.Prefix in + let assert_equal = assert_equal ~printer:V4.to_string in + assert_equal ~msg:"first 192.168.1.0/24" + (V4.of_string_exn "192.168.1.1") + (first (of_string_exn "192.168.1.0/24")); + assert_equal ~msg:"first 169.254.169.254/31" + (Ipaddr.V4.of_string_exn "169.254.169.254") + (first (of_string_exn "169.254.169.254/31")); + assert_equal ~msg:"first 169.254.169.254/32" + (Ipaddr.V4.of_string_exn "169.254.169.254") + (first (of_string_exn "169.254.169.254/32")); + assert_equal ~msg:"last 192.168.1.0/24" + (Ipaddr.V4.of_string_exn "192.168.1.254") + (last (of_string_exn "192.168.1.0/24")); + assert_equal ~msg:"last 169.254.169.254/31" + (Ipaddr.V4.of_string_exn "169.254.169.255") + (last (of_string_exn "169.254.169.254/31")); + assert_equal ~msg:"last 169.254.169.254/32" + (Ipaddr.V4.of_string_exn "169.254.169.254") + (last (of_string_exn "169.254.169.254/32")) + let suite = "Test V4" >::: [ "string_rt" >:: test_string_rt; "string_rt_bad" >:: test_string_rt_bad; @@ -349,6 +393,8 @@ module Test_v4 = struct "multicast_mac" >:: test_multicast_mac; "domain_name" >:: test_domain_name; "prefix_mem" >:: test_prefix_mem; + "succ_pred" >:: test_succ_pred; + "prefix_first_last" >:: test_prefix_first_last; ] end @@ -670,6 +716,55 @@ module Test_v6 = struct assert_equal ~msg:("link_address_of_mac "^ip_str^" <> "^expected) ip_str expected + let test_succ_pred () = + let open V6 in + let printer = function + | Ok v -> Printf.sprintf "Ok %s" (V6.to_string v) + | Error (`Msg e) -> Printf.sprintf "Error `Msg \"%s\"" e + in + let assert_equal = assert_equal ~printer in + let ip1 = of_string_exn "::" in + let ip2 = of_string_exn "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" in + let ip3 = of_string_exn "::2" in + assert_equal ~msg:"succ ::" (of_string "::1") (succ ip1); + assert_equal ~msg:"succ (succ ::)" + (of_string "::2") (succ ip1 >>= succ); + assert_equal ~msg:"succ ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" + (Error (`Msg "Ipaddr: highest address has been reached")) (succ ip2); + assert_equal ~msg:"pred ::2" (of_string "::1") (pred ip3) ; + assert_equal ~msg:"pred ::ffff:ffff" + (of_string "::ffff:fffd") + (of_string "::ffff:ffff" >>= pred >>= pred); + assert_equal ~msg:"pred ::" + (Error (`Msg "Ipaddr: lowest address has been reached")) (pred ip1); + assert_equal ~msg:"pred (succ ::2)" (Ok ip3) (succ ip3 >>= pred) + + let test_first_last () = + let open V6 in + let open Prefix in + let ip_of_string = V6.of_string_exn in + let assert_equal = assert_equal ~printer:V6.to_string in + assert_equal ~msg:"first ::/64" + (ip_of_string "::1") (first @@ of_string_exn "::/64"); + assert_equal ~msg:"first ::ff00/120" + (ip_of_string "::ff01") (first @@ of_string_exn "::ff00/120"); + assert_equal ~msg:"first ::aaa0/127" + (ip_of_string "::aaa0") (first @@ of_string_exn "::aaa0/127"); + assert_equal ~msg:"first ::aaa0/128" (ip_of_string "::aaa0") + (first @@ of_string_exn "::aaa0/128"); + assert_equal ~msg:"last ::/64" (ip_of_string "::ffff:ffff:ffff:ffff") + (last @@ of_string_exn "::/64"); + assert_equal ~msg:"last ::/120" (ip_of_string "::ff") + (last @@ of_string_exn "::/120"); + assert_equal ~msg:"last ::/112" (ip_of_string "::ffff") + (last @@ of_string_exn "::/112"); + assert_equal ~msg:"last ::bbbb:eeee:0000:0000/64" (ip_of_string "::ffff:ffff:ffff:ffff") + (last @@ of_string_exn "::bbbb:eeee:0000:0000/64"); + assert_equal ~msg:"last ::aaa0/127" (ip_of_string "::aaa1") + (last @@ of_string_exn "::aaa0/127"); + assert_equal ~msg:"last ::aaa0/128" (ip_of_string "::aaa0") + (last @@ of_string_exn "::aaa0/128") + let suite = "Test V6" >::: [ "string_rt" >:: test_string_rt; "string_rt_bad" >:: test_string_rt_bad; @@ -692,6 +787,8 @@ module Test_v6 = struct "multicast_mac" >:: test_multicast_mac; "domain_name" >:: test_domain_name; "link_address_of_mac" >:: test_link_address_of_mac; + "succ_pred" >:: test_succ_pred; + "first_last" >:: test_first_last; ] end diff --git a/lib_test/test_ipaddr_b128.ml b/lib_test/test_ipaddr_b128.ml new file mode 100644 index 0000000..1f60a32 --- /dev/null +++ b/lib_test/test_ipaddr_b128.ml @@ -0,0 +1,59 @@ +(* + * Copyright (c) 2013-2014 David Sheets + * + * 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. + * + *) + +open OUnit + +let test_shift_right () = + let open Ipaddr_internal in + let open V6 in + let printer = function + | Ok v -> Printf.sprintf "Ok %s" (to_string v) + | Error (`Msg e) -> Printf.sprintf "Error `Msg \"%s\"" e + in + let assert_equal = assert_equal ~printer in + assert_equal ~msg:":: >> 32" + (of_string "::") + (B128.shift_right (of_string_exn "::ffff:ffff") 32); + assert_equal ~msg:"::aaaa:bbbb:ffff:ffff >> 32" + (of_string "::aaaa:bbbb") + (B128.shift_right (of_string_exn "::aaaa:bbbb:ffff:ffff") 32); + assert_equal ~msg:"::aaaa:bbbb:ffff:ffff >> 40" + (of_string "::aa:aabb") + (B128.shift_right (of_string_exn "::aaaa:bbbb:ffff:ffff") 40); + assert_equal ~msg:"::ffff >> 2" + (of_string "::3fff") + (B128.shift_right (of_string_exn "::ffff") 2); + assert_equal ~msg:"ffff:: >> 128" + (of_string "::") + (B128.shift_right (of_string_exn "ffff::") 128); + assert_equal ~msg:"aaaa:bbbb:cccc:dddd:: >> 120" + (of_string "::aa") + (B128.shift_right (of_string_exn "aaaa:bbbb:cccc:dddd::") 120); + assert_equal ~msg:"ffff:: >> 140" + (of_string "::") + (B128.shift_right (of_string_exn "ffff::") 140); + assert_equal ~msg:"::ffff:ffff >> -8" + (of_string "::") + (B128.shift_right (of_string_exn "::ffff:ffff") (-8)) + +let suite = "Test B128 module" >::: [ + "shift_right" >:: test_shift_right; +] + +;; +let _results = run_test_tt_main suite in +() diff --git a/lib_test/test_ppx.ml b/lib_test/test_ppx.ml index 0b5c08b..d7cf6eb 100644 --- a/lib_test/test_ppx.ml +++ b/lib_test/test_ppx.ml @@ -23,4 +23,5 @@ type t = { ipv4p: Ipaddr_sexp.V4.Prefix.t; scope: Ipaddr_sexp.scope; mac: Macaddr_sexp.t; + ipp: Ipaddr_sexp.Prefix.t; } [@@deriving sexp]