diff --git a/src/lib/dynamic_enricher.ml b/src/lib/dynamic_enricher.ml index 700c6826..aed5cdcc 100644 --- a/src/lib/dynamic_enricher.ml +++ b/src/lib/dynamic_enricher.ml @@ -16,8 +16,9 @@ let collect () : Key_value.t list = | kvs -> acc := List.rev_append kvs !acc | exception exn -> let bt = Printexc.get_raw_backtrace () in - Printf.eprintf "opentelemetry: dynamic_enricher raised %s\n%s%!" - (Printexc.to_string exn) - (Printexc.raw_backtrace_to_string bt)) + Self_debug.log Warning (fun () -> + Printf.sprintf "dynamic_enricher raised %s\n%s" + (Printexc.to_string exn) + (Printexc.raw_backtrace_to_string bt))) (Alist.get enrichers_); !acc diff --git a/src/lib/opentelemetry.ml b/src/lib/opentelemetry.ml index c0b0a59e..91dd683a 100644 --- a/src/lib/opentelemetry.ml +++ b/src/lib/opentelemetry.ml @@ -56,6 +56,8 @@ module Sdk = struct @since NEXT_RELEASE *) let get_logger ?name ?version ?attrs ?__MODULE__ () = Log_provider.get_logger ?name ?version ?attrs ?__MODULE__ () + + let self_debug_to_stderr = Sdk.self_debug_to_stderr end module Main_exporter = Sdk [@@deprecated "use Sdk instead"] @@ -66,6 +68,8 @@ module Collector = struct end [@@deprecated "Use 'Exporter' instead"] +module Provider_config = Provider_config +module Self_debug = Self_debug module Dynamic_enricher = Dynamic_enricher module Trace_provider = Trace_provider module Meter_provider = Meter_provider diff --git a/src/lib/provider_config.ml b/src/lib/provider_config.ml new file mode 100644 index 00000000..7932fabe --- /dev/null +++ b/src/lib/provider_config.ml @@ -0,0 +1,11 @@ +(** Per-provider batching configuration. *) + +type t = { + batch: int option; + timeout: Mtime.Span.t; +} + +let make ?(batch : int option) ?(timeout = Mtime.Span.(2_000 * ms)) () : t = + { batch; timeout } + +let default : t = make ~batch:200 () diff --git a/src/lib/provider_config.mli b/src/lib/provider_config.mli new file mode 100644 index 00000000..a7e77374 --- /dev/null +++ b/src/lib/provider_config.mli @@ -0,0 +1,16 @@ +(** Per-provider batching configuration. *) + +type t = { + batch: int option; + (** Batch size (number of items). [None] means unbatched (immediate emit). + *) + timeout: Mtime.Span.t; (** Timeout between automatic batch flushes. *) +} + +val make : ?batch:int -> ?timeout:Mtime.Span.t -> unit -> t +(** Create a provider config. + @param batch batch size. Default: [Some 200]. + @param timeout flush timeout. Default: [2000ms] *) + +val default : t +(** Default provider config: [200] batch size, [2s] timeout. *) diff --git a/src/lib/sdk.ml b/src/lib/sdk.ml index 22fc1c0b..1f7db854 100644 --- a/src/lib/sdk.ml +++ b/src/lib/sdk.ml @@ -10,10 +10,13 @@ open struct let exporter : Exporter.t option Atomic.t = Atomic.make None end +let self_debug_to_stderr = Self_debug.to_stderr + (** Remove current exporter, if any. @param on_done called once the exporter has fully shut down (queue drained). *) let remove ~on_done () : unit = + Self_debug.log Info (fun () -> "opentelemetry: SDK removed"); (* flush+close provider emitters so buffered signals reach the queue *) Emitter.flush_and_close (Trace_provider.get ()).emit; Emitter.flush_and_close (Meter_provider.get ()).emit; @@ -51,16 +54,17 @@ let run_tick_callbacks : unit -> unit = Globals.run_tick_callbacks from their ticker. *) let tick : unit -> unit = Globals.run_tick_callbacks -let set ?batch_traces ?batch_metrics ?batch_logs - ?(batch_timeout = Mtime.Span.(2_000 * ms)) (exp : Exporter.t) : unit = +let set ?(traces = Provider_config.default) ?(metrics = Provider_config.default) + ?(logs = Provider_config.default) (exp : Exporter.t) : unit = + Self_debug.log Info (fun () -> "opentelemetry: SDK set up"); Atomic.set exporter (Some exp); let tracer : Tracer.t = let t = Tracer.of_exporter exp in { t with emit = - Emitter_batch.add_batching_opt ~timeout:batch_timeout - ~batch_size:batch_traces t.emit; + Emitter_batch.add_batching_opt ~timeout:traces.Provider_config.timeout + ~batch_size:traces.Provider_config.batch t.emit; } in let meter : Meter.t = @@ -68,8 +72,8 @@ let set ?batch_traces ?batch_metrics ?batch_logs { m with emit = - Emitter_batch.add_batching_opt ~timeout:batch_timeout - ~batch_size:batch_metrics m.emit; + Emitter_batch.add_batching_opt ~timeout:metrics.Provider_config.timeout + ~batch_size:metrics.Provider_config.batch m.emit; } in let logger : Logger.t = @@ -77,8 +81,8 @@ let set ?batch_traces ?batch_metrics ?batch_logs { l with emit = - Emitter_batch.add_batching_opt ~timeout:batch_timeout - ~batch_size:batch_logs l.emit; + Emitter_batch.add_batching_opt ~timeout:logs.Provider_config.timeout + ~batch_size:logs.Provider_config.batch l.emit; } in Trace_provider.set tracer; diff --git a/src/lib/self_debug.ml b/src/lib/self_debug.ml new file mode 100644 index 00000000..16bcff89 --- /dev/null +++ b/src/lib/self_debug.ml @@ -0,0 +1,32 @@ +type level = + | Debug + | Info + | Warning + | Error + +type logger = level -> (unit -> string) -> unit + +let logger : logger ref = ref (fun _ _ -> ()) + +let[@inline] log level f = !logger level f + +let string_of_level = function + | Debug -> "debug" + | Info -> "info" + | Warning -> "warning" + | Error -> "error" + +let to_stderr ?(min_level = Warning) () : unit = + let[@inline] int_of_level_ = function + | Debug -> 0 + | Info -> 1 + | Warning -> 2 + | Error -> 3 + in + let threshold = int_of_level_ min_level in + logger := + fun level mk_msg -> + if int_of_level_ level >= threshold then ( + let msg = mk_msg () in + Printf.eprintf "[otel:%s] %s\n%!" (string_of_level level) msg + ) diff --git a/src/lib/self_debug.mli b/src/lib/self_debug.mli new file mode 100644 index 00000000..b95c2bec --- /dev/null +++ b/src/lib/self_debug.mli @@ -0,0 +1,36 @@ +(** Emergency diagnostic logger for the OpenTelemetry SDK itself. + + Bypasses the OTEL pipeline entirely. Defaults to silently discarding all + messages. Use {!to_stderr} or set {!logger} to enable output. + + Usage: + {[ + Self_debug.log Info (fun () -> Printf.sprintf "batch flushed %d items" n) + ]}. + + @since NEXT_RELEASE *) + +type level = + | Debug + | Info + | Warning + | Error + +type logger = level -> (unit -> string) -> unit +(** A logger, takes a level and a (lazy) message, and maybe emit the message *) + +val logger : logger ref +(** The current log sink. Replace to redirect output. Default: no-op. *) + +val string_of_level : level -> string +(** String representation of a level. *) + +val log : level -> (unit -> string) -> unit +(** [log level mk_msg] emits a diagnostic message if the current logger is + active. [mk_msg] is called lazily — only if the message will be emitted. *) + +val to_stderr : ?min_level:level -> unit -> unit +(** Install a stderr logger. Messages below [min_level] (default: [Warning]) are + suppressed. This is useful to help debug problems with this library itself + (e.g. when nothing is emitted but the user expects something to be emitted) +*)