Fixed race in socket removal and event dispatch in eventloop.

diff --git a/libs/stdext/eventloop.ml b/libs/stdext/eventloop.ml
index ff32fabf4986ecce75e1124a984be60a174a355b..47944ec12772763b15d8a682f64e6acb8968bfad 100644 (file)
--- a/libs/stdext/eventloop.ml
+++ b/libs/stdext/eventloop.ml
@@ -138,6 +138,9 @@ and t =
        readers: Unixext.Fdset.t;
        writers: Unixext.Fdset.t;
        excepts: Unixext.Fdset.t;
+       (* dispatch state *)
+       mutable d_readers: Unixext.Fdset.t;
+       mutable d_writers: Unixext.Fdset.t;
 }
 
 let create () =
@@ -146,6 +149,8 @@ let create () =
        readers = Unixext.Fdset.create ();
        writers = Unixext.Fdset.create ();
        excepts = Unixext.Fdset.create ();
+       d_readers = Unixext.Fdset.create ();
+       d_writers = Unixext.Fdset.create ();
 }
 
 let num_connections t =
@@ -174,6 +179,10 @@ let register_conn t fd ?(enable_send_done=false) ?(enable_recv=true) callbacks =
 let remove_conn t handle =
        Unixext.Fdset.clear t.readers handle;
        Unixext.Fdset.clear t.writers handle;
+       (* Also remove this handle from the set we might be
+          dispatching over. *)
+       Unixext.Fdset.clear t.d_readers handle;
+       Unixext.Fdset.clear t.d_writers handle;
        t.conns <- ConnMap.remove handle t.conns
 
 let get_fd t handle = handle
@@ -183,7 +192,7 @@ let connect t handle addr =
        conn_state.status <- Connecting;
        try
                Unix.connect handle addr;
-               conn_state.status <- Connected;         
+               conn_state.status <- Connected;
                conn_state.callbacks.connect_callback t handle
        with
        | Unix.Unix_error (Unix.EINPROGRESS, _, _) ->
@@ -372,10 +381,13 @@ let dispatch t interval =
        in
        (match events with
         | Some (r, w, _) ->
+               (* Store dispatch set for remove_conn. *)
+               t.d_readers <- r;
+               t.d_writers <- w;
                ConnMap.iter (fun fd cs ->
-                               if Unixext.Fdset.is_set r fd then
+                               if Unixext.Fdset.is_set t.d_readers fd then
                                        dispatch_read t fd cs;
-                               if Unixext.Fdset.is_set w fd then
+                               if Unixext.Fdset.is_set t.d_writers fd then
                                        dispatch_write t fd cs
                             ) t.conns
         | None -> ()