Permalink
Browse files

Add more per-connection low-level debugging

  • Loading branch information...
1 parent 5c6feb5 commit 215980e52c997b0cc3f83061837f843829ff5396 David Scott committed Apr 1, 2013
Showing with 15 additions and 2 deletions.
  1. +3 −0 core/xs_protocol.ml
  2. +1 −0 core/xs_protocol.mli
  3. +11 −2 server/xs_server.ml
View
@@ -139,6 +139,9 @@ type t = {
data: Buffer.t;
}
+let to_debug_string pkt =
+ Printf.sprintf "ty=%s tid=%ld rid=%ld data(%d)=%s" (Op.to_string pkt.ty) pkt.tid pkt.rid pkt.len (Buffer.contents pkt.data)
+
cstruct header {
uint32_t ty;
uint32_t rid;
View
@@ -105,6 +105,7 @@ module PacketStream : functor(IO: IO) -> sig
end
val to_string : t -> string
+val to_debug_string : t -> string
val get_tid : t -> int32
val get_ty : t -> Op.t
val get_data : t -> string
View
@@ -66,6 +66,7 @@ module Server = functor(T: TRANSPORT) -> struct
let flush_watch_events q =
Lwt_list.iter_s
(fun (path, token) ->
+ debug "%s flush path=%s token=%s" (Xs_protocol.string_of_address address) path token;
PS.send channel (Xs_protocol.(Response.(print (Watchevent(path, token)) 0l 0l)))
) q in
let (background_watch_event_flusher: unit Lwt.t) =
@@ -75,7 +76,11 @@ module Server = functor(T: TRANSPORT) -> struct
lwt () = while_lwt Queue.length c.Connection.watch_events = 0 do
Lwt_condition.wait ~mutex:m c.Connection.cvar
done in
- flush_watch_events (take_watch_events ())
+ let events = take_watch_events () in
+ debug "%s start background watch flush" (Xs_protocol.string_of_address address);
+ lwt () = flush_watch_events events in
+ debug "%s stop background watch flush" (Xs_protocol.string_of_address address);
+ return ()
)
done in
@@ -85,6 +90,7 @@ module Server = functor(T: TRANSPORT) -> struct
lwt request = match_lwt (PS.recv channel) with
| Ok x -> return x
| Exception e -> raise_lwt e in
+ debug "%s received %s" (Xs_protocol.string_of_address address) (Xs_protocol.to_debug_string request);
Lwt_mutex.with_lock m
(fun () ->
(* A side-effect of processing a Watch request is that other parallel
@@ -99,9 +105,12 @@ module Server = functor(T: TRANSPORT) -> struct
let reply = Call.reply store c request in
(* New watch events can be generated but not flushed because we hold m *)
+ debug "%s reply generated" (Xs_protocol.string_of_address address);
lwt () = flush_watch_events events in
- PS.send channel reply
+ lwt () = PS.send channel reply in
+ debug "%s sent %s" (Xs_protocol.string_of_address address) (Xs_protocol.to_debug_string reply);
+ return ()
)
done in
T.destroy t

0 comments on commit 215980e

Please sign in to comment.