Ensure that old client has quit before adding new one

Not sure if this can happen, but it removes a TODO from the code.

client_eth.ml

@@ -2,12 +2,14 @@
    See the README file for details. *)
 
 open Utils
+open Lwt.Infix
 
 let src = Logs.Src.create "client_eth" ~doc:"Ethernet networks for NetVM clients"
 module Log = (val Logs.src_log src : Logs.LOG)
 
 type t = {
   mutable iface_of_ip : client_link IpMap.t;
+  changed : unit Lwt_condition.t;   (* Fires when [iface_of_ip] changes. *)
   client_gw : Ipaddr.V4.t;  (* The IP that clients are given as their default gateway. *)
 }
 
@@ -17,20 +19,32 @@ type host =
   | `External of Ipaddr.t ]
 
 let create ~client_gw =
-  { iface_of_ip = IpMap.empty; client_gw }
+  let changed = Lwt_condition.create () in
+  { iface_of_ip = IpMap.empty; client_gw; changed }
 
 let client_gw t = t.client_gw
 
 let add_client t iface =
   let ip = iface#other_ip in
-  (* TODO: Should probably wait for the previous client to disappear. *)
-  (* assert (not (IpMap.mem ip t.iface_of_ip)); *)
-  t.iface_of_ip <- t.iface_of_ip |> IpMap.add ip iface
+  let rec aux () =
+    if IpMap.mem ip t.iface_of_ip then (
+      (* Wait for old client to disappear before adding one with the same IP address.
+         Otherwise, its [remove_client] call will remove the new client instead. *)
+      Log.info (fun f -> f "Waiting for old client %a to go away before accepting new one" Ipaddr.V4.pp_hum ip);
+      Lwt_condition.wait t.changed >>= aux
+    ) else (
+      t.iface_of_ip <- t.iface_of_ip |> IpMap.add ip iface;
+      Lwt_condition.broadcast t.changed ();
+      Lwt.return_unit
+    )
+  in
+  aux ()
 
 let remove_client t iface =
   let ip = iface#other_ip in
   assert (IpMap.mem ip t.iface_of_ip);
-  t.iface_of_ip <- t.iface_of_ip |> IpMap.remove ip
+  t.iface_of_ip <- t.iface_of_ip |> IpMap.remove ip;
+  Lwt_condition.broadcast t.changed ()
 
 let lookup t ip = IpMap.find ip t.iface_of_ip
 

client_eth.mli

@@ -21,7 +21,10 @@ val create : client_gw:Ipaddr.V4.t -> t
 (** [create ~client_gw] is a network of client machines.
     Qubes will have configured the client machines to use [client_gw] as their default gateway. *)
 
-val add_client : t -> client_link -> unit
+val add_client : t -> client_link -> unit Lwt.t
+(** [add_client t client] registers a new client. If a client with this IP address is already registered,
+    it waits for [remove_client] to be called on that before adding the new client and returning. *)
+
 val remove_client : t -> client_link -> unit
 
 val client_gw : t -> Ipaddr.V4.t

client_net.ml

@@ -50,7 +50,7 @@ let add_vif { Dao.domid; device_id; client_ip } ~router ~cleanup_tasks =
   let client_eth = router.Router.client_eth in
   let gateway_ip = Client_eth.client_gw client_eth in
   let iface = new client_iface eth ~gateway_ip ~client_ip client_mac in
-  Router.add_client router iface;
+  Router.add_client router iface >>= fun () ->
   Cleanup.on_cleanup cleanup_tasks (fun () -> Router.remove_client router iface);
   let fixed_arp = Client_eth.ARP.create ~net:client_eth iface in
   Netback.listen backend (fun frame ->

router.mli

@@ -22,9 +22,8 @@ val create :
 val target : t -> Cstruct.t -> interface option
 (** [target t packet] is the interface to which [packet] (an IP packet) should be routed. *)
 
-val add_client : t -> client_link -> unit
-(** [add_client t iface] adds a rule for routing packets addressed to [iface].
-    The client's IP address must be within the [client_eth] passed to [create]. *)
+val add_client : t -> client_link -> unit Lwt.t
+(** [add_client t iface] adds a rule for routing packets addressed to [iface]. *)
 
 val remove_client : t -> client_link -> unit