adapt to mirage/mirage#1004 API changes

.travis.yml

@@ -5,11 +5,10 @@ sudo: false
 env:
   global:
   - POST_INSTALL_HOOK="sh ./.travis-ci.sh"
-  - EXTRA_REMOTES="https://github.com/mirage/mirage-dev.git"
+  - EXTRA_REMOTES="https://github.com/hannesm/mirage-dev.git#easy"
   - PACKAGE=tcpip
   matrix:
-  - DISTRO=alpine OCAML_VERSION=4.05 EXTRA_ENV="MIRAGE_MODE=xen"
-  - DISTRO=alpine OCAML_VERSION=4.06 EXTRA_ENV="MIRAGE_MODE=hvt"
+  - DISTRO=alpine OCAML_VERSION=4.06 EXTRA_ENV="MIRAGE_MODE=xen"
   - DISTRO=alpine OCAML_VERSION=4.07 EXTRA_ENV="MIRAGE_MODE=unix"
   - DISTRO=alpine OCAML_VERSION=4.08 EXTRA_ENV="MIRAGE_MODE=qubes"
   - DISTRO=alpine OCAML_VERSION=4.09 EXTRA_ENV="MIRAGE_MODE=virtio"

examples/unikernel/services.ml

@@ -1,6 +1,6 @@
 open Lwt.Infix
 
-module Main (S: Mirage_types_lwt.STACKV4) = struct
+module Main (S: Mirage_stack.V4) = struct
   let report_and_close flow pp e message =
     let ip, port = S.TCPV4.dst flow in
     Logs.warn

src/icmp/dune

@@ -1,7 +1,6 @@
 (library
  (name tcpip_icmpv4)
  (public_name tcpip.icmpv4)
- (libraries mirage-protocols-lwt rresult logs tcpip mirage-profile tcpip.udp)
- (preprocess
-  (pps ppx_cstruct))
+ (libraries mirage-protocols rresult logs tcpip mirage-profile tcpip.udp)
+ (preprocess (pps ppx_cstruct))
  (wrapped false))

src/icmp/icmpv4.ml

@@ -3,10 +3,8 @@ open Lwt.Infix
 let src = Logs.Src.create "icmpv4" ~doc:"Mirage ICMPv4"
 module Log = (val Logs.src_log src : Logs.LOG)
 
-module Make(IP : Mirage_protocols_lwt.IPV4) = struct
+module Make(IP : Mirage_protocols.IP with type ipaddr = Ipaddr.V4.t) = struct
 
-  type buffer = Cstruct.t
-  type 'a io = 'a Lwt.t
   type ipaddr = Ipaddr.V4.t
 
   type t = {

src/icmp/icmpv4.mli

@@ -1,5 +1,5 @@
-module Make ( I:Mirage_protocols_lwt.IPV4 ) : sig
-  include Mirage_protocols_lwt.ICMPV4
+module Make (I:Mirage_protocols.IP with type ipaddr = Ipaddr.V4.t) : sig
+  include Mirage_protocols.ICMP with type ipaddr = Ipaddr.V4.t
 
-  val connect : I.t -> t io
+  val connect : I.t -> t Lwt.t
 end

src/ipv4/dune

@@ -1,8 +1,7 @@
 (library
  (name tcpip_ipv4)
  (public_name tcpip.ipv4)
- (libraries logs mirage-protocols-lwt ipaddr cstruct rresult tcpip
+ (libraries logs mirage-protocols ipaddr cstruct rresult tcpip
    tcpip.udp mirage-random mirage-clock randomconv lru)
- (preprocess
-  (pps ppx_cstruct))
+ (preprocess (pps ppx_cstruct))
  (wrapped false))

src/ipv4/routing.ml

@@ -12,7 +12,7 @@ let mac_of_multicast ip =
 
 type routing_error = [ `Local | `Gateway ]
 
-module Make(Log : Logs.LOG) (A : Mirage_protocols_lwt.ARP) = struct
+module Make(Log : Logs.LOG) (A : Mirage_protocols.ARP) = struct
 
   open Lwt.Infix
 

src/ipv4/static_ipv4.ml

@@ -19,7 +19,7 @@ open Lwt.Infix
 let src = Logs.Src.create "ipv4" ~doc:"Mirage IPv4"
 module Log = (val Logs.src_log src : Logs.LOG)
 
-module Make (R: Mirage_random.C) (C: Mirage_clock.MCLOCK) (Ethernet: Mirage_protocols_lwt.ETHERNET) (Arpv4 : Mirage_protocols_lwt.ARP) = struct
+module Make (R: Mirage_random.S) (C: Mirage_clock.MCLOCK) (Ethernet: Mirage_protocols.ETHERNET) (Arpv4 : Mirage_protocols.ARP) = struct
   module Routing = Routing.Make(Log)(Arpv4)
 
   (** IO operation errors *)
@@ -28,17 +28,14 @@ module Make (R: Mirage_random.C) (C: Mirage_clock.MCLOCK) (Ethernet: Mirage_prot
     | #Mirage_protocols.Ip.error as e -> Mirage_protocols.Ip.pp_error ppf e
     | `Ethif e -> Ethernet.pp_error ppf e
 
-  type 'a io = 'a Lwt.t
-  type buffer = Cstruct.t
   type ipaddr = Ipaddr.V4.t
-  type callback = src:ipaddr -> dst:ipaddr -> buffer -> unit Lwt.t
+  type callback = src:ipaddr -> dst:ipaddr -> Cstruct.t -> unit Lwt.t
 
   let pp_ipaddr = Ipaddr.V4.pp
 
   type t = {
     ethif : Ethernet.t;
     arp : Arpv4.t;
-    clock : C.t;
     mutable ip: Ipaddr.V4.t;
     network: Ipaddr.V4.Prefix.t;
     mutable gateway: Ipaddr.V4.t option;
@@ -149,7 +146,7 @@ module Make (R: Mirage_random.C) (C: Mirage_clock.MCLOCK) (Ethernet: Mirage_prot
         Log.debug (fun m -> m "dropping zero length IPv4 frame %a" Ipv4_packet.pp packet) ;
         Lwt.return_unit
       end else
-        let ts = C.elapsed_ns t.clock in
+        let ts = C.elapsed_ns () in
         match Fragments.process t.cache ts packet payload with
         | None -> Lwt.return_unit
         | Some (packet, payload) ->
@@ -159,22 +156,12 @@ module Make (R: Mirage_random.C) (C: Mirage_clock.MCLOCK) (Ethernet: Mirage_prot
           | Some `UDP -> udp ~src ~dst payload
           | Some `ICMP | None -> default ~proto:packet.proto ~src ~dst payload
 
-  let connect
-      ?(ip=Ipaddr.V4.any)
-      ?(network=Ipaddr.V4.Prefix.make 0 Ipaddr.V4.any)
-      ?(gateway=None) clock ethif arp =
-    match Ipaddr.V4.Prefix.mem ip network with
-    | false ->
-      Log.warn (fun f -> f "IPv4: ip %a is not in the prefix %a"
-                   Ipaddr.V4.pp ip Ipaddr.V4.Prefix.pp network);
-      Lwt.fail_with "given IP is not in the network provided"
-    | true ->
-      Arpv4.set_ips arp [ip] >>= fun () ->
-      (* TODO currently hardcoded to 256KB, should be configurable
-         and maybe limited per-src/dst-ip as well? *)
-      let cache = Fragments.Cache.create ~random:true (1024 * 256) in
-      let t = { ethif; arp; ip; clock; network; gateway ; cache } in
-      Lwt.return t
+  let connect ~ip:(network, ip) ?gateway ethif arp =
+    Arpv4.set_ips arp [ip] >>= fun () ->
+    (* TODO currently hardcoded to 256KB, should be configurable
+          and maybe limited per-src/dst-ip as well? *)
+    let cache = Fragments.Cache.create ~random:true (1024 * 256) in
+    Lwt.return { ethif; arp; ip; network; gateway ; cache }
 
   let disconnect _ = Lwt.return_unit
 

src/ipv4/static_ipv4.mli

@@ -14,16 +14,10 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-module Make (R: Mirage_random.C) (C: Mirage_clock.MCLOCK) (E: Mirage_protocols_lwt.ETHERNET) (A: Mirage_protocols_lwt.ARP) : sig
-  include Mirage_protocols_lwt.IPV4
-  val connect :
-    ?ip:Ipaddr.V4.t ->
-    ?network:Ipaddr.V4.Prefix.t ->
-    ?gateway:Ipaddr.V4.t option ->
-    C.t -> E.t -> A.t -> t Lwt.t
-    (** Connect to an ipv4 device.
-        Default ip is {!Ipaddr.V4.any}
-        Default network is {!Ipaddr.V4.any}/0
-        Default gateway is None. *)
+module Make (R: Mirage_random.S) (C: Mirage_clock.MCLOCK) (E: Mirage_protocols.ETHERNET) (A: Mirage_protocols.ARP) : sig
+  include Mirage_protocols.IP with type ipaddr = Ipaddr.V4.t
 
+  val connect : ip:(Ipaddr.V4.Prefix.t * Ipaddr.V4.t) -> ?gateway:Ipaddr.V4.t ->
+    E.t -> A.t -> t Lwt.t
+  (** Connect to an ipv4 device. *)
 end

src/ipv6/dune

@@ -1,9 +1,8 @@
 (library
  (name tcpip_ipv6)
  (public_name tcpip.ipv6)
- (libraries logs mirage-protocols-lwt mirage-time-lwt macaddr-cstruct
-   mirage-clock-lwt duration ipaddr cstruct rresult mirage-random tcpip
+ (libraries logs mirage-protocols mirage-time macaddr-cstruct
+   mirage-clock duration ipaddr cstruct rresult mirage-random tcpip
    randomconv)
- (preprocess
-  (pps ppx_cstruct))
+ (preprocess (pps ppx_cstruct))
  (wrapped false))

src/ipv6/ipv6.ml

@@ -21,20 +21,17 @@ module I = Ipaddr
 
 open Lwt.Infix
 
-module Make (E : Mirage_protocols_lwt.ETHERNET)
-            (R : Mirage_random.C)
-            (T : Mirage_time_lwt.S)
-            (C : Mirage_clock_lwt.MCLOCK) = struct
-  type 'a io    = 'a Lwt.t
-  type buffer   = Cstruct.t
+module Make (E : Mirage_protocols.ETHERNET)
+            (R : Mirage_random.S)
+            (T : Mirage_time.S)
+            (C : Mirage_clock.MCLOCK) = struct
   type ipaddr   = Ipaddr.V6.t
-  type callback = src:ipaddr -> dst:ipaddr -> buffer -> unit Lwt.t
+  type callback = src:ipaddr -> dst:ipaddr -> Cstruct.t -> unit Lwt.t
 
   let pp_ipaddr = Ipaddr.V6.pp
 
   type t =
     { ethif : E.t;
-      clock : C.t;
       mutable ctx : Ndpv6.context }
 
   type error = [ Mirage_protocols.Ip.error | `Ethif of E.error ]
@@ -50,7 +47,7 @@ module Make (E : Mirage_protocols_lwt.ETHERNET)
 
   let start_ticking t =
     let rec loop () =
-      let now = C.elapsed_ns t.clock in
+      let now = C.elapsed_ns () in
       let ctx, outs = Ndpv6.tick ~now t.ctx in
       t.ctx <- ctx;
       Lwt_list.iter_s (output_ign t) outs (* MCP: replace with propagation *) >>= fun () ->
@@ -61,7 +58,7 @@ module Make (E : Mirage_protocols_lwt.ETHERNET)
   let mtu t = E.mtu t.ethif - Ipv6_wire.sizeof_ipv6
 
   let write t ?fragment:_ ?ttl:_ ?src:_ dst proto ?(size = 0) headerf bufs =
-    let now = C.elapsed_ns t.clock in
+    let now = C.elapsed_ns () in
     (* TODO fragmentation! *)
     let payload = Cstruct.concat bufs in
     let size' = size + Cstruct.len payload in
@@ -92,7 +89,7 @@ module Make (E : Mirage_protocols_lwt.ETHERNET)
     Lwt_list.fold_left_s fail_any (Ok ()) outs
 
   let input t ~tcp ~udp ~default buf =
-    let now = C.elapsed_ns t.clock in
+    let now = C.elapsed_ns () in
     let _, outs, actions = Ndpv6.handle ~now ~random:R.generate t.ctx buf in
     Lwt_list.iter_s (function
         | `Tcp (src, dst, buf) -> tcp ~src ~dst buf
@@ -108,7 +105,7 @@ module Make (E : Mirage_protocols_lwt.ETHERNET)
   let src t ~dst = Ndpv6.select_source t.ctx dst
 
   let set_ip t ip =
-    let now = C.elapsed_ns t.clock in
+    let now = C.elapsed_ns () in
     let ctx, outs = Ndpv6.add_ip ~now t.ctx ip in
     t.ctx <- ctx;
     (* MCP: replace the below *)
@@ -118,13 +115,13 @@ module Make (E : Mirage_protocols_lwt.ETHERNET)
     Ndpv6.get_ip t.ctx
 
   let set_ip_gateways t ips =
-    let now = C.elapsed_ns t.clock in
+    let now = C.elapsed_ns () in
     let ctx = Ndpv6.add_routers ~now t.ctx ips in
     t.ctx <- ctx;
     Lwt.return_unit
 
   let set_ip_netmask t pfx =
-    let now = C.elapsed_ns t.clock in
+    let now = C.elapsed_ns () in
     let ctx = Ndpv6.add_prefix ~now t.ctx pfx in
     t.ctx <- ctx;
     Lwt.return_unit
@@ -145,11 +142,11 @@ module Make (E : Mirage_protocols_lwt.ETHERNET)
     | Some x -> f x >>= g
     | None -> g ()
 
-  let connect ?ip ?netmask ?gateways ethif clock =
+  let connect ?ip ?netmask ?gateways ethif =
     Log.info (fun f -> f "IP6: Starting");
-    let now = C.elapsed_ns clock in
+    let now = C.elapsed_ns () in
     let ctx, outs = Ndpv6.local ~now ~random:R.generate (E.mac ethif) in
-    let t = {ctx; clock; ethif} in
+    let t = {ctx; ethif} in
     (* MCP: replace this error swallowing with proper propagation *)
     Lwt_list.iter_s (output_ign t) outs >>= fun () ->
     (ip, Lwt_list.iter_s (set_ip t)) >>=? fun () ->

src/ipv6/ipv6.mli

@@ -14,14 +14,14 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-module Make (E : Mirage_protocols_lwt.ETHERNET)
-            (R : Mirage_random.C)
-            (T : Mirage_time_lwt.S)
-            (Clock : Mirage_clock_lwt.MCLOCK) : sig
-  include Mirage_protocols_lwt.IPV6
+module Make (E : Mirage_protocols.ETHERNET)
+            (R : Mirage_random.S)
+            (T : Mirage_time.S)
+            (Clock : Mirage_clock.MCLOCK) : sig
+  include Mirage_protocols.IP with type ipaddr = Ipaddr.V6.t
   val connect :
     ?ip:Ipaddr.V6.t list ->
     ?netmask:Ipaddr.V6.Prefix.t list ->
     ?gateways:Ipaddr.V6.t list ->
-    E.t -> Clock.t -> t Lwt.t
+    E.t -> t Lwt.t
 end

src/stack-direct/dune

@@ -1,5 +1,5 @@
 (library
  (name tcpip_stack_direct)
  (public_name tcpip.stack-direct)
- (libraries logs ipaddr lwt result fmt mirage-time-lwt mirage-random
-   mirage-protocols-lwt mirage-stack-lwt mirage-net-lwt ethernet))
+ (libraries logs ipaddr lwt result fmt mirage-time mirage-random
+   mirage-protocols mirage-stack mirage-net ethernet))

src/stack-direct/tcpip_stack_direct.ml

@@ -20,28 +20,24 @@ let src = Logs.Src.create "tcpip-stack-direct" ~doc:"Pure OCaml TCP/IP stack"
 module Log = (val Logs.src_log src : Logs.LOG)
 
 type direct_ipv4_input = src:Ipaddr.V4.t -> dst:Ipaddr.V4.t -> Cstruct.t -> unit Lwt.t
-module type UDPV4_DIRECT = Mirage_protocols_lwt.UDPV4
-  with type ipinput = direct_ipv4_input
+module type UDPV4_DIRECT = Mirage_protocols.UDP
+  with type ipaddr = Ipaddr.V4.t
+   and type ipinput = direct_ipv4_input
 
-module type TCPV4_DIRECT = Mirage_protocols_lwt.TCPV4
-  with type ipinput = direct_ipv4_input
+module type TCPV4_DIRECT = Mirage_protocols.TCP
+  with type ipaddr = Ipaddr.V4.t
+   and type ipinput = direct_ipv4_input
 
 module Make
     (Time     : Mirage_time.S)
-    (Random   : Mirage_random.C)
-    (Netif    : Mirage_net_lwt.S)
-    (Ethernet : Mirage_protocols_lwt.ETHERNET)
-    (Arpv4    : Mirage_protocols_lwt.ARP)
-    (Ipv4     : Mirage_protocols_lwt.IPV4)
-    (Icmpv4   : Mirage_protocols_lwt.ICMPV4)
+    (Random   : Mirage_random.S)
+    (Netif    : Mirage_net.S)
+    (Ethernet : Mirage_protocols.ETHERNET)
+    (Arpv4    : Mirage_protocols.ARP)
+    (Ipv4     : Mirage_protocols.IP with type ipaddr = Ipaddr.V4.t)
+    (Icmpv4   : Mirage_protocols.ICMP with type ipaddr = Ipaddr.V4.t)
     (Udpv4    : UDPV4_DIRECT)
     (Tcpv4    : TCPV4_DIRECT) = struct
-  type +'a io = 'a Lwt.t
-  type buffer = Cstruct.t
-  type ipv4addr = Ipaddr.V4.t
-  type tcpv4 = Tcpv4.t
-  type udpv4 = Udpv4.t
-  type ipv4 = Ipv4.t
 
   module UDPV4 = Udpv4
   module TCPV4 = Tcpv4

src/stack-direct/tcpip_stack_direct.mli

@@ -15,27 +15,27 @@
  *)
 
 type direct_ipv4_input = src:Ipaddr.V4.t -> dst:Ipaddr.V4.t -> Cstruct.t -> unit Lwt.t
-module type UDPV4_DIRECT = Mirage_protocols_lwt.UDPV4
-  with type ipinput = direct_ipv4_input
 
-module type TCPV4_DIRECT = Mirage_protocols_lwt.TCPV4
-  with type ipinput = direct_ipv4_input
+module type UDPV4_DIRECT = Mirage_protocols.UDP
+  with type ipaddr = Ipaddr.V4.t
+   and type ipinput = direct_ipv4_input
+
+module type TCPV4_DIRECT = Mirage_protocols.TCP
+  with type ipaddr = Ipaddr.V4.t
+   and type ipinput = direct_ipv4_input
 
 module Make
     (Time     : Mirage_time.S)
-    (Random   : Mirage_random.C)
-    (Netif    : Mirage_net_lwt.S)
-    (Ethernet : Mirage_protocols_lwt.ETHERNET)
-    (Arpv4    : Mirage_protocols_lwt.ARP)
-    (Ipv4     : Mirage_protocols_lwt.IPV4)
-    (Icmpv4   : Mirage_protocols_lwt.ICMPV4)
+    (Random   : Mirage_random.S)
+    (Netif    : Mirage_net.S)
+    (Ethernet : Mirage_protocols.ETHERNET)
+    (Arpv4    : Mirage_protocols.ARP)
+    (Ipv4     : Mirage_protocols.IP with type ipaddr = Ipaddr.V4.t)
+    (Icmpv4   : Mirage_protocols.ICMP with type ipaddr = Ipaddr.V4.t)
     (Udpv4    : UDPV4_DIRECT)
     (Tcpv4    : TCPV4_DIRECT) : sig
-  include Mirage_stack_lwt.V4
-    with type udpv4   = Udpv4.t
-     and type tcpv4   = Tcpv4.t
-     and type ipv4    = Ipv4.t
-     and module IPV4 = Ipv4
+  include Mirage_stack.V4
+    with module IPV4 = Ipv4
      and module TCPV4 = Tcpv4
      and module UDPV4 = Udpv4