From 4699a72e9e9fd0678373c10073286689b762fcc8 Mon Sep 17 00:00:00 2001 From: Mindy Date: Mon, 20 May 2019 21:24:34 -0400 Subject: [PATCH 1/6] use Ip.pp_addr instead of uipaddr-based pretty-printers --- src/ipv4/static_ipv4.ml | 6 ++---- src/ipv6/ipv6.ml | 6 ++---- src/stack-unix/ipv4_socket.ml | 4 +--- src/stack-unix/ipv6_socket.ml | 3 --- src/tcp/flow.ml | 6 +++--- src/tcp/wire.ml | 3 +-- src/udp/udp.ml | 11 +++-------- 7 files changed, 12 insertions(+), 27 deletions(-) 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/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 From c20aa5ff28bb11e1cd84ca6c10a6f8a24f0164ea Mon Sep 17 00:00:00 2001 From: Mindy Date: Wed, 22 May 2019 09:49:26 -0500 Subject: [PATCH 2/6] pin mirage-protocols and mirage-protocols-lwt to pp_ips branch --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 65d150b2e..991a676cf 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,7 +3,7 @@ script: bash -ex .travis-ci.sh sudo: required env: global: - - EXTRA_REMOTES="https://github.com/mirage/mirage-dev.git" + - EXTRA_REMOTES="https://github.com/mirage/mirage-dev.git" PINS="mirage-procotols:https://github.com/yomimono/mirage-protocols.git#pp_ips mirage-protocols-lwt:https://github.com/yomimono/mirage-protocols-lwt.git#pp_ips" 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 From 914826e70ed8fcad50ac65f0d02bba8d35111476 Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Mon, 8 Jul 2019 11:45:18 +0100 Subject: [PATCH 3/6] remove dependency on configurator for build and update travis --- .travis.yml | 4 ++-- CHANGES.md | 2 ++ src/config/discover.ml | 14 +++++--------- src/config/dune | 2 +- src/tcpip_checksum/dune | 3 +-- tcpip.opam | 5 ++--- 6 files changed, 13 insertions(+), 17 deletions(-) diff --git a/.travis.yml b/.travis.yml index 991a676cf..ec3dd60ea 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,10 +3,10 @@ script: bash -ex .travis-ci.sh sudo: required env: global: - - EXTRA_REMOTES="https://github.com/mirage/mirage-dev.git" PINS="mirage-procotols:https://github.com/yomimono/mirage-protocols.git#pp_ips mirage-protocols-lwt:https://github.com/yomimono/mirage-protocols-lwt.git#pp_ips" + - EXTRA_REMOTES="https://github.com/mirage/mirage-dev.git" 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 1f75014fd..fedb60a3b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,8 @@ ### 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) 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/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/tcpip.opam b/tcpip.opam index 577721c49..350c7d000 100644 --- a/tcpip.opam +++ b/tcpip.opam @@ -21,7 +21,6 @@ build: [ depopts: ["mirage-xen-ocaml"] depends: [ "dune" {build & >= "1.0"} - "configurator" {build} "ocaml" {>= "4.03.0"} "rresult" {>= "0.5.0"} "cstruct" {>= "3.2.0"} @@ -31,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" From 6025b81ffe5b896dfd85edcde563cf1c3f6bfb6f Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Mon, 8 Jul 2019 12:20:37 +0100 Subject: [PATCH 4/6] release v3.7.6 --- CHANGES.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index fedb60a3b..a1db50a2d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,4 +1,5 @@ -### dev +### v3.7.6 (2019-07-08) + * 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) From 420a09dbe35071c9653e2c4cfe4c958e56aeabf7 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Thu, 11 Jul 2019 19:30:48 +0200 Subject: [PATCH 5/6] Ipv4.Fragments: remove debug message --- src/ipv4/fragments.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/src/ipv4/fragments.ml b/src/ipv4/fragments.ml index bab025585..1692203a8 100644 --- a/src/ipv4/fragments.ml +++ b/src/ipv4/fragments.ml @@ -124,7 +124,6 @@ let max_number_of_fragments = 16 let max_duration = Duration.of_sec 10 let process cache ts (packet : Ipv4_packet.t) payload = - Log.debug (fun m -> m "process called with off %x" packet.off) ; let add_trim key value cache = let cache' = Cache.add key value cache in Cache.trim cache' From 56ec9cea09cc3075a8d81730234dcf381b9d0741 Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Sat, 13 Jul 2019 20:04:37 +0100 Subject: [PATCH 6/6] support ipaddr 4.0 interfaces, use Macaddr_cstruct --- CHANGES.md | 4 ++++ src/ipv4/routing.ml | 4 ++-- src/ipv6/dune | 2 +- src/ipv6/ndpv6.ml | 16 +++++----------- tcpip.opam | 5 +++-- 5 files changed, 15 insertions(+), 16 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index a1db50a2d..a97239a0d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,7 @@ +### dev + +* support ipaddr/macaddr.4.0.0 interfaces (@avsm) + ### v3.7.6 (2019-07-08) * opam: ensure Xen bindings are built with right mirage-xen-ocaml CFLAGS (@avsm) diff --git a/src/ipv4/routing.ml b/src/ipv4/routing.ml index 55bfc8aca..bbbf92fe4 100644 --- a/src/ipv4/routing.ml +++ b/src/ipv4/routing.ml @@ -1,6 +1,6 @@ (* RFC 1112: 01-00-5E-00-00-00 ORed with lower 23 bits of the ip address *) let mac_of_multicast ip = - let ipb = Ipaddr.V4.to_bytes ip in + let ipb = Ipaddr.V4.to_octets ip in let macb = Bytes.create 6 in Bytes.set macb 0 (Char.chr 0x01); Bytes.set macb 1 (Char.chr 0x00); @@ -8,7 +8,7 @@ let mac_of_multicast ip = Bytes.set macb 3 (Char.chr ((Char.code ipb.[1]) land 0x7F)); Bytes.set macb 4 (String.get ipb 2); Bytes.set macb 5 (String.get ipb 3); - Macaddr.of_bytes_exn (Bytes.to_string macb) + Macaddr.of_octets_exn (Bytes.to_string macb) type routing_error = [ `Local | `Gateway ] diff --git a/src/ipv6/dune b/src/ipv6/dune index a869fa75c..228785386 100644 --- a/src/ipv6/dune +++ b/src/ipv6/dune @@ -1,7 +1,7 @@ (library (name tcpip_ipv6) (public_name tcpip.ipv6) - (libraries logs mirage-protocols-lwt mirage-time-lwt + (libraries logs mirage-protocols-lwt mirage-time-lwt macaddr-cstruct mirage-clock-lwt duration ipaddr cstruct rresult mirage-random tcpip randomconv) (preprocess diff --git a/src/ipv6/ndpv6.ml b/src/ipv6/ndpv6.ml index 2aaa8eff3..b5cfecee6 100644 --- a/src/ipv6/ndpv6.ml +++ b/src/ipv6/ndpv6.ml @@ -110,16 +110,10 @@ let ipaddr_to_cstruct_raw i cs off = Cstruct.BE.set_uint32 cs (12 + off) d let macaddr_to_cstruct_raw x cs off = - Cstruct.blit_from_string (Macaddr.to_bytes x) 0 cs off 6 - -let macaddr_of_cstruct cs = - if Cstruct.len cs <> 6 then invalid_arg "macaddr_of_cstruct"; - match Macaddr.of_bytes (Cstruct.to_string cs) with - | Ok x -> x - | Error _ -> assert false + Cstruct.blit_from_string (Macaddr.to_octets x) 0 cs off 6 let interface_addr mac = - let bmac = Macaddr.to_bytes mac in + let bmac = Macaddr.to_octets mac in let c i = Char.code (String.get bmac i) in Ipaddr.make 0 0 0 0 @@ -137,7 +131,7 @@ let multicast_mac = fun ip -> let _, _, _, n = Ipaddr.to_int32 ip in Cstruct.BE.set_uint32 pbuf 2 n; - Macaddr.of_bytes_exn (Cstruct.to_string pbuf) + Macaddr_cstruct.of_cstruct_exn pbuf (* vary the reachable time by some random factor between 0.5 and 1.5 *) let compute_reachable_time r reachable_time = @@ -746,9 +740,9 @@ module Parser = struct let opt, opts = Cstruct.split opts (Ipv6_wire.get_opt_len opts * 8) in match Ipv6_wire.get_opt_ty opt, Ipv6_wire.get_opt_len opt with | 1, 1 -> - SLLA (macaddr_of_cstruct (Ipv6_wire.get_llopt_addr opt)) :: parse_options1 opts + SLLA (Macaddr_cstruct.of_cstruct_exn (Ipv6_wire.get_llopt_addr opt)) :: parse_options1 opts | 2, 1 -> - TLLA (macaddr_of_cstruct (Ipv6_wire.get_llopt_addr opt)) :: parse_options1 opts + TLLA (Macaddr_cstruct.of_cstruct_exn (Ipv6_wire.get_llopt_addr opt)) :: parse_options1 opts | 5, 1 -> MTU (Int32.to_int (Cstruct.BE.get_uint32 opt 4)) :: parse_options1 opts | 3, 4 -> diff --git a/tcpip.opam b/tcpip.opam index 350c7d000..174c0fcc2 100644 --- a/tcpip.opam +++ b/tcpip.opam @@ -33,8 +33,9 @@ depends: [ "mirage-protocols" {>= "3.0.0"} "mirage-protocols-lwt" {>= "3.0.0"} "mirage-time-lwt" {>= "1.0.0"} - "ipaddr" {>= "3.0.0"} - "macaddr" + "ipaddr" {>= "4.0.0"} + "macaddr" {>="4.0.0"} + "macaddr-cstruct" "mirage-profile" {>= "0.5"} "fmt" "lwt" {>= "3.0.0"}