aboutsummaryrefslogtreecommitdiffstats
path: root/lib/runtime_tools/src/dbg.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/runtime_tools/src/dbg.erl')
-rw-r--r--lib/runtime_tools/src/dbg.erl1749
1 files changed, 1749 insertions, 0 deletions
diff --git a/lib/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl
new file mode 100644
index 0000000000..66ac0422eb
--- /dev/null
+++ b/lib/runtime_tools/src/dbg.erl
@@ -0,0 +1,1749 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(dbg).
+-export([p/1,p/2,c/3,c/4,i/0,start/0,stop/0,stop_clear/0,tracer/0,
+ tracer/2, tracer/3, get_tracer/0, get_tracer/1, tp/2, tp/3, tp/4,
+ ctp/0, ctp/1, ctp/2, ctp/3, tpl/2, tpl/3, tpl/4, ctpl/0, ctpl/1,
+ ctpl/2, ctpl/3, ctpg/0, ctpg/1, ctpg/2, ctpg/3, ltp/0, wtp/1, rtp/1,
+ dtp/0, dtp/1, n/1, cn/1, ln/0, h/0, h/1]).
+
+-export([trace_port/2, flush_trace_port/0, flush_trace_port/1,
+ trace_port_control/1, trace_port_control/2, trace_client/2,
+ trace_client/3, stop_trace_client/1]).
+
+-export([transform_flags/1,dhandler/2]).
+
+-export([fun2ms/1]).
+
+%% Local exports
+-export([erlang_trace/3,get_info/0]).
+
+%% Debug exports
+-export([wrap_presort/2, wrap_sort/2, wrap_postsort/1, wrap_sortfix/2,
+ match_front/2, match_rear/2,
+ match_0_9/1]).
+
+
+%%% Shell callable utility
+fun2ms(ShellFun) when is_function(ShellFun) ->
+ % Check that this is really a shell fun...
+ case erl_eval:fun_data(ShellFun) of
+ {fun_data,ImportList,Clauses} ->
+ case ms_transform:transform_from_shell(
+ ?MODULE,Clauses,ImportList) of
+ {error,[{_,[{_,_,Code}|_]}|_],_} ->
+ io:format("Error: ~s~n",
+ [ms_transform:format_error(Code)]),
+ {error,transform_error};
+ Else ->
+ Else
+ end;
+ false ->
+ exit({badarg,{?MODULE,fun2ms,
+ [function,called,with,real,'fun',
+ should,be,transformed,with,
+ parse_transform,'or',called,with,
+ a,'fun',generated,in,the,
+ shell]}})
+ end.
+
+
+%%% Client functions.
+
+%%
+%% n(Node) -> {ok, Node} | {error, Reason}
+%% Adds Node to the list of traced nodes.
+%%
+n(Node) when Node =:= node() ->
+ {error, cant_add_local_node};
+n(Node) ->
+ case (catch net_adm:ping(Node)) of
+ {'EXIT',_} ->
+ {error, {bad_node, Node}};
+ pang ->
+ {error, {nodedown, Node}};
+ pong ->
+ req({add_node, Node});
+ Other ->
+ {error, Other}
+ end.
+
+%%
+%% cn(Node) -> ok
+%% Remove Node from the list of traced nodes.
+%%
+cn(Node) ->
+ req({remove_node, Node}).
+
+%%
+%% ln() -> ok
+%% List traced nodes
+%%
+ln() ->
+ lists:foreach(fun(X) ->
+ io:format("~p~n",[X])
+ end,
+ req(get_nodes)),
+ ok.
+
+%%
+%% tp/tpl(Module, Pattern) | tp/tpl(Module,Function,Pattern) |
+%% tp/tpl(Module,Function,Arity,Pattern) | tp/tpl({M,F,A},Pattern)
+%% -> {ok, [{matched,Node,N}]} |
+%% {ok, [{matched,Node,N}, {saved,M}]} |
+%% {ok, [{saved,M}]} |
+%% {error, Reason}
+%% Set trace pattern for function or group of functions.
+%%
+tp(Module, Function, Pattern) ->
+ do_tp({Module, Function, '_'}, Pattern, []).
+tp(Module, Function, Arity, Pattern) ->
+ do_tp({Module, Function, Arity}, Pattern, []).
+tp(Module, Pattern) when is_atom(Module) ->
+ do_tp({Module, '_', '_'}, Pattern, []);
+tp({_Module, _Function, _Arity} = X, Pattern) ->
+ do_tp(X,Pattern,[]).
+tpl(Module, Function, Pattern) ->
+ do_tp({Module, Function, '_'}, Pattern, [local]).
+tpl(Module, Function, Arity, Pattern) ->
+ do_tp({Module, Function, Arity}, Pattern, [local]).
+tpl(Module, Pattern) when is_atom(Module) ->
+ do_tp({Module, '_', '_'}, Pattern, [local]);
+tpl({_Module, _Function, _Arity} = X, Pattern) ->
+ do_tp(X,Pattern,[local]).
+do_tp({_Module, _Function, _Arity} = X, Pattern, Flags)
+ when is_integer(Pattern);
+ is_atom(Pattern) ->
+ case ets:lookup(get_pattern_table(), Pattern) of
+ [{_,NPattern}] ->
+ do_tp(X, binary_to_term(NPattern), Flags);
+ _ ->
+ {error, unknown_pattern}
+ end;
+do_tp({Module, _Function, _Arity} = X, Pattern, Flags) when is_list(Pattern) ->
+ Nodes = req(get_nodes),
+ case Module of
+ '_' ->
+ ok;
+ M when is_atom(M) ->
+ %% Try to load M on all nodes
+ lists:foreach(fun(Node) ->
+ rpc:call(Node, M, module_info, [])
+ end,
+ Nodes)
+ end,
+ case lint_tp(Pattern) of
+ {ok,_} ->
+ SaveInfo = case save_pattern(Pattern) of
+ N when is_integer(N), N > 0; is_atom(N) ->
+ [{saved, N}];
+ _ ->
+ []
+ end,
+ {ok, do_tp_on_nodes(Nodes, X, Pattern, Flags) ++ SaveInfo};
+ Other ->
+ Other
+ end.
+
+%% All nodes are handled the same way - also the local node if it is traced
+do_tp_on_nodes(Nodes, MFA, P, Flags) ->
+ lists:map(fun(Node) ->
+ case rpc:call(Node,erlang,trace_pattern,[MFA,P, Flags]) of
+ N when is_integer(N) ->
+ {matched, Node, N};
+ Else ->
+ {matched, Node, 0, Else}
+ end
+ end,
+ Nodes).
+
+%%
+%% ctp/ctpl(Module) | ctp/ctpl(Module,Function) |
+%% ctp/ctpl(Module,Function,Arity) | ctp/ctpl({M,F,A}) ->
+%% {ok, [{matched, N}]} | {error, Reason}
+%% Clears trace pattern for function or group of functions.
+%%
+ctp() ->
+ do_ctp({'_','_','_'},[]).
+ctp(Module, Function) ->
+ do_ctp({Module, Function, '_'}, []).
+ctp(Module, Function, Arity) ->
+ do_ctp({Module, Function, Arity}, []).
+ctp(Module) when is_atom(Module) ->
+ do_ctp({Module, '_', '_'}, []);
+ctp({_Module, _Function, _Arity} = X) ->
+ do_ctp(X,[]).
+ctpl() ->
+ do_ctp({'_', '_', '_'}, [local]).
+ctpl(Module, Function) ->
+ do_ctp({Module, Function, '_'}, [local]).
+ctpl(Module, Function, Arity) ->
+ do_ctp({Module, Function, Arity}, [local]).
+ctpl(Module) when is_atom(Module) ->
+ do_ctp({Module, '_', '_'}, [local]);
+ctpl({_Module, _Function, _Arity} = X) ->
+ do_ctp(X,[local]).
+ctpg() ->
+ do_ctp({'_', '_', '_'}, [global]).
+ctpg(Module, Function) ->
+ do_ctp({Module, Function, '_'}, [global]).
+ctpg(Module, Function, Arity) ->
+ do_ctp({Module, Function, Arity}, [global]).
+ctpg(Module) when is_atom(Module) ->
+ do_ctp({Module, '_', '_'}, [global]);
+ctpg({_Module, _Function, _Arity} = X) ->
+ do_ctp(X,[global]).
+do_ctp({Module, Function, Arity},[]) ->
+ do_ctp({Module, Function, Arity},[global]),
+ do_ctp({Module, Function, Arity},[local]);
+do_ctp({_Module, _Function, _Arity}=MFA,Flags) ->
+ Nodes = req(get_nodes),
+ {ok,do_tp_on_nodes(Nodes,MFA,false,Flags)}.
+
+%%
+%% ltp() -> ok
+%% List saved and built-in trace patterns.
+%%
+ltp() ->
+ pt_doforall(fun({X, El},_Ignore) ->
+ io:format("~p: ~p~n", [X,El])
+ end,[]).
+
+%%
+%% dtp() | dtp(N) -> ok
+%% Delete saved pattern with number N or all saved patterns
+%%
+%% Do not delete built-in trace patterns.
+dtp() ->
+ pt_doforall(fun ({Key, _}, _) when is_integer(Key) ->
+ dtp(Key);
+ ({_, _}, _) ->
+ ok
+ end,
+ []).
+dtp(N) when is_integer(N) ->
+ ets:delete(get_pattern_table(), N),
+ ok;
+dtp(_) ->
+ ok.
+
+%%
+%% wtp(FileName) -> ok | {error, Reason}
+%% Writes all current saved trace patterns to a file.
+%%
+%% Actually write the built-in trace patterns too.
+wtp(FileName) ->
+ case file:open(FileName,[write]) of
+ {error, Reason} ->
+ {error, Reason};
+ {ok, File} ->
+ pt_doforall(fun ({_, Val}, _) when is_list(Val) ->
+ io:format(File, "~p.~n", [Val]);
+ ({_, _}, _) ->
+ ok
+ end,
+ []),
+ file:close(File),
+ ok
+ end.
+
+%%
+%% rtp(FileName) -> ok | {error, Reason}
+%% Reads in previously saved pattern file and merges the contents
+%% with what's there now.
+%%
+%% So the saved built-in trace patterns will merge with
+%% the already existing, which should be the same.
+rtp(FileName) ->
+ T = get_pattern_table(),
+ case file:consult(FileName) of
+ {error, Reason1} ->
+ {error, {read_error, Reason1}};
+ {ok, Data} ->
+ case check_list(Data) of
+ ok ->
+ lists:foreach(fun(X) ->
+ save_pattern(X,T)
+ end, Data),
+ ok;
+ {error, Reason2} ->
+ {error, {file_format_error, Reason2}}
+ end
+ end.
+
+tracer() ->
+ tracer(process, {fun dhandler/2,user}).
+
+tracer(port, Fun) when is_function(Fun) ->
+ start(Fun);
+
+tracer(port, Port) when is_port(Port) ->
+ start(fun() -> Port end);
+
+tracer(process, {Handler,HandlerData}) ->
+ start(fun() -> start_tracer_process(Handler, HandlerData) end).
+
+
+remote_tracer(port, Fun) when is_function(Fun) ->
+ remote_start(Fun);
+
+remote_tracer(port, Port) when is_port(Port) ->
+ remote_start(fun() -> Port end);
+
+remote_tracer(process, {Handler,HandlerData}) ->
+ remote_start(fun() -> start_tracer_process(Handler, HandlerData) end).
+
+remote_start(StartTracer) ->
+ case (catch StartTracer()) of
+ {'EXIT', Reason} ->
+ {error, Reason};
+ Tracer ->
+ {ok,Tracer}
+ end.
+
+%%
+%% tracer(Node,Type,Data) -> {ok, Node} | {error, Reason}
+%% Add Node to the list of traced nodes and a trace port defined by
+%% Type and Data is started on Node.
+%%
+tracer(Node,Type,Data) when Node =:= node() ->
+ case tracer(Type,Data) of
+ {ok,_Dbg} -> {ok,Node};
+ Error -> Error
+ end;
+tracer(Node,Type,Data) ->
+ case (catch net_adm:ping(Node)) of
+ {'EXIT',_} ->
+ {error, {bad_node, Node}};
+ pang ->
+ {error, {nodedown, Node}};
+ pong ->
+ req({add_node, Node, Type, Data});
+ Other ->
+ {error, Other}
+ end.
+
+flush_trace_port() ->
+ trace_port_control(flush).
+flush_trace_port(Node) ->
+ trace_port_control(Node, flush).
+
+trace_port_control(Operation) ->
+ trace_port_control(node(), Operation).
+
+trace_port_control(Node, flush) ->
+ Ref = erlang:trace_delivered(all),
+ receive
+ {trace_delivered,all,Ref} -> ok
+ end,
+ case trace_port_control(Node, $f, "") of
+ {ok, [0]} ->
+ ok;
+ {ok, _} ->
+ {error, not_supported_by_trace_driver};
+ Other ->
+ Other
+ end;
+trace_port_control(Node,get_listen_port) ->
+ case trace_port_control(Node,$p, "") of
+ {ok, <<0, IpPort:16>>} ->
+ {ok, IpPort};
+ {ok, _Other} ->
+ {error, not_supported_by_trace_driver};
+ Other ->
+ Other
+ end.
+
+trace_port_control(Node, Command, Arg) ->
+ case get_tracer(Node) of
+ {ok, Port} when is_port(Port) ->
+ {ok, catch rpc:call(Node,erlang,port_control,[Port, Command, Arg])};
+ _ ->
+ {error, no_trace_driver}
+ end.
+
+
+
+
+trace_port(file, {Filename, wrap, Tail}) ->
+ trace_port(file, {Filename, wrap, Tail, 128*1024});
+trace_port(file, {Filename, wrap, Tail, WrapSize}) ->
+ trace_port(file, {Filename, wrap, Tail, WrapSize, 8});
+trace_port(file, {Filename, wrap, Tail, WrapSize, WrapCnt})
+ when is_list(Tail),
+ is_integer(WrapSize), WrapSize >= 0, WrapSize < (1 bsl 32),
+ is_integer(WrapCnt), WrapCnt >= 1, WrapCnt < (1 bsl 32) ->
+ trace_port1(file, Filename, {wrap, Tail, WrapSize, WrapCnt, 0});
+trace_port(file, {Filename, wrap, Tail, {time, WrapTime}, WrapCnt})
+ when is_list(Tail),
+ is_integer(WrapTime), WrapTime >= 1, WrapTime < (1 bsl 32),
+ is_integer(WrapCnt), WrapCnt >= 1, WrapCnt < (1 bsl 32) ->
+ trace_port1(file, Filename, {wrap, Tail, 0, WrapCnt, WrapTime});
+trace_port(file, Filename) ->
+ trace_port1(file, Filename, nowrap);
+
+trace_port(ip, Portno) when is_integer(Portno) ->
+ trace_port(ip,{Portno,50});
+
+trace_port(ip, {Portno, Qsiz}) when is_integer(Portno), is_integer(Qsiz) ->
+ fun() ->
+ Driver = "trace_ip_drv",
+ Dir1 = filename:join(code:priv_dir(runtime_tools), "lib"),
+ case catch erl_ddll:load_driver(Dir1, Driver) of
+ ok ->
+ ok;
+ _ ->
+ Dir2 = filename:join(
+ Dir1,
+ erlang:system_info(system_architecture)),
+ catch erl_ddll:load_driver(Dir2, Driver)
+ end,
+ L = lists:flatten(
+ io_lib:format("~s ~p ~p 2",
+ [Driver, Portno, Qsiz])),
+ open_port({spawn, L}, [eof])
+ end.
+
+trace_port1(file, Filename, Options) ->
+ Driver = "trace_file_drv",
+ fun() ->
+ Name = filename:absname(Filename),
+ %% Absname is needed since the driver uses
+ %% the supplied name without further investigations,
+ %% and if the name is relative the resulting path
+ %% might be too long which can cause a bus error
+ %% on vxworks instead of a nice error code return.
+ %% Also, the absname must be found inside the fun,
+ %% in case the actual node where the port shall be
+ %% started is on another node (or even another host)
+ {Wrap, Tail} =
+ case Options of
+ {wrap, T, WrapSize, WrapCnt, WrapTime} ->
+ {lists:flatten(
+ io_lib:format("w ~p ~p ~p ~p ",
+ [WrapSize, WrapCnt, WrapTime,
+ length(Name)])),
+ T};
+ nowrap ->
+ {"", ""}
+ end,
+ Command = Driver ++ " " ++ Wrap ++ "n " ++ Name ++ Tail,
+ Dir1 = filename:join(code:priv_dir(runtime_tools), "lib"),
+ case catch erl_ddll:load_driver(Dir1, Driver) of
+ ok ->
+ ok;
+ _ ->
+ Dir2 = filename:join(
+ Dir1,
+ erlang:system_info(system_architecture)),
+ catch erl_ddll:load_driver(Dir2, Driver)
+ end,
+ if element(1, Options) == wrap ->
+ %% Delete all files from any previous wrap log
+ Files = wrap_postsort(wrap_presort(Name, Tail)),
+ lists:foreach(
+ fun(N) -> file:delete(N) end,
+ Files);
+ true -> ok
+ end,
+ open_port({spawn, Command}, [eof])
+ end.
+
+
+trace_client(file, Filename) ->
+ trace_client(file, Filename, {fun dhandler/2,user});
+trace_client(follow_file, Filename) ->
+ trace_client(follow_file, Filename, {fun dhandler/2,user});
+trace_client(ip, Portno) when is_integer(Portno) ->
+ trace_client1(ip, {"localhost", Portno}, {fun dhandler/2,user});
+trace_client(ip, {Host, Portno}) when is_integer(Portno) ->
+ trace_client1(ip, {Host, Portno}, {fun dhandler/2,user}).
+
+trace_client(file, {Filename, wrap, Tail}, FD) ->
+ trace_client(file, {Filename, wrap, Tail, 128*1024}, FD);
+trace_client(file, {Filename, wrap, Tail, WrapSize}, FD) ->
+ trace_client(file, {Filename, wrap, Tail, WrapSize, 8}, FD);
+trace_client(file,
+ {_Filename, wrap, Tail, _WrapSize, WrapCnt} = WrapSpec,
+ {Fun, _Data} = FD)
+ when is_list(Tail), is_function(Fun), is_integer(WrapCnt), WrapCnt >= 1 ->
+ trace_client1(file, WrapSpec, FD);
+trace_client(file, Filename, {Fun, Data} ) when is_function(Fun) ->
+ trace_client1(file, Filename, {Fun, Data});
+trace_client(follow_file, Filename, {Fun, Data} ) when is_function(Fun) ->
+ trace_client1(follow_file, Filename, {Fun, Data});
+trace_client(ip, Portno, {Fun, Data}) when is_integer(Portno), is_function(Fun) ->
+ trace_client1(ip, {"localhost", Portno}, {Fun, Data});
+trace_client(ip, {Host, Portno}, {Fun, Data}) when is_integer(Portno),
+ is_function(Fun) ->
+ trace_client1(ip, {Host, Portno}, {Fun, Data}).
+
+trace_client1(Type, OpenData, {Handler,HData}) ->
+ case req({link_to,
+ spawn(
+ fun() ->
+ tc_loop(gen_reader(Type, OpenData), Handler, HData)
+ end)}) of
+ {ok, Pid} ->
+ Pid;
+ Other ->
+ Other
+ end.
+
+stop_trace_client(Pid) when is_pid(Pid) ->
+ process_flag(trap_exit,true),
+ link(Pid),
+ exit(to_pidspec(Pid),abnormal),
+ Res = receive
+ {'EXIT', Pid, _} ->
+ ok
+ after 5000 ->
+ {error, timeout}
+ end,
+ process_flag(trap_exit,false),
+ Res.
+
+p(Pid) ->
+ p(Pid, [m]).
+
+p(Pid, Flags) when is_atom(Flags) ->
+ p(Pid, [Flags]);
+p(Pid, Flags) ->
+ req({p,Pid,Flags}).
+
+i() -> req(i).
+
+c(M, F, A) ->
+ c(M, F, A, all).
+c(M, F, A, Flags) when is_atom(Flags) ->
+ c(M, F, A, [Flags]);
+c(M, F, A, Flags) ->
+ case transform_flags(Flags) of
+ {error,Reason} -> {error,Reason};
+ Flags1 ->
+ tracer(),
+ {ok, Tracer} = get_tracer(),
+ S = self(),
+ Pid = spawn(fun() -> c(S, M, F, A, [{tracer, Tracer} | Flags1]) end),
+ Mref = erlang:monitor(process, Pid),
+ receive
+ {'DOWN', Mref, _, _, Reason} ->
+ stop_clear(),
+ {error, Reason};
+ {Pid, Res} ->
+ erlang:demonitor(Mref),
+ receive {'DOWN', Mref, _, _, _} -> ok after 0 -> ok end,
+ %% 'sleep' prevents the tracer (recv_all_traces) from
+ %% receiving garbage {'EXIT',...} when dbg i stopped.
+ timer:sleep(1),
+ stop_clear(),
+ Res
+ end
+ end.
+
+c(Parent, M, F, A, Flags) ->
+ %% The trace BIF is used directly here instead of the existing function
+ %% p/2. The reason is that p/2 (when stopping trace) sends messages which
+ %% we don't want to show up in this simple tracing from the shell.
+ erlang:trace(self(), true, Flags),
+ Res = apply(M, F, A),
+ erlang:trace(self(), false, [all]),
+ Parent ! {self(), Res}.
+
+stop() ->
+ Mref = erlang:monitor(process, dbg),
+ catch dbg ! {self(),stop},
+ receive
+ {'DOWN',Mref,_,_,_} ->
+ ok
+ end.
+
+stop_clear() ->
+ ctp(),
+ stop().
+
+%%% Calling the server.
+
+req(R) ->
+ P = ensure(), % The pid or perhaps the name of the server
+ Mref = erlang:monitor(process, P),
+ catch P ! {self(), R}, % May crash if P = atom() and server died
+ receive
+ {'DOWN', Mref, _, _, _} -> % If server died
+ exit(dbg_server_crash);
+ {dbg, Reply} ->
+ erlang:demonitor(Mref),
+ receive {'DOWN', Mref, _, _, _} -> ok after 0 -> ok end,
+ Reply
+ end.
+
+%% Returns the pid of the dbg server, or in worst case the name.
+%% Starts a new server if necessary.
+ensure() ->
+ case whereis(dbg) of
+ undefined ->
+ case start() of
+ {ok, P} ->
+ P;
+ {error, already_started} ->
+ dbg
+ end;
+ Pid ->
+ Pid
+ end.
+
+
+%%% Server implementation.
+start() ->
+ start(no_tracer).
+
+start(TracerFun) ->
+ S = self(),
+ case whereis(dbg) of
+ undefined ->
+ Dbg = spawn(fun() -> init(S) end),
+ receive {Dbg,started} -> ok end,
+ case TracerFun of
+ no_tracer ->
+ {ok, Dbg};
+ Fun when is_function(Fun) ->
+ req({tracer,TracerFun})
+ end;
+ Pid when is_pid(Pid), is_function(TracerFun) ->
+ req({tracer,TracerFun})
+ end.
+
+init(Parent) ->
+ process_flag(trap_exit, true),
+ register(dbg, self()),
+ Parent ! {self(),started},
+ loop({[],[]},[]).
+
+%
+% SurviveLinks = Processes we should take with us while falling,
+% but not get killed by if they die (i. e. trace clients
+% and relay processes on other nodes)
+% SurviveLinks = {TraceClients,Relays}
+%
+loop({C,T}=SurviveLinks, Table) ->
+ receive
+ {From,i} ->
+ reply(From, display_info(lists:map(fun({N,_}) -> N end,get()))),
+ loop(SurviveLinks, Table);
+ {From,{p,Pid,Flags}} ->
+ reply(From, trace_process(Pid, Flags)),
+ loop(SurviveLinks, Table);
+ {From,{tracer,TracerFun}} when is_function(TracerFun) ->
+ case get(node()) of
+ undefined ->
+ case (catch TracerFun()) of
+ {'EXIT', Reason} ->
+ reply(From, {error, Reason});
+ Tracer when is_pid(Tracer); is_port(Tracer) ->
+ put(node(),{self(),Tracer}),
+ reply(From, {ok,self()})
+ end;
+ {_Relay,_Tracer} ->
+ reply(From, {error, already_started})
+ end,
+ loop(SurviveLinks,Table);
+ {From,{get_tracer,Node}} ->
+ case get(Node) of
+ undefined -> reply(From,{error, {no_tracer_on_node,Node}});
+ {_Relay,Tracer} -> reply(From, {ok,Tracer})
+ end,
+ loop(SurviveLinks, Table);
+ {From, get_table} ->
+ Tab = case Table of
+ [] ->
+ new_pattern_table();
+ _exists ->
+ Table
+ end,
+ reply(From, {ok, Tab}),
+ loop(SurviveLinks, Tab);
+ {_From,stop} ->
+ %% We want to make sure that all trace messages have been delivered
+ %% on all nodes that might be traced. Since dbg:cn/1 does not turn off
+ %% tracing on the node it removes from the list of active trace nodes,
+ %% we will call erlang:trace_delivered/1 on ALL nodes that we have
+ %% connections to.
+ Delivered = fun() ->
+ Ref = erlang:trace_delivered(all),
+ receive
+ {trace_delivered,all,Ref} -> ok
+ end
+ end,
+ catch rpc:multicall(nodes(), erlang, apply, [Delivered,[]]),
+ Ref = erlang:trace_delivered(all),
+ receive
+ {trace_delivered,all,Ref} ->
+ exit(done)
+ end;
+ {From, {link_to, Pid}} ->
+ case (catch link(Pid)) of
+ {'EXIT', Reason} ->
+ reply(From, {error, Reason}),
+ loop(SurviveLinks, Table);
+ _ ->
+ reply(From, {ok, Pid}),
+ loop({[Pid|C],T}, Table)
+ end;
+ {From, {add_node, Node}} ->
+ case get(node()) of
+ undefined ->
+ reply(From, {error, no_local_tracer}),
+ loop(SurviveLinks, Table);
+ {_LocalRelay,Tracer} when is_port(Tracer) ->
+ reply(From, {error, cant_trace_remote_pid_to_local_port}),
+ loop(SurviveLinks, Table);
+ {_LocalRelay,Tracer} when is_pid(Tracer) ->
+ case (catch relay(Node, Tracer)) of
+ {ok,Relay} ->
+ reply(From, {ok, Node}),
+ loop({C,[Relay|T]}, Table);
+ {'EXIT', Something} ->
+ reply(From, {error, Something}),
+ loop(SurviveLinks, Table);
+ Error ->
+ reply(From, Error),
+ loop(SurviveLinks, Table)
+ end
+ end;
+ {From, {add_node, Node, Type, Data}} ->
+ case (catch relay(Node, {Type,Data})) of
+ {ok,Relay} ->
+ reply(From, {ok, Node}),
+ loop({C,[Relay|T]}, Table);
+ {'EXIT', Something} ->
+ reply(From, {error, Something}),
+ loop(SurviveLinks, Table);
+ Error ->
+ reply(From, Error),
+ loop(SurviveLinks, Table)
+ end;
+ {From, {remove_node, Node}} ->
+ erase(Node),
+ reply(From, ok),
+ loop(SurviveLinks, Table);
+ {From, get_nodes} ->
+ reply(From, lists:map(fun({N,_}) -> N end, get())),
+ loop(SurviveLinks, Table);
+ {'EXIT', Pid, Reason} ->
+ case lists:delete(Pid, C) of
+ C ->
+ case lists:delete(Pid,T) of
+ T ->
+ io:format(user,"** dbg got EXIT - terminating: ~p~n",
+ [Reason]),
+ exit(done);
+ NewT ->
+ erase(node(Pid)),
+ loop({C,NewT}, Table)
+ end;
+ NewC ->
+ loop({NewC,T}, Table)
+ end;
+ Other ->
+ io:format(user,"** dbg got garbage: ~p~n",
+ [{Other,SurviveLinks,Table}]),
+ loop(SurviveLinks, Table)
+ end.
+
+reply(Pid, Reply) ->
+ Pid ! {dbg,Reply}.
+
+
+%%% A process-based tracer.
+
+start_tracer_process(Handler, HandlerData) ->
+ spawn_opt(fun() -> tracer_init(Handler, HandlerData) end,
+ [link,{priority,max}]).
+
+
+tracer_init(Handler, HandlerData) ->
+ process_flag(trap_exit, true),
+ tracer_loop(Handler, HandlerData).
+
+tracer_loop(Handler, Hdata) ->
+ receive
+ Msg ->
+ %% Don't match in receive to avoid giving EXIT message higher
+ %% priority than the trace messages.
+ case Msg of
+ {'EXIT',_Pid,_Reason} ->
+ ok;
+ Trace ->
+ NewData = recv_all_traces(Trace, Handler, Hdata),
+ tracer_loop(Handler, NewData)
+ end
+ end.
+
+recv_all_traces(Trace, Handler, Hdata) ->
+ Suspended = suspend(Trace, []),
+ recv_all_traces(Suspended, Handler, Hdata, [Trace]).
+
+recv_all_traces(Suspended0, Handler, Hdata, Traces) ->
+ receive
+ Trace when is_tuple(Trace), element(1, Trace) == trace ->
+ Suspended = suspend(Trace, Suspended0),
+ recv_all_traces(Suspended, Handler, Hdata, [Trace|Traces]);
+ Trace when is_tuple(Trace), element(1, Trace) == trace_ts ->
+ Suspended = suspend(Trace, Suspended0),
+ recv_all_traces(Suspended, Handler, Hdata, [Trace|Traces]);
+ Trace when is_tuple(Trace), element(1, Trace) == seq_trace ->
+ Suspended = suspend(Trace, Suspended0),
+ recv_all_traces(Suspended, Handler, Hdata, [Trace|Traces]);
+ Trace when is_tuple(Trace), element(1, Trace) == drop ->
+ Suspended = suspend(Trace, Suspended0),
+ recv_all_traces(Suspended, Handler, Hdata, [Trace|Traces]);
+ Other ->
+ %%% Is this really a good idea?
+ io:format(user,"** tracer received garbage: ~p~n", [Other]),
+ recv_all_traces(Suspended0, Handler, Hdata, Traces)
+ after 0 ->
+ case catch invoke_handler(Traces, Handler, Hdata) of
+ {'EXIT',Reason} ->
+ resume(Suspended0),
+ exit({trace_handler_crashed,Reason});
+ NewHdata ->
+ resume(Suspended0),
+ NewHdata
+ end
+ end.
+
+invoke_handler([Tr|Traces], Handler, Hdata0) ->
+ Hdata = invoke_handler(Traces, Handler, Hdata0),
+ Handler(Tr, Hdata);
+invoke_handler([], _Handler, Hdata) ->
+ Hdata.
+
+suspend({trace,From,call,_Func}, Suspended) when node(From) == node() ->
+ case (catch erlang:suspend_process(From, [unless_suspending,
+ asynchronous])) of
+ true ->
+ [From | Suspended];
+ _ ->
+ Suspended
+ end;
+suspend(_Other, Suspended) -> Suspended.
+
+resume([Pid|Pids]) when node(Pid) == node() ->
+ (catch erlang:resume_process(Pid)),
+ resume(Pids);
+resume([]) -> ok.
+
+
+
+%%% Utilities.
+
+trac(Proc, How, Flags) when is_atom(Proc) ->
+ %% Proc = all | new | existing | RegisteredName
+ %% Must go to all nodes
+ case get() of
+ [] ->
+ {error,no_tracers};
+ Nodes ->
+ Matched = [trac(Node, NodeInfo, Proc, How, Flags)
+ || {Node, NodeInfo} <- Nodes],
+ {ok,Matched}
+ end;
+trac(Proc, How, Flags) ->
+ %% Proc = Pid | Integer | {X,Y,Z} | "<X.Y.Z>"
+ %% One node only
+ Pid = to_pid(Proc),
+ case Pid of
+ {badpid,_} ->
+ {error,Pid};
+ _ ->
+ Node = if is_pid(Pid) -> node(Pid); true -> node() end,
+ case get(Node) of
+ undefined ->
+ {error,{no_tracer_on_node,Node}};
+ NodeInfo ->
+ Match = trac(Node, NodeInfo, Pid, How, Flags),
+ {ok,[Match]}
+ end
+ end.
+
+trac(Node, {_Relay, Tracer}, AtomPid, How, Flags) ->
+ case rpc:call(Node, ?MODULE, erlang_trace,
+ [AtomPid, How, [{tracer, Tracer} | Flags]]) of
+ N when is_integer(N) ->
+ {matched, Node, N};
+ {badrpc,Reason} ->
+ {matched, Node, 0, Reason};
+ Else ->
+ {matched, Node, 0, Else}
+ end.
+
+erlang_trace(AtomPid, How, Flags) ->
+ case to_pidspec(AtomPid) of
+ {badpid,_} ->
+ {no_proc,AtomPid};
+ P ->
+ erlang:trace(P, How, Flags)
+ end.
+
+%% Since we are not allowed to do erlang:trace/3 on a remote
+%% process, we create a relay process at the remote node.
+
+relay(Node,To) when Node /= node() ->
+ case get(Node) of
+ undefined ->
+ S = self(),
+ Pid = spawn_link(Node, fun() -> do_relay(S,To) end),
+ receive {started,Remote} -> put(Node, {Pid,Remote}) end,
+ {ok,Pid};
+ {_Relay,PortOrPid} ->
+ {error, {already_started, PortOrPid}}
+ end.
+
+do_relay(Parent,RelP) ->
+ process_flag(trap_exit, true),
+ case RelP of
+ {Type,Data} ->
+ {ok,Tracer} = remote_tracer(Type,Data),
+ Parent ! {started,Tracer};
+ Pid when is_pid(Pid) ->
+ Parent ! {started,self()}
+ end,
+ do_relay_1(RelP).
+
+do_relay_1(RelP) ->
+ %% In the case of a port tracer, this process exists only so that
+ %% dbg know that the node is alive... should maybe use monitor instead?
+ receive
+ {'EXIT', _P, _} ->
+ exit(normal);
+ TraceInfo when is_pid(RelP) -> % Here is the normal case for trace i/o
+ RelP ! TraceInfo,
+ do_relay_1(RelP);
+ Other ->
+ io:format(user,"** relay got garbage: ~p~n", [Other]),
+ do_relay_1(RelP)
+ end.
+
+dhandler(end_of_trace, Out) ->
+ Out;
+dhandler(Trace, Out) when element(1, Trace) == trace, tuple_size(Trace) >= 3 ->
+ dhandler1(Trace, tuple_size(Trace), Out);
+dhandler(Trace, Out) when element(1, Trace) == trace_ts, tuple_size(Trace) >= 4 ->
+ dhandler1(Trace, tuple_size(Trace)-1, Out);
+dhandler(Trace, Out) when element(1, Trace) == drop, tuple_size(Trace) =:= 2 ->
+ io:format(Out, "*** Dropped ~p messages.~n", [element(2,Trace)]),
+ Out;
+dhandler(Trace, Out) when element(1, Trace) == seq_trace, tuple_size(Trace) >= 3 ->
+ SeqTraceInfo = case Trace of
+ {seq_trace, Lbl, STI, TS} ->
+ io:format(Out, "SeqTrace ~p [~p]: ",
+ [TS, Lbl]),
+ STI;
+ {seq_trace, Lbl, STI} ->
+ io:format(Out, "SeqTrace [~p]: ",
+ [Lbl]),
+ STI
+ end,
+ case SeqTraceInfo of
+ {send, Ser, Fr, To, Mes} ->
+ io:format(Out, "(~p) ~p ! ~p [Serial: ~p]~n",
+ [Fr, To, Mes, Ser]);
+ {'receive', Ser, Fr, To, Mes} ->
+ io:format(Out, "(~p) << ~p [Serial: ~p, From: ~p]~n",
+ [To, Mes, Ser, Fr]);
+ {print, Ser, Fr, _, Info} ->
+ io:format(Out, "-> ~p [Serial: ~p, From: ~p]~n",
+ [Info, Ser, Fr]);
+ Else ->
+ io:format(Out, "~p~n", [Else])
+ end,
+ Out;
+dhandler(_Trace, Out) ->
+ Out.
+
+dhandler1(Trace, Size, Out) ->
+%%%! Self = self(),
+ From = element(2, Trace),
+ case element(3, Trace) of
+ 'receive' ->
+ case element(4, Trace) of
+ {dbg,ok} -> ok;
+ Message -> io:format(Out, "(~p) << ~p~n", [From,Message])
+ end;
+ 'send' ->
+ Message = element(4, Trace),
+ case element(5, Trace) of
+%%%! This causes messages to disappear when used by ttb (observer). Tests
+%%%! so far show that there is no difference in results with dbg even if I
+%%%! comment it out, so I hope this is only some old code which isn't
+%%%! needed anymore... /siri
+%%%! Self -> ok;
+ To -> io:format(Out, "(~p) ~p ! ~p~n", [From,To,Message])
+ end;
+ call ->
+ case element(4, Trace) of
+ MFA when Size == 5 ->
+ Message = element(5, Trace),
+ io:format(Out, "(~p) call ~s (~p)~n", [From,ffunc(MFA),Message]);
+ MFA ->
+ io:format(Out, "(~p) call ~s~n", [From,ffunc(MFA)])
+ end;
+ return -> %% To be deleted...
+ case element(4, Trace) of
+ MFA when Size == 5 ->
+ Ret = element(5, Trace),
+ io:format(Out, "(~p) old_ret ~s -> ~p~n", [From,ffunc(MFA),Ret]);
+ MFA ->
+ io:format(Out, "(~p) old_ret ~s~n", [From,ffunc(MFA)])
+ end;
+ return_from ->
+ MFA = element(4, Trace),
+ Ret = element(5, Trace),
+ io:format(Out, "(~p) returned from ~s -> ~p~n", [From,ffunc(MFA),Ret]);
+ return_to ->
+ MFA = element(4, Trace),
+ io:format(Out, "(~p) returning to ~s~n", [From,ffunc(MFA)]);
+ spawn when Size == 5 ->
+ Pid = element(4, Trace),
+ MFA = element(5, Trace),
+ io:format(Out, "(~p) spawn ~p as ~s~n", [From,Pid,ffunc(MFA)]);
+ Op ->
+ io:format(Out, "(~p) ~p ~s~n", [From,Op,ftup(Trace,4,Size)])
+ end,
+ Out.
+
+
+
+%%% These f* functions returns non-flat strings
+
+%% {M,F,[A1, A2, ..., AN]} -> "M:F(A1, A2, ..., AN)"
+%% {M,F,A} -> "M:F/A"
+ffunc({M,F,Argl}) when is_list(Argl) ->
+ io_lib:format("~p:~p(~s)", [M, F, fargs(Argl)]);
+ffunc({M,F,Arity}) ->
+ io_lib:format("~p:~p/~p", [M,F,Arity]);
+ffunc(X) -> io_lib:format("~p", [X]).
+
+%% Integer -> "Integer"
+%% [A1, A2, ..., AN] -> "A1, A2, ..., AN"
+fargs(Arity) when is_integer(Arity) -> integer_to_list(Arity);
+fargs([]) -> [];
+fargs([A]) -> io_lib:format("~p", [A]); %% last arg
+fargs([A|Args]) -> [io_lib:format("~p,", [A]) | fargs(Args)];
+fargs(A) -> io_lib:format("~p", [A]). % last or only arg
+
+%% {A_1, A_2, ..., A_N} -> "A_Index A_Index+1 ... A_Size"
+ftup(Trace, Index, Index) ->
+ io_lib:format("~p", [element(Index, Trace)]);
+ftup(Trace, Index, Size) ->
+ [io_lib:format("~p ", [element(Index, Trace)])
+ | ftup(Trace, Index+1, Size)].
+
+
+
+trace_process(Pid, [clear]) ->
+ trac(Pid, false, all());
+trace_process(Pid, Flags0) ->
+ case transform_flags(Flags0) of
+ {error,Reason} -> {error,Reason};
+ Flags -> trac(Pid, true, Flags)
+ end.
+
+transform_flags(Flags0) ->
+ transform_flags(Flags0,[]).
+transform_flags([],Acc) -> Acc;
+transform_flags([m|Tail],Acc) -> transform_flags(Tail,[send,'receive'|Acc]);
+transform_flags([s|Tail],Acc) -> transform_flags(Tail,[send|Acc]);
+transform_flags([r|Tail],Acc) -> transform_flags(Tail,['receive'|Acc]);
+transform_flags([c|Tail],Acc) -> transform_flags(Tail,[call|Acc]);
+transform_flags([call|Tail],Acc) -> transform_flags(Tail,[call|Acc]);
+transform_flags([p|Tail],Acc) -> transform_flags(Tail,[procs|Acc]);
+transform_flags([sos|Tail],Acc) -> transform_flags(Tail,[set_on_spawn|Acc]);
+transform_flags([sol|Tail],Acc) -> transform_flags(Tail,[set_on_link|Acc]);
+transform_flags([sofs|Tail],Acc) -> transform_flags(Tail,[set_on_first_spawn|Acc]);
+transform_flags([sofl|Tail],Acc) -> transform_flags(Tail,[set_on_first_link|Acc]);
+transform_flags([all|_],_Acc) -> all();
+transform_flags([F|Tail]=List,Acc) when is_atom(F) ->
+ case lists:member(F, all()) of
+ true -> transform_flags(Tail,[F|Acc]);
+ false -> {error,{bad_flags,List}}
+ end;
+transform_flags(Bad,_Acc) -> {error,{bad_flags,Bad}}.
+
+all() ->
+ [send,'receive',call,procs,garbage_collection,running,
+ set_on_spawn,set_on_first_spawn,set_on_link,set_on_first_link,
+ timestamp,arity,return_to].
+
+display_info([Node|Nodes]) ->
+ io:format("~nNode ~w:~n",[Node]),
+ io:format("~-12s ~-21s Trace ~n", ["Pid", "Initial call"]),
+ List = rpc:call(Node,?MODULE,get_info,[]),
+ display_info1(List),
+ display_info(Nodes);
+display_info([]) ->
+ ok.
+
+display_info1([{Pid,Call,Flags}|T]) ->
+ io:format("~-12s ~-21s ~s~n",
+ [io_lib:format("~w",[Pid]),
+ io_lib:format("~p", [Call]),
+ format_trace(Flags)]),
+ display_info1(T);
+display_info1([]) ->
+ ok.
+
+get_info() ->
+ get_info(processes(),[]).
+
+get_info([Pid|T],Acc) ->
+ case pinfo(Pid, initial_call) of
+ undefined ->
+ get_info(T,Acc);
+ {initial_call, Call} ->
+ case tinfo(Pid, flags) of
+ undefined ->
+ get_info(T,Acc);
+ {flags,[]} ->
+ get_info(T,Acc);
+ {flags,Flags} ->
+ get_info(T,[{Pid,Call,Flags}|Acc])
+ end
+ end;
+get_info([],Acc) -> Acc.
+
+format_trace([]) -> [];
+format_trace([Item]) -> [ts(Item)];
+format_trace([Item|T]) -> [ts(Item) ," | ", format_trace(T)].
+
+ts(send) -> "s";
+ts('receive') -> "r";
+ts(call) -> "c";
+ts(procs) -> "p";
+ts(set_on_spawn) -> "sos";
+ts(set_on_first_spawn) -> "sofs";
+ts(set_on_link) -> "sol";
+ts(set_on_first_link) -> "sofl";
+ts(Other) -> atom_to_list(Other).
+
+%%
+%% Turn (pid or) atom into a PidSpec for erlang:trace,
+%% return {badpid,X} on failure
+%%
+
+to_pidspec(X) when is_pid(X) ->
+ case erlang:is_process_alive(X) of
+ true -> X;
+ false -> {badpid,X}
+ end;
+to_pidspec(new) -> new;
+to_pidspec(all) -> all;
+to_pidspec(existing) -> existing;
+to_pidspec(X) when is_atom(X) ->
+ case whereis(X) of
+ undefined -> {badpid,X};
+ Pid -> Pid
+ end;
+to_pidspec(X) -> {badpid,X}.
+
+%%
+%% Turn (pid or) integer or tuple or list into pid
+%%
+
+to_pid(X) when is_pid(X) -> X;
+to_pid(X) when is_integer(X) -> to_pid({0,X,0});
+to_pid({X,Y,Z}) ->
+ to_pid(lists:concat(["<",integer_to_list(X),".",
+ integer_to_list(Y),".",
+ integer_to_list(Z),">"]));
+to_pid(X) when is_list(X) ->
+ try list_to_pid(X) of
+ Pid -> Pid
+ catch
+ error:badarg -> {badpid,X}
+ end;
+to_pid(X) -> {badpid,X}.
+
+
+pinfo(P, X) when node(P) == node() -> erlang:process_info(P, X);
+pinfo(P, X) -> check(rpc:call(node(P), erlang, process_info, [P, X])).
+
+tinfo(P, X) when node(P) == node() -> erlang:trace_info(P, X);
+tinfo(P, X) -> check(rpc:call(node(P), erlang, trace_info, [P, X])).
+
+check({badrpc, _}) -> undefined;
+check(X) -> X.
+
+%% Process loop that processes a trace. Reads the trace with
+%% the reader Reader, and feeds the trace terms
+%% to handler Handler, keeping a state variable for the
+%% handler.
+%%
+%% Exits 'normal' at end of trace, other exits due to errors.
+%%
+%% Reader is a lazy list, i.e either a list or a fun/0.
+%% If it is a fun, it is evaluated for rest of the lazy list.
+%% A list head is considered to be a trace term. End of list
+%% is interpreted as end of trace.
+
+tc_loop([Term|Tail], Handler, HData0) ->
+ HData = Handler(Term, HData0),
+ tc_loop(Tail, Handler, HData);
+tc_loop([], Handler, HData) ->
+ Handler(end_of_trace, HData),
+ exit(normal);
+tc_loop(Reader, Handler, HData) when is_function(Reader) ->
+ tc_loop(Reader(), Handler, HData);
+tc_loop(Other, _Handler, _HData) ->
+ io:format("~p:tc_loop ~p~n", [?MODULE, Other]),
+ exit({unknown_term_from_reader, Other}).
+
+
+
+%% Returns a reader (lazy list of trace terms) for tc_loop/2.
+gen_reader(ip, {Host, Portno}) ->
+ case gen_tcp:connect(Host, Portno, [{active, false}, binary]) of
+ {ok, Sock} ->
+ mk_reader(fun ip_read/2, Sock);
+ Error ->
+ exit(Error)
+ end;
+gen_reader(file, {Filename, wrap, Tail, _, WrapCnt}) ->
+ mk_reader_wrap(wrap_sort(wrap_presort(Filename, Tail), WrapCnt));
+gen_reader(file, Filename) ->
+ gen_reader_file(fun file_read/2, Filename);
+gen_reader(follow_file, Filename) ->
+ gen_reader_file(fun follow_read/2, Filename).
+
+%% Opens a file and returns a reader (lazy list).
+gen_reader_file(ReadFun, Filename) ->
+ case file:open(Filename, [read, raw, binary]) of
+ {ok, File} ->
+ mk_reader(ReadFun, File);
+ Error ->
+ exit({client_cannot_open, Error})
+ end.
+
+%% Creates and returns a reader (lazy list).
+mk_reader(ReadFun, Source) ->
+ fun() ->
+ case read_term(ReadFun, Source) of
+ {ok, Term} ->
+ [Term | mk_reader(ReadFun, Source)];
+ eof ->
+ [] % end_of_trace
+ end
+ end.
+
+%% Creates and returns a reader (lazy list) for a wrap log.
+%% The argument is a sorted list of sort converted
+%% wrap log file names, see wrap_presort/2.
+
+mk_reader_wrap([]) ->
+ [];
+mk_reader_wrap([Hd | _] = WrapFiles) ->
+ case file:open(wrap_name(Hd), [read, raw, binary]) of
+ {ok, File} ->
+ mk_reader_wrap(WrapFiles, File);
+ Error ->
+ exit({client_cannot_open, Error})
+ end.
+
+mk_reader_wrap([_Hd | Tail] = WrapFiles, File) ->
+ fun() ->
+ case read_term(fun file_read/2, File) of
+ {ok, Term} ->
+ [Term | mk_reader_wrap(WrapFiles, File)];
+ eof ->
+ file:close(File),
+ case Tail of
+ [_|_] ->
+ mk_reader_wrap(Tail);
+ [] ->
+ [] % end_of_trace
+ end
+ end
+ end.
+
+
+
+%% Generic read term function.
+%% Returns {ok, Term} | 'eof'. Exits on errors.
+
+read_term(ReadFun, Source) ->
+ case ReadFun(Source, 5) of
+ Bin when is_binary(Bin) ->
+ read_term(ReadFun, Source, Bin);
+ List when is_list(List) ->
+ read_term(ReadFun, Source, list_to_binary(List));
+ eof ->
+ eof
+ end.
+
+read_term(ReadFun, Source, <<Op, Size:32>> = Tag) ->
+ case Op of
+ 0 ->
+ case ReadFun(Source, Size) of
+ eof ->
+ exit({'trace term missing',
+ binary_to_list(Tag)});
+ Bin when is_binary(Bin) ->
+ {ok, binary_to_term(Bin)};
+ List when is_list(List) ->
+ {ok, binary_to_term(list_to_binary(List))}
+ end;
+ 1 ->
+ {ok, {drop, Size}};
+ Junk ->
+ exit({'bad trace tag', Junk})
+ end.
+
+
+
+%% Read functions for different source types, for read_term/2.
+%%
+%% Returns a binary of length N, an I/O-list of
+%% effective length N or 'eof'. Exits on errors.
+
+file_read(File, N) ->
+ case file:read(File, N) of
+ {ok, Bin} when byte_size(Bin) =:= N ->
+ Bin;
+ {ok, Bin} when is_binary(Bin) ->
+ exit({'truncated file', binary_to_list(Bin)});
+ eof ->
+ eof;
+ {error, Reason} ->
+ exit({'file read error', Reason})
+ end.
+
+follow_read(File, N) ->
+ follow_read(File, N, cur).
+
+follow_read(File, N, Pos) ->
+ case file:position(File, Pos) of
+ {ok, Offset} ->
+ case file:read(File, N) of
+ {ok, Bin} when byte_size(Bin) =:= N ->
+ Bin;
+ {ok, Bin} when is_binary(Bin) ->
+ follow_read(File, N, Offset);
+ eof ->
+ follow_read(File, N, Offset);
+ {error, Reason} ->
+ exit({'file read error', Reason})
+ end;
+ {error, Reason} ->
+ exit({'file position error', Reason})
+ end.
+
+ip_read(Socket, N) ->
+ case gen_tcp:recv(Socket, N) of
+ {ok, Bin} when byte_size(Bin) < N ->
+ [Bin | ip_read(Socket, N-byte_size(Bin))];
+ {ok, Bin} when byte_size(Bin) == N ->
+ [Bin];
+ {ok, Bin} when is_binary(Bin) ->
+ exit({'socket read too much data', Bin});
+ {error, closed} ->
+ eof;
+ {error, _Reason} = Error ->
+ exit({'socket read error', Error})
+ end.
+
+get_tracer() ->
+ req({get_tracer,node()}).
+get_tracer(Node) ->
+ req({get_tracer,Node}).
+
+save_pattern([]) ->
+ 0;
+save_pattern(P) ->
+ (catch save_pattern(P, get_pattern_table())).
+
+save_pattern(Pattern, PT) ->
+ Last = last_pattern(ets:last(PT), PT),
+ BPattern = term_to_binary(Pattern),
+ case ets:match_object(PT, {'_', BPattern}) of
+ [] ->
+ ets:insert(PT, {Last + 1, BPattern}),
+ Last + 1;
+ [{N, BPattern}] ->
+ N
+ end.
+
+last_pattern('$end_of_table', _PT) ->
+ 0;
+last_pattern(I, PT) when is_atom(I) ->
+ last_pattern(ets:prev(PT, I), PT);
+last_pattern(I, _PT) when is_integer(I) ->
+ I;
+last_pattern(_, _) ->
+ throw({error, badtable}).
+
+
+get_pattern_table() ->
+ {ok, Ret} = req(get_table),
+ Ret.
+
+new_pattern_table() ->
+ PT = ets:new(dbg_tab, [ordered_set, public]),
+ ets:insert(PT,
+ {x,
+ term_to_binary([{'_',[],[{exception_trace}]}])}),
+ ets:insert(PT,
+ {exception_trace,
+ term_to_binary(x)}),
+ PT.
+
+
+pt_doforall(Fun, Ld) ->
+ T = get_pattern_table(),
+ pt_doforall(T, Fun, ets:first(T), Ld).
+
+pt_doforall(_, _, '$end_of_table', _Ld) ->
+ ok;
+pt_doforall(T, Fun, Key, Ld) ->
+ [{A,B}] = ets:lookup(T,Key),
+ NLd = Fun({A,binary_to_term(B)},Ld),
+ pt_doforall(T,Fun,ets:next(T,Key),NLd).
+
+lint_tp([]) ->
+ {ok,[]};
+lint_tp(Pattern) ->
+ case erlang:match_spec_test([],Pattern,trace) of
+ {ok,_Res,Warnings,_Flags} ->
+ {ok, Warnings};
+ {error, Reasons} ->
+ {error, Reasons}
+ end.
+
+check_list(T) ->
+ case (catch lists:foldl(
+ fun(Val,_) ->
+ {ok,_,_,_} =
+ erlang:match_spec_test([],Val,trace),
+ ok
+ end,
+ ok, T)) of
+ {'EXIT',_} ->
+ {error, bad_match_spec};
+ ok ->
+ ok;
+ _Else ->
+ {error, badfile}
+ end.
+
+
+
+%% Find all possible wrap log files.
+%% Returns: a list of sort converted filenames.
+%%
+%% The sort conversion is done by extracting the wrap sequence counter
+%% from the filename, and calling wrap_encode/2.
+wrap_presort(Filename, Tail) ->
+ Name = filename:basename(Filename),
+ Dirname = filename:dirname(Filename),
+ case file:list_dir(Dirname) of
+ {ok, Files} ->
+ lists:zf(
+ fun(N) ->
+ case match_front(N, Name) of
+ false ->
+ false;
+ X ->
+ case match_rear(X, Tail) of
+ false ->
+ false;
+ C -> % Counter
+ case match_0_9(C) of
+ true ->
+ {true,
+ wrap_encode(
+ filename:join(Dirname, N),
+ C)};
+ false ->
+ false
+ end
+ end
+ end
+ end,
+ Files);
+ _ ->
+ []
+ end.
+
+
+
+%% Sorts a list of sort converted files
+wrap_sort(Files, N) ->
+ wrap_sortfix(lists:sort(Files), N).
+
+%% Finish the sorting, since the lists:sort order is not the correct order.
+%% Cut the list of files at the gap (at least one file is supposed
+%% to be 'missing') and create a new list by cons'ing the two parts
+%% in the right order.
+wrap_sortfix([], N) when N >= 1 ->
+ [];
+wrap_sortfix([], _N) ->
+ exit(inconsistent_wrap_file_trace_set);
+%% file 0, gap 1..N
+wrap_sortfix([{0, _}] = Files, N) when N >= 1 ->
+ Files;
+wrap_sortfix([{0, _}], _N) ->
+ exit(inconsistent_wrap_file_trace_set);
+%% files 0, ...
+wrap_sortfix([{0, _} | _] = Files, N) when N >= 1->
+ wrap_sortfix_1(Files, N, [], Files);
+%% gap 0, files 1, ...
+wrap_sortfix([{1, _} | _] = Files, N) when N >= 1 ->
+ wrap_sortfix_2(Files, N, [], Files);
+wrap_sortfix([{_C, _} | _], _N) ->
+ exit(inconsistent_wrap_file_trace_set).
+
+%% files 0..C, gap C+1..N
+wrap_sortfix_1([{C, _}], N, _R, Files)
+ when C < N ->
+ Files;
+%% files 0..C1, C1+1==C2, ...
+wrap_sortfix_1([{C1, _} = F1 | [{C2, _} | _] = Tail], N, R, Files)
+ when C1+1 == C2, C2 < N ->
+ wrap_sortfix_1(Tail, N, [F1 | R], Files);
+%% files 0..C1, gap C1+1, files C1+2==C2, ...
+wrap_sortfix_1([{C1, _} = F1 | [{C2, _} | _] = Tail], N, R, _Files)
+ when C1+2 == C2, C2 =< N ->
+ wrap_sortfix_2(Tail, N, lists:reverse([F1 | R]), Tail);
+wrap_sortfix_1([_F1 | [_F2 | _]], _N, _R, _Files) ->
+ exit(inconsistent_wrap_file_trace_set).
+
+%% M == length(R); files 0..M-1, gap M, files M+1..N
+wrap_sortfix_2([{N, _}], N, R, Files) ->
+ Files ++ R;
+wrap_sortfix_2([{_C, _}], _N, _R, _Files) ->
+ exit(inconsistent_wrap_file_trace_set);
+%% M == length(R); files 0..M-1, gap M, files M+1..C1, C1+1==C2, ...
+wrap_sortfix_2([{C1, _} | [{C2, _} | _] = Tail], N, R, Files)
+ when C1+1 == C2, C2 =< N ->
+ wrap_sortfix_2(Tail, N, R, Files);
+wrap_sortfix_2([{_C1, _} | [{_C2, _} | _]], _N, _R, _Files) ->
+ exit(inconsistent_wrap_file_trace_set).
+
+
+
+%% Extract the filenames from a list of sort converted ones.
+wrap_postsort(Files) ->
+ lists:map(fun wrap_name/1, Files).
+
+wrap_encode(N, C) ->
+ {list_to_integer(C), N}.
+
+wrap_name({_C, N}) ->
+ N.
+
+%% Returns what is left of ListA when removing all matching
+%% elements from ListB, or false if some element did not match,
+%% or if ListA runs out of elements before ListB.
+match_front(ListA, []) when is_list(ListA) ->
+ ListA;
+match_front([], ListB) when is_list(ListB) ->
+ false;
+match_front([Hd|TlA], [Hd|TlB]) ->
+ match_front(TlA,TlB);
+match_front([_HdA|_], [_HdB|_]) ->
+ false.
+
+%% Reversed version of match_front/2
+match_rear(ListA, ListB) when is_list(ListA), is_list(ListB) ->
+ case match_front(lists:reverse(ListA), lists:reverse(ListB)) of
+ false ->
+ false;
+ List ->
+ lists:reverse(List)
+ end.
+
+%% Returns true if the non-empty list arguments contains all
+%% characters $0 .. $9.
+match_0_9([]) ->
+ false;
+match_0_9([H]) when is_integer(H), $0 =< H, H =< $9 ->
+ true;
+match_0_9([H|T]) when is_integer(H), $0 =< H, H =< $9 ->
+ match_0_9(T);
+match_0_9(L) when is_list(L) ->
+ false.
+
+%%%%%%%%%%%%%%%%%%
+%% Help...
+%%%%%%%%%%%%%%%%%%
+
+help_display([]) ->
+ io:format("~n",[]),
+ ok;
+help_display([H|T]) ->
+ io:format("~s~n",[H]),
+ help_display(T).
+
+h() ->
+ help_display(
+ [
+ "The following help items are available:",
+ " p, c",
+ " - Set trace flags for processes",
+ " tp, tpl, ctp, ctpl, ctpg, ltp, dtp, wtp, rtp",
+ " - Manipulate trace patterns for functions",
+ " n, cn, ln",
+ " - Add/remove traced nodes.",
+ " tracer, trace_port, trace_client, get_tracer, stop, stop_clear",
+ " - Manipulate tracer process/port",
+ " i",
+ " - Info",
+ "",
+ "call dbg:h(Item) for brief help a brief description",
+ "of one of the items above."]).
+h(p) ->
+ help_display(["p(Item) -> {ok, MatchDesc} | {error, term()}",
+ " - Traces messages to and from Item.",
+ "p(Item, Flags) -> {ok, MatchDesc} | {error, term()}",
+ " - Traces Item according to Flags.",
+ " Flags can be one of s,r,m,c,p,sos,sol,sofs,",
+ " sofl,all,clear or any flag accepted by erlang:trace/3"]);
+h(c) ->
+ help_display(["c(Mod, Fun, Args)",
+ " - Evaluates apply(M,F,Args) with all trace flags set.",
+ "c(Mod, Fun, Args, Flags)",
+ " - Evaluates apply(M,F,Args) with Flags trace flags set."]);
+h(i) ->
+ help_display(["i() -> ok",
+ " - Displays information about all traced processes."]);
+h(tp) ->
+ help_display(
+ ["tp(Module,MatchSpec)",
+ " - Same as tp({Module, '_', '_'}, MatchSpec)",
+ "tp(Module,Function,MatchSpec)",
+ " - Same as tp({Module, Function, '_'}, MatchSpec)",
+ "tp(Module, Function, Arity, MatchSpec)",
+ " - Same as tp({Module, Function, Arity}, MatchSpec)",
+ "tp({Module, Function, Arity}, MatchSpec) -> {ok, MatchDesc} "
+ "| {error, term()}",
+ " - Set pattern for traced global function calls."]);
+h(tpl) ->
+ help_display(
+ ["tpl(Module,MatchSpec)",
+ " - Same as tpl({Module, '_', '_'}, MatchSpec)",
+ "tpl(Module,Function,MatchSpec)",
+ " - Same as tpl({Module, Function, '_'}, MatchSpec)",
+ "tpl(Module, Function, Arity, MatchSpec)",
+ " - Same as tpl({Module, Function, Arity}, MatchSpec)",
+ "tpl({Module, Function, Arity}, MatchSpec) -> {ok, MatchDesc} "
+ "| {error, term()}",
+ " - Set pattern for traced local (as well as global) function calls."]);
+h(ctp) ->
+ help_display(
+ ["ctp()",
+ " - Same as ctp({'_', '_', '_'})",
+ "ctp(Module)",
+ " - Same as ctp({Module, '_', '_'})",
+ "ctp(Module, Function)",
+ " - Same as ctp({Module, Function, '_'})",
+ "ctp(Module, Function, Arity)",
+ " - Same as ctp({Module, Function, Arity})",
+ "ctp({Module, Function, Arity}) -> {ok, MatchDesc} | {error, term()}",
+ " - Clear call trace pattern for the specified functions"]);
+h(ctpl) ->
+ help_display(
+ ["ctpl()",
+ " - Same as ctpl({'_', '_', '_'})",
+ "ctpl(Module)",
+ " - Same as ctpl({Module, '_', '_'})",
+ "ctpl(Module, Function)",
+ " - Same as ctpl({Module, Function, '_'})",
+ "ctpl(Module, Function, Arity)",
+ " - Same as ctpl({Module, Function, Arity})",
+ "ctpl({Module, Function, Arity}) -> {ok, MatchDesc} | {error, term()}",
+ " - Clear local call trace pattern for the specified functions"]);
+h(ctpg) ->
+ help_display(
+ ["ctpg()",
+ " - Same as ctpg({'_', '_', '_'})",
+ "ctpg(Module)",
+ " - Same as ctpg({Module, '_', '_'})",
+ "ctpg(Module, Function)",
+ " - Same as ctpg({Module, Function, '_'})",
+ "ctpg(Module, Function, Arity)",
+ " - Same as ctpg({Module, Function, Arity})",
+ "ctpg({Module, Function, Arity}) -> {ok, MatchDesc} | {error, term()}",
+ " - Clear global call trace pattern for the specified functions"]);
+h(ltp) ->
+ help_display(["ltp() -> ok",
+ " - Lists saved and built-in match_spec's on the console."]);
+h(dtp) ->
+ help_display(["dtp() -> ok",
+ " - Deletes all saved match_spec's.",
+ "dtp(N) -> ok",
+ " - Deletes a specific saved match_spec."]);
+h(wtp) ->
+ help_display(["wtp(Name) -> ok | {error, IOError}",
+ " - Writes all saved match_spec's to a file"]);
+h(rtp) ->
+ help_display(["rtp(Name) -> ok | {error, Error}",
+ " - Read saved match specifications from file."]);
+h(n) ->
+ help_display(
+ ["n(Nodename) -> {ok, Nodename} | {error, Reason}",
+ " - Starts a tracer server on the given node.",
+ "n(Nodename,Type,Data) -> {ok, Nodename} | {error, Reason}",
+ " - Starts a tracer server with additional args on the given node."]);
+h(cn) ->
+ help_display(["cn(Nodename) -> ok",
+ " - Clears a node from the list of traced nodes."]);
+h(ln) ->
+ help_display(["ln() -> ok",
+ " - Shows the list of traced nodes on the console."]);
+h(tracer) ->
+ help_display(["tracer() -> {ok, pid()} | {error, already_started}",
+ " - Starts a tracer server that handles trace messages.",
+ "tracer(Type, Data) -> {ok, pid()} | {error, Error}",
+ " - Starts a tracer server with additional parameters"]);
+h(trace_port) ->
+ help_display(["trace_port(Type, Parameters) -> fun()",
+ " - Creates and returns a trace port generating fun"]);
+h(trace_client) ->
+ help_display(["trace_client(Type, Parameters) -> pid()",
+ " - Starts a trace client that reads messages created by "
+ "a trace port driver",
+ "trace_client(Type, Parameters, HandlerSpec) -> pid()",
+ " - Starts a trace client that reads messages created by a",
+ " trace port driver, with a user defined handler"]);
+h(get_tracer) ->
+ help_display(
+ ["get_tracer() -> {ok, Tracer}",
+ " - Returns the process or port to which all trace messages are sent.",
+ "get_tracer(Node) -> {ok, Tracer}",
+ " - Returns the process or port to which all trace messages are sent."]);
+h(stop) ->
+ help_display(
+ ["stop() -> stopped",
+ " - Stops the dbg server and the tracing of all processes.",
+ " Does not clear any trace patterns."]);
+h(stop_clear) ->
+ help_display(
+ ["stop_clear() -> stopped",
+ " - Stops the dbg server and the tracing of all processes,",
+ " and clears all trace patterns."]).
+