From 69d1d512e3368594193c8112265d8ad196a6b1b6 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 12 Feb 2026 12:34:28 +0000 Subject: [PATCH] add missing OTEL env variables - Rename http_config to exporter_config with deprecated alias - add OTEL_SDK_DISABLED support (sdk_disabled field) - add OTEL_EXPORTER_OTLP_PROTOCOL support (Http_protobuf | Http_json) - add OTEL_LOG_LEVEL support (log_level field replacing debug bool) - add OTEL_EXPORTER_OTLP_TIMEOUT and per-signal timeout variants - add per-signal headers (OTEL_EXPORTER_OTLP_{TRACES,METRICS,LOGS}_HEADERS) - add OTEL_SERVICE_NAME support also remove some globals and put most config in `exporter_config.ml`, which is no longer a private record. --- .../opentelemetry_client_cohttp_eio.ml | 8 +- .../opentelemetry_client_cohttp_eio.mli | 5 - .../opentelemetry_client_cohttp_lwt.ml | 9 +- .../opentelemetry_client_cohttp_lwt.mli | 5 - .../opentelemetry_client_ocurl_lwt.ml | 9 +- .../opentelemetry_client_ocurl_lwt.mli | 5 - .../opentelemetry_client_ocurl.ml | 9 +- .../opentelemetry_client_ocurl.mli | 5 - src/client/exporter_config.ml | 332 ++++++++++++++++++ src/client/exporter_config.mli | 190 ++++++++++ src/client/generic_http_consumer.ml | 19 +- src/client/http_config.ml | 183 +--------- src/client/http_config.mli | 140 +------- src/lib/globals.ml | 6 +- 14 files changed, 556 insertions(+), 369 deletions(-) create mode 100644 src/client/exporter_config.ml create mode 100644 src/client/exporter_config.mli diff --git a/src/client-cohttp-eio/opentelemetry_client_cohttp_eio.ml b/src/client-cohttp-eio/opentelemetry_client_cohttp_eio.ml index 50c03ec7..08f7700c 100644 --- a/src/client-cohttp-eio/opentelemetry_client_cohttp_eio.ml +++ b/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 diff --git a/src/client-cohttp-eio/opentelemetry_client_cohttp_eio.mli b/src/client-cohttp-eio/opentelemetry_client_cohttp_eio.mli index 6a6aede9..814180a6 100644 --- a/src/client-cohttp-eio/opentelemetry_client_cohttp_eio.mli +++ b/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 : diff --git a/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml b/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml index d8b52b83..2c93c61b 100644 --- a/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml +++ b/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 diff --git a/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.mli b/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.mli index beb2d216..9198063b 100644 --- a/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.mli +++ b/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 : diff --git a/src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.ml b/src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.ml index 131d45a3..d42a8281 100644 --- a/src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.ml +++ b/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) () diff --git a/src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.mli b/src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.mli index 1a10f6f7..46ad1fab 100644 --- a/src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.mli +++ b/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 : diff --git a/src/client-ocurl/opentelemetry_client_ocurl.ml b/src/client-ocurl/opentelemetry_client_ocurl.ml index f24d0e84..d34b9dfc 100644 --- a/src/client-ocurl/opentelemetry_client_ocurl.ml +++ b/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) () diff --git a/src/client-ocurl/opentelemetry_client_ocurl.mli b/src/client-ocurl/opentelemetry_client_ocurl.mli index 39558157..ee779256 100644 --- a/src/client-ocurl/opentelemetry_client_ocurl.mli +++ b/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 diff --git a/src/client/exporter_config.ml b/src/client/exporter_config.ml new file mode 100644 index 00000000..809a3236 --- /dev/null +++ b/src/client/exporter_config.ml @@ -0,0 +1,332 @@ +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; [@alert deprecated "Use log_level instead"] + 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; +} + +let pp out (self : t) : unit = + 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 pp_protocol out = function + | Http_protobuf -> Format.fprintf out "http/protobuf" + | Http_json -> Format.fprintf out "http/json" + in + 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" + in + 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 + +module Env () : ENV = 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\n%!" s; + Log_level_none + | 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 _ -> [] + + 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 diff --git a/src/client/exporter_config.mli b/src/client/exporter_config.mli new file mode 100644 index 00000000..071ac15c --- /dev/null +++ b/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 diff --git a/src/client/generic_http_consumer.ml b/src/client/generic_http_consumer.ml index 6fd80fd1..9256fe4b 100644 --- a/src/client/generic_http_consumer.ml +++ b/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 - | Traces _ -> self.config.url_traces - | Metrics _ -> self.config.url_metrics + | Logs _ -> self.config.url_logs, self.config.headers_logs + | Traces _ -> self.config.url_traces, self.config.headers_traces + | 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) diff --git a/src/client/http_config.ml b/src/client/http_config.ml index efc1c011..ff2b3f0a 100644 --- a/src/client/http_config.ml +++ b/src/client/http_config.ml @@ -1,182 +1,3 @@ -type t = { - 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; -} +(** @deprecated Use {!Exporter_config} instead *) -let pp out (self : t) : unit = - 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 +include Exporter_config diff --git a/src/client/http_config.mli b/src/client/http_config.mli index cdc48de7..135d99e9 100644 --- a/src/client/http_config.mli +++ b/src/client/http_config.mli @@ -1,139 +1,3 @@ -(** Constructing and managing the configuration common to many (most?) - HTTP-based clients. +(** @deprecated Use {!Exporter_config} instead *) - This is extended and reused by concrete client implementations that exports - signals over HTTP, depending on their needs. *) - -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 +include module type of Exporter_config diff --git a/src/lib/globals.ml b/src/lib/globals.ml index c4d3c55b..4dc88055 100644 --- a/src/lib/globals.ml +++ b/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