mor efixes

This commit is contained in:
Simon Cruanes 2025-12-04 21:10:21 -05:00
parent 00cf5aa712
commit 4f218b31ef
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
11 changed files with 68 additions and 49 deletions

View file

@ -28,11 +28,6 @@
(>= "4.08")) (>= "4.08"))
ptime ptime
hmap hmap
atomic
(thread-local-storage
(and
(>= 0.2)
(< 0.3)))
(odoc :with-doc) (odoc :with-doc)
(alcotest :with-test) (alcotest :with-test)
(pbrt (pbrt
@ -46,14 +41,33 @@
(>= 0.27) (>= 0.27)
(< 0.28))) (< 0.28)))
(mtime (mtime
(>= "1.4"))) (>= "1.4")))
(depopts trace lwt eio) (depopts atomic trace thread-local-storage lwt eio)
(conflicts (conflicts
(trace (trace
(< 0.10))) (< 0.10)))
(tags (tags
(instrumentation tracing opentelemetry datadog jaeger))) (instrumentation tracing opentelemetry datadog jaeger)))
(package
(name opentelemetry-client)
(synopsis "Client SDK for https://opentelemetry.io")
(depends
(opentelemetry
(= :version))
(odoc :with-doc)
(alcotest :with-test)
(saturn
(and
(>= 1.0)
(< 2.0)))
(thread-local-storage
(and
(>= 0.2)
(< 0.3))))
(tags
(tracing opentelemetry sdk)))
(package (package
(name opentelemetry-lwt) (name opentelemetry-lwt)
(synopsis "Lwt-compatible instrumentation for https://opentelemetry.io") (synopsis "Lwt-compatible instrumentation for https://opentelemetry.io")
@ -83,6 +97,8 @@
; atomic ; vendored ; atomic ; vendored
(opentelemetry (opentelemetry
(= :version)) (= :version))
(opentelemetry-client
(= :version))
(odoc :with-doc) (odoc :with-doc)
(ezcurl (ezcurl
(>= 0.2.3)) (>= 0.2.3))
@ -99,6 +115,8 @@
(>= "1.4")) (>= "1.4"))
(opentelemetry (opentelemetry
(= :version)) (= :version))
(opentelemetry-client
(= :version))
(odoc :with-doc) (odoc :with-doc)
(ezcurl-lwt (ezcurl-lwt
(>= 0.2.3)) (>= 0.2.3))
@ -124,10 +142,14 @@
(containers :with-test) (containers :with-test)
(cohttp-lwt-unix :with-test) (cohttp-lwt-unix :with-test)
(opentelemetry-client-cohttp-lwt (opentelemetry-client-cohttp-lwt
(and :with-test (= :version))) (and
:with-test
(= :version)))
(opentelemetry-cohttp-lwt (opentelemetry-cohttp-lwt
(and :with-test (= :version)))) (and
(synopsis "Opentelemetry tracing for Cohttp HTTP servers")) :with-test
(= :version))))
(synopsis "Opentelemetry-based reporter for Logs"))
(package (package
(name opentelemetry-cohttp-lwt) (name opentelemetry-cohttp-lwt)
@ -156,6 +178,8 @@
; for spans ; for spans
(opentelemetry (opentelemetry
(= :version)) (= :version))
(opentelemetry-client
(= :version))
(odoc :with-doc) (odoc :with-doc)
(lwt (lwt
(>= "5.3")) (>= "5.3"))
@ -165,7 +189,10 @@
cohttp-lwt-unix cohttp-lwt-unix
(alcotest :with-test) (alcotest :with-test)
(containers :with-test) (containers :with-test)
(opentelemetry-lwt (and :with-test (= :version)))) (opentelemetry-lwt
(and
:with-test
(= :version))))
(synopsis "Collector client for opentelemetry, using cohttp + lwt")) (synopsis "Collector client for opentelemetry, using cohttp + lwt"))
(package (package
@ -179,6 +206,8 @@
mirage-crypto-rng-eio mirage-crypto-rng-eio
(opentelemetry (opentelemetry
(= :version)) (= :version))
(opentelemetry-client
(= :version))
(odoc :with-doc) (odoc :with-doc)
(cohttp-eio (cohttp-eio
(>= 6.1.0)) (>= 6.1.0))

View file

@ -11,7 +11,6 @@
Opentelemetry_atomic) Opentelemetry_atomic)
(libraries (libraries
hmap hmap
atomic
opentelemetry.ambient-context.core opentelemetry.ambient-context.core
opentelemetry.atomic opentelemetry.atomic
(select (select

View file

@ -6,7 +6,7 @@
(>= %{ocaml_version} 5.0)) (>= %{ocaml_version} 5.0))
(libraries (libraries
opentelemetry opentelemetry
opentelemetry.client opentelemetry-client
eio eio
eio.unix eio.unix
cohttp cohttp

View file

@ -6,7 +6,7 @@
(pps lwt_ppx)) (pps lwt_ppx))
(libraries (libraries
opentelemetry opentelemetry
opentelemetry.client opentelemetry-client
lwt lwt
cohttp-lwt cohttp-lwt
cohttp-lwt-unix cohttp-lwt-unix

View file

@ -7,7 +7,7 @@
(libraries (libraries
opentelemetry opentelemetry
opentelemetry.atomic opentelemetry.atomic
opentelemetry.client opentelemetry-client
pbrt pbrt
mtime mtime
mtime.clock.os mtime.clock.os

View file

@ -4,7 +4,7 @@
(libraries (libraries
opentelemetry opentelemetry
opentelemetry.atomic opentelemetry.atomic
opentelemetry.client opentelemetry-client
curl curl
pbrt pbrt
threads threads

View file

@ -5,7 +5,7 @@
open Opentelemetry_client open Opentelemetry_client
open Common_ open Common_
module OT = Opentelemetry module OTEL = Opentelemetry
module Config = Config module Config = Config
let get_headers = Config.Env.get_headers let get_headers = Config.Env.get_headers
@ -52,26 +52,13 @@ let start_bg_thread (f : unit -> unit) : Thread.t =
Thread.create run () Thread.create run ()
let str_to_hex (s : string) : string = let str_to_hex (s : string) : string =
let i_to_hex (i : int) = Opentelemetry_util.Util_bytes_.bytes_to_hex (Bytes.unsafe_of_string s)
if i < 10 then
Char.chr (i + Char.code '0')
else
Char.chr (i - 10 + Char.code 'a')
in
let res = Bytes.create (2 * String.length s) in
for i = 0 to String.length s - 1 do
let n = Char.code (String.get s i) in
Bytes.set res (2 * i) (i_to_hex ((n land 0xf0) lsr 4));
Bytes.set res ((2 * i) + 1) (i_to_hex (n land 0x0f))
done;
Bytes.unsafe_to_string res
module Exporter_impl : sig module Exporter_impl : sig
val n_bytes_sent : int Atomic.t val n_bytes_sent : int Atomic.t
class type t = object class type t = object
inherit OT.Exporter.t inherit OTEL.Exporter.t
method shutdown : on_done:(unit -> unit) -> unit -> unit method shutdown : on_done:(unit -> unit) -> unit -> unit
end end
@ -85,7 +72,7 @@ end = struct
let n_bytes_sent : int Atomic.t = Atomic.make 0 let n_bytes_sent : int Atomic.t = Atomic.make 0
class type t = object class type t = object
inherit OT.Exporter.t inherit OTEL.Exporter.t
method shutdown : on_done:(unit -> unit) -> unit -> unit method shutdown : on_done:(unit -> unit) -> unit -> unit
end end
@ -301,12 +288,12 @@ end = struct
end end
let create_exporter ?(stop = Atomic.make false) let create_exporter ?(stop = Atomic.make false)
?(config : Config.t = Config.make ()) () : #OT.Exporter.t = ?(config : Config.t = Config.make ()) () : #OTEL.Exporter.t =
let backend = Exporter_impl.create ~stop ~config () in let backend = Exporter_impl.create ~stop ~config () in
(backend :> OT.Exporter.t) (backend :> OTEL.Exporter.t)
(** thread that calls [tick()] regularly, to help enforce timeouts *) (** thread that calls [tick()] regularly, to help enforce timeouts *)
let setup_ticker_thread ~stop ~sleep_ms (exp : #OT.Exporter.t) () = let setup_ticker_thread ~stop ~sleep_ms (exp : #OTEL.Exporter.t) () =
let sleep_s = float sleep_ms /. 1000. in let sleep_s = float sleep_ms /. 1000. in
let tick_loop () = let tick_loop () =
try try
@ -326,7 +313,7 @@ let setup_ticker_thread ~stop ~sleep_ms (exp : #OT.Exporter.t) () =
let setup_ ?(stop = Atomic.make false) ?(config : Config.t = Config.make ()) () let setup_ ?(stop = Atomic.make false) ?(config : Config.t = Config.make ()) ()
: unit = : unit =
let exporter = Exporter_impl.create ~stop ~config () in let exporter = Exporter_impl.create ~stop ~config () in
OT.Exporter.Main_exporter.set exporter; OTEL.Exporter.Main_exporter.set exporter;
Self_trace.set_enabled config.common.self_trace; Self_trace.set_enabled config.common.self_trace;
@ -338,7 +325,7 @@ let setup_ ?(stop = Atomic.make false) ?(config : Config.t = Config.make ()) ()
let remove_backend () : unit = let remove_backend () : unit =
(* we don't need the callback, this runs in the same thread *) (* we don't need the callback, this runs in the same thread *)
OT.Exporter.Main_exporter.remove () ~on_done:ignore OTEL.Exporter.Main_exporter.remove () ~on_done:ignore
let setup ?stop ?config ?(enable = true) () = let setup ?stop ?config ?(enable = true) () =
if enable then setup_ ?stop ?config () if enable then setup_ ?stop ?config ()

View file

@ -1,6 +1,6 @@
(library (library
(name opentelemetry_client) (name opentelemetry_client)
(public_name opentelemetry.client) (public_name opentelemetry-client)
(flags :standard -open Opentelemetry_util) (flags :standard -open Opentelemetry_util)
(libraries (libraries
opentelemetry opentelemetry
@ -8,7 +8,8 @@
opentelemetry.emitter opentelemetry.emitter
opentelemetry.proto opentelemetry.proto
pbrt pbrt
saturn
mtime mtime
mtime.clock.os) mtime.clock.os)
(synopsis (synopsis
"Basic exporters, as well as Common types and logic shared between exporters")) "Basic exporters, as well as common types and logic shared between exporters"))

View file

@ -47,7 +47,8 @@ let pp_flags = Proto.Logs.pp_log_record_flags
(** Make a single log entry *) (** Make a single log entry *)
let make ?time ?(observed_time_unix_nano = Timestamp_ns.now_unix_ns ()) let make ?time ?(observed_time_unix_nano = Timestamp_ns.now_unix_ns ())
?severity ?log_level ?flags ?trace_id ?span_id (body : Value.t) : t = ?severity ?log_level ?flags ?trace_id ?span_id ?(attrs = [])
(body : Value.t) : t =
let time_unix_nano = let time_unix_nano =
match time with match time with
| None -> observed_time_unix_nano | None -> observed_time_unix_nano
@ -56,21 +57,22 @@ let make ?time ?(observed_time_unix_nano = Timestamp_ns.now_unix_ns ())
let trace_id = Option.map Trace_id.to_bytes trace_id in let trace_id = Option.map Trace_id.to_bytes trace_id in
let span_id = Option.map Span_id.to_bytes span_id in let span_id = Option.map Span_id.to_bytes span_id in
let body = Value.conv body in let body = Value.conv body in
let attributes = List.map Key_value.conv attrs in
make_log_record ~time_unix_nano ~observed_time_unix_nano make_log_record ~time_unix_nano ~observed_time_unix_nano
?severity_number:severity ?severity_text:log_level ?flags ?trace_id ?span_id ?severity_number:severity ?severity_text:log_level ?flags ?trace_id ?span_id
?body () ~attributes ?body ()
(** Make a log entry whose body is a string *) (** Make a log entry whose body is a string *)
let make_str ?time ?observed_time_unix_nano ?severity ?log_level ?flags let make_str ?time ?observed_time_unix_nano ?severity ?log_level ?flags
?trace_id ?span_id (body : string) : t = ?trace_id ?span_id ?attrs (body : string) : t =
make ?time ?observed_time_unix_nano ?severity ?log_level ?flags ?trace_id make ?time ?observed_time_unix_nano ?severity ?log_level ?flags ?trace_id
?span_id (`String body) ?span_id ?attrs (`String body)
(** Make a log entry with format *) (** Make a log entry with format *)
let make_strf ?time ?observed_time_unix_nano ?severity ?log_level ?flags let make_strf ?time ?observed_time_unix_nano ?severity ?log_level ?flags
?trace_id ?span_id fmt = ?trace_id ?span_id ?attrs fmt =
Format.kasprintf Format.kasprintf
(fun bod -> (fun bod ->
make_str ?time ?observed_time_unix_nano ?severity ?log_level ?flags make_str ?time ?observed_time_unix_nano ?severity ?log_level ?flags
?trace_id ?span_id bod) ?trace_id ?span_id ?attrs bod)
fmt fmt

View file

@ -24,6 +24,7 @@ module Timestamp_ns = Timestamp_ns
(** {2 Export signals to some external collector.} *) (** {2 Export signals to some external collector.} *)
module Emitter = Opentelemetry_emitter.Emitter
module Exporter = Exporter module Exporter = Exporter
module Main_exporter = Main_exporter module Main_exporter = Main_exporter

View file

@ -20,10 +20,10 @@ module Tracer = struct
include Tracer include Tracer
(** Sync span guard *) (** Sync span guard *)
let with_ ?force_new_trace_id ?trace_state ?attrs ?kind ?trace_id ?parent let with_ (self : t) ?force_new_trace_id ?trace_state ?attrs ?kind ?trace_id
?links name (cb : Span.t -> 'a Lwt.t) : 'a Lwt.t = ?parent ?links name (cb : Span.t -> 'a Lwt.t) : 'a Lwt.t =
let thunk, finally = let thunk, finally =
with_thunk_and_finally ?force_new_trace_id ?trace_state ?attrs ?kind with_thunk_and_finally self ?force_new_trace_id ?trace_state ?attrs ?kind
?trace_id ?parent ?links name cb ?trace_id ?parent ?links name cb
in in