From 6b3df70da43d26c7a04990849b795127cd161458 Mon Sep 17 00:00:00 2001
From: Prashanth Mundkur <prashanth.mundkur@citrix.com>
Date: Thu, 14 May 2009 09:20:29 -0700
Subject: [PATCH] better error handling; clarify a callback name

---
 libs/stdext/eventloop.ml  | 33 ++++++++++++++++++++++++---------
 libs/stdext/eventloop.mli |  3 ++-
 2 files changed, 26 insertions(+), 10 deletions(-)

diff --git a/libs/stdext/eventloop.ml b/libs/stdext/eventloop.ml
index 0dfba07..aa84b5f 100644
--- a/libs/stdext/eventloop.ml
+++ b/libs/stdext/eventloop.ml
@@ -109,7 +109,7 @@ type conn_callbacks =
 	connect_callback : t -> handle -> unit;
 	recv_callback : t -> handle -> string -> (* offset *) int -> (* length *) int -> unit;
 	send_done_callback : t -> handle -> unit;
-	closed_callback : t -> handle -> unit;
+	shutdown_callback : t -> handle -> unit;
 	error_callback : t -> handle -> error -> unit;
 }
 
@@ -162,6 +162,8 @@ let remove_conn t handle =
 	Unixext.Fdset.clear t.writers handle;
 	t.conns <- ConnMap.remove handle t.conns
 
+let get_fd t handle = handle
+
 let connect t handle addr =
 	let conn_state = ConnMap.find handle t.conns in
 	conn_state.status <- Connecting;
@@ -248,13 +250,15 @@ let dispatch_read t fd cs =
 		 | Unix.Unix_error (Unix.ECONNABORTED, _, _)
 		 | Unix.Unix_error (Unix.EINTR, _, _)
 		   -> ()
+		 | Unix.Unix_error (ec, f, s) ->
+			cs.callbacks.error_callback t fd (ec, f, s)
 		)
 	| Connected ->
 		if cs.recv_enabled then
 			try
 				let read_bytes = Unix.read fd buf 0 buflen in
 				if read_bytes = 0 then
-					cs.callbacks.closed_callback t fd
+					cs.callbacks.shutdown_callback t fd
 				else
 					cs.callbacks.recv_callback t fd buf 0 read_bytes
 			with
@@ -262,16 +266,27 @@ let dispatch_read t fd cs =
 			| Unix.Unix_error (Unix.EAGAIN, _, _)
 			| Unix.Unix_error (Unix.EINTR, _, _) ->
 				()
+			| Unix.Unix_error (ec, f, s) ->
+				cs.callbacks.error_callback t fd (ec, f, s)
 		else
 			Unixext.Fdset.clear t.readers fd
-let do_send fd cs =
+let do_send t fd cs =
 	let payload = Buffer.contents cs.send_buf in
 	let payload_len = String.length payload in
-	match Unix.write fd payload 0 payload_len with
-	| 0 -> ()
-	| sent ->
-		Buffer.clear cs.send_buf;
-		Buffer.add_substring cs.send_buf payload sent (payload_len - sent)
+	try
+		(match Unix.write fd payload 0 payload_len with
+		 | 0 -> ()
+		 | sent ->
+			Buffer.clear cs.send_buf;
+			Buffer.add_substring cs.send_buf payload sent (payload_len - sent)
+		)
+	with
+	| Unix.Unix_error (Unix.EWOULDBLOCK, _, _)
+	| Unix.Unix_error (Unix.EAGAIN, _, _)
+	| Unix.Unix_error (Unix.EINTR, _, _) ->
+		()
+	| Unix.Unix_error (ec, f, s) ->
+		cs.callbacks.error_callback t fd (ec, f, s)
 
 let dispatch_write t fd cs =
 	match cs.status with
@@ -294,7 +309,7 @@ let dispatch_write t fd cs =
 		   writes, we disable the write watch.  *)
 		Unixext.Fdset.clear t.writers fd
 	| Connected ->
-		do_send fd cs;
+		do_send t fd cs;
 		if Buffer.length cs.send_buf = 0 then begin
 			if cs.send_done_enabled then
 				cs.callbacks.send_done_callback t fd;
diff --git a/libs/stdext/eventloop.mli b/libs/stdext/eventloop.mli
index 9b5a07a..46c5665 100644
--- a/libs/stdext/eventloop.mli
+++ b/libs/stdext/eventloop.mli
@@ -29,13 +29,14 @@ type conn_callbacks =
 	connect_callback : t -> handle -> unit;
 	recv_callback : t -> handle -> string -> (* offset *) int -> (* length *) int -> unit;
 	send_done_callback : t -> handle -> unit;
-	closed_callback : t -> handle -> unit;
+	shutdown_callback : t -> handle -> unit;
 	error_callback : t -> handle -> error -> unit;
 }
 
 (* 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
+val get_fd : t -> handle -> Unix.file_descr
 
 val connect : t -> handle -> Unix.sockaddr -> unit
 val listen : t -> handle -> unit
-- 
2.39.5