Merge pull request #288 from djs55/add-mtu

Compute TCP MSS from IP, ethif MTU

_oasis

@@ -133,6 +133,8 @@ Library "icmpv4-socket"
                       cstruct.lwt,
                       io-page.unix,
                       tcpip.icmpv4,
+                      tcpip.ipv4,
+                      tcpip.ipv6,
                       mirage-protocols,mirage-protocols-lwt
 
 Library "udpv4-socket"

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: f4270b7cbeb239d804a95dc1c080220b)
+# DO NOT EDIT (digest: 417bae857bae4a5a1016501e56db0a47)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -186,13 +186,25 @@ true: annot, bin_annot
 "unix/icmpv4-socket.cmxs": use_icmpv4-socket
 <unix/*.ml{,i,y}>: pkg_cstruct
 <unix/*.ml{,i,y}>: pkg_cstruct.ppx
+<unix/*.ml{,i,y}>: pkg_duration
+<unix/*.ml{,i,y}>: pkg_io-page
 <unix/*.ml{,i,y}>: pkg_ipaddr
+<unix/*.ml{,i,y}>: pkg_mirage-clock
+<unix/*.ml{,i,y}>: pkg_mirage-clock-lwt
 <unix/*.ml{,i,y}>: pkg_mirage-net-lwt
 <unix/*.ml{,i,y}>: pkg_mirage-profile
+<unix/*.ml{,i,y}>: pkg_mirage-random
+<unix/*.ml{,i,y}>: pkg_mirage-time-lwt
+<unix/*.ml{,i,y}>: pkg_randomconv
 <unix/*.ml{,i,y}>: pkg_result
 <unix/*.ml{,i,y}>: pkg_rresult
+<unix/*.ml{,i,y}>: use_ethif
 <unix/*.ml{,i,y}>: use_icmpv4
+<unix/*.ml{,i,y}>: use_ipv4
+<unix/*.ml{,i,y}>: use_ipv6
+<unix/*.ml{,i,y}>: use_tcp
 <unix/*.ml{,i,y}>: use_tcpip
+<unix/*.ml{,i,y}>: use_udp
 # Library udpv4-socket
 "unix/udpv4-socket.cmxs": use_udpv4-socket
 # Library udpv6-socket

lib/META

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: af6a7b40c941c47bca5c459a000ce665)
+# DO NOT EDIT (digest: 514c9a0cdf340349d239ac493ed47a94)
 version = "3.0.0"
 description =
 "Implementations for network-related module types from MirageOS."
@@ -157,7 +157,7 @@ package "icmpv4-socket" (
  description =
  "Implementations for network-related module types from MirageOS."
  requires =
- "lwt lwt.unix ipaddr.unix cstruct.lwt io-page.unix tcpip.icmpv4 mirage-protocols mirage-protocols-lwt"
+ "lwt lwt.unix ipaddr.unix cstruct.lwt io-page.unix tcpip.icmpv4 tcpip.ipv4 tcpip.ipv6 mirage-protocols mirage-protocols-lwt"
  archive(byte) = "icmpv4-socket.cma"
  archive(byte, plugin) = "icmpv4-socket.cma"
  archive(native) = "icmpv4-socket.cmxa"

lib/ethif/ethif.ml

@@ -21,6 +21,8 @@ open Lwt.Infix
 let src = Logs.Src.create "ethif" ~doc:"Mirage Ethernet"
 module Log = (val Logs.src_log src : Logs.LOG)
 
+let default_mtu = 1500
+
 module Make(Netif : Mirage_net_lwt.S) = struct
 
   type 'a io = 'a Lwt.t
@@ -33,9 +35,11 @@ module Make(Netif : Mirage_net_lwt.S) = struct
 
   type t = {
     netif: Netif.t;
+    mtu: int;
   }
 
   let mac t = Netif.mac t.netif
+  let mtu t = t.mtu
 
   let input ~arpv4 ~ipv4 ~ipv6 t frame =
     let open Ethif_packet in
@@ -73,9 +77,9 @@ module Make(Netif : Mirage_net_lwt.S) = struct
       Log.warn (fun f -> f "netif writev errored %a" Netif.pp_error e) ;
       Error e
 
-  let connect netif =
+  let connect ?(mtu = default_mtu) netif =
     MProf.Trace.label "ethif.connect";
-    let t = { netif } in
+    let t = { netif; mtu } in
     Log.info (fun f -> f "Connected Ethernet interface %s" (Macaddr.to_string (mac t)));
     Lwt.return t
 

lib/ethif/ethif.mli

@@ -17,5 +17,10 @@
 
 module Make ( N:Mirage_net_lwt.S) : sig
   include Mirage_protocols_lwt.ETHIF with type netif = N.t
-  val connect : netif -> t Lwt.t
+
+  val connect : ?mtu:int -> netif -> 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
+      used. *)
 end

lib/ipv4/static_ipv4.ml

@@ -130,4 +130,6 @@ module Make(Ethif: Mirage_protocols_lwt.ETHIF) (Arpv4 : Mirage_protocols_lwt.ARP
   let to_uipaddr ip = Ipaddr.V4 ip
   let of_uipaddr = Ipaddr.to_v4
 
+  let mtu t = Ethif.mtu t.ethif - Ipv4_wire.sizeof_ipv4
+
 end

lib/ipv6/ipv6.ml

@@ -59,6 +59,9 @@ module Make (E : Mirage_protocols_lwt.ETHIF)
   let allocate_frame t ~dst ~proto =
     Ndpv6.allocate_frame t.ctx dst proto
 
+  let mtu t =
+    E.mtu t.ethif - Ipv6_wire.sizeof_ipv6
+
   let writev t frame bufs =
     let now = C.elapsed_ns t.clock in
     let dst =

lib/tcp/pcb.ml

@@ -350,7 +350,7 @@ struct
     Hashtbl.add t.listens id (params.tx_isn, (pushf, (pcb, th)));
     Stats.incr_listen ();
     (* Queue a SYN ACK for transmission *)
-    let options = Options.MSS 1460 :: opts in
+    let options = Options.MSS (Ip.mtu t.ip - Tcp_wire.sizeof_tcp) :: opts in
     TXS.output ~flags:Segment.Syn ~options pcb.txq (Cstruct.create 0) >>= fun () ->
     Lwt.return (pcb, th)
 
@@ -623,7 +623,7 @@ struct
     (* TODO: This is hardcoded for now - make it configurable *)
     let rx_wnd_scaleoffer = wscale_default in
     let options =
-      Options.MSS 1460 :: Options.Window_size_shift rx_wnd_scaleoffer :: []
+      Options.MSS (Ip.mtu t.ip - Tcp_wire.sizeof_tcp) :: Options.Window_size_shift rx_wnd_scaleoffer :: []
     in
     let window = 5840 in
     let th, wakener = MProf.Trace.named_task "TCP connect" in

lib/tcp/window.ml

@@ -59,7 +59,6 @@ type t = {
 let count_ackd_segs = MProf.Counter.make ~name:"tcp-ackd-segs"
 
 let default_mss = 536
-let max_mss = 1460
 
 let alpha = 0.125  (* see RFC 2988 *)
 let beta = 0.25    (* see RFC 2988 *)
@@ -81,7 +80,7 @@ let t ~rx_wnd_scale ~tx_wnd_scale ~rx_wnd ~tx_wnd ~rx_isn ~tx_mss ~tx_isn =
   let rx_nxt = Sequence.incr rx_isn in
   let rx_nxt_inseq = Sequence.incr rx_isn in
   (* TODO: improve this sanity check of tx_mss *)
-  let tx_mss = match tx_mss with |None -> default_mss |Some mss -> min mss max_mss in
+  let tx_mss = match tx_mss with |None -> default_mss |Some mss -> mss in
   let snd_una = tx_nxt in
   let fast_rec_th = tx_nxt in
   let ack_serviced = true in

myocamlbuild.ml

@@ -1,5 +1,5 @@
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 61d522780b0d74636b2863a6585885db) *)
+(* DO NOT EDIT (digest: 2b48a56d3f5cff3a6f50fcaa0be7ece6) *)
 module OASISGettext = struct
 (* # 22 "src/oasis/OASISGettext.ml" *)
 
@@ -922,7 +922,7 @@ let package_default =
        ];
      includes =
        [
-          ("unix", ["lib/icmp"]);
+          ("unix", ["lib/icmp"; "lib/ipv4"; "lib/ipv6"]);
           ("lib_test",
             [
                "lib";

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.4.5 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: cbeda8f1a0d1981bd8673b1f4f130d43) *)
+(* DO NOT EDIT (digest: b685ec63d44811f24db90b6ae2c9c30a) *)
 (*
    Regenerated by OASIS v0.4.8
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -8667,6 +8667,8 @@ let setup_t =
                            FindlibPackage ("cstruct.lwt", None);
                            FindlibPackage ("io-page.unix", None);
                            InternalLibrary "icmpv4";
+                           InternalLibrary "ipv4";
+                           InternalLibrary "ipv6";
                            FindlibPackage ("mirage-protocols", None);
                            FindlibPackage ("mirage-protocols-lwt", None)
                         ];
@@ -9796,15 +9798,15 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.8";
-     oasis_digest = Some "E\1568G\151\151\152\128\020\174Eaz[\r\191";
+     oasis_digest = Some "\211`}\212\224?\031\023eS_\003;&\202\196";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
   };;
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 9808 "setup.ml"
+# 9810 "setup.ml"
 let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t
 open BaseCompat.Compat_0_4
 (* OASIS_STOP *)

unix/ipv4_socket.ml

@@ -31,6 +31,7 @@ let pp_error = Mirage_protocols.Ip.pp_error
 
 let to_uipaddr ip = Ipaddr.V4 ip
 let of_uipaddr = Ipaddr.to_v4
+let mtu _ = 1500 - Ipv4_wire.sizeof_ipv4
 
 let id _ = ()
 let disconnect _ = return_unit

unix/ipv6_socket.ml

@@ -30,6 +30,7 @@ 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 _ = ()
 let disconnect () = return_unit