Allow the virtual ethernet link MTU to be configured

This adds support for the database key

  com.docker.driver.amd64-linux/slirp/mtu

The default value is unchanged (1500).

Signed-off-by: David Scott <dave.scott@docker.com>

src/bin/main.ml

@@ -265,7 +265,8 @@ let main_t socket_url port_control_url introspection_url diagnostics_url max_con
       extra_dns_ip = [];
       get_domain_search = (fun () -> []);
       get_domain_name = (fun () -> "local");
-      pcap_settings = Active_config.Value(pcap, never) } in
+      pcap_settings = Active_config.Value(pcap, never);
+      mtu = 1500; } in
 
   let config = match db_path with
     | Some db_path ->

src/hostnet/capture.ml

@@ -216,7 +216,7 @@ module Make(Input: Sig.VMNET) = struct
     t.stats.rx_pkts <- 0l;
     t.stats.tx_pkts <- 0l
 
-  let of_fd ~client_macaddr:_ ~server_macaddr:_ =
+  let of_fd ~client_macaddr:_ ~server_macaddr:_ ~mtu:_ =
     failwith "Capture.of_fd unimplemented"
 
   let start_capture _ ?size_limit:_ _ =

src/hostnet/filter.ml

@@ -104,7 +104,7 @@ module Make(Input: Sig.VMNET) = struct
     t.stats.rx_pkts <- 0l;
     t.stats.tx_pkts <- 0l
 
-  let of_fd ~client_macaddr:_ ~server_macaddr:_ =
+  let of_fd ~client_macaddr:_ ~server_macaddr:_ ~mtu:_ =
     failwith "Filter.of_fd unimplemented"
 
   let start_capture _ ?size_limit:_ _ =

src/hostnet/sig.ml

@@ -190,7 +190,7 @@ module type VMNET = sig
   type fd
 
   val of_fd: client_macaddr:Macaddr.t -> server_macaddr:Macaddr.t
-    -> fd -> t Error.t
+    -> mtu:int -> fd -> t Error.t
 
   val start_capture: t -> ?size_limit:int64 -> string -> unit Lwt.t
 

src/hostnet/slirp.ml

@@ -23,6 +23,8 @@ let default_dns_extra = []
    to respect the Do Not Fragment bit. *)
 let safe_outgoing_mtu = 1452 (* packets above this size with DNF set will get ICMP errors *)
 
+let default_mtu = 1500 (* used for the virtual ethernet link *)
+
 let log_exception_continue description f =
   Lwt.catch
     (fun () -> f ())
@@ -73,6 +75,7 @@ type config = {
   get_domain_search: unit -> string list;
   get_domain_name: unit -> string;
   pcap_settings: pcap Active_config.values;
+  mtu: int;
 }
 
 module Make(Config: Active_config.S)(Vmnet: Sig.VMNET)(Dns_policy: Sig.DNS_POLICY)(Host: Sig.HOST) = struct
@@ -936,8 +939,16 @@ module Make(Config: Active_config.S)(Vmnet: Sig.VMNET)(Dns_policy: Sig.DNS_POLIC
       monitor_dns_settings settings in
     Lwt.async (fun () -> log_exception_continue "monitor DNS settings" (fun () -> monitor_dns_settings dns_settings));
 
-    Log.info (fun f -> f "Creating slirp server pcap_settings:%s peer_ip:%s local_ip:%s domain_search:%s"
-                 (print_pcap @@ Active_config.hd pcap_settings) (Ipaddr.V4.to_string peer_ip) (Ipaddr.V4.to_string local_ip) (String.concat " " !domain_search)
+    let mtu_path = driver @ [ "slirp"; "mtu" ] in
+    Config.int config ~default:default_mtu mtu_path
+    >>= fun mtus ->
+    Lwt.async (fun () -> restart_on_change "slirp/mtu" string_of_int mtus);
+    let mtu = Active_config.hd mtus in
+
+    Log.info (fun f -> f "Creating slirp server pcap_settings:%s peer_ip:%s local_ip:%s domain_search:%s mtu:%d"
+                 (print_pcap @@ Active_config.hd pcap_settings)
+                 (Ipaddr.V4.to_string peer_ip) (Ipaddr.V4.to_string local_ip)
+                 (String.concat " " !domain_search) mtu
              );
     let t = {
       peer_ip;
@@ -946,11 +957,12 @@ module Make(Config: Active_config.S)(Vmnet: Sig.VMNET)(Dns_policy: Sig.DNS_POLIC
       get_domain_search;
       get_domain_name;
       pcap_settings;
+      mtu;
     } in
     Lwt.return t
 
   let connect t client =
-    or_failwith_result "vmnet" @@ Vmnet.of_fd ~client_macaddr ~server_macaddr client
+    or_failwith_result "vmnet" @@ Vmnet.of_fd ~client_macaddr ~server_macaddr ~mtu:t.mtu client
     >>= fun x ->
     Log.debug (fun f -> f "accepted vmnet connection");
 

src/hostnet/slirp.mli

@@ -11,6 +11,7 @@ type config = {
   get_domain_search: unit -> string list;
   get_domain_name: unit -> string;
   pcap_settings: pcap Active_config.values;
+  mtu: int;
 }
 (** A slirp TCP/IP stack ready to accept connections *)
 

src/hostnet/vmnet.ml

@@ -18,8 +18,6 @@ let log_exception_continue description f =
        Lwt.return ()
     )
 
-let default_mtu = 1500
-
 let ethernet_header_length = 14 (* no VLAN *)
 
 module Init = struct
@@ -121,8 +119,7 @@ module Vif = struct
 
   let to_string t = Sexplib.Sexp.to_string (sexp_of_t t)
 
-  let create client_macaddr () =
-    let mtu = default_mtu in
+  let create client_macaddr mtu () =
     let max_packet_size = 1550 in
     { mtu; max_packet_size; client_macaddr }
 
@@ -178,6 +175,7 @@ type t = {
   stats: stats;
   client_macaddr: Macaddr.t;
   server_macaddr: Macaddr.t;
+  mtu: int;
   mutable write_header: Cstruct.t;
   write_m: Lwt_mutex.t;
   mutable pcap: Unix.file_descr option;
@@ -219,7 +217,7 @@ let server_negotiate t =
       Lwt.return (Command.unmarshal buf)
       >>= fun (command, _) ->
       Log.debug (fun f -> f "PPP.negotiate: received %s" (Command.to_string command));
-      let vif = Vif.create t.client_macaddr () in
+      let vif = Vif.create t.client_macaddr t.mtu () in
       let buf = Cstruct.create Vif.sizeof in
       let (_: Cstruct.t) = Vif.marshal vif buf in
       let open Lwt.Infix in
@@ -315,7 +313,7 @@ let stop_capture t =
       stop_capture_already_locked t
     )
 
-let make ~client_macaddr ~server_macaddr fd =
+let make ~client_macaddr ~server_macaddr ~mtu fd =
   let fd = Some fd in
   let stats = { rx_bytes = 0L; rx_pkts = 0l; tx_bytes = 0L; tx_pkts = 0l } in
   let write_header = Cstruct.create (1024 * Packet.sizeof) in
@@ -326,23 +324,23 @@ let make ~client_macaddr ~server_macaddr fd =
   let listeners = [] in
   let listening = false in
   let after_disconnect, after_disconnect_u = Lwt.task () in
-  { fd; stats; client_macaddr; server_macaddr; write_header; write_m; pcap;
+  { fd; stats; client_macaddr; server_macaddr; mtu; write_header; write_m; pcap;
     pcap_size_limit; pcap_m; listeners; listening; after_disconnect; after_disconnect_u }
 
 type fd = C.flow
 
-let of_fd ~client_macaddr ~server_macaddr flow =
+let of_fd ~client_macaddr ~server_macaddr ~mtu flow =
   let open Lwt_result.Infix in
   let channel = Channel.create flow in
-  let t = make ~client_macaddr ~server_macaddr channel in
+  let t = make ~client_macaddr ~server_macaddr ~mtu channel in
   server_negotiate t
   >>= fun () ->
   Lwt_result.return t
 
-let client_of_fd ~client_macaddr ~server_macaddr flow =
+let client_of_fd ~client_macaddr ~server_macaddr ~mtu flow =
   let open Lwt_result.Infix in
   let channel = Channel.create flow in
-  let t = make ~client_macaddr ~server_macaddr channel in
+  let t = make ~client_macaddr ~server_macaddr ~mtu channel in
   client_negotiate t
   >>= fun () ->
   Lwt_result.return t
@@ -398,9 +396,9 @@ let writev t bufs =
            capture t bufs
            >>= fun () ->
            let len = List.(fold_left (+) 0 (map Cstruct.len bufs)) in
-           if len > (default_mtu + ethernet_header_length) then begin
+           if len > (t.mtu + ethernet_header_length) then begin
              Log.err (fun f ->
-               f "Dropping over-large ethernet frame, length = %d, mtu = %d" len default_mtu
+               f "Dropping over-large ethernet frame, length = %d, mtu = %d" len t.mtu
              );
              Lwt.return_unit
            end else begin
@@ -488,9 +486,9 @@ let write t buf =
            capture t [ buf ]
            >>= fun () ->
            let len = Cstruct.len buf in
-           if len > (default_mtu + ethernet_header_length) then begin
+           if len > (t.mtu + ethernet_header_length) then begin
              Log.err (fun f ->
-               f "Dropping over-large ethernet frame, length = %d, mtu = %d" len default_mtu
+               f "Dropping over-large ethernet frame, length = %d, mtu = %d" len t.mtu
              );
              Lwt.return_unit
            end else begin

src/hostnet/vmnet.mli

@@ -13,13 +13,13 @@ val after_disconnect: t -> unit Lwt.t
 
 val add_listener: t -> (Cstruct.t -> unit Lwt.t) -> unit
 
-val of_fd: client_macaddr:Macaddr.t -> server_macaddr:Macaddr.t -> C.flow -> t Error.t
-(** [of_fd ~client_macaddr ~server_macaddr fd] negotiates with the client over
+val of_fd: client_macaddr:Macaddr.t -> server_macaddr:Macaddr.t -> mtu:int -> C.flow -> t Error.t
+(** [of_fd ~client_macaddr ~server_macaddr ~mtu fd] negotiates with the client over
     [fd]. The client uses [client_macaddr] as the source address of all its ethernet
     frames. The server uses [server_macaddr] as the source address of all its
-    ethernet frames. *)
+    ethernet frames and sets the MTU to [mtu]. *)
 
-val client_of_fd: client_macaddr:Macaddr.t -> server_macaddr:Macaddr.t -> C.flow -> t Error.t
+val client_of_fd: client_macaddr:Macaddr.t -> server_macaddr:Macaddr.t -> mtu:int -> C.flow -> t Error.t
 
 val start_capture: t -> ?size_limit:int64 -> string -> unit Lwt.t
 (** [start_capture t ?size_limit filename] closes any existing pcap capture