add Eventloop.t as arg to callbacks

diff --git a/libs/stdext/eventloop.ml b/libs/stdext/eventloop.ml
index af483b700f5a23db81a0f4fb070557b2d52affae..0dfba075bacdfbcf644ba97a98a24116f740782d 100644 (file)
--- a/libs/stdext/eventloop.ml
+++ b/libs/stdext/eventloop.ml
@@ -19,35 +19,6 @@ let dbg fmt =
        let logger s = if !verbose then Printf.printf "%s\n" s in
        Printf.ksprintf logger fmt
 
-type error = Unix.error * string * string
-
-type handle = Unix.file_descr
-
-type conn_callbacks =
-{
-       accept_callback : handle -> Unix.file_descr -> Unix.sockaddr -> unit;
-       connect_callback : handle -> unit;
-       recv_callback : handle -> string -> (* offset *) int -> (* length *) int -> unit;
-       send_done_callback : handle -> unit;
-       closed_callback : handle -> unit;
-       error_callback : handle -> error -> unit;
-}
-
-type conn_status =
-       | Connecting
-       | Listening
-       | Connected
-
-type conn_state =
-{
-       callbacks : conn_callbacks;
-       mutable status : conn_status;
-       mutable send_done_enabled : bool;
-       mutable recv_enabled : bool;
-
-       send_buf : Buffer.t;
-}
-
 module ConnMap = Map.Make (struct type t = Unix.file_descr let compare = compare end)
 
 (* A module that supports finding a timer by handle as well as by expiry time. *)
@@ -123,7 +94,36 @@ type timer_callbacks =
        expiry_callback : unit -> unit
 }
 
-type t =
+type error = Unix.error * string * string
+
+type handle = Unix.file_descr
+
+type conn_status =
+       | Connecting
+       | Listening
+       | Connected
+
+type conn_callbacks =
+{
+       accept_callback : t -> handle -> Unix.file_descr -> Unix.sockaddr -> unit;
+       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;
+       error_callback : t -> handle -> error -> unit;
+}
+
+and conn_state =
+{
+       callbacks : conn_callbacks;
+       mutable status : conn_status;
+       mutable send_done_enabled : bool;
+       mutable recv_enabled : bool;
+
+       send_buf : Buffer.t;
+}
+
+and t =
 {
        mutable conns: conn_state ConnMap.t;
        mutable timers: timer_callbacks Timers.t;
@@ -168,13 +168,13 @@ let connect t handle addr =
        try
                Unix.connect handle addr;
                conn_state.status <- Connected;         
-               conn_state.callbacks.connect_callback handle
+               conn_state.callbacks.connect_callback t handle
        with
        | Unix.Unix_error (Unix.EINPROGRESS, _, _) ->
                Unixext.Fdset.set t.readers handle;
                Unixext.Fdset.set t.writers handle
        | Unix.Unix_error (ec, f, s) ->
-               conn_state.callbacks.error_callback handle (ec, f, s)
+               conn_state.callbacks.error_callback t handle (ec, f, s)
 
 let listen t handle =
        let conn_state = ConnMap.find handle t.conns in
@@ -235,14 +235,14 @@ let dispatch_read t fd cs =
                        cs.status <- Connected;
                        if not cs.recv_enabled then
                                Unixext.Fdset.clear t.readers fd;
-                       cs.callbacks.connect_callback fd
+                       cs.callbacks.connect_callback t fd
                | Some err ->
-                       cs.callbacks.error_callback fd (err, "connect", "")
+                       cs.callbacks.error_callback t fd (err, "connect", "")
                )
        | Listening ->
                (try
                        let afd, aaddr = Unix.accept fd in
-                       cs.callbacks.accept_callback fd afd aaddr
+                       cs.callbacks.accept_callback t fd afd aaddr
                 with
                 | Unix.Unix_error (Unix.EWOULDBLOCK, _, _)
                 | Unix.Unix_error (Unix.ECONNABORTED, _, _)
@@ -254,9 +254,9 @@ let dispatch_read t fd cs =
                        try
                                let read_bytes = Unix.read fd buf 0 buflen in
                                if read_bytes = 0 then
-                                       cs.callbacks.closed_callback fd
+                                       cs.callbacks.closed_callback t fd
                                else
-                                       cs.callbacks.recv_callback fd buf 0 read_bytes
+                                       cs.callbacks.recv_callback t fd buf 0 read_bytes
                        with
                        | Unix.Unix_error (Unix.EWOULDBLOCK, _, _)
                        | Unix.Unix_error (Unix.EAGAIN, _, _)
@@ -283,9 +283,9 @@ let dispatch_write t fd cs =
                                Unixext.Fdset.set t.readers fd
                        else
                                Unixext.Fdset.clear t.readers fd;
-                       cs.callbacks.connect_callback fd
+                       cs.callbacks.connect_callback t fd
                | Some err ->
-                       cs.callbacks.error_callback fd (err, "connect", "")
+                       cs.callbacks.error_callback t fd (err, "connect", "")
                )
        | Listening ->
                (* This should never happen, since listening sockets
@@ -297,7 +297,7 @@ let dispatch_write t fd cs =
                do_send fd cs;
                if Buffer.length cs.send_buf = 0 then begin
                        if cs.send_done_enabled then
-                               cs.callbacks.send_done_callback fd;
+                               cs.callbacks.send_done_callback t fd;
                        Unixext.Fdset.clear t.writers fd
                end
 

diff --git a/libs/stdext/eventloop.mli b/libs/stdext/eventloop.mli
index 3a182f7cf81f556a28dafcd5c8a64c2b2558382d..9b5a07aadce91a513c752a834ac834649658fa47 100644 (file)
--- a/libs/stdext/eventloop.mli
+++ b/libs/stdext/eventloop.mli
@@ -25,12 +25,12 @@ type error = Unix.error * string * string
 
 type conn_callbacks =
 {
-       accept_callback : handle -> Unix.file_descr -> Unix.sockaddr -> unit;
-       connect_callback : handle -> unit;
-       recv_callback : handle -> string -> (* offset *) int -> (* length *) int -> unit;
-       send_done_callback : handle -> unit;
-       closed_callback : handle -> unit;
-       error_callback : handle -> error -> unit;
+       accept_callback : t -> handle -> Unix.file_descr -> Unix.sockaddr -> unit;
+       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;
+       error_callback : t -> handle -> error -> unit;
 }
 
 (* by default, connections are disabled for the send_done callback, and enabled for all others. *)