new flag ?enable_logging to disable regular logs (not debug)

Author: c-cube

src/Tiny_httpd.ml

@@ -27,8 +27,8 @@ open struct
     slice.len <- 0
 end
 
-let create ?(masksigpipe = not Sys.win32) ?max_connections ?(timeout = 0.0)
-    ?buf_size ?(get_time_s = Unix.gettimeofday)
+let create ?enable_logging ?(masksigpipe = not Sys.win32) ?max_connections
+    ?(timeout = 0.0) ?buf_size ?(get_time_s = Unix.gettimeofday)
     ?(new_thread = fun f -> ignore (Thread.create f () : Thread.t))
     ?(addr = "127.0.0.1") ?(port = 8080) ?sock ?middlewares () : t =
   let max_connections = get_max_connection_ ?max_connections () in
@@ -65,4 +65,4 @@ let create ?(masksigpipe = not Sys.win32) ?max_connections ?(timeout = 0.0)
     let tcp_server () = tcp_server_builder
   end in
   let backend = (module B : IO_BACKEND) in
-  Server.create_from ?buf_size ?middlewares ~backend ()
+  Server.create_from ?enable_logging ?buf_size ?middlewares ~backend ()

src/Tiny_httpd.mli

@@ -125,6 +125,7 @@ include module type of struct
 end
 
 val create :
+  ?enable_logging:bool ->
   ?masksigpipe:bool ->
   ?max_connections:int ->
   ?timeout:float ->
@@ -167,6 +168,8 @@ val create :
       systemd on Linux (or launchd on macOS). If passed in, this socket will be
       used instead of the [addr] and [port]. If not passed in, those will be
       used. This parameter exists since 0.10.
+    @param enable_logging if true and [Logs] is installed, log requests. Default true.
+      This parameter exists since NEXT_RELEASE. Does not affect debug-level logs.
 
     @param get_time_s obtain the current timestamp in seconds.
       This parameter exists since 0.11.

src/core/log.default.ml

@@ -5,3 +5,4 @@ let debug _ = ()
 let error _ = ()
 let setup ~debug:_ () = ()
 let dummy = true
+let fully_disable = ignore

src/core/log.logs.ml

@@ -1,6 +1,8 @@
 (* Use Logs *)
 
-module Log = (val Logs.(src_log @@ Src.create "tiny_httpd"))
+let log_src = Logs.Src.create "tiny_httpd"
+
+module Log = (val Logs.(src_log log_src))
 
 let info k = Log.info (fun fmt -> k (fun x -> fmt ?header:None ?tags:None x))
 let debug k = Log.debug (fun fmt -> k (fun x -> fmt ?header:None ?tags:None x))
@@ -15,8 +17,9 @@ let setup ~debug () =
   Logs.set_level ~all:true
     (Some
        (if debug then
-         Logs.Debug
-       else
-         Logs.Info))
+          Logs.Debug
+        else
+          Logs.Info))
 
 let dummy = false
+let fully_disable () = Logs.Src.set_level log_src None

src/core/log.mli

@@ -10,3 +10,8 @@ val setup : debug:bool -> unit -> unit
     @param debug if true, set logging to debug (otherwise info) *)
 
 val dummy : bool
+
+val fully_disable : unit -> unit
+(** Totally silence logs for tiny_httpd. With [Logs] installed this means setting
+    the level of the tiny_httpd source to [None]. 
+  @since NEXT_RELEASE *)

src/core/server.ml

@@ -84,6 +84,7 @@ let unwrap_handler_result req = function
 
 type t = {
   backend: (module IO_BACKEND);
+  enable_logging: bool;
   mutable tcp_server: IO.TCP_server.t option;
   mutable handler: IO.Input.t Request.t -> Response.t;
       (** toplevel handler, if any *)
@@ -250,7 +251,7 @@ let add_route_server_sent_handler ?accept ?(middlewares = []) self route f =
     end in
     (try f req (module SSG : SERVER_SENT_GENERATOR)
      with Exit_SSE -> IO.Output.close oc);
-    Log.info (fun k -> k "closed SSE connection")
+    if self.enable_logging then Log.info (fun k -> k "closed SSE connection")
   in
   add_route_handler_ self ?accept ~meth:`GET route ~tr_req f
 
@@ -272,11 +273,13 @@ let add_upgrade_handler ?(accept = fun _ -> Ok ()) ?(middlewares = [])
 
 let clear_bytes_ bs = Bytes.fill bs 0 (Bytes.length bs) '\x00'
 
-let create_from ?(buf_size = 16 * 1_024) ?(middlewares = []) ~backend () : t =
+let create_from ?(enable_logging = not Log.dummy) ?(buf_size = 16 * 1_024)
+    ?(middlewares = []) ~backend () : t =
   let handler _req = Response.fail ~code:404 "no top handler" in
   let self =
     {
       backend;
+      enable_logging;
       tcp_server = None;
       handler;
       path_handlers = [];
@@ -326,7 +329,7 @@ let client_handle_for (self : t) ~client_addr ic oc : unit =
 
   (* how to log the response to this query *)
   let log_response (req : _ Request.t) (resp : Response.t) =
-    if not Log.dummy then (
+    if self.enable_logging && not Log.dummy then (
       let msgf k =
         let elapsed = B.get_time_s () -. req.start_time in
         k
@@ -353,14 +356,14 @@ let client_handle_for (self : t) ~client_addr ic oc : unit =
   let handle_exn e bt : unit =
     let msg = Printexc.to_string e in
     let resp = Response.fail ~code:500 "server error: %s" msg in
-    if not Log.dummy then log_exn msg bt;
+    if self.enable_logging && not Log.dummy then log_exn msg bt;
     Response.Private_.output_ ~bytes:bytes_res oc resp
   in
 
   let handle_bad_req req e bt =
     let msg = Printexc.to_string e in
     let resp = Response.fail ~code:500 "server error: %s" msg in
-    if not Log.dummy then (
+    if self.enable_logging && not Log.dummy then (
       log_exn msg bt;
       log_response req resp
     );
@@ -393,7 +396,8 @@ let client_handle_for (self : t) ~client_addr ic oc : unit =
       match UP.handshake client_addr req with
       | Error msg ->
         (* fail the upgrade *)
-        Log.error (fun k -> k "upgrade failed: %s" msg);
+        if self.enable_logging then
+          Log.error (fun k -> k "upgrade failed: %s" msg);
         send_resp @@ Response.make_raw ~code:429 "upgrade required"
       | Ok (headers, handshake_st) ->
         (* send the upgrade reply *)

src/core/server.mli

@@ -81,6 +81,7 @@ module type IO_BACKEND = sig
 end
 
 val create_from :
+  ?enable_logging:bool ->
   ?buf_size:int ->
   ?middlewares:([ `Encoding | `Stage of int ] * Middleware.t) list ->
   backend:(module IO_BACKEND) ->
@@ -94,6 +95,9 @@ val create_from :
 
     @param buf_size size for buffers (since 0.11)
     @param middlewares see {!add_middleware} for more details.
+    @param enable_logging if true and [Logs] is installed,
+      emit logs via Logs (since NEXT_RELEASE).
+      Default [true].
 
     @since 0.14
 *)
@@ -117,7 +121,7 @@ val add_decode_request_cb :
   t ->
   (unit Request.t -> (unit Request.t * (IO.Input.t -> IO.Input.t)) option) ->
   unit
-  [@@deprecated "use add_middleware"]
+[@@deprecated "use add_middleware"]
 (** Add a callback for every request.
     The callback can provide a stream transformer and a new request (with
     modified headers, typically).
@@ -129,7 +133,7 @@ val add_decode_request_cb :
 
 val add_encode_response_cb :
   t -> (unit Request.t -> Response.t -> Response.t option) -> unit
-  [@@deprecated "use add_middleware"]
+[@@deprecated "use add_middleware"]
 (** Add a callback for every request/response pair.
     Similarly to {!add_encode_response_cb} the callback can return a new
     response, for example to compress it.