CP-50108: Use Ipaddr instead of string-based CIDR handling

In nm.ml; helpers.ml.
Expands test cases, keeps the existent exception behaviour.

Signed-off-by: Andrii Sultanov <andrii.sultanov@cloud.com>

Author: Andrii Sultanov

ocaml/tests/test_helpers.ml

@@ -320,6 +320,14 @@ module IPCheckers = Generic.MakeStateless (struct
       ; ( (`ipv6, "address5", "ze80::bae8:56ff:fe29:894a")
         , Error (Server_error (invalid_ip_address_specified, ["address5"]))
         )
+      ; ((`ipv4or6, "address5", "192.168.0.1"), Ok ())
+      ; ((`ipv4or6, "address6", "fe80::bae8:56ff:fe29:894a"), Ok ())
+      ; ( (`ipv4or6, "address7", "ze80::bae8:56ff:fe29:894a")
+        , Error (Server_error (invalid_ip_address_specified, ["address7"]))
+        )
+      ; ( (`ipv4or6, "address8", "192.168.0.300")
+        , Error (Server_error (invalid_ip_address_specified, ["address8"]))
+        )
       ]
 end)
 
@@ -399,6 +407,17 @@ module CIDRCheckers = Generic.MakeStateless (struct
       ; ( (`ipv6, "address5", "ze80::bae8:56ff:fe29:894a/64")
         , Error (Server_error (invalid_cidr_address_specified, ["address5"]))
         )
+      ; ( (`ipv4or6, "address6", "bad-address/64")
+        , Error (Server_error (invalid_cidr_address_specified, ["address6"]))
+        )
+      ; ((`ipv4or6, "address7", "fe80::bae8:56ff:fe29:894a/64"), Ok ())
+      ; ( (`ipv4or6, "address8", "ze80::bae8:56ff:fe29:894a/64")
+        , Error (Server_error (invalid_cidr_address_specified, ["address8"]))
+        )
+      ; ((`ipv4or6, "address9", "255.255.255.0/32"), Ok ())
+      ; ( (`ipv4or6, "address10", "192.168.0.2/33")
+        , Error (Server_error (invalid_cidr_address_specified, ["address10"]))
+        )
       ]
 end)
 

ocaml/xapi-idl/network/dune

@@ -10,6 +10,7 @@
    threads.posix
    xapi-idl
    xapi-log
+   ipaddr
  )
  (wrapped false)
  (preprocess (pps ppx_deriving_rpc)))

ocaml/xapi-idl/network/network_interface.ml

@@ -34,19 +34,27 @@ let comp f g x = f (g x)
 let ( ++ ) f g x = comp f g x
 
 let netmask_to_prefixlen netmask =
-  Scanf.sscanf netmask "%d.%d.%d.%d" (fun a b c d ->
-      let rec length l x = if x > 0 then length (succ l) (x lsr 1) else l in
-      let masks = List.map (( - ) 255) [a; b; c; d] in
-      32 - List.fold_left length 0 masks
+  let raise_on_ipaddr_err = function
+    | `Msg str ->
+        failwith
+          (Printf.sprintf "%s: Failed to parse the netmask %s (%s)" __FUNCTION__
+             netmask str
+          )
+  in
+  Ipaddr.V4.(
+    match of_string netmask with
+    | Ok ip_t -> (
+      match Prefix.of_netmask ~address:ip_t ~netmask:ip_t with
+      | Ok x ->
+          Prefix.bits x
+      | Error e ->
+          raise_on_ipaddr_err e
+    )
+    | Error e ->
+        raise_on_ipaddr_err e
   )
 
-let prefixlen_to_netmask len =
-  let mask l =
-    if l <= 0 then 0 else if l > 8 then 255 else 256 - (1 lsl (8 - l))
-  in
-  let lens = [len; len - 8; len - 16; len - 24] in
-  let masks = List.map (string_of_int ++ mask) lens in
-  String.concat "." masks
+let prefixlen_to_netmask len = Ipaddr.V4.(Prefix.mask len |> to_string)
 
 module Unix = struct
   include Unix

ocaml/xapi/dune

@@ -77,6 +77,7 @@
     http_lib
     httpsvr
     ipaddr
+    ipaddr.unix
     magic-mime
     message-switch-core
     message-switch-unix

ocaml/xapi/helpers.ml

@@ -1114,31 +1114,55 @@ let assert_is_valid_ip kind field address =
   if not (is_valid_ip kind address) then
     raise Api_errors.(Server_error (invalid_ip_address_specified, [field]))
 
+module type AbstractIpaddr = sig
+  type t
+
+  module Prefix : sig
+    type addr = t
+
+    type t
+
+    val of_string : string -> (t, [> `Msg of string]) result
+
+    val address : t -> addr
+
+    val bits : t -> int
+  end
+
+  val to_string : t -> string
+end
+
 let parse_cidr kind cidr =
-  try
-    let address, prefixlen = Scanf.sscanf cidr "%s@/%d" (fun a p -> (a, p)) in
-    if not (is_valid_ip kind address) then (
-      error "Invalid address in CIDR (%s)" address ;
-      None
-    ) else if
-        prefixlen < 0
-        || (kind = `ipv4 && prefixlen > 32)
-        || (kind = `ipv6 && prefixlen > 128)
-      then (
-      error "Invalid prefix length in CIDR (%d)" prefixlen ;
-      None
-    ) else
+  let select_ip_family = function
+    | `ipv4 ->
+        (module Ipaddr.V4 : AbstractIpaddr)
+    | `ipv6 ->
+        (module Ipaddr.V6)
+  in
+  let module AddrParse = (val select_ip_family kind) in
+  match AddrParse.Prefix.of_string cidr with
+  | Ok ip_t ->
+      let address = AddrParse.Prefix.address ip_t |> AddrParse.to_string in
+      let prefixlen = AddrParse.Prefix.bits ip_t in
       Some (address, prefixlen)
-  with _ ->
-    error "Invalid CIDR format (%s)" cidr ;
-    None
+  | Error e ->
+      let msg = match e with `Msg str -> str in
+      error "Invalid address in CIDR (%s). %s" cidr msg ;
+      None
+
+let valid_cidr_aux kind cidr =
+  match kind with
+  | `ipv4or6 ->
+      parse_cidr `ipv4 cidr = None && parse_cidr `ipv6 cidr = None
+  | (`ipv4 | `ipv6) as kind ->
+      parse_cidr kind cidr = None
 
 let assert_is_valid_cidr kind field cidr =
-  if parse_cidr kind cidr = None then
+  if valid_cidr_aux kind cidr then
     raise Api_errors.(Server_error (invalid_cidr_address_specified, [field]))
 
 let assert_is_valid_ip_addr kind field address =
-  if (not (is_valid_ip kind address)) && parse_cidr kind address = None then
+  if (not (is_valid_ip kind address)) && valid_cidr_aux kind address then
     raise Api_errors.(Server_error (invalid_ip_address_specified, [field]))
 
 (** Return true if the MAC is in the right format XX:XX:XX:XX:XX:XX *)

ocaml/xapi/nm.ml

@@ -613,18 +613,18 @@ let bring_pif_up ~__context ?(management_interface = false) (pif : API.ref_PIF)
                     let addresses =
                       List.filter_map
                         (fun addr_and_prefixlen ->
-                          try
-                            let n = String.index addr_and_prefixlen '/' in
-                            let addr =
-                              Unix.inet_addr_of_string
-                                (String.sub addr_and_prefixlen 0 n)
+                          let ( let* ) = Option.bind in
+                          Ipaddr.V6.(
+                            let* ip_t =
+                              Result.to_option
+                                (Prefix.of_string addr_and_prefixlen)
                             in
-                            let prefixlen =
-                              int_of_string
-                                (String.sub_to_end addr_and_prefixlen (n + 1))
+                            let addr =
+                              Prefix.address ip_t |> Ipaddr_unix.V6.to_inet_addr
                             in
+                            let prefixlen = Prefix.bits ip_t in
                             Some (addr, prefixlen)
-                          with _ -> None
+                          )
                         )
                         rc.API.pIF_IPv6
                     in
@@ -714,9 +714,16 @@ let bring_pif_up ~__context ?(management_interface = false) (pif : API.ref_PIF)
               | [] ->
                   ""
               | hd :: _ -> (
-                (* IPv6 addresses are stored with this format: <ipv6>/<cidr> *)
-                match String.split_on_char '/' hd with [ip; _] -> ip | _ -> ""
-              )
+                  (* IPv6 addresses are stored with this format: <ipv6>/<cidr> *)
+                  Ipaddr.V6.(
+                    match Prefix.of_string hd with
+                    | Ok ip_t ->
+                        Prefix.address ip_t |> to_string
+                    | _ ->
+                        debug "%s not an IPv6 prefix: %s" __FUNCTION__ hd ;
+                        ""
+                  )
+                )
             )
           in
           if new_ip <> pif_ip then (