The R13B03 release.OTP_R13B03

1 files changed, 320 insertions, 0 deletions

diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl
new file mode 100644
index 0000000000..0f428de07a
--- /dev/null
+++ b/lib/runtime_tools/src/observer_backend.erl
@@ -0,0 +1,320 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2002-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(observer_backend).
+
+%% General
+-export([vsn/0]).
+
+%% etop stuff
+-export([etop_collect/1]).
+-include("observer_backend.hrl").
+
+%% ttb stuff
+-export([ttb_init_node/3,
+	 ttb_write_trace_info/3,
+	 ttb_write_binary/2,
+	 ttb_stop/1,
+	 ttb_fetch/2,
+	 ttb_get_filenames/1]).
+-define(CHUNKSIZE,8191). % 8 kbytes - 1 byte
+
+vsn() ->
+    case application:load(runtime_tools) of
+	R when R=:=ok; R=:={error,{already_loaded,runtime_tools}} -> 
+	    application:get_key(runtime_tools,vsn);
+	Error -> Error
+    end.
+
+
+
+%%
+%% etop backend
+%%
+etop_collect(Collector) ->
+    ProcInfo = etop_collect(processes(), []),
+    Collector ! {self(),#etop_info{now = now(),
+				   n_procs = length(ProcInfo),
+				   run_queue = erlang:statistics(run_queue),
+				   wall_clock = erlang:statistics(wall_clock),
+				   runtime = erlang:statistics(runtime),
+				   memi = etop_memi(),
+				   procinfo = ProcInfo
+				  }}.
+
+etop_memi() ->
+    try
+	[{total, c:memory(total)},
+	 {processes, c:memory(processes)}, 
+	 {ets, c:memory(ets)},
+	 {atom, c:memory(atom)},
+	 {code, c:memory(code)},
+	 {binary, c:memory(binary)}]
+    catch
+	error:notsup ->
+	    undefined
+    end.
+
+etop_collect([P|Ps], Acc) when P =:= self() ->
+    etop_collect(Ps, Acc);
+etop_collect([P|Ps], Acc) ->
+    Fs = [registered_name,initial_call,memory,reductions,current_function,message_queue_len],
+    case process_info(P, Fs) of
+	undefined ->
+	    etop_collect(Ps, Acc);
+	[{registered_name,Reg},{initial_call,Initial},{memory,Mem},
+	 {reductions,Reds},{current_function,Current},{message_queue_len,Qlen}] ->
+	    Name = case Reg of
+		       [] -> Initial;
+		       _ -> Reg
+		   end,
+	    Info = #etop_proc_info{pid=P,mem=Mem,reds=Reds,name=Name,
+				   cf=Current,mq=Qlen},
+	    etop_collect(Ps, [Info|Acc])
+    end;
+etop_collect([], Acc) -> Acc.
+
+%%
+%% ttb backend
+%%
+ttb_init_node(MetaFile,PI,Traci) ->
+    if
+	is_list(MetaFile);
+	is_atom(MetaFile) ->
+	    file:delete(MetaFile);
+	true -> 				% {local,_,_}
+	    ok
+    end,
+    Self = self(),
+    MetaPid = spawn(fun() -> ttb_meta_tracer(MetaFile,PI,Self) end),
+    receive {MetaPid,started} -> ok end,
+    MetaPid ! {metadata,Traci},
+    case PI of
+	true ->
+	    Proci = pnames(),
+	    MetaPid ! {metadata,Proci};
+	false ->
+	    ok
+    end,
+    {ok,MetaPid}.
+
+ttb_write_trace_info(MetaPid,Key,What) ->
+    MetaPid ! {metadata,Key,What},
+    ok.
+
+ttb_meta_tracer(MetaFile,PI,Parent) ->
+    case PI of
+	true ->
+	    ReturnMS = [{'_',[],[{return_trace}]}],
+	    erlang:trace_pattern({erlang,spawn,3},ReturnMS,[meta]),
+	    erlang:trace_pattern({erlang,spawn_link,3},ReturnMS,[meta]),
+	    erlang:trace_pattern({erlang,spawn_opt,1},ReturnMS,[meta]),
+	    erlang:trace_pattern({erlang,register,2},[],[meta]),
+	    erlang:trace_pattern({global,register_name,2},[],[meta]);
+	false ->
+	    ok
+    end,
+    Parent ! {self(),started},
+    ttb_meta_tracer_loop(MetaFile,PI,dict:new()).
+
+ttb_meta_tracer_loop(MetaFile,PI,Acc) ->
+    receive
+	{trace_ts,_,call,{erlang,register,[Name,Pid]},_} ->
+	    ttb_store_meta({pid,{Pid,Name}},MetaFile),
+	    ttb_meta_tracer_loop(MetaFile,PI,Acc);
+	{trace_ts,_,call,{global,register_name,[Name,Pid]},_} ->
+	    ttb_store_meta({pid,{Pid,{global,Name}}},MetaFile),
+	    ttb_meta_tracer_loop(MetaFile,PI,Acc);
+	{trace_ts,CallingPid,call,{erlang,spawn_opt,[{M,F,Args,_}]},_} ->
+	    MFA = {M,F,length(Args)},
+	    NewAcc = dict:update(CallingPid,
+				 fun(Old) -> [MFA|Old] end, [MFA], 
+				 Acc),
+	    ttb_meta_tracer_loop(MetaFile,PI,NewAcc);
+	{trace_ts,CallingPid,return_from,{erlang,spawn_opt,_Arity},Ret,_} ->
+	    case Ret of
+		{NewPid,_Mref} when is_pid(NewPid) -> ok;
+		NewPid when is_pid(NewPid) -> ok
+	    end,
+	    NewAcc = 
+		dict:update(CallingPid,
+			    fun([H|T]) -> 
+				    ttb_store_meta({pid,{NewPid,H}},MetaFile),
+				    T 
+			    end,
+			    Acc),
+	    ttb_meta_tracer_loop(MetaFile,PI,NewAcc);
+	{trace_ts,CallingPid,call,{erlang,Spawn,[M,F,Args]},_} 
+	when Spawn==spawn;Spawn==spawn_link ->
+	    MFA = {M,F,length(Args)},
+	    NewAcc = dict:update(CallingPid,
+				 fun(Old) -> [MFA|Old] end, [MFA], 
+				 Acc),
+	    ttb_meta_tracer_loop(MetaFile,PI,NewAcc);
+
+	{trace_ts,CallingPid,return_from,{erlang,Spawn,_Arity},NewPid,_} 
+	when Spawn==spawn;Spawn==spawn_link ->
+	    NewAcc = 
+		dict:update(CallingPid,
+			    fun([H|T]) -> 
+				    ttb_store_meta({pid,{NewPid,H}},MetaFile),
+				    T
+			    end,
+			    Acc),
+	    ttb_meta_tracer_loop(MetaFile,PI,NewAcc);
+
+	{metadata,Data} when is_list(Data) ->
+	    ttb_store_meta(Data,MetaFile),
+	    ttb_meta_tracer_loop(MetaFile,PI,Acc);
+
+	{metadata,Key,Fun} when is_function(Fun) ->
+	    ttb_store_meta([{Key,Fun()}],MetaFile),
+	    ttb_meta_tracer_loop(MetaFile,PI,Acc);
+
+	{metadata,Key,What} ->
+	    ttb_store_meta([{Key,What}],MetaFile),
+	    ttb_meta_tracer_loop(MetaFile,PI,Acc);
+
+	stop when PI=:=true ->
+	    erlang:trace_pattern({erlang,spawn,3},false,[meta]),
+	    erlang:trace_pattern({erlang,spawn_link,3},false,[meta]),
+	    erlang:trace_pattern({erlang,spawn_opt,1},false,[meta]),
+	    erlang:trace_pattern({erlang,register,2},false,[meta]),
+	    erlang:trace_pattern({global,register_name,2},false,[meta]);
+	stop ->
+	    ok
+    end.
+
+pnames() ->
+    Processes = processes(),
+    Globals = lists:map(fun(G) -> {global:whereis_name(G),G} end, 
+			global:registered_names()),
+    lists:flatten(lists:foldl(fun(Pid,Acc) -> [pinfo(Pid,Globals)|Acc] end, 
+			      [], Processes)).
+
+pinfo(P,Globals) ->
+    case process_info(P,registered_name) of
+	[] ->
+	    case lists:keysearch(P,1,Globals) of
+		{value,{P,G}} -> {pid,{P,{global,G}}};
+		false -> 
+		    case process_info(P,initial_call) of
+			{_,I} -> {pid,{P,I}};
+			undefined -> [] % the process has terminated
+		    end
+	    end;
+	{_,R} -> {pid,{P,R}};
+	undefined -> [] % the process has terminated
+    end.
+
+
+ttb_store_meta(Data,{local,MetaFile,Port}) when is_list(Data) ->
+    ttb_send_to_port(Port,MetaFile,Data);
+ttb_store_meta(Data,MetaFile) when is_list(Data) ->
+    {ok,Fd} = file:open(MetaFile,[raw,append]),
+    ttb_write_binary(Fd,Data),
+    file:close(Fd);
+ttb_store_meta(Data,MetaFile) ->
+    ttb_store_meta([Data],MetaFile).
+
+ttb_write_binary(Fd,[H|T]) ->
+    file:write(Fd,ttb_make_binary(H)),
+    ttb_write_binary(Fd,T);
+ttb_write_binary(_Fd,[]) ->
+    ok.
+
+ttb_send_to_port(Port,MetaFile,[H|T]) ->
+    B1 = ttb_make_binary(H),
+    B2 = term_to_binary({metadata,MetaFile,B1}),
+    erlang:port_command(Port,B2),
+    ttb_send_to_port(Port,MetaFile,T);
+ttb_send_to_port(_Port,_MetaFile,[]) ->
+    ok.
+
+ttb_make_binary(Term) ->
+    B = term_to_binary(Term),
+    SizeB = byte_size(B),
+    if SizeB > 255 ->
+	    %% size is bigger than 8 bits, must therefore add an extra
+	    %% size field
+	    SB = term_to_binary({'$size',SizeB}),
+	    <<(byte_size(SB)):8, SB/binary, B/binary>>;
+        true ->
+	    <<SizeB:8, B/binary>>
+    end.
+
+    
+%% Stop ttb
+ttb_stop(MetaPid) ->
+    Delivered = erlang:trace_delivered(all),
+    receive
+	{trace_delivered,all,Delivered} -> ok
+    end,
+    Ref = erlang:monitor(process,MetaPid),
+    MetaPid ! stop,
+
+    %% Must wait for the process to terminate there
+    %% because dbg will be stopped when this function
+    %% returns, and then the Port (in {local,MetaFile,Port})
+    %% cannot be accessed any more.
+    receive {'DOWN', Ref, process, MetaPid, _Info} -> ok end,
+    seq_trace:reset_trace(),
+    seq_trace:set_system_tracer(false).
+
+%% Fetch ttb logs from remote node
+ttb_fetch(MetaFile,{Port,Host}) ->
+    erlang:process_flag(priority,low),
+    Files = ttb_get_filenames(MetaFile),
+    {ok, Sock} = gen_tcp:connect(Host, Port, [binary, {packet, 2}]),
+    send_files({Sock,Host},Files),
+    ok = gen_tcp:close(Sock).
+
+
+send_files({Sock,Host},[File|Files]) ->
+    {ok,Fd} = file:open(File,[raw,read,binary]),
+    gen_tcp:send(Sock,<<1,(list_to_binary(File))/binary>>),
+    send_chunks(Sock,Fd),
+    file:delete(File),
+    send_files({Sock,Host},Files);
+send_files({_Sock,_Host},[]) ->
+    done.
+
+send_chunks(Sock,Fd) ->
+    case file:read(Fd,?CHUNKSIZE) of
+	{ok,Bin} -> 
+	    ok = gen_tcp:send(Sock, <<0,Bin/binary>>),
+	    send_chunks(Sock,Fd);
+	eof ->
+	    ok;
+	{error,Reason} ->
+	    ok = gen_tcp:send(Sock, <<2,(term_to_binary(Reason))/binary>>)
+    end.
+
+ttb_get_filenames(MetaFile) ->
+    Dir = filename:dirname(MetaFile),
+    Root = filename:rootname(filename:basename(MetaFile)),
+    {ok,List} = file:list_dir(Dir),
+    match_filenames(Dir,Root,List,[]).
+
+match_filenames(Dir,MetaFile,[H|T],Files) ->
+    case lists:prefix(MetaFile,H) of
+	true -> match_filenames(Dir,MetaFile,T,[filename:join(Dir,H)|Files]);
+	false -> match_filenames(Dir,MetaFile,T,Files)
+    end;
+match_filenames(_Dir,_MetaFile,[],Files) ->
+    Files.