Merge pull request #371 from hannesm/less-types

remove ethif and prefix type from IP interface

.travis.yml

@@ -8,5 +8,5 @@ env:
   - OCAML_VERSION=4.04 PACKAGE=tcpip MIRAGE_MODE=unix
   - OCAML_VERSION=4.04 PACKAGE=tcpip MIRAGE_MODE=unix FLAGS="--net=socket"
   - UPDATE_GCC_BINUTILS=1 OCAML_VERSION=4.04 PACKAGE=tcpip MIRAGE_MODE=xen
-  - UPDATE_GCC_BINUTILS=1 OCAML_VERSION=4.05 PACKAGE=tcpip MIRAGE_MODE=ukvm
+  - UPDATE_GCC_BINUTILS=1 OCAML_VERSION=4.05 PACKAGE=tcpip MIRAGE_MODE=hvt
   - OCAML_VERSION=4.06 PACKAGE=tcpip MIRAGE_MODE=unix

CHANGES.md

@@ -1,3 +1,17 @@
+### v3.5.0 (2018-09-16)
+
+* Ipv4: require Mirage_random.C, used for generating IPv4 identifier instead of using OCaml's stdlib Random directly (#371 @hannesm)
+* Tcp: use entire 32 bits at random for the initial sequence number, thanks to NCC group for reporting (#371 @hannesm)
+* adjust to mirage-protocols 1.4.0 and mirage-stack 1.3.0 changes (#371 @hannesm)
+  Arp no longer contains the type alias ethif
+  Ethif no longer contains the type alias netif
+  Static_ipv4 no longer contains the type alias ethif and prefix
+  Ipv6 no longer contains the type alias ethif and prefix
+  Mirage_protocols_lwt.IPV4 no longer contains the type alias ethif
+  Mirage_protocols_lwt.UDPV4 and TCPV4 no longer contain the type alias ip
+* remove unused types: 'a config, netif, and id from socket and direct stack (#371 @hannesm)
+* remove usage of Result, depending on OCaml >= 4.03.0 (#372 @hannesm)
+
 ### v3.4.2 (2018-06-15)
 
 Note the use of the new TCP keep-alive feature can cause excessive amounts

src/arpv4/arpv4.ml

@@ -28,7 +28,6 @@ module Make (Ethif : Mirage_protocols_lwt.ETHIF)
   type buffer = Cstruct.t
   type ipaddr = Ipaddr.V4.t
   type macaddr = Macaddr.t
-  type ethif = Ethif.t
   type repr = string
   type error = Mirage_protocols.Arp.error
   let pp_error = Mirage_protocols.Arp.pp_error

src/arpv4/arpv4.mli

@@ -20,8 +20,6 @@ module Make (Ethif : Mirage_protocols_lwt.ETHIF)
   (Time : Mirage_time_lwt.S) : sig
   include Mirage_protocols_lwt.ARP
 
-  type ethif = Ethif.t
-
   (** [connect] creates a value of type [t]. *)
-  val connect : ethif -> Clock.t -> t Lwt.t
+  val connect : Ethif.t -> Clock.t -> t Lwt.t
 end

src/ethif/ethif.ml

@@ -27,7 +27,6 @@ module Make(Netif : Mirage_net_lwt.S) = struct
   type 'a io = 'a Lwt.t
   type buffer = Cstruct.t
   type macaddr = Macaddr.t
-  type netif = Netif.t
 
   type error = Netif.error
   let pp_error = Netif.pp_error

src/ethif/ethif.mli

@@ -16,9 +16,9 @@
  *)
 
 module Make ( N:Mirage_net_lwt.S) : sig
-  include Mirage_protocols_lwt.ETHIF with type netif = N.t
+  include Mirage_protocols_lwt.ETHIF
 
-  val connect : ?mtu:int -> netif -> t Lwt.t
+  val connect : ?mtu:int -> N.t -> t Lwt.t
   (** [connect ?mtu netif] connects an ethernet layer on top of the raw
       network device [netif]. The Maximum Transfer Unit may be set via the
       optional [?mtu] parameter, otherwise a default value of 1500 will be

src/ipv4/ipv4_common.ml

@@ -1,10 +1,10 @@
-let adjust_output_header ~dmac ~tlen frame =
+let adjust_output_header ~rng ~dmac ~tlen frame =
   let open Ipv4_wire in
   Ethif_wire.set_ethernet_dst dmac 0 frame;
   let buf = Cstruct.sub frame Ethif_wire.sizeof_ethernet sizeof_ipv4 in
   (* Set the mutable values in the ipv4 header *)
   set_ipv4_len buf tlen;
-  set_ipv4_id buf (Random.int 65535); (* TODO *)
+  set_ipv4_id buf (Randomconv.int16 rng);
   set_ipv4_csum buf 0;
   let checksum = Tcpip_checksum.ones_complement buf in
   set_ipv4_csum buf checksum

src/ipv4/jbuild

@@ -3,6 +3,6 @@
  ((name        tcpip_ipv4)
   (public_name tcpip.ipv4)
   (libraries   (logs io-page mirage-protocols-lwt ipaddr cstruct rresult
-                tcpip tcpip.ethif tcpip.udp))
+                tcpip tcpip.ethif tcpip.udp mirage-random mirage-clock randomconv))
   (preprocess (pps (ppx_cstruct)))
   (wrapped false)))

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(Ethif: Mirage_protocols_lwt.ETHIF) (Arpv4 : Mirage_protocols_lwt.ARP) = struct
+module Make (R: Mirage_random.C) (C: Mirage_clock.MCLOCK) (Ethif: Mirage_protocols_lwt.ETHIF) (Arpv4 : Mirage_protocols_lwt.ARP) = struct
   module Routing = Routing.Make(Log)(Arpv4)
 
   (** IO operation errors *)
@@ -28,11 +28,9 @@ module Make(Ethif: Mirage_protocols_lwt.ETHIF) (Arpv4 : Mirage_protocols_lwt.ARP
   | #Mirage_protocols.Ip.error as e -> Mirage_protocols.Ip.pp_error ppf e
   | `Ethif e -> Ethif.pp_error ppf e
 
-  type ethif = Ethif.t
   type 'a io = 'a Lwt.t
   type buffer = Cstruct.t
   type ipaddr = Ipaddr.V4.t
-  type prefix = Ipaddr.V4.Prefix.t
   type callback = src:ipaddr -> dst:ipaddr -> buffer -> unit Lwt.t
 
   type t = {
@@ -43,7 +41,7 @@ module Make(Ethif: Mirage_protocols_lwt.ETHIF) (Arpv4 : Mirage_protocols_lwt.ARP
     mutable gateway: Ipaddr.V4.t option;
   }
 
-  let adjust_output_header = Ipv4_common.adjust_output_header
+  let adjust_output_header = Ipv4_common.adjust_output_header ~rng:R.generate
 
   let allocate_frame t ~(dst:ipaddr) ~(proto : [`ICMP | `TCP | `UDP]) : (buffer * int) =
     Ipv4_common.allocate_frame ~src:t.ip ~source:(Ethif.mac t.ethif) ~dst ~proto
@@ -98,7 +96,7 @@ module Make(Ethif: Mirage_protocols_lwt.ETHIF) (Arpv4 : Mirage_protocols_lwt.ARP
   let connect
       ?(ip=Ipaddr.V4.any)
       ?(network=Ipaddr.V4.Prefix.make 0 Ipaddr.V4.any)
-      ?(gateway=None) ethif arp =
+      ?(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_hum ip Ipaddr.V4.Prefix.pp_hum network);

src/ipv4/static_ipv4.mli

@@ -14,13 +14,13 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-module Make (N:Mirage_protocols_lwt.ETHIF) (A: Mirage_protocols_lwt.ARP) : sig
-  include Mirage_protocols_lwt.IPV4 with type ethif = N.t
+module Make (R: Mirage_random.C) (C: Mirage_clock.MCLOCK) (E: Mirage_protocols_lwt.ETHIF) (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 ->
-    ethif -> A.t -> t Lwt.t
+    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

src/ipv6/ipv6.ml

@@ -25,12 +25,10 @@ module Make (E : Mirage_protocols_lwt.ETHIF)
             (R : Mirage_random.C)
             (T : Mirage_time_lwt.S)
             (C : Mirage_clock_lwt.MCLOCK) = struct
-  type ethif    = E.t
   type 'a io    = 'a Lwt.t
   type buffer   = Cstruct.t
   type ipaddr   = Ipaddr.V6.t
   type callback = src:ipaddr -> dst:ipaddr -> buffer -> unit Lwt.t
-  type prefix   = Ipaddr.V6.Prefix.t
 
   type t =
     { ethif : E.t;

src/ipv6/ipv6.mli

@@ -18,10 +18,10 @@ module Make (E : Mirage_protocols_lwt.ETHIF)
             (R : Mirage_random.C)
             (T : Mirage_time_lwt.S)
             (Clock : Mirage_clock_lwt.MCLOCK) : sig
-  include Mirage_protocols_lwt.IPV6 with type ethif = E.t
+  include Mirage_protocols_lwt.IPV6
   val connect :
     ?ip:Ipaddr.V6.t list ->
     ?netmask:Ipaddr.V6.Prefix.t list ->
     ?gateways:Ipaddr.V6.t list ->
-    ethif -> Clock.t -> t Lwt.t
+    E.t -> Clock.t -> t Lwt.t
 end

src/stack-direct/tcpip_stack_direct.ml

@@ -30,16 +30,13 @@ module Make
     (Time    : Mirage_time.S)
     (Random  : Mirage_random.C)
     (Netif   : Mirage_net_lwt.S)
-    (Ethif   : Mirage_protocols_lwt.ETHIF with type netif = Netif.t)
+    (Ethif   : Mirage_protocols_lwt.ETHIF)
     (Arpv4   : Mirage_protocols_lwt.ARP)
-    (Ipv4    : Mirage_protocols_lwt.IPV4 with type ethif = Ethif.t)
+    (Ipv4    : Mirage_protocols_lwt.IPV4)
     (Icmpv4  : Mirage_protocols_lwt.ICMPV4)
-    (Udpv4   : UDPV4_DIRECT with type ip = Ipv4.t)
-    (Tcpv4   : TCPV4_DIRECT with type ip = Ipv4.t) = struct
+    (Udpv4   : UDPV4_DIRECT)
+    (Tcpv4   : TCPV4_DIRECT) = struct
   type +'a io = 'a Lwt.t
-  type 'a config = 'a Mirage_stack_lwt.stackv4_config
-  type netif = Netif.t
-  type id = netif config
   type buffer = Cstruct.t
   type ipv4addr = Ipaddr.V4.t
   type tcpv4 = Tcpv4.t
@@ -51,7 +48,6 @@ module Make
   module IPV4  = Ipv4
 
   type t = {
-    id    : id;
     netif : Netif.t;
     ethif : Ethif.t;
     arpv4 : Arpv4.t;
@@ -127,11 +123,10 @@ module Make
             nstat.tx_bytes nstat.tx_pkts) ;
       Lwt.return_unit
 
-  let connect id ethif arpv4 ipv4 icmpv4 udpv4 tcpv4 =
-    let { Mirage_stack_lwt.interface = netif; _ } = id in
+  let connect netif ethif arpv4 ipv4 icmpv4 udpv4 tcpv4 =
     let udpv4_listeners = Hashtbl.create 7 in
     let tcpv4_listeners = Hashtbl.create 7 in
-    let t = { id; netif; ethif; arpv4; ipv4; icmpv4; tcpv4; udpv4;
+    let t = { netif; ethif; arpv4; ipv4; icmpv4; tcpv4; udpv4;
               udpv4_listeners; tcpv4_listeners } in
     Log.info (fun f -> f "stack assembled: %a" pp t);
     Lwt.ignore_result (listen t);

src/stack-direct/tcpip_stack_direct.mli

@@ -25,24 +25,22 @@ module Make
     (Time    : Mirage_time.S)
     (Random  : Mirage_random.C)
     (Netif   : Mirage_net_lwt.S)
-    (Ethif   : Mirage_protocols_lwt.ETHIF with type netif = Netif.t)
+    (Ethif   : Mirage_protocols_lwt.ETHIF)
     (Arpv4   : Mirage_protocols_lwt.ARP)
-    (Ipv4    : Mirage_protocols_lwt.IPV4 with type ethif = Ethif.t)
+    (Ipv4    : Mirage_protocols_lwt.IPV4)
     (Icmpv4  : Mirage_protocols_lwt.ICMPV4)
-    (Udpv4   : UDPV4_DIRECT with type ip = Ipv4.t)
-    (Tcpv4   : TCPV4_DIRECT with type ip = Ipv4.t) : sig
+    (Udpv4   : UDPV4_DIRECT)
+    (Tcpv4   : TCPV4_DIRECT) : sig
   include Mirage_stack_lwt.V4
-    with type netif   = Netif.t
-     and type udpv4   = Udpv4.t
+    with type udpv4   = Udpv4.t
      and type tcpv4   = Tcpv4.t
      and type ipv4    = Ipv4.t
      and module IPV4 = Ipv4
      and module TCPV4 = Tcpv4
      and module UDPV4 = Udpv4
 
-  val connect : netif Mirage_stack_lwt.stackv4_config ->
-    Ethif.t -> Arpv4.t -> Ipv4.t -> Icmpv4.t -> Udpv4.t -> Tcpv4.t ->
-    t Lwt.t
+  val connect : Netif.t -> Ethif.t -> Arpv4.t -> Ipv4.t -> Icmpv4.t ->
+    Udpv4.t -> Tcpv4.t -> t Lwt.t
   (** [connect] assembles the arguments into a network stack, then calls
       `listen` on the assembled stack before returning it to the caller.  The
       initial `listen` functions to ensure that the lower-level layers (e.g.

src/stack-unix/ipv4_socket.ml

@@ -21,8 +21,6 @@ type t = Ipaddr.V4.t option
 type +'a io = 'a Lwt.t
 type error = Mirage_protocols.Ip.error
 type ipaddr = Ipaddr.V4.t
-type prefix = Ipaddr.V4.t (* FIXME *)
-type ethif = unit
 type buffer = Cstruct.t
 type callback = src:ipaddr -> dst:ipaddr -> buffer -> unit io
 type uipaddr = Ipaddr.t

src/stack-unix/ipv6_socket.ml

@@ -23,7 +23,6 @@ type t = unit
 type +'a io = 'a Lwt.t
 type error = [ `Unimplemented | `Unknown of string ]
 type ipaddr = Ipaddr.V6.t
-type ethif = unit
 type buffer = Cstruct.t
 type callback = src:ipaddr -> dst:ipaddr -> buffer -> unit io
 type uipaddr = Ipaddr.t

src/stack-unix/tcpip_stack_socket.ml

@@ -23,19 +23,14 @@ type socket_ipv4_input = unit Lwt.t
 
 module type UDPV4_SOCKET = Mirage_protocols_lwt.UDP
   with type ipinput = socket_ipv4_input
-   and type ip = Ipaddr.V4.t option
 
 module type TCPV4_SOCKET = Mirage_protocols_lwt.TCP
   with type ipinput = socket_ipv4_input
-   and type ip = Ipaddr.V4.t option
 
 module Tcpv4 = Tcpv4_socket
 module Udpv4 = Udpv4_socket
 
 type +'a io = 'a Lwt.t
-type 'a config = 'a Mirage_stack_lwt.stackv4_config
-type netif = Ipaddr.V4.t list
-type id = netif config
 type buffer = Cstruct.t
 type ipv4addr = Ipaddr.V4.t
 
@@ -48,7 +43,6 @@ type tcpv4 = Tcpv4_socket.t
 type ipv4  = Ipaddr.V4.t option
 
 type t = {
-  id    : id;
   udpv4 : Udpv4.t;
   tcpv4 : Tcpv4.t;
   udpv4_listeners: (int, Udpv4.callback) Hashtbl.t;
@@ -138,14 +132,13 @@ let listen _t =
   let t, _ = Lwt.task () in
   t (* TODO cancellation *)
 
-let connect id udpv4 tcpv4 =
-  let { Mirage_stack_lwt.interface; _ } = id in
+let connect ips udpv4 tcpv4 =
   Log.info (fun f -> f "Manager: connect");
   let udpv4_listeners = Hashtbl.create 7 in
   let tcpv4_listeners = Hashtbl.create 7 in
-  let t = { id; tcpv4; udpv4; udpv4_listeners; tcpv4_listeners } in
+  let t = { tcpv4; udpv4; udpv4_listeners; tcpv4_listeners } in
   Log.info (fun f -> f "Manager: configuring");
-  configure t interface
+  configure t ips
   >>= fun () ->
   return t
 

src/stack-unix/tcpip_stack_socket.mli

@@ -15,12 +15,10 @@
  *)
 
 include Mirage_stack_lwt.V4
-  with type netif   = Ipaddr.V4.t list
-   and type tcpv4   = Tcpv4_socket.t
+  with type tcpv4   = Tcpv4_socket.t
    and type udpv4   = Udpv4_socket.t
    and type ipv4    = Ipaddr.V4.t option
    and module UDPV4 = Udpv4_socket
    and module TCPV4 = Tcpv4_socket
    and module IPV4  = Ipv4_socket
-val connect : netif Mirage_stack_lwt.stackv4_config ->
-  Udpv4_socket.t -> Tcpv4_socket.t -> t Lwt.t
+val connect : Ipaddr.V4.t list -> Udpv4_socket.t -> Tcpv4_socket.t -> t Lwt.t

src/stack-unix/tcpv4_socket.ml

@@ -20,7 +20,6 @@ type buffer = Cstruct.t
 type ipaddr = Ipaddr.V4.t
 type flow = Lwt_unix.file_descr
 type +'a io = 'a Lwt.t
-type ip = Ipaddr.V4.t option (* interface *)
 type ipinput = unit io
 
 type t = {

src/stack-unix/tcpv4_socket.mli

@@ -15,11 +15,10 @@
  *)
 
 include Mirage_protocols_lwt.TCP
-  with type ip = Ipaddr.V4.t option
-   and type ipaddr = Ipaddr.V4.t
+  with type ipaddr = Ipaddr.V4.t
    and type ipinput = unit Lwt.t
    and type flow = Lwt_unix.file_descr
    and type error = [ Mirage_protocols.Tcp.error | `Exn of exn ]
    and type write_error = [ Mirage_protocols.Tcp.write_error | `Exn of exn ]
 
-val connect : ip -> t Lwt.t
+val connect : Ipaddr.V4.t option -> t Lwt.t

src/stack-unix/tcpv6_socket.ml

@@ -21,7 +21,6 @@ type buffer = Cstruct.t
 type ipaddr = Ipaddr.V6.t
 type flow = Lwt_unix.file_descr
 type +'a io = 'a Lwt.t
-type ip = Ipaddr.V6.t option (* interface *)
 type ipinput = unit io
 
 type t = {

src/stack-unix/tcpv6_socket.mli

@@ -16,11 +16,10 @@
  *)
 
 include Mirage_protocols_lwt.TCP
-  with type ip = Ipaddr.V6.t option
-   and type ipaddr = Ipaddr.V6.t
+  with type ipaddr = Ipaddr.V6.t
    and type ipinput = unit Lwt.t
    and type flow = Lwt_unix.file_descr
    and type error = [ Mirage_protocols.Tcp.error | `Exn of exn ]
    and type write_error = [ Mirage_protocols.Tcp.write_error | `Exn of exn ]
 
-val connect : ip -> t io
+val connect : Ipaddr.V6.t option -> t io