From 1c61c3917283354bdb92294b9349e050badf045f Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 4 Dec 2024 15:52:32 -0500 Subject: [PATCH] new flag ?enable_logging to disable regular logs (not debug) --- src/Tiny_httpd.ml | 6 +++--- src/Tiny_httpd.mli | 3 +++ src/core/log.default.ml | 1 + src/core/log.logs.ml | 11 +++++++---- src/core/log.mli | 5 +++++ src/core/server.ml | 16 ++++++++++------ src/core/server.mli | 8 ++++++-- 7 files changed, 35 insertions(+), 15 deletions(-) diff --git a/src/Tiny_httpd.ml b/src/Tiny_httpd.ml index 36b6ca8a..9d51056b 100644 --- a/src/Tiny_httpd.ml +++ b/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 () diff --git a/src/Tiny_httpd.mli b/src/Tiny_httpd.mli index fbd30bef..92463446 100644 --- a/src/Tiny_httpd.mli +++ b/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. diff --git a/src/core/log.default.ml b/src/core/log.default.ml index 5340578b..47c2d8c5 100644 --- a/src/core/log.default.ml +++ b/src/core/log.default.ml @@ -5,3 +5,4 @@ let debug _ = () let error _ = () let setup ~debug:_ () = () let dummy = true +let fully_disable = ignore diff --git a/src/core/log.logs.ml b/src/core/log.logs.ml index f2cc8f56..b20718db 100644 --- a/src/core/log.logs.ml +++ b/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 diff --git a/src/core/log.mli b/src/core/log.mli index 5944e125..3990a98a 100644 --- a/src/core/log.mli +++ b/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 *) diff --git a/src/core/server.ml b/src/core/server.ml index 889ce547..871671fc 100644 --- a/src/core/server.ml +++ b/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 *) diff --git a/src/core/server.mli b/src/core/server.mli index b585dfac..4dcb5926 100644 --- a/src/core/server.mli +++ b/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.