From: Prashanth Mundkur <prashanth.mundkur@citrix.com>
Date: Thu, 4 Jun 2009 07:19:41 +0000 (-0700)
Subject: Allow eventloop callbacks to be modified; expose a compare function on the handle.
X-Git-Url: http://xenbits.xensource.com/gitweb?a=commitdiff_plain;h=3c355c4f986f26c63bd6d0d70617807b24d59212;p=xenclient%2Ftoolstack.git

Allow eventloop callbacks to be modified; expose a compare function on the handle.
---

diff --git a/libs/stdext/eventloop.ml b/libs/stdext/eventloop.ml
index aa84b5f..9c68fc8 100644
--- a/libs/stdext/eventloop.ml
+++ b/libs/stdext/eventloop.ml
@@ -98,6 +98,8 @@ type error = Unix.error * string * string
 
 type handle = Unix.file_descr
 
+let handle_compare = compare
+
 type conn_status =
 	| Connecting
 	| Listening
@@ -115,7 +117,7 @@ type conn_callbacks =
 
 and conn_state =
 {
-	callbacks : conn_callbacks;
+	mutable callbacks : conn_callbacks;
 	mutable status : conn_status;
 	mutable send_done_enabled : bool;
 	mutable recv_enabled : bool;
@@ -213,6 +215,10 @@ let has_pending_send t handle =
 	let conn_state = ConnMap.find handle t.conns in
 	Buffer.length conn_state.send_buf > 0
 
+let set_callbacks t handle callbacks =
+	let conn_state = ConnMap.find handle t.conns in
+	conn_state.callbacks <- callbacks
+
 (* timers *)
 
 type timer = Timers.handle
@@ -311,9 +317,9 @@ let dispatch_write t fd cs =
 	| Connected ->
 		do_send t fd cs;
 		if Buffer.length cs.send_buf = 0 then begin
+			Unixext.Fdset.clear t.writers fd;
 			if cs.send_done_enabled then
-				cs.callbacks.send_done_callback t fd;
-			Unixext.Fdset.clear t.writers fd
+				cs.callbacks.send_done_callback t fd
 		end
 
 let dispatch_timers t current_time =
diff --git a/libs/stdext/eventloop.mli b/libs/stdext/eventloop.mli
index 46c5665..0bf9256 100644
--- a/libs/stdext/eventloop.mli
+++ b/libs/stdext/eventloop.mli
@@ -33,6 +33,9 @@ type conn_callbacks =
 	error_callback : t -> handle -> error -> unit;
 }
 
+(* this is to allow collections indexed by connection handles. *)
+val handle_compare : handle -> handle -> int
+
 (* by default, connections are disabled for the send_done callback, and enabled for all others. *)
 val register_conn : t -> Unix.file_descr -> ?enable_send_done:bool -> ?enable_recv:bool -> conn_callbacks -> handle
 val remove_conn : t -> handle -> unit
@@ -50,6 +53,8 @@ val disable_recv : t -> handle -> unit
 val send : t -> handle -> string -> unit
 val has_pending_send : t -> handle -> bool
 
+val set_callbacks : t -> handle -> conn_callbacks -> unit
+
 (* timers *)
 
 type timer