diff options
Diffstat (limited to 'lib/runtime_tools/src/dbg.erl')
| -rw-r--r-- | lib/runtime_tools/src/dbg.erl | 1749 |
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."]). + |