diff --git a/.travis.yml b/.travis.yml index 65d150b2e..ec3dd60ea 100644 --- a/.travis.yml +++ b/.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 diff --git a/CHANGES.md b/CHANGES.md index 11c87b458..fedb60a3b 100644 --- a/CHANGES.md +++ b/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) diff --git a/src/config/discover.ml b/src/config/discover.ml index 81f075fa6..ae7fb0081 100644 --- a/src/config/discover.ml +++ b/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) diff --git a/src/config/dune b/src/config/dune index e2ed62f5f..21a5f9a54 100644 --- a/src/config/dune +++ b/src/config/dune @@ -1,3 +1,3 @@ (executable (name discover) - (libraries base stdio configurator)) + (libraries dune.configurator)) diff --git a/src/ipv4/static_ipv4.ml b/src/ipv4/static_ipv4.ml index a4fc5fe03..3725242f5 100644 --- a/src/ipv4/static_ipv4.ml +++ b/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 diff --git a/src/ipv6/ipv6.ml b/src/ipv6/ipv6.ml index 0303d98b8..b1e2fedec 100644 --- a/src/ipv6/ipv6.ml +++ b/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 () diff --git a/src/stack-unix/ipv4_socket.ml b/src/stack-unix/ipv4_socket.ml index 71e4b547e..fff551711 100644 --- a/src/stack-unix/ipv4_socket.ml +++ b/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 _ = () diff --git a/src/stack-unix/ipv6_socket.ml b/src/stack-unix/ipv6_socket.ml index b0b39d035..ea8b00b40 100644 --- a/src/stack-unix/ipv6_socket.ml +++ b/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 _ = () diff --git a/src/tcp/flow.ml b/src/tcp/flow.ml index df9b4cbbd..f57e85d0d 100644 --- a/src/tcp/flow.ml +++ b/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 diff --git a/src/tcp/wire.ml b/src/tcp/wire.ml index d8a08e3a4..5d31f7a45 100644 --- a/src/tcp/wire.ml +++ b/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) diff --git a/src/tcpip_checksum/dune b/src/tcpip_checksum/dune index 307472183..f678570fc 100644 --- a/src/tcpip_checksum/dune +++ b/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) diff --git a/src/udp/udp.ml b/src/udp/udp.ml index 0d5708f17..3203b8788 100644 --- a/src/udp/udp.ml +++ b/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 diff --git a/tcpip.opam b/tcpip.opam index f5dec614e..350c7d000 100644 --- a/tcpip.opam +++ b/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"