Merge pull request #122 from ocaml-tracing/simon/missing-env-vars

add missing OTEL env variables

src/client-cohttp-eio/opentelemetry_client_cohttp_eio.ml

@@ -9,10 +9,6 @@ open Opentelemetry_client
 
 let spf = Printf.sprintf
 
-let set_headers = Config.Env.set_headers
-
-let get_headers = Config.Env.get_headers
-
 module Make (CTX : sig
   val sw : Eio.Switch.t
 
@@ -91,13 +87,13 @@ struct
     let cleanup = ignore
 
     (* send the content to the remote endpoint/path *)
-    let send (client : t) ~url ~decode (body : string) :
+    let send (client : t) ~url ~headers:user_headers ~decode (body : string) :
         ('a, Export_error.t) result =
       Eio.Switch.run @@ fun sw ->
       let uri = Uri.of_string url in
 
       let open Cohttp in
-      let headers = Header.(add_list (init ()) (Config.Env.get_headers ())) in
+      let headers = Header.(add_list (init ()) user_headers) in
       let headers =
         Header.(add headers "Content-Type" "application/x-protobuf")
       in
@@ -179,13 +175,13 @@ let create_exporter ?(config = Config.make ()) ~sw ~env () =
 
 let create_backend = create_exporter
 
-let setup_ ~sw ?config env : unit =
+let setup_ ~sw ~config env : unit =
   Opentelemetry_ambient_context.set_current_storage Ambient_context_eio.storage;
-  let exp = create_exporter ?config ~sw ~env () in
+  let exp = create_exporter ~config ~sw ~env () in
   Main_exporter.set exp
 
-let setup ?config ?(enable = true) ~sw env =
+let setup ?(config = Config.make ()) ?(enable = true) ~sw env =
-  if enable then setup_ ~sw ?config env
+  if enable && not config.sdk_disabled then setup_ ~sw ~config env
 
 let remove_exporter () =
   let p, waker = Eio.Promise.create () in
@@ -194,10 +190,10 @@ let remove_exporter () =
 
 let remove_backend = remove_exporter
 
-let with_setup ?config ?(enable = true) env f =
+let with_setup ?(config = Config.make ()) ?(enable = true) env f =
-  if enable then (
+  if enable && not config.sdk_disabled then (
     Eio.Switch.run @@ fun sw ->
-    setup_ ~sw ?config env;
+    setup_ ~sw ~config env;
     Fun.protect f ~finally:remove_exporter
   ) else
     f ()

src/client-cohttp-eio/opentelemetry_client_cohttp_eio.mli

@@ -3,11 +3,6 @@
    https://opentelemetry.io/docs/reference/specification/protocol/exporter/
    *)
 
-val get_headers : unit -> (string * string) list
-
-val set_headers : (string * string) list -> unit
-(** Set http headers that are sent on every http query to the collector. *)
-
 module Config = Config
 
 val create_consumer :

src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml

@@ -8,10 +8,6 @@ open Opentelemetry_client
 open Opentelemetry
 open Common_
 
-let set_headers = Config.Env.set_headers
-
-let get_headers = Config.Env.get_headers
-
 type error = Export_error.t
 
 open struct
@@ -31,11 +27,12 @@ module Httpc : Generic_http_consumer.HTTPC with module IO = IO = struct
   let cleanup _self = ()
 
   (* send the content to the remote endpoint/path *)
-  let send (_self : t) ~url ~decode (bod : string) : ('a, error) result Lwt.t =
+  let send (_self : t) ~url ~headers:user_headers ~decode (bod : string) :
+      ('a, error) result Lwt.t =
     let uri = Uri.of_string url in
 
     let open Cohttp in
-    let headers = Header.(add_list (init ()) (Config.Env.get_headers ())) in
+    let headers = Header.(add_list (init ()) user_headers) in
     let headers =
       Header.(
         add_list headers
@@ -119,13 +116,14 @@ let create_exporter ?(config = Config.make ()) () =
 
 let create_backend = create_exporter
 
-let setup_ ?config () : unit =
+let setup_ ~config () : unit =
   Opentelemetry_client_lwt.Util_ambient_context.setup_ambient_context ();
-  let exp = create_exporter ?config () in
+  let exp = create_exporter ~config () in
   Main_exporter.set exp;
   ()
 
-let setup ?config ?(enable = true) () = if enable then setup_ ?config ()
+let setup ?(config = Config.make ()) ?(enable = true) () =
+  if enable && not config.sdk_disabled then setup_ ~config ()
 
 let remove_exporter () : unit Lwt.t =
   let done_fut, done_u = Lwt.wait () in
@@ -140,7 +138,7 @@ let remove_exporter () : unit Lwt.t =
 let remove_backend = remove_exporter
 
 let with_setup ?(config = Config.make ()) ?(enable = true) () f : _ Lwt.t =
-  if enable then (
+  if enable && not config.sdk_disabled then (
     setup_ ~config ();
 
     Lwt.finalize f remove_exporter

src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.mli

@@ -3,11 +3,6 @@
    https://opentelemetry.io/docs/reference/specification/protocol/exporter/
    *)
 
-val get_headers : unit -> (string * string) list
-
-val set_headers : (string * string) list -> unit
-(** Set http headers that are sent on every http query to the collector. *)
-
 module Config = Config
 
 val create_consumer :

src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.ml

@@ -8,10 +8,6 @@ open Opentelemetry
 open Opentelemetry_client
 open Common_
 
-let set_headers = Config.Env.set_headers
-
-let get_headers = Config.Env.get_headers
-
 type error = Export_error.t
 
 open struct
@@ -30,12 +26,13 @@ module Httpc : Generic_http_consumer.HTTPC with module IO = IO = struct
   let cleanup self = Ezcurl_lwt.delete self
 
   (** send the content to the remote endpoint/path *)
-  let send (self : t) ~url ~decode (bod : string) : ('a, error) result Lwt.t =
+  let send (self : t) ~url ~headers:user_headers ~decode (bod : string) :
+      ('a, error) result Lwt.t =
     let* r =
       let headers =
         ("Content-Type", "application/x-protobuf")
         :: ("Accept", "application/x-protobuf")
-        :: Config.Env.get_headers ()
+        :: user_headers
       in
       Ezcurl_lwt.post ~client:self ~headers ~params:[] ~url
         ~content:(`String bod) ()
@@ -90,14 +87,15 @@ let create_exporter ?(config = Config.make ()) () =
 
 let create_backend = create_exporter
 
-let setup_ ?config () : Exporter.t =
+let setup_ ~config () : Exporter.t =
   Opentelemetry_client_lwt.Util_ambient_context.setup_ambient_context ();
-  let exp = create_exporter ?config () in
+  let exp = create_exporter ~config () in
   Main_exporter.set exp;
   exp
 
-let setup ?config ?(enable = true) () =
+let setup ?(config = Config.make ()) ?(enable = true) () =
-  if enable then ignore (setup_ ?config () : Exporter.t)
+  if enable && not config.sdk_disabled then
+    ignore (setup_ ~config () : Exporter.t)
 
 let remove_exporter () : unit Lwt.t =
   let done_fut, done_u = Lwt.wait () in
@@ -108,7 +106,7 @@ let remove_backend = remove_exporter
 
 let with_setup ?(after_shutdown = ignore) ?(config = Config.make ())
     ?(enable = true) () f : _ Lwt.t =
-  if enable then
+  if enable && not config.sdk_disabled then
     let open Lwt.Syntax in
     let exp = setup_ ~config () in
 

src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.mli

@@ -3,11 +3,6 @@
    https://opentelemetry.io/docs/reference/specification/protocol/exporter/
    *)
 
-val get_headers : unit -> (string * string) list
-
-val set_headers : (string * string) list -> unit
-(** Set http headers that are sent on every http query to the collector. *)
-
 module Config = Config
 
 val create_consumer :

src/client-ocurl/opentelemetry_client_ocurl.ml

@@ -8,10 +8,6 @@ module OTELC = Opentelemetry_client
 module OTEL = Opentelemetry
 open Common_
 
-let get_headers = Config.Env.get_headers
-
-let set_headers = Config.Env.set_headers
-
 let n_bytes_sent : int Atomic.t = Atomic.make 0
 
 type error = OTELC.Export_error.t
@@ -30,12 +26,13 @@ module Httpc : OTELC.Generic_http_consumer.HTTPC with module IO = IO = struct
 
   let cleanup = Ezcurl.delete
 
-  let send (self : t) ~url ~decode (bod : string) : ('a, error) result =
+  let send (self : t) ~url ~headers:user_headers ~decode (bod : string) :
+      ('a, error) result =
     let r =
       let headers =
         ("Content-Type", "application/x-protobuf")
         :: ("Accept", "application/x-protobuf")
-        :: Config.Env.get_headers ()
+        :: user_headers
       in
       Ezcurl.post ~client:self ~headers ~params:[] ~url ~content:(`String bod)
         ()
@@ -108,7 +105,7 @@ let shutdown_and_wait ?(after_shutdown = ignore) (self : OTEL.Exporter.t) : unit
   after_shutdown self;
   ()
 
-let setup_ ?(config : Config.t = Config.make ()) () : OTEL.Exporter.t =
+let setup_ ~config () : OTEL.Exporter.t =
   let exporter = create_exporter ~config () in
   OTEL.Main_exporter.set exporter;
 
@@ -134,12 +131,14 @@ let remove_exporter () : unit =
 
 let remove_backend = remove_exporter
 
-let setup ?config ?(enable = true) () =
+let setup ?(config : Config.t = Config.make ()) ?(enable = true) () =
-  if enable then ignore (setup_ ?config () : OTEL.Exporter.t)
+  if enable && not config.common.sdk_disabled then
+    ignore (setup_ ~config () : OTEL.Exporter.t)
 
-let with_setup ?after_shutdown ?config ?(enable = true) () f =
+let with_setup ?after_shutdown ?(config : Config.t = Config.make ())
-  if enable then (
+    ?(enable = true) () f =
-    let exp = setup_ ?config () in
+  if enable && not config.common.sdk_disabled then (
+    let exp = setup_ ~config () in
     Fun.protect f ~finally:(fun () -> shutdown_and_wait ?after_shutdown exp)
   ) else
     f ()

src/client-ocurl/opentelemetry_client_ocurl.mli

@@ -3,11 +3,6 @@
    https://opentelemetry.io/docs/reference/specification/protocol/exporter/
    *)
 
-val get_headers : unit -> (string * string) list
-
-val set_headers : (string * string) list -> unit
-(** Set http headers that are sent on every http query to the collector. *)
-
 module Config = Config
 
 val n_bytes_sent : unit -> int

src/client/exporter_config.ml

@@ -0,0 +1,338 @@
+type protocol =
+  | Http_protobuf
+  | Http_json
+
+type log_level =
+  | Log_level_none
+  | Log_level_error
+  | Log_level_warn
+  | Log_level_info
+  | Log_level_debug
+
+type rest = unit
+
+type t = {
+  debug: bool;
+  log_level: log_level;
+  sdk_disabled: bool;
+  url_traces: string;
+  url_metrics: string;
+  url_logs: string;
+  headers: (string * string) list;
+  headers_traces: (string * string) list;
+  headers_metrics: (string * string) list;
+  headers_logs: (string * string) list;
+  protocol: protocol;
+  timeout_ms: int;
+  timeout_traces_ms: int;
+  timeout_metrics_ms: int;
+  timeout_logs_ms: int;
+  batch_traces: int option;
+  batch_metrics: int option;
+  batch_logs: int option;
+  batch_timeout_ms: int;
+  self_trace: bool;
+  http_concurrency_level: int option;
+  _rest: rest;
+}
+
+open struct
+  let ppiopt out i =
+    match i with
+    | None -> Format.fprintf out "None"
+    | Some i -> Format.fprintf out "%d" i
+
+  let pp_header ppf (a, b) = Format.fprintf ppf "@[%s: @,%s@]@." a b
+
+  let ppheaders out l =
+    Format.fprintf out "[@[%a@]]" (Format.pp_print_list pp_header) l
+
+  let pp_protocol out = function
+    | Http_protobuf -> Format.fprintf out "http/protobuf"
+    | Http_json -> Format.fprintf out "http/json"
+
+  let pp_log_level out = function
+    | Log_level_none -> Format.fprintf out "none"
+    | Log_level_error -> Format.fprintf out "error"
+    | Log_level_warn -> Format.fprintf out "warn"
+    | Log_level_info -> Format.fprintf out "info"
+    | Log_level_debug -> Format.fprintf out "debug"
+end
+
+let pp out (self : t) : unit =
+  let {
+    debug;
+    log_level;
+    sdk_disabled;
+    self_trace;
+    url_traces;
+    url_metrics;
+    url_logs;
+    headers;
+    headers_traces;
+    headers_metrics;
+    headers_logs;
+    protocol;
+    timeout_ms;
+    timeout_traces_ms;
+    timeout_metrics_ms;
+    timeout_logs_ms;
+    batch_traces;
+    batch_metrics;
+    batch_logs;
+    batch_timeout_ms;
+    http_concurrency_level;
+    _rest = _;
+  } =
+    self
+  in
+  Format.fprintf out
+    "{@[ debug=%B;@ log_level=%a;@ sdk_disabled=%B;@ self_trace=%B;@ \
+     url_traces=%S;@ url_metrics=%S;@ url_logs=%S;@ @[<2>headers=@,\
+     %a@];@ @[<2>headers_traces=@,\
+     %a@];@ @[<2>headers_metrics=@,\
+     %a@];@ @[<2>headers_logs=@,\
+     %a@];@ protocol=%a;@ timeout_ms=%d;@ timeout_traces_ms=%d;@ \
+     timeout_metrics_ms=%d;@ timeout_logs_ms=%d;@ batch_traces=%a;@ \
+     batch_metrics=%a;@ batch_logs=%a;@ batch_timeout_ms=%d;@ \
+     http_concurrency_level=%a @]}"
+    debug pp_log_level log_level sdk_disabled self_trace url_traces url_metrics
+    url_logs ppheaders headers ppheaders headers_traces ppheaders
+    headers_metrics ppheaders headers_logs pp_protocol protocol timeout_ms
+    timeout_traces_ms timeout_metrics_ms timeout_logs_ms ppiopt batch_traces
+    ppiopt batch_metrics ppiopt batch_logs batch_timeout_ms ppiopt
+    http_concurrency_level
+
+let default_url = "http://localhost:4318"
+
+type 'k make =
+  ?debug:bool ->
+  ?log_level:log_level ->
+  ?sdk_disabled:bool ->
+  ?url:string ->
+  ?url_traces:string ->
+  ?url_metrics:string ->
+  ?url_logs:string ->
+  ?batch_traces:int option ->
+  ?batch_metrics:int option ->
+  ?batch_logs:int option ->
+  ?headers:(string * string) list ->
+  ?headers_traces:(string * string) list ->
+  ?headers_metrics:(string * string) list ->
+  ?headers_logs:(string * string) list ->
+  ?protocol:protocol ->
+  ?timeout_ms:int ->
+  ?timeout_traces_ms:int ->
+  ?timeout_metrics_ms:int ->
+  ?timeout_logs_ms:int ->
+  ?batch_timeout_ms:int ->
+  ?self_trace:bool ->
+  ?http_concurrency_level:int ->
+  'k
+
+module type ENV = sig
+  val make : (t -> 'a) -> 'a make
+end
+
+open struct
+  let get_debug_from_env () =
+    match Sys.getenv_opt "OTEL_OCAML_DEBUG" with
+    | Some ("1" | "true") -> true
+    | _ -> false
+
+  let get_log_level_from_env () =
+    match Sys.getenv_opt "OTEL_LOG_LEVEL" with
+    | Some "none" -> Log_level_none
+    | Some "error" -> Log_level_error
+    | Some "warn" -> Log_level_warn
+    | Some "info" -> Log_level_info
+    | Some "debug" -> Log_level_debug
+    | Some s ->
+      Printf.eprintf "warning: unknown log level %S, defaulting to info\n%!" s;
+      (* log in info level, so we at least don't miss warnings and errors  *)
+      Log_level_info
+    | None ->
+      if get_debug_from_env () then
+        Log_level_debug
+      else
+        Log_level_none
+
+  let get_sdk_disabled_from_env () =
+    match Sys.getenv_opt "OTEL_SDK_DISABLED" with
+    | Some ("true" | "1") -> true
+    | _ -> false
+
+  let get_protocol_from_env env_name =
+    match Sys.getenv_opt env_name with
+    | Some "http/protobuf" -> Http_protobuf
+    | Some "http/json" -> Http_json
+    | _ -> Http_protobuf
+
+  let get_timeout_from_env env_name default =
+    match Sys.getenv_opt env_name with
+    | Some s -> (try int_of_string s with _ -> default)
+    | None -> default
+
+  let make_get_from_env env_name =
+    let value = ref None in
+    fun () ->
+      match !value with
+      | None ->
+        value := Sys.getenv_opt env_name;
+        !value
+      | Some value -> Some value
+
+  let get_url_from_env = make_get_from_env "OTEL_EXPORTER_OTLP_ENDPOINT"
+
+  let get_url_traces_from_env =
+    make_get_from_env "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT"
+
+  let get_url_metrics_from_env =
+    make_get_from_env "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT"
+
+  let get_url_logs_from_env =
+    make_get_from_env "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT"
+
+  let remove_trailing_slash url =
+    if url <> "" && String.get url (String.length url - 1) = '/' then
+      String.sub url 0 (String.length url - 1)
+    else
+      url
+
+  let parse_headers s =
+    let parse_header s =
+      match String.split_on_char '=' s with
+      | [ key; value ] -> key, value
+      | _ -> failwith "Unexpected format for header"
+    in
+    String.split_on_char ',' s |> List.map parse_header
+
+  let get_headers_from_env env_name =
+    try parse_headers (Sys.getenv env_name) with _ -> []
+
+  let get_general_headers_from_env () =
+    try parse_headers (Sys.getenv "OTEL_EXPORTER_OTLP_HEADERS") with _ -> []
+end
+
+module Env () : ENV = struct
+  let merge_headers base specific =
+    (* Signal-specific headers override generic ones *)
+    let specific_keys = List.map fst specific in
+    let filtered_base =
+      List.filter (fun (k, _) -> not (List.mem k specific_keys)) base
+    in
+    List.rev_append specific filtered_base
+
+  let make k ?(debug = get_debug_from_env ())
+      ?(log_level = get_log_level_from_env ())
+      ?(sdk_disabled = get_sdk_disabled_from_env ()) ?url ?url_traces
+      ?url_metrics ?url_logs ?(batch_traces = Some 400)
+      ?(batch_metrics = Some 200) ?(batch_logs = Some 400)
+      ?(headers = get_general_headers_from_env ()) ?headers_traces
+      ?headers_metrics ?headers_logs
+      ?(protocol = get_protocol_from_env "OTEL_EXPORTER_OTLP_PROTOCOL")
+      ?(timeout_ms = get_timeout_from_env "OTEL_EXPORTER_OTLP_TIMEOUT" 10_000)
+      ?timeout_traces_ms ?timeout_metrics_ms ?timeout_logs_ms
+      ?(batch_timeout_ms = 2_000) ?(self_trace = false) ?http_concurrency_level
+      =
+    let url_traces, url_metrics, url_logs =
+      let base_url =
+        let base_url =
+          match get_url_from_env () with
+          | None -> Option.value url ~default:default_url
+          | Some url -> remove_trailing_slash url
+        in
+        remove_trailing_slash base_url
+      in
+      let url_traces =
+        match get_url_traces_from_env () with
+        | None -> Option.value url_traces ~default:(base_url ^ "/v1/traces")
+        | Some url -> url
+      in
+      let url_metrics =
+        match get_url_metrics_from_env () with
+        | None -> Option.value url_metrics ~default:(base_url ^ "/v1/metrics")
+        | Some url -> url
+      in
+      let url_logs =
+        match get_url_logs_from_env () with
+        | None -> Option.value url_logs ~default:(base_url ^ "/v1/logs")
+        | Some url -> url
+      in
+      url_traces, url_metrics, url_logs
+    in
+
+    (* Get per-signal headers from env vars *)
+    let env_headers_traces =
+      get_headers_from_env "OTEL_EXPORTER_OTLP_TRACES_HEADERS"
+    in
+    let env_headers_metrics =
+      get_headers_from_env "OTEL_EXPORTER_OTLP_METRICS_HEADERS"
+    in
+    let env_headers_logs =
+      get_headers_from_env "OTEL_EXPORTER_OTLP_LOGS_HEADERS"
+    in
+
+    (* Merge with provided headers, env-specific takes precedence *)
+    let headers_traces =
+      match headers_traces with
+      | Some h -> h
+      | None -> merge_headers headers env_headers_traces
+    in
+    let headers_metrics =
+      match headers_metrics with
+      | Some h -> h
+      | None -> merge_headers headers env_headers_metrics
+    in
+    let headers_logs =
+      match headers_logs with
+      | Some h -> h
+      | None -> merge_headers headers env_headers_logs
+    in
+
+    (* Get per-signal timeouts from env vars with fallback to general timeout *)
+    let timeout_traces_ms =
+      match timeout_traces_ms with
+      | Some t -> t
+      | None ->
+        get_timeout_from_env "OTEL_EXPORTER_OTLP_TRACES_TIMEOUT" timeout_ms
+    in
+    let timeout_metrics_ms =
+      match timeout_metrics_ms with
+      | Some t -> t
+      | None ->
+        get_timeout_from_env "OTEL_EXPORTER_OTLP_METRICS_TIMEOUT" timeout_ms
+    in
+    let timeout_logs_ms =
+      match timeout_logs_ms with
+      | Some t -> t
+      | None ->
+        get_timeout_from_env "OTEL_EXPORTER_OTLP_LOGS_TIMEOUT" timeout_ms
+    in
+
+    k
+      {
+        debug;
+        log_level;
+        sdk_disabled;
+        url_traces;
+        url_metrics;
+        url_logs;
+        headers;
+        headers_traces;
+        headers_metrics;
+        headers_logs;
+        protocol;
+        timeout_ms;
+        timeout_traces_ms;
+        timeout_metrics_ms;
+        timeout_logs_ms;
+        batch_traces;
+        batch_metrics;
+        batch_logs;
+        batch_timeout_ms;
+        self_trace;
+        http_concurrency_level;
+        _rest = ();
+      }
+end

src/client/exporter_config.mli

@@ -0,0 +1,190 @@
+(** Constructing and managing the configuration common to many (most?)
+    HTTP-based clients.
+
+    This is extended and reused by concrete client implementations that exports
+    signals over HTTP, depending on their needs. *)
+
+type protocol =
+  | Http_protobuf
+  | Http_json
+
+type log_level =
+  | Log_level_none
+  | Log_level_error
+  | Log_level_warn
+  | Log_level_info
+  | Log_level_debug
+
+type rest
+(** opaque type to force using {!make} while allowing record updates *)
+
+type t = {
+  debug: bool; [@alert deprecated "Use log_level instead"]
+      (** @deprecated Use {!log_level} instead. Debug the client itself? *)
+  log_level: log_level;
+      (** Log level for internal diagnostics. Read from OTEL_LOG_LEVEL or falls
+          back to OTEL_OCAML_DEBUG for compatibility. *)
+  sdk_disabled: bool;
+      (** If true, the SDK is completely disabled and no-ops. Read from
+          OTEL_SDK_DISABLED. Default false. *)
+  url_traces: string;  (** Url to send traces/spans *)
+  url_metrics: string;  (** Url to send metrics*)
+  url_logs: string;  (** Url to send logs *)
+  headers: (string * string) list;
+      (** Global API headers sent to all endpoints. Default is none or
+          "OTEL_EXPORTER_OTLP_HEADERS" if set. Signal-specific headers can
+          override these. *)
+  headers_traces: (string * string) list;
+      (** Headers for traces endpoint. Merges OTEL_EXPORTER_OTLP_HEADERS with
+          OTEL_EXPORTER_OTLP_TRACES_HEADERS (signal-specific takes precedence).
+      *)
+  headers_metrics: (string * string) list;
+      (** Headers for metrics endpoint. Merges OTEL_EXPORTER_OTLP_HEADERS with
+          OTEL_EXPORTER_OTLP_METRICS_HEADERS (signal-specific takes precedence).
+      *)
+  headers_logs: (string * string) list;
+      (** Headers for logs endpoint. Merges OTEL_EXPORTER_OTLP_HEADERS with
+          OTEL_EXPORTER_OTLP_LOGS_HEADERS (signal-specific takes precedence). *)
+  protocol: protocol;
+      (** Wire protocol to use. Read from OTEL_EXPORTER_OTLP_PROTOCOL. Default
+          Http_protobuf. *)
+  timeout_ms: int;
+      (** General timeout in milliseconds for exporter operations. Read from
+          OTEL_EXPORTER_OTLP_TIMEOUT. Default 10_000. *)
+  timeout_traces_ms: int;
+      (** Timeout for trace exports. Read from
+          OTEL_EXPORTER_OTLP_TRACES_TIMEOUT, falls back to timeout_ms. *)
+  timeout_metrics_ms: int;
+      (** Timeout for metric exports. Read from
+          OTEL_EXPORTER_OTLP_METRICS_TIMEOUT, falls back to timeout_ms. *)
+  timeout_logs_ms: int;
+      (** Timeout for log exports. Read from OTEL_EXPORTER_OTLP_LOGS_TIMEOUT,
+          falls back to timeout_ms. *)
+  batch_traces: int option;
+      (** Batch traces? If [Some i], then this produces batches of (at most) [i]
+          items. If [None], there is no batching.
+
+          Note that traces and metrics are batched separately. Default
+          [Some 400]. *)
+  batch_metrics: int option;
+      (** Batch metrics? If [Some i], then this produces batches of (at most)
+          [i] items. If [None], there is no batching.
+
+          Note that traces and metrics are batched separately. Default
+          [Some 200]. *)
+  batch_logs: int option;
+      (** Batch logs? See {!batch_metrics} for details. Default [Some 400] *)
+  batch_timeout_ms: int;
+      (** Number of milliseconds after which we will emit a batch, even
+          incomplete. Note that the batch might take longer than that, because
+          this is only checked when a new event occurs or when a tick is
+          emitted. Default 2_000. *)
+  self_trace: bool;
+      (** If true, the OTEL library will perform some self-instrumentation.
+          Default [false].
+          @since 0.7 *)
+  http_concurrency_level: int option;
+      (** How many HTTP requests can be done simultaneously (at most)? This can
+          be used to represent the size of a pool of workers where each worker
+          gets a batch to send, send it, and repeats.
+          @since NEXT_RELEASE *)
+  _rest: rest;
+}
+(** Configuration.
+
+    To build one, use {!make} below. This might be extended with more fields in
+    the future. *)
+
+val default_url : string
+(** The default base URL for the config. *)
+
+val pp : Format.formatter -> t -> unit
+
+type 'k make =
+  ?debug:bool ->
+  ?log_level:log_level ->
+  ?sdk_disabled:bool ->
+  ?url:string ->
+  ?url_traces:string ->
+  ?url_metrics:string ->
+  ?url_logs:string ->
+  ?batch_traces:int option ->
+  ?batch_metrics:int option ->
+  ?batch_logs:int option ->
+  ?headers:(string * string) list ->
+  ?headers_traces:(string * string) list ->
+  ?headers_metrics:(string * string) list ->
+  ?headers_logs:(string * string) list ->
+  ?protocol:protocol ->
+  ?timeout_ms:int ->
+  ?timeout_traces_ms:int ->
+  ?timeout_metrics_ms:int ->
+  ?timeout_logs_ms:int ->
+  ?batch_timeout_ms:int ->
+  ?self_trace:bool ->
+  ?http_concurrency_level:int ->
+  'k
+(** A function that gathers all the values needed to construct a {!t}, and
+    produces a ['k]. ['k] is typically a continuation used to construct a
+    configuration that includes a {!t}.
+
+    @param url
+      base url used to construct per-signal urls. Per-signal url options take
+      precedence over this base url. If not provided, this defaults to
+      "OTEL_EXPORTER_OTLP_ENDPOINT" if set, or if not {!default_url}.
+
+    Example of constructed per-signal urls with the base url
+    http://localhost:4318
+    - Traces: http://localhost:4318/v1/traces
+    - Metrics: http://localhost:4318/v1/metrics
+    - Logs: http://localhost:4318/v1/logs
+
+    Use per-signal url options if different urls are needed for each signal
+    type.
+
+    @param url_traces
+      url to send traces, or "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" if set. The
+      url is used as-is without any modification.
+
+    @param url_metrics
+      url to send metrics, or "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT" if set. The
+      url is used as-is without any modification.
+
+    @param url_logs
+      url to send logs, or "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT" if set. The url is
+      used as-is without any modification. *)
+
+(** Construct, inspect, and update {!t} configurations, drawing defaults from
+    the environment *)
+module type ENV = sig
+  val make : (t -> 'a) -> 'a make
+  (** [make f] is a {!type:make} function that will give [f] a safely
+      constructed {!t}.
+
+      Typically this is used to extend the constructor for {!t} with new
+      optional arguments.
+
+      E.g., we can construct a configuration that includes a {!t} alongside a
+      more specific field like so:
+
+      {[
+        type extended_config = {
+          new_field: string;
+          common: t;
+        }
+
+        let make : (new_field:string -> unit -> extended_config) make =
+          Env.make (fun common ~new_field () -> { new_field; common })
+
+        let _example : extended_config =
+          make ~new_field:"foo" ~url_traces:"foo/bar" ~debug:true ()
+      ]}
+
+      As a special case, we can get the simple constructor function for {!t}
+      with [Env.make (fun common () -> common)] *)
+end
+
+(** A generative functor that produces a state-space that can read configuration
+    values from the environment, provide stateful configuration setting and
+    accessing operations, and a way to make a new {!t} configuration record *)
+module Env : functor () -> ENV

src/client/generic_http_consumer.ml

@@ -19,6 +19,7 @@ module type HTTPC = sig
   val send :
     t ->
     url:string ->
+    headers:(string * string) list ->
     decode:[ `Dec of Pbrt.Decoder.t -> 'a | `Ret of 'a ] ->
     string ->
     ('a, error) result IO.t
@@ -62,14 +63,22 @@ end = struct
     let send (self : t) (sigs : OTEL.Any_signal_l.t) : (unit, error) result IO.t
         =
       let res = Resource_signal.of_signal_l sigs in
-      let url =
+      let url, signal_headers =
         match res with
-        | Logs _ -> self.config.url_logs
+        | Logs _ -> self.config.url_logs, self.config.headers_logs
-        | Traces _ -> self.config.url_traces
+        | Traces _ -> self.config.url_traces, self.config.headers_traces
-        | Metrics _ -> self.config.url_metrics
+        | Metrics _ -> self.config.url_metrics, self.config.headers_metrics
       in
+      (* Merge general headers with signal-specific ones (signal-specific takes precedence) *)
+      let signal_keys = List.map fst signal_headers in
+      let filtered_general =
+        List.filter
+          (fun (k, _) -> not (List.mem k signal_keys))
+          self.config.headers
+      in
+      let headers = List.rev_append signal_headers filtered_general in
       let data = Resource_signal.Encode.any ~encoder:self.encoder res in
-      Httpc.send self.http ~url ~decode:(`Ret ()) data
+      Httpc.send self.http ~url ~headers ~decode:(`Ret ()) data
   end
 
   module C = Generic_consumer.Make (IO) (Notifier) (Sender)

src/client/http_config.ml

@@ -1,182 +1,3 @@
-type t = {
+(** @deprecated Use {!Exporter_config} instead *)
-  debug: bool;
-  url_traces: string;
-  url_metrics: string;
-  url_logs: string;
-  headers: (string * string) list;
-  batch_traces: int option;
-  batch_metrics: int option;
-  batch_logs: int option;
-  batch_timeout_ms: int;
-  self_trace: bool;
-  http_concurrency_level: int option;
-}
 
-let pp out (self : t) : unit =
+include Exporter_config
-  let ppiopt out i =
-    match i with
-    | None -> Format.fprintf out "None"
-    | Some i -> Format.fprintf out "%d" i
-  in
-  let pp_header ppf (a, b) = Format.fprintf ppf "@[%s: @,%s@]@." a b in
-  let ppheaders out l =
-    Format.fprintf out "[@[%a@]]" (Format.pp_print_list pp_header) l
-  in
-  let {
-    debug;
-    self_trace;
-    url_traces;
-    url_metrics;
-    url_logs;
-    headers;
-    batch_traces;
-    batch_metrics;
-    batch_logs;
-    batch_timeout_ms;
-    http_concurrency_level;
-  } =
-    self
-  in
-  Format.fprintf out
-    "{@[ debug=%B;@ self_trace=%B; url_traces=%S;@ url_metrics=%S;@ \
-     url_logs=%S;@ @[<2>headers=@,\
-     %a@];@ batch_traces=%a;@ batch_metrics=%a;@ batch_logs=%a;@ \
-     batch_timeout_ms=%d;@ http_concurrency_level=%a @]}"
-    debug self_trace url_traces url_metrics url_logs ppheaders headers ppiopt
-    batch_traces ppiopt batch_metrics ppiopt batch_logs batch_timeout_ms ppiopt
-    http_concurrency_level
-
-let default_url = "http://localhost:4318"
-
-type 'k make =
-  ?debug:bool ->
-  ?url:string ->
-  ?url_traces:string ->
-  ?url_metrics:string ->
-  ?url_logs:string ->
-  ?batch_traces:int option ->
-  ?batch_metrics:int option ->
-  ?batch_logs:int option ->
-  ?headers:(string * string) list ->
-  ?batch_timeout_ms:int ->
-  ?self_trace:bool ->
-  ?http_concurrency_level:int ->
-  'k
-
-module type ENV = sig
-  val get_debug : unit -> bool
-
-  val set_debug : bool -> unit
-
-  val get_headers : unit -> (string * string) list
-
-  val set_headers : (string * string) list -> unit
-
-  val make : (t -> 'a) -> 'a make
-end
-
-module Env () : ENV = struct
-  let debug_ =
-    ref
-      (match Sys.getenv_opt "OTEL_OCAML_DEBUG" with
-      | Some ("1" | "true") -> true
-      | _ -> false)
-
-  let get_debug () = !debug_
-
-  let set_debug b = debug_ := b
-
-  let make_get_from_env env_name =
-    let value = ref None in
-    fun () ->
-      match !value with
-      | None ->
-        value := Sys.getenv_opt env_name;
-        !value
-      | Some value -> Some value
-
-  let get_url_from_env = make_get_from_env "OTEL_EXPORTER_OTLP_ENDPOINT"
-
-  let get_url_traces_from_env =
-    make_get_from_env "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT"
-
-  let get_url_metrics_from_env =
-    make_get_from_env "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT"
-
-  let get_url_logs_from_env =
-    make_get_from_env "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT"
-
-  let remove_trailing_slash url =
-    if url <> "" && String.get url (String.length url - 1) = '/' then
-      String.sub url 0 (String.length url - 1)
-    else
-      url
-
-  let parse_headers s =
-    let parse_header s =
-      match String.split_on_char '=' s with
-      | [ key; value ] -> key, value
-      | _ -> failwith "Unexpected format for header"
-    in
-    String.split_on_char ',' s |> List.map parse_header
-
-  let default_headers = []
-
-  let headers =
-    ref
-      (try parse_headers (Sys.getenv "OTEL_EXPORTER_OTLP_HEADERS")
-       with _ -> default_headers)
-
-  let get_headers () = !headers
-
-  let set_headers s = headers := s
-
-  let make k ?(debug = get_debug ()) ?url ?url_traces ?url_metrics ?url_logs
-      ?(batch_traces = Some 400) ?(batch_metrics = Some 200)
-      ?(batch_logs = Some 400) ?(headers = get_headers ())
-      ?(batch_timeout_ms = 2_000) ?(self_trace = false) ?http_concurrency_level
-      =
-    (* Ensure the state is synced, in case these values are passed in explicitly *)
-    set_debug debug;
-    set_headers headers;
-    let url_traces, url_metrics, url_logs =
-      let base_url =
-        let base_url =
-          match get_url_from_env () with
-          | None -> Option.value url ~default:default_url
-          | Some url -> remove_trailing_slash url
-        in
-        remove_trailing_slash base_url
-      in
-      let url_traces =
-        match get_url_traces_from_env () with
-        | None -> Option.value url_traces ~default:(base_url ^ "/v1/traces")
-        | Some url -> url
-      in
-      let url_metrics =
-        match get_url_metrics_from_env () with
-        | None -> Option.value url_metrics ~default:(base_url ^ "/v1/metrics")
-        | Some url -> url
-      in
-      let url_logs =
-        match get_url_logs_from_env () with
-        | None -> Option.value url_logs ~default:(base_url ^ "/v1/logs")
-        | Some url -> url
-      in
-      url_traces, url_metrics, url_logs
-    in
-    k
-      {
-        debug;
-        url_traces;
-        url_metrics;
-        url_logs;
-        headers;
-        batch_traces;
-        batch_metrics;
-        batch_logs;
-        batch_timeout_ms;
-        self_trace;
-        http_concurrency_level;
-      }
-end

src/client/http_config.mli

@@ -1,139 +1,4 @@
-(** Constructing and managing the configuration common to many (most?)
+(** @deprecated Use {!Exporter_config} instead *)
-    HTTP-based clients.
 
-    This is extended and reused by concrete client implementations that exports
+include module type of Exporter_config
-    signals over HTTP, depending on their needs. *)
+[@@deprecated "use Exporter_config instead"]
-
-type t = private {
-  debug: bool;  (** Debug the client itself? *)
-  url_traces: string;  (** Url to send traces/spans *)
-  url_metrics: string;  (** Url to send metrics*)
-  url_logs: string;  (** Url to send logs *)
-  headers: (string * string) list;
-      (** API headers sent to the endpoint. Default is none or
-          "OTEL_EXPORTER_OTLP_HEADERS" if set. *)
-  batch_traces: int option;
-      (** Batch traces? If [Some i], then this produces batches of (at most) [i]
-          items. If [None], there is no batching.
-
-          Note that traces and metrics are batched separately. Default
-          [Some 400]. *)
-  batch_metrics: int option;
-      (** Batch metrics? If [Some i], then this produces batches of (at most)
-          [i] items. If [None], there is no batching.
-
-          Note that traces and metrics are batched separately. Default
-          [Some 200]. *)
-  batch_logs: int option;
-      (** Batch logs? See {!batch_metrics} for details. Default [Some 400] *)
-  batch_timeout_ms: int;
-      (** Number of milliseconds after which we will emit a batch, even
-          incomplete. Note that the batch might take longer than that, because
-          this is only checked when a new event occurs or when a tick is
-          emitted. Default 2_000. *)
-  self_trace: bool;
-      (** If true, the OTEL library will perform some self-instrumentation.
-          Default [false].
-          @since 0.7 *)
-  http_concurrency_level: int option;
-      (** How many HTTP requests can be done simultaneously (at most)? This can
-          be used to represent the size of a pool of workers where each worker
-          gets a batch to send, send it, and repeats.
-          @since NEXT_RELEASE *)
-}
-(** Configuration.
-
-    To build one, use {!make} below. This might be extended with more fields in
-    the future. *)
-
-val default_url : string
-(** The default base URL for the config. *)
-
-val pp : Format.formatter -> t -> unit
-
-type 'k make =
-  ?debug:bool ->
-  ?url:string ->
-  ?url_traces:string ->
-  ?url_metrics:string ->
-  ?url_logs:string ->
-  ?batch_traces:int option ->
-  ?batch_metrics:int option ->
-  ?batch_logs:int option ->
-  ?headers:(string * string) list ->
-  ?batch_timeout_ms:int ->
-  ?self_trace:bool ->
-  ?http_concurrency_level:int ->
-  'k
-(** A function that gathers all the values needed to construct a {!t}, and
-    produces a ['k]. ['k] is typically a continuation used to construct a
-    configuration that includes a {!t}.
-
-    @param url
-      base url used to construct per-signal urls. Per-signal url options take
-      precedence over this base url. If not provided, this defaults to
-      "OTEL_EXPORTER_OTLP_ENDPOINT" if set, or if not {!default_url}.
-
-    Example of constructed per-signal urls with the base url
-    http://localhost:4318
-    - Traces: http://localhost:4318/v1/traces
-    - Metrics: http://localhost:4318/v1/metrics
-    - Logs: http://localhost:4318/v1/logs
-
-    Use per-signal url options if different urls are needed for each signal
-    type.
-
-    @param url_traces
-      url to send traces, or "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" if set. The
-      url is used as-is without any modification.
-
-    @param url_metrics
-      url to send metrics, or "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT" if set. The
-      url is used as-is without any modification.
-
-    @param url_logs
-      url to send logs, or "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT" if set. The url is
-      used as-is without any modification. *)
-
-(** Construct, inspect, and update {!t} configurations, drawing defaults from
-    the environment and encapsulating state *)
-module type ENV = sig
-  val get_debug : unit -> bool
-
-  val set_debug : bool -> unit
-
-  val get_headers : unit -> (string * string) list
-
-  val set_headers : (string * string) list -> unit
-
-  val make : (t -> 'a) -> 'a make
-  (** [make f] is a {!type:make} function that will give [f] a safely
-      constructed {!t}.
-
-      Typically this is used to extend the constructor for {!t} with new
-      optional arguments.
-
-      E.g., we can construct a configuration that includes a {!t} alongside a
-      more specific field like so:
-
-      {[
-        type extended_config = {
-          new_field: string;
-          common: t;
-        }
-
-        let make : (new_field:string -> unit -> extended_config) make =
-          Env.make (fun common ~new_field () -> { new_field; common })
-
-        let _example : extended_config =
-          make ~new_field:"foo" ~url_traces:"foo/bar" ~debug:true ()
-      ]}
-
-      As a special case, we can get the simple constructor function for {!t}
-      with [Env.make (fun common () -> common)] *)
-end
-
-(** A generative functor that produces a state-space that can read configuration
-    values from the environment, provide stateful configuration setting and
-    accessing operations, and a way to make a new {!t} configuration record *)
-module Env : functor () -> ENV

src/lib/globals.ml

@@ -4,7 +4,11 @@ open Common_
 open Proto.Common
 
 (** Main service name metadata *)
-let service_name = ref "unknown_service"
+let service_name =
+  ref
+    (match Sys.getenv_opt "OTEL_SERVICE_NAME" with
+    | Some name -> name
+    | None -> "unknown_service")
 
 (** Namespace for the service *)
 let service_namespace = ref None

tests/client/test_client_lib.ml

@@ -7,41 +7,19 @@ let test_config_printing () =
     Format.asprintf "%a" Config.pp @@ Env.make (fun common () -> common) ()
   in
   let expected =
-    "{ debug=false;\n\
+    "{ debug=false; log_level=none; sdk_disabled=false; self_trace=false;\n\
-    \ self_trace=false; url_traces=\"http://localhost:4318/v1/traces\";\n\
+    \ url_traces=\"http://localhost:4318/v1/traces\";\n\
     \ url_metrics=\"http://localhost:4318/v1/metrics\";\n\
-    \ url_logs=\"http://localhost:4318/v1/logs\"; headers=[]; batch_traces=400;\n\
+    \ url_logs=\"http://localhost:4318/v1/logs\"; headers=[]; headers_traces=[];\n\
-    \ batch_metrics=200; batch_logs=400; batch_timeout_ms=2000;\n\
+    \ headers_metrics=[]; headers_logs=[]; protocol=http/protobuf;\n\
-    \ http_concurrency_level=None }"
+    \ timeout_ms=10000; timeout_traces_ms=10000; timeout_metrics_ms=10000;\n\
+    \ timeout_logs_ms=10000; batch_traces=400; batch_metrics=200; \
+     batch_logs=400;\n\
+    \ batch_timeout_ms=2000; http_concurrency_level=None }"
   in
   check' string ~msg:"is rendered correctly" ~actual ~expected
 
-let test_overriding_stateful_config () =
-  let module Env = Config.Env () in
-  Env.set_headers [ "foo", "bar" ];
-  Env.set_debug true;
-  let headers = [ "changed", "header" ] in
-  let debug = false in
-  let config : Config.t =
-    Env.make (fun common () -> common) ~debug ~headers ()
-  in
-  check'
-    (list (pair string string))
-    ~msg:"header is overriden" ~actual:(Env.get_headers ()) ~expected:headers;
-  check'
-    (list (pair string string))
-    ~msg:"config and stateful headers are the same" ~actual:(Env.get_headers ())
-    ~expected:config.headers;
-  check' bool ~msg:"debug is overriden" ~actual:(Env.get_debug ())
-    ~expected:debug;
-  check' bool ~msg:"config and stateful debug are the same"
-    ~actual:(Env.get_debug ()) ~expected:config.debug
-
 let suite =
-  [
+  [ test_case "default config pretty printing" `Quick test_config_printing ]
-    test_case "default config pretty printing" `Quick test_config_printing;
-    test_case "overriding default stateful values via make constructor" `Quick
-      test_overriding_stateful_config;
-  ]
 
 let () = Alcotest.run "Opentelemetry_client" [ "Config", suite ]