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