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

@@ -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

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
 

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

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

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)