From 76a54ac6e1db96b33c770d84ba7b5d173dc83b3d Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 4 Dec 2025 14:37:20 -0500
Subject: [PATCH] fix client, allow to set the self-tracing tracer.

---
 src/client/debug_exporter.ml  |  1 +
 src/client/dune               |  2 ++
 src/client/exporter_stdout.ml |  5 ++++-
 src/client/self_trace.ml      | 12 ++++++++----
 src/client/self_trace.mli     |  7 +++++++
 5 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/src/client/debug_exporter.ml b/src/client/debug_exporter.ml
index 291067bd..295becac 100644
--- a/src/client/debug_exporter.ml
+++ b/src/client/debug_exporter.ml
@@ -20,6 +20,7 @@ let debug ?(out = Format.err_formatter) (exp : OTEL.Exporter.t) :
         (fun m -> Format.fprintf out "METRIC: %a@." Metrics.pp_metric m)
         exp.emit_metrics;
     on_tick = exp.on_tick;
+    tick = exp.tick;
     cleanup =
       (fun ~on_done () ->
         Format.fprintf out "CLEANUP@.";
diff --git a/src/client/dune b/src/client/dune
index 48e836d7..037f4d6b 100644
--- a/src/client/dune
+++ b/src/client/dune
@@ -1,8 +1,10 @@
 (library
  (name opentelemetry_client)
  (public_name opentelemetry.client)
+ (flags :standard -open Opentelemetry_util)
  (libraries
   opentelemetry
+  opentelemetry.util
   opentelemetry.emitter
   opentelemetry.proto
   pbrt
diff --git a/src/client/exporter_stdout.ml b/src/client/exporter_stdout.ml
index 4e8ec5c2..76dbf760 100644
--- a/src/client/exporter_stdout.ml
+++ b/src/client/exporter_stdout.ml
@@ -33,8 +33,10 @@ let stdout : OTEL.Exporter.t =
   let open Opentelemetry_util in
   let out = Format.std_formatter in
   let mutex = Mutex.create () in
+  let ticker = Cb_set.create () in
 
   let closed = Atomic.make false in
+  let tick () = Cb_set.trigger ticker in
 
   let mk_emitter pp_signal =
     let emit l =
@@ -57,6 +59,7 @@ let stdout : OTEL.Exporter.t =
     emit_spans = mk_emitter pp_span;
     emit_logs = mk_emitter Proto.Logs.pp_log_record;
     emit_metrics = mk_emitter Proto.Metrics.pp_metric;
-    on_tick = Cb_set.create ();
+    on_tick = Cb_set.register ticker;
+    tick;
     cleanup = (fun ~on_done () -> on_done ());
   }
diff --git a/src/client/self_trace.ml b/src/client/self_trace.ml
index 23dd258b..cf5adcb5 100644
--- a/src/client/self_trace.ml
+++ b/src/client/self_trace.ml
@@ -2,17 +2,21 @@ open Common_
 
 let enabled = Atomic.make false
 
+let tracer = Atomic.make OTEL.Tracer.dynamic_forward_to_main_exporter
+
 let[@inline] add_event (scope : OTEL.Span.t) ev = OTEL.Span.add_event scope ev
 
+let set_tracer tr = Atomic.set tracer tr
+
 let dummy_trace_id_ = OTEL.Trace_id.dummy
 
 let dummy_span_id = OTEL.Span_id.dummy
 
-(* FIXME: get an explicit tracer instead *)
 let with_ ?kind ?attrs name f =
-  if Atomic.get enabled then
-    OTEL.Tracer.with_ ?kind ?attrs name f
-  else (
+  if Atomic.get enabled then (
+    let tracer = Atomic.get tracer in
+    OTEL.Tracer.with_ tracer ?kind ?attrs name f
+  ) else (
     (* A new scope is needed here because it might be modified *)
     let span : OTEL.Span.t =
       OTEL.Span.make ~trace_id:dummy_trace_id_ ~id:dummy_span_id ~start_time:0L
diff --git a/src/client/self_trace.mli b/src/client/self_trace.mli
index b6b371ef..07cf9369 100644
--- a/src/client/self_trace.mli
+++ b/src/client/self_trace.mli
@@ -10,5 +10,12 @@ val with_ :
   string ->
   (OTEL.Span.t -> 'a) ->
   'a
+(** A simple way to create spans to instrument parts of the OTEL SDK itself. *)
+
+val set_tracer : OTEL.Tracer.t -> unit
+(** Set the tracer to use for self-tracing. We need to make sure it will not
+    lead to infinite loops (if the tracer itself is self-tracing, it might
+    invoke itself recursively, and so on). *)
 
 val set_enabled : bool -> unit
+(** Enable self tracing. A tracer must also be set. *)