support for ipaddr 5.0.0 and tcpip 5.0.0

CHANGES.md

@@ -1,3 +1,7 @@
+### v1.2.2 (2020-06-22)
+
+* Support for ipaddr 5.0.0 and tcpip 5.0.0 (#109 @hannesm)
+
 ### v1.2.1 (2020-05-11)
 
 * Fix minimal dune version (1.4) (#108 @samoht)

charrua-client-lwt.opam

@@ -21,7 +21,7 @@ depends: [
   "charrua" {= version}
   "charrua-client" {= version}
   "cstruct" {>="3.0.2"}
-  "ipaddr" {>="4.0.0"}
+  "ipaddr" {>="5.0.0"}
   "mirage-random" {>= "2.0.0"}
   "duration"
   "mirage-time" {>= "2.0.0"}

charrua-client-mirage.opam

@@ -16,7 +16,7 @@ depends: [
   "dune" {>= "1.4.0"}
   "ocaml" {>= "4.06.0"}
   "charrua-client-lwt" {= version}
-  "ipaddr" {>= "4.0.0"}
+  "ipaddr" {>= "5.0.0"}
   "mirage-random" {>= "2.0.0"}
   "mirage-clock" {>= "3.0.0"}
   "mirage-time" {>= "2.0.0"}

charrua-client.opam

@@ -22,7 +22,7 @@ depends: [
   "charrua-server" {= version & with-test}
   "charrua" {= version}
   "cstruct" {>="3.0.2"}
-  "ipaddr" {>= "4.0.0"}
+  "ipaddr" {>= "5.0.0"}
   "macaddr" {>= "4.0.0"}
 ]
 synopsis: "DHCP client implementation"

charrua-server.opam

@@ -21,7 +21,7 @@ depends: [
   "charrua"       {= version}
   "cstruct"       {>= "3.0.1"}
   "sexplib"
-  "ipaddr"        {>= "4.0.0"}
+  "ipaddr"        {>= "5.0.0"}
   "macaddr"       {>= "4.0.0"}
   "ipaddr-sexp"
   "macaddr-sexp"

charrua-unix.opam

@@ -19,7 +19,7 @@ depends: [
   "cstruct-unix"
   "cmdliner"
   "rawlink" {>= "1.0"}
-  "tuntap" {>= "1.2.0"}
+  "tuntap" {>= "2.0.0"}
   "mtime" {>="1.0.0"}
 ]
 synopsis: "Unix DHCP daemon"

charrua.opam

@@ -19,12 +19,12 @@ depends: [
   "ppx_cstruct"
   "cstruct"       {>= "3.0.1"}
   "sexplib"
-  "ipaddr"        {>= "4.0.0"}
+  "ipaddr"        {>= "5.0.0"}
   "macaddr"       {>= "4.0.0"}
   "ipaddr-sexp"
   "macaddr-sexp"
   "ethernet"      {>= "2.2.0"}
-  "tcpip"         {>= "4.0.0"}
+  "tcpip"         {>= "5.0.0"}
   "rresult"
 ]
 synopsis: "DHCP wire frame encoder and decoder"

client/mirage/dhcp_client_mirage.ml

@@ -1,7 +1,7 @@
 let src = Logs.Src.create "dhcp_client_mirage"
 module Log = (val Logs.src_log src : Logs.LOG)
 
-let config_of_lease lease : Mirage_protocols.ipv4_config option =
+let config_of_lease lease =
   let open Dhcp_wire in
   (* ipv4_config expects a single IP address and the information
    * needed to construct a prefix.  It can optionally use one router. *)
@@ -12,12 +12,16 @@ let config_of_lease lease : Mirage_protocols.ipv4_config option =
     Log.debug (fun f -> f "Unusable lease: %s" @@ Dhcp_wire.pkt_to_string lease);
     None
   | Some subnet ->
-    let network = Ipaddr.V4.Prefix.of_netmask subnet address in
-    let valid_routers = Dhcp_wire.collect_routers lease.options in
-    match valid_routers with
-    | [] -> Some Mirage_protocols.{ address; network; gateway = None }
-    | hd::_ ->
-      Some Mirage_protocols.{ address; network; gateway = (Some hd) }
+    match Ipaddr.V4.Prefix.of_netmask ~netmask:subnet ~address with
+    | Error `Msg msg ->
+      Log.info (fun f -> f "Invalid address and netmask combination %s, discarding" msg);
+      None
+    | Ok network ->
+      let valid_routers = Dhcp_wire.collect_routers lease.options in
+      match valid_routers with
+      | [] -> Some Mirage_protocols.{ address; network; gateway = None }
+      | hd::_ ->
+        Some Mirage_protocols.{ address; network; gateway = Some hd }
 
 module Make(Random : Mirage_random.S)(Time : Mirage_time.S) (Net : Mirage_net.S) = struct
   open Lwt.Infix

client/mirage/dhcp_ipv4.ml

@@ -5,5 +5,5 @@ module Make(Dhcp_client : Mirage_protocols.DHCP_CLIENT) (R : Mirage_random.S) (C
   include Static_ipv4.Make(R)(C)(E)(Arp)
   let connect dhcp ethernet arp =
     Lwt_stream.last_new dhcp >>= fun (config : Mirage_protocols.ipv4_config) ->
-    connect ~ip:(config.network, config.address) ?gateway:config.gateway ethernet arp
+    connect ~cidr:config.network ?gateway:config.gateway ethernet arp
 end

lib/dhcp_wire.ml

@@ -642,8 +642,8 @@ let options_of_buf buf buf_len =
           invalid_arg bad_len
         else
           List.map (function
-              | addr, mask -> try
-                  Ipaddr.V4.Prefix.of_netmask mask addr
+              | address, netmask -> try
+                  Ipaddr.V4.Prefix.of_netmask_exn ~netmask ~address
                 with
                   Ipaddr.Parse_error (a, b) -> invalid_arg (a ^ ": " ^ b))
             (get_ip_tuple_list ())

server/dhcp_parser.mly

@@ -118,9 +118,12 @@ subnets:
   | sub = subnet; subs = subnets { sub :: (List.rev subs) }
 
 subnet:
-  | SUBNET; ip = IP; NETMASK; mask = IP; LBRACKET;
+  | SUBNET; address = IP; NETMASK; netmask = IP; LBRACKET;
   statements = statements; hosts = hosts; RBRACKET {
-  let network = Ipaddr.V4.Prefix.of_netmask mask ip in
+  let network =
+    try Ipaddr.V4.Prefix.of_netmask_exn ~netmask ~address with
+      Ipaddr.Parse_error (a, b) -> choke (a ^ ": " ^ b)
+  in
   (* Catch statements that don't make sense in a subnet *)
   let () = List.iter (function
       | Hw_eth _ | Fixed_addr _ ->
@@ -135,7 +138,7 @@ subnet:
       statements |> (function
       | Some (v1, v2) -> (v1, v2)
       | None -> choke ("Missing `range` statement for subnet " ^
-                       (Ipaddr.V4.to_string ip)))
+                       (Ipaddr.V4.to_string address)))
   in
   let options = Util.filter_map (function
       | Dhcp_option o -> Some o

unix/charruad.ml

@@ -118,9 +118,12 @@ let rec input config db link =
 
 let ifname_of_address ip_addr interfaces =
   let ifnet =
-    List.find (function _name, (ip_addrx, _) -> ip_addr = ip_addrx) interfaces
+    List.find
+      (function _name, cidr ->
+         Ipaddr.V4.compare ip_addr (Ipaddr.V4.Prefix.address cidr) = 0)
+      interfaces
   in
-  match ifnet with name, (_, _) -> name
+  match ifnet with name, _ -> name
 
 let charruad configfile verbosity daemonize =
   let open Dhcp_server.Config in
@@ -130,7 +133,7 @@ let charruad configfile verbosity daemonize =
   init_log (level_of_string verbosity) daemonize;
   let interfaces = Tuntap.getifaddrs_v4 () in
   let addresses = List.map
-      (function name, (addr, _) -> (addr, Tuntap.get_macaddr name))
+      (function name, cidr -> (Ipaddr.V4.Prefix.address cidr, Tuntap.get_macaddr name))
       interfaces
   in
   let configtxt = read_file configfile in