diff --git a/devkit.opam b/devkit.opam index 25301de..3708d79 100644 --- a/devkit.opam +++ b/devkit.opam @@ -17,11 +17,12 @@ depends: [ "ounit2" "camlzip" "libevent" {>= "0.8.0"} - "ocurl" {>= "0.7.2"} + "curl" {>= "0.10.0"} + "curl_lwt" "pcre2" {>= "8.0.3"} - "trace" {>= "0.4"} + "trace" {>= "0.12"} "extunix" {>= "0.1.4"} - "lwt" {>= "5.7.0"} + "lwt" {>= "6.0.0"} "lwt_ppx" "base-bytes" "base-unix" diff --git a/lwt_engines.ml b/lwt_engines.ml index 3802e29..9cf06c4 100644 --- a/lwt_engines.ml +++ b/lwt_engines.ml @@ -30,6 +30,8 @@ method poll fds timeout = l end +type Lwt_engine.engine_id += Engine_id__Devkit_libevent + (** libevent-based engine for lwt *) class libevent = let once_block = Ev.[ONCE] in @@ -37,6 +39,8 @@ let once_nonblock = Ev.[ONCE;NONBLOCK] in object(self) inherit Lwt_engine.abstract + method id = Engine_id__Devkit_libevent + val events_ = Ev.init () val mutable pid = Unix.getpid () method events = diff --git a/possibly_otel.mli b/possibly_otel.mli index d880365..5179fe9 100644 --- a/possibly_otel.mli +++ b/possibly_otel.mli @@ -2,7 +2,7 @@ module Otrace := Trace_core module Traceparent : sig val name : string - val get_ambient : ?explicit_span:Trace_core.explicit_span -> unit -> string option + val get_ambient : ?explicit_span:Trace_core.span -> unit -> string option end val enter_manual_span : @@ -11,4 +11,4 @@ val enter_manual_span : __LINE__:int -> ?data:(unit -> (string * Otrace.user_data) list) -> string -> - Trace_core.explicit_span + Trace_core.span diff --git a/possibly_otel.real.ml b/possibly_otel.real.ml index f56d67c..50e6e7f 100644 --- a/possibly_otel.real.ml +++ b/possibly_otel.real.ml @@ -5,22 +5,10 @@ let (let*) o f = Option.map f o module Traceparent = struct let name = Trace_context.Traceparent.name - let get_ambient ?explicit_span () = + let get_ambient ?explicit_span:_ () = let* Scope.{ trace_id; span_id; _ } = Scope.get_ambient_scope () in - let span_id = match explicit_span with - | Some {Trace_core.span; _} -> Opentelemetry_trace.Internal.otel_of_otrace span - | None -> span_id - in Trace_context.Traceparent.to_value ~trace_id ~parent_id:span_id () end let enter_manual_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ?data name = - match Scope.get_ambient_scope () with - | None -> - Trace_core.enter_manual_toplevel_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ?data name - | Some Scope.{ span_id; _ } -> - let otrace_espan = Trace_core.{ - span = Opentelemetry_trace.Internal.otrace_of_otel span_id; - meta = Trace_core.Meta_map.empty - } in - Trace_core.enter_manual_sub_span ~parent:otrace_espan ~__FUNCTION__ ~__FILE__ ~__LINE__ ?data name + Trace_core.enter_span ~parent:None ~__FUNCTION__ ~__FILE__ ~__LINE__ ?data name diff --git a/possibly_otel.stub.ml b/possibly_otel.stub.ml index 2afe916..18f8d15 100644 --- a/possibly_otel.stub.ml +++ b/possibly_otel.stub.ml @@ -6,4 +6,4 @@ end let enter_manual_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ?data name = - Trace_core.enter_manual_toplevel_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ?data name + Trace_core.enter_manual_span ~parent:None ~__FUNCTION__ ~__FILE__ ~__LINE__ ?data name diff --git a/prelude.ml b/prelude.ml index ec457e2..c13e44a 100644 --- a/prelude.ml +++ b/prelude.ml @@ -61,6 +61,13 @@ let call_me_maybe f x = and poll is guaranteed to be available without the fd limitation. *) let () = - if not (Lwt_config._HAVE_LIBEV && Lwt_config.libev_default) then begin + match Lwt_engine.id () with + | Lwt_engine.Engine_id__libev _ -> () + | Lwt_engine.Engine_id__select -> + (* Otherwise, prefer poll over select, because select can only monitor fds up to 1024, + and poll is guaranteed to be available without the fd limitation. *) Lwt_engine.set @@ new Lwt_engines.poll - end + | Lwt_engine.Engine_id__poll -> () + | lwteng -> + eprintfn "Unknown Lwt engine (%s) in use, leaving as is" Obj.Extension_constructor.(name (of_val lwteng)); + () diff --git a/web.ml b/web.ml index 9431236..da01ce0 100644 --- a/web.ml +++ b/web.ml @@ -321,8 +321,8 @@ module Http (IO : IO_TYPE) (Curl_IO : CURL with type 'a t = 'a IO.t) : HTTP with let t = new Action.timer in let result = Some (fun h code -> if verbose then verbose_curl_result nr_http action t h code; - Trace_core.add_data_to_manual_span explicit_span ["http.response.status_code", `Int (Curl.get_httpcode h)]; - Trace_core.exit_manual_span explicit_span; + Trace_core.add_data_to_span explicit_span ["http.response.status_code", `Int (Curl.get_httpcode h)]; + Trace_core.exit_span explicit_span; return () ) in