use Ip.pp_addr instead of uipaddr-based pretty-printers

.travis.yml

@@ -7,6 +7,6 @@ env:
   matrix:
   - UPDATE_GCC_BINUTILS=1 OCAML_VERSION=4.05 PACKAGE=tcpip MIRAGE_MODE=xen
   - UPDATE_GCC_BINUTILS=1 OCAML_VERSION=4.05 PACKAGE=tcpip MIRAGE_MODE=hvt
-  - OCAML_VERSION=4.06 PACKAGE=tcpip MIRAGE_MODE=unix
+  - OCAML_VERSION=4.07 PACKAGE=tcpip MIRAGE_MODE=unix
   - UPDATE_GCC_BINUTILS=1 OCAML_VERSION=4.07 PACKAGE=tcpip MIRAGE_MODE=qubes
   - UPDATE_GCC_BINUTILS=1 OCAML_VERSION=4.07 PACKAGE=tcpip MIRAGE_MODE=virtio

CHANGES.md

@@ -1,3 +1,9 @@
+### dev
+* opam: ensure Xen bindings are built with right mirage-xen-ocaml CFLAGS (@avsm)
+* opam: correctly register mirage-xen-ocaml as a depopt (@avsm)
+* use mirage-protocols-3.0 interface for ipaddr printing (#408 @yomimono @linse)
+* remove dependency on configurator and use dune's builtin one instead (@avsm)
+
 ### v3.7.5 (2019-05-03)
 
 * drop IPv4 packets which destination address is not us or broadcast (#407 by @hannesm)

src/config/discover.ml

@@ -1,9 +1,4 @@
-open Base
-open Stdio
-module C = Configurator
-
-let write_sexp fn sexp =
-  Out_channel.write_all fn ~data:(Sexp.to_string sexp)
+module C = Configurator.V1
 
 let () =
   (* Extend the pkg-config path rather than overwriting it.
@@ -23,7 +18,8 @@ let () =
       match C.Pkg_config.get c with
       | None -> default
       | Some pc ->
-        Option.value (C.Pkg_config.query pc ~package:"mirage-xen-ocaml") ~default
+        (match C.Pkg_config.query pc ~package:"mirage-xen-ocaml" with
+         | None -> default
+         | Some c -> c)
     in
-
-    write_sexp "c_flags_xen.sexp" (sexp_of_list sexp_of_string conf.cflags))
+    C.Flags.write_sexp "c_flags_xen.sexp" conf.cflags)

src/config/dune

@@ -1,3 +1,3 @@
 (executable
  (name discover)
- (libraries base stdio configurator))
+ (libraries dune.configurator))

src/ipv4/static_ipv4.ml

@@ -34,6 +34,8 @@ module Make (R: Mirage_random.C) (C: Mirage_clock.MCLOCK) (Ethernet: Mirage_prot
   type ipaddr = Ipaddr.V4.t
   type callback = src:ipaddr -> dst:ipaddr -> buffer -> unit Lwt.t
 
+  let pp_ipaddr = Ipaddr.V4.pp
+
   type t = {
     ethif : Ethernet.t;
     arp : Arpv4.t;
@@ -210,10 +212,6 @@ module Make (R: Mirage_random.C) (C: Mirage_clock.MCLOCK) (Ethernet: Mirage_prot
 
   let src t ~dst:_ = t.ip
 
-  type uipaddr = Ipaddr.t
-  let to_uipaddr ip = Ipaddr.V4 ip
-  let of_uipaddr = Ipaddr.to_v4
-
   let mtu t = Ethernet.mtu t.ethif - Ipv4_wire.sizeof_ipv4
 
 end

src/ipv6/ipv6.ml

@@ -30,6 +30,8 @@ module Make (E : Mirage_protocols_lwt.ETHERNET)
   type ipaddr   = Ipaddr.V6.t
   type callback = src:ipaddr -> dst:ipaddr -> buffer -> unit Lwt.t
 
+  let pp_ipaddr = Ipaddr.V6.pp
+
   type t =
     { ethif : E.t;
       clock : C.t;
@@ -139,10 +141,6 @@ module Make (E : Mirage_protocols_lwt.ETHERNET)
     Cstruct.set_uint8 ph 39 (Ipv6_wire.protocol_to_int proto);
     ph
 
-  type uipaddr = I.t
-  let to_uipaddr ip = I.V6 ip
-  let of_uipaddr ip = Some (I.to_v6 ip)
-
   let (>>=?) (x,f) g = match x with
     | Some x -> f x >>= g
     | None -> g ()

src/stack-unix/ipv4_socket.ml

@@ -23,12 +23,10 @@ type error = Mirage_protocols.Ip.error
 type ipaddr = Ipaddr.V4.t
 type buffer = Cstruct.t
 type callback = src:ipaddr -> dst:ipaddr -> buffer -> unit io
-type uipaddr = Ipaddr.t
 
 let pp_error = Mirage_protocols.Ip.pp_error
+let pp_ipaddr = Ipaddr.V4.pp
 
-let to_uipaddr ip = Ipaddr.V4 ip
-let of_uipaddr = Ipaddr.to_v4
 let mtu _ = 1500 - Ipv4_wire.sizeof_ipv4
 
 let id _ = ()

src/stack-unix/ipv6_socket.ml

@@ -25,10 +25,7 @@ type error = [ `Unimplemented | `Unknown of string ]
 type ipaddr = Ipaddr.V6.t
 type buffer = Cstruct.t
 type callback = src:ipaddr -> dst:ipaddr -> buffer -> unit io
-type uipaddr = Ipaddr.t
 
-let to_uipaddr ip = Ipaddr.V6 ip
-let of_uipaddr ip = Some (Ipaddr.to_v6 ip)
 let mtu _ = 1500 - Ipv6_wire.sizeof_ipv6
 
 let id _ = ()

src/tcp/flow.ml

@@ -700,15 +700,15 @@ struct
   | `Timeout ->
     Log.debug (fun fmt ->
       fmt "Timeout attempting to connect to %a:%d\n%!"
-        Ipaddr.pp (Ip.to_uipaddr daddr) dport)
+        Ip.pp_ipaddr daddr dport)
   | `Refused ->
     Log.debug (fun fmt ->
       fmt "Refused connection to %a:%d\n%!"
-        Ipaddr.pp (Ip.to_uipaddr daddr) dport)
+        Ip.pp_ipaddr daddr dport)
   | e ->
     Log.debug (fun fmt ->
       fmt "%a error connecting to %a:%d\n%!"
-        pp_error e Ipaddr.pp (Ip.to_uipaddr daddr) dport)
+        pp_error e Ip.pp_ipaddr daddr dport)
 
   let create_connection ?keepalive tcp (daddr, dport) =
     connect ?keepalive tcp ~dst:daddr ~dst_port:dport >>= function

src/tcp/wire.ml

@@ -41,9 +41,8 @@ module Make (Ip:Mirage_protocols_lwt.IP) = struct
   let dst_port t = t.dst_port
 
   let pp ppf t =
-    let uip = Ip.to_uipaddr in
     Fmt.pf ppf "remote %a,%d to local %a, %d"
-      Ipaddr.pp (uip t.dst) t.dst_port Ipaddr.pp (uip t.src) t.src_port
+      Ip.pp_ipaddr t.dst t.dst_port Ip.pp_ipaddr t.src t.src_port
 
   let xmit ~ip { src_port; dst_port; dst; _ } ?(rst=false) ?(syn=false)
       ?(fin=false) ?(psh=false)

src/tcpip_checksum/dune

@@ -19,8 +19,7 @@
  (targets c_flags_xen.sexp)
  (deps
   (:< ../config/discover.exe))
- (action
-  (run %{<} -ocamlc %{ocamlc})))
+ (action (run %{<})))
 
 (rule
  (targets checksum_stubs_xen.c)

src/udp/udp.ml

@@ -19,8 +19,6 @@ open Lwt.Infix
 let src = Logs.Src.create "udp" ~doc:"Mirage UDP"
 module Log = (val Logs.src_log src : Logs.LOG)
 
-let pp_ips = Format.pp_print_list Ipaddr.pp
-
 module Make(Ip: Mirage_protocols_lwt.IP)(Random:Mirage_random.C) = struct
 
   type 'a io = 'a Lwt.t
@@ -36,8 +34,7 @@ module Make(Ip: Mirage_protocols_lwt.IP)(Random:Mirage_random.C) = struct
     ip : Ip.t;
   }
 
-  let pp_ip fmt a =
-    Ipaddr.pp fmt (Ip.to_uipaddr a)
+  let pp_ip = Ip.pp_ipaddr
 
   (* TODO: ought we to check to make sure the destination is relevant
      here?  Currently we process all incoming packets without making
@@ -83,14 +80,12 @@ module Make(Ip: Mirage_protocols_lwt.IP)(Random:Mirage_random.C) = struct
     writev ?src_port ~dst ~dst_port t [buf]
 
   let connect ip =
-    let ips = List.map Ip.to_uipaddr @@ Ip.get_ip ip in
-    Log.info (fun f -> f "UDP interface connected on %a" pp_ips ips);
+    Log.info (fun f -> f "UDP interface connected on %a" (Fmt.list Ip.pp_ipaddr) @@ Ip.get_ip ip);
     let t = { ip } in
     Lwt.return t
 
   let disconnect t =
-    let ips = List.map Ip.to_uipaddr @@ Ip.get_ip t.ip in
-    Log.info (fun f -> f "UDP interface disconnected on %a" pp_ips ips);
+    Log.info (fun f -> f "UDP interface disconnected on %a" (Fmt.list Ip.pp_ipaddr) @@ Ip.get_ip t.ip);
     Lwt.return_unit
 
 end

tcpip.opam

@@ -14,13 +14,13 @@ tags: ["org:mirage"]
 
 build: [
   ["dune" "subst"] {pinned}
-  ["dune" "build" "-p" name "-j" jobs]
-  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
+  ["env" "OPAM_PKG_CONFIG_PATH=%{prefix}%/lib/pkgconfig" "dune" "build" "-p" name "-j" jobs]
+  ["env" "OPAM_PKG_CONFIG_PATH=%{prefix}%/lib/pkgconfig" "dune" "runtest" "-p" name "-j" jobs] {with-test}
 ]
 
+depopts: ["mirage-xen-ocaml"]
 depends: [
   "dune"     {build & >= "1.0"}
-  "configurator" {build}
   "ocaml" {>= "4.03.0"}
   "rresult" {>= "0.5.0"}
   "cstruct" {>= "3.2.0"}
@@ -30,8 +30,8 @@ depends: [
   "mirage-random" {>= "1.0.0"}
   "mirage-clock-lwt" {>= "1.2.0"}
   "mirage-stack-lwt" {>= "1.3.0"}
-  "mirage-protocols" {>= "2.0.0"}
-  "mirage-protocols-lwt" {>= "2.0.0"}
+  "mirage-protocols" {>= "3.0.0"}
+  "mirage-protocols-lwt" {>= "3.0.0"}
   "mirage-time-lwt" {>= "1.0.0"}
   "ipaddr" {>= "3.0.0"}
   "macaddr"