diff --git a/CHANGES.md b/CHANGES.md index 9f2260f45b..140dc07304 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,6 @@ ## current +- lwt, lwt_unix: Improve use of logs and the documentation, fix bug in the Debug.enable_debug function (mseri #772) - lwt_jsoo: Fix exception on connection errors in chrome (mefyl #761) - lwt_jsoo: Fix `Lwt.wakeup_exn` `Invalid_arg` exception when a js stack overflow happens in the XHR completion handler (mefyl #762). diff --git a/README.md b/README.md index 733453f128..396ece959f 100644 --- a/README.md +++ b/README.md @@ -404,9 +404,19 @@ folder in the sources ## Debugging -You can activate some runtime debugging for the servers by setting `COHTTP_DEBUG` to any value different from `0` or `false`, and it will set a default debug-level logger on stdout. Note: If you turn on the debugging on the `cohttp-lwt-server` example, you need to make sure you also pass the `-vvv` option, which forces the debug level of the logger. +You can activate some runtime debugging for the servers by setting `COHTTP_DEBUG` to any value different from `0` or `false`, and it will set a default debug-level logger on stdout. -Since both Cohttp and Conduit use `Logs` for debugging output, you can enable custom debugging in your code (if needed) by adding something like the following to your code (courtesy of @dinosaure) +Since both Cohttp and Conduit use `Logs` for debugging output, you can enable custom debugging in your code (if needed). For example, if you intend to make use of the `COHTTP_DEBUG` env variable, you could simply use + +```ocaml +let () = + if not @@ Debug.debug_active () then ( + Fmt_tty.setup_std_outputs (); + Logs.set_level ~all:true level; + Logs.set_reporter Debug.default_reporter); +``` + +Of course you are free to completely override it and use your own reporters, for example by adding something like the following to your code (courtesy of @dinosaure). ```ocaml let reporter ppf = diff --git a/cohttp-lwt-unix/bin/cohttp_curl_lwt.ml b/cohttp-lwt-unix/bin/cohttp_curl_lwt.ml index 2ca0785f42..c31dafebdd 100644 --- a/cohttp-lwt-unix/bin/cohttp_curl_lwt.ml +++ b/cohttp-lwt-unix/bin/cohttp_curl_lwt.ml @@ -48,15 +48,12 @@ let client uri ofile meth' = | None -> output_body Lwt_io.stdout | Some fname -> Lwt_io.with_file ~mode:Lwt_io.output fname output_body) -let run_client verbose ofile uri meth = - Lwt_main.run - ( (if verbose then ( - (* activate debug sets the reporter *) - Cohttp_lwt_unix.Debug.activate_debug (); - Log.debug (fun d -> d ">>> Debug active"); - return ()) - else return ()) - >>= fun () -> client uri ofile meth ) +let run_client level ofile uri meth = + if not @@ Debug.debug_active () then ( + Fmt_tty.setup_std_outputs (); + Logs.set_level ~all:true level; + Logs.set_reporter Debug.default_reporter); + Lwt_main.run (client uri ofile meth) open Cmdliner @@ -77,9 +74,7 @@ let meth = let doc = "Set http method" in Arg.(value & opt string "GET" & info [ "X"; "request" ] ~doc) -let verb = - let doc = "Display additional debugging to standard error." in - Arg.(value & flag & info [ "v"; "verbose" ] ~doc) +let verb = Logs_cli.level () let ofile = let doc = "Output filename to store the URI into." in diff --git a/cohttp-lwt-unix/bin/cohttp_proxy_lwt.ml b/cohttp-lwt-unix/bin/cohttp_proxy_lwt.ml index 923b4936f2..9fddad8639 100644 --- a/cohttp-lwt-unix/bin/cohttp_proxy_lwt.ml +++ b/cohttp-lwt-unix/bin/cohttp_proxy_lwt.ml @@ -73,8 +73,12 @@ let start_proxy port host verbose cert key () = in Server.create ~mode config -let lwt_start_proxy port host verbose cert key = - Lwt_main.run (start_proxy port host verbose cert key ()) +let lwt_start_proxy port host level cert key = + if not @@ Debug.debug_active () then ( + Fmt_tty.setup_std_outputs (); + Logs.set_level ~all:true level; + Logs.set_reporter Debug.default_reporter); + Lwt_main.run (start_proxy port host (level <> None) cert key ()) open Cmdliner @@ -86,9 +90,7 @@ let port = let doc = "TCP port to listen on." in Arg.(value & opt int 8080 & info [ "p" ] ~docv:"PORT" ~doc) -let verb = - let doc = "Logging output to console." in - Arg.(value & flag & info [ "v"; "verbose" ] ~doc) +let verb = Logs_cli.level () let ssl_cert = let doc = "SSL certificate file." in diff --git a/cohttp-lwt-unix/bin/cohttp_server_lwt.ml b/cohttp-lwt-unix/bin/cohttp_server_lwt.ml index 944b90c963..b4c2b63b8a 100644 --- a/cohttp-lwt-unix/bin/cohttp_server_lwt.ml +++ b/cohttp-lwt-unix/bin/cohttp_server_lwt.ml @@ -128,11 +128,11 @@ let start_server docroot port host index tls () = let ctx = Cohttp_lwt_unix.Net.init ~ctx () in Server.create ~ctx ~mode config -let lwt_start_server docroot port host index verbose tls = - if verbose <> None then ( - (* activate_debug sets the reporter *) - Cohttp_lwt_unix.Debug.activate_debug (); - Logs.set_level verbose); +let lwt_start_server docroot port host index level tls = + if not @@ Debug.debug_active () then ( + Fmt_tty.setup_std_outputs (); + Logs.set_level ~all:true level; + Logs.set_reporter Debug.default_reporter); Lwt_main.run (start_server docroot port host index tls ()) open Cmdliner diff --git a/cohttp-lwt-unix/bin/dune b/cohttp-lwt-unix/bin/dune index a76a0c4c00..63e95e9032 100644 --- a/cohttp-lwt-unix/bin/dune +++ b/cohttp-lwt-unix/bin/dune @@ -1,6 +1,6 @@ (executables (names cohttp_curl_lwt cohttp_proxy_lwt cohttp_server_lwt) (libraries cohttp-lwt-unix cohttp_server logs logs.lwt logs.fmt logs.cli - cmdliner conduit-lwt) + cmdliner conduit-lwt fmt.tty) (package cohttp-lwt-unix) (public_names cohttp-curl-lwt cohttp-proxy-lwt cohttp-server-lwt)) diff --git a/cohttp-lwt-unix/src/debug.ml b/cohttp-lwt-unix/src/debug.ml index 090f21e359..2d550017ab 100644 --- a/cohttp-lwt-unix/src/debug.ml +++ b/cohttp-lwt-unix/src/debug.ml @@ -19,7 +19,7 @@ let debug_active () = !_debug_active open Lwt.Infix -let default_reporter (file_descr, ppf) = +let reporter file_descr ppf = let ppf, flush = let buf = Buffer.create 0x100 in ( Fmt.with_buffer ~like:ppf buf, @@ -62,18 +62,21 @@ let default_reporter (file_descr, ppf) = in { Logs.report } -let set_log = +let default_reporter = reporter Lwt_unix.stderr Fmt.stderr + +let set_logger = lazy - ((* If no reporter has been set by the application, set default one + (if + (* If no reporter has been set by the application, set default one that prints to stderr *) - if Logs.reporter () == Logs.nop_reporter then - Logs.set_level @@ Some Logs.Debug; - Logs.set_reporter (default_reporter (Lwt_unix.stderr, Fmt.stderr))) + Logs.reporter () == Logs.nop_reporter + then Logs.set_reporter default_reporter) let activate_debug () = - Lazy.force set_log; if not !_debug_active then ( _debug_active := true; + Lazy.force set_logger; + Logs.set_level ~all:true (Some Logs.Debug); Logs.debug (fun f -> f "Cohttp debugging output is active")) let () = diff --git a/cohttp-lwt-unix/src/debug.mli b/cohttp-lwt-unix/src/debug.mli index 1261d2537e..d14e7124d3 100644 --- a/cohttp-lwt-unix/src/debug.mli +++ b/cohttp-lwt-unix/src/debug.mli @@ -16,6 +16,17 @@ (** Debugging output for Cohttp Unix *) +val default_reporter : Logs.reporter +(** [default_reporter] provides a simple reporter that sends the logging output + to stderr. For example, the code below enables logging at level [level] to + stderr, using coloured output if possible. + + {[ + Fmt_tty.setup_std_outputs (); + Logs.set_level ~all:true (Some level); + Logs.set_reporter Debug.default_reporter + ]} *) + val activate_debug : unit -> unit (** [activate_debug] enables debugging output that will be sent to standard error. *) @@ -23,3 +34,19 @@ val activate_debug : unit -> unit val debug_active : unit -> bool (** [debug_active] returns true if [activate_debug] has been called and false otherwise *) + +(** {2 Selectively disable cohttp logging} *) + +(** It is possible to selectively disable cohttp internal logginb by filtering + over the various modules logs names as follows. + + {[ + (* Set log level v for all loggers, this does also affect cohttp internal loggers *) + Logs.set_level ~all:true level; + (* Disable all cohttp-lwt and cohttp-lwt-unix logs *) + List.iter (fun src -> + match Logs.Src.name src with + | "cohttp.lwt.io" | "cohttp.lwt.server" -> Logs.Src.set_level src None + | _ -> ()) + @@ Logs.Src.list () + ]} *) diff --git a/cohttp-lwt-unix/src/io.mli b/cohttp-lwt-unix/src/io.mli index 9b088417e7..2862ac1743 100644 --- a/cohttp-lwt-unix/src/io.mli +++ b/cohttp-lwt-unix/src/io.mli @@ -14,6 +14,11 @@ * }}}*) +(** The [Io] module contains the IO implementation for [cohttp-lwt-unix]. + + The {!Logs} source name for this module logger is ["cohttp.lwt.io"]. Refer + to the {!Debug} module for further details.*) + include Cohttp_lwt.S.IO with type ic = Lwt_io.input_channel diff --git a/cohttp-lwt-unix/src/server.ml b/cohttp-lwt-unix/src/server.ml index ca94d33b62..e33280e0fa 100644 --- a/cohttp-lwt-unix/src/server.ml +++ b/cohttp-lwt-unix/src/server.ml @@ -2,7 +2,8 @@ module Server_core = Cohttp_lwt.Make_server (Io) include Server_core open Lwt.Infix -let src = Logs.Src.create "cohttp.lwt.server" ~doc:"Cohttp Lwt server module" +let src = + Logs.Src.create "cohttp.lwt.server" ~doc:"Cohttp Lwt Unix server module" module Log = (val Logs.src_log src : Logs.LOG) diff --git a/cohttp-lwt-unix/src/server.mli b/cohttp-lwt-unix/src/server.mli index 7fe1641728..37d75150e6 100644 --- a/cohttp-lwt-unix/src/server.mli +++ b/cohttp-lwt-unix/src/server.mli @@ -1,5 +1,8 @@ (** The [Server] module implements the full UNIX HTTP server interface, - including the UNIX-specific functions defined in {!S}. *) + including the UNIX-specific functions defined in {!S}. + + The {!Logs} source name for this module logger is ["cohttp.lwt.server"]. + Refer to the {!Debug} module for further details. *) include Cohttp_lwt.S.Server with module IO = Io diff --git a/cohttp-lwt/src/server.mli b/cohttp-lwt/src/server.mli index bbc46a07ff..781dcd2c4c 100644 --- a/cohttp-lwt/src/server.mli +++ b/cohttp-lwt/src/server.mli @@ -1,4 +1,8 @@ (** The [Make] functor glues together a {!Cohttp.S.IO} implementation to send requests down a connection that is established by the user. The resulting - module satisfies the {!Server} module type. *) + module satisfies the {!Server} module type. + + The {!Logs} source name for this module's logger is ["cohttp.lwt.server"]. + Refer to the {!Debug} module for further details.*) + module Make (IO : S.IO) : S.Server with module IO = IO