use debug module that can be dynamically activated and redirected instead of printf.

diff --git a/common/dbus_server.ml b/common/dbus_server.ml
index fcabbdf9175d88ca5526ae903af60167ca6664a2..9ec7e7b0e7515721559c6dd1b0e7da80290ef36b 100644 (file)
--- a/common/dbus_server.ml
+++ b/common/dbus_server.ml
@@ -15,18 +15,21 @@
 
 open Stringext
 
+module D=Debug.Debugger(struct let name="dbus-server" end)
+open D
+
 (* Utilities *)
 
 let dump_msg m =
-       Opt.iter (fun s -> Printf.printf " Sender: %s\n" s) (DBus.Message.get_sender m);
-       Opt.iter (fun s -> Printf.printf " Destination: %s\n" s) (DBus.Message.get_destination m);
-       Opt.iter (fun s -> Printf.printf " Path: %s\n" s) (DBus.Message.get_path m);
-       Opt.iter (fun s -> Printf.printf " Interface: %s\n" s) (DBus.Message.get_interface m);
-       Opt.iter (fun s -> Printf.printf " Member: %s\n" s) (DBus.Message.get_member m);
+       Opt.iter (fun s -> debug " Sender: %s" s) (DBus.Message.get_sender m);
+       Opt.iter (fun s -> debug " Destination: %s" s) (DBus.Message.get_destination m);
+       Opt.iter (fun s -> debug " Path: %s" s) (DBus.Message.get_path m);
+       Opt.iter (fun s -> debug " Interface: %s" s) (DBus.Message.get_interface m);
+       Opt.iter (fun s -> debug " Member: %s" s) (DBus.Message.get_member m);
        List.iter (fun arg ->
-                       Printf.printf " Arg: %s\n" (DBus.string_of_ty arg)
+                       debug " Arg: %s" (DBus.string_of_ty arg)
                  ) (DBus.Message.get m);
-       Printf.printf "%!"
+       ()
 
 (* Connection *)
 
@@ -42,7 +45,7 @@ module PendingCalls = Map.Make (struct type t = int32 let compare = compare end)
 let pending_calls = ref (PendingCalls.empty : (resp_handler PendingCalls.t))
 
 let send_request msg resp_handler =
-       Printf.printf "Sending request...\n%!";
+       debug "Sending request...";
        dump_msg msg;
        let serial = Dbus_conn.send (Opt.unbox !dbus_conn_ref) msg in
        pending_calls := PendingCalls.add serial resp_handler !pending_calls
@@ -61,12 +64,12 @@ let dispatch_response resp =
 
 let send_error req err_name err_msg =
        let err_msg = DBus.Message.new_error req err_name err_msg in
-       Printf.printf "Sending error message...\n%!";
+       info "Sending error message...";
        dump_msg err_msg;
        ignore (Dbus_conn.send (Opt.unbox !dbus_conn_ref) err_msg)
 
 let send_msg msg =
-       Printf.printf "Sending message...\n%!";
+       info "Sending message...";
        dump_msg msg;
        ignore (Dbus_conn.send (Opt.unbox !dbus_conn_ref) msg)
 
@@ -136,12 +139,12 @@ type node =
 let apis = ref ([] : ((* node name *) string * node) list)
 
 let register_node name node =
-       Printf.printf "Registering node \"%s\" ...\n%!" name;
+       debug "Registering node \"%s\" ...\n%!" name;
        apis := (name, node) :: !apis
 
 let remove_node name =
        (* Remove child nodes as well. *)
-       Printf.printf "Removing node \"%s\" and its children...\n%!" name;
+       debug "Removing node \"%s\" and its children...\n%!" name;
        apis := List.filter (fun (n, _) -> not (String.startswith name n)) !apis
 
 let dispatch_get req node prop =
@@ -247,7 +250,7 @@ let dispatch_interface req node interface m =
                    with Not_found -> None) in
        match meth with
        | None ->
-               Printf.printf "Unknown method \"%s\" ...\n%!" m;
+               warn "Unknown method \"%s\" ...\n%!" m;
                send_unknown_method ()
        | Some m ->
                (match m req (DBus.Message.get req) with
@@ -269,12 +272,12 @@ let dispatch_api req n i m =
        in
        match opt_node, i, opt_interface with
        | None, _, _ ->
-               Printf.printf "Unknown node \"%s\" ...\n%!" n;
+               warn "Unknown node %S ..." n;
                send_unknown_node_error ()
        | Some node, "org.freedesktop.DBus.Properties", _ ->
                dispatch_property_interface req node m
        | _, _, None ->
-               Printf.printf "Unknown interface \"%s\" for node \"%s\"...\n%!" i n;
+               warn "Unknown interface %S for node %S..." i n;
                send_invalid_interface_error ()
        | Some node, _, Some interface ->
                dispatch_interface req node interface m
@@ -285,13 +288,13 @@ let dispatch_request msg =
        let meth = DBus.Message.get_member msg in
        match node, intf, meth with
        |      _,      _,   None ->
-               Printf.printf "Missing method\n%!";
+               warn "Missing method";
                send_error msg DBus.ERR_INVALID_ARGS "Missing method"
        |      _,   None,      _ ->
-               Printf.printf "Missing interface\n%!";
+               warn "Missing interface";
                send_error msg DBus.ERR_INVALID_ARGS "Missing interface"
        |   None,      _,      _ ->
-               Printf.printf "Missing object\n%!";
+               warn "Missing object";
                send_error msg DBus.ERR_INVALID_ARGS "Missing object"
        | Some n, Some i, Some m ->
                dispatch_api msg n i m
@@ -299,10 +302,10 @@ let dispatch_request msg =
 (* Incoming callbacks from connection *)
 
 let error_callback conn err =
-       Printf.printf "Received error.\n%!"
+       warn "Received error."
 
 let msg_received_callback conn m =
-       Printf.printf "Received %s:\n" (DBus.Message.string_of_message_ty (DBus.Message.get_type m));
+       warn "Received %s:" (DBus.Message.string_of_message_ty (DBus.Message.get_type m));
        dump_msg m;
        (match DBus.Message.get_type m with
         | DBus.Message.Invalid       -> ()