Allow switch port timeout to be configured

src/bin/main.ml

@@ -194,7 +194,7 @@ let hvsock_addr_of_uri ~default_serviceid uri =
   let main_t
       socket_url port_control_url introspection_url diagnostics_url
       max_connections vsock_path db_path db_branch dns hosts host_names
-      listen_backlog debug
+      listen_backlog port_max_idle_time debug
     =
     (* Write to stdout if expicitly requested [debug = true] or if the
        environment variable DEBUG is set *)
@@ -304,7 +304,8 @@ let hvsock_addr_of_uri ~default_serviceid uri =
         vnet_switch;
         mtu = 1500;
         host_names;
-        clock }
+        clock;
+        port_max_idle_time }
     in
 
     let config = match db_path with
@@ -374,12 +375,12 @@ let hvsock_addr_of_uri ~default_serviceid uri =
   let main
       socket_url port_control_url introspection_url diagnostics_url
       max_connections vsock_path db_path db_branch dns hosts host_names
-      listen_backlog debug
+      listen_backlog port_max_idle_time debug
     =
     Host.Main.run
       (main_t socket_url port_control_url introspection_url diagnostics_url
          max_connections vsock_path db_path db_branch dns hosts host_names
-         listen_backlog debug)
+         listen_backlog port_max_idle_time debug)
 
 open Cmdliner
 
@@ -501,6 +502,10 @@ let listen_backlog =
              then we will use SOMAXCONN." in
   Arg.(value & opt (some int) None & info [ "listen-backlog" ] ~doc)
 
+let port_max_idle_time =
+  let doc = "Idle time to wait before timing out and disconnecting switch ports." in
+  Arg.(value & opt int 30 & info [ "port-max-idle-time" ] ~doc)
+
 let debug =
   let doc = "Verbose debug logging to stdout" in
   Arg.(value & flag & info [ "debug" ] ~doc)
@@ -515,7 +520,7 @@ let command =
   Term.(pure main
         $ socket $ port_control_path $ introspection_path $ diagnostics_path
         $ max_connections $ vsock_path $ db_path $ db_branch $ dns $ hosts
-        $ host_names $ listen_backlog $ debug),
+        $ host_names $ listen_backlog $ port_max_idle_time $ debug),
   Term.info (Filename.basename Sys.argv.(0)) ~version:Depends.version ~doc ~man
 
 let () =

src/hostnet/slirp.ml

@@ -86,6 +86,7 @@ type ('a, 'b) config = {
   mtu: int;
   host_names: Dns.Name.t list;
   clock: 'a;
+  port_max_idle_time: int;
 }
 
 module Make
@@ -794,30 +795,34 @@ struct
         Lwt.return (Ok ())
   end
 
-  (* If no traffic is received for 5 minutes, delete the endpoint and
+  (* If no traffic is received for `port_max_idle_time`, delete the endpoint and
      the switch port. *)
-  let rec delete_unused_endpoints t () =
-    Host.Time.sleep_ns (Duration.of_sec 30)
-    >>= fun () ->
-    Lwt_mutex.with_lock t.endpoints_m
-      (fun () ->
-         let now = Unix.gettimeofday () in
-         let old_ips = IPMap.fold (fun ip endpoint acc ->
-             let age = now -. endpoint.Endpoint.last_active_time in
-             if age > 300.0 then ip :: acc else acc
-           ) t.endpoints [] in
-         List.iter (fun ip ->
-             Switch.remove t.switch ip;
-             t.endpoints <- IPMap.remove ip t.endpoints
-           ) old_ips;
-         Lwt.return_unit
-      )
-    >>= fun () ->
-    delete_unused_endpoints t ()
+  let rec delete_unused_endpoints t ~port_max_idle_time () =
+    if port_max_idle_time <= 0
+    then Lwt.return_unit (* never delete a port *)
+    else begin
+      Host.Time.sleep_ns (Duration.of_sec 30)
+      >>= fun () ->
+      Lwt_mutex.with_lock t.endpoints_m
+        (fun () ->
+          let now = Unix.gettimeofday () in
+          let old_ips = IPMap.fold (fun ip endpoint acc ->
+              let age = now -. endpoint.Endpoint.last_active_time in
+              if age > (float_of_int port_max_idle_time) then ip :: acc else acc
+            ) t.endpoints [] in
+          List.iter (fun ip ->
+              Switch.remove t.switch ip;
+              t.endpoints <- IPMap.remove ip t.endpoints
+            ) old_ips;
+          Lwt.return_unit
+        )
+      >>= fun () ->
+      delete_unused_endpoints t ~port_max_idle_time ()
+    end
 
   let connect x vnet_switch vnet_client_id client_macaddr server_macaddr peer_ip
       local_ip highest_ip extra_dns_ip mtu get_domain_search get_domain_name
-      (global_arp_table:arp_table) clock
+      (global_arp_table:arp_table) clock port_max_idle_time
     =
 
     let valid_subnets = [ Ipaddr.V4.Prefix.global ] in
@@ -871,7 +876,7 @@ struct
       udp_nat;
       icmp_nat;
     } in
-    Lwt.async @@ delete_unused_endpoints t;
+    Lwt.async @@ delete_unused_endpoints ~port_max_idle_time t;
 
     let find_endpoint ip =
       Lwt_mutex.with_lock t.endpoints_m
@@ -1342,11 +1347,16 @@ struct
         log_exception_continue "monitor http interception settings" (fun () ->
             monitor_http_intercept_settings http_intercept_settings));
 
+    let port_max_idle_time_path = driver @ [ "slirp"; "port-max-idle-time" ] in
+    Config.int config ~default:300 port_max_idle_time_path
+    >>= fun port_max_idle_times ->
+    let port_max_idle_time = Active_config.hd port_max_idle_times in
+
     Log.info (fun f ->
         f "Creating slirp server peer_ip:%s local_ip:%s domain_search:%s \
-           mtu:%d"
+           mtu:%d port_max_idle_time:%d"
           (Ipaddr.V4.to_string peer_ip) (Ipaddr.V4.to_string local_ip)
-          (String.concat " " !domain_search) mtu
+          (String.concat " " !domain_search) mtu port_max_idle_time
       );
 
     let global_arp_table : arp_table = {
@@ -1371,6 +1381,7 @@ struct
       mtu;
       host_names;
       clock;
+      port_max_idle_time;
     } in
     Lwt.return t
 
@@ -1484,7 +1495,7 @@ struct
       connect x t.vnet_switch vnet_client_id client_macaddr t.server_macaddr
         client_ip t.local_ip t.highest_ip t.extra_dns_ip t.mtu
         t.get_domain_search t.get_domain_name t.global_arp_table
-        t.clock
+        t.clock t.port_max_idle_time
     end
 
 end

src/hostnet/slirp.mli

@@ -31,6 +31,7 @@ type ('clock, 'vnet_switch) config = {
   mtu: int;
   host_names: Dns.Name.t list;
   clock: 'clock;
+  port_max_idle_time: int;
 }
 
 module Make

src/hostnet_test/slirp_stack.ml

@@ -169,6 +169,7 @@ let config =
     mtu = 1500;
     host_names = [];
     clock;
+    port_max_idle_time = 300;
   }
 
 (* This is a hacky way to get a hancle to the server side of the stack. *)

src/ofs/active_config.ml

@@ -228,16 +228,18 @@ module Make(Time: Mirage_time_lwt.S)(FLOW: Mirage_flow_lwt.S) = struct
       | Some x -> Lwt.return x
       ) vs
 
+  open Astring
+
   let int t ~default path =
     string t ~default:(string_of_int default) path
     >>= fun strings ->
-    let parse s = Lwt.return (try int_of_string s with _ -> default) in
+    let parse s = Lwt.return (try int_of_string @@ String.trim ~drop:Char.Ascii.is_white s with _ -> default) in
     changes @@ map parse strings
 
   let bool t ~default path =
     string t ~default:(string_of_bool default) path
     >>= fun strings ->
-    let parse s = Lwt.return (try bool_of_string s with _ -> default) in
+    let parse s = Lwt.return (try bool_of_string @@ String.trim ~drop:Char.Ascii.is_white s with _ -> default) in
     changes @@ map parse strings
 
 end