├── doc
└── images
│ ├── ttb-log-snap-1.png
│ ├── ttb-log-snap-2.png
│ └── ttb-log-snap.png
├── Makefile
├── .gitignore
├── src
├── trace_runner.app.src
├── tr_ct.erl
└── tr_ttb.erl
├── include
└── trace_runner.hrl
├── README.md
└── LICENSE
/doc/images/ttb-log-snap-1.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/uwiger/trace_runner/HEAD/doc/images/ttb-log-snap-1.png
--------------------------------------------------------------------------------
/doc/images/ttb-log-snap-2.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/uwiger/trace_runner/HEAD/doc/images/ttb-log-snap-2.png
--------------------------------------------------------------------------------
/doc/images/ttb-log-snap.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/uwiger/trace_runner/HEAD/doc/images/ttb-log-snap.png
--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
1 | .PHONY: all clean compile
2 |
3 | all: compile
4 |
5 | compile:
6 | rebar compile
7 |
8 | clean:
9 | rebar clean
10 |
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | .eunit
2 | deps
3 | *.o
4 | *.beam
5 | *.plt
6 | erl_crash.dump
7 | ebin
8 | rel/example_project
9 | .concrete/DEV_MODE
10 | .rebar
11 |
--------------------------------------------------------------------------------
/src/trace_runner.app.src:
--------------------------------------------------------------------------------
1 | %% -*- mode: erlang; indent-tabs-mode: nil; -*-
2 | %%---- BEGIN COPYRIGHT -------------------------------------------------------
3 | %%
4 | %% Copyright (C) 2016 Ulf Wiger. All rights reserved.
5 | %%
6 | %% This Source Code Form is subject to the terms of the Mozilla Public
7 | %% License, v. 2.0. If a copy of the MPL was not distributed with this
8 | %% file, You can obtain one at http://mozilla.org/MPL/2.0/.
9 | %%
10 | %%---- END COPYRIGHT ---------------------------------------------------------
11 | {application, trace_runner,
12 | [
13 | {description, "A wrapper for tracing test runs using TTB"},
14 | {vsn, git},
15 | {registered, []},
16 | {applications, [
17 | kernel,
18 | stdlib,
19 | runtime_tools,
20 | observer
21 | ]},
22 | {licenses, ["MPL-2.0"]},
23 | {links, [{"GitHub", "https://github.com/uwiger/trace_runner"}]},
24 | {env, []}
25 | ]}.
26 |
--------------------------------------------------------------------------------
/include/trace_runner.hrl:
--------------------------------------------------------------------------------
1 | %% -*- mode: erlang; indent-tabs-mode: nil; -*-
2 | %%---- BEGIN COPYRIGHT -------------------------------------------------------
3 | %%
4 | %% Copyright (C) 2016 Ulf Wiger. All rights reserved.
5 | %%
6 | %% This Source Code Form is subject to the terms of the Mozilla Public
7 | %% License, v. 2.0. If a copy of the MPL was not distributed with this
8 | %% file, You can obtain one at http://mozilla.org/MPL/2.0/.
9 | %%
10 | %%---- END COPYRIGHT ---------------------------------------------------------
11 |
12 | -ifndef(event).
13 |
14 | -define(costly_event(E),
15 | case erlang:trace_info({MODULE,event,3}, traced) of
16 | {_, false} -> ok;
17 | _ -> event(?LINE, E, none)
18 | end).
19 |
20 | -define(costly_event(E, S),
21 | case erlang:trace_info({MODULE,event,3}, traced) of
22 | {_, false} -> ok;
23 | _ -> event(?LINE, E, S)
24 | end).
25 |
26 | -define(event(E), event(?LINE, E, none)).
27 | -define(event(E, S), event(?LINE, E, S)).
28 |
29 | -endif. % ?event()
30 |
--------------------------------------------------------------------------------
/src/tr_ct.erl:
--------------------------------------------------------------------------------
1 | -module(tr_ct).
2 |
3 | -export([ with_trace/3 ]).
4 |
5 | -export([ trace_checkpoint/2
6 | , set_activation_checkpoint/2 ]).
7 |
8 | -define(SPEC, tr_ct_spec).
9 | -define(TR_ACTIVATE_AT, tr_activate_at).
10 | -define(TR_START, start).
11 |
12 | with_trace(Fun, Config0, Spec) ->
13 | ct:log("with_trace (Spec = ~p)...", [Spec]),
14 | Config = [{?SPEC, Spec} | Config0],
15 | trace_checkpoint(?TR_START, Config),
16 | Res = try Fun(Config)
17 | catch Error:R:Stack ->
18 | case Error of
19 | error ->
20 | ct:pal("Error ~p~nStack = ~p", [R, Stack]),
21 | ttb_stop(),
22 | error(R);
23 | exit ->
24 | ct:pal("Exit ~p~nStack = ~p", [R, Stack]),
25 | ttb_stop(),
26 | exit(R);
27 | throw ->
28 | ct:pal("Caught throw:~p", [R]),
29 | throw(R)
30 | end
31 | end,
32 | ct:log("Res = ~p", [Res]),
33 | case get_spec(collect, Config, on_error) of
34 | on_error ->
35 | ct:log("Discarding trace", []),
36 | tr_ttb:stop_nofetch();
37 | always ->
38 | ttb_stop()
39 | end,
40 | Res.
41 |
42 | set_activation_checkpoint(Checkpoint, Config) ->
43 | [{tr_activate_at, Checkpoint} | Config].
44 |
45 | trace_checkpoint(Checkpoint, Config) ->
46 | case trace_is_active(Config) of
47 | true ->
48 | case proplists:get_value(?TR_ACTIVATE_AT, Config, ?TR_START) of
49 | Checkpoint ->
50 | Dest = get_destination(Config),
51 | Spec0 = get_spec(Config),
52 | Spec = Spec0#{info => #{checkpoint => Checkpoint}},
53 | TTBRes = tr_ttb:on_nodes(get_nodes(Config), Dest, Spec),
54 | ct:log("Trace set up at checkpoint ~p: ~p",
55 | [Checkpoint, TTBRes]);
56 | _ ->
57 | ok
58 | end;
59 | false ->
60 | ok
61 | end.
62 |
63 | trace_is_active(Config) ->
64 | lists:keymember(?SPEC, 1, Config).
65 |
66 | ttb_stop() ->
67 | Dir = tr_ttb:stop(),
68 | Out = filename:join(filename:dirname(Dir), filename:basename(Dir) ++ ".txt"),
69 | case tr_ttb:format(Dir, Out, #{limit => 10000}) of
70 | {error, Reason} ->
71 | ct:pal("TTB formatting error: ~p", [Reason]);
72 | _ ->
73 | ok
74 | end,
75 | ct:pal("Formatted trace log in ~s~n", [Out]).
76 |
77 | get_destination(Config) ->
78 | case get_spec(destination, Config) of
79 | undefined ->
80 | LogBase = log_base_name(Config),
81 | fstring("~s.tr_ct", [LogBase]);
82 | D ->
83 | D
84 | end.
85 |
86 | get_nodes(Config) ->
87 | get_spec(nodes, Config, [node()]).
88 |
89 | get_spec(Key, Config) ->
90 | get_spec(Key, Config, undefined).
91 |
92 | get_spec(Key, Config, Default) ->
93 | tr_ttb:cfg(get_spec(Config), Key, Default).
94 |
95 | get_spec(Config) ->
96 | case proplists:get_value(?SPEC, Config) of
97 | undefined ->
98 | #{};
99 | Map when is_map(Map) ->
100 | Map
101 | end.
102 |
103 | log_base_name(Config) ->
104 | {_, LF} = lists:keyfind(tc_logfile, 1, Config),
105 | [Base, []] = re:split(LF, <<"\\.html">>, [{return, list}]),
106 | Base.
107 |
108 | fstring(Fmt, Args) ->
109 | lists:flatten(io_lib:format(Fmt, Args)).
110 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # trace_runner
2 | A wrapper for tracing test runs and for complex shell-based tracing using TTB.
3 |
4 | This component is based on [locks_ttb](https://github.com/uwiger/locks/blob/master/src/locks_ttb.erl), whose main purpose was to be used in complicated
5 | multi-node test cases: a wrapper around the test case sets up a multi-node
6 | trace using ttb; if the test case succeeds, the traces are discarded, but
7 | if it fails, the logs are fetched, merged and formatted for 'easy' viewing.
8 |
9 | The idea is complemented with the notion of using an `event()` function,
10 | whose only purpose is to be traced. This can serve as extremely lightweight
11 | runtime debugging statements. Since the `event()` function only returns
12 | `ok`, the whole operation is cheaper than any runtime test for debug level
13 | could be. The `include/trace_runner.hrl` include file defines `?event`
14 | macros that can be used, including one that tests whether the `event()`
15 | function is traced, before evaluating the argument expression. This can
16 | be used to 'pretty-print' the arguments to the `event()` function without
17 | incurring overhead when not tracing (obviously there is *some* overhead in
18 | checking the trace status).
19 |
20 | There is also support for shell-based tracing, making use of the
21 | instrumentation callbacks e.g. for pretty-printing of trace output.
22 |
23 | ## API
24 |
25 | The main API functions are:
26 |
27 | ```erlang
28 | tr_ttb:on_nodes(Nodes, OutputFile, Spec) -> {ok, [{Item, MatchDesc}]}.
29 | ```
30 |
31 | This function acts as a wrapper to [`ttb:start_trace/4`](https://www.erlang.org/doc/man/ttb.html#start_trace-4), and returns whatever
32 | that call returns. The `Spec` can be either a module name, where the module
33 | is expected to export some or all of the supported configuration callbacks
34 | (see below), or a map():
35 |
36 | ```erlang
37 | -type spec() :: #{ patterns => [tr_ttb:pattern()]
38 | , flags => {tr_ttb:procs(), tr_ttb:flags()},
39 | , collect => on_error | always
40 | , info => any() }
41 | ```
42 |
43 | The `info` attribute is used for documentation purposes. If the trace
44 | includes tracing on `tr_ttb:event/3`, a trace message will be included
45 | showing `tr_ttb:event(_Line, ttb_started, Spec)`. The `tr_ct` trace
46 | wrapper, described below, uses the `info` attribute to signal where,
47 | at which checkpoint, the trace started.
48 |
49 |
50 |
51 | Example (from https://github.com/PDXOstc/rvi_core, although at the time of writing, the trace_runner support hasn't yet been merged)
52 |
53 | First, we create a callback module for the `tr_ttb` behavior, which
54 | lets us specify trace patterns and trace flags.
55 |
56 | ```erlang
57 | patterns() ->
58 | [{authorize_rpc , event, 3, []},
59 | {service_edge_rpc , event, 3, []},
60 | {service_discovery_rpc, event, 3, []},
61 | {dlink_tcp_rpc , event, 3, []},
62 | {connection , event, 3, []},
63 | {dlink_tls_rpc , event, 3, []},
64 | {dlink_tls_conn , event, 3, []},
65 | {dlink_bt_rpc , event, 3, []},
66 | {bt_connection , event, 3, []},
67 | {dlink_sms_rpc , event, 3, []},
68 | {schedule_rpc , event, 3, []},
69 | {proto_json_rpc , event, 3, []},
70 | {proto_msgpack_rpc , event, 3, []},
71 | {rvi_common , event, 3, []},
72 | {?MODULE , event, 3, []}
73 | | tr_ttb:default_patterns()].
74 |
75 | flags() ->
76 | {all, call}.
77 | ```
78 |
79 | Then, we instrument our test suite(s):
80 |
81 | ```erlang
82 | t_multicall_sota_service(Config) ->
83 | with_trace(fun t_multicall_sota_service_/1, Config,
84 | "t_multicall_sota_service").
85 |
86 | t_multicall_sota_service_(_Config) ->
87 | %% the actual test case
88 | Data = <<"abc">>,
89 | ...
90 | ```
91 |
92 | ## Common Test wrapper
93 |
94 | The module `tr_ct` contains a wrapper function, `tr_ct:with_trace/3`,
95 | which calls the above `tr_ttb:on_nodes/3` at a chosen time, applies
96 | a test function, and fetches and pretty-prints the trace data if the
97 | test function fails. Note that if `collect => always`, fetching and
98 | pretty-printing will happen even if the test case succeeds.
99 |
100 | Example, from [the mnesia_rocksdb project](https://github.com/aeternity/mnesia_rocksdb/blob/master/test/mnesia_rocksdb_SUITE.erl)
101 |
102 | ```erlang
103 | mrdb_two_procs(Config) ->
104 | tr_ct:with_trace(fun mrdb_two_procs_/1, Config,
105 | tr_flags(
106 | {self(), [call, sos, p]},
107 | tr_patterns(
108 | mrdb, [ {mrdb, insert, 2, x}
109 | , {mrdb, read, 2, x}
110 | , {mrdb, activity, x} ], tr_opts()))).
111 |
112 | mrdb_two_procs_(Config) ->
113 | ....
114 |
115 | tr_opts() ->
116 | #{patterns => [ {mrdb, '_', '_', x}
117 | , {mrdb_lib, '_', '_', x}
118 | , {tr_ttb, event, 3, []}
119 | , {?MODULE, go_ahead_other, 3, x}
120 | , {?MODULE, wait_for_other, 3, x}
121 | , {?MODULE, await_other_down, 3, x}
122 | , {?MODULE, do_when_p_allows, 4, x}
123 | , {?MODULE, allow_p, 3, x}
124 | ]}.
125 |
126 | tr_patterns(Mod, Ps, #{patterns := Pats} = Opts) ->
127 | Pats1 = [P || P <- Pats, element(1,P) =/= Mod],
128 | Opts#{patterns => Ps ++ Pats1}.
129 |
130 | tr_flags(Flags, Opts) when is_map(Opts) ->
131 | Opts#{flags => Flags}.
132 | ```
133 |
134 | The `with_trace/3` wrapper will derive the output filename from the
135 | Common Test `Config`: either via the property `destination`, or via
136 | the test case name, taken from the `tc_logfile` property maintained
137 | by the Common Test support logic. In the latter case, a `".tr_ct"`
138 | suffix is added to the test case name.
139 |
140 |
141 | In the wrapper, we determine which nodes to include in the trace,
142 | give the trace a name, then call the test case within a try ... catch.
143 | If the test succeeds, we call `stop_nofetch()`, discarding the trace,
144 | otherwise, we fetch the trace logs and merge them, pretty-printing
145 | the result.
146 |
147 | ```erlang
148 | with_trace(F, Config, File) ->
149 | Nodes = [N || {N,_} <- get_nodes()],
150 | rvi_ttb:on_nodes([node()|Nodes], File),
151 | try F(Config)
152 | catch
153 | error:R ->
154 | Stack = erlang:get_stacktrace(),
155 | ttb_stop(),
156 | ct:log("Error ~p; Stack = ~p", [R, Stack]),
157 | erlang:error(R);
158 | exit:R ->
159 | ttb_stop(),
160 | exit(R)
161 | end,
162 | rvi_ttb:stop_nofetch(),
163 | ok.
164 |
165 | ttb_stop() ->
166 | Dir = rvi_ttb:stop(),
167 | Out = filename:join(filename:dirname(Dir),
168 | filename:basename(Dir) ++ ".txt"),
169 | rvi_ttb:format(Dir, Out),
170 | ct:log("Formatted trace log in ~s~n", [Out]).
171 | ```
172 |
173 | On test failure, this would result in the following output in the CT log:
174 |
175 |
176 |
177 | The formatted text log has an emacs erlang-mode header, so is best
178 | viewed in emacs.
179 |
180 |
181 |
182 | Note that the log formatter prefixes each message with the relative time
183 | (in ms) since the start of the trace, the name of the node where the
184 | trace event originated and the module/line of the traced call.
185 | It also tries to pretty-print records, looking for a
186 | `record_fields(RecName)` callback in the module named in the call trace.
187 |
188 |
189 |
190 | A `record_fields/1` function might look like this:
191 |
192 | ```erlang
193 | record_fields(service_entry) -> record_info(fields, service_entry);
194 | record_fields(st ) -> record_info(fields, st);
195 | record_fields(component_spec) -> record_info(fields, component_spec);
196 | record_fields(_) -> no.
197 | ```
198 |
199 | ### Tracing checkpoints
200 |
201 | For some test cases, it may be useful to defer tracing start until the point
202 | where tricky stuff starts happening. This can be done with the functions
203 | `tr_ct:set_activation_checkpoint(Label, Config)`, and
204 | `tr_ct:trace_checkpoint(Label, Config)`.
205 |
206 | **Example:**
207 | ```erlang
208 | init_per_suite(Config) ->
209 | tr_ct:set_activation_checkpoint(?TABS_CREATED, Config).
210 |
211 | ...
212 |
213 | encoding_sext_attrs(Config) ->
214 | tr_ct:with_trace(fun encoding_sext_attrs_/1, Config,
215 | tr_patterns(mnesia_rocksdb,
216 | [{mnesia_rocksdb,'_',x}], tr_opts())).
217 |
218 | encoding_sext_attrs_(Config) ->
219 | Created = create_tabs([{t, [{attributes, [k, v]}]}], Config),
220 | ok = mrdb:insert(t, {t, 1, a}),
221 | ok = mnesia:dirty_write({t, 2, b}),
222 | expect_error(fun() -> mrdb:insert(t, {t, a}) end, ?LINE,
223 | error, {mrdb_abort, badarg}),
224 | expect_error(fun() -> mnesia:dirty_write({t, a}) end, ?LINE,
225 | exit, '_'),
226 | delete_tabs(Created),
227 | ok.
228 |
229 | ...
230 |
231 | create_tabs(Tabs, Config) ->
232 | Res = lists:map(fun create_tab/1, Tabs),
233 | tr_ct:trace_checkpoint(?TABS_CREATED, Config),
234 | Res.
235 | ```
236 |
237 | The above test setup will cause tracing to start only after `create_tabs/2`
238 | has been completed.
239 |
240 | ## Custom formatting of terms
241 |
242 | The pretty-printer allows terms to be custom-formatted using a `pp_term(Term)` callback,
243 | optionally exported from the callback module. The semantics of the callback is:
244 |
245 | ```erlang
246 | pp_term(Term) -> {yes, Term1} | no.
247 | ```
248 |
249 | The custom formatting function can call on subsequent `pp_term/1` callbacks using
250 | the `trace_runner` helper function `tr_ttb:pp_term(Term, Mod) -> Term1`.
251 | The helper unwraps any `{yes, ...}` tuples etc., returning either a modified term
252 | or the original term.
253 |
254 | Instead of a callback module, `tr_ttb:pp_term/2` can take a fun as second argument.
255 | Technically, the implementation is:
256 |
257 | ```erlang
258 | pp_term(T, M) when is_atom(M) ->
259 | pp_term(T, fun M:pp_term/1);
260 | pp_term(T, F) when is_function(F, 1) ->
261 | try F(T) of
262 | {yes, Out} ->
263 | Out;
264 | no -> pp_term_(T, F)
265 | catch
266 | error:_ ->
267 | pp_term_(T, F)
268 | end.
269 | ```
270 |
271 | ... where `pp_term_/2` traverses the term, looking for opportunities to pretty-print
272 | sub-terms. That is, by returning `no`, the callback allows the traversal to continue.
273 | If it is known that no opportunities to pretty-print exist in a subterm, returning
274 | `{yes, Term}` will stop further inspection in that area.
275 |
276 | As an example of how layered pretty-printing can be leveraged, see the pretty-printing
277 | of Merkle Patricia Trees (MPT) in the Aeternity system. MPTs are particularly hard
278 | to read in raw form, partly since terms are encoded twice. The `pp_term/1` callbacks
279 | at the application level therefore first call on a generic helper function, which
280 | converts a tree to a key-value list, then applies application-specific decoding of
281 | the stored terms. Note the trick to tag custom-formatted terms with `'$...'` tags,
282 | both to help the reader and to allow higher levels to detect and further refine
283 | the data.
284 |
285 | ```erlang
286 | record_fields(_) -> {check_mods, [ aec_accounts ]}.
287 |
288 | pp_term(Term) ->
289 | aeu_mp_trees:tree_pp_term(Term, '$accounts', fun aec_accounts:deserialize/2).
290 | ```
291 |
292 | The helper function:
293 | ```erlang
294 | %% Utility trace support for state tree modules
295 | %%
296 | tree_pp_term(#mpt{} = Term, CacheTag, XForm) ->
297 | Dec = fun(X) -> pp_mpt_decode(X, CacheTag, XForm) end,
298 | {yes, tr_ttb:pp_term(tr_ttb:pp_term(Term, aeu_mtrees), Dec)};
299 | tree_pp_term(_, _, _) ->
300 | no.
301 |
302 | pp_mpt_decode({'$mpt', L}, Tag, XForm) ->
303 | {yes, {Tag, [{K, XForm(K, V)}
304 | || {K, V} <- L]}};
305 | pp_mpt_decode(_, _, _) ->
306 | no.
307 | ```
308 |
309 | ## Record pretty-printing
310 |
311 | The pretty-printer uses a generalized version of the `record_print_fun` used in
312 | `io_lib_pretty.erl`. This way, `record_fields(Term)` can be exported from the
313 | callback module. In addition to the normal `{yes, FieldNames} | no` returns,
314 | the callbacks can also return `{check_mods, Modules}`, instructing the caller
315 | to inspect any `record_fields/1` callbacks of the listed modules.
316 |
317 | The function `tr_ttb:pr(Term, Module)` can be used to similar effect as
318 | `lager:pr(Term, Module)`. It's intended to be used in e.g. log output
319 | and will try to pretty-print a record for a single line, given the record_info()
320 | data accessible via `Module`.
321 |
322 | ## Shell tracing
323 |
324 | Shell tracing can make use of the same instrumented pretty-printing via the
325 | function `tr_ttb:dbg_tracer(Options)` function. This starts a `dbg` tracer
326 | which calls on the pretty-printing callbacks described above. As formatting
327 | is likely to be slower, it is recommended that tracing is stopped using the
328 | function `tr_ttb:dbg_stop()`, which waits until the tracer process has processed
329 | queued trace messages before stopping it.
330 |
331 | The optional `Options` argument is a map, and supports the following options:
332 | ```
333 | fd - the output descriptor. Defaults to the group_leader of the current process
334 | print_header - whether to print the preamble mainly meant for emacs. Defaults to 'false'
335 | limit - How many lines of trace output to print. Defaults to 'infinity'
336 | time_resolution - millisecond | microsecond. Defaults to 'millisecond'
337 | delay - The trace handler will sleep for the given number of milliseconds
338 | shell_records - If possible, records definitions stored in the shell via `rr(Mod)` will be used
339 | ```
340 |
341 | The `delay` option, e.g. `delay => 1000` causes a sleep when encountered. The option is then removed
342 | from the accumulator. A callback could then reinsert it for another sleep, although currently, there is
343 | no provision for user modification of the accumulator state.
344 |
345 | In the future, more log formatting options may be added.
346 | Pull requests are welcome.
347 |
348 | ## Extended trace patterns
349 |
350 | If `Patterns` is given as a list, all patterns will be applied as in `ttb:start_trace/4`.
351 | `tr_ttb` also supports an extended description:
352 |
353 | ```erlang
354 | PatternMap :: #{ start := [tuple()]
355 | , tp => [{M, F, A, MatchSpec}]
356 | , tpl => [{M, F, A, MatchSpec}]
357 | , tpe => [{Event, MatchSpec}]
358 | , ctp => [{M, F, A}]
359 | , ctpl => [{M, F, A}]
360 | , ctpg => [{M, F, A}]
361 | , ctpe => [Event] }.
362 | ```
363 |
364 | When this form is used, the `start` element (mandatory) is passed to `ttb:start_trace/4`,
365 | and then, the corresponding functions, `ttb:tp/2, ttb:tpl/2, ...` are called for those
366 | other elements that are present. Note that all the other elements are optional.
367 |
368 | This allows the caller to e.g conveniently set a wildcard trace pattern for a whole module,
369 | then selectively turn of trace on a few specific functions in that module.
370 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | Mozilla Public License Version 2.0
2 | ==================================
3 |
4 | 1. Definitions
5 | --------------
6 |
7 | 1.1. "Contributor"
8 | means each individual or legal entity that creates, contributes to
9 | the creation of, or owns Covered Software.
10 |
11 | 1.2. "Contributor Version"
12 | means the combination of the Contributions of others (if any) used
13 | by a Contributor and that particular Contributor's Contribution.
14 |
15 | 1.3. "Contribution"
16 | means Covered Software of a particular Contributor.
17 |
18 | 1.4. "Covered Software"
19 | means Source Code Form to which the initial Contributor has attached
20 | the notice in Exhibit A, the Executable Form of such Source Code
21 | Form, and Modifications of such Source Code Form, in each case
22 | including portions thereof.
23 |
24 | 1.5. "Incompatible With Secondary Licenses"
25 | means
26 |
27 | (a) that the initial Contributor has attached the notice described
28 | in Exhibit B to the Covered Software; or
29 |
30 | (b) that the Covered Software was made available under the terms of
31 | version 1.1 or earlier of the License, but not also under the
32 | terms of a Secondary License.
33 |
34 | 1.6. "Executable Form"
35 | means any form of the work other than Source Code Form.
36 |
37 | 1.7. "Larger Work"
38 | means a work that combines Covered Software with other material, in
39 | a separate file or files, that is not Covered Software.
40 |
41 | 1.8. "License"
42 | means this document.
43 |
44 | 1.9. "Licensable"
45 | means having the right to grant, to the maximum extent possible,
46 | whether at the time of the initial grant or subsequently, any and
47 | all of the rights conveyed by this License.
48 |
49 | 1.10. "Modifications"
50 | means any of the following:
51 |
52 | (a) any file in Source Code Form that results from an addition to,
53 | deletion from, or modification of the contents of Covered
54 | Software; or
55 |
56 | (b) any new file in Source Code Form that contains any Covered
57 | Software.
58 |
59 | 1.11. "Patent Claims" of a Contributor
60 | means any patent claim(s), including without limitation, method,
61 | process, and apparatus claims, in any patent Licensable by such
62 | Contributor that would be infringed, but for the grant of the
63 | License, by the making, using, selling, offering for sale, having
64 | made, import, or transfer of either its Contributions or its
65 | Contributor Version.
66 |
67 | 1.12. "Secondary License"
68 | means either the GNU General Public License, Version 2.0, the GNU
69 | Lesser General Public License, Version 2.1, the GNU Affero General
70 | Public License, Version 3.0, or any later versions of those
71 | licenses.
72 |
73 | 1.13. "Source Code Form"
74 | means the form of the work preferred for making modifications.
75 |
76 | 1.14. "You" (or "Your")
77 | means an individual or a legal entity exercising rights under this
78 | License. For legal entities, "You" includes any entity that
79 | controls, is controlled by, or is under common control with You. For
80 | purposes of this definition, "control" means (a) the power, direct
81 | or indirect, to cause the direction or management of such entity,
82 | whether by contract or otherwise, or (b) ownership of more than
83 | fifty percent (50%) of the outstanding shares or beneficial
84 | ownership of such entity.
85 |
86 | 2. License Grants and Conditions
87 | --------------------------------
88 |
89 | 2.1. Grants
90 |
91 | Each Contributor hereby grants You a world-wide, royalty-free,
92 | non-exclusive license:
93 |
94 | (a) under intellectual property rights (other than patent or trademark)
95 | Licensable by such Contributor to use, reproduce, make available,
96 | modify, display, perform, distribute, and otherwise exploit its
97 | Contributions, either on an unmodified basis, with Modifications, or
98 | as part of a Larger Work; and
99 |
100 | (b) under Patent Claims of such Contributor to make, use, sell, offer
101 | for sale, have made, import, and otherwise transfer either its
102 | Contributions or its Contributor Version.
103 |
104 | 2.2. Effective Date
105 |
106 | The licenses granted in Section 2.1 with respect to any Contribution
107 | become effective for each Contribution on the date the Contributor first
108 | distributes such Contribution.
109 |
110 | 2.3. Limitations on Grant Scope
111 |
112 | The licenses granted in this Section 2 are the only rights granted under
113 | this License. No additional rights or licenses will be implied from the
114 | distribution or licensing of Covered Software under this License.
115 | Notwithstanding Section 2.1(b) above, no patent license is granted by a
116 | Contributor:
117 |
118 | (a) for any code that a Contributor has removed from Covered Software;
119 | or
120 |
121 | (b) for infringements caused by: (i) Your and any other third party's
122 | modifications of Covered Software, or (ii) the combination of its
123 | Contributions with other software (except as part of its Contributor
124 | Version); or
125 |
126 | (c) under Patent Claims infringed by Covered Software in the absence of
127 | its Contributions.
128 |
129 | This License does not grant any rights in the trademarks, service marks,
130 | or logos of any Contributor (except as may be necessary to comply with
131 | the notice requirements in Section 3.4).
132 |
133 | 2.4. Subsequent Licenses
134 |
135 | No Contributor makes additional grants as a result of Your choice to
136 | distribute the Covered Software under a subsequent version of this
137 | License (see Section 10.2) or under the terms of a Secondary License (if
138 | permitted under the terms of Section 3.3).
139 |
140 | 2.5. Representation
141 |
142 | Each Contributor represents that the Contributor believes its
143 | Contributions are its original creation(s) or it has sufficient rights
144 | to grant the rights to its Contributions conveyed by this License.
145 |
146 | 2.6. Fair Use
147 |
148 | This License is not intended to limit any rights You have under
149 | applicable copyright doctrines of fair use, fair dealing, or other
150 | equivalents.
151 |
152 | 2.7. Conditions
153 |
154 | Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted
155 | in Section 2.1.
156 |
157 | 3. Responsibilities
158 | -------------------
159 |
160 | 3.1. Distribution of Source Form
161 |
162 | All distribution of Covered Software in Source Code Form, including any
163 | Modifications that You create or to which You contribute, must be under
164 | the terms of this License. You must inform recipients that the Source
165 | Code Form of the Covered Software is governed by the terms of this
166 | License, and how they can obtain a copy of this License. You may not
167 | attempt to alter or restrict the recipients' rights in the Source Code
168 | Form.
169 |
170 | 3.2. Distribution of Executable Form
171 |
172 | If You distribute Covered Software in Executable Form then:
173 |
174 | (a) such Covered Software must also be made available in Source Code
175 | Form, as described in Section 3.1, and You must inform recipients of
176 | the Executable Form how they can obtain a copy of such Source Code
177 | Form by reasonable means in a timely manner, at a charge no more
178 | than the cost of distribution to the recipient; and
179 |
180 | (b) You may distribute such Executable Form under the terms of this
181 | License, or sublicense it under different terms, provided that the
182 | license for the Executable Form does not attempt to limit or alter
183 | the recipients' rights in the Source Code Form under this License.
184 |
185 | 3.3. Distribution of a Larger Work
186 |
187 | You may create and distribute a Larger Work under terms of Your choice,
188 | provided that You also comply with the requirements of this License for
189 | the Covered Software. If the Larger Work is a combination of Covered
190 | Software with a work governed by one or more Secondary Licenses, and the
191 | Covered Software is not Incompatible With Secondary Licenses, this
192 | License permits You to additionally distribute such Covered Software
193 | under the terms of such Secondary License(s), so that the recipient of
194 | the Larger Work may, at their option, further distribute the Covered
195 | Software under the terms of either this License or such Secondary
196 | License(s).
197 |
198 | 3.4. Notices
199 |
200 | You may not remove or alter the substance of any license notices
201 | (including copyright notices, patent notices, disclaimers of warranty,
202 | or limitations of liability) contained within the Source Code Form of
203 | the Covered Software, except that You may alter any license notices to
204 | the extent required to remedy known factual inaccuracies.
205 |
206 | 3.5. Application of Additional Terms
207 |
208 | You may choose to offer, and to charge a fee for, warranty, support,
209 | indemnity or liability obligations to one or more recipients of Covered
210 | Software. However, You may do so only on Your own behalf, and not on
211 | behalf of any Contributor. You must make it absolutely clear that any
212 | such warranty, support, indemnity, or liability obligation is offered by
213 | You alone, and You hereby agree to indemnify every Contributor for any
214 | liability incurred by such Contributor as a result of warranty, support,
215 | indemnity or liability terms You offer. You may include additional
216 | disclaimers of warranty and limitations of liability specific to any
217 | jurisdiction.
218 |
219 | 4. Inability to Comply Due to Statute or Regulation
220 | ---------------------------------------------------
221 |
222 | If it is impossible for You to comply with any of the terms of this
223 | License with respect to some or all of the Covered Software due to
224 | statute, judicial order, or regulation then You must: (a) comply with
225 | the terms of this License to the maximum extent possible; and (b)
226 | describe the limitations and the code they affect. Such description must
227 | be placed in a text file included with all distributions of the Covered
228 | Software under this License. Except to the extent prohibited by statute
229 | or regulation, such description must be sufficiently detailed for a
230 | recipient of ordinary skill to be able to understand it.
231 |
232 | 5. Termination
233 | --------------
234 |
235 | 5.1. The rights granted under this License will terminate automatically
236 | if You fail to comply with any of its terms. However, if You become
237 | compliant, then the rights granted under this License from a particular
238 | Contributor are reinstated (a) provisionally, unless and until such
239 | Contributor explicitly and finally terminates Your grants, and (b) on an
240 | ongoing basis, if such Contributor fails to notify You of the
241 | non-compliance by some reasonable means prior to 60 days after You have
242 | come back into compliance. Moreover, Your grants from a particular
243 | Contributor are reinstated on an ongoing basis if such Contributor
244 | notifies You of the non-compliance by some reasonable means, this is the
245 | first time You have received notice of non-compliance with this License
246 | from such Contributor, and You become compliant prior to 30 days after
247 | Your receipt of the notice.
248 |
249 | 5.2. If You initiate litigation against any entity by asserting a patent
250 | infringement claim (excluding declaratory judgment actions,
251 | counter-claims, and cross-claims) alleging that a Contributor Version
252 | directly or indirectly infringes any patent, then the rights granted to
253 | You by any and all Contributors for the Covered Software under Section
254 | 2.1 of this License shall terminate.
255 |
256 | 5.3. In the event of termination under Sections 5.1 or 5.2 above, all
257 | end user license agreements (excluding distributors and resellers) which
258 | have been validly granted by You or Your distributors under this License
259 | prior to termination shall survive termination.
260 |
261 | ************************************************************************
262 | * *
263 | * 6. Disclaimer of Warranty *
264 | * ------------------------- *
265 | * *
266 | * Covered Software is provided under this License on an "as is" *
267 | * basis, without warranty of any kind, either expressed, implied, or *
268 | * statutory, including, without limitation, warranties that the *
269 | * Covered Software is free of defects, merchantable, fit for a *
270 | * particular purpose or non-infringing. The entire risk as to the *
271 | * quality and performance of the Covered Software is with You. *
272 | * Should any Covered Software prove defective in any respect, You *
273 | * (not any Contributor) assume the cost of any necessary servicing, *
274 | * repair, or correction. This disclaimer of warranty constitutes an *
275 | * essential part of this License. No use of any Covered Software is *
276 | * authorized under this License except under this disclaimer. *
277 | * *
278 | ************************************************************************
279 |
280 | ************************************************************************
281 | * *
282 | * 7. Limitation of Liability *
283 | * -------------------------- *
284 | * *
285 | * Under no circumstances and under no legal theory, whether tort *
286 | * (including negligence), contract, or otherwise, shall any *
287 | * Contributor, or anyone who distributes Covered Software as *
288 | * permitted above, be liable to You for any direct, indirect, *
289 | * special, incidental, or consequential damages of any character *
290 | * including, without limitation, damages for lost profits, loss of *
291 | * goodwill, work stoppage, computer failure or malfunction, or any *
292 | * and all other commercial damages or losses, even if such party *
293 | * shall have been informed of the possibility of such damages. This *
294 | * limitation of liability shall not apply to liability for death or *
295 | * personal injury resulting from such party's negligence to the *
296 | * extent applicable law prohibits such limitation. Some *
297 | * jurisdictions do not allow the exclusion or limitation of *
298 | * incidental or consequential damages, so this exclusion and *
299 | * limitation may not apply to You. *
300 | * *
301 | ************************************************************************
302 |
303 | 8. Litigation
304 | -------------
305 |
306 | Any litigation relating to this License may be brought only in the
307 | courts of a jurisdiction where the defendant maintains its principal
308 | place of business and such litigation shall be governed by laws of that
309 | jurisdiction, without reference to its conflict-of-law provisions.
310 | Nothing in this Section shall prevent a party's ability to bring
311 | cross-claims or counter-claims.
312 |
313 | 9. Miscellaneous
314 | ----------------
315 |
316 | This License represents the complete agreement concerning the subject
317 | matter hereof. If any provision of this License is held to be
318 | unenforceable, such provision shall be reformed only to the extent
319 | necessary to make it enforceable. Any law or regulation which provides
320 | that the language of a contract shall be construed against the drafter
321 | shall not be used to construe this License against a Contributor.
322 |
323 | 10. Versions of the License
324 | ---------------------------
325 |
326 | 10.1. New Versions
327 |
328 | Mozilla Foundation is the license steward. Except as provided in Section
329 | 10.3, no one other than the license steward has the right to modify or
330 | publish new versions of this License. Each version will be given a
331 | distinguishing version number.
332 |
333 | 10.2. Effect of New Versions
334 |
335 | You may distribute the Covered Software under the terms of the version
336 | of the License under which You originally received the Covered Software,
337 | or under the terms of any subsequent version published by the license
338 | steward.
339 |
340 | 10.3. Modified Versions
341 |
342 | If you create software not governed by this License, and you want to
343 | create a new license for such software, you may create and use a
344 | modified version of this License if you rename the license and remove
345 | any references to the name of the license steward (except to note that
346 | such modified license differs from this License).
347 |
348 | 10.4. Distributing Source Code Form that is Incompatible With Secondary
349 | Licenses
350 |
351 | If You choose to distribute Source Code Form that is Incompatible With
352 | Secondary Licenses under the terms of this version of the License, the
353 | notice described in Exhibit B of this License must be attached.
354 |
355 | Exhibit A - Source Code Form License Notice
356 | -------------------------------------------
357 |
358 | This Source Code Form is subject to the terms of the Mozilla Public
359 | License, v. 2.0. If a copy of the MPL was not distributed with this
360 | file, You can obtain one at http://mozilla.org/MPL/2.0/.
361 |
362 | If it is not possible or desirable to put the notice in a particular
363 | file, then You may include the notice in a location (such as a LICENSE
364 | file in a relevant directory) where a recipient would be likely to look
365 | for such a notice.
366 |
367 | You may add additional accurate notices of copyright ownership.
368 |
369 | Exhibit B - "Incompatible With Secondary Licenses" Notice
370 | ---------------------------------------------------------
371 |
372 | This Source Code Form is "Incompatible With Secondary Licenses", as
373 | defined by the Mozilla Public License, v. 2.0.
374 |
--------------------------------------------------------------------------------
/src/tr_ttb.erl:
--------------------------------------------------------------------------------
1 | %% -*- mode: erlang; indent-tabs-mode: nil; -*-
2 | %%---- BEGIN COPYRIGHT -------------------------------------------------------
3 | %%
4 | %% Copyright (C) 2016 Ulf Wiger. All rights reserved.
5 | %%
6 | %% This Source Code Form is subject to the terms of the Mozilla Public
7 | %% License, v. 2.0. If a copy of the MPL was not distributed with this
8 | %% file, You can obtain one at http://mozilla.org/MPL/2.0/.
9 | %%
10 | %%---- END COPYRIGHT ---------------------------------------------------------
11 | -module(tr_ttb).
12 |
13 | -export([ event/1 ]).
14 |
15 | -export([ dbg_tracer/0
16 | , dbg_tracer/1
17 | , dbg_stop/0 ]).
18 |
19 | -export([
20 | on_nodes/2,
21 | on_nodes/3,
22 | on_nodes/4,
23 | default_patterns/0,
24 | default_flags/0,
25 | stop/0,
26 | stop_nofetch/0,
27 | format/1,
28 | format/2,
29 | format/3,
30 | format_opts/0,
31 | format_opts/1,
32 | handler/4,
33 | pr/2, %% (Term, Module) -> string()
34 | pp/3,
35 | pp_term/2, %% (Term, Module | F((T) -> {yes, T1} | no)) -> Term1
36 | pp_custom/3, %% (Term, Tag, Fmt((X) -> X1)) -> Term1
37 | record_print_fun/1
38 | ]).
39 |
40 | -export([ cfg/3 ]).
41 |
42 | -export([ shell_records_tab/0 ]).
43 |
44 | -export_type([ flag/0, flags/0,
45 | pattern/0, patterns/0,
46 | proc/0 ]).
47 |
48 | -type trace_pat() :: any().
49 | -type pattern() :: {module(), atom(), arity(), trace_pat()}.
50 | -type patterns() :: [pattern()].
51 |
52 | -type proc() :: pid() | port() | atom() | {global,any()}
53 | | all | processes | ports | existing | existing_processes
54 | | existing_ports | new | new_processes | new_ports.
55 | -type procs() :: proc() | [proc()].
56 |
57 | -type flag() :: clear | all
58 | | m | s | r | c | call | p | sos | sol | sofs | sofl
59 | | send | 'receive' | call | procs | ports | garbage_collection
60 | | running | set_on_spawn | set_on_first_spawn | set_on_link
61 | | set_on_first_link | timestamp | monotonic_timestamp
62 | | strict_monotonic_timestamp | arity | return_to | silent
63 | | running_procs | running_ports | exiting.
64 | -type flags() :: flag() | [flag()].
65 |
66 | -callback flags() -> {procs(), flags()}.
67 | -callback patterns() -> [pattern()].
68 |
69 | -define(EVENT(E, S), event(?LINE, E, S)).
70 |
71 | %% This function is also traced. Can be used to insert markers in the trace
72 | %% log.
73 | event(E) ->
74 | event(?LINE, E, none).
75 |
76 | event(_, _, _) ->
77 | ok.
78 |
79 | dbg_tracer() ->
80 | dbg_tracer(#{}).
81 |
82 | dbg_tracer(Opts) when is_map(Opts) ->
83 | St0 = init_state(maps:merge(#{ fd => group_leader()
84 | , print_header => false }, Opts)),
85 | dbg:tracer(process, {fun dhandler/2, St0}).
86 |
87 | dbg_stop() ->
88 | await_traces(),
89 | dbg:stop().
90 |
91 | shell_records_tab() ->
92 | case find_shell_process() of
93 | ShellPid when is_pid(ShellPid) ->
94 | case [T || T <- ets:all(),
95 | ets:info(T, owner) == ShellPid
96 | andalso ets:info(T, name) == shell_records] of
97 | [RecTab] ->
98 | RecTab;
99 | [] ->
100 | undefined
101 | end;
102 | _ ->
103 | undefined
104 | end.
105 |
106 | find_shell_process() ->
107 | find_shell_process(group_leader()).
108 |
109 | find_shell_process(GL) ->
110 | case lists:keyfind(shell, 1, pi(GL, dictionary)) of
111 | {_, Pid} ->
112 | Pid;
113 | false ->
114 | case pi(GL, group_leader) of
115 | GL -> undefined;
116 | GL1 -> find_shell_process(GL1)
117 | end
118 | end.
119 |
120 | pi(P, Key) when is_pid(P) ->
121 | {_, I} = process_info(P, Key),
122 | I.
123 |
124 | await_traces() ->
125 | case dbg:get_tracer() of
126 | {ok, Tracer} ->
127 | await_tracer(process_info(Tracer, message_queue_len), Tracer);
128 | {error, _} ->
129 | ok
130 | end.
131 |
132 | await_tracer({message_queue_len, L}, Tracer) when L > 3 ->
133 | timer:sleep(10),
134 | await_tracer(process_info(Tracer, message_queue_len), Tracer);
135 | await_tracer(_, _) ->
136 | ok.
137 |
138 |
139 | on_nodes(Ns, File) ->
140 | on_nodes(Ns, default_patterns(), default_flags(), [{file, File}]).
141 |
142 | on_nodes(Ns, File, Spec) ->
143 | on_nodes(Ns,
144 | cfg(Spec, patterns, default_patterns()),
145 | cfg(Spec, flags, default_flags()),
146 | [ {file, File}
147 | , {tr_ttb_info, cfg(Spec, info, undefined)}]).
148 |
149 | -spec on_nodes([node()], [pattern()], {procs(), flags()}, list()) ->
150 | {ok,list()} | {error, any()}.
151 | on_nodes(Ns, Patterns0, Flags, Opts0) ->
152 | Opts = lists:keydelete(tr_ttb_info, 1, Opts0),
153 | Patterns = expand_patterns(Patterns0),
154 | Res = ttb_start_trace(Ns, Patterns, Flags, Opts),
155 | ?EVENT(ttb_started, maybe_info(#{ nodes => Ns
156 | , patterns => Patterns
157 | , flags => Flags }, Opts0)),
158 | Res.
159 |
160 | maybe_info(Map, Opts) ->
161 | case lists:keyfind(tr_ttb_info, 1, Opts) of
162 | {_, Info} when Info =/= undefined ->
163 | Map#{info => Info};
164 | _ ->
165 | Map
166 | end.
167 |
168 | ttb_start_trace(Ns, Patterns, Flags, Opts) ->
169 | Start = maps:get(start, Patterns, []),
170 | Res = ttb:start_trace(Ns, Start, Flags, Opts),
171 | maps:fold(
172 | fun(Op, Pats, _) when Op==tp; Op==tpl->
173 | [ttb:Op(M,F,A,MS) || {M,F,A,MS} <- Pats];
174 | (Op, Pats, _) when Op==ctp; Op==ctpl; Op==ctpg ->
175 | [ttb:Op(M,F,A) || {M,F,A} <- Pats];
176 | (tpe, Pats, _) ->
177 | [dbg:tpe(E, MS) || {E, MS} <- Pats];
178 | (ctpe, Pats, _) ->
179 | [dbg:ctpe(E) || E <- Pats]
180 | end, ok, maps:without([start], Patterns)),
181 | Res.
182 |
183 | expand_patterns(Patterns) when is_map(Patterns) ->
184 | maps:merge(Patterns,
185 | maps:map(fun(_K, V) when is_list(V) ->
186 | [expand_pat(P) || P <- V];
187 | (_, V) -> V
188 | end,
189 | maps:with([start,tp,tpl], Patterns)));
190 | expand_patterns(Patterns) when is_list(Patterns) ->
191 | #{start => [expand_pat(P) || P <- Patterns]}.
192 |
193 | expand_pat(P) when is_tuple(P) ->
194 | Sz = tuple_size(P),
195 | case element(Sz, P) of
196 | x ->
197 | setelement(Sz, P, [{'_',[],[{exception_trace}]}]);
198 | _ ->
199 | P
200 | end;
201 | expand_pat(P) ->
202 | P.
203 |
204 | -spec default_patterns() -> [pattern()].
205 | default_patterns() ->
206 | [{?MODULE , event, 3, []}].
207 |
208 | -spec default_flags() -> {procs(), flags()}.
209 | default_flags() ->
210 | {all, call}.
211 |
212 | stop() ->
213 | {stopped, Dir} = ttb:stop([return_fetch_dir]),
214 | Dir.
215 |
216 | stop_nofetch() ->
217 | ttb:stop([nofetch]).
218 |
219 | format(Dir) ->
220 | format(Dir, standard_io).
221 |
222 | format(Dir, OutFile) ->
223 | format(Dir, OutFile, #{}).
224 |
225 | format(Dir, OutFile, Opts) ->
226 | try ttb:format(Dir, format_opts(OutFile, Opts))
227 | catch
228 | error:exceeded_limit = Reason ->
229 | {error, Reason};
230 | error:Other:ST ->
231 | {error, {Other, ST}}
232 | end.
233 |
234 | format_opts() ->
235 | format_opts(standard_io).
236 |
237 | format_opts(Outfile) ->
238 | format_opts(Outfile, #{}).
239 |
240 | format_opts(OutFile, Opts0) ->
241 | Opts = maps:merge(#{limit => 10000}, Opts0),
242 | [{out, OutFile}, {handler, {fun handler/4, init_state(Opts)}}].
243 |
244 | init_state(Opts0) ->
245 | Opts = maps:merge(#{ ts => 0
246 | , diff => 0
247 | , limit => infinity
248 | , sofar => 0
249 | , opts => Opts0 }, Opts0),
250 | case Opts of
251 | #{shell_records := true, shell_records_tab := _} ->
252 | Opts;
253 | #{shell_records := true} ->
254 | case shell_records_tab() of
255 | undefined ->
256 | maps:without([shell_records, shell_records_tab], Opts);
257 | Tab ->
258 | Opts#{shell_records_tab => Tab}
259 | end;
260 | _ ->
261 | Opts
262 | end.
263 |
264 | %% Real-time handler (see dbg_tracer/1
265 | dhandler(end_of_trace, St) ->
266 | St;
267 | dhandler(Trace, #{fd := Fd} = St) ->
268 | handler(Fd, Trace, [], St).
269 |
270 | handler(Fd, Trace, TI, #{delay := D} = Acc) ->
271 | timer:sleep(D),
272 | handler(Fd, Trace, TI, maps:remove(delay, Acc));
273 | handler(_, _, _, #{limit_exceeded := true} = Acc) ->
274 | Acc;
275 | handler(Fd, Trace, TI, Acc) ->
276 | try Res = handler_(Fd, Trace, TI, Acc),
277 | Res
278 | catch
279 | error:limit_exceeded ->
280 | Acc#{limit_exceeded => true};
281 | Caught:E:ST ->
282 | fwrite(user, "CAUGHT ~p:~p:~p~nTrace=~p", [Caught, E, ST, Trace]),
283 | Acc
284 | end.
285 |
286 | handler_(Fd, Trace, _, #{ts := TSp, diff := Diff, sofar := Sofar} = Acc) ->
287 | TS = ts(Trace, TSp),
288 | L0 = case {TSp,Diff} of {0,0} ->
289 | case maps:get(print_header, Acc, true) of
290 | true ->
291 | io:fwrite(Fd, "%% -*- erlang -*-~n", []),
292 | io:put_chars(Fd, format_time(TS)),
293 | 2;
294 | _ ->
295 | 0
296 | end;
297 | _ -> 0
298 | end,
299 | Tdiff = tdiff(TS, TSp, time_resolution(Acc)),
300 | Diff1 = Diff + Tdiff,
301 | Sofar1 = Sofar + L0,
302 | Acc1 = Acc#{sofar => Sofar1, ts => TS, diff => Diff1},
303 | check_limit_exceeded(Acc1),
304 | Lines =
305 | case Trace of
306 | {trace_ts, From, call, {Mod, Fun, Args}, TS} ->
307 | {Pid, Node} = pid_and_node(From),
308 | print_call(Fd, Pid, Node, Mod, Fun, Args, Diff1, Acc);
309 | {trace_ts, From, Type, {Mod, Fun, Arity}, Info, TS}
310 | when Type =:= return_from; Type =:= exception_from ->
311 | {Pid, Node} = pid_and_node(From),
312 | print_return(Fd, Type, Pid, Node, Mod, Fun, Arity, Info, Diff1, Acc);
313 | {trace_ts, From, Type, Info, TS} ->
314 | {Pid, Node} = pid_and_node(From),
315 | print_other(Fd, #{type => Type}, Pid, Node, Info, Diff1, Acc);
316 | {trace_ts, From, Type, Arg, Info, TS} ->
317 | {Pid, Node} = pid_and_node(From),
318 | print_other(Fd, #{type => Type, arg => Arg}, Pid, Node, Info, Diff1, Acc);
319 | TraceTS when element(1, TraceTS) == trace_ts ->
320 | fwrite(Fd, "~p~n", [Trace]);
321 | _ ->
322 | fwrite(Fd, "~p~n", [Trace])
323 | end,
324 | Acc1#{sofar => Sofar1 + Lines}.
325 |
326 | pid_and_node({Pid, _, Node}) ->
327 | {Pid, Node};
328 | pid_and_node(Pid) when is_pid(Pid); is_port(Pid) ->
329 | {Pid, local}.
330 |
331 | fwrite(Fd, Fmt, Args) ->
332 | io_reqs(Fd, [{put_chars, fwrite(Fmt, Args)}]).
333 |
334 | io_reqs(Fd, Rs) ->
335 | Lines = count_lines(Rs),
336 | io:requests(Fd, Rs),
337 | Lines.
338 |
339 | count_lines(Rs) ->
340 | lists:foldl(
341 | fun(nl, Acc) -> Acc+1;
342 | ({put_chars, Cs}, Acc) ->
343 | count_newlines(Cs) + Acc;
344 | ({put_chars, unicode, Cs}, Acc) ->
345 | count_newlines(Cs) + Acc
346 | end, 0, Rs).
347 |
348 | count_newlines(Cs) ->
349 | case re:run(Cs, <<"\\v">>, [global]) of
350 | {match, Ms} ->
351 | length(Ms);
352 | nomatch ->
353 | 0
354 | end.
355 |
356 |
357 | check_limit_exceeded(#{sofar := Sofar, limit := Limit}) ->
358 | if Sofar > Limit ->
359 | error(limit_exceeded);
360 | true ->
361 | ok
362 | end.
363 |
364 | ts(Trace, _TSp) when element(1, Trace) == trace_ts ->
365 | Sz = tuple_size(Trace),
366 | element(Sz, Trace);
367 | ts(_, 0) ->
368 | erlang:timestamp();
369 | ts(_, TSp) ->
370 | TSp.
371 |
372 | print_call(Fd, Pid, Node, Mod, Fun, Args, Diff, Acc) ->
373 | case {Fun, Args} of
374 | {event, [Line, Evt, State]} when is_integer(Line) ->
375 | Lines = print_evt(Fd, Pid, Node, Mod, Line, Evt, State, Diff, Acc),
376 | case get_pids({Evt, State}) of
377 | [] -> Lines;
378 | Pids ->
379 | Lines1 = fwrite(Fd, " Nodes = ~p~n", [Pids]),
380 | Lines + Lines1
381 | end;
382 | _ ->
383 | print_call_(Fd, Pid, Node, Mod, Fun, Args, Diff, Acc)
384 | end.
385 |
386 | print_return(Fd, Type, Pid, Node, Mod, Fun, Arity, Info, T, Acc) ->
387 | Tstr = fwrite("~w", [T]),
388 | Indent = iolist_size(Tstr) + 3 + 4,
389 | Head = print_return_head(Type, Pid, Node, Mod, Fun, Arity),
390 | Line1Len = iolist_size([Tstr, Head]),
391 | InfoPP = pp(Info, 1, Mod, Acc),
392 | Res = case fits_on_line(InfoPP, Line1Len, 79) of %% minus space
393 | true -> [" ", InfoPP];
394 | false ->
395 | ["\n", indent(Indent), pp(Info, Indent, Mod, Acc)]
396 | end,
397 | io_reqs(Fd, [{put_chars, unicode, [Tstr, Head, Res]}, nl]).
398 |
399 | print_other(Fd, Type, Pid, Node, Info, T, Acc) ->
400 | Tstr = fwrite("~w", [T]),
401 | Indent = iolist_size(Tstr) + 3 + 4,
402 | Head = print_other_head(Pid, Node, Type),
403 | Line1Len = iolist_size([Tstr, Head]),
404 | Mod = guess_mod(Type, Info),
405 | InfoPP = pp(Info, 1, Mod, Acc),
406 | Res = case fits_on_line(InfoPP, Line1Len, 79) of
407 | true -> [" ", InfoPP];
408 | false ->
409 | ["\n", indent(Indent), pp(Info, Indent, Mod, Acc)]
410 | end,
411 | io_reqs(Fd, [{put_chars, unicode, [Tstr, Head, Res]}, nl]).
412 |
413 | typestr(return_from ) -> "->";
414 | typestr(exception_from) -> "xx~~>".
415 |
416 | guess_mod(Type, Info) ->
417 | guess_mod(Type, Info, ?MODULE).
418 |
419 | guess_mod(#{type := exit}, {_, [{Mod, _, _}|_]}, Default) when is_atom(Mod) ->
420 | case erlang:function_exported(Mod, module_info, 0) of
421 | true -> Mod;
422 | false -> Default
423 | end;
424 | guess_mod(_, {erlang, apply, [Mod|_]}, _) when is_atom(Mod) ->
425 | Mod;
426 | guess_mod(_, {erlang, apply, [F|_]}, _) when is_function(F) ->
427 | {_, Mod} = erlang:fun_info(F, module),
428 | Mod;
429 | guess_mod(_, _, Default) ->
430 | Default.
431 |
432 | -define(CHAR_MAX, 60).
433 |
434 | print_evt(Fd, Pid, N, Mod, L, E, St, T, Acc) ->
435 | Tstr = fwrite("~w", [T]),
436 | Indent = iolist_size(Tstr) + 3,
437 | Head = case N of
438 | local -> fwrite(" - ~w|~w/~w: " , [Pid, Mod, L]);
439 | _ -> fwrite(" - ~w~w|~w/~w: ", [Pid, N, Mod, L])
440 | end,
441 | EvtCol = iolist_size(Head) + 1,
442 | EvtCs = pp(E, EvtCol, Mod, Acc),
443 | io_reqs(Fd, [{put_chars, unicode, [Tstr, Head, EvtCs]}, nl
444 | | print_tail(St, Mod, Indent, Acc)]).
445 |
446 | print_call_(Fd, Pid, N, Mod, Fun, Args, T, Acc) ->
447 | Tstr = fwrite("~w", [T]),
448 | Indent = iolist_size(Tstr) + 3 + 4,
449 | Head = print_call_head(Pid, N, Mod, Fun),
450 | Line1Len = iolist_size([Tstr, Head]),
451 | PlainArgs = pp_args(Args, 1, Mod, Acc),
452 | Rest = case fits_on_line(PlainArgs, Line1Len, 79) of %% minus )
453 | true -> [PlainArgs, ")"];
454 | false ->
455 | ["\n", indent(Indent),
456 | pp_args(Args, Indent, Mod, Acc), ")"]
457 | end,
458 | io_reqs(Fd, [{put_chars, unicode, [Tstr, Head, Rest]}, nl]).
459 |
460 | print_call_head(Pid, N, Mod, Fun) ->
461 | case N of
462 | local -> fwrite(" - ~w|~w:~w(" , [Pid, Mod, Fun]);
463 | _ -> fwrite(" - ~w~w|~w:~w(", [Pid, N, Mod, Fun])
464 | end.
465 |
466 | print_other_head(Pid, N, #{type := Type, arg := Arg}) ->
467 | case N of
468 | local -> fwrite(" - ~w|~w[~w]:", [Pid, Type, Arg]);
469 | _ -> fwrite(" - ~w~w|~w[~w]:", [Pid, N, Type, Arg])
470 | end;
471 | print_other_head(Pid, N, #{type := Type}) ->
472 | case N of
473 | local -> fwrite(" - ~w|~w:", [Pid, Type]);
474 | _ -> fwrite(" - ~w~w|~w", [Pid, N, Type])
475 | end.
476 |
477 | print_return_head(Type, Pid, Node, Mod, Fun, Arity) ->
478 | case Node of
479 | local -> fwrite(" - ~w|~w:~w/~w " ++ typestr(Type), [Pid, Mod, Fun, Arity]);
480 | _ -> fwrite(" - ~w~w|~w:~w/~w " ++ typestr(Type), [Pid, Node, Mod, Fun, Arity])
481 | end.
482 |
483 | fwrite(Fmt, Args) ->
484 | io_lib:fwrite(Fmt, Args).
485 |
486 | indent(N) ->
487 | lists:duplicate(N, $\s).
488 |
489 | rm_braces(Str) ->
490 | %% allow for whitespace (incl vertical) before and after
491 | B = iolist_to_binary(Str),
492 | Sz = byte_size(B),
493 | {Open,1} = binary:match(B, [<<"{">>]),
494 | {Close,1} = lists:last(
495 | binary:matches(B, [<<"}">>])),
496 | SzA = Open + 1,
497 | SzB = Sz-Close,
498 | SzMid = Sz - SzA - SzB,
499 | <<_:SzA/unit:8,Mid:SzMid/binary,_/binary>> = B,
500 | Mid.
501 |
502 | fits_on_line(IOList, Len, LineLen) ->
503 | iolist_size(IOList) + Len =< LineLen
504 | andalso has_no_line_breaks(IOList).
505 |
506 | has_no_line_breaks(IOL) ->
507 | nomatch =:= re:run(IOL, <<"\\v">>).
508 |
509 |
510 | print_tail(none, _, _Col, _Acc) -> [];
511 | print_tail(St, Mod, Col, Acc) ->
512 | Cs = pp(St, Col+1, Mod, Acc),
513 | [{put_chars, unicode, [lists:duplicate(Col,$\s), Cs]}, nl].
514 |
515 | %% Pretty-printing the args list as a list, may trigger the 'string' interpretation
516 | %% of the list. We want to remove the brackets anyway, so convert to tuple, then remove the braces
517 | pp_args(Args, Col, Mod, Acc) ->
518 | rm_braces(pp(list_to_tuple(Args), Col, Mod, Acc)).
519 |
520 | pp(Term, Col, Mod) ->
521 | pp(Term, Col, Mod, #{}).
522 |
523 | pp(Term, Col, Mod, Acc) ->
524 | Out = pp_term(Term, Mod),
525 | io_lib_pretty:print(Out,
526 | [{column, Col},
527 | {line_length, 80},
528 | {depth, -1},
529 | {max_chars, ?CHAR_MAX},
530 | {record_print_fun, record_print_fun(Mod, Acc)}]).
531 |
532 | pp_term(T, M) when is_atom(M) ->
533 | pp_term(T, fun M:pp_term/1);
534 | pp_term(T, F) when is_function(F, 1) ->
535 | try F(T) of
536 | {yes, Out} -> Out;
537 | no -> pp_term_(T, F)
538 | catch
539 | error:_ ->
540 | pp_term_(T, F)
541 | end.
542 |
543 | pp_term_(D, _) when element(1, D) == dict ->
544 | pp_custom(D, '$dict', fun dict_to_list/1);
545 | pp_term_(T, M) when is_tuple(T) ->
546 | list_to_tuple([pp_term(Trm, M) || Trm <- tuple_to_list(T)]);
547 | pp_term_(L, M) when is_list(L) ->
548 | %% Could be an improper list
549 | lmap(L, fun(T) -> pp_term(T, M) end);
550 | pp_term_(T, _) ->
551 | T.
552 |
553 | %% Similar to lager:pr(Term, Module)
554 | %% Tries to print term T as a record, given the record_info() data
555 | %% accessible via module M. Return value is a string in either case,
556 | %% representing the pretty-printed term, formatted for a single (long) line.
557 | %% The chars_limit values are somewhat arbitrarily chosen.
558 | %%
559 | pr(T, M) when is_tuple(T), is_atom(element(1,T)) ->
560 | Tag = element(1, T),
561 | NoFields = size(T) - 1,
562 | RPF = record_print_fun(M),
563 | case RPF(Tag, NoFields) of
564 | no ->
565 | T;
566 | [] ->
567 | io_lib:format("#~w{}", [Tag]);
568 | Fields ->
569 | Max = 1000,
570 | ElemMax = 1000 div max(1,NoFields div 4),
571 | [{K1,V1}|Pairs] = lists:zip(Fields, tl(tuple_to_list(T))),
572 | io_lib:format("#~w{~w=~0P~s}",
573 | [Tag, K1, V1, 5,
574 | [io_lib:format(",~w=~0P",[K,V,5],
575 | [{chars_limit, ElemMax}])
576 | || {K,V} <- Pairs]], [{chars_limit, Max}])
577 | end;
578 | pr(T, _) ->
579 | io_lib:format("~0P", [T, 5], [{chars_limit, 200}]).
580 |
581 | lmap([H|T], F) when is_list(T) ->
582 | [F(H)|lmap(T,F)];
583 | lmap([H|X], F) ->
584 | [F(H)|F(X)];
585 | lmap([], _) ->
586 | [].
587 |
588 | pp_custom(X, Tag, F) ->
589 | try {Tag, F(X)}
590 | catch
591 | error:_ ->
592 | {'ERROR-CUSTOM', Tag, X}
593 | end.
594 |
595 | tdiff(_, 0, _) -> 0;
596 | tdiff(TS, T0, Res) ->
597 | case Res of
598 | millisecond ->
599 | timer:now_diff(TS, T0) div 1000;
600 | microsecond ->
601 | timer:now_diff(TS, T0)
602 | end.
603 |
604 | time_resolution(Opts) ->
605 | maps:get(time_resolution, Opts, millisecond).
606 |
607 | record_print_fun(Mod) ->
608 | record_print_fun(Mod, #{}).
609 |
610 | record_print_fun(Mod, Acc) ->
611 | fun(Tag, NoFields) ->
612 | record_print_fun_(Mod, Tag, NoFields, [], Acc)
613 | end.
614 |
615 | record_print_fun_(Mod, Tag, NoFields, V, Acc) ->
616 | case shell_record_print(Tag, NoFields, Acc) of
617 | Fields when is_list(Fields) ->
618 | Fields;
619 | _ ->
620 | try Mod:record_fields(Tag) of
621 | Fields when is_list(Fields) ->
622 | case length(Fields) of
623 | NoFields -> Fields;
624 | _ -> no
625 | end;
626 | {check_mods, Mods} when is_list(Mods) ->
627 | check_mods(Mods, Tag, NoFields, V, Acc);
628 | no -> no
629 | catch
630 | _:_ ->
631 | no
632 | end
633 | end.
634 |
635 | %% code copied and slightly modified from shell:record_print_fun/1
636 | shell_record_print(Tag, NoFields, #{shell_records_tab := RT}) ->
637 | try ets:lookup(RT, Tag) of
638 | [{_,{attribute,_,record,{Tag,Fields}}}]
639 | when length(Fields) =:= NoFields ->
640 | record_fields(Fields);
641 | _ ->
642 | no
643 | catch
644 | error:_ ->
645 | no
646 | end;
647 | shell_record_print(_, _, _) ->
648 | no.
649 |
650 | record_fields([{record_field,_,{atom,_,Field}} | Fs]) ->
651 | [Field | record_fields(Fs)];
652 | record_fields([{record_field,_,{atom,_,Field},_} | Fs]) ->
653 | [Field | record_fields(Fs)];
654 | record_fields([{typed_record_field,Field,_Type} | Fs]) ->
655 | record_fields([Field | Fs]);
656 | record_fields([]) ->
657 | [].
658 |
659 |
660 | check_mods([], _, _, _, _) ->
661 | no;
662 | check_mods([M|Mods], Tag, NoFields, V, Acc) ->
663 | Cont = fun(V1) -> check_mods(Mods, Tag, NoFields, V1, Acc) end,
664 | case lists:member(M, V) of
665 | true ->
666 | Cont(V);
667 | false ->
668 | V1 = [M|V],
669 | try record_print_fun_(M, Tag, NoFields, V1, Acc) of
670 | Fields when is_list(Fields) ->
671 | Fields;
672 | no ->
673 | Cont(V1)
674 | catch
675 | _:_ ->
676 | Cont(V1)
677 | end
678 | end.
679 |
680 | get_pids(Term) ->
681 | Pids = dict:to_list(get_pids(Term, dict:new())),
682 | [{node_prefix(P), N} || {N, P} <- Pids].
683 |
684 | get_pids(T, Acc) when is_tuple(T) ->
685 | get_pids(tuple_to_list(T), Acc);
686 | get_pids(L, Acc) when is_list(L) ->
687 | get_pids_(L, Acc);
688 | get_pids(P, Acc) when is_pid(P) ->
689 | try ets:lookup(ttb, P) of
690 | [{_, _, Node}] ->
691 | dict:store(Node, P, Acc);
692 | _ ->
693 | Acc
694 | catch
695 | error:_ -> Acc
696 | end;
697 | get_pids(_, Acc) ->
698 | Acc.
699 |
700 | get_pids_([H|T], Acc) ->
701 | get_pids_(T, get_pids(H, Acc));
702 | get_pids_(_, Acc) ->
703 | Acc.
704 |
705 |
706 | node_prefix(P) ->
707 | case re:run(pid_to_list(P), "[^<\\.]+", [{capture,first,list}]) of
708 | {match, [Pfx]} ->
709 | Pfx;
710 | _ ->
711 | P
712 | end.
713 |
714 | cfg(Mod, Key, Default) when is_atom(Mod) ->
715 | try_callback(Mod, Key, [], Default);
716 | cfg(Spec, Key, Default) when is_map(Spec) ->
717 | case maps:find(Key, Spec) of
718 | {ok, Res} -> Res;
719 | error ->
720 | case maps:get(module, Spec, undefined) of
721 | undefined -> Default;
722 | Mod ->
723 | try_callback(Mod, Key, [], Default)
724 | end
725 | end.
726 |
727 | try_callback(Mod, Key, Args, Default) ->
728 | ensure_loaded(Mod),
729 | case erlang:function_exported(Mod, Key, length(Args)) of
730 | true ->
731 | apply(Mod, Key, Args);
732 | false ->
733 | Default
734 | end.
735 |
736 | ensure_loaded(Mod) ->
737 | case code:ensure_loaded(Mod) of
738 | {module, _} ->
739 | true;
740 | {error, _} ->
741 | false
742 | end.
743 |
744 | %% -dialyzer(no_opaque).
745 | -dialyzer([{nowarn_function, dict_to_list/1}, no_opaque]).
746 | dict_to_list(D) when element(1, D) == dict ->
747 | dict:to_list(D).
748 |
749 | -dialyzer({nowarn_function, format_time_/1}).
750 | %% ==================================================================
751 | %% Copied from lager_default_formatter.erl, lager_util.erl
752 |
753 | format_time(Now) ->
754 | {Date, Time} = format_time_(maybe_utc(localtime_ms(Now))),
755 | ["=== Start time: ", Date, " ", Time, " ===\n"].
756 |
757 | format_time_({utc, {{Y, M, D}, {H, Mi, S, Ms}}}) ->
758 | {[integer_to_list(Y), $-, i2l(M), $-, i2l(D)],
759 | [i2l(H), $:, i2l(Mi), $:, i2l(S), $., i3l(Ms), $ , $U, $T, $C]};
760 | format_time_({{Y, M, D}, {H, Mi, S, Ms}}) ->
761 | {[integer_to_list(Y), $-, i2l(M), $-, i2l(D)],
762 | [i2l(H), $:, i2l(Mi), $:, i2l(S), $., i3l(Ms)]};
763 | format_time_({utc, {{Y, M, D}, {H, Mi, S}}}) ->
764 | {[integer_to_list(Y), $-, i2l(M), $-, i2l(D)],
765 | [i2l(H), $:, i2l(Mi), $:, i2l(S), $ , $U, $T, $C]};
766 | format_time_({{Y, M, D}, {H, Mi, S}}) ->
767 | {[integer_to_list(Y), $-, i2l(M), $-, i2l(D)],
768 | [i2l(H), $:, i2l(Mi), $:, i2l(S)]}.
769 |
770 | i2l(I) when I < 10 -> [$0, $0+I];
771 | i2l(I) -> integer_to_list(I).
772 | i3l(I) when I < 100 -> [$0 | i2l(I)];
773 | i3l(I) -> integer_to_list(I).
774 |
775 | localtime_ms(Now) ->
776 | {_, _, Micro} = Now,
777 | {Date, {Hours, Minutes, Seconds}} = calendar:now_to_local_time(Now),
778 | {Date, {Hours, Minutes, Seconds, Micro div 1000 rem 1000}}.
779 |
780 | maybe_utc({Date, {H, M, S, Ms}}) ->
781 | case maybe_utc_({Date, {H, M, S}}) of
782 | {utc, {Date1, {H1, M1, S1}}} ->
783 | {utc, {Date1, {H1, M1, S1, Ms}}};
784 | {Date1, {H1, M1, S1}} ->
785 | {Date1, {H1, M1, S1, Ms}}
786 | end.
787 |
788 | maybe_utc_(Time) ->
789 | UTC = case application:get_env(sasl, utc_log) of
790 | {ok, Val} ->
791 | Val;
792 | undefined ->
793 | %% Backwards compatible:
794 | application:get_env(stdlib, utc_log, false)
795 | end,
796 | if
797 | UTC =:= true ->
798 | UTCTime = case calendar:local_time_to_universal_time_dst(Time) of
799 | [] -> calendar:local_time();
800 | [T0|_] -> T0
801 | end,
802 | {utc, UTCTime};
803 | true ->
804 | Time
805 | end.
806 |
807 | %% ==================================================================
808 |
--------------------------------------------------------------------------------