better error handling; clarify a callback name

diff --git a/libs/stdext/eventloop.ml b/libs/stdext/eventloop.ml
index 0dfba075bacdfbcf644ba97a98a24116f740782d..aa84b5f85df88edd9b7376748c94cec00e20e7ae 100644 (file)
--- 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 9b5a07aadce91a513c752a834ac834649658fa47..46c5665151ac5b3e58da7faa2f713aa3743dfb14 100644 (file)
--- 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