package trace-tef

  1. Overview
  2. Docs
A simple backend for trace, emitting Catapult/TEF JSON into a file

Install 

dune-project
 Dependency

github.com Readme Changelog Edit opam file Versions (14)

Authors

  1. S
    Simon Cruanes

Maintainers

  1. S
    Simon Cruanes

Sources

trace-0.11.tbz
sha256=a29329fcfb191a98bfed26c05c300ed9e1e915b73cc59f51e9d9cdc4d1f158bc
sha512=ff77a4ef19375f4ad3b1ddff7336657a4a5695924b679ac2c36a77b14b95c63d126539efd1590f83b415a1288bb843a5fb4308e53a807dcc22456cb40a8e0026

doc/src/trace-tef/trace_tef.ml.html

Source file trace_tef.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
open Trace_core
module Collector_tef = Collector_tef
module Exporter = Exporter
module Writer = Writer
module Types = Types

let block_signals () =
  try
    ignore
      (Unix.sigprocmask SIG_BLOCK
         [
           Sys.sigterm;
           Sys.sigpipe;
           Sys.sigint;
           Sys.sigchld;
           Sys.sigalrm;
           Sys.sigusr1;
           Sys.sigusr2;
         ]
        : _ list)
  with _ -> ()

(** Thread that simply regularly "ticks", sending events to the background
    thread so it has a chance to write to the file *)
let tick_thread (c : Collector_tef.t) : unit =
  block_signals ();
  while Collector_tef.active c do
    Thread.delay 0.5;
    Collector_tef.flush c
  done

type output =
  [ `Stdout
  | `Stderr
  | `File of string
  ]

let collector_ ~(finally : unit -> unit) ~out ~(mode : [ `Single | `Jsonl ]) ()
    : Collector.t =
  let jsonl = mode = `Jsonl in
  let oc, must_close =
    match out with
    | `Stdout -> stdout, false
    | `Stderr -> stderr, false
    | `File path -> open_out path, true
    | `File_append path ->
      open_out_gen [ Open_creat; Open_wronly; Open_append ] 0o644 path, true
    | `Output oc -> oc, false
  in
  let pid = Trace_util.Mock_.get_pid () in

  let exporter = Exporter.of_out_channel oc ~jsonl ~close_channel:must_close in
  let exporter =
    {
      exporter with
      close =
        (fun () ->
          exporter.close ();
          finally ());
    }
  in
  let coll_st = Collector_tef.create ~pid ~exporter () in
  let _t_tick : Thread.t = Thread.create tick_thread coll_st in
  Collector_tef.collector coll_st

let[@inline] collector ~out () : collector =
  collector_ ~finally:ignore ~mode:`Single ~out ()

open struct
  let register_atexit =
    let has_registered = ref false in
    fun () ->
      if not !has_registered then (
        has_registered := true;
        at_exit Trace_core.shutdown
      )
end

let setup ?(debug = false) ?(out = `Env) () =
  register_atexit ();

  let setup_col c =
    let c =
      if debug then
        Trace_debug.Track_spans.track c
      else
        c
    in
    Trace_core.setup_collector c
  in

  match out with
  | `Stderr -> setup_col @@ collector ~out:`Stderr ()
  | `Stdout -> setup_col @@ collector ~out:`Stdout ()
  | `File path -> setup_col @@ collector ~out:(`File path) ()
  | `Env ->
    (match Sys.getenv_opt "TRACE" with
    | Some ("1" | "true") ->
      let path = "trace.json" in
      let c = collector ~out:(`File path) () in
      setup_col c
    | Some "stdout" -> setup_col @@ collector ~out:`Stdout ()
    | Some "stderr" -> setup_col @@ collector ~out:`Stderr ()
    | Some path ->
      let c = collector ~out:(`File path) () in
      setup_col c
    | None -> ())

let with_setup ?debug ?out () f =
  setup ?debug ?out ();
  Fun.protect ~finally:Trace_core.shutdown f

module Private_ = struct
  let mock_all_ () =
    Trace_util.Mock_.mock_all ();
    ()

  let collector_jsonl ~finally ~out () : collector =
    collector_ ~finally ~mode:`Jsonl ~out ()

  module Event = Event
end