Skip to content

Commit

Permalink
CP-48195: Tracing -- Move create\set\destroy\...
Browse files Browse the repository at this point in the history
Moves the following:

- `create` under `TracerProvider`;
- `set` under `TracerProvider`;
- `destroy` under `TracerProvider;
- `get_tracer_providers` unde `TracerProvider`;
- `get_tracer` under `Tracer`.

Adds documentation for `TracerProvider` module.

It kept being confusing of what `Tracing.set` does unless I was going through
the implementation again and again. Therefore, I moved some of the
functions so that their functionality becomes (hopefully) more intuitive.

Signed-off-by: Gabriel Buica <[email protected]>
  • Loading branch information
GabrielBuica committed May 9, 2024
1 parent a0c84e5 commit 43e26f3
Show file tree
Hide file tree
Showing 8 changed files with 166 additions and 134 deletions.
11 changes: 7 additions & 4 deletions ocaml/libs/tracing/test_tracing.ml
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,7 @@ let with_observe_mode_check flag f = f () ; assert_observe_mode flag

let get_provider name_label =
let providers =
Tracing.get_tracer_providers ()
Tracing.TracerProvider.get_tracer_providers ()
|> List.filter (fun provider ->
String.equal
(Tracing.TracerProvider.get_name_label provider)
Expand All @@ -60,11 +60,14 @@ let get_provider name_label =
Alcotest.failf "expected only one provider"

let create_with (enabled, attributes, endpoints, name_label, uuid) =
let () = Tracing.create ~enabled ~attributes ~endpoints ~name_label ~uuid in
let () =
Tracing.TracerProvider.create ~enabled ~attributes ~endpoints ~name_label
~uuid
in
get_provider name_label

let test_destroy_all_providers uuids =
let () = List.iter (fun uuid -> Tracing.destroy ~uuid) uuids in
let () = List.iter (fun uuid -> Tracing.TracerProvider.destroy ~uuid) uuids in
assert_observe_mode false

let test_create_and_destroy () =
Expand Down Expand Up @@ -145,7 +148,7 @@ let test_create_and_destroy () =

let test_set_tracer_provider () =
let test_set_with provider (enabled, attributes, endpoints, uuid) =
Tracing.set ~enabled ~attributes ~endpoints ~uuid () ;
Tracing.TracerProvider.set ~enabled ~attributes ~endpoints ~uuid () ;
let updated_provider =
provider |> Tracing.TracerProvider.get_name_label |> get_provider
in
Expand Down
184 changes: 93 additions & 91 deletions ocaml/libs/tracing/tracing.ml
Original file line number Diff line number Diff line change
Expand Up @@ -412,6 +412,7 @@ module Spans = struct
let lock = Mutex.create ()

let span_timeout = Atomic.make 86400.
(* one day in seconds *)

let span_timeout_thread = ref None

Expand Down Expand Up @@ -479,6 +480,81 @@ module TracerProvider = struct
let get_endpoints t = t.endpoints

let get_enabled t = t.enabled

let lock = Mutex.create ()

let tracer_providers = Hashtbl.create 100

let create ~enabled ~attributes ~endpoints ~name_label ~uuid =
let provider : t =
let endpoints = List.map endpoint_of_string endpoints in
let attributes = Attributes.of_list attributes in
{name_label; attributes; endpoints; enabled}
in
Xapi_stdext_threads.Threadext.Mutex.execute lock (fun () ->
( match Hashtbl.find_opt tracer_providers uuid with
| None ->
Hashtbl.add tracer_providers uuid provider
| Some _ ->
(* CP-45469: It is ok not to have an exception here since it is unlikely that the
user has caused the issue, so no need to propagate back. It is also
handy to not change the control flow since calls like cluster_pool_resync
might not be aware that a TracerProvider has already been created.*)
error "Tracing : TracerProvider %s already exists" name_label
) ;
if enabled then set_observe true
)

let get_tracer_providers_unlocked () =
Hashtbl.fold (fun _ provider acc -> provider :: acc) tracer_providers []

let get_tracer_providers () =
Xapi_stdext_threads.Threadext.Mutex.execute lock
get_tracer_providers_unlocked

let set ?enabled ?attributes ?endpoints ~uuid () =
let update_provider (provider : t) enabled attributes endpoints =
let enabled = Option.value ~default:provider.enabled enabled in
let attributes : string Attributes.t =
Option.fold ~none:provider.attributes ~some:Attributes.of_list
attributes
in
let endpoints =
Option.fold ~none:provider.endpoints
~some:(List.map endpoint_of_string)
endpoints
in
{provider with enabled; attributes; endpoints}
in

Xapi_stdext_threads.Threadext.Mutex.execute lock (fun () ->
let provider =
match Hashtbl.find_opt tracer_providers uuid with
| Some (provider : t) ->
update_provider provider enabled attributes endpoints
| None ->
fail "The TracerProvider : %s does not exist" uuid
in
Hashtbl.replace tracer_providers uuid provider ;
if
List.for_all
(fun provider -> not provider.enabled)
(get_tracer_providers_unlocked ())
then (
set_observe false ;
Xapi_stdext_threads.Threadext.Mutex.execute Spans.lock (fun () ->
Hashtbl.clear Spans.spans ;
Hashtbl.clear Spans.finished_spans
)
) else
set_observe true
)

let destroy ~uuid =
Xapi_stdext_threads.Threadext.Mutex.execute lock (fun () ->
let _ = Hashtbl.remove tracer_providers uuid in
if Hashtbl.length tracer_providers = 0 then set_observe false else ()
)
end

module Tracer = struct
Expand All @@ -497,6 +573,22 @@ module Tracer = struct
in
{name= ""; provider}

let get_tracer ~name =
if Atomic.get observe then (
let providers =
Xapi_stdext_threads.Threadext.Mutex.execute TracerProvider.lock
TracerProvider.get_tracer_providers_unlocked
in

match List.find_opt TracerProvider.get_enabled providers with
| Some provider ->
create ~name ~provider
| None ->
warn "No provider found for tracing %s" name ;
no_op
) else
no_op

let span_of_span_context context name : Span.t =
{
context
Expand Down Expand Up @@ -551,102 +643,12 @@ module Tracer = struct
Spans.finished_span_hashtbl_is_empty ()
end

let lock = Mutex.create ()

let tracer_providers = Hashtbl.create 100

let get_tracer_providers_unlocked () =
Hashtbl.fold (fun _ provider acc -> provider :: acc) tracer_providers []

let get_tracer_providers () =
Xapi_stdext_threads.Threadext.Mutex.execute lock get_tracer_providers_unlocked

let set ?enabled ?attributes ?endpoints ~uuid () =
let update_provider (provider : TracerProvider.t) enabled attributes endpoints
=
let enabled = Option.value ~default:provider.enabled enabled in
let attributes : string Attributes.t =
Option.fold ~none:provider.attributes ~some:Attributes.of_list attributes
in
let endpoints =
Option.fold ~none:provider.endpoints
~some:(List.map endpoint_of_string)
endpoints
in
{provider with enabled; attributes; endpoints}
in

Xapi_stdext_threads.Threadext.Mutex.execute lock (fun () ->
let provider =
match Hashtbl.find_opt tracer_providers uuid with
| Some (provider : TracerProvider.t) ->
update_provider provider enabled attributes endpoints
| None ->
fail "The TracerProvider : %s does not exist" uuid
in
Hashtbl.replace tracer_providers uuid provider ;
if
List.for_all
(fun provider -> not provider.TracerProvider.enabled)
(get_tracer_providers_unlocked ())
then (
set_observe false ;
Xapi_stdext_threads.Threadext.Mutex.execute Spans.lock (fun () ->
Hashtbl.clear Spans.spans ;
Hashtbl.clear Spans.finished_spans
)
) else
set_observe true
)

let create ~enabled ~attributes ~endpoints ~name_label ~uuid =
let provider : TracerProvider.t =
let endpoints = List.map endpoint_of_string endpoints in
let attributes = Attributes.of_list attributes in
{name_label; attributes; endpoints; enabled}
in
Xapi_stdext_threads.Threadext.Mutex.execute lock (fun () ->
( match Hashtbl.find_opt tracer_providers uuid with
| None ->
Hashtbl.add tracer_providers uuid provider
| Some _ ->
(* CP-45469: It is ok not to have an exception here since it is unlikely that the
user has caused the issue, so no need to propagate back. It is also
handy to not change the control flow since calls like cluster_pool_resync
might not be aware that a TracerProvider has already been created.*)
error "Tracing : TracerProvider %s already exists" name_label
) ;
if enabled then set_observe true
)

let destroy ~uuid =
Xapi_stdext_threads.Threadext.Mutex.execute lock (fun () ->
let _ = Hashtbl.remove tracer_providers uuid in
if Hashtbl.length tracer_providers = 0 then set_observe false else ()
)

let get_tracer ~name =
if Atomic.get observe then (
let providers =
Xapi_stdext_threads.Threadext.Mutex.execute lock
get_tracer_providers_unlocked
in

match List.find_opt TracerProvider.get_enabled providers with
| Some provider ->
Tracer.create ~name ~provider
| None ->
warn "No provider found for tracing %s" name ;
Tracer.no_op
) else
Tracer.no_op

let enable_span_garbage_collector ?(timeout = 86400.) () =
Spans.GC.initialise_thread ~timeout

let with_tracing ?(attributes = []) ?(parent = None) ~name f =
if Atomic.get observe then (
let tracer = get_tracer ~name in
let tracer = Tracer.get_tracer ~name in
match Tracer.start ~tracer ~attributes ~name ~parent () with
| Ok span -> (
try
Expand Down
67 changes: 45 additions & 22 deletions ocaml/libs/tracing/tracing.mli
Original file line number Diff line number Diff line change
Expand Up @@ -110,6 +110,8 @@ end
module Tracer : sig
type t

val get_tracer : name:string -> t

val span_of_span_context : SpanContext.t -> string -> Span.t

val start :
Expand All @@ -131,40 +133,61 @@ module Tracer : sig
val finished_span_hashtbl_is_empty : unit -> bool
end

(** [TracerProvider] module provides ways to intereact with the tracer providers.
*)
module TracerProvider : sig
(** Type that represents a tracer provider.*)
type t

val create :
enabled:bool
-> attributes:(string * string) list
-> endpoints:string list
-> name_label:string
-> uuid:string
-> unit
(** [create ~enabled ~attributes ~endpoints ~name_label ~uuid] initializes a
tracer provider based on the following parameters: [enabled], [attributes],
[endpoints], [name_label], and [uuid]. *)

val set :
?enabled:bool
-> ?attributes:(string * string) list
-> ?endpoints:string list
-> uuid:string
-> unit
-> unit
(** [set ?enabled ?attributes ?endpoints ~uuid ()] updates the tracer provider
identified by the given [uuid] with the new configuration paremeters:
[enabled], [attributes], and [endpoints].
If any of the configuration parameters are
missing, the old ones are kept.
Raises [Failure] if there are no tracer provider with the given [uuid].
*)

val destroy : uuid:string -> unit
(** [destroy ~uuid] destroys the tracer provider with the given [uuid].
If there are no tracer provider with the given [uuid], it does nothing.
*)

val get_tracer_providers : unit -> t list
(** [get_tracer_providers] returns a list of all existing tracer providers. *)

val get_name_label : t -> string
(** [get_name_label provider] returns the name label of the [provider]. *)

val get_attributes : t -> (string * string) list
(** [get_attributes provider] returns the list of attributes of the [provider]. *)

val get_endpoints : t -> endpoint list
(** [get_endpoints provider] returns list of endpoints of the [provider]. *)

val get_enabled : t -> bool
(** [get_name_label provider] returns whether or not the [provider] is enabled. *)
end

val set :
?enabled:bool
-> ?attributes:(string * string) list
-> ?endpoints:string list
-> uuid:string
-> unit
-> unit

val create :
enabled:bool
-> attributes:(string * string) list
-> endpoints:string list
-> name_label:string
-> uuid:string
-> unit

val destroy : uuid:string -> unit

val get_tracer_providers : unit -> TracerProvider.t list

val get_tracer : name:string -> Tracer.t

val enable_span_garbage_collector : ?timeout:float -> unit -> unit

val with_tracing :
Expand Down
2 changes: 1 addition & 1 deletion ocaml/libs/tracing/tracing_export.ml
Original file line number Diff line number Diff line change
Expand Up @@ -280,7 +280,7 @@ module Destination = struct
let@ parent =
with_tracing ~parent:None ~attributes ~name:"Tracing.flush_spans"
in
get_tracer_providers ()
TracerProvider.get_tracer_providers ()
|> List.filter TracerProvider.get_enabled
|> List.concat_map TracerProvider.get_endpoints
|> List.iter (export_to_endpoint parent span_list)
Expand Down
8 changes: 4 additions & 4 deletions ocaml/tests/test_observer.ml
Original file line number Diff line number Diff line change
Expand Up @@ -62,13 +62,13 @@ end

module TracerProvider = struct
let assert_num_observers ~__context x =
let providers = get_tracer_providers () in
let providers = TracerProvider.get_tracer_providers () in
Alcotest.(check int)
(Printf.sprintf "%d provider(s) exists in lib " x)
x (List.length providers)

let find_provider_exn ~name =
let providers = get_tracer_providers () in
let providers = TracerProvider.get_tracer_providers () in
match
List.find_opt (fun x -> TracerProvider.get_name_label x = name) providers
with
Expand Down Expand Up @@ -135,12 +135,12 @@ let test_create ~__context ?(name_label = "test-observer") ?(enabled = false) ()
self

let start_test_span () =
let tracer = get_tracer ~name:"test-observer" in
let tracer = Tracer.get_tracer ~name:"test-observer" in
let span = Tracer.start ~tracer ~name:"test_task" ~parent:None () in
span

let start_test_trace () =
let tracer = get_tracer ~name:"test-observer" in
let tracer = Tracer.get_tracer ~name:"test-observer" in
let root =
Tracer.start ~tracer ~name:"test_task" ~parent:None ()
|> Result.value ~default:None
Expand Down
2 changes: 1 addition & 1 deletion ocaml/xapi/context.ml
Original file line number Diff line number Diff line change
Expand Up @@ -331,7 +331,7 @@ let start_tracing_helper ?(span_attributes = []) parent_fn task_name =
let span_name, span_attributes = span_details_from_task_name task_name in
let parent = parent_fn span_name in
let span_kind = span_kind_of_parent parent in
let tracer = get_tracer ~name:span_name in
let tracer = Tracer.get_tracer ~name:span_name in
match
Tracer.start ~span_kind ~tracer ~attributes:span_attributes ~name:span_name
~parent ()
Expand Down
Loading

0 comments on commit 43e26f3

Please sign in to comment.