path: root/lib/runtime_tools/src/dbg.erl

%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1996-2013. 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,deliver_and_flush/1]).

%% 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) ->
    case get_tracer(Node) of
	{ok, Port} when is_port(Port) ->
	    case catch rpc:call(Node,?MODULE,deliver_and_flush,[Port]) of
		[0] ->
		    ok;
		_ ->
		    {error, not_supported_by_trace_driver}
	    end;
	_ ->
	    {error, no_trace_driver}
    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.
    
%% A bit more than just flush - it also makes sure all trace messages
%% are delivered first, before flushing the driver.
deliver_and_flush(Port) ->
    Ref = erlang:trace_delivered(all),
    receive
	{trace_delivered,all,Ref} -> ok
    end,
    erlang:port_control(Port, $f, "").
					   

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.

	    %% 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.
	    %% If it is a file trace driver, we will also flush the port.
	    lists:foreach(fun({Node,{_Relay,Port}}) ->
				  rpc:call(Node,?MODULE,deliver_and_flush,[Port])
			  end,
			  get()),
	    exit(done);
	{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, element(tuple_size(Trace),Trace), 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) ->
    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),
	    To = element(5, Trace),
	    io:format(Out, "(~p) ~p ! ~p~n", [From,To,Message]);
	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.

dhandler1(Trace, Size, TS, Out) ->
    From = element(2, Trace),
    case element(3, Trace) of
	'receive' ->
	    case element(4, Trace) of
		{dbg,ok} -> ok;
		Message ->
		    io:format(Out, "(~p) << ~p (Timestamp: ~p)~n", [From,Message,TS])
	    end;
	'send' ->
	    Message = element(4, Trace),
	    To = element(5, Trace),
	    io:format(Out, "(~p) ~p ! ~p (Timestamp: ~p)~n", [From,To,Message,TS]);
	call ->
	    case element(4, Trace) of
		MFA when Size == 5 ->
		    Message = element(5, Trace),
		    io:format(Out, "(~p) call ~s (~p) (Timestamp: ~p)~n", [From,ffunc(MFA),Message,TS]);
		MFA ->
		    io:format(Out, "(~p) call ~s (Timestamp: ~p)~n", [From,ffunc(MFA),TS])
	    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 (Timestamp: ~p)~n", [From,ffunc(MFA),Ret,TS]);
		MFA ->
		    io:format(Out, "(~p) old_ret ~s (Timestamp: ~p)~n", [From,ffunc(MFA),TS])
	    end;
	return_from ->
	    MFA = element(4, Trace),
	    Ret = element(5, Trace),
	    io:format(Out, "(~p) returned from ~s -> ~p (Timestamp: ~p)~n", [From,ffunc(MFA),Ret,TS]);
	return_to ->
	    MFA = element(4, Trace),
	    io:format(Out, "(~p) returning to ~s (Timestamp: ~p)~n", [From,ffunc(MFA),TS]);
	spawn when Size == 5 ->
	    Pid = element(4, Trace),
	    MFA = element(5, Trace),
	    io:format(Out, "(~p) spawn ~p as ~s (Timestamp: ~p)~n", [From,Pid,ffunc(MFA),TS]);
	Op ->
	    io:format(Out, "(~p) ~p ~s (Timestamp: ~p)~n", [From,Op,ftup(Trace,4,Size),TS])
    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)}),
    ets:insert(PT,
	       {c,
		term_to_binary([{'_',[],[{message,{caller}}]}])}),
    ets:insert(PT,
	       {caller_trace,
		term_to_binary(c)}),
    ets:insert(PT,
	       {cx,
		term_to_binary([{'_',[],[{exception_trace},
					 {message,{caller}}]}])}),
    ets:insert(PT,
	       {caller_exception_trace,
		term_to_binary(cx)}),
    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."]).