aboutsummaryrefslogtreecommitdiffstats
path: root/lib/observer/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/observer/src')
-rw-r--r--lib/observer/src/Makefile132
-rw-r--r--lib/observer/src/crashdump_viewer.erl2566
-rw-r--r--lib/observer/src/crashdump_viewer.hrl132
-rw-r--r--lib/observer/src/crashdump_viewer_html.erl1431
-rw-r--r--lib/observer/src/etop.erl344
-rw-r--r--lib/observer/src/etop_defs.hrl29
-rw-r--r--lib/observer/src/etop_gui.erl362
-rw-r--r--lib/observer/src/etop_tr.erl130
-rw-r--r--lib/observer/src/etop_txt.erl101
-rw-r--r--lib/observer/src/multitrace.erl256
-rw-r--r--lib/observer/src/observer.app.src34
-rw-r--r--lib/observer/src/observer.appup.src19
-rw-r--r--lib/observer/src/ttb.erl1000
-rw-r--r--lib/observer/src/ttb_et.erl267
14 files changed, 6803 insertions, 0 deletions
diff --git a/lib/observer/src/Makefile b/lib/observer/src/Makefile
new file mode 100644
index 0000000000..dde1ea17be
--- /dev/null
+++ b/lib/observer/src/Makefile
@@ -0,0 +1,132 @@
+#
+# %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%
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(OBSERVER_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/observer-$(VSN)
+
+# ----------------------------------------------------
+# Common Macros
+# ----------------------------------------------------
+
+MODULES= \
+ crashdump_viewer \
+ crashdump_viewer_html \
+ etop \
+ etop_gui \
+ etop_tr \
+ etop_txt \
+ ttb \
+ ttb_et
+HRL_FILES= \
+ ../include/etop.hrl
+INTERNAL_HRL_FILES= \
+ crashdump_viewer.hrl \
+ etop_defs.hrl
+ERL_FILES= $(MODULES:%=%.erl)
+EXAMPLE_FILES= multitrace.erl
+
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET)
+
+PRIVDIR= ../priv
+WEBTOOLFILES= $(PRIVDIR)/crashdump_viewer.tool
+BINDIR= $(PRIVDIR)/bin
+EXECUTABLES= \
+ $(BINDIR)/etop \
+ $(BINDIR)/getop \
+ $(BINDIR)/etop.bat \
+ $(BINDIR)/getop.bat
+CDVDIR= $(PRIVDIR)/crashdump_viewer
+GIF_FILES= \
+ $(CDVDIR)/collapsd.gif \
+ $(CDVDIR)/exploded.gif
+
+APP_FILE= observer.app
+
+APP_SRC= $(APP_FILE).src
+APP_TARGET= $(EBIN)/$(APP_FILE)
+
+APPUP_FILE= observer.appup
+
+APPUP_SRC= $(APPUP_FILE).src
+APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+ERL_COMPILE_FLAGS += \
+ -I../include \
+ -I ../../et/include \
+ -I ../../../libraries/et/include
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f errs core *~
+
+$(APP_TARGET): $(APP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(VSN);' $< > $@
+
+$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(VSN);' $< > $@
+
+docs:
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/src
+ $(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR)/src
+ $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src
+ $(INSTALL_DATA) $(EXAMPLE_FILES) $(RELSYSDIR)/src
+ $(INSTALL_DIR) $(RELSYSDIR)/include
+ $(INSTALL_DATA) $(HRL_FILES) $(RELSYSDIR)/include
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+ $(INSTALL_DIR) $(RELSYSDIR)/priv/bin
+ $(INSTALL_SCRIPT) $(EXECUTABLES) $(RELSYSDIR)/priv/bin
+ $(INSTALL_DIR) $(RELSYSDIR)/priv/crashdump_viewer
+ $(INSTALL_DATA) $(WEBTOOLFILES) $(RELSYSDIR)/priv
+ $(INSTALL_DATA) $(GIF_FILES) $(RELSYSDIR)/priv/crashdump_viewer
+
+release_docs_spec:
+
+
+
+
+
+
+
diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl
new file mode 100644
index 0000000000..b323d86ea4
--- /dev/null
+++ b/lib/observer/src/crashdump_viewer.erl
@@ -0,0 +1,2566 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-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(crashdump_viewer).
+
+%%
+%% This module is the main module in the crashdump viewer. It implements
+%% the server started by webtool and the API for the crashdump viewer tool.
+%%
+%% All functions in the API except configData/0 and start_link/0 are
+%% called from HTML pages via erl_scheme.
+%%
+%% Tables
+%% ------
+%% cdv_menu_table: This table holds the menu which is presented in the left
+%% frame of the crashdump viewer page. Each element in the table represents
+%% one meny item, and the state of the item indicates if it is presently
+%% visible or not.
+%%
+%% cdv_dump_index_table: This table holds all tags read from the crashdump.
+%% Each tag indicates where the information about a specific item starts.
+%% The table entry for a tag includes the start and end positions for
+%% this item-information. All tags start with a "=" at the beginning of
+%% a line.
+%%
+%% Process state
+%% -------------
+%% file: The name of the crashdump currently viewed.
+%% procs_summary: Process summary represented by a list of
+%% #proc records. This is used for efficiency reasons when sorting
+%% the process summary table instead of reading all processes from
+%% the dump again.
+%% sorted: atom(), indicated what item was last sorted in process summary.
+%% This is needed so reverse sorting can be done.
+%% shared_heap: 'true' if crashdump comes from a system running shared heap,
+%% else 'false'.
+%% wordsize: 4 | 8, the number of bytes in a word.
+%% binaries: a gb_tree containing binaries or links to binaries in the dump
+%%
+
+%% User API
+-export([start/0,stop/0]).
+
+%% Webtool API
+-export([configData/0,
+ start_link/0]).
+-export([start_page/2,
+ read_file_frame/2,
+ read_file/2,
+ redirect/2,
+ filename_frame/2,
+ menu_frame/2,
+ initial_info_frame/2,
+ toggle/2,
+ general_info/2,
+ processes/2,
+ proc_details/2,
+ ports/2,
+ ets_tables/2,
+ timers/2,
+ fun_table/2,
+ atoms/2,
+ dist_info/2,
+ loaded_modules/2,
+ loaded_mod_details/2,
+ memory/2,
+ allocated_areas/2,
+ allocator_info/2,
+ hash_tables/2,
+ index_tables/2,
+ sort_procs/2,
+ expand/2,
+ expand_binary/2,
+ expand_memory/2,
+ next/2]).
+
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+%% Debug support
+-export([debug/1,stop_debug/0]).
+
+-include("crashdump_viewer.hrl").
+-include_lib("kernel/include/file.hrl").
+-include_lib("stdlib/include/ms_transform.hrl").
+
+-define(START_PAGE,"/cdv_erl/crashdump_viewer/start_page").
+-define(READ_FILE_PAGE,"/cdv_erl/crashdump_viewer/read_file?path=").
+-define(SERVER, crashdump_viewer_server).
+-define(call_timeout,3600000).
+-define(chunk_size,1000). % number of bytes read from crashdump at a time
+-define(max_line_size,100). % max number of bytes (i.e. characters) the
+ % line_head/1 function can return
+-define(max_display_size,500). % max number of bytes that will be directly
+ % displayed. If e.g. msg_q is longer than
+ % this, it must be explicitly expanded.
+-define(max_display_binary_size,50). % max size of a binary that will be
+ % directly displayed.
+
+-define(initial_proc_record(Pid),
+ #proc{pid=Pid,
+ %% msg_q_len, reds and stack_heap are integers because it must
+ %% be possible to sort on them. All other fields are strings
+ msg_q_len=0,reds=0,stack_heap=0,
+ %% for old dumps start_time, parent and number of heap frament
+ %% does not exist
+ start_time="unknown",
+ parent="unknown",
+ num_heap_frag="unknown",
+ %% current_func can be both "current function" and
+ %% "last scheduled in for"
+ current_func={"Current Function",?space},
+ %% stack_dump, message queue and dictionaries should only be
+ %% displayed as a link to "Expand" (if dump is from OTP R9B
+ %% or newer)
+ _=?space}).
+
+-record(state,{file,procs_summary,sorted,shared_heap=false,
+ wordsize=4,num_atoms="unknown",binaries,bg_status}).
+
+%%%-----------------------------------------------------------------
+%%% Debugging
+%% Start tracing with
+%% debug(Functions).
+%% Functions = local | global | FunctionList
+%% FunctionList = [Function]
+%% Function = {FunctionName,Arity} | FunctionName
+debug(F) ->
+ ttb:tracer(all,[{file,"cdv"}]), % tracing all nodes
+ ttb:p(all,[call,timestamp]),
+ MS = [{'_',[],[{return_trace},{message,{caller}}]}],
+ tp(F,MS),
+ ttb:ctp(?MODULE,stop_debug), % don't want tracing of the stop_debug func
+ ok.
+tp([{M,F,A}|T],MS) -> % mod:func/arity
+ ttb:tpl(M,F,A,MS),
+ tp(T,MS);
+tp([{M,F}|T],MS) -> % mod:func
+ ttb:tpl(M,F,MS),
+ tp(T,MS);
+tp([M|T],MS) -> % mod
+ ttb:tp(M,MS), % only exported
+ tp(T,MS);
+tp([],_MS) ->
+ ok.
+stop_debug() ->
+ ttb:stop([format]).
+
+%%%-----------------------------------------------------------------
+%%% User API
+start() ->
+ webtool:start(),
+ receive after 1000 -> ok end,
+ webtool:start_tools([],"app=crashdump_viewer"),
+ receive after 1000 -> ok end,
+ ok.
+
+stop() ->
+ webtool:stop_tools([],"app=crashdump_viewer"),
+ webtool:stop().
+
+%%%-----------------------------------------------------------------
+%%% Return config data used by webtool
+configData() ->
+ Dir = filename:join(code:priv_dir(observer),"crashdump_viewer"),
+ {crashdump_viewer,
+ [{web_data,{"CrashDumpViewer",?START_PAGE}},
+ {alias,{"/crashdump_viewer",Dir}},
+ {alias,{"/crashdump_erts_doc",erts_docdir()}},
+ {alias,{"/crashdump_doc",cdv_docdir()}},
+ {alias,{erl_alias,"/cdv_erl",[?MODULE]}},
+ {start,{child,{{local,?SERVER},
+ {?MODULE,start_link,[]},
+ permanent,100,worker,[?MODULE]}}}
+ ]}.
+
+erts_docdir() ->
+ ErtsVsn = erlang:system_info(version),
+ RootDir = code:root_dir(),
+ VsnErtsDir = filename:join(RootDir,"erts-"++ErtsVsn),
+ DocDir = filename:join(["doc","html"]),
+ case filelib:is_dir(VsnErtsDir) of
+ true ->
+ filename:join(VsnErtsDir,DocDir);
+ false ->
+ %% So this can be run in clearcase
+ filename:join([RootDir,"erts",DocDir])
+ end.
+
+cdv_docdir() ->
+ ObserverDir = code:lib_dir(observer),
+ filename:join([ObserverDir,"doc","html"]).
+
+%%====================================================================
+%% External functions
+%%====================================================================
+%%%--------------------------------------------------------------------
+%%% Start the server
+start_link() ->
+ case whereis(?SERVER) of
+ undefined ->
+ gen_server:start_link({local, ?SERVER}, ?MODULE, [], []);
+ Pid ->
+ {ok,Pid}
+ end.
+
+%%%-----------------------------------------------------------------
+%%% If crashdump_viewer is just started, show welcome frame. Else
+%%% show menu and general_info
+start_page(_Env,_Input) ->
+ call(start_page).
+
+%%%-----------------------------------------------------------------
+%%% Display the form for entering the file name for the crashdump
+%%% to view.
+read_file_frame(_Env,_Input) ->
+ crashdump_viewer_html:read_file_frame().
+
+%%%-----------------------------------------------------------------
+%%% Called when the 'ok' button is clicked after entering the dump
+%%% file name.
+read_file(_Env,Input) ->
+ call({read_file,Input}).
+
+%%%-----------------------------------------------------------------
+%%% The topmost frame of the main page. Called when a crashdump is
+%%% loaded.
+filename_frame(_Env,_Input) ->
+ call(filename_frame).
+
+%%%-----------------------------------------------------------------
+%%% The initial information frame. Called when a crashdump is loaded.
+initial_info_frame(_Env,_Input) ->
+ call(initial_info_frame).
+
+%%%-----------------------------------------------------------------
+%%% The left frame of the main page. Called when a crashdump is
+%%% loaded.
+menu_frame(_Env,_Input) ->
+ crashdump_viewer_html:menu_frame().
+
+%%%-----------------------------------------------------------------
+%%% Called when the collapsed or exploded picture in the menu is
+%%% clicked.
+toggle(_Env,Input) ->
+ call({toggle,Input}).
+
+%%%-----------------------------------------------------------------
+%%% The following functions are called when menu items are clicked.
+general_info(_Env,_Input) ->
+ call(general_info).
+processes(_Env,_Input) ->
+ call(procs_summary).
+ports(_Env,Input) -> % this is also called when a link to a port is clicked
+ call({ports,Input}).
+ets_tables(_Env,Input) ->
+ call({ets_tables,Input}).
+timers(_Env,Input) ->
+ call({timers,Input}).
+fun_table(_Env,_Input) ->
+ call(funs).
+atoms(_Env,_Input) ->
+ call(atoms).
+dist_info(_Env,_Input) ->
+ call(dist_info).
+loaded_modules(_Env,_Input) ->
+ call(loaded_mods).
+loaded_mod_details(_Env,Input) ->
+ call({loaded_mod_details,Input}).
+memory(_Env,_Input) ->
+ call(memory).
+allocated_areas(_Env,_Input) ->
+ call(allocated_areas).
+allocator_info(_Env,_Input) ->
+ call(allocator_info).
+hash_tables(_Env,_Input) ->
+ call(hash_tables).
+index_tables(_Env,_Input) ->
+ call(index_tables).
+
+%%%-----------------------------------------------------------------
+%%% Called when a link to a process (Pid) is clicked.
+proc_details(_Env,Input) ->
+ call({proc_details,Input}).
+
+%%%-----------------------------------------------------------------
+%%% Called when one of the headings in the process summary table are
+%%% clicked. It sorts the processes by the clicked heading.
+sort_procs(_Env,Input) ->
+ call({sort_procs,Input}).
+
+%%%-----------------------------------------------------------------
+%%% Called when the "Expand" link in a call stack (Last Calls) is
+%%% clicked.
+expand(_Env,Input) ->
+ call({expand,Input}).
+
+%%%-----------------------------------------------------------------
+%%% Called when the "Expand" link in a stack dump, message queue or
+%%% dictionary is clicked.
+expand_memory(_Env,Input) ->
+ call({expand_memory,Input}).
+
+%%%-----------------------------------------------------------------
+%%% Called when "<< xxx bytes>>" link in a stack dump, message queue or
+%%% dictionary is clicked.
+expand_binary(_Env,Input) ->
+ call({expand_binary,Input}).
+
+%%%-----------------------------------------------------------------
+%%% Called when the "Next" link under atoms is clicked.
+next(_Env,Input) ->
+ call({next,Input}).
+
+%%%-----------------------------------------------------------------
+%%% Called on regular intervals while waiting for a dump to be read
+redirect(_Env,_Input) ->
+ call(redirect).
+
+%%====================================================================
+%% Server functions
+%%====================================================================
+
+%%--------------------------------------------------------------------
+%% Function: init/1
+%% Description: Initiates the server
+%% Returns: {ok, State} |
+%% {ok, State, Timeout} |
+%% ignore |
+%% {stop, Reason}
+%%--------------------------------------------------------------------
+init([]) ->
+ ets:new(cdv_menu_table,[set,named_table,{keypos,#menu_item.index},public]),
+ ets:new(cdv_dump_index_table,[bag,named_table,public]),
+ {ok, #state{}}.
+
+%%--------------------------------------------------------------------
+%% Function: handle_call/3
+%% Description: Handling call messages
+%% Returns: {reply, Reply, State} |
+%% {reply, Reply, State, Timeout} |
+%% {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, Reply, State} | (terminate/2 is called)
+%% {stop, Reason, State} (terminate/2 is called)
+%%--------------------------------------------------------------------
+handle_call(start_page,_From,State=#state{file=undefined,bg_status=undefined})->
+ Reply = crashdump_viewer_html:welcome(),
+ {reply,Reply,State};
+handle_call(start_page, _From, State=#state{file=undefined,bg_status={done,Page}}) ->
+ {reply,Page,State};
+handle_call(start_page, _From, State=#state{file=undefined,bg_status=Status}) ->
+ Reply = crashdump_viewer_html:redirect(Status),
+ {reply,Reply,State};
+handle_call(start_page, _From, State) ->
+ Reply = crashdump_viewer_html:start_page(),
+ {reply,Reply,State};
+handle_call({read_file,Input}, _From, _State) ->
+ {ok,File0} = get_value("path",httpd:parse_query(Input)),
+ File =
+ case File0 of
+ [$"|FileAndSome] ->
+ %% Opera adds \"\" around the filename!
+ [$"|Elif] = lists:reverse(FileAndSome),
+ lists:reverse(Elif);
+ _ ->
+ File0
+ end,
+ spawn_link(fun() -> read_file(File) end),
+ Status = background_status(reading,File),
+ Reply = crashdump_viewer_html:redirect(Status),
+ {reply, Reply, #state{bg_status=Status}};
+handle_call(redirect,_From, State=#state{bg_status={done,Page}}) ->
+ {reply, Page, State#state{bg_status=undefined}};
+handle_call(redirect,_From, State=#state{bg_status=Status}) ->
+ Reply = crashdump_viewer_html:redirect(Status),
+ {reply, Reply, State};
+handle_call(filename_frame,_From,State=#state{file=File}) ->
+ Reply = crashdump_viewer_html:filename_frame(File),
+ {reply,Reply,State};
+handle_call(initial_info_frame,_From,State=#state{file=File}) ->
+ GenInfo = general_info(File),
+ NumAtoms = GenInfo#general_info.num_atoms,
+ {WS,SH} = parse_vsn_str(GenInfo#general_info.system_vsn,4,false),
+ Reply = crashdump_viewer_html:general_info(GenInfo),
+ {reply,Reply,State#state{shared_heap=SH,wordsize=WS,num_atoms=NumAtoms}};
+handle_call({toggle,Input},_From,State) ->
+ {ok,Index} = get_value("index",httpd:parse_query(Input)),
+ do_toggle(list_to_integer(Index)),
+ Reply = crashdump_viewer_html:menu_frame(),
+ {reply,Reply,State};
+handle_call({expand,Input},_From,State=#state{file=File}) ->
+ [{"pos",Pos},{"size",Size},{"what",What},{"truncated",Truncated}] =
+ httpd:parse_query(Input),
+ Expanded = get_expanded(File,list_to_integer(Pos),list_to_integer(Size)),
+ TruncText = if Truncated=="true" -> "WARNING: This term is truncated!\n\n";
+ true -> ""
+ end,
+ Reply =
+ case {Truncated,What} of
+ {_,"LastCalls"} ->
+ LastCalls = replace_all($ ,$\n,Expanded,[]),
+ crashdump_viewer_html:info_page(What,[TruncText,LastCalls]);
+ {_,"StackDump"} ->
+ crashdump_viewer_html:info_page(What,[TruncText,Expanded]);
+ {"false",_} ->
+ crashdump_viewer_html:pretty_info_page(What,Expanded);
+ {"true",_} ->
+ crashdump_viewer_html:info_page(What,[TruncText,Expanded])
+ end,
+ {reply,Reply,State};
+handle_call({expand_memory,Input},_From,State=#state{file=File,binaries=B}) ->
+ [{"pid",Pid},{"what",What}] = httpd:parse_query(Input),
+ Reply =
+ case truncated_warning([{"=proc",Pid}]) of
+ [] ->
+ Expanded = expand_memory(File,What,Pid,B),
+ crashdump_viewer_html:expanded_memory(What,Expanded);
+ _TW ->
+ Info =
+ "The crashdump is truncated in the middle of this "
+ "process' memory information, so this information "
+ "can not be extracted.",
+ crashdump_viewer_html:info_page(What,Info)
+ end,
+ {reply,Reply,State};
+handle_call({expand_binary,Input},_From,State=#state{file=File}) ->
+ [{"pos",Pos0}] = httpd:parse_query(Input),
+ Pos = list_to_integer(Pos0),
+ Fd = open(File),
+ pos_bof(Fd,Pos),
+ {Bin,_Line} = get_binary(val(Fd)),
+ close(Fd),
+ Reply=crashdump_viewer_html:expanded_binary(io_lib:format("~p",[Bin])),
+ {reply,Reply,State};
+handle_call({next,Input},_From,State=#state{file=File}) ->
+ [{"pos",Pos},{"num",N},{"start",Start},{"what",What}] =
+ httpd:parse_query(Input),
+ Tags = related_tags(What),
+ TW = truncated_warning(Tags),
+ Next = get_next(File,list_to_integer(Pos),list_to_integer(N),
+ list_to_integer(Start),What),
+ Reply = crashdump_viewer_html:next(Next,TW),
+ {reply,Reply,State};
+handle_call(general_info,_From,State=#state{file=File}) ->
+ GenInfo=general_info(File),
+ Reply = crashdump_viewer_html:general_info(GenInfo),
+ {reply,Reply,State};
+handle_call(procs_summary,_From,State=#state{file=File,shared_heap=SH}) ->
+ ProcsSummary =
+ case State#state.procs_summary of
+ undefined -> procs_summary(File);
+ PS -> PS
+ end,
+ TW = truncated_warning(["=proc"]),
+ Reply = crashdump_viewer_html:procs_summary("pid",ProcsSummary,TW,SH),
+ {reply,Reply,State#state{procs_summary=ProcsSummary,sorted="pid"}};
+handle_call({sort_procs,Input}, _From, State=#state{shared_heap=SH}) ->
+ {ok,Sort} = get_value("sort",httpd:parse_query(Input)),
+ {ProcsSummary,Sorted} = do_sort_procs(Sort,
+ State#state.procs_summary,
+ State#state.sorted),
+ TW = truncated_warning(["=proc"]),
+ Reply = crashdump_viewer_html:procs_summary(Sort,ProcsSummary,TW,SH),
+ {reply,Reply,State#state{sorted=Sorted}};
+handle_call({proc_details,Input},_From,State=#state{file=File,shared_heap=SH}) ->
+ {ok,Pid} = get_value("pid",httpd:parse_query(Input)),
+ Reply =
+ case get_proc_details(File,Pid) of
+ {ok,Proc} ->
+ TW = truncated_warning([{"=proc",Pid}]),
+ crashdump_viewer_html:proc_details(Pid,Proc,TW,SH);
+ {other_node,Node} ->
+ TW = truncated_warning(["=visible_node",
+ "=hidden_node",
+ "=not_connected"]),
+ crashdump_viewer_html:nods(Node,TW);
+ not_found ->
+ crashdump_viewer_html:info_page(["Could not find process: ",
+ Pid],?space)
+ end,
+ {reply, Reply, State};
+handle_call({ports,Input},_From,State=#state{file=File}) ->
+ Reply =
+ case get_value("port",httpd:parse_query(Input)) of
+ {ok,P} ->
+ Id = [$#|P],
+ case get_port(File,Id) of
+ {ok,PortInfo} ->
+ TW = truncated_warning([{"=port",Id}]),
+ crashdump_viewer_html:ports(Id,[PortInfo],TW);
+ {other_node,Node} ->
+ TW = truncated_warning(["=visible_node",
+ "=hidden_node",
+ "=not_connected"]),
+ crashdump_viewer_html:nods(Node,TW);
+ not_found ->
+ crashdump_viewer_html:info_page(
+ ["Could not find port: ",Id],?space)
+ end;
+ error -> % no port identity in Input - get all ports
+ Ports=get_ports(File),
+ TW = truncated_warning(["=port"]),
+ crashdump_viewer_html:ports("Port Information",Ports,TW)
+ end,
+ {reply,Reply,State};
+handle_call({ets_tables,Input},_From,State=#state{file=File,wordsize=WS}) ->
+ {Pid,Heading,InternalEts} =
+ case get_value("pid",httpd:parse_query(Input)) of
+ {ok,P} ->
+ {P,["ETS Tables for Process ",P],[]};
+ error ->
+ I = get_internal_ets_tables(File,WS),
+ {'_',"ETS Table Information",I}
+ end,
+ EtsTables = get_ets_tables(File,Pid,WS),
+ TW = truncated_warning(["=ets"]),
+ Reply = crashdump_viewer_html:ets_tables(Heading,EtsTables,InternalEts,TW),
+ {reply,Reply,State};
+handle_call({timers,Input},_From,State=#state{file=File}) ->
+ {Pid,Heading} =
+ case get_value("pid",httpd:parse_query(Input)) of
+ {ok,P} -> {P,["Timers for Process ",P]};
+ error -> {'_',"Timer Information"}
+ end,
+ Timers=get_timers(File,Pid),
+ TW = truncated_warning(["=timer"]),
+ Reply = crashdump_viewer_html:timers(Heading,Timers,TW),
+ {reply,Reply,State};
+handle_call(dist_info,_From,State=#state{file=File}) ->
+ Nods=nods(File),
+ TW = truncated_warning(["=visible_node","=hidden_node","=not_connected"]),
+ Reply = crashdump_viewer_html:nods(Nods,TW),
+ {reply,Reply,State};
+handle_call(loaded_mods,_From,State=#state{file=File}) ->
+ LoadedMods=loaded_mods(File),
+ TW = truncated_warning(["=mod"]),
+ Reply = crashdump_viewer_html:loaded_mods(LoadedMods,TW),
+ {reply,Reply,State};
+handle_call({loaded_mod_details,Input},_From,State=#state{file=File}) ->
+ {ok,Mod} = get_value("mod",httpd:parse_query(Input)),
+ ModInfo = get_loaded_mod_details(File,Mod),
+ TW = truncated_warning([{"=mod",Mod}]),
+ Reply = crashdump_viewer_html:loaded_mod_details(ModInfo,TW),
+ {reply,Reply,State};
+handle_call(funs,_From,State=#state{file=File}) ->
+ Funs=funs(File),
+ TW = truncated_warning(["=fun"]),
+ Reply = crashdump_viewer_html:funs(Funs,TW),
+ {reply,Reply,State};
+handle_call(atoms,_From,State=#state{file=File,num_atoms=Num}) ->
+ Atoms=atoms(File),
+ TW = truncated_warning(["=atoms","=num_atoms"]),
+ Reply = crashdump_viewer_html:atoms(Atoms,Num,TW),
+ {reply,Reply,State};
+handle_call(memory,_From,State=#state{file=File}) ->
+ Memory=memory(File),
+ TW = truncated_warning(["=memory"]),
+ Reply = crashdump_viewer_html:memory(Memory,TW),
+ {reply,Reply,State};
+handle_call(allocated_areas,_From,State=#state{file=File}) ->
+ AllocatedAreas=allocated_areas(File),
+ TW = truncated_warning(["=allocated_areas"]),
+ Reply = crashdump_viewer_html:allocated_areas(AllocatedAreas,TW),
+ {reply,Reply,State};
+handle_call(allocator_info,_From,State=#state{file=File}) ->
+ SlAlloc=allocator_info(File),
+ TW = truncated_warning(["=allocator"]),
+ Reply = crashdump_viewer_html:allocator_info(SlAlloc,TW),
+ {reply,Reply,State};
+handle_call(hash_tables,_From,State=#state{file=File}) ->
+ HashTables=hash_tables(File),
+ TW = truncated_warning(["=hash_table","=index_table"]),
+ Reply = crashdump_viewer_html:hash_tables(HashTables,TW),
+ {reply,Reply,State};
+handle_call(index_tables,_From,State=#state{file=File}) ->
+ IndexTables=index_tables(File),
+ TW = truncated_warning(["=hash_table","=index_table"]),
+ Reply = crashdump_viewer_html:index_tables(IndexTables,TW),
+ {reply,Reply,State}.
+
+
+
+%%--------------------------------------------------------------------
+%% Function: handle_cast/2
+%% Description: Handling cast messages
+%% Returns: {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%%--------------------------------------------------------------------
+handle_cast({background_done,{Page,File,Binaries},Dict}, State) ->
+ lists:foreach(fun({Key,Val}) -> put(Key,Val) end, Dict),
+ {noreply, State#state{file=File,binaries=Binaries,bg_status={done,Page}}};
+handle_cast({background_status,Status}, State) ->
+ {noreply, State#state{bg_status=Status}}.
+
+%%--------------------------------------------------------------------
+%% Function: handle_info/2
+%% Description: Handling all non call/cast messages
+%% Returns: {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%%--------------------------------------------------------------------
+handle_info(_Info, State) ->
+ {noreply, State}.
+
+%%--------------------------------------------------------------------
+%% Function: terminate/2
+%% Description: Shutdown the server
+%% Returns: any (ignored by gen_server)
+%%--------------------------------------------------------------------
+terminate(_Reason, _State) ->
+ ok.
+
+%%--------------------------------------------------------------------
+%% Func: code_change/3
+%% Purpose: Convert process state when code is changed
+%% Returns: {ok, NewState}
+%%--------------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+call(Request) ->
+ gen_server:call(?SERVER,Request,?call_timeout).
+
+cast(Msg) ->
+ gen_server:cast(?SERVER,Msg).
+
+unexpected(_Fd,{eof,_LastLine},_Where) ->
+ ok; % truncated file
+unexpected(Fd,{part,What},Where) ->
+ skip_rest_of_line(Fd),
+ io:format("WARNING: Found unexpected line in ~s:~n~s ...~n",[Where,What]);
+unexpected(_Fd,What,Where) ->
+ io:format("WARNING: Found unexpected line in ~s:~n~s~n",[Where,What]).
+
+truncated_warning([]) ->
+ [];
+truncated_warning([Tag|Tags]) ->
+ case truncated_here(Tag) of
+ true -> truncated_warning();
+ false -> truncated_warning(Tags)
+ end.
+truncated_warning() ->
+ ["WARNING: The crash dump is truncated here. "
+ "Some information might be missing."].
+
+truncated_here(Tag) ->
+ case get(truncated) of
+ true ->
+ case get(last_tag) of
+ Tag -> % Tag == {TagType,Id}
+ true;
+ {Tag,_Id} ->
+ true;
+ _LastTag ->
+ truncated_earlier(Tag)
+ end;
+ false ->
+ false
+ end.
+
+
+%% Check if the dump was truncated with the same tag, but earlier id.
+%% Eg if this is {"=proc","<0.30.0>"}, we should warn if the dump was
+%% truncated in {"=proc","<0.29.0>"} or earlier
+truncated_earlier({"=proc",Pid}) ->
+ compare_pid(Pid,get(truncated_proc));
+truncated_earlier(_Tag) ->
+ false.
+
+compare_pid("<"++Id,"<"++OtherId) ->
+ Id>=OtherId;
+compare_pid(_,_) ->
+ false.
+
+background_status(Action,File) ->
+ SizeInfo = filesizeinfo(File),
+ background_status(Action,File,SizeInfo).
+
+background_status(processing,File,SizeInfo) ->
+ "Processing " ++ File ++ SizeInfo;
+background_status(reading,File,SizeInfo) ->
+ "Reading file " ++ File ++ SizeInfo.
+
+filesizeinfo(File) ->
+ case file:read_file_info(File) of
+ {ok,#file_info{size=Size}} ->
+ " (" ++ integer_to_list(Size) ++ " bytes)";
+ _X ->
+ ""
+ end.
+
+
+open(File) ->
+ {ok,Fd} = file:open(File,[read,read_ahead,raw,binary]),
+ Fd.
+close(Fd) ->
+ erase(chunk),
+ file:close(Fd).
+pos_bof(Fd,Pos) ->
+ reset_chunk(),
+ file:position(Fd,{bof,Pos}).
+
+get_chunk(Fd) ->
+ case erase(chunk) of
+ undefined ->
+ case read(Fd) of
+ eof ->
+ put_pos(Fd),
+ eof;
+ Other ->
+ Other
+ end;
+ Bin ->
+ {ok,Bin}
+ end.
+
+read(Fd) ->
+ file:read(Fd,?chunk_size).
+
+put_chunk(Fd,Bin) ->
+ {ok,Pos0} = file:position(Fd,cur),
+ Pos = Pos0 - byte_size(Bin),
+ put(chunk,Bin),
+ put(pos,Pos).
+
+put_pos(Fd) ->
+ {ok,Pos} = file:position(Fd,cur),
+ put(pos,Pos).
+
+reset_chunk() ->
+ erase(chunk),
+ erase(pos).
+
+line_head(Fd) ->
+ case get_chunk(Fd) of
+ {ok,Bin} -> line_head(Fd,Bin,[],0);
+ eof -> {eof,[]}
+ end.
+line_head(Fd,Bin,Acc,?max_line_size) ->
+ put_chunk(Fd,Bin),
+ {part,lists:reverse(Acc)};
+line_head(Fd,<<$\n:8,Bin/binary>>,Acc,_N) ->
+ put_chunk(Fd,Bin),
+ lists:reverse(Acc);
+line_head(Fd,<<$::8,$\r:8,$\n:8,Bin/binary>>,Acc,_N) ->
+ put_chunk(Fd,Bin),
+ lists:reverse(Acc);
+line_head(Fd,<<$::8,$\r:8>>,Acc,N) ->
+ case get_chunk(Fd) of
+ {ok,Bin} -> line_head(Fd,<<$:,Bin/binary>>,Acc,N);
+ eof -> {eof,lists:reverse(Acc)}
+ end;
+line_head(Fd,<<$::8>>,Acc,N) ->
+ case get_chunk(Fd) of
+ {ok,Bin} -> line_head(Fd,<<$:,Bin/binary>>,Acc,N);
+ eof -> {eof,lists:reverse(Acc)}
+ end;
+line_head(Fd,<<$::8,Space:8,Bin/binary>>,Acc,_N) when Space=:=$ ;Space=:=$\n ->
+ put_chunk(Fd,Bin),
+ lists:reverse(Acc);
+line_head(Fd,<<$::8,Bin/binary>>,Acc,_N) ->
+ put_chunk(Fd,Bin),
+ lists:reverse(Acc);
+line_head(Fd,<<$\r:8,Bin/binary>>,Acc,N) ->
+ line_head(Fd,Bin,Acc,N+1);
+line_head(Fd,<<Char:8,Bin/binary>>,Acc,N) ->
+ line_head(Fd,Bin,[Char|Acc],N+1);
+line_head(Fd,<<>>,Acc,N) ->
+ case get_chunk(Fd) of
+ {ok,Bin} -> line_head(Fd,Bin,Acc,N);
+ eof -> {eof,lists:reverse(Acc)}
+ end.
+
+skip_rest_of_line(Fd) ->
+ case get_chunk(Fd) of
+ {ok,Bin} -> skip(Fd,Bin);
+ eof -> ok
+ end.
+skip(Fd,<<$\n:8,Bin/binary>>) ->
+ put_chunk(Fd,Bin),
+ ok;
+skip(Fd,<<_Char:8,Bin/binary>>) ->
+ skip(Fd,Bin);
+skip(Fd,<<>>) ->
+ case get_chunk(Fd) of
+ {ok,Bin} -> skip(Fd,Bin);
+ eof -> ok
+ end.
+
+
+val(Fd) ->
+ case get_rest_of_line(Fd) of
+ {eof,[]} -> "-1";
+ [] -> "-1";
+ {eof,Val} -> Val;
+ Val -> Val
+ end.
+
+get_rest_of_line(Fd) ->
+ case get_chunk(Fd) of
+ {ok,Bin} -> get_rest_of_line_1(Fd, Bin, []);
+ eof -> {eof,[]}
+ end.
+
+get_rest_of_line_1(Fd, <<$\n:8,Bin/binary>>, Acc) ->
+ put_chunk(Fd, Bin),
+ lists:reverse(Acc);
+get_rest_of_line_1(Fd, <<$\r:8,Rest/binary>>, Acc) ->
+ get_rest_of_line_1(Fd, Rest, Acc);
+get_rest_of_line_1(Fd, <<Char:8,Rest/binary>>, Acc) ->
+ get_rest_of_line_1(Fd, Rest, [Char|Acc]);
+get_rest_of_line_1(Fd, <<>>, Acc) ->
+ case get_chunk(Fd) of
+ {ok,Bin} -> get_rest_of_line_1(Fd, Bin, Acc);
+ eof -> {eof,lists:reverse(Acc)}
+ end.
+
+count_rest_of_line(Fd) ->
+ case get_chunk(Fd) of
+ {ok,Bin} -> count_rest_of_line(Fd,Bin,0);
+ eof -> {eof,0}
+ end.
+count_rest_of_line(Fd,<<$\n:8,Bin/binary>>,N) ->
+ put_chunk(Fd,Bin),
+ N;
+count_rest_of_line(Fd,<<$\r:8,Bin/binary>>,N) ->
+ count_rest_of_line(Fd,Bin,N);
+count_rest_of_line(Fd,<<_Char:8,Bin/binary>>,N) ->
+ count_rest_of_line(Fd,Bin,N+1);
+count_rest_of_line(Fd,<<>>,N) ->
+ case get_chunk(Fd) of
+ {ok,Bin} -> count_rest_of_line(Fd,Bin,N);
+ eof -> {eof,N}
+ end.
+
+get_n_lines_of_tag(Fd,N) ->
+ case get_chunk(Fd) of
+ {ok,Bin} ->
+ {AllOrPart,Rest,Lines} = get_n_lines_of_tag(Fd,N,Bin,[]),
+ {AllOrPart,N-Rest,Lines};
+ eof ->
+ empty
+ end.
+get_n_lines_of_tag(Fd,N,<<"\n=",_/binary>>=Bin,Acc) ->
+ put_chunk(Fd,Bin),
+ {all,N-1,lists:reverse(Acc)};
+get_n_lines_of_tag(Fd,0,Bin,Acc) ->
+ put_chunk(Fd,Bin),
+ {part,0,lists:reverse(Acc)};
+get_n_lines_of_tag(Fd,N,<<$\n:8,Bin/binary>>,Acc) ->
+ get_n_lines_of_tag(Fd,N-1,Bin,[$\n|Acc]);
+get_n_lines_of_tag(Fd,N,<<$\r:8,Bin/binary>>,Acc) ->
+ get_n_lines_of_tag(Fd,N,Bin,Acc);
+get_n_lines_of_tag(Fd,N,<<Char:8,Bin/binary>>,Acc) ->
+ get_n_lines_of_tag(Fd,N,Bin,[Char|Acc]);
+get_n_lines_of_tag(Fd,N,<<>>,Acc) ->
+ case get_chunk(Fd) of
+ {ok,Bin} ->
+ get_n_lines_of_tag(Fd,N,Bin,Acc);
+ eof ->
+ case Acc of
+ [$\n|_] ->
+ {all,N,lists:reverse(Acc)};
+ _ ->
+ {all,N-1,lists:reverse(Acc)}
+ end
+ end.
+
+count_rest_of_tag(Fd) ->
+ case get_chunk(Fd) of
+ {ok,Bin} -> count_rest_of_tag(Fd,Bin,0);
+ eof -> 0
+ end.
+count_rest_of_tag(Fd,<<"\n=",Bin/binary>>,N) ->
+ put_chunk(Fd,Bin),
+ N;
+count_rest_of_tag(Fd,<<$\r:8,Bin/binary>>,N) ->
+ count_rest_of_tag(Fd,Bin,N);
+count_rest_of_tag(Fd,<<_Char:8,Bin/binary>>,N) ->
+ count_rest_of_tag(Fd,Bin,N+1);
+count_rest_of_tag(Fd,<<>>,N) ->
+ case get_chunk(Fd) of
+ {ok,Bin} -> count_rest_of_tag(Fd,Bin,N);
+ eof -> N
+ end.
+
+split(Str) ->
+ split($ ,Str,[]).
+split(Char,Str) ->
+ split(Char,Str,[]).
+split(Char,[Char|Str],Acc) -> % match Char
+ {lists:reverse(Acc),Str};
+split(_Char,[$\r,$\n|Str],Acc) -> % new line
+ {lists:reverse(Acc),Str};
+split(_Char,[$\n|Str],Acc) -> % new line
+ {lists:reverse(Acc),Str};
+split(Char,[H|T],Acc) ->
+ split(Char,T,[H|Acc]);
+split(_Char,[],Acc) ->
+ {lists:reverse(Acc),[]}.
+
+size_or_term(Fd) ->
+ size_or_term(Fd,get(pos)).
+size_or_term(Fd,Pos) ->
+ case count_rest_of_line(Fd) of
+ {eof,Size} ->
+ {size,true,Size,Pos};
+ Size when Size > ?max_display_size ->
+ {size,false,Size,Pos};
+ _Size ->
+ {ok,Pos} = pos_bof(Fd,Pos),
+ val(Fd)
+ end.
+
+%%%-----------------------------------------------------------------
+%%%
+get_value(Key,List) ->
+ case lists:keysearch(Key,1,List) of
+ {value,{Key,Value}} -> {ok,Value};
+ false -> error
+ end.
+
+parse_vsn_str([],WS,false) ->
+ %% If the log is translated, crashdump_translate might have written
+ %% shared_heap=true in dictionary.
+ case erase(shared_heap) of
+ true -> {WS,true};
+ _ -> {WS,false}
+ end;
+parse_vsn_str([],WS,SH) ->
+ {WS,SH};
+parse_vsn_str(Str,WS,SH) ->
+ case Str of
+ "[64-bit]" ++ Rest ->
+ case SH of
+ false ->
+ parse_vsn_str(Rest,8,false);
+ _ ->
+ {8,SH}
+ end;
+ "[shared heap]" ++ Rest ->
+ case WS of
+ 4 ->
+ parse_vsn_str(Rest,WS,true);
+ _ ->
+ {WS,true}
+ end;
+ [_Char|Rest] ->
+ parse_vsn_str(Rest,WS,SH)
+ end.
+
+
+%%%-----------------------------------------------------------------
+%%%
+initial_menu() ->
+ insert_items(
+ [menu_item(0, {"./general_info","General information"},0),
+ menu_item(0, {"./processes","Processes"}, 0),
+ menu_item(0, {"./ports","Ports"}, 0),
+ menu_item(0, {"./ets_tables","ETS tables"}, 0),
+ menu_item(0, {"./timers","Timers"}, 0),
+ menu_item(0, {"./fun_table","Fun table"}, 0),
+ menu_item(0, {"./atoms","Atoms"}, 0),
+ menu_item(0, {"./dist_info","Distribution information"}, 0),
+ menu_item(0, {"./loaded_modules","Loaded modules"}, 0),
+ menu_item(2, "Internal Tables", 0),
+ menu_item(0, {"./hash_tables","Hash tables"}, 1),
+ menu_item(0, {"./index_tables","Index tables"}, 1),
+ menu_item(3, "Memory information", 0),
+ menu_item(0, {"./memory","Memory"}, 1),
+ menu_item(0, {"./allocated_areas","Allocated areas"}, 1),
+ menu_item(0, {"./allocator_info","Allocator information"}, 1),
+ menu_item(2, "Documentation", 0),
+ menu_item(0, {"/crashdump_doc/crashdump_help.html",
+ "Crashdump Viewer help"}, 1,"doc"),
+ menu_item(0, {"/crashdump_erts_doc/crash_dump.html",
+ "How to interpret Erlang crashdumps"}, 1,"doc")]).
+
+menu_item(Children,Text,Depth) ->
+ menu_item(Children,Text,Depth,"main").
+menu_item(Children,Text,Depth,Target) ->
+ #menu_item{picture=get_pic(Children),
+ text=Text,
+ depth=Depth,
+ children=Children,
+ state=if Depth==0 -> true; true -> false end,
+ target=Target}.
+
+insert_items(Items) ->
+ insert_items(Items,1).
+insert_items([Item|Items],Index) ->
+ ets:insert(cdv_menu_table,Item#menu_item{index=Index}),
+ insert_items(Items,Index+1);
+insert_items([],_) ->
+ ok.
+
+get_pic(0) ->
+ "";
+get_pic(_) ->
+ "/crashdump_viewer/collapsd.gif".
+
+do_toggle(Index) ->
+ [Item]= ets:lookup(cdv_menu_table,Index),
+ case toggle_children(Index,Index+Item#menu_item.children,
+ Item#menu_item.depth+1,undefined) of
+ true ->
+ ets:insert(cdv_menu_table,
+ Item#menu_item{picture=
+ "/crashdump_viewer/exploded.gif"});
+ false ->
+ ets:insert(cdv_menu_table,
+ Item#menu_item{picture=
+ "/crashdump_viewer/collapsd.gif"})
+ end.
+
+toggle_children(Index,Max,_Depth,ToggleState) when Index>Max->
+ ToggleState;
+toggle_children(Index,Max,Depth,ToggleState) ->
+ case ets:lookup(cdv_menu_table,Index+1) of
+ [#menu_item{depth=Depth}=Child] ->
+ NewState = not Child#menu_item.state,
+ ets:insert(cdv_menu_table,Child#menu_item{state=NewState}),
+ toggle_children(Index+1,Max,Depth,NewState);
+ _ ->
+ toggle_children(Index+1,Max,Depth,ToggleState)
+ end.
+
+%%%-----------------------------------------------------------------
+%%% Traverse crash dump and insert index in table for each heading
+%%%
+%%% This function is executed in a background process in order to
+%%% avoid a timeout in the web browser. The browser displays "Please
+%%% wait..." while this is going on.
+%%%
+%%% Variable written to process dictionary in this function are copied
+%%% to the crashdump_viewer_server when the function is completed (see
+%%% background_done/1).
+read_file(File) ->
+ case file:read_file_info(File) of
+ {ok,#file_info{type=regular,access=FileA}} when FileA=:=read;
+ FileA=:=read_write ->
+ Fd = open(File),
+ case read(Fd) of
+ {ok,<<$=:8,TagAndRest/binary>>} ->
+ {Tag,Id,Rest,N1} = tag(Fd,TagAndRest,1),
+ case Tag of
+ "=erl_crash_dump" ->
+ ets:delete_all_objects(cdv_dump_index_table),
+ ets:insert(cdv_dump_index_table,{Tag,Id,N1+1}),
+ put(last_tag,{Tag,""}),
+ Status = background_status(processing,File),
+ background_status(Status),
+ indexify(Fd,Rest,N1),
+ check_if_truncated(),
+ initial_menu(),
+ Binaries = read_binaries(Fd),
+ R = crashdump_viewer_html:start_page(),
+ close(Fd),
+ background_done({R,File,Binaries});
+ _Other ->
+ R = crashdump_viewer_html:error(
+ "~s is not an Erlang crash dump~n",
+ [File]),
+ close(Fd),
+ background_done({R,undefined,undefined})
+ end;
+ {ok,<<"<Erlang crash dump>",_Rest/binary>>} ->
+ %% old version - no longer supported
+ R = crashdump_viewer_html:error(
+ "The crashdump ~s is in the pre-R10B format, "
+ "which is no longer supported.~n",
+ [File]),
+ close(Fd),
+ background_done({R,undefined,undefined});
+ _Other ->
+ R = crashdump_viewer_html:error(
+ "~s is not an Erlang crash dump~n",
+ [File]),
+ close(Fd),
+ background_done({R,undefined,undefined})
+ end;
+ _other ->
+ R = crashdump_viewer_html:error("~s is not an Erlang crash dump~n",
+ [File]),
+ background_done({R,undefined,undefined})
+ end.
+
+indexify(Fd,<<"\n=",TagAndRest/binary>>,N) ->
+ {Tag,Id,Rest,N1} = tag(Fd,TagAndRest,N+2),
+ ets:insert(cdv_dump_index_table,{Tag,Id,N1+1}), % +1 to get past newline
+ put(last_tag,{Tag,Id}),
+ indexify(Fd,Rest,N1);
+indexify(Fd,<<>>,N) ->
+ case read(Fd) of
+ {ok,Chunk} when is_binary(Chunk) ->
+ indexify(Fd,Chunk,N);
+ eof ->
+ eof
+ end;
+indexify(Fd,<<$\n>>,N) ->
+ %% This clause is needed in case the chunk ends with a newline and
+ %% the next chunk starts with a tag (i.e. "\n=....")
+ case read(Fd) of
+ {ok,Chunk} when is_binary(Chunk) ->
+ indexify(Fd,<<$\n,Chunk/binary>>,N);
+ eof ->
+ eof
+ end;
+indexify(Fd,<<_Char:8,Rest/binary>>,N) ->
+ indexify(Fd,Rest,N+1).
+
+tag(Fd,Bin,N) ->
+ tag(Fd,Bin,N,[],[],tag).
+tag(_Fd,<<$\n:8,_/binary>>=Rest,N,Gat,Di,_Now) ->
+ {[$=|lists:reverse(Gat)],lists:reverse(Di),Rest,N};
+tag(Fd,<<$\r:8,Rest/binary>>,N,Gat,Di,Now) ->
+ tag(Fd,Rest,N+1,Gat,Di,Now);
+tag(Fd,<<$::8,IdAndRest/binary>>,N,Gat,Di,tag) ->
+ tag(Fd,IdAndRest,N+1,Gat,Di,id);
+tag(Fd,<<Char:8,Rest/binary>>,N,Gat,Di,tag) ->
+ tag(Fd,Rest,N+1,[Char|Gat],Di,tag);
+tag(Fd,<<Char:8,Rest/binary>>,N,Gat,Di,id) ->
+ tag(Fd,Rest,N+1,Gat,[Char|Di],id);
+tag(Fd,<<>>,N,Gat,Di,Now) ->
+ case read(Fd) of
+ {ok,Chunk} when is_binary(Chunk) ->
+ tag(Fd,Chunk,N,Gat,Di,Now);
+ eof ->
+ {[$=|lists:reverse(Gat)],lists:reverse(Di),<<>>,N}
+ end.
+
+check_if_truncated() ->
+ case get(last_tag) of
+ {"=end",_} ->
+ put(truncated,false),
+ put(truncated_proc,false);
+ TruncatedTag ->
+ put(truncated,true),
+ find_truncated_proc(TruncatedTag)
+ end.
+
+find_truncated_proc({"=atom",_Id}) ->
+ put(truncated_proc,false);
+find_truncated_proc({Tag,Pid}) ->
+ case is_proc_tag(Tag) of
+ true ->
+ put(truncated_proc,Pid);
+ false ->
+ %% This means that the dump is truncated between "=proc" and
+ %% "=proc_heap" => memory info is missing for all procs.
+ put(truncated_proc,"<0.0.0>")
+ end.
+
+is_proc_tag(Tag) when Tag=="=proc";
+ Tag=="=proc_dictionary";
+ Tag=="=proc_messages";
+ Tag=="=proc_dictionary";
+ Tag=="=debug_proc_dictionary";
+ Tag=="=proc_stack";
+ Tag=="=proc_heap" ->
+ true;
+is_proc_tag(_) ->
+ false.
+
+related_tags("Atoms") ->
+ ["=atoms","=num_atoms"].
+
+%%% Inform the crashdump_viewer_server that a background job is completed.
+background_done(Result) ->
+ Dict = get(),
+ cast({background_done,Result,Dict}).
+
+background_status(Status) ->
+ cast({background_status,Status}).
+
+%%%-----------------------------------------------------------------
+%%% Functions for reading information from the dump
+general_info(File) ->
+ [{"=erl_crash_dump",_Id,Start}] =
+ ets:lookup(cdv_dump_index_table,"=erl_crash_dump"),
+ Fd = open(File),
+ pos_bof(Fd,Start),
+ Created = case get_rest_of_line(Fd) of
+ {eof,SomeOfLine} -> SomeOfLine;
+ WholeLine -> WholeLine
+ end,
+
+ GI0 = get_general_info(Fd,#general_info{created=Created,_=?space}),
+ GI = case GI0#general_info.num_atoms of
+ ?space -> GI0#general_info{num_atoms=get_num_atoms(Fd)};
+ _ -> GI0
+ end,
+
+ {MemTot,MemMax} =
+ case ets:lookup(cdv_dump_index_table,"=memory") of
+ [{"=memory",_,MemStart}] ->
+ pos_bof(Fd,MemStart),
+ Memory = get_meminfo(Fd,[]),
+ Tot = case lists:keysearch("total",1,Memory) of
+ {value,{_,T}} -> T;
+ false -> ""
+ end,
+ Max = case lists:keysearch("maximum",1,Memory) of
+ {value,{_,M}} -> M;
+ false -> ""
+ end,
+ {Tot,Max};
+ _ ->
+ {"",""}
+ end,
+
+ close(Fd),
+ {NumProcs,NumEts,NumFuns} = count(),
+ NodeName =
+ case ets:lookup(cdv_dump_index_table,"=node") of
+ [{"=node",N,_Start}] ->
+ N;
+ [] ->
+ case ets:lookup(cdv_dump_index_table,"=no_distribution") of
+ [_] -> "nonode@nohost";
+ [] -> "unknown"
+ end
+ end,
+
+ InstrInfo =
+ case ets:member(cdv_dump_index_table,"=old_instr_data") of
+ true ->
+ old_instr_data;
+ false ->
+ case ets:member(cdv_dump_index_table,"=instr_data") of
+ true ->
+ instr_data;
+ false ->
+ false
+ end
+ end,
+ GI#general_info{node_name=NodeName,
+ num_procs=integer_to_list(NumProcs),
+ num_ets=integer_to_list(NumEts),
+ num_fun=integer_to_list(NumFuns),
+ mem_tot=MemTot,
+ mem_max=MemMax,
+ instr_info=InstrInfo}.
+
+get_general_info(Fd,GenInfo) ->
+ case line_head(Fd) of
+ "Slogan" ->
+ get_general_info(Fd,GenInfo#general_info{slogan=val(Fd)});
+ "System version" ->
+ get_general_info(Fd,GenInfo#general_info{system_vsn=val(Fd)});
+ "Compiled" ->
+ get_general_info(Fd,GenInfo#general_info{compile_time=val(Fd)});
+ "Atoms" ->
+ get_general_info(Fd,GenInfo#general_info{num_atoms=val(Fd)});
+ "=" ++ _next_tag ->
+ GenInfo;
+ Other ->
+ unexpected(Fd,Other,"general information"),
+ GenInfo
+ end.
+
+get_num_atoms(Fd) ->
+ case ets:match(cdv_dump_index_table,{"=hash_table","atom_tab",'$1'}) of
+ [[Pos]] ->
+ pos_bof(Fd,Pos),
+ skip_rest_of_line(Fd), % size
+ skip_rest_of_line(Fd), % used
+ case line_head(Fd) of
+ "objs" ->
+ val(Fd);
+ _1 ->
+ get_num_atoms2()
+ end;
+ [] ->
+ get_num_atoms2()
+ end.
+get_num_atoms2() ->
+ case ets:lookup(cdv_dump_index_table,"=num_atoms") of
+ [] ->
+ ?space;
+ [{"=num_atoms",NA,_Pos}] ->
+ %% If dump is translated this will exist
+ case get(truncated) of
+ true ->
+ [NA," (visible in dump)"]; % might be more
+ false ->
+ NA
+ end
+ end.
+
+count() ->
+ {ets:select_count(cdv_dump_index_table,count_ms("=proc")),
+ ets:select_count(cdv_dump_index_table,count_ms("=ets")),
+ ets:select_count(cdv_dump_index_table,count_ms("=fun"))}.
+
+count_ms(Tag) ->
+ [{{Tag,'_','_'},[],[true]}].
+
+
+procs_summary(File) ->
+ AllProcs = ets:lookup(cdv_dump_index_table,"=proc"),
+ Fd = open(File),
+ R = lists:map(fun({"=proc",Pid,Start}) ->
+ pos_bof(Fd,Start),
+ get_procinfo(Fd,fun main_procinfo/4,
+ ?initial_proc_record(Pid))
+ end,
+ AllProcs),
+ close(Fd),
+ R.
+
+get_proc_details(File,Pid) ->
+ DumpVsn = ets:lookup_element(cdv_dump_index_table,"=erl_crash_dump",2),
+ case ets:match(cdv_dump_index_table,{"=proc",Pid,'$1'}) of
+ [[Start]] ->
+ Fd = open(File),
+ pos_bof(Fd,Start),
+ Proc0 =
+ case DumpVsn of
+ "0.0" ->
+ %% Old version (translated)
+ ?initial_proc_record(Pid);
+ _ ->
+ (?initial_proc_record(Pid))#proc{
+ stack_dump=if_exist("=proc_stack",Pid),
+ msg_q=if_exist("=proc_messages",Pid),
+ dict=if_exist("=proc_dictionary",Pid),
+ debug_dict=if_exist("=debug_proc_dictionary",Pid)}
+ end,
+ Proc = get_procinfo(Fd,fun all_procinfo/4,Proc0),
+ close(Fd),
+ {ok,Proc};
+ _ ->
+ case maybe_other_node(File,Pid) of
+ {other_node,Type,Node} ->
+ Info = "The process you are searching for was residing on "
+ "a remote node. No process information is available. "
+ "Information about the remote node is show below.",
+ {other_node,{Type,Info,Node}};
+ not_found ->
+ not_found
+ end
+ end.
+
+if_exist(Tag,Key) ->
+ case ets:select_count(cdv_dump_index_table,[{{Tag,Key,'_'},[],[true]}]) of
+ 0 ->
+ Tag1 =
+ case is_proc_tag(Tag) of
+ true -> "=proc";
+ false -> Tag
+ end,
+ case truncated_here({Tag1,Key}) of
+ true -> truncated;
+ false -> ?space
+ end;
+ _ ->
+ expand
+ end.
+
+get_procinfo(Fd,Fun,Proc) ->
+ case line_head(Fd) of
+ "State" ->
+ State = case val(Fd) of
+ "Garbing" -> "Garbing\n(limited info)";
+ State0 -> State0
+ end,
+ get_procinfo(Fd,Fun,Proc#proc{state=State});
+ "Name" ->
+ get_procinfo(Fd,Fun,Proc#proc{name=val(Fd)});
+ "Spawned as" ->
+ IF = val(Fd),
+ case Proc#proc.name of
+ ?space ->
+ get_procinfo(Fd,Fun,Proc#proc{name=IF,init_func=IF});
+ _ ->
+ get_procinfo(Fd,Fun,Proc#proc{init_func=IF})
+ end;
+ "Spawned by" ->
+ case val(Fd) of
+ "[]" ->
+ get_procinfo(Fd,Fun,Proc);
+ Parent ->
+ get_procinfo(Fd,Fun,Proc#proc{parent=Parent})
+ end;
+ "Started" ->
+ get_procinfo(Fd,Fun,Proc#proc{start_time=val(Fd)});
+ "Last scheduled in for" ->
+ get_procinfo(Fd,Fun,Proc#proc{current_func=
+ {"Last scheduled in for",
+ val(Fd)}});
+ "Current call" ->
+ get_procinfo(Fd,Fun,Proc#proc{current_func={"Current call",
+ val(Fd)}});
+ "Message queue length" ->
+ %% stored as integer so we can sort on it
+ get_procinfo(Fd,Fun,Proc#proc{msg_q_len=list_to_integer(val(Fd))});
+ "Reductions" ->
+ %% stored as integer so we can sort on it
+ get_procinfo(Fd,Fun,Proc#proc{reds=list_to_integer(val(Fd))});
+ "Number of heap fragments" ->
+ get_procinfo(Fd,Fun,Proc#proc{num_heap_frag=val(Fd)});
+ "Heap fragment data" ->
+ get_procinfo(Fd,Fun,Proc#proc{heap_frag_data=val(Fd)});
+ Stack when Stack=:="Stack+heap"; Stack=:="Stack" ->
+ %% stored as integer so we can sort on it
+ get_procinfo(Fd,Fun,Proc#proc{stack_heap=
+ list_to_integer(val(Fd))});
+ "OldHeap" ->
+ get_procinfo(Fd,Fun,Proc#proc{old_heap=val(Fd)});
+ "Heap unused" ->
+ get_procinfo(Fd,Fun,Proc#proc{heap_unused=val(Fd)});
+ "OldHeap unused" ->
+ get_procinfo(Fd,Fun,Proc#proc{old_heap_unused=val(Fd)});
+ "New heap start" ->
+ get_procinfo(Fd,Fun,Proc#proc{new_heap_start=val(Fd)});
+ "New heap top" ->
+ get_procinfo(Fd,Fun,Proc#proc{new_heap_top=val(Fd)});
+ "Stack top" ->
+ get_procinfo(Fd,Fun,Proc#proc{stack_top=val(Fd)});
+ "Stack end" ->
+ get_procinfo(Fd,Fun,Proc#proc{stack_end=val(Fd)});
+ "Old heap start" ->
+ get_procinfo(Fd,Fun,Proc#proc{old_heap_start=val(Fd)});
+ "Old heap top" ->
+ get_procinfo(Fd,Fun,Proc#proc{old_heap_top=val(Fd)});
+ "Old heap end" ->
+ get_procinfo(Fd,Fun,Proc#proc{old_heap_end=val(Fd)});
+ {eof,_} ->
+ Proc; % truncated file
+ Other ->
+ Fun(Fd,Fun,Proc,Other)
+ end.
+
+main_procinfo(Fd,Fun,Proc,LineHead) ->
+ case LineHead of
+ "Stack dump" ->
+ %% This is the last element in older dumps (DumpVsn=0.0)
+ Proc;
+ "=" ++ _next_tag ->
+ %% DumpVsn=0.1 or newer: No stack dump here
+ Proc;
+ "arity = " ++ _ ->
+ %%! Temporary workaround
+ get_procinfo(Fd,Fun,Proc);
+ _Other ->
+ skip_rest_of_line(Fd),
+ get_procinfo(Fd,Fun,Proc)
+ end.
+all_procinfo(Fd,Fun,Proc,LineHead) ->
+ case LineHead of
+ "Message queue" ->
+ get_procinfo(Fd,Fun,Proc#proc{msg_q=size_or_term(Fd)});
+ "Last calls" ->
+ R = case size_or_term(Fd) of
+ SizeThing when is_tuple(SizeThing) ->
+ Proc#proc{last_calls=SizeThing};
+ Term ->
+ Proc#proc{last_calls=replace_all($ ,$\n,Term,[])}
+ end,
+ get_procinfo(Fd,Fun,R);
+ "Link list" ->
+ get_procinfo(Fd,Fun,Proc#proc{links=val(Fd)});
+ "Program counter" ->
+ get_procinfo(Fd,Fun,Proc#proc{prog_count=val(Fd)});
+ "CP" ->
+ get_procinfo(Fd,Fun,Proc#proc{cp=val(Fd)});
+ "arity = " ++ Arity ->
+ %%! Temporary workaround
+ get_procinfo(Fd,Fun,Proc#proc{arity=Arity--"\r\n"});
+ "Dictionary" ->
+ get_procinfo(Fd,Fun,Proc#proc{dict=size_or_term(Fd)});
+ "$Dictionary" ->
+ get_procinfo(Fd,Fun,Proc#proc{debug_dict=size_or_term(Fd)});
+ "Stack dump" ->
+ %% This is the last element in older dumps (DumpVsn=0.0)
+ get_stack_dump(Fd,Proc);
+ "=" ++ _next_tag ->
+ %% DumpVsn=0.1 or newer: No stack dump here
+ Proc;
+ Other ->
+ unexpected(Fd,Other,"process info"),
+ get_procinfo(Fd,Fun,Proc)
+ end.
+
+get_stack_dump(Fd,Proc) ->
+ %% Always show stackdump as "Expand" link
+ Pos = get(pos),
+ Size = count_rest_of_tag(Fd),
+ Proc#proc{stack_dump={size,true,Size,Pos}}.
+
+maybe_other_node(File,Id) ->
+ Channel =
+ case split($.,Id) of
+ {"<" ++ N, _Rest} ->
+ N;
+ {"#Port<" ++ N, _Rest} ->
+ N
+ end,
+ Ms = ets:fun2ms(
+ fun({Tag,Id,Start}) when Tag=:="=visible_node", Id=:=Channel ->
+ {"Visible Node",Start};
+ ({Tag,Id,Start}) when Tag=:="=hidden_node", Id=:=Channel ->
+ {"Hidden Node",Start};
+ ({Tag,Id,Start}) when Tag=:="=not_connected", Id=:=Channel ->
+ {"Not Connected Node",Start}
+ end),
+ case ets:select(cdv_dump_index_table,Ms) of
+ [] ->
+ not_found;
+ [{Type,Pos}] ->
+ Fd = open(File),
+ NodeInfo = get_nodeinfo(Fd,Channel,Pos),
+ close(Fd),
+ {other_node,Type,NodeInfo}
+ end.
+
+expand_memory(File,What,Pid,Binaries) ->
+ Fd = open(File),
+ put(fd,Fd),
+ Dict = read_heap(Fd,Pid,Binaries),
+ Expanded =
+ case What of
+ "StackDump" -> read_stack_dump(Fd,Pid,Dict);
+ "MsgQueue" -> read_messages(Fd,Pid,Dict);
+ "Dictionary" -> read_dictionary(Fd,"=proc_dictionary",Pid,Dict);
+ "DebugDictionary" -> read_dictionary(Fd,"=debug_proc_dictionary",Pid,Dict)
+ end,
+ erase(fd),
+ close(Fd),
+ Expanded.
+
+%%%
+%%% Read binaries.
+%%%
+read_binaries(Fd) ->
+ AllBinaries = ets:match(cdv_dump_index_table,{"=binary",'$1','$2'}),
+ read_binaries(Fd,AllBinaries, gb_trees:empty()).
+
+read_binaries(Fd,[[Addr0,Pos]|Bins],Dict0) ->
+ pos_bof(Fd,Pos),
+ {Addr,_} = get_hex(Addr0),
+ Dict =
+ case line_head(Fd) of
+ {eof,_} ->
+ gb_trees:enter(Addr,'#CDVTruncatedBinary',Dict0);
+ Size0 ->
+ {Size,_} = get_hex(Size0),
+ if Size > ?max_display_binary_size ->
+ gb_trees:enter(Addr,{'#CDVTooBig',binary,Pos},Dict0);
+ true ->
+ pos_bof(Fd,Pos),
+ Line = val(Fd),
+ parse_binary(Addr,Line,Dict0)
+ end
+ end,
+ read_binaries(Fd,Bins,Dict);
+read_binaries(_Fd,[],Dict) ->
+ Dict.
+
+parse_binary(Addr, Line0, Dict) ->
+ case get_hex(Line0) of
+ {N,":"++Line1} ->
+ {Bin,Line} = get_binary(N, Line1, []),
+ [] = skip_blanks(Line),
+ gb_trees:enter(Addr, Bin, Dict);
+ {_N,[]} ->
+ %% If the dump is truncated before the ':' in this line, then
+ %% line_head/1 might not discover it (if a \n has been inserted
+ %% somehow???)
+ gb_trees:enter(Addr,'#CDVTruncatedBinary',Dict)
+ end.
+
+
+
+%%%
+%%% Read top level section.
+%%%
+
+read_stack_dump(Fd,Pid,Dict) ->
+ case ets:match(cdv_dump_index_table,{"=proc_stack",Pid,'$1'}) of
+ [[Start]] ->
+ pos_bof(Fd,Start),
+ read_stack_dump1(Fd,Dict,[]);
+ [] ->
+ []
+ end.
+read_stack_dump1(Fd,Dict,Acc) ->
+ %% This function is never called if the dump is truncated in "=proc_heap:Pid"
+ case val(Fd) of
+ "=" ++ _next_tag ->
+ lists:reverse(Acc);
+ Line ->
+ Stack = parse_top(Line,Dict),
+ read_stack_dump1(Fd,Dict,[Stack|Acc])
+ end.
+
+parse_top(Line0, D) ->
+ {Label,Line1} = get_label(Line0),
+ {Term,Line,D} = parse_term(Line1, D),
+ [] = skip_blanks(Line),
+ {Label,Term}.
+
+%%%
+%%% Read message queue.
+%%%
+
+read_messages(Fd,Pid,Dict) ->
+ case ets:match(cdv_dump_index_table,{"=proc_messages",Pid,'$1'}) of
+ [[Start]] ->
+ pos_bof(Fd,Start),
+ read_messages1(Fd,Dict,[]);
+ [] ->
+ []
+ end.
+read_messages1(Fd,Dict,Acc) ->
+ %% This function is never called if the dump is truncated in "=proc_heap:Pid"
+ case val(Fd) of
+ "=" ++ _next_tag ->
+ lists:reverse(Acc);
+ Line ->
+ Msg = parse_message(Line,Dict),
+ read_messages1(Fd,Dict,[Msg|Acc])
+ end.
+
+parse_message(Line0, D) ->
+ {Msg,":"++Line1,_} = parse_term(Line0, D),
+ {Token,Line,_} = parse_term(Line1, D),
+ [] = skip_blanks(Line),
+ {Msg,Token}.
+
+%%%
+%%% Read process dictionary
+%%%
+
+read_dictionary(Fd,Tag,Pid,Dict) ->
+ case ets:match(cdv_dump_index_table,{Tag,Pid,'$1'}) of
+ [[Start]] ->
+ pos_bof(Fd,Start),
+ read_dictionary1(Fd,Dict,[]);
+ [] ->
+ []
+ end.
+read_dictionary1(Fd,Dict,Acc) ->
+ %% This function is never called if the dump is truncated in "=proc_heap:Pid"
+ case val(Fd) of
+ "=" ++ _next_tag ->
+ lists:reverse(Acc);
+ Line ->
+ Msg = parse_dictionary(Line,Dict),
+ read_dictionary1(Fd,Dict,[Msg|Acc])
+ end.
+
+parse_dictionary(Line0, D) ->
+ {Entry,Line,_} = parse_term(Line0, D),
+ [] = skip_blanks(Line),
+ Entry.
+
+%%%
+%%% Read heap data.
+%%%
+
+read_heap(Fd,Pid,Dict0) ->
+ case ets:match(cdv_dump_index_table,{"=proc_heap",Pid,'$2'}) of
+ [[Pos]] ->
+ pos_bof(Fd,Pos),
+ read_heap(Dict0);
+ [] ->
+ Dict0
+ end.
+
+read_heap(Dict0) ->
+ %% This function is never called if the dump is truncated in "=proc_heap:Pid"
+ case get(fd) of
+ end_of_heap ->
+ Dict0;
+ Fd ->
+ case val(Fd) of
+ "=" ++ _next_tag ->
+ put(fd, end_of_heap),
+ Dict0;
+ Line ->
+ Dict = parse(Line,Dict0),
+ read_heap(Dict)
+ end
+ end.
+
+parse(Line0, Dict0) ->
+ {Addr,":"++Line1} = get_hex(Line0),
+ {_Term,Line,Dict} = parse_heap_term(Line1, Addr, Dict0),
+ [] = skip_blanks(Line),
+ Dict.
+
+
+do_sort_procs("state",Procs,"state") ->
+ {lists:reverse(lists:keysort(#proc.state,Procs)),"rstate"};
+do_sort_procs("state",Procs,_) ->
+ {lists:keysort(#proc.state,Procs),"state"};
+do_sort_procs("pid",Procs,"pid") ->
+ {lists:reverse(Procs),"rpid"};
+do_sort_procs("pid",Procs,_) ->
+ {Procs,"pid"};
+do_sort_procs("msg_q_len",Procs,"msg_q_len") ->
+ {lists:keysort(#proc.msg_q_len,Procs),"rmsg_q_len"};
+do_sort_procs("msg_q_len",Procs,_) ->
+ {lists:reverse(lists:keysort(#proc.msg_q_len,Procs)),"msg_q_len"};
+do_sort_procs("reds",Procs,"reds") ->
+ {lists:keysort(#proc.reds,Procs),"rreds"};
+do_sort_procs("reds",Procs,_) ->
+ {lists:reverse(lists:keysort(#proc.reds,Procs)),"reds"};
+do_sort_procs("mem",Procs,"mem") ->
+ {lists:keysort(#proc.stack_heap,Procs),"rmem"};
+do_sort_procs("mem",Procs,_) ->
+ {lists:reverse(lists:keysort(#proc.stack_heap,Procs)),"mem"};
+do_sort_procs("init_func",Procs,"init_func") ->
+ {lists:reverse(lists:keysort(#proc.init_func,Procs)),"rinit_func"};
+do_sort_procs("init_func",Procs,_) ->
+ {lists:keysort(#proc.init_func,Procs),"init_func"};
+do_sort_procs("name_func",Procs,"name_func") ->
+ {lists:reverse(lists:keysort(#proc.name,Procs)),"rname_func"};
+do_sort_procs("name_func",Procs,_) ->
+ {lists:keysort(#proc.name,Procs),"name_func"};
+do_sort_procs("name",Procs,Sorted) ->
+ {No,Yes} =
+ lists:foldl(fun(P,{N,Y}) ->
+ case P#proc.name of
+ ?space -> {[P|N],Y};
+ _other -> {N,[P|Y]}
+ end
+ end,
+ {[],[]},
+ Procs),
+ Result = lists:keysort(#proc.name,Yes) ++ No,
+ case Sorted of
+ "name" -> {lists:reverse(Result),"rname"};
+ _ -> {Result,"name"}
+ end.
+
+
+get_port(File,Port) ->
+ case ets:match(cdv_dump_index_table,{"=port",Port,'$1'}) of
+ [[Start]] ->
+ Fd = open(File),
+ R = get_portinfo(Fd,Port,Start),
+ close(Fd),
+ {ok,R};
+ [] ->
+ case maybe_other_node(File,Port) of
+ {other_node,Type,Node} ->
+ Info = "The port you are searching for was residing on "
+ "a remote node. No port information is available. "
+ "Information about the remote node is show below.",
+ {other_node,{Type,Info,Node}};
+ not_found ->
+ not_found
+ end
+ end.
+
+get_ports(File) ->
+ Ports = ets:lookup(cdv_dump_index_table,"=port"),
+ Fd = open(File),
+ R = lists:map(fun({"=port",Id,Start}) -> get_portinfo(Fd,Id,Start) end,
+ Ports),
+ close(Fd),
+ R.
+
+
+get_portinfo(Fd,Id,Start) ->
+ pos_bof(Fd,Start),
+ get_portinfo(Fd,#port{id=Id,_=?space}).
+
+get_portinfo(Fd,Port) ->
+ case line_head(Fd) of
+ "Slot" ->
+ get_portinfo(Fd,Port#port{slot=val(Fd)});
+ "Connected" ->
+ get_portinfo(Fd,Port#port{connected=val(Fd)});
+ "Links" ->
+ get_portinfo(Fd,Port#port{links=val(Fd)});
+ "Port controls linked-in driver" ->
+ get_portinfo(Fd,Port#port{controls=["Linked in driver: " |
+ val(Fd)]});
+ "Port controls external process" ->
+ get_portinfo(Fd,Port#port{controls=["External proc: " | val(Fd)]});
+ "Port is a file" ->
+ get_portinfo(Fd,Port#port{controls=["File: "| val(Fd)]});
+ "Port is UNIX fd not opened by emulator" ->
+ get_portinfo(Fd,Port#port{
+ controls=["UNIX fd not opened by emulator: "|
+ val(Fd)]});
+ "=" ++ _next_tag ->
+ Port;
+ Other ->
+ unexpected(Fd,Other,"port info"),
+ Port
+ end.
+
+get_ets_tables(File,Pid,WS) ->
+ EtsTables = ets:match_object(cdv_dump_index_table,{"=ets",Pid,'_'}),
+ Fd = open(File),
+ R = lists:map(fun({"=ets",P,Start}) ->
+ get_etsinfo(Fd,P,Start,WS)
+ end,
+ EtsTables),
+ close(Fd),
+ R.
+
+get_internal_ets_tables(File,WS) ->
+ InternalEts = ets:match_object(cdv_dump_index_table,
+ {"=internal_ets",'_','_'}),
+ Fd = open(File),
+ R = lists:map(fun({"=internal_ets",Descr,Start}) ->
+ {Descr,get_etsinfo(Fd,undefined,Start,WS)}
+ end,
+ InternalEts),
+ close(Fd),
+ R.
+
+get_etsinfo(Fd,Pid,Start,WS) ->
+ pos_bof(Fd,Start),
+ get_etsinfo(Fd,#ets_table{pid=Pid,type="hash",_=?space},WS).
+
+get_etsinfo(Fd,EtsTable,WS) ->
+ case line_head(Fd) of
+ "Slot" ->
+ get_etsinfo(Fd,EtsTable#ets_table{slot=val(Fd)},WS);
+ "Table" ->
+ get_etsinfo(Fd,EtsTable#ets_table{id=val(Fd)},WS);
+ "Name" ->
+ get_etsinfo(Fd,EtsTable#ets_table{name=val(Fd)},WS);
+ "Ordered set (AVL tree), Elements" ->
+ skip_rest_of_line(Fd),
+ get_etsinfo(Fd,EtsTable#ets_table{type="tree",buckets="-"},WS);
+ "Buckets" ->
+ get_etsinfo(Fd,EtsTable#ets_table{buckets=val(Fd)},WS);
+ "Objects" ->
+ get_etsinfo(Fd,EtsTable#ets_table{size=val(Fd)},WS);
+ "Words" ->
+ Words = list_to_integer(val(Fd)),
+ Bytes =
+ case Words of
+ -1 -> "-1"; % probably truncated
+ _ -> integer_to_list(Words * WS)
+ end,
+ get_etsinfo(Fd,EtsTable#ets_table{memory=Bytes},WS);
+ "=" ++ _next_tag ->
+ EtsTable;
+ Other ->
+ unexpected(Fd,Other,"ETS info"),
+ EtsTable
+ end.
+
+get_timers(File,Pid) ->
+ Timers = ets:match_object(cdv_dump_index_table,{"=timer",Pid,'$1'}),
+ Fd = open(File),
+ R = lists:map(fun({"=timer",P,Start}) ->
+ get_timerinfo(Fd,P,Start)
+ end,
+ Timers),
+ close(Fd),
+ R.
+
+get_timerinfo(Fd,Pid,Start) ->
+ pos_bof(Fd,Start),
+ get_timerinfo(Fd,#timer{pid=Pid,_=?space}).
+
+get_timerinfo(Fd,Timer) ->
+ case line_head(Fd) of
+ "Message" ->
+ get_timerinfo(Fd,Timer#timer{msg=val(Fd)});
+ "Time left" ->
+ get_timerinfo(Fd,Timer#timer{time=val(Fd)});
+ "=" ++ _next_tag ->
+ Timer;
+ Other ->
+ unexpected(Fd,Other,"timer info"),
+ Timer
+ end.
+
+nods(File) ->
+ case ets:lookup(cdv_dump_index_table,"=no_distribution") of
+ [] ->
+ V = ets:lookup(cdv_dump_index_table,"=visible_node"),
+ H = ets:lookup(cdv_dump_index_table,"=hidden_node"),
+ N = ets:lookup(cdv_dump_index_table,"=not_connected"),
+ Fd = open(File),
+ Visible = lists:map(
+ fun({"=visible_node",Channel,Start}) ->
+ get_nodeinfo(Fd,Channel,Start)
+ end,
+ V),
+ Hidden = lists:map(
+ fun({"=hidden_node",Channel,Start}) ->
+ get_nodeinfo(Fd,Channel,Start)
+ end,
+ H),
+ NotConnected = lists:map(
+ fun({"=not_connected",Channel,Start}) ->
+ get_nodeinfo(Fd,Channel,Start)
+ end,
+ N),
+ close(Fd),
+ {Visible,Hidden,NotConnected};
+ [_] ->
+ no_distribution
+ end.
+
+get_nodeinfo(Fd,Channel,Start) ->
+ pos_bof(Fd,Start),
+ get_nodeinfo(Fd,#nod{channel=Channel,_=?space}).
+
+get_nodeinfo(Fd,Nod) ->
+ case line_head(Fd) of
+ "Name" ->
+ get_nodeinfo(Fd,Nod#nod{name=val(Fd)});
+ "Controller" ->
+ get_nodeinfo(Fd,Nod#nod{controller=val(Fd)});
+ "Creation" ->
+ get_nodeinfo(Fd,Nod#nod{creation=val(Fd)});
+ "Remote link" ->
+ Procs = val(Fd), % e.g. "<0.31.0> <4322.54.0>"
+ RemoteLinks = Nod#nod.remote_links,
+ get_nodeinfo(Fd,Nod#nod{remote_links=[split(Procs)|RemoteLinks]});
+ "Remote monitoring" ->
+ Procs = val(Fd), % e.g. "<0.31.0> <4322.54.0>"
+ RemoteMon = Nod#nod.remote_mon,
+ get_nodeinfo(Fd,Nod#nod{remote_mon=[split(Procs)|RemoteMon]});
+ "Remotely monitored by" ->
+ Procs = val(Fd), % e.g. "<0.31.0> <4322.54.0>"
+ RemoteMonBy = Nod#nod.remote_mon_by,
+ get_nodeinfo(Fd,Nod#nod{remote_mon_by=[split(Procs)|RemoteMonBy]});
+ "Error" ->
+ get_nodeinfo(Fd,Nod#nod{error=val(Fd)});
+ "=" ++ _next_tag ->
+ Nod;
+ Other ->
+ unexpected(Fd,Other,"node info"),
+ Nod
+ end.
+
+loaded_mods(File) ->
+ case ets:lookup(cdv_dump_index_table,"=loaded_modules") of
+ [{"=loaded_modules",_,StartTotal}] ->
+ Fd = open(File),
+ pos_bof(Fd,StartTotal),
+ {CC,OC} = get_loaded_mod_totals(Fd,{"unknown","unknown"}),
+
+ Mods = ets:lookup(cdv_dump_index_table,"=mod"),
+ LM = lists:map(fun({"=mod",M,Start}) ->
+ pos_bof(Fd,Start),
+ InitLM = #loaded_mod{mod=M,_=?space},
+ get_loaded_mod_info(Fd,InitLM,
+ fun main_modinfo/3)
+ end,
+ Mods),
+ close(Fd),
+ {CC,OC,LM};
+ [] ->
+ {"unknown","unknown",[]}
+ end.
+
+get_loaded_mod_totals(Fd,{CC,OC}) ->
+ case line_head(Fd) of
+ "Current code" ->
+ get_loaded_mod_totals(Fd,{val(Fd),OC});
+ "Old code" ->
+ get_loaded_mod_totals(Fd,{CC,val(Fd)});
+ "=" ++ _next_tag ->
+ {CC,OC};
+ Other ->
+ unexpected(Fd,Other,"loaded modules info"),
+ {CC,OC} % truncated file
+ end.
+
+get_loaded_mod_details(File,Mod) ->
+ [[Start]] = ets:match(cdv_dump_index_table,{"=mod",Mod,'$1'}),
+ Fd = open(File),
+ pos_bof(Fd,Start),
+ InitLM = #loaded_mod{mod=Mod,old_size="No old code exists",
+ _="No information available"},
+ ModInfo = get_loaded_mod_info(Fd,InitLM,fun all_modinfo/3),
+ close(Fd),
+ ModInfo.
+
+get_loaded_mod_info(Fd,LM,Fun) ->
+ case line_head(Fd) of
+ "Current size" ->
+ get_loaded_mod_info(Fd,LM#loaded_mod{current_size=val(Fd)},Fun);
+ "Old size" ->
+ get_loaded_mod_info(Fd,LM#loaded_mod{old_size=val(Fd)},Fun);
+ "=" ++ _next_tag ->
+ LM;
+ {eof,_} ->
+ LM; % truncated file
+ Other ->
+ LM1 = Fun(Fd,LM,Other),
+ get_loaded_mod_info(Fd,LM1,Fun)
+ end.
+
+main_modinfo(_Fd,LM,_LineHead) ->
+ LM.
+all_modinfo(Fd,LM,LineHead) ->
+ case LineHead of
+ "Current attributes" ->
+ Str = hex_to_str(val(Fd)),
+ LM#loaded_mod{current_attrib=Str};
+ "Current compilation info" ->
+ Str = hex_to_str(val(Fd)),
+ LM#loaded_mod{current_comp_info=Str};
+ "Old attributes" ->
+ Str = hex_to_str(val(Fd)),
+ LM#loaded_mod{old_attrib=Str};
+ "Old compilation info" ->
+ Str = hex_to_str(val(Fd)),
+ LM#loaded_mod{old_comp_info=Str};
+ Other ->
+ unexpected(Fd,Other,"loaded modules info"),
+ LM
+ end.
+
+
+hex_to_str(Hex) ->
+ Term = hex_to_term(Hex,[]),
+ io_lib:format("~p~n",[Term]).
+
+hex_to_term([X,Y|Hex],Acc) ->
+ MS = hex_to_dec([X]),
+ LS = hex_to_dec([Y]),
+ Z = 16*MS+LS,
+ hex_to_term(Hex,[Z|Acc]);
+hex_to_term([],Acc) ->
+ Bin = list_to_binary(lists:reverse(Acc)),
+ case catch binary_to_term(Bin) of
+ {'EXIT',_Reason} ->
+ {"WARNING: The term is probably truncated!",
+ "I can not do binary_to_term.",
+ Bin};
+ Term ->
+ Term
+ end.
+
+hex_to_dec("F") -> 15;
+hex_to_dec("E") -> 14;
+hex_to_dec("D") -> 13;
+hex_to_dec("C") -> 12;
+hex_to_dec("B") -> 11;
+hex_to_dec("A") -> 10;
+hex_to_dec(N) -> list_to_integer(N).
+
+
+
+funs(File) ->
+ case ets:lookup(cdv_dump_index_table,"=fun") of
+ [] ->
+ [];
+ AllFuns ->
+ Fd = open(File),
+ R = lists:map(fun({"=fun",_,Start}) ->
+ get_funinfo(Fd,Start)
+ end,
+ AllFuns),
+ close(Fd),
+ R
+ end.
+
+get_funinfo(Fd,Start) ->
+ pos_bof(Fd,Start),
+ get_funinfo1(Fd,#fu{_=?space}).
+
+get_funinfo1(Fd,Fu) ->
+ case line_head(Fd) of
+ "Module" ->
+ get_funinfo1(Fd,Fu#fu{module=val(Fd)});
+ "Uniq" ->
+ get_funinfo1(Fd,Fu#fu{uniq=val(Fd)});
+ "Index" ->
+ get_funinfo1(Fd,Fu#fu{index=val(Fd)});
+ "Address" ->
+ get_funinfo1(Fd,Fu#fu{address=val(Fd)});
+ "Native_address" ->
+ get_funinfo1(Fd,Fu#fu{native_address=val(Fd)});
+ "Refc" ->
+ get_funinfo1(Fd,Fu#fu{refc=val(Fd)});
+ "=" ++ _next_tag ->
+ Fu;
+ Other ->
+ unexpected(Fd,Other,"fun info"),
+ Fu
+ end.
+
+atoms(File) ->
+ case ets:lookup(cdv_dump_index_table,"=atoms") of
+ [{_atoms,_Id,Start}] ->
+ Fd = open(File),
+ pos_bof(Fd,Start),
+ R = case get_n_lines_of_tag(Fd,100) of
+ {all,N,Lines} ->
+ {n_lines,1,N,"Atoms",Lines};
+ {part,100,Lines} ->
+ {n_lines,1,100,"Atoms",Lines,get(pos)};
+ empty ->
+ []
+ end,
+ close(Fd),
+ R;
+ _ ->
+ []
+ end.
+
+memory(File) ->
+ case ets:lookup(cdv_dump_index_table,"=memory") of
+ [{"=memory",_,Start}] ->
+ Fd = open(File),
+ pos_bof(Fd,Start),
+ R = get_meminfo(Fd,[]),
+ close(Fd),
+ R;
+ _ ->
+ []
+ end.
+
+get_meminfo(Fd,Acc) ->
+ case line_head(Fd) of
+ "=" ++ _next_tag ->
+ lists:reverse(Acc);
+ {eof,_last_line} ->
+ lists:reverse(Acc);
+ Key ->
+ get_meminfo(Fd,[{Key,val(Fd)}|Acc])
+ end.
+
+allocated_areas(File) ->
+ case ets:lookup(cdv_dump_index_table,"=allocated_areas") of
+ [{"=allocated_areas",_,Start}] ->
+ Fd = open(File),
+ pos_bof(Fd,Start),
+ R = get_allocareainfo(Fd,[]),
+ close(Fd),
+ R;
+ _ ->
+ []
+ end.
+
+get_allocareainfo(Fd,Acc) ->
+ case line_head(Fd) of
+ "=" ++ _next_tag ->
+ lists:reverse(Acc);
+ {eof,_last_line} ->
+ lists:reverse(Acc);
+ Key ->
+ Val = val(Fd),
+ AllocInfo =
+ case split(Val) of
+ {Alloc,[]} ->
+ {Key,Alloc,?space};
+ {Alloc,Used} ->
+ {Key,Alloc,Used}
+ end,
+ get_allocareainfo(Fd,[AllocInfo|Acc])
+ end.
+
+allocator_info(File) ->
+ case ets:lookup(cdv_dump_index_table,"=allocator") of
+ [] ->
+ [];
+ AllAllocators ->
+ Fd = open(File),
+ R = lists:map(fun({"=allocator",Heading,Start}) ->
+ {Heading,get_allocatorinfo(Fd,Start)}
+ end,
+ AllAllocators),
+ close(Fd),
+ R
+ end.
+
+get_allocatorinfo(Fd,Start) ->
+ pos_bof(Fd,Start),
+ get_allocatorinfo1(Fd,[]).
+
+get_allocatorinfo1(Fd,Acc) ->
+ case line_head(Fd) of
+ "=" ++ _next_tag ->
+ lists:reverse(Acc);
+ {eof,_last_line} ->
+ lists:reverse(Acc);
+ Key ->
+ Values = get_all_vals(val(Fd),[]),
+ get_allocatorinfo1(Fd,[{Key,Values}|Acc])
+ end.
+
+get_all_vals([$ |Rest],Acc) ->
+ [lists:reverse(Acc)|get_all_vals(Rest,[])];
+get_all_vals([],Acc) ->
+ [lists:reverse(Acc)];
+get_all_vals([Char|Rest],Acc) ->
+ get_all_vals(Rest,[Char|Acc]).
+
+
+hash_tables(File) ->
+ case ets:lookup(cdv_dump_index_table,"=hash_table") of
+ [] ->
+ [];
+ AllHashTables ->
+ Fd = open(File),
+ R = lists:map(fun({"=hash_table",Name,Start}) ->
+ get_hashtableinfo(Fd,Name,Start)
+ end,
+ AllHashTables),
+ close(Fd),
+ R
+ end.
+
+get_hashtableinfo(Fd,Name,Start) ->
+ pos_bof(Fd,Start),
+ get_hashtableinfo1(Fd,#hash_table{name=Name,_=?space}).
+
+get_hashtableinfo1(Fd,HashTable) ->
+ case line_head(Fd) of
+ "size" ->
+ get_hashtableinfo1(Fd,HashTable#hash_table{size=val(Fd)});
+ "used" ->
+ get_hashtableinfo1(Fd,HashTable#hash_table{used=val(Fd)});
+ "objs" ->
+ get_hashtableinfo1(Fd,HashTable#hash_table{objs=val(Fd)});
+ "depth" ->
+ get_hashtableinfo1(Fd,HashTable#hash_table{depth=val(Fd)});
+ "=" ++ _next_tag ->
+ HashTable;
+ Other ->
+ unexpected(Fd,Other,"hash table information"),
+ HashTable
+ end.
+
+index_tables(File) ->
+ case ets:lookup(cdv_dump_index_table,"=index_table") of
+ [] ->
+ [];
+ AllIndexTables ->
+ Fd = open(File),
+ R = lists:map(fun({"=index_table",Name,Start}) ->
+ get_indextableinfo(Fd,Name,Start)
+ end,
+ AllIndexTables),
+ close(Fd),
+ R
+ end.
+
+get_indextableinfo(Fd,Name,Start) ->
+ pos_bof(Fd,Start),
+ get_indextableinfo1(Fd,#index_table{name=Name,_=?space}).
+
+get_indextableinfo1(Fd,IndexTable) ->
+ case line_head(Fd) of
+ "size" ->
+ get_indextableinfo1(Fd,IndexTable#index_table{size=val(Fd)});
+ "used" ->
+ get_indextableinfo1(Fd,IndexTable#index_table{used=val(Fd)});
+ "limit" ->
+ get_indextableinfo1(Fd,IndexTable#index_table{limit=val(Fd)});
+ "rate" ->
+ get_indextableinfo1(Fd,IndexTable#index_table{rate=val(Fd)});
+ "=" ++ _next_tag ->
+ IndexTable;
+ Other ->
+ unexpected(Fd,Other,"index table information"),
+ IndexTable
+ end.
+
+
+
+
+
+get_expanded(File,Pos,Size) ->
+ Fd = open(File),
+ R = case file:pread(Fd,Pos,Size) of
+ {ok,Bin}->
+ binary_to_list(Bin);
+ eof ->
+ ?space
+ end,
+ close(Fd),
+ R.
+
+
+get_next(File,Pos,N0,Start,What) ->
+ Fd = open(File),
+ pos_bof(Fd,Pos),
+ R = case get_n_lines_of_tag(Fd,N0) of
+ {all,N,Lines} ->
+ {n_lines,Start,N,What,Lines};
+ {part,N,Lines} ->
+ {n_lines,Start,N,What,Lines,get(pos)}
+ end,
+ close(Fd),
+ R.
+
+
+
+replace_all(From,To,[From|Rest],Acc) ->
+ replace_all(From,To,Rest,[To|Acc]);
+replace_all(From,To,[Char|Rest],Acc) ->
+ replace_all(From,To,Rest,[Char|Acc]);
+replace_all(_From,_To,[],Acc) ->
+ lists:reverse(Acc).
+
+
+%%%-----------------------------------------------------------------
+%%% Parse memory in crashdump version 0.1 and newer
+%%%
+parse_heap_term([$l|Line0], Addr, D0) -> %Cons cell.
+ {H,"|"++Line1,D1} = parse_term(Line0, D0),
+ {T,Line,D2} = parse_term(Line1, D1),
+ Term = [H|T],
+ D = gb_trees:insert(Addr, Term, D2),
+ {Term,Line,D};
+parse_heap_term([$t|Line0], Addr, D) -> %Tuple
+ {N,":"++Line} = get_hex(Line0),
+ parse_tuple(N, Line, Addr, D, []);
+parse_heap_term([$F|Line0], Addr, D0) -> %Float
+ {N,":"++Line1} = get_hex(Line0),
+ {Chars,Line} = get_chars(N, Line1),
+ Term = list_to_float(Chars),
+ D = gb_trees:insert(Addr, Term, D0),
+ {Term,Line,D};
+parse_heap_term("B16#"++Line0, Addr, D0) -> %Positive big number.
+ {Term,Line} = get_hex(Line0),
+ D = gb_trees:insert(Addr, Term, D0),
+ {Term,Line,D};
+parse_heap_term("B-16#"++Line0, Addr, D0) -> %Negative big number
+ {Term0,Line} = get_hex(Line0),
+ Term = -Term0,
+ D = gb_trees:insert(Addr, Term, D0),
+ {Term,Line,D};
+parse_heap_term("B"++Line0, Addr, D0) -> %Decimal big num (new in R10B-something).
+ case string:to_integer(Line0) of
+ {Int,Line} when is_integer(Int) ->
+ D = gb_trees:insert(Addr, Int, D0),
+ {Int,Line,D}
+ end;
+parse_heap_term([$P|Line0], Addr, D0) -> % External Pid.
+ {Pid0,Line} = get_id(Line0),
+ Pid = "#CDVPid"++Pid0,
+ D = gb_trees:insert(Addr, Pid, D0),
+ {Pid,Line,D};
+parse_heap_term([$p|Line0], Addr, D0) -> % External Port.
+ {Port0,Line} = get_id(Line0),
+ Port = "#CDVPort"++Port0,
+ D = gb_trees:insert(Addr, Port, D0),
+ {Port,Line,D};
+parse_heap_term("E"++Line0, Addr, D0) -> %Term encoded in external format.
+ {Bin,Line} = get_binary(Line0),
+ Term = binary_to_term(Bin),
+ D = gb_trees:insert(Addr, Term, D0),
+ {Term,Line,D};
+parse_heap_term("Yh"++Line0, Addr, D0) -> %Heap binary.
+ {Term,Line} = get_binary(Line0),
+ D = gb_trees:insert(Addr, Term, D0),
+ {Term,Line,D};
+parse_heap_term("Yc"++Line0, Addr, D0) -> %Reference-counted binary.
+ {Binp,":"++Line1} = get_hex(Line0),
+ {First,":"++Line2} = get_hex(Line1),
+ {Sz,Line} = get_hex(Line2),
+ Term = case gb_trees:lookup(Binp, D0) of
+ {value,<<_:First/binary,T:Sz/binary,_/binary>>} -> T;
+ {value,{'#CDVTooBig',binary,Pos}} -> cdvbin(Sz,Pos);
+ {value,'#CDVTruncatedBinary'} -> '#CDVTruncatedBinary';
+ none -> '#CDVNonexistingBinary'
+ end,
+ D = gb_trees:insert(Addr, Term, D0),
+ {Term,Line,D};
+parse_heap_term("Ys"++Line0, Addr, D0) -> %Sub binary.
+ {Binp,":"++Line1} = get_hex(Line0),
+ {First,":"++Line2} = get_hex(Line1),
+ {Sz,Line} = get_hex(Line2),
+ Term = case gb_trees:lookup(Binp, D0) of
+ {value,<<_:First/binary,T:Sz/binary,_/binary>>} -> T;
+ {value,{'#CDVTooBig',binary,Pos}} -> cdvbin(Sz,Pos);
+ {value,'#CDVTruncatedBinary'} -> '#CDVTruncatedBinary';
+ none -> '#CDVNonexistingBinary'
+ end,
+ D = gb_trees:insert(Addr, Term, D0),
+ {Term,Line,D}.
+
+
+parse_tuple(0, Line, Addr, D0, Acc) ->
+ Tuple = list_to_tuple(lists:reverse(Acc)),
+ D = gb_trees:insert(Addr, Tuple, D0),
+ {Tuple,Line,D};
+parse_tuple(N, Line0, Addr, D0, Acc) ->
+ case parse_term(Line0, D0) of
+ {Term,[$,|Line],D} when N > 1 ->
+ parse_tuple(N-1, Line, Addr, D, [Term|Acc]);
+ {Term,Line,D}->
+ parse_tuple(N-1, Line, Addr, D, [Term|Acc])
+ end.
+
+parse_term([$H|Line0], D) -> %Pointer to heap term.
+ {Ptr,Line} = get_hex(Line0),
+ deref_ptr(Ptr, Line, D);
+parse_term([$N|Line], D) -> %[] (nil).
+ {[],Line,D};
+parse_term([$I|Line0], D) -> %Small.
+ {Int,Line} = string:to_integer(Line0),
+ {Int,Line,D};
+parse_term([$A|_]=Line, D) -> %Atom.
+ parse_atom(Line, D);
+parse_term([$P|Line0], D) -> %Pid.
+ {Pid,Line} = get_id(Line0),
+ {"#CDVPid"++Pid,Line,D};
+parse_term([$p|Line0], D) -> %Port.
+ {Port,Line} = get_id(Line0),
+ {"#CDVPort"++Port,Line,D};
+parse_term([$S|Str0], D) -> %Information string.
+ Str = lists:reverse(skip_blanks(lists:reverse(Str0))),
+ {Str,[],D};
+parse_term([$D|Line0], D) -> %DistExternal
+ try
+ {AttabSize,":"++Line1} = get_hex(Line0),
+ {Attab, "E"++Line2} = parse_atom_translation_table(AttabSize, Line1, []),
+ {Bin,Line3} = get_binary(Line2),
+ {try
+ erts_debug:dist_ext_to_term(Attab, Bin)
+ catch
+ error:_ -> '<invalid-distribution-message>'
+ end,
+ Line3,
+ D}
+ catch
+ error:_ ->
+ {'#CDVBadDistExt', skip_dist_ext(Line0), D}
+ end.
+
+skip_dist_ext(Line) ->
+ skip_dist_ext(lists:reverse(Line), []).
+
+skip_dist_ext([], SeqTraceToken) ->
+ SeqTraceToken;
+skip_dist_ext([$:| _], SeqTraceToken) ->
+ [$:|SeqTraceToken];
+skip_dist_ext([C|Cs], KeptCs) ->
+ skip_dist_ext(Cs, [C|KeptCs]).
+
+parse_atom([$A|Line0], D) ->
+ {N,":"++Line1} = get_hex(Line0),
+ {Chars, Line} = get_chars(N, Line1),
+ {list_to_atom(Chars), Line, D}.
+
+parse_atom_translation_table(0, Line0, As) ->
+ {list_to_tuple(lists:reverse(As)), Line0};
+parse_atom_translation_table(N, Line0, As) ->
+ {A, Line1, _} = parse_atom(Line0, []),
+ parse_atom_translation_table(N-1, Line1, [A|As]).
+
+
+
+deref_ptr(Ptr, Line, D0) ->
+ case gb_trees:lookup(Ptr, D0) of
+ {value,Term} ->
+ {Term,Line,D0};
+ none ->
+ case get(fd) of
+ end_of_heap ->
+ {['#CDVIncompleteHeap'],Line,D0};
+ Fd ->
+ case val(Fd) of
+ "="++_ ->
+ put(fd, end_of_heap),
+ deref_ptr(Ptr, Line, D0);
+ L ->
+ D = parse(L, D0),
+ deref_ptr(Ptr, Line, D)
+ end
+ end
+ end.
+
+get_hex(L) ->
+ get_hex_1(L, 0).
+
+get_hex_1([H|T]=L, Acc) ->
+ case get_hex_digit(H) of
+ none -> {Acc,L};
+ Digit -> get_hex_1(T, (Acc bsl 4) bor Digit)
+ end;
+get_hex_1([], Acc) -> {Acc,[]}.
+
+get_hex_digit(C) when $0 =< C, C =< $9 -> C-$0;
+get_hex_digit(C) when $a =< C, C =< $f -> C-$a+10;
+get_hex_digit(C) when $A =< C, C =< $F -> C-$A+10;
+get_hex_digit(_) -> none.
+
+skip_blanks([$\s|T]) ->
+ skip_blanks(T);
+skip_blanks([$\r|T]) ->
+ skip_blanks(T);
+skip_blanks([$\n|T]) ->
+ skip_blanks(T);
+skip_blanks([$\t|T]) ->
+ skip_blanks(T);
+skip_blanks(T) -> T.
+
+get_chars(N, Line) ->
+ get_chars(N, Line, []).
+
+get_chars(0, Line, Acc) ->
+ {lists:reverse(Acc),Line};
+get_chars(N, [H|T], Acc) ->
+ get_chars(N-1, T, [H|Acc]).
+
+get_id(Line) ->
+ get_id(Line, []).
+
+get_id([$>|Line], Acc) ->
+ {lists:reverse(Acc, [$>]),Line};
+get_id([H|T], Acc) ->
+ get_id(T, [H|Acc]).
+
+get_label(L) ->
+ get_label(L, []).
+
+get_label([$:|Line], Acc) ->
+ Label = lists:reverse(Acc),
+ case get_hex(Label) of
+ {Int,[]} ->
+ {Int,Line};
+ _ ->
+ {list_to_atom(Label),Line}
+ end;
+get_label([H|T], Acc) ->
+ get_label(T, [H|Acc]).
+
+get_binary(Line0) ->
+ {N,":"++Line} = get_hex(Line0),
+ get_binary(N, Line, []).
+
+get_binary(0, Line, Acc) ->
+ {list_to_binary(lists:reverse(Acc)),Line};
+get_binary(N, [A,B|Line], Acc) ->
+ Byte = (get_hex_digit(A) bsl 4) bor get_hex_digit(B),
+ get_binary(N-1, Line, [Byte|Acc]);
+get_binary(_N, [], _Acc) ->
+ {'#CDVTruncatedBinary',[]}.
+
+cdvbin(Sz,Pos) ->
+ "#CDVBin<"++integer_to_list(Sz)++","++integer_to_list(Pos)++">".
diff --git a/lib/observer/src/crashdump_viewer.hrl b/lib/observer/src/crashdump_viewer.hrl
new file mode 100644
index 0000000000..386d3bb423
--- /dev/null
+++ b/lib/observer/src/crashdump_viewer.hrl
@@ -0,0 +1,132 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-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%
+%%
+-define(space, "&nbsp;").
+
+
+-record(menu_item,{index,picture,text,depth,children,state,target}).
+
+-record(general_info,
+ {created,
+ slogan,
+ system_vsn,
+ compile_time,
+ node_name,
+ num_atoms,
+ num_procs,
+ num_ets,
+ num_fun,
+ mem_tot,
+ mem_max,
+ instr_info}).
+
+-record(proc,
+ {pid,
+ name,
+ init_func,
+ parent,
+ start_time,
+ state,
+ current_func,
+ msg_q_len,
+ msg_q,
+ last_calls,
+ links,
+ prog_count,
+ cp,
+ arity,
+ dict,
+ debug_dict,
+ reds,
+ num_heap_frag,
+ heap_frag_data,
+ stack_heap,
+ old_heap,
+ heap_unused,
+ old_heap_unused,
+ new_heap_start,
+ new_heap_top,
+ stack_top,
+ stack_end,
+ old_heap_start,
+ old_heap_top,
+ old_heap_end,
+ stack_dump}).
+
+-record(port,
+ {id,
+ slot,
+ connected,
+ links,
+ controls}).
+
+-record(ets_table,
+ {pid,
+ slot,
+ id,
+ name,
+ type,
+ buckets,
+ size,
+ memory}).
+
+-record(timer,
+ {pid,
+ msg,
+ time}).
+
+-record(fu,
+ {module,
+ uniq,
+ index,
+ address,
+ native_address,
+ refc}).
+
+-record(nod,
+ {name,
+ channel,
+ controller,
+ creation,
+ remote_links,
+ remote_mon,
+ remote_mon_by,
+ error}).
+
+-record(loaded_mod,
+ {mod,
+ current_size,
+ current_attrib,
+ current_comp_info,
+ old_size,
+ old_attrib,
+ old_comp_info}).
+
+-record(hash_table,
+ {name,
+ size,
+ used,
+ objs,
+ depth}).
+
+-record(index_table,
+ {name,
+ size,
+ used,
+ limit,
+ rate}).
diff --git a/lib/observer/src/crashdump_viewer_html.erl b/lib/observer/src/crashdump_viewer_html.erl
new file mode 100644
index 0000000000..5fa829ed37
--- /dev/null
+++ b/lib/observer/src/crashdump_viewer_html.erl
@@ -0,0 +1,1431 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-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(crashdump_viewer_html).
+
+%%
+%% This module implements the HTML generation for the crashdump
+%% viewer. No logic or states are kept by this module.
+%%
+
+-export([welcome/0,
+ read_file_frame/0,
+ redirect/1,
+ start_page/0,
+ filename_frame/1,
+ menu_frame/0,
+ general_info/1,
+ pretty_info_page/2,
+ info_page/2,
+ procs_summary/4,
+ proc_details/4,
+ expanded_memory/2,
+ expanded_binary/1,
+ next/2,
+ ports/3,
+ timers/3,
+ ets_tables/4,
+ nods/2,
+ loaded_mods/2,
+ loaded_mod_details/2,
+ funs/2,
+ atoms/3,
+ memory/2,
+ allocated_areas/2,
+ allocator_info/2,
+ hash_tables/2,
+ index_tables/2,
+ error/2]).
+
+-include("crashdump_viewer.hrl").
+
+%%%-----------------------------------------------------------------
+%%% Welcome frame
+welcome() ->
+ header(body(welcome_body())).
+
+welcome_body() ->
+ table(
+ "WIDTH=100% HEIGHT=60%",
+ [tr("VALIGN=middle",
+ td("ALIGN=center",
+ font("SIZE=6",
+ ["Welcome to the Web Based",br(),
+ "Erlang Crash Dump Analyser"]))),
+ tr("VALIGN=middle",
+ td("ALIGN=center",
+ form(["name=load_new ACTION=\"./read_file_frame\""],
+ input(["TYPE=submit VALUE=\"Load Crashdump\""]))))]).
+
+%%%-----------------------------------------------------------------
+%%% Present a form to enter file name of erlang crash dump
+read_file_frame() ->
+ header("Read File",body(read_file_frame_body())).
+
+
+read_file_frame_body() ->
+ Entry =
+ case webtool:is_localhost() of
+ true -> [input("TYPE=file NAME=browse SIZE=40"),
+ input("TYPE=hidden NAME=path")];
+ false -> input("TYPE=text NAME=path SIZE=60")
+ end,
+ Form =
+ form(
+ "NAME=read_file_form METHOD=post ACTION= \"./read_file\"",
+ table(
+ "BORDER=0",
+ [tr(td("COLSPAN=2","Enter file to analyse")),
+ tr(
+ [td(Entry),
+ td("ALIGN=center",
+ input("TYPE=submit onClick=\"path.value=browse.value;\""
+ "VALUE=Ok"))])])),
+ table(
+ "WIDTH=100% HEIGHT=60%",
+ tr("VALIGN=middle",
+ td("ALIGN=center",Form))).
+
+
+%%%-----------------------------------------------------------------
+%%% Display "Please wait..." while crashdump is being read
+redirect(Status) ->
+ Head = ["<META HTTP-EQUIV=\"refresh\" CONTENT=\"3; URL=./redirect\">"],
+ header("Please wait...",Head,body([Status,br(),"Please wait..."])).
+
+%%%-----------------------------------------------------------------
+%%% Frameset containing "filename", "menu", and "main" frames
+start_page() ->
+ header("Crashdump Viewer Start Page",start_page_frameset()).
+
+start_page_frameset() ->
+ frameset(
+ "ROWS=\"70,*\"",
+ [frame(["NAME=\"filename\" SRC=\"./filename_frame\""]),
+ frameset(
+ "COLS=\"200,*\"",
+ [frame(["NAME=\"menu\" ",
+ "SRC=\"/cdv_erl/crashdump_viewer/menu_frame\""]),
+ frame("NAME=\"main\" SRC=\"./initial_info_frame\"")])]).
+
+
+
+%%%-----------------------------------------------------------------
+%%% Topmost frame presents the filename of the crashdump currently
+%%% viewed
+filename_frame(File) ->
+ header("Filename",body(filename_body(File))).
+
+filename_body(File) ->
+ p("ALIGN=center",[b("Crashdump currently viewed:"),br(),File]).
+
+
+%%%-----------------------------------------------------------------
+%%% Left frame displays the menu
+menu_frame() ->
+ header("Menu", body(menu_body())).
+
+menu_body() ->
+ [p(format_items(1,ets:info(cdv_menu_table,size),true)),
+ p([br(),
+ form(["name=load_new ACTION=\"./read_file_frame\" ",
+ "TARGET=app_frame"],
+ input("TYPE=submit VALUE=\"Load New Crashdump\""))])].
+
+format_items(I,Max,_ParentState) when I>Max->
+ [];
+format_items(I,Max,ParentState) when I=<Max->
+ case ets:lookup(cdv_menu_table,I) of
+ [] -> [];
+ [#menu_item{state=false,children=0}] ->
+ format_items(I+1,Max,ParentState);
+ [#menu_item{state=false,children=Children}] ->
+ format_items(I+Children+1,Max,arentState);
+ [Item=#menu_item{state=true,children=0}] when ParentState ->
+ This = format_item(Item),
+ [This|format_items(I+1,Max,ParentState)];
+ [Item=#menu_item{state=true,children=Children}] when ParentState ->
+ This = format_item(Item),
+ Ch = format_items(I+1,I+Children,true),
+ [[This | Ch] | format_items(I+Children+1,Max,ParentState)]
+ end.
+
+format_item(Item) ->
+ [lists:duplicate(Item#menu_item.depth*5,?space),
+ format_picture(Item#menu_item.index,
+ Item#menu_item.picture,
+ Item#menu_item.children),
+ format_title(Item#menu_item.text,Item#menu_item.target),
+ br()].
+
+format_picture(_Index,Picture,0) ->
+ img(Picture);
+format_picture(Index,Picture,_Children) ->
+ href( ["./toggle?index=", integer_to_list(Index)], img(Picture)).
+
+format_title({Link,Text},Target) ->
+ href(["TARGET=\"",Target,"\""],Link,Text);
+format_title(Text,_Type) ->
+ Text.
+
+%%%-----------------------------------------------------------------
+%%% Display the general information
+general_info(GenInfo) ->
+ Heading = "General Information",
+ header(Heading,body(general_info_body(Heading,GenInfo))).
+
+general_info_body(Heading,GenInfo) ->
+ TruncatedInfo =
+ case get(truncated) of
+ true ->
+ p(font("SIZE=\"+1\" COLOR=\"#FF0000\"",
+ b(["WARNING:",br(),
+ "The crashdump is truncated",br(),
+ "Some information might be missing",br()])));
+ false ->
+ ""
+ end,
+
+ [heading(Heading,"general_info"),
+ TruncatedInfo,
+ table(
+ "BORDER=4 CELLPADDING=4",
+ [tr([th("ALIGN=left BGCOLOR=\"#8899AA\"","Slogan"),
+ td(GenInfo#general_info.slogan)]),
+ tr([th("ALIGN=left BGCOLOR=\"#8899AA\"","Node name"),
+ td(GenInfo#general_info.node_name)]),
+ tr([th("ALIGN=left BGCOLOR=\"#8899AA\"","Crashdump created on"),
+ td(GenInfo#general_info.created)]),
+ tr([th("ALIGN=left BGCOLOR=\"#8899AA\"","System version"),
+ td(GenInfo#general_info.system_vsn)]),
+ tr([th("ALIGN=left BGCOLOR=\"#8899AA\"","Compiled"),
+ td(GenInfo#general_info.compile_time)]),
+ case GenInfo#general_info.mem_tot of
+ "" -> "";
+ MemTot ->
+ tr([th("ALIGN=left BGCOLOR=\"#8899AA\"","Memory allocated"),
+ td([MemTot," bytes"])])
+ end,
+ case GenInfo#general_info.mem_max of
+ "" -> "";
+ MemMax ->
+ tr([th("ALIGN=left BGCOLOR=\"#8899AA\"","Memory maximum"),
+ td([MemMax," bytes"])])
+ end,
+ tr([th("ALIGN=left BGCOLOR=\"#8899AA\"","Atoms"),
+ td(GenInfo#general_info.num_atoms)]),
+ tr([th("ALIGN=left BGCOLOR=\"#8899AA\"","Processes"),
+ td(GenInfo#general_info.num_procs)]),
+ tr([th("ALIGN=left BGCOLOR=\"#8899AA\"","ETS tables"),
+ td(GenInfo#general_info.num_ets)]),
+ tr([th("ALIGN=left BGCOLOR=\"#8899AA\"","Funs"),
+ td(GenInfo#general_info.num_fun)])]),
+ case GenInfo#general_info.instr_info of
+ old_instr_data ->
+ [br(),br(),
+ font("COLOR=\"#FF0000\"",
+ ["Instrumentation information is found at the end of ",br(),
+ "the dump. The information has an old format, and ",br(),
+ "is not presented in this tool. Please read the ",br(),
+ "crashdump manually to see this information."])];
+ instr_data ->
+ [br(),br(),
+ font("COLOR=\"#FF0000\"",
+ ["Instrumentation information is found at the end of ",br(),
+ "the dump. The information is not presented in this ",br(),
+ "tool. Please read the crashdump manually to see",br(),
+ "this information."])];
+ false ->
+ []
+ end].
+
+%%%-----------------------------------------------------------------
+%%% Display an error message
+error(Text,Args) ->
+ Str = io_lib:format(Text,Args),
+ header(body(error_body(Str))).
+
+error_body(Str) ->
+ [h1("An error occured:"),Str,"\n"].
+
+
+%%%-----------------------------------------------------------------
+%%% Display the given information as is
+info_page(Heading,Info) ->
+ info_page(Heading,Info,[]).
+info_page(Heading,Info,TW) ->
+ header(Heading,body(info_body(Heading,Info,TW))).
+
+info_body(Heading,[],TW) ->
+ [h1(Heading),
+ warn(TW),
+ "No information was found\n"];
+info_body(Heading,Info,TW) ->
+ [h1(Heading),
+ warn(TW),
+ pre(href_proc_port(lists:flatten(Info)))].
+
+%%%-----------------------------------------------------------------
+%%% Pretty print the given information
+pretty_info_page(Heading,Info) ->
+ header(Heading,body(pretty_info_body(Heading,Info))).
+
+pretty_info_body(Heading,[]) ->
+ [h1(Heading),
+ "No information was found\n"];
+pretty_info_body(Heading,Info) ->
+ [h1(Heading),
+ pre(pretty_format(Info))].
+
+%%%-----------------------------------------------------------------
+%%% Make table with summary of process information
+procs_summary(Sorted,ProcsSummary,TW,SharedHeap) ->
+ Heading = "Process Information",
+ header(Heading,
+ body(
+ procs_summary_body(Heading,ProcsSummary,TW,Sorted,SharedHeap))).
+
+procs_summary_body(Heading,[],TW,_Sorted,_SharedHeap) ->
+ [h1(Heading),
+ warn(TW),
+ "No processes were found\n"];
+procs_summary_body(Heading,ProcsSummary,TW,Sorted,SharedHeap) ->
+ MemHeading =
+ if SharedHeap ->
+ "Stack";
+ true ->
+ "Stack+heap"
+ end,
+
+ [heading(Heading,"processes"),
+ warn(TW),
+ table(
+ "BORDER=4 CELLPADDING=4",
+ [tr(
+ [summary_table_head("pid","Pid",Sorted),
+ summary_table_head("name_func","Name/Spawned as",Sorted),
+ summary_table_head("state","State",Sorted),
+ summary_table_head("reds","Reductions",Sorted),
+ summary_table_head("mem",MemHeading,Sorted),
+ summary_table_head("msg_q_len","MsgQ Length",Sorted)]) |
+ lists:map(fun(Proc) -> procs_summary_table(Proc) end,ProcsSummary)])].
+
+summary_table_head(Sorted,Text,Sorted) ->
+ %% Mark the sorted column (bigger and italic)
+ th(font("SIZE=\"+1\"",em(href("./sort_procs?sort="++Sorted,Text))));
+summary_table_head(SortOn,Text,_Sorted) ->
+ th(href("./sort_procs?sort="++SortOn,Text)).
+
+procs_summary_table(Proc) ->
+ #proc{pid=Pid,name=Name,state=State,
+ reds=Reds,stack_heap=Mem0,msg_q_len=MsgQLen}=Proc,
+ Mem = case Mem0 of
+ -1 -> "unknown";
+ _ -> integer_to_list(Mem0)
+ end,
+ tr(
+ [td(href(["./proc_details?pid=",Pid],Pid)),
+ td(Name),
+ td(State),
+ td("ALIGN=right",integer_to_list(Reds)),
+ td("ALIGN=right",Mem),
+ td("ALIGN=right",integer_to_list(MsgQLen))]).
+
+%%%-----------------------------------------------------------------
+%%% Print details for one process
+proc_details(Pid,Proc,TW,SharedHeap) ->
+ Script =
+"<SCRIPT type=\"text/javascript\">
+ function popup() {
+ window.open(\"\",\"expanded\",'resizable=yes,scrollbars=yes')
+}
+</SCRIPT>\n",
+
+ Heading = ["Process ", Pid],
+ header(Heading,Script,body(proc_details_body(Heading,Proc,TW,SharedHeap))).
+
+proc_details_body(Heading,Proc,TW,SharedHeap) ->
+ Pid = Proc#proc.pid,
+ Name = if Proc#proc.name==Proc#proc.init_func -> ?space;
+ true -> Proc#proc.name
+ end,
+ [help("processes"),
+ warn(TW),
+ table(
+ "BORDER=4 COLS=4 WIDTH=\"100%\"",
+ [tr(
+ "BGCOLOR=\"#8899AA\"",
+ [td("COLSPAN=4 ALIGN=center",Heading)]),
+ tr(
+ [td("NOWRAP=true",b("Name")),
+ td("COLSPAN=1",Name),
+ td("NOWRAP=true",b("Spawned as")),
+ td("COLSPAN=1",Proc#proc.init_func)]),
+ tr(
+ [td("NOWRAP=true",b("State")),
+ td("COLSPAN=1",Proc#proc.state),
+ td("NOWRAP=true",b(element(1,Proc#proc.current_func))),
+ td("COLSPAN=1",element(2,Proc#proc.current_func))]),
+ tr(
+ [td("NOWRAP=true",b("Started")),
+ td("COLSPAN=1",Proc#proc.start_time),
+ td("NOWRAP=true",b("Spawned by")),
+ td("COLSPAN=1",href_proc_port(Proc#proc.parent))]),
+ tr(
+ [td("NOWRAP=true",b("Reductions")),
+ td("COLSPAN=3",integer_to_list(Proc#proc.reds))]),
+ if SharedHeap ->
+ Stack = case Proc#proc.stack_heap of
+ -1 -> "unknown";
+ S -> integer_to_list(S)
+ end,
+ tr(
+ [td("NOWRAP=true",b("Stack")),
+ td("COLSPAN=3",Stack)]);
+ true ->
+ [tr(
+ [td("NOWRAP=true",b("Stack+heap")),
+ td(integer_to_list(Proc#proc.stack_heap)),
+ td("NOWRAP=true",b("OldHeap")),
+ td(Proc#proc.old_heap)]),
+ tr(
+ [td("NOWRAP=true",b("Heap unused")),
+ td(Proc#proc.heap_unused),
+ td("NOWRAP=true",b("OldHeap unused")),
+ td(Proc#proc.old_heap_unused)]),
+ tr(
+ [td("NOWRAP=true",b("Number of heap fragments")),
+ td(Proc#proc.num_heap_frag),
+ td("NOWRAP=true",b("Heap fragment data")),
+ td(Proc#proc.heap_frag_data)])]
+ end,
+ case Proc#proc.new_heap_start of
+ ?space -> "";
+ _ ->
+ %% Garbing
+ [tr(
+ [td("NOWRAP=true",b("New heap start")),
+ td("COLSPAN=1",Proc#proc.new_heap_start),
+ td("NOWRAP=true",b("New heap top")),
+ td("COLSPAN=1",Proc#proc.new_heap_top)]),
+ tr(
+ [td("NOWRAP=true",b("Stack top")),
+ td("COLSPAN=1",Proc#proc.stack_top),
+ td("NOWRAP=true",b("Stack end")),
+ td("COLSPAN=1",Proc#proc.stack_end)]),
+ tr(
+ [td("NOWRAP=true",b("Old heap start")),
+ td("COLSPAN=1",Proc#proc.old_heap_start),
+ td("NOWRAP=true",b("Old heap top")),
+ td("COLSPAN=1",Proc#proc.old_heap_top)]),
+ tr(
+ [td("NOWRAP=true",b("Old heap end")),
+ td("COLSPAN=3",Proc#proc.old_heap_end)])]
+ end,
+ case Proc#proc.prog_count of
+ ?space -> "";
+ _ ->
+ [tr(
+ [td("NOWRAP=true",b("Program counter")),
+ td("COLSPAN=3",Proc#proc.prog_count)]),
+ tr(
+ [td("NOWRAP=true",b("Continuation pointer")),
+ td("COLSPAN=3",Proc#proc.cp)]),
+ tr(
+ [td("NOWRAP=true",b("Arity")),
+ td("COLSPAN=3",Proc#proc.arity)])]
+ end,
+ tr(
+ [td("NOWRAP=true",b("Link list")),
+ td("COLSPAN=3",href_proc_port(Proc#proc.links))]),
+
+ tr(
+ [td("NOWRAP=true",b("Msg queue length")),
+ td("COLSPAN=3",integer_to_list(Proc#proc.msg_q_len))]),
+
+ %% These are displayed only if data exist
+ display_or_link_to_expand("MsgQueue",Proc#proc.msg_q,Pid),
+ display_or_link_to_expand("Dictionary",Proc#proc.dict,Pid),
+ display_or_link_to_expand("DebugDictionary",Proc#proc.debug_dict,Pid),
+ display_or_link_to_expand("LastCalls",Proc#proc.last_calls,Pid),
+ display_or_link_to_expand("StackDump",Proc#proc.stack_dump,Pid)]),
+
+ p([href(["./ets_tables?pid=",Proc#proc.pid],
+ "ETS tables owned by this process"),
+ "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;",
+ href(["./timers?pid=",Proc#proc.pid],
+ "Timers owned by this process")])].
+
+display_or_link_to_expand(Heading,Data,Pid) ->
+ case Data of
+ expand ->
+ link_to_read_memory(Heading,Pid);
+ truncated ->
+ Text = font("COLOR=\"#FF0000\"",
+ "The dump is truncated, no data available"),
+ tr(
+ [td("NOWRAP=true VALIGN=top",b(Heading)),
+ td("COLSPAN=3",Text)]);
+ ?space ->
+ "";
+ {size,Truncated,Size,Pos} ->
+ %% Too much data, or truncated data -
+ %% display a link to expand it
+ tr(
+ [td("NOWRAP=true",b(Heading)),
+ td("COLSPAN=3",
+ href("TARGET=\"expanded\" onClick=popup()",
+ ["./expand?pos=",integer_to_list(Pos),
+ "&size=",integer_to_list(Size),
+ "&what=",Heading,
+ "&truncated=",atom_to_list(Truncated)],
+ ["Expand (",integer_to_list(Size)," bytes)"]))]);
+ _ ->
+ %% Not too much Data - display it
+ tr(
+ [td("NOWRAP=true VALIGN=top",b(Heading)),
+ td("COLSPAN=3",pre(format(Heading,Data)))])
+ end.
+
+link_to_read_memory(Heading,Pid) ->
+ tr(
+ [td("NOWRAP=true",b(Heading)),
+ td("COLSPAN=3",
+ href("TARGET=\"expanded\" onClick=popup()",
+ ["./expand_memory?pid=",Pid,
+ "&what=",Heading],
+ ["Expand ", Heading]))]).
+
+format("LastCalls",Data) ->
+ Data;
+format("StackDump",Data) ->
+ Data;
+format(_Heading,Data) ->
+ pretty_format(Data).
+
+
+
+%%%-----------------------------------------------------------------
+%%% Expanded memory
+expanded_memory(Heading,Expanded) ->
+ header(Heading,body(expanded_memory_body(Heading,Expanded))).
+
+expanded_memory_body(Heading,[]) ->
+ [heading(Heading,"processes"),
+ case Heading of
+ "MsgQueue" -> "No messages were found";
+ "StackDump" -> "No stack dump was found";
+ "Dictionary" -> "No dictionary was found";
+ "DebugDictionary" -> "No debug dictionary was found"
+ end];
+expanded_memory_body(Heading,Expanded) ->
+ [heading(Heading,"processes"),
+ case Heading of
+ "MsgQueue" ->
+ table(
+ "BORDER=4 CELLPADDING=4",
+ [tr(
+ [th("Message"),
+ th("SeqTraceToken")]) |
+ lists:map(fun(Msg) -> msgq_table(Msg) end, Expanded)]);
+ "StackDump" ->
+ table(
+ "BORDER=4 CELLPADDING=4",
+ [tr(
+ [th("Label"),
+ th("Term")]) |
+ lists:map(fun(Entry) -> stackdump_table(Entry) end, Expanded)]);
+ _ ->
+ table(
+ "BORDER=4 CELLPADDING=4",
+ [tr(
+ [th("Key"),
+ th("Value")]) |
+ lists:map(fun(Entry) -> dict_table(Entry) end, Expanded)])
+ end].
+
+msgq_table({Msg0,Token0}) ->
+ Token = case Token0 of
+ [] -> ?space;
+ _ -> io_lib:fwrite("~w",[Token0])
+ end,
+ Msg = href_proc_port(lists:flatten(io_lib:format("~p",[Msg0]))),
+ tr([td(pre(Msg)), td(Token)]).
+
+stackdump_table({Label0,Term0}) ->
+ Label = io_lib:format("~w",[Label0]),
+ Term = href_proc_port(lists:flatten(io_lib:format("~p",[Term0]))),
+ tr([td("VALIGN=top",Label), td(pre(Term))]).
+
+dict_table({Key0,Value0}) ->
+ Key = href_proc_port(lists:flatten(io_lib:format("~p",[Key0]))),
+ Value = href_proc_port(lists:flatten(io_lib:format("~p",[Value0]))),
+ tr([td("VALIGN=top",pre(Key)), td(pre(Value))]).
+
+
+%%%-----------------------------------------------------------------
+%%% Display an expanded binary, i.e. the whole binary, not just the
+%%% size of it.
+expanded_binary(Bin) ->
+ Heading = "Expanded binary",
+ header(Heading,body(expanded_binary_body(Heading,Bin))).
+
+expanded_binary_body(Heading,Bin) ->
+ [h1(Heading),
+ pre(href_proc_port(lists:flatten(Bin))),
+ br(),br(),
+ href("javascript:history.go(-1)","BACK")].
+
+%%%-----------------------------------------------------------------
+%%% Print table of ports
+ports(Heading,Ports,TW) ->
+ header(Heading,body(ports_body(Heading,Ports,TW))).
+
+ports_body(Heading,[],TW) ->
+ [h1(Heading),
+ warn(TW),
+ "No ports were found\n"];
+ports_body(Heading,Ports,TW) ->
+ [heading(Heading,"ports"),
+ warn(TW),
+ table(
+ "BORDER=4 CELLPADDING=4",
+ [tr(
+ [th("Id"),
+ th("Slot"),
+ th("Connected"),
+ th("Links"),
+ th("Controls")]) |
+ lists:map(fun(Port) -> ports_table(Port) end, Ports)])].
+
+ports_table(Port) ->
+ #port{id=Id,slot=Slot,connected=Connected,links=Links,
+ controls=Controls}=Port,
+ tr(
+ [td(Id),
+ td("ALIGHT=right",Slot),
+ td(href_proc_port(Connected)),
+ td(href_proc_port(Links)),
+ td(Controls)]).
+
+%%%-----------------------------------------------------------------
+%%% Print table of ETS tables
+ets_tables(Heading,EtsTables,InternalEts,TW) ->
+ header(Heading,body(ets_tables_body(Heading,EtsTables,InternalEts,TW))).
+
+ets_tables_body(Heading,[],InternalEts,TW) ->
+ [h1(Heading),
+ warn(TW),
+ "No ETS tables were found\n" |
+ internal_ets_tables_table(InternalEts)];
+ets_tables_body(Heading,EtsTables,InternalEts,TW) ->
+ [heading(Heading,"ets_tables"),
+ warn(TW),
+ table(
+ "BORDER=4 CELLPADDING=4",
+ [tr(
+ [th("Owner"),
+ th("Slot"),
+ th("Id"),
+ th("Name"),
+ th("Type"),
+ th("Buckets"),
+ th("Objects"),
+ th("Memory (bytes)")]) |
+ lists:map(fun(EtsTable) -> ets_tables_table(EtsTable) end,
+ EtsTables)]) |
+ internal_ets_tables_table(InternalEts)].
+
+ets_tables_table(EtsTable) ->
+ #ets_table{pid=Pid,slot=Slot,id=Id,name=Name,type=Type,
+ buckets=Buckets,size=Size,memory=Memory} = EtsTable,
+ tr(
+ [td(href_proc_port(Pid)),
+ td(Slot),
+ td(Id),
+ td(Name),
+ td(Type),
+ td("ALIGN=right",Buckets),
+ td("ALIGN=right",Size),
+ td("ALIGN=right",Memory)]).
+
+internal_ets_tables_table(InternalEtsTables) ->
+ [h2("Internal ETS tables"),
+ table(
+ "BORDER=4 CELLPADDING=4",
+ [tr(
+ [th("Description"),
+ th("Id"),
+ th("Name"),
+ th("Type"),
+ th("Buckets"),
+ th("Objects"),
+ th("Memory (bytes)")]) |
+ lists:map(fun(InternalEtsTable) ->
+ internal_ets_tables_table1(InternalEtsTable)
+ end,
+ InternalEtsTables)])].
+
+internal_ets_tables_table1({Descr,InternalEtsTable}) ->
+ #ets_table{id=Id,name=Name,type=Type,buckets=Buckets,
+ size=Size,memory=Memory} = InternalEtsTable,
+ tr(
+ [td(Descr),
+ td(Id),
+ td(Name),
+ td(Type),
+ td("ALIGN=right",Buckets),
+ td("ALIGN=right",Size),
+ td("ALIGN=right",Memory)]).
+
+%%%-----------------------------------------------------------------
+%%% Print table of timers
+timers(Heading,Timers,TW) ->
+ header(Heading,body(timers_body(Heading,Timers,TW))).
+
+timers_body(Heading,[],TW) ->
+ [h1(Heading),
+ warn(TW),
+ "No timers were found\n"];
+timers_body(Heading,Timers,TW) ->
+ [heading(Heading,"timers"),
+ warn(TW),
+ table(
+ "BORDER=4 CELLPADDING=4",
+ [tr(
+ [th("Owner"),
+ th("Message"),
+ th("Time left")]) |
+ lists:map(fun(Timer) -> timers_table(Timer) end, Timers)])].
+
+timers_table(Timer) ->
+ #timer{pid=Pid,msg=Msg,time=Time}=Timer,
+ tr(
+ [td(href_proc_port(Pid)),
+ td(Msg),
+ td("ALIGN=right",Time)]).
+
+%%%-----------------------------------------------------------------
+%%% Print table of nodes in distribution
+nods(Nods,TW) ->
+ header("Distribution Information",body(nodes_body(Nods,TW))).
+
+nodes_body(no_distribution,_TW) ->
+ [heading("Distribution Information","distribution_info"),
+ "Not alive\n"];
+nodes_body({Type,Info,Node},TW) when is_record(Node,nod) ->
+ %% Display only one node - used when a pid or port on a remote
+ %% node is clicked.
+ [heading("Remote Node","distribution_info"),
+ warn(TW),
+ Info,
+ make_nodes_table(Type,[Node])];
+nodes_body({Visible,Hidden,NotConnected},TW) ->
+ %% Display all nodes - this is the complete distribution info
+ [heading("Distribution Information","distribution_info"),
+ warn(TW),
+ make_nodes_table("Visible Nodes",Visible),
+ make_nodes_table("Hidden Nodes",Hidden),
+ make_nodes_table("Not Connected Nodes",NotConnected)].
+
+make_nodes_table(Text,[]) ->
+ p(["No \"",Text,"\" were found"]);
+make_nodes_table(Text,Nodes) ->
+ p(table(
+ "BORDER=4 CELLPADDING=4",
+ [nodes_table_heading(Text),
+ lists:map(fun(Node) -> nodes_table_row(Node) end, Nodes)])).
+
+nodes_table_heading(Text) ->
+ [tr("BGCOLOR=\"#8899AA\"",[th("COLSPAN=6",Text)]),
+ tr([th("Name"),
+ th("Channel"),
+ th("Controller"),
+ th("Creation(s)"),
+ th("Links/Monitors"),
+ th("Extra info")])].
+
+nodes_table_row(Node) ->
+ #nod{name=Name,channel=Channel,controller=Controller,creation=Creation,
+ remote_links=Links,remote_mon=Mon,remote_mon_by=MonBy,error=Error}=Node,
+ tr(
+ [td(maybe_refcount(Name)),
+ td("ALIGN=right",Channel),
+ td(href_proc_port(Controller)),
+ td("ALIGN=right",break_lines_creation(Creation)),
+ td(format_links_and_monitors(Links,Mon,MonBy)),
+ td(format_extra_info(Error))]).
+
+maybe_refcount(Name) ->
+ maybe_refcount(Name, []).
+maybe_refcount([$ ,$( | Rest], Acc) ->
+ [lists:reverse(Acc),br(),[$(|Rest]];
+maybe_refcount([Char | Rest], Acc) ->
+ maybe_refcount(Rest, [Char | Acc]);
+maybe_refcount([],Acc) ->
+ lists:reverse(Acc).
+
+break_lines_creation(Creation) ->
+ break_lines_creation(Creation,[]).
+break_lines_creation([$ ,$( | Rest1], Acc) ->
+ {RefCount,Rest2} = to_end_par(Rest1,[$(,$ ]),
+ [lists:reverse(Acc),RefCount,br(),break_lines_creation(Rest2)];
+break_lines_creation([$ | Rest], Acc) ->
+ [lists:reverse(Acc),br(),break_lines_creation(Rest)];
+break_lines_creation([Char | Rest], Acc) ->
+ break_lines_creation(Rest, [Char | Acc]);
+break_lines_creation([],Acc) ->
+ lists:reverse(Acc).
+
+to_end_par([$),$ | Rest], Acc) ->
+ {lists:reverse([$) | Acc]),Rest};
+to_end_par([$) | Rest], Acc) ->
+ {lists:reverse([$) | Acc]),Rest};
+to_end_par([Char | Rest], Acc) ->
+ to_end_par(Rest, [Char | Acc]);
+to_end_par([],Acc) ->
+ {lists:reverse(Acc),[]}.
+
+
+format_links_and_monitors(?space,?space,?space) ->
+ ?space;
+format_links_and_monitors(Links,Mon,MonBy) ->
+ [format_links_and_monitors(Links," is linked to "),
+ format_links_and_monitors(Mon," is monitoring "),
+ format_links_and_monitors(MonBy," is monitored by ")].
+
+format_links_and_monitors(?space,_Text) ->
+ "";
+format_links_and_monitors([{Local,Remote}|Rest],Text) ->
+ [[href_proc_port(Local),Text,href_proc_port(Remote),br()] |
+ format_links_and_monitors(Rest,Text)];
+format_links_and_monitors([],_Text) ->
+ [].
+
+format_extra_info(?space) ->
+ ?space;
+format_extra_info(Error) ->
+ case Error of
+ ?space -> "";
+ _ -> font("COLOR=\"#FF0000\"",["ERROR: ",Error,"\n"])
+ end.
+%%%-----------------------------------------------------------------
+%%% Print loaded modules information
+loaded_mods({CC,OC,LM},TW) ->
+ Heading = "Loaded Modules Information",
+ header(Heading,body(loaded_mods_body(Heading,CC,OC,LM,TW))).
+
+loaded_mods_body(Heading,"unknown","unknown",[],TW) ->
+ [h1(Heading),
+ warn(TW),
+ "No loaded modules information was found\n"];
+loaded_mods_body(Heading,CC,OC,LM,TW) ->
+ [heading(Heading,"loaded_modules"),
+ warn(TW),
+ p([b("Current code: "),CC," bytes",br(),
+ b("Old code: "),OC," bytes"]),
+ table(
+ "BORDER=4 CELLPADDING=4",
+ [tr([th("Module"),
+ th("Current size (bytes)"),
+ th("Old size (bytes)")]) |
+ lists:map(fun(Mod) -> loaded_mods_table(Mod) end,LM)])].
+
+loaded_mods_table(#loaded_mod{mod=Mod,current_size=CS,old_size=OS}) ->
+ tr([td(href(["loaded_mod_details?mod=",Mod],Mod)),
+ td("ALIGN=right",CS),
+ td("ALIGN=right",OS)]).
+
+
+%%%-----------------------------------------------------------------
+%%% Print detailed information about one module
+loaded_mod_details(ModInfo,TW) ->
+ header(ModInfo#loaded_mod.mod,body(loaded_mod_details_body(ModInfo,TW))).
+
+loaded_mod_details_body(ModInfo,TW) ->
+ #loaded_mod{mod=Mod,current_size=CS,current_attrib=CA,
+ current_comp_info=CCI,old_size=OS,
+ old_attrib=OA,old_comp_info=OCI} = ModInfo,
+ [help("loaded_modules"),
+ warn(TW),
+ table(
+ "BORDER=4 CELLPADDING=4",
+ [tr(th("BGCOLOR=\"#8899AA\" COLSPAN=3",
+ ["Module: ",Mod])),
+ tr([td(?space),th("Current"),th("Old")]),
+ tr([th("ALIGN=left","Size (bytes)"),
+ td(CS),
+ td(OS)]),
+ tr([th("ALIGN=left","Attributes"),
+ td(pre(CA)),
+ td(pre(OA))]),
+ tr([th("ALIGN=left","Compilation info"),
+ td(pre(CCI)),
+ td(pre(OCI))])])].
+
+
+%%%-----------------------------------------------------------------
+%%% Print table of funs
+funs(Funs,TW) ->
+ Heading = "Fun Information",
+ header(Heading,body(funs_body(Heading,Funs,TW))).
+
+funs_body(Heading,[],TW) ->
+ [h1(Heading),
+ warn(TW),
+ "No Fun information was found\n"];
+funs_body(Heading,Funs,TW) ->
+ [heading(Heading,"funs"),
+ warn(TW),
+ table(
+ "BORDER=4 CELLPADDING=4",
+ [tr(
+ [th("Module"),
+ th("Uniq"),
+ th("Index"),
+ th("Address"),
+ th("Native_address"),
+ th("Refc")]) |
+ lists:map(fun(Fun) -> funs_table(Fun) end, Funs)])].
+
+funs_table(Fu) ->
+ #fu{module=Module,uniq=Uniq,index=Index,address=Address,
+ native_address=NativeAddress,refc=Refc}=Fu,
+ tr(
+ [td(Module),
+ td("ALIGN=right",Uniq),
+ td("ALIGN=right",Index),
+ td(Address),
+ td(NativeAddress),
+ td("ALIGN=right",Refc)]).
+
+%%%-----------------------------------------------------------------
+%%% Print atoms
+atoms(Atoms,Num,TW) ->
+ Heading = "Atoms",
+ header(Heading,body(atoms_body(Heading,Atoms,Num,TW))).
+
+atoms_body(Heading,[],Num,TW) ->
+ [h1(Heading),
+ warn(TW),
+ "No atoms were found in log",br(),
+ "Total number of atoms in node was ", Num, br()];
+atoms_body(Heading,Atoms,Num,TW) ->
+ [heading(Heading,"atoms"),
+ warn(TW),
+ "Total number of atoms in node was ", Num,
+ br(),
+ "The last created atom is shown first",
+ br(),br() |
+ n_first(Atoms)].
+
+n_first({n_lines,Start,N,What,Lines,Pos}) ->
+ NextHref = next_href(N,What,Pos,Start),
+ [What," number ",integer_to_list(Start),"-",integer_to_list(Start+N-1),
+ br(),
+ NextHref,
+ pre(Lines),
+ NextHref];
+n_first({n_lines,_Start,_N,_What,Lines}) ->
+ [pre(Lines)].
+
+%%%-----------------------------------------------------------------
+%%% Print next N lines of "something"
+next(NLines,TW) ->
+ header(element(4,NLines),body(next_body(NLines,TW))).
+
+next_body({n_lines,Start,N,What,Lines,Pos},TW) ->
+ PrefHref = prev_href(),
+ NextHref = next_href(N,What,Pos,Start),
+ [warn(TW),
+ What," number ",integer_to_list(Start),"-",integer_to_list(Start+N-1),
+ br(),
+ PrefHref,
+ ?space,
+ NextHref,
+ pre(Lines),
+ PrefHref,
+ ?space,
+ NextHref];
+next_body({n_lines,Start,N,What,Lines},TW) ->
+ PrefHref = prev_href(),
+ [warn(TW),
+ What," number ",integer_to_list(Start),"-",integer_to_list(Start+N-1),
+ br(),
+ PrefHref,
+ pre(Lines),
+ PrefHref].
+
+
+prev_href() ->
+ href("javascript:history.back()",["Previous"]).
+
+next_href(N,What,Pos,Start) ->
+ href(["./next?pos=",integer_to_list(Pos),
+ "&num=",integer_to_list(N),
+ "&start=",integer_to_list(Start+N),
+ "&what=",What],
+ "Next").
+
+%%%-----------------------------------------------------------------
+%%% Print memory information
+memory(Memory,TW) ->
+ Heading = "Memory Information",
+ header(Heading,body(memory_body(Heading,Memory,TW))).
+
+memory_body(Heading,[],TW) ->
+ [h1(Heading),
+ warn(TW),
+ "No memory information was found\n"];
+memory_body(Heading,Memory,TW) ->
+ [heading(Heading,"memory"),
+ warn(TW),
+ table(
+ "BORDER=4 CELLPADDING=4",
+ [tr("BGCOLOR=\"#8899AA\"",
+ [th(?space),
+ th("Bytes")]) |
+ lists:map(fun(Entry) -> memory_table(Entry) end, Memory)])].
+
+memory_table({Key,Value}) ->
+ tr([th("ALIGN=left",Key),td("ALIGN=right",Value)]).
+
+%%%-----------------------------------------------------------------
+%%% Print allocated areas information
+allocated_areas(AllocatedAreas,TW) ->
+ Heading = "Information about allocated areas",
+ header(Heading,body(allocated_areas_body(Heading,AllocatedAreas,TW))).
+
+allocated_areas_body(Heading,[],TW) ->
+ [h1(Heading),
+ warn(TW),
+ "No information was found about allocated areas\n"];
+allocated_areas_body(Heading,AllocatedAreas,TW) ->
+ [heading(Heading,"memory"),
+ warn(TW),
+ table(
+ "BORDER=4 CELLPADDING=4",
+ [tr("BGCOLOR=\"#8899AA\"",
+ [th(?space),
+ th("Allocated (bytes)"),
+ th("Used (bytes)")]) |
+ lists:map(fun(Entry) -> allocated_areas_table(Entry) end,
+ AllocatedAreas)])].
+
+allocated_areas_table({Key,Alloc,Used}) ->
+ tr(
+ [th("ALIGN=left",Key),
+ td("ALIGN=right",Alloc),
+ td("ALIGN=right",Used)]).
+
+
+%%%-----------------------------------------------------------------
+%%% Print allocator_info information
+allocator_info(Allocators,TW) ->
+ Heading = "Allocator Information",
+ header(Heading,body(allocator_info_body(Heading,Allocators,TW))).
+
+allocator_info_body(Heading,[],TW) ->
+ [h1(Heading),
+ warn(TW),
+ "No information was found about allocators\n"];
+allocator_info_body(Heading,Allocators,TW) ->
+ [heading(Heading,"memory"),
+ warn(TW),
+ p(b("Sizes are in bytes")),
+ lists:map(fun({SubTitle,Allocator}) ->
+ [table(
+ "BORDER=4 CELLPADDING=4",
+ [tr("BGCOLOR=\"#8899AA\"",
+ th("COLSPAN=10 ALIGN=left",
+ font("SIZE=+1",SubTitle))) |
+ lists:map(
+ fun({Key,Values}) ->
+ tr([th("ALIGN=left",Key) |
+ lists:map(
+ fun(Val) ->
+ td("ALIGN=right",Val)
+ end,Values)])
+ end,
+ Allocator)]),
+ br(),br()]
+ end,
+ Allocators)].
+
+%%%-----------------------------------------------------------------
+%%% Print informatin about internal tables
+hash_tables(HashTables,TW) ->
+ Heading = "Hash Table Information",
+ header(Heading,body(hash_tables_body(Heading,HashTables,TW))).
+
+hash_tables_body(Heading,[],TW) ->
+ [h1(Heading),
+ warn(TW),
+ "No hash table information was found\n"];
+hash_tables_body(Heading,HashTables,TW) ->
+ [heading(Heading,"internal_tables"),
+ warn(TW),
+ table(
+ "BORDER=4 CELLPADDING=4",
+ [tr(
+ [th("Name"),
+ th("Size"),
+ th("Used"),
+ th("Objects"),
+ th("Depth")]) |
+ lists:map(fun(HashTable) -> hash_tables_table(HashTable) end,
+ HashTables)])].
+
+hash_tables_table(HashTable) ->
+ #hash_table{name=Name,size=Size,used=Used,objs=Objs,depth=Depth}=HashTable,
+ tr(
+ [td(Name),
+ td("ALIGN=right",Size),
+ td("ALIGN=right",Used),
+ td("ALIGN=right",Objs),
+ td("ALIGN=right",Depth)]).
+
+index_tables(IndexTables,TW) ->
+ Heading = "Index Table Information",
+ header(Heading,body(index_tables_body(Heading,IndexTables,TW))).
+
+index_tables_body(Heading,[],TW) ->
+ [h1(Heading),
+ warn(TW),
+ "No index table information was found\n"];
+index_tables_body(Heading,IndexTables,TW) ->
+ [heading(Heading,"internal_tables"),
+ warn(TW),
+ table(
+ "BORDER=4 CELLPADDING=4",
+ [tr(
+ [th("Name"),
+ th("Size"),
+ th("Limit"),
+ th("Used"),
+ th("Rate")]) |
+ lists:map(fun(IndexTable) -> index_tables_table(IndexTable) end,
+ IndexTables)])].
+
+index_tables_table(IndexTable) ->
+ #index_table{name=Name,size=Size,limit=Limit,used=Used,rate=Rate} =
+ IndexTable,
+ tr(
+ [td(Name),
+ td("ALIGN=right",Size),
+ td("ALIGN=right",Limit),
+ td("ALIGN=right",Used),
+ td("ALIGN=right",Rate)]).
+
+%%%-----------------------------------------------------------------
+%%% Internal library
+header(Body) ->
+ header("","",Body).
+header(Title,Body) ->
+ header(Title,"",Body).
+header(Title,JavaScript,Body) ->
+ ["Pragma:no-cache\r\n",
+ "Content-type: text/html\r\n\r\n",
+ html_header(Title,JavaScript,Body)].
+
+html_header(Title,JavaScript,Body) ->
+ ["<HTML>\n",
+ "<HEAD>\n",
+ "<TITLE>", Title, "</TITLE>\n",
+ JavaScript,
+ "</HEAD>\n",
+ Body,
+ "</HTML>"].
+
+body(Text) ->
+ ["<BODY BGCOLOR=\"#FFFFFF\">\n",
+ Text,
+ "<\BODY>\n"].
+
+frameset(Args,Frames) ->
+ ["<FRAMESET ",Args,">\n", Frames, "\n</FRAMESET>\n"].
+frame(Args) ->
+ ["<FRAME ",Args, ">\n"].
+
+table(Args,Text) ->
+ ["<TABLE ", Args, ">\n", Text, "\n</TABLE>\n"].
+tr(Text) ->
+ ["<TR>\n", Text, "\n</TR>\n"].
+tr(Args,Text) ->
+ ["<TR ", Args, ">\n", Text, "\n</TR>\n"].
+th(Text) ->
+ ["<TH>", Text, "</TH>"].
+th(Args,Text) ->
+ ["<TH ", Args, ">\n", Text, "\n</TH>\n"].
+td(Text) ->
+ ["<TD>", Text, "</TD>"].
+td(Args,Text) ->
+ ["<TD ", Args, ">", Text, "</TD>"].
+
+b(Text) ->
+ ["<B>",Text,"</B>"].
+em(Text) ->
+ ["<EM>",Text,"</EM>\n"].
+pre(Text) ->
+ ["<PRE>",Text,"</PRE>"].
+href(Link,Text) ->
+ ["<A HREF=\"",Link,"\">",Text,"</A>"].
+href(Args,Link,Text) ->
+ ["<A HREF=\"",Link,"\" ",Args,">",Text,"</A>"].
+img("") ->
+ "";
+img(Picture) ->
+ ["<IMG SRC=\"", Picture, "\" BORDER=0>"].
+form(Args,Text) ->
+ ["<FORM ",Args,">\n",Text,"\n</FORM>\n"].
+input(Args) ->
+ ["<INPUT ", Args, ">\n"].
+h1(Text) ->
+ ["<H1>",Text,"</H1>\n"].
+h2(Text) ->
+ ["<H2>",Text,"</H2>\n"].
+font(Args,Text) ->
+ ["<FONT ",Args,">\n",Text,"\n</FONT>\n"].
+p(Text) ->
+ ["<P>",Text,"</P>\n"].
+p(Args, Text) ->
+ ["<P ", Args, ">",Text,"</P>\n"].
+br() ->
+ "<BR>\n".
+
+
+%% In all the following, "<" is changed to "&lt;" and ">" is changed to "&gt;"
+href_proc_port(Text) ->
+ href_proc_port(Text,[]).
+href_proc_port([$#,$R,$e,$f,$<|T],Acc) ->
+ %% No links to refs
+ href_proc_port(T,[$;,$t,$l,$&,$f,$e,$R,$#|Acc]);
+href_proc_port([$#,$F,$u,$n,$<|T],Acc) ->
+ %% No links to funs
+ href_proc_port(T,[$;,$t,$l,$&,$n,$u,$F,$#|Acc]);
+href_proc_port([$#,$P,$o,$r,$t,$<|T],Acc) ->
+ {[$#|Port]=HashPort,Rest} = to_gt(T,[$;,$t,$l,$&,$t,$r,$o,$P,$#]),
+ href_proc_port(Rest,[href("TARGET=\"main\"",
+ ["./ports?port=",Port],HashPort)|Acc]);
+href_proc_port([$<,$<|T],Acc) ->
+ %% No links to binaries
+ href_proc_port(T,[$;,$t,$l,$&,$;,$t,$l,$&|Acc]);
+href_proc_port([$<,C|T],Acc) when $0 =< C, C =< $9 ->
+ %% Pid
+ {Pid,Rest} = to_gt(T,[C,$;,$t,$l,$&]),
+ href_proc_port(Rest,[href("TARGET=\"main\"",
+ ["./proc_details?pid=",Pid],Pid)|Acc]);
+href_proc_port([$",$#,$C,$D,$V,$B,$i,$n,$<|T],Acc) ->
+ %% Binary written by crashdump_viewer:parse_heap_term(...)
+ {SizeAndPos,[$"|Rest]} = split($>,T),
+ {Size,Pos} = split($,,SizeAndPos),
+ href_proc_port(Rest,[href("TARGET=\"expanded\"",
+ ["./expand_binary?pos=",Pos],
+ ["&lt;&lt; ",Size," bytes &gt;&gt;"]) | Acc]);
+href_proc_port([$",$#,$C,$D,$V,$P,$o,$r,$t,$<|T],Acc) ->
+ %% Port written by crashdump_viewer:parse_term(...)
+ {[$#|Port]=HashPort,[$"|Rest]} = to_gt(T,[$;,$t,$l,$&,$t,$r,$o,$P,$#]),
+ href_proc_port(Rest,[href("TARGET=\"main\"",
+ ["./ports?port=",Port],HashPort)|Acc]);
+href_proc_port([$",$#,$C,$D,$V,$P,$i,$d,$<|T],Acc) ->
+ %% Pid written by crashdump_viewer:parse_term(...)
+ {Pid,[$"|Rest]} = to_gt(T,[$;,$t,$l,$&]),
+ href_proc_port(Rest,[href("TARGET=\"main\"",
+ ["./proc_details?pid=",Pid],Pid)|Acc]);
+href_proc_port([$',$#,$C,$D,$V,$I,$n,$c,$o,$m,$p,$l,$e,$t,$e,$H,$e,$a,$p,$'|T],
+ Acc)->
+ %% The heap is incomplete! Written by crashdump_viewer:deref_pts(...)
+ IH = lists:reverse(
+ lists:flatten(
+ "<FONT COLOR=\"#FF0000\">...(Incomplete Heap)</FONT>")),
+ href_proc_port(T,IH++Acc);
+href_proc_port([$',$#,$C,$D,$V,$T,$r,$u,$n,$c,$a,$t,$e,$d,$B,$i,$n,$a,$r,$y,$'
+ |T], Acc)->
+ %% A binary which is truncated! Written by
+ %% crashdump_viewer:parse_heap_term(...)
+ IH = lists:reverse(
+ lists:flatten(
+ "<FONT COLOR=\"#FF0000\">&lt;&lt;...(Truncated Binary)&gt;&gt;"
+ "</FONT>")),
+ href_proc_port(T,IH++Acc);
+href_proc_port([$',$#,$C,$D,$V,$N,$o,$n,$e,$x,$i,$s,$t,$i,$n,$g,$B,$i,$n,$a,$r,
+ $y,$'|T], Acc)->
+ %% A binary which could not be found in the dump! Written by
+ %% crashdump_viewer:parse_heap_term(...)
+ IH = lists:reverse(
+ lists:flatten(
+ "<FONT COLOR=\"#FF0000\">&lt;&lt;...(Nonexisting Binary)&gt;&gt;"
+ "</FONT>")),
+ href_proc_port(T,IH++Acc);
+href_proc_port([$<|T],Acc) ->
+ href_proc_port(T,[$;,$t,$l,$&|Acc]);
+href_proc_port([$>|T],Acc) ->
+ href_proc_port(T,[$;,$t,$g,$&|Acc]);
+href_proc_port([H|T],Acc) ->
+ href_proc_port(T,[H|Acc]);
+href_proc_port([],Acc) ->
+ lists:reverse(Acc).
+
+to_gt(Str,Acc) ->
+ {Match,Rest} = to_gt_noreverse(Str,Acc),
+ {lists:reverse(Match),Rest}.
+to_gt_noreverse([$>|T],Acc) ->
+ {[$;,$t,$g,$&|Acc],T};
+to_gt_noreverse([H|T],Acc) ->
+ to_gt_noreverse(T,[H|Acc]);
+to_gt_noreverse([],Acc) ->
+ {Acc,[]}.
+
+split(Char,Str) ->
+ split(Char,Str,[]).
+split(Char,[Char|Str],Acc) -> % match Char
+ {lists:reverse(Acc),Str};
+split(Char,[H|T],Acc) ->
+ split(Char,T,[H|Acc]).
+
+
+warn([]) ->
+ [];
+warn(Warning) ->
+ font("COLOR=\"#FF0000\"",p([Warning,br(),br()])).
+
+heading(Heading,HelpMarker) ->
+ [font("SIZE=+2",b(Heading)),?space,?space,help(HelpMarker)].
+
+help(HelpMarker) ->
+ [href("TARGET=doc",
+ ["/crashdump_doc/crashdump_help.html#",HelpMarker],
+ "Help"),
+ br(),br()].
+
+%%%-----------------------------------------------------------------
+%%% This function pretty formats a string which contains erlang
+%%% terms (e.g. the message queue).
+%%% In all the following, "<" is changed to "&lt;" and ">" is changed to "&gt;"
+pretty_format(In) ->
+ case catch scan(In,[],initial,[]) of
+ {'EXIT',_Reason} ->
+ %% Probably a truncated file, so the erlang term is not complete
+ [font("COLOR=\"#FF0000\"","(This term might be truncated)"),
+ href_proc_port(lists:flatten(In))];
+ {[R],_,Insrt} ->
+ InsrtString = lists:flatten(io_lib:format("~p",[R])),
+ lists:flatten(replace_insrt(lists:reverse(InsrtString),Insrt,[]))
+ end.
+
+%% Finish term
+scan(In,Acc,list,Insrt) when hd(In)==$] ->
+ {lists:reverse(Acc),tl(In),Insrt};
+scan(In,Acc,tuple,Insrt) when hd(In)==$} ->
+ {list_to_tuple(lists:reverse(Acc)),tl(In),Insrt};
+scan(In,Acc,atom,Insrt) when In==[];hd(In)==$,;hd(In)==$];hd(In)==$} ->
+ {list_to_atom(lists:reverse(Acc)),In,Insrt};
+scan(In,Acc,float,Insrt) when In==[];hd(In)==$,;hd(In)==$];hd(In)==$} ->
+ {list_to_float(lists:reverse(Acc)),In,Insrt};
+scan(In,Acc,integer,Insrt) when In==[];hd(In)==$,;hd(In)==$];hd(In)==$} ->
+ {list_to_integer(lists:reverse(Acc)),In,Insrt};
+scan([$"|In],Acc,string,Insrt) when In==[];hd(In)==$,;hd(In)==$];hd(In)==$} ->
+ {lists:reverse(Acc),In,Insrt};
+scan([$>|In],Acc,special,Insrt) when In==[];hd(In)==$,;hd(In)==$];hd(In)==$} ->
+ %% pid, ref, port, fun
+ {lists:reverse([$;,$t,$g,$&|Acc]),In,Insrt};
+scan([$}|In],Acc,special,Insrt) when In==[];hd(In)==$,;hd(In)==$];hd(In)==$} ->
+ %% bignum integer, e.g. #integer(2) = {2452,4324}
+ {lists:reverse([$}|Acc]),In,Insrt};
+scan([$,|In],Acc,Cur,Insrt) when Cur/=string,Cur/=special ->
+ scan(In,Acc,Cur,Insrt);
+
+%% In the middle of an atom
+scan([$'|In],Acc,Cur,Insrt) when Cur==atom ->
+ %% all $' are removed. They are added again by list_to_atom,
+ %% so if we don't remove them we will get two of them.
+ scan(In,Acc,Cur,Insrt);
+
+%% A $. in the middle of an integer - turn to float
+scan([C|T],Acc,integer,Insrt) when C==$. ->
+ scan(T,[C|Acc],float,Insrt);
+
+%% In the middle of an atom, integer, float or string
+scan([$<|T],Acc,Cur,Insrt) when Cur==atom;Cur==string;Cur==special ->
+ scan(T,[$;,$t,$l,$&|Acc],Cur,Insrt);
+scan([$>|T],Acc,Cur,Insrt) when Cur==atom;Cur==string ->
+ scan(T,[$;,$t,$g,$&|Acc],Cur,Insrt);
+scan([C|T],Acc,Cur,Insrt) when Cur==atom;Cur==integer;Cur==float;Cur==string;Cur==special ->
+ scan(T,[C|Acc],Cur,Insrt);
+
+%% Start list
+scan([$[|T],Acc,Cur,Insrt0) ->
+ {L,Rest,Insrt} = scan(T,[],list,Insrt0),
+ scan(Rest,[L|Acc],Cur,Insrt);
+
+%% Star tuple
+scan([${|T],Acc,Cur,Insrt0) ->
+ {Tuple,Rest,Insrt} = scan(T,[],tuple,Insrt0),
+ scan(Rest,[Tuple|Acc],Cur,Insrt);
+
+%% Star string
+scan([$"|T],Acc,Cur,Insrt0) ->
+ {String,Rest,Insrt} = scan(T,[],string,Insrt0),
+ scan(Rest,[String|Acc],Cur,Insrt);
+
+%% Start atom
+scan([$'|T],Acc,Cur,Insrt0) ->
+ %% all $' are removed. They are added again by list_to_atom,
+ %% so if we don't remove them we will get two of them.
+ {Atom,Rest,Insrt} = scan(T,[],atom,Insrt0),
+ scan(Rest,[Atom|Acc],Cur,Insrt);
+scan([C|T],Acc,Cur,Insrt0) when C>=$A,C=<$Z;C>=$a,C=<$z;C==$'->
+ {Atom,Rest,Insrt} = scan(T,[C],atom,Insrt0),
+ scan(Rest,[Atom|Acc],Cur,Insrt);
+
+%% Start integer or float
+scan([C|T],Acc,Cur,Insrt0) when C>=$0,C=<$9;C==$- ->
+ {Num,Rest,Insrt} = scan(T,[C],integer,Insrt0), % can later change to float
+ scan(Rest,[Num|Acc],Cur,Insrt);
+
+%% Start Pid/Port/Ref/Fun/Binary
+scan([$<|T],Acc,Cur,Insrt0) ->
+ {Special,Rest,Insrt} = scan(T,[$;,$t,$l,$&],special,Insrt0),
+ scan(Rest,['$insrt'|Acc],Cur,[Special|Insrt]);
+scan([$#|T],Acc,Cur,Insrt0) ->
+ {Special,Rest,Insrt} = scan(T,[$#],special,Insrt0),
+ scan(Rest,['$insrt'|Acc],Cur,[Special|Insrt]);
+
+
+%% done
+scan([],Acc,initial,Insrt) ->
+ {Acc,[],Insrt}.
+
+
+replace_insrt("'trsni$'"++Rest,[H|T],Acc) -> % the list is reversed here!
+ Special =
+ case H of
+ "&lt;&lt;" ++ _Binary ->
+ H;
+ "&lt;" ++ _Pid ->
+ href("TARGET=\"main\"",["./proc_details?pid=",H],H);
+ "#Port&lt;" ++ Port ->
+ href("TARGET=\"main\"",["./ports?port=","Port&lt;"++Port],H);
+ "#" ++ _other ->
+ H
+ end,
+ replace_insrt(Rest,T,[Special|Acc]);
+replace_insrt([H|T],Insrt,Acc) ->
+ replace_insrt(T,Insrt,[H|Acc]);
+replace_insrt([],[],Acc) ->
+ Acc.
diff --git a/lib/observer/src/etop.erl b/lib/observer/src/etop.erl
new file mode 100644
index 0000000000..0bf1d68534
--- /dev/null
+++ b/lib/observer/src/etop.erl
@@ -0,0 +1,344 @@
+%%
+%% %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(etop).
+-author('[email protected]').
+
+-export([start/0, start/1, config/2, stop/0, dump/1, help/0]).
+%% Internal
+-export([update/1]).
+-export([loadinfo/1, meminfo/2, getopt/2]).
+
+-include("etop.hrl").
+-include("etop_defs.hrl").
+
+-define(change_at_runtime_config,[lines,interval,sort,accumulate]).
+
+help() ->
+ io:format(
+ "Usage of the erlang top program~n"
+ "Options are set as command line parameters as in -node a@host -..~n"
+ "or as parameter to etop:start([{node, a@host}, {...}])~n"
+ "Options are:~n"
+ " node atom Required The erlang node to measure ~n"
+ " port integer The used port, NOTE: due to a bug this program~n"
+ " will hang if the port is not avaiable~n"
+ " accumulate boolean If true execution time is accumulated ~n"
+ " lines integer Number of displayed processes~n"
+ " interval integer Display update interval in secs~n"
+ " sort runtime | reductions | memory | msg_q~n"
+ " What information to sort by~n"
+ " Default: runtime (reductions if tracing=off)~n"
+ " output graphical | text~n"
+ " How to present results~n"
+ " Default: graphical~n"
+ " tracing on | off etop uses the erlang trace facility, and thus~n"
+ " no other tracing is possible on the node while~n"
+ " etop is running, unless this option is set to~n"
+ " 'off'. Also helpful if the etop tracing causes~n"
+ " too high load on the measured node.~n"
+ " With tracing off, runtime is not measured!~n"
+ " setcookie string Only applicable on operating system command~n"
+ " line. Set cookie for the etop node, must be~n"
+ " same as the cookie for the measured node.~n"
+ " This is not an etop parameter~n"
+ ).
+
+stop() ->
+ case whereis(etop_server) of
+ undefined -> not_started;
+ Pid when is_pid(Pid) -> etop_server ! stop
+ end.
+
+config(Key,Value) ->
+ case check_runtime_config(Key,Value) of
+ ok ->
+ etop_server ! {config,{Key,Value}},
+ ok;
+ error ->
+ {error,illegal_opt}
+ end.
+check_runtime_config(lines,L) when is_integer(L),L>0 -> ok;
+check_runtime_config(interval,I) when is_integer(I),I>0 -> ok;
+check_runtime_config(sort,S) when S=:=runtime;
+ S=:=reductions;
+ S=:=memory;
+ S=:=msg_q -> ok;
+check_runtime_config(accumulate,A) when A=:=true; A=:=false -> ok;
+check_runtime_config(_Key,_Value) -> error.
+
+dump(File) ->
+ case file:open(File,[write]) of
+ {ok,Fd} -> etop_server ! {dump,Fd};
+ Error -> Error
+ end.
+
+start() ->
+ start([]).
+
+start(Opts) ->
+ process_flag(trap_exit, true),
+ Config1 = handle_args(init:get_arguments() ++ Opts, #opts{}),
+ Config2 = Config1#opts{server=self()},
+
+ %% Connect to the node we want to look at
+ Node = getopt(node, Config2),
+ case net_adm:ping(Node) of
+ pang when Node /= node() ->
+ io:format("Error Couldn't connect to node ~p ~n~n", [Node]),
+ help(),
+ exit("connection error");
+ _pong ->
+ check_runtime_tools_vsn(Node)
+ end,
+
+ %% Maybe set up the tracing
+ Config3 =
+ if Config2#opts.tracing == on, Node /= node() ->
+ %% Cannot trace on current node since the tracer will
+ %% trace itself
+ etop_tr:setup_tracer(Config2);
+ true ->
+ if Config2#opts.sort == runtime ->
+ Config2#opts{sort=reductions,tracing=off};
+ true ->
+ Config2#opts{tracing=off}
+ end
+ end,
+ AccumTab = ets:new(accum_tab,
+ [set,public,{keypos,#etop_proc_info.pid}]),
+ Config4 = Config3#opts{accum_tab=AccumTab},
+
+ %% Start the output server
+ Out = spawn_link(Config4#opts.out_mod, init, [Config4]),
+ Config5 = Config4#opts{out_proc = Out},
+
+ init_data_handler(Config5),
+ ok.
+
+check_runtime_tools_vsn(Node) ->
+ case rpc:call(Node,observer_backend,vsn,[]) of
+ {ok,Vsn} -> check_vsn(Vsn);
+ _ -> exit("Faulty version of runtime_tools on remote node")
+ end.
+check_vsn(_Vsn) -> ok.
+%check_vsn(_Vsn) -> exit("Faulty version of runtime_tools on remote node").
+
+
+%% Handle the incoming data
+
+init_data_handler(Config) ->
+ register(etop_server,self()),
+ Reader =
+ if Config#opts.tracing == on -> etop_tr:reader(Config);
+ true -> undefined
+ end,
+ data_handler(Reader, Config).
+
+data_handler(Reader, Opts) ->
+ receive
+ stop ->
+ stop(Opts),
+ ok;
+ {config,{Key,Value}} ->
+ data_handler(Reader,putopt(Key,Value,Opts));
+ {dump,Fd} ->
+ Opts#opts.out_proc ! {dump,Fd},
+ data_handler(Reader,Opts);
+ {'EXIT', EPid, Reason} when EPid == Opts#opts.out_proc ->
+ case Reason of
+ normal -> ok;
+ _ -> io:format("Output server crashed: ~p~n",[Reason])
+ end,
+ stop(Opts),
+ out_proc_stopped;
+ {'EXIT', Reader, eof} ->
+ io:format("Lost connection to node ~p exiting~n", [Opts#opts.node]),
+ stop(Opts),
+ connection_lost;
+ _ ->
+ data_handler(Reader, Opts)
+ end.
+
+stop(Opts) ->
+ (Opts#opts.out_mod):stop(Opts#opts.out_proc),
+ if Opts#opts.tracing == on -> etop_tr:stop_tracer(Opts);
+ true -> ok
+ end,
+ unregister(etop_server).
+
+update(#opts{store=Store,node=Node,tracing=Tracing}=Opts) ->
+ Pid = spawn_link(Node,observer_backend,etop_collect,[self()]),
+ Info = receive {Pid,I} -> I
+ after 1000 -> exit(connection_lost)
+ end,
+ #etop_info{procinfo=ProcInfo} = Info,
+ ProcInfo1 =
+ if Tracing == on ->
+ PI=lists:map(fun(PI=#etop_proc_info{pid=P}) ->
+ case ets:lookup(Store,P) of
+ [{P,T}] -> PI#etop_proc_info{runtime=T};
+ [] -> PI
+ end
+ end,
+ ProcInfo),
+ PI;
+ true ->
+ lists:map(fun(PI) -> PI#etop_proc_info{runtime='-'} end,ProcInfo)
+ end,
+ ProcInfo2 = sort(Opts,ProcInfo1),
+ Info#etop_info{procinfo=ProcInfo2}.
+
+sort(Opts,PI) ->
+ Tag = get_tag(Opts#opts.sort),
+ PI1 = if Opts#opts.accum ->
+ PI;
+ true ->
+ AccumTab = Opts#opts.accum_tab,
+ lists:map(
+ fun(#etop_proc_info{pid=Pid,reds=Reds,runtime=RT}=I) ->
+ NewI =
+ case ets:lookup(AccumTab,Pid) of
+ [#etop_proc_info{reds=OldReds,
+ runtime='-'}] ->
+ I#etop_proc_info{reds=Reds-OldReds,
+ runtime='-'};
+ [#etop_proc_info{reds=OldReds,
+ runtime=OldRT}] ->
+ I#etop_proc_info{reds=Reds-OldReds,
+ runtime=RT-OldRT};
+ [] ->
+ I
+ end,
+ ets:insert(AccumTab,I),
+ NewI
+ end,
+ PI)
+ end,
+ PI2 = lists:reverse(lists:keysort(Tag,PI1)),
+ lists:sublist(PI2,Opts#opts.lines).
+
+get_tag(runtime) -> #etop_proc_info.runtime;
+get_tag(memory) -> #etop_proc_info.mem;
+get_tag(reductions) -> #etop_proc_info.reds;
+get_tag(msg_q) -> #etop_proc_info.mq.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Configuration Management
+
+getopt(What, Config) when is_record(Config, opts) ->
+ case What of
+ node -> Config#opts.node;
+ port -> Config#opts.port;
+ accum -> Config#opts.accum;
+ intv -> Config#opts.intv;
+ lines -> Config#opts.lines;
+ sort -> Config#opts.sort;
+ width -> Config#opts.width;
+ height-> Config#opts.height;
+
+ store -> Config#opts.store;
+ host -> Config#opts.host
+ end.
+
+putopt(Key, Value, Config) when is_record(Config, opts) ->
+ Config1 = handle_args([{Key,Value}],Config),
+ Config1#opts.out_proc ! {config,{Key,Value},Config1},
+ Config1.
+
+handle_args([{node, [NodeString]}| R], Config) when is_list(NodeString) ->
+ Node = list_to_atom(NodeString),
+ NewC = Config#opts{node = Node},
+ handle_args(R, NewC);
+handle_args([{node, Node} |R], Config) when is_atom(Node) ->
+ NewC = Config#opts{node = Node},
+ handle_args(R, NewC);
+handle_args([{port, Port}| R], Config) when is_integer(Port) ->
+ NewC = Config#opts{port=Port},
+ handle_args(R, NewC);
+handle_args([{port, [Port]}| R], Config) when is_list(Port) ->
+ NewC = Config#opts{port= list_to_integer(Port)},
+ handle_args(R, NewC);
+handle_args([{interval, Time}| R], Config) when is_integer(Time)->
+ NewC = Config#opts{intv=Time*1000},
+ handle_args(R, NewC);
+handle_args([{interval, [Time]}| R], Config) when is_list(Time)->
+ NewC = Config#opts{intv=list_to_integer(Time)*1000},
+ handle_args(R, NewC);
+handle_args([{lines, Lines}| R], Config) when is_integer(Lines) ->
+ NewC = Config#opts{lines=Lines},
+ handle_args(R, NewC);
+handle_args([{lines, [Lines]}| R], Config) when is_list(Lines) ->
+ NewC = Config#opts{lines= list_to_integer(Lines)},
+ handle_args(R, NewC);
+handle_args([{accumulate, Bool}| R], Config) when is_atom(Bool) ->
+ NewC = Config#opts{accum=Bool},
+ handle_args(R, NewC);
+handle_args([{accumulate, [Bool]}| R], Config) when is_list(Bool) ->
+ NewC = Config#opts{accum= list_to_atom(Bool)},
+ handle_args(R, NewC);
+handle_args([{sort, Sort}| R], Config) when is_atom(Sort) ->
+ NewC = Config#opts{sort=Sort},
+ handle_args(R, NewC);
+handle_args([{sort, [Sort]}| R], Config) when is_list(Sort) ->
+ NewC = Config#opts{sort= list_to_atom(Sort)},
+ handle_args(R, NewC);
+handle_args([{output, Output}| R], Config) when is_atom(Output) ->
+ NewC = Config#opts{out_mod=output(Output)},
+ handle_args(R, NewC);
+handle_args([{output, [Output]}| R], Config) when is_list(Output) ->
+ NewC = Config#opts{out_mod= output(list_to_atom(Output))},
+ handle_args(R, NewC);
+handle_args([{tracing, OnOff}| R], Config) when is_atom(OnOff) ->
+ NewC = Config#opts{tracing=OnOff},
+ handle_args(R, NewC);
+handle_args([{tracing, [OnOff]}| R], Config) when is_list(OnOff) ->
+ NewC = Config#opts{tracing=list_to_atom(OnOff)},
+ handle_args(R, NewC);
+
+handle_args([_| R], C) ->
+ handle_args(R, C);
+handle_args([], C) ->
+ C.
+
+output(graphical) -> etop_gui;
+output(text) -> etop_txt.
+
+
+loadinfo(SysI) ->
+ #etop_info{n_procs = Procs,
+ run_queue = RQ,
+ now = Now,
+ wall_clock = {_, WC},
+ runtime = {_, RT}} = SysI,
+ Cpu = round(100*RT/WC),
+ Clock = io_lib:format("~2.2.0w:~2.2.0w:~2.2.0w",
+ tuple_to_list(element(2,calendar:now_to_datetime(Now)))),
+ {Cpu,Procs,RQ,Clock}.
+
+meminfo(MemI, [Tag|Tags]) ->
+ [round(get_mem(Tag, MemI)/1024)|meminfo(MemI, Tags)];
+meminfo(_MemI, []) -> [].
+
+get_mem(Tag, MemI) ->
+ case lists:keysearch(Tag, 1, MemI) of
+ {value, {Tag, I}} -> I; %these are in bytes
+ _ -> 0
+ end.
+
diff --git a/lib/observer/src/etop_defs.hrl b/lib/observer/src/etop_defs.hrl
new file mode 100644
index 0000000000..664de61973
--- /dev/null
+++ b/lib/observer/src/etop_defs.hrl
@@ -0,0 +1,29 @@
+%%
+%% %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%
+%%
+-define(SYSFORM,
+ " ~-72w~10s~n"
+ " Load: cpu ~8w Memory: total ~8w binary ~8w~n"
+ " procs~8w processes~8w code ~8w~n"
+ " runq ~8w atom ~8w ets ~8w~n").
+
+-record(opts, {node=node(), port = 8415, accum = false, intv = 5000, lines = 10,
+ width = 700, height = 340, sort = runtime, tracing = on,
+ %% Other state information
+ out_mod=etop_gui, out_proc, server, host, tracer, store,
+ accum_tab, remote}).
diff --git a/lib/observer/src/etop_gui.erl b/lib/observer/src/etop_gui.erl
new file mode 100644
index 0000000000..ff1b8078ad
--- /dev/null
+++ b/lib/observer/src/etop_gui.erl
@@ -0,0 +1,362 @@
+%%
+%% %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(etop_gui).
+-author('[email protected]').
+
+-export([init/1,stop/1]).
+-export([formatmfa/1,to_list/1]).% For etop_txt
+
+-include("etop.hrl").
+-include("etop_defs.hrl").
+
+-import(etop, [loadinfo/1, meminfo/2, getopt/2]).
+
+%% Heights
+-define(BarH, 28). % height of menubar
+-define(LabelH, 90). % height of label with system info
+-define(GridLineH, 21). % height of one line in the table (grid)
+
+%% Column numbers for grid - click to sort
+-define(TimeCol, 3).
+-define(RedsCol, 4).
+-define(MemCol, 5).
+-define(MsgQCol, 6).
+
+%% Font
+-define(Normal, {screen,12}).
+-define(Bold, {screen,bold,12}).
+
+
+%% -----------------------------------------------------------------------------
+stop(_) -> ok.
+
+init(Config) ->
+ S = gs:start(),
+ Width = getopt(width, Config),
+ TotLines = getopt(lines,Config)+1,
+
+ %% Max number of processes shown in window at startup is 10
+ %% If less than 10 lines is specified, window size fits number of lines
+ WinH = if TotLines > 11 -> 11*?GridLineH + ?BarH + ?LabelH;
+ true -> TotLines*?GridLineH + ?BarH + ?LabelH
+ end,
+ Win = gs:create(window, S,
+ [{title, "Erlang Top"},
+ {map, true}, %% While debugging
+ {configure, true},
+ {width, Width}, {height, WinH}]),
+ Bar = gs:create(menubar, Win, []),
+
+ FileButt = gs:create(menubutton, Bar, [{label,{text, " File "}}]),
+ OptionsButt = gs:create(menubutton, Bar, [{label,{text, " Options "}}]),
+ File = gs:create(menu, FileButt, []),
+ Options = gs:create(menu, OptionsButt, []),
+ gse:named_menuitem(refresh, File,
+ [{label,{text," Refresh "}}]),
+ gse:named_menuitem(dump, File,
+ [{label,{text," Dump to file "}}]),
+ gse:named_menuitem(exit, File,
+ [{label,{text," Exit "}}]),
+
+ gse:named_menuitem(accum, Options,
+ [{label,{text, " Accumulate "}},
+ {itemtype, check}]),
+ gse:named_menuitem(intv, Options,
+ [{label,{text, " Update Interval "}}]),
+ gse:named_menuitem(lines, Options,
+ [{label,{text, " Number of Lines "}}]),
+ Sort = gse:named_menuitem(sort, Options,
+ [{label,{text, " Sort "}},
+ {itemtype,cascade}]),
+ SortMenu = gse:create(menu, Sort, []),
+ gse:named_menuitem(runtime, SortMenu,
+ [{label,{text, " Time "}},
+ {itemtype,radio},{group,gr1}]),
+ gse:named_menuitem(memory, SortMenu,
+ [{label,{text, " Memory "}},
+ {itemtype,radio},{group,gr1}]),
+ gse:named_menuitem(reductions, SortMenu,
+ [{label,{text, " Reductions "}},
+ {itemtype,radio},{group,gr1}]),
+ gse:named_menuitem(msg_q, SortMenu,
+ [{label,{text, " Message Queue "}},
+ {itemtype,radio},{group,gr1}]),
+
+ SysInfo = gs:create(label,Win,[{x, 0}, {y, ?BarH},{align,sw},
+ {width, Width},{height,?LabelH}]),
+
+ {GridH,VScroll} = calc_grid_h(WinH,TotLines),
+ Grid = gse:grid(Win,
+ [{x, 0}, {y, ?BarH+?LabelH},
+ {width, Width},
+ {height, GridH},
+ {hscroll, false},
+ {vscroll, VScroll},
+ {columnwidths, calc_column_w(Width)},
+ {rows, {1, TotLines}},
+ {font,?Normal}]),
+
+ %% Header line
+ GL1 = gse:gridline(Grid, [{{text, 1}, "PID"},
+ {{text, 2}, "Name or Initial Function"},
+ {{text, ?TimeCol}, "Time(us)"},
+ {{text, ?RedsCol}, "Reds"},
+ {{text, ?MemCol}, "Memory"},
+ {{text, ?MsgQCol}, "MsgQ"},
+ {{text, 7}, "Current Function"},
+ {bg, lightblue},
+ {row, 1},
+ {click, true}]),
+
+ config_sort(GL1,getopt(sort,Config)),
+ Info = do_update(Grid, SysInfo, Config),
+
+ get_event(Info, Win, Grid, GL1, SysInfo, Config).
+
+calc_column_w(W) ->
+ %% W = [2x, 3x, 1x, 1x, 1x, 1x, 3x] = 12x
+ RW = W-9, % just to make nice small margins on each side of grid
+ X = RW div 12,
+ [2*X, 3*X, X, X, X, X, 3*X + (RW - 12*X)].
+
+config_sort(GL1,Sort) ->
+ gs:config(Sort,[{select,true}]),
+ lists:foreach(fun(S) ->
+ gs:config(GL1,[{{font,S},?Normal}])
+ end,
+ [?TimeCol,?MemCol,?RedsCol,?MsgQCol]),
+ case Sort of
+ runtime -> gs:config(GL1,{{font,?TimeCol},?Bold});
+ memory -> gs:config(GL1,{{font,?MemCol},?Bold});
+ reductions -> gs:config(GL1,{{font,?RedsCol},?Bold});
+ msg_q -> gs:config(GL1,{{font,?MsgQCol},?Bold})
+ end.
+
+config_lines(Win,Grid,TotLines) ->
+ OldGridH = gs:read(Grid,height),
+ NewLinesH = TotLines*?GridLineH,
+ if NewLinesH =< OldGridH ->
+ gs:config(Win,[{height,NewLinesH+?BarH+?LabelH}]),
+ gs:config(Grid,[{rows,{1,TotLines}},
+ {height,NewLinesH},
+ {vscroll,false}]);
+ true ->
+ gs:config(Grid,[{rows,{1,TotLines}},{vscroll,right}])
+ end.
+
+calc_grid_h(WinH,TotLines) ->
+ LeftInWin = WinH - ?BarH - ?LabelH,
+ TotGrid = TotLines * ?GridLineH,
+ if LeftInWin >= TotGrid ->
+ {TotGrid,false};
+ true ->
+ {LeftInWin,right}
+ end.
+
+set_win_h(Win,OrigH,TotLines) ->
+ TotH = TotLines*?GridLineH + ?BarH + ?LabelH,
+ if TotH >= OrigH -> OrigH;
+ true -> gs:config(Win,[{height,TotH}]),
+ TotH
+ end.
+
+get_event(Info, Win, Grid, GL1, SysInfo, Config) ->
+ receive
+ {gs, Win, configure,[],[W,H,_,_]} ->
+ TotLines = getopt(lines,Config)+1,
+ %% Will not make window higher than total number of lines
+ RealWinH = set_win_h(Win,H,TotLines),
+ {GridH,VScroll} = calc_grid_h(RealWinH,TotLines),
+ gs:config(Grid, [{width, W},
+ {columnwidths, calc_column_w(W)},
+ {height,GridH}, {vscroll,VScroll}]),
+ get_event(Info, Win, Grid, GL1, SysInfo, Config);
+ {gs, refresh, _, _, _} ->
+ Info1 = do_update(Grid, SysInfo, Config),
+ get_event(Info1, Win, Grid, GL1, SysInfo, Config);
+ {gs, dump, _, _, _} ->
+ case pop(Win,dump) of
+ {ok,File} -> etop:dump(File);
+ {error,cancel} -> ok
+ end,
+ get_event(Info, Win, Grid, GL1, SysInfo, Config);
+ {gs, Win, destroy, _, _} ->
+ normal;
+ {gs, exit, _, _, _} ->
+ ok;
+ {gs, accum, _, _, _} ->
+ Old = getopt(accum,Config),
+ etop:config(accumulate,not Old),
+ get_event(Info, Win, Grid, GL1, SysInfo, Config);
+ {gs,intv,_,_,_} ->
+ case pop(Win,interval) of
+ {ok,Intv} -> etop:config(interval,list_to_integer(Intv));
+ {error,cancel} -> ok
+ end,
+ get_event(Info, Win, Grid, GL1, SysInfo, Config);
+ {gs,lines,_,_,_} ->
+ case pop(Win,lines) of
+ {ok,Lines} -> etop:config(lines,list_to_integer(Lines));
+ {error,cancel} -> ok
+ end,
+ get_event(Info, Win, Grid, GL1, SysInfo, Config);
+ {gs,Sort,_,_,_} when Sort=:=runtime;
+ Sort=:=memory;
+ Sort=:=reductions;
+ Sort=:=msg_q ->
+ etop:config(sort,Sort),
+ get_event(Info, Win, Grid, GL1, SysInfo, Config);
+ {gs,GL1,click,_,[Col,1,_]} ->
+ case Col of
+ ?TimeCol -> etop:config(sort, runtime);
+ ?MemCol -> etop:config(sort, memory);
+ ?RedsCol -> etop:config(sort, reductions);
+ ?MsgQCol -> etop:config(sort, msg_q);
+ _other -> ignore
+ end,
+ get_event(Info, Win, Grid, GL1, SysInfo, Config);
+ {config,{Key,Value},Config1} ->
+ case Key of
+ lines -> config_lines(Win,Grid,Value+1);
+ sort -> config_sort(GL1,Value);
+ accumulate -> gs:config(accum,[{select,Value}]);
+ _ -> ok
+ end,
+ Info1 = do_update(Grid, SysInfo, Config1),
+ get_event(Info1, Win, Grid, GL1, SysInfo, Config1);
+ {dump,Fd} ->
+ etop_txt:do_update(Fd,Info,Config),
+ get_event(Info, Win, Grid, GL1, SysInfo, Config);
+ Msg ->
+ io:format("~p got unexpected msg ~p~n", [?MODULE, Msg]),
+ get_event(Info, Win, Grid, GL1, SysInfo, Config)
+ after getopt(intv,Config) ->
+ Info1 = do_update(Grid, SysInfo, Config),
+ get_event(Info1, Win, Grid, GL1, SysInfo, Config)
+ end.
+
+do_update(Grid, SysInfo, Config) ->
+ Info = etop:update(Config),
+ Lines = makegridlines(Info#etop_info.procinfo, Grid, 2),
+ clear_lines(Lines, getopt(lines,Config) + 1, Grid),
+ makesysinfo(getopt(node,Config),Info,SysInfo),
+ Info.
+
+%clear_lines(From, To, _Grid) when From > To -> ok;
+clear_lines(From, To, Grid) ->
+ case gs:read(Grid, {obj_at_row, From}) of
+ undefined ->
+ ok;
+ GridLine ->
+ gs:destroy(GridLine),
+ clear_lines(From + 1, To, Grid)
+ end.
+
+formatmfa({M, F, A}) ->
+ io_lib:format("~w:~w/~w",[M, F, A]).
+
+makegridlines([#etop_proc_info{pid=Pid,
+ mem=Mem,
+ reds=Reds,
+ name=Name,
+ runtime=Time,
+ cf=MFA,
+ mq=MQ}
+ |T], Grid, Count) ->
+ update_gl(Grid, Count, [{{text, 1}, pid_to_list(Pid)},
+ {{text, 2}, to_list(Name)},
+ {{text, ?TimeCol},
+ if is_integer(Time)->integer_to_list(Time);
+ true -> Time
+ end},
+ {{text, ?RedsCol}, integer_to_list(Reds)},
+ {{text, ?MemCol}, integer_to_list(Mem)},
+ {{text, ?MsgQCol}, integer_to_list(MQ)},
+ {{text, 7}, formatmfa(MFA)},
+ {row, Count}, {click, false}]),
+ makegridlines(T, Grid, Count + 1);
+makegridlines([],_Grid,Count) ->
+ Count.
+
+update_gl(Grid, Row, GL) ->
+ case gs:read(Grid, {obj_at_row, Row}) of
+ undefined ->
+ gse:gridline(Grid,[{row, Row}|GL]);
+ GridLine ->
+ gs:config(GridLine,GL)
+ end.
+
+to_list(Name) when is_atom(Name) -> atom_to_list(Name);
+to_list({_M,_F,_A}=MFA) -> formatmfa(MFA).
+
+
+makesysinfo(Node,Info,SysInfo) ->
+ {Cpu,NProcs,RQ,Clock} = loadinfo(Info),
+ case Info#etop_info.memi of
+ undefined ->
+ Str = "No memory information is available.";
+ Memi ->
+ [Tot,Procs,Atom,Bin,Code,Ets] =
+ meminfo(Memi, [total,processes,atom,binary,code,ets]),
+ Str = io_lib:fwrite(?SYSFORM,
+ [Node,Clock,
+ Cpu,Tot,Bin,
+ NProcs,Procs,Code,
+ RQ,Atom,Ets])
+ end,
+ gs:config(SysInfo,[{label,{text,Str}},{font,?Normal}]).
+
+
+pop(Win,Key) ->
+ Pop = gs:create(window,Win,[{title,"Config"},
+ {width,160},{height,100}]),
+ gs:create(label,Pop,[{label,{text,txt(Key)}},
+ {width,160}]),
+ gs:create(entry,entry,Pop,[{x,10},{y,30},{width,130},
+ {keypress,true}]),
+ gs:create(button,ok,Pop,[{width,45},{y,60},{x,10},
+ {label,{text,"Ok"}}]),
+ gs:create(button,cancel,Pop,[{width,60},{y,60},{x,80},
+ {label,{text,"Cancel"}}]),
+ gs:config(Pop,{map,true}),
+ pop_loop(Pop).
+
+pop_loop(Pop) ->
+ receive
+ {gs,entry,keypress,_,['Return'|_]} ->
+ Str = gs:read(entry,text),
+ gs:destroy(Pop),
+ {ok,Str};
+ {gs,entry,keypress,_,_} -> % all other keypresses
+ pop_loop(Pop);
+ {gs,ok,click,_,_} ->
+ Str = gs:read(entry,text),
+ gs:destroy(Pop),
+ {ok,Str};
+ {gs,cancel,click,_,_} ->
+ gs:destroy(Pop),
+ {error,cancel};
+ X ->
+ io:format("Got X=~w~n",[X]),
+ pop_loop(Pop)
+ end.
+
+txt(interval) -> "Enter new interval:";
+txt(lines) -> "Enter number of lines:";
+txt(dump) -> "Enter file name:".
diff --git a/lib/observer/src/etop_tr.erl b/lib/observer/src/etop_tr.erl
new file mode 100644
index 0000000000..dd326fe639
--- /dev/null
+++ b/lib/observer/src/etop_tr.erl
@@ -0,0 +1,130 @@
+%%
+%% %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(etop_tr).
+-author('[email protected]').
+
+%%-compile(export_all).
+-export([setup_tracer/1,stop_tracer/1,reader/1]).
+-import(etop,[getopt/2]).
+
+-include("etop_defs.hrl").
+
+setup_tracer(Config) ->
+ TraceNode = getopt(node,Config),
+ RHost = rpc:call(TraceNode, net_adm, localhost, []),
+ Store = ets:new(?MODULE, [set, public]),
+
+ %% We can only trace one process anyway kill the old one.
+ case erlang:whereis(dbg) of
+ undefined ->
+ case rpc:call(TraceNode, erlang, whereis, [dbg]) of
+ undefined -> fine;
+ Pid ->
+ exit(Pid, kill)
+ end;
+ Pid ->
+ exit(Pid,kill)
+ end,
+
+ dbg:tracer(TraceNode,port,dbg:trace_port(ip,{getopt(port,Config),5000})),
+ dbg:p(all,[running,timestamp]),
+ T = dbg:get_tracer(TraceNode),
+ Config#opts{tracer=T,host=RHost,store=Store}.
+
+stop_tracer(_Config) ->
+ dbg:p(all,clear),
+ dbg:stop(),
+ ok.
+
+
+
+reader(Config) ->
+ Host = getopt(host, Config),
+ Port = getopt(port, Config),
+
+ {ok, Sock} = gen_tcp:connect(Host, Port, [{active, false}]),
+ spawn_link(fun() -> reader_init(Sock,getopt(store,Config),nopid) end).
+
+
+%%%%%%%%%%%%%% Socket reader %%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+reader_init(Sock, Store, Last) ->
+ process_flag(priority, high),
+ reader(Sock, Store, Last).
+
+reader(Sock, Store, Last) ->
+ Data = get_data(Sock),
+ New = handle_data(Last, Data, Store),
+ reader(Sock, Store, New).
+
+handle_data(_, {_, Pid, in, _, Time}, _) ->
+ {Pid,Time};
+handle_data({Pid,Time1}, {_, Pid, out, _, Time2}, Store) ->
+ Elapsed = elapsed(Time1, Time2),
+ case ets:member(Store,Pid) of
+ true -> ets:update_counter(Store, Pid, Elapsed);
+ false -> ets:insert(Store,{Pid,Elapsed})
+ end,
+ nopid;
+handle_data(_W, {drop, D}, _) -> %% Error case we are missing data here!
+ io:format("Erlang top dropped data ~p~n", [D]),
+ nopid;
+handle_data(nopid, {_, _, out, _, _}, _Store) ->
+ %% ignore - there was probably just a 'drop'
+ nopid;
+handle_data(_, G, _) ->
+ io:format("Erlang top got garbage ~p~n", [G]),
+ nopid.
+
+elapsed({Me1, S1, Mi1}, {Me2, S2, Mi2}) ->
+ Me = (Me2 - Me1) * 1000000,
+ S = (S2 - S1 + Me) * 1000000,
+ Mi2 - Mi1 + S.
+
+
+%%%%%% Socket helpers %%%%
+get_data(Sock) ->
+ [Op | BESiz] = my_ip_read(Sock, 5),
+ Siz = get_be(BESiz),
+ case Op of
+ 0 ->
+ B = list_to_binary(my_ip_read(Sock, Siz)),
+ binary_to_term(B);
+ 1 ->
+ {drop, Siz};
+ Else ->
+ exit({'bad trace tag', Else})
+ end.
+
+get_be([A,B,C,D]) ->
+ A * 16777216 + B * 65536 + C * 256 + D.
+
+my_ip_read(Sock,N) ->
+ case gen_tcp:recv(Sock, N) of
+ {ok, Data} ->
+ case length(Data) of
+ N ->
+ Data;
+ X ->
+ Data ++ my_ip_read(Sock, N - X)
+ end;
+ _Else ->
+ exit(eof)
+ end.
+
diff --git a/lib/observer/src/etop_txt.erl b/lib/observer/src/etop_txt.erl
new file mode 100644
index 0000000000..d0612f15b4
--- /dev/null
+++ b/lib/observer/src/etop_txt.erl
@@ -0,0 +1,101 @@
+%%
+%% %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(etop_txt).
+-author('[email protected]').
+
+%%-compile(export_all).
+-export([init/1,stop/1]).
+-export([do_update/3]).
+
+-include("etop.hrl").
+-include("etop_defs.hrl").
+
+-import(etop,[loadinfo/1,meminfo/2]).
+-import(etop_gui,[formatmfa/1,to_list/1]).
+
+-define(PROCFORM,"~-15w~-20s~8w~8w~8w~8w ~-20s~n").
+
+stop(Pid) -> Pid ! stop.
+
+init(Config) ->
+ loop(Config).
+
+loop(Config) ->
+ Info = do_update(Config),
+ receive
+ stop -> stopped;
+ {dump,Fd} -> do_update(Fd,Info,Config), loop(Config);
+ {config,_,Config1} -> loop(Config1)
+ after Config#opts.intv -> loop(Config)
+ end.
+
+do_update(Config) ->
+ Info = etop:update(Config),
+ do_update(standard_io,Info,Config).
+
+do_update(Fd,Info,Config) ->
+ {Cpu,NProcs,RQ,Clock} = loadinfo(Info),
+ io:nl(Fd),
+ writedoubleline(Fd),
+ case Info#etop_info.memi of
+ undefined ->
+ io:fwrite(Fd, " ~-72w~10s~n"
+ " Load: cpu ~8w~n"
+ " procs~8w~n"
+ " runq ~8w~n",
+ [Config#opts.node,Clock,
+ Cpu,NProcs,RQ]);
+ Memi ->
+ [Tot,Procs,Atom,Bin,Code,Ets] =
+ meminfo(Memi, [total,processes,atom,binary,code,ets]),
+ io:fwrite(Fd, ?SYSFORM,
+ [Config#opts.node,Clock,
+ Cpu,Tot,Bin,
+ NProcs,Procs,Code,
+ RQ,Atom,Ets])
+ end,
+ io:nl(Fd),
+ writepinfo_header(Fd),
+ writesingleline(Fd),
+ writepinfo(Fd,Info#etop_info.procinfo),
+ writedoubleline(Fd),
+ io:nl(Fd),
+ Info.
+
+writepinfo_header(Fd) ->
+ io:fwrite(Fd,"Pid Name or Initial Func Time Reds Memory MsgQ Current Function~n",[]).
+
+writesingleline(Fd) ->
+ io:fwrite(Fd,"----------------------------------------------------------------------------------------~n",[]).
+writedoubleline(Fd) ->
+ io:fwrite(Fd,"========================================================================================~n",[]).
+
+writepinfo(Fd,[#etop_proc_info{pid=Pid,
+ mem=Mem,
+ reds=Reds,
+ name=Name,
+ runtime=Time,
+ cf=MFA,
+ mq=MQ}
+ |T]) ->
+ io:fwrite(Fd,?PROCFORM,[Pid,to_list(Name),Time,Reds,Mem,MQ,formatmfa(MFA)]),
+ writepinfo(Fd,T);
+writepinfo(_Fd,[]) ->
+ ok.
+
diff --git a/lib/observer/src/multitrace.erl b/lib/observer/src/multitrace.erl
new file mode 100644
index 0000000000..144697ce9c
--- /dev/null
+++ b/lib/observer/src/multitrace.erl
@@ -0,0 +1,256 @@
+%%
+%% %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(multitrace).
+-author('[email protected]').
+
+-export([debug/1,gc/1,schedule/1,stop/0,format/1,format/2]).
+-export([handle_debug/4,handle_gc/4,handle_schedule/4]).
+
+%%
+%% Tool API
+%%
+debug(Func) ->
+ case running() of
+ false ->
+ {ok,_} = ttb:tracer(all,
+ [{file,"debug_trace"},
+ {handler, {{?MODULE,handle_debug},initial}}]),
+ init(),
+ {ok,_} = ttb:p(all,[timestamp,c]),
+ tp(Func),
+ ok;
+ true ->
+ {error, tracer_already_running}
+ end.
+
+tp([Func|Funcs]) ->
+ tp(Func),
+ tp(Funcs);
+tp([]) -> ok;
+tp({M,F,A}) -> do_tp(M,F,A);
+tp({M,F}) -> do_tp(M,F,'_');
+tp(M) -> do_tp(M,'_','_').
+
+do_tp(M,F,A) ->
+ {ok,_}=ttb:tp(M,F,A,[{'_',[],[{message,{caller}},{return_trace}]}]).
+
+gc(Proc) ->
+ case running() of
+ false ->
+ {ok,_} = ttb:tracer(all,[{file,"gc_trace"},
+ {handler,{{?MODULE,handle_gc},initial}},
+ {process_info,false}]),
+ init(),
+ {ok,_} = ttb:p(Proc,[timestamp,garbage_collection]),
+ ok;
+ true ->
+ {error, tracer_already_running}
+ end.
+
+schedule(Proc) ->
+ case running() of
+ false ->
+ {ok,_} = ttb:tracer(all,
+ [{file,"schedule_trace"},
+ {handler,{{?MODULE,handle_schedule},initial}},
+ {process_info,false}]),
+ init(),
+ {ok,_} = ttb:p(Proc,[timestamp,running]),
+ ok;
+ true ->
+ {error, tracer_already_running}
+ end.
+
+stop() ->
+ ttb:stop().
+
+format(File) ->
+ ttb:format(File).
+format(File,Out) ->
+ ttb:format(File,[{out,Out}]).
+
+
+%%
+%% Print call trace
+%%
+handle_debug(Out,Trace,TI,initial) ->
+ print_header(Out,TI),
+ handle_debug(Out,Trace,TI,0);
+handle_debug(_Out,end_of_trace,_TI,N) ->
+ N;
+handle_debug(Out,Trace,_TI,N) ->
+ print_func(Out,Trace,N),
+ N+1.
+
+print_func(Out,{trace_ts,P,call,{M,F,A},C,Ts},N) ->
+ io:format(Out,
+ "~w: ~s~n"
+ "Process : ~w~n"
+ "Call : ~w:~w/~w~n"
+ "Arguments : ~p~n"
+ "Caller : ~w~n~n",
+ [N,ts(Ts),P,M,F,length(A),A,C]);
+print_func(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) ->
+ io:format(Out,
+ "~w: ~s~n"
+ "Process : ~w~n"
+ "Return from : ~w:~w/~w~n"
+ "Return value : ~p~n~n",
+ [N,ts(Ts),P,M,F,A,R]).
+
+
+%%
+%% Print GC trace
+%%
+handle_gc(_Out,end_of_trace,_TI,S) ->
+ S;
+handle_gc(Out,Trace,TI,initial) ->
+ print_header(Out,TI),
+ print_gc_header(Out),
+ handle_gc(Out,Trace,TI,dict:new());
+handle_gc(_Out,{trace_ts,P,gc_start,Info,Ts},_TI,S) ->
+ dict:store(P,{Info,Ts},S);
+handle_gc(Out,{trace_ts,P,gc_end,Info,Ts},_TI,S) ->
+ case dict:find(P,S) of
+ {ok,{StartInfo,StartTime}} ->
+ {EM,ER,ES,EO,EH,EOB,EB} = sort(Info),
+ {SM,SR,SS,SO,SH,SOB,SB} = sort(StartInfo),
+ io:format(Out,
+ "start\t~w\t~w\t~w\t~w\t~w\t~w\t~w\t~w~n"
+ "end\t~w\t~w\t~w\t~w\t~w\t~w\t~w\t~w~n~n",
+ [SM,SR,SS,SO,SH,SOB,SB,P,EM,ER,ES,EO,EH,EOB,EB,diff(StartTime,Ts)]),
+ dict:erase(P,S);
+ error ->
+ S
+ end.
+
+print_gc_header(Out) ->
+ io:format(Out,
+ "\tMBuf\tRecent\tStack\tOldHeap\tHeap\tOldBL\tBlock\t"
+ "Process/Time(micro sec)~n"
+ "============================================="
+ "============================================~n",[]).
+
+sort(GC) ->
+ sort(GC,{0,0,0,0,0,'_','_'}).
+sort([{mbuf_size,M}|Rest],{_,R,S,O,H,OB,B}) ->
+ sort(Rest,{M,R,S,O,H,OB,B});
+sort([{recent_size,R}|Rest],{M,_,S,O,H,OB,B}) ->
+ sort(Rest,{M,R,S,O,H,OB,B});
+sort([{stack_size,S}|Rest],{M,R,_,O,H,OB,B}) ->
+ sort(Rest,{M,R,S,O,H,OB,B});
+sort([{old_heap_size,O}|Rest],{M,R,S,_,H,OB,B}) ->
+ sort(Rest,{M,R,S,O,H,OB,B});
+sort([{heap_size,H}|Rest],{M,R,S,O,_,OB,B}) ->
+ sort(Rest,{M,R,S,O,H,OB,B});
+sort([{old_heap_block_size,OB}|Rest],{M,R,S,O,H,_,B}) ->
+ sort(Rest,{M,R,S,O,H,OB,B});
+sort([{heap_block_size,B}|Rest],{M,R,S,O,H,OB,_}) ->
+ sort(Rest,{M,R,S,O,H,OB,B});
+sort([],GC) ->
+ GC.
+
+
+%%
+%% Print scheduling trace
+%%
+handle_schedule(Out,Trace,TI,initial) ->
+ print_header(Out,TI),
+ handle_schedule(Out,Trace,TI,[]);
+handle_schedule(Out,end_of_trace,_TI,S) ->
+ summary(Out,S);
+handle_schedule(Out,{trace_ts,P,out,Info,Ts},_TI,S) ->
+ io:format(Out,
+ "out:~n"
+ "Process : ~w~n"
+ "Time : ~s~n"
+ "Function : ~w~n~n",[P,ts(Ts),Info]),
+ case lists:keysearch(P,1,S) of
+ {value,{P,List}} ->
+ lists:keyreplace(P,1,S,{P,[{out,Ts}|List]});
+ false ->
+ [{P,[{out,Ts}]} | S]
+ end;
+handle_schedule(Out,{trace_ts,P,in,Info,Ts},_TI,S) ->
+ io:format(Out,
+ "in:~n"
+ "Process : ~w~n"
+ "Time : ~s~n"
+ "Function : ~w~n~n",[P,ts(Ts),Info]),
+ case lists:keysearch(P,1,S) of
+ {value,{P,List}} ->
+ lists:keyreplace(P,1,S,{P,[{in,Ts}|List]});
+ false ->
+ [{P,[{in,Ts}]} | S]
+ end.
+
+
+summary(Out,[{P,List}|Rest]) ->
+ Sum = proc_summary(List,0),
+ io:format(Out,"Total time 'in' for process ~w: ~w micro seconds~n",[P,Sum]),
+ summary(Out,Rest);
+summary(_Out,[]) ->
+ ok.
+
+proc_summary([{in,_Start}|Rest],Acc) ->
+ proc_summary(Rest,Acc);
+proc_summary([{out,End},{in,Start}|Rest],Acc) ->
+ Diff = diff(Start,End),
+ proc_summary(Rest,Acc+Diff);
+proc_summary([],Acc) ->
+ Acc.
+
+
+%%
+%% Library functions
+%%
+ts({_, _, Micro} = Now) ->
+ {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(Now),
+ io_lib:format("~4.4.0w-~2.2.0w-~2.2.0w ~2.2.0w:~2.2.0w:~2.2.0w,~6.6.0w",
+ [Y,M,D,H,Min,S,Micro]).
+
+
+diff({SMeg,SS,SMic},{EMeg,ES,EMic}) ->
+ (EMeg-SMeg)*1000000000000 + (ES-SS)*1000000 + (EMic-SMic).
+
+
+init() ->
+ ttb:write_trace_info(start_time,fun() -> now() end).
+
+print_header(Out,TI) ->
+ {value,{node,[Node]}} = lists:keysearch(node,1,TI),
+ {value,{flags,Flags}} = lists:keysearch(flags,1,TI),
+ case lists:keysearch(start_time,1,TI) of
+ {value,{start_time,[ST]}} ->
+ io:format(Out,
+ "~nTracing started on node ~w at ~s~n"
+ "Flags: ~p~n~n~n",
+ [Node,ts(ST),Flags]);
+ false -> % in case this file was not loaded on the traced node
+ io:format(Out,
+ "~nTracing from node ~w~n"
+ "Flags: ~p~n~n~n",
+ [Node,Flags])
+ end.
+
+running() ->
+ case whereis(ttb) of
+ undefined -> false;
+ _Pid -> true
+ end.
diff --git a/lib/observer/src/observer.app.src b/lib/observer/src/observer.app.src
new file mode 100644
index 0000000000..5c65ea5c8f
--- /dev/null
+++ b/lib/observer/src/observer.app.src
@@ -0,0 +1,34 @@
+%%
+%% %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%
+%%
+{application, observer,
+ [{description, "OBSERVER version 1"},
+ {vsn, "%VSN%"},
+ {modules, [crashdump_viewer,
+ crashdump_viewer_html,
+ etop,
+ etop_gui,
+ etop_tr,
+ etop_txt,
+ ttb,
+ ttb_et]},
+ {registered, []},
+ {applications, [kernel, stdlib]},
+ {env, []}]}.
+
+
diff --git a/lib/observer/src/observer.appup.src b/lib/observer/src/observer.appup.src
new file mode 100644
index 0000000000..1d5a0d93f5
--- /dev/null
+++ b/lib/observer/src/observer.appup.src
@@ -0,0 +1,19 @@
+%%
+%% %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%
+%%
+{"%VSN%",[],[]}.
diff --git a/lib/observer/src/ttb.erl b/lib/observer/src/ttb.erl
new file mode 100644
index 0000000000..221b71df6a
--- /dev/null
+++ b/lib/observer/src/ttb.erl
@@ -0,0 +1,1000 @@
+%%
+%% %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(ttb).
+-author('[email protected]').
+
+%% API
+-export([tracer/0,tracer/1,tracer/2,p/2,stop/0,stop/1]).
+-export([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]).
+-export([seq_trigger_ms/0,seq_trigger_ms/1]).
+-export([write_trace_info/2]).
+-export([write_config/2,write_config/3,run_config/1,run_config/2,list_config/1]).
+-export([list_history/0,run_history/1]).
+-export([format/1,format/2]).
+
+%% For debugging
+-export([dump_ti/1]).
+
+-include_lib("kernel/include/file.hrl").
+-define(meta_time,5000).
+-define(history_table,ttb_history_table).
+-define(seq_trace_flags,[send,'receive',print,timestamp]).
+-define(upload_dir,"ttb_upload").
+-ifdef(debug).
+-define(get_status,;get_status -> erlang:display(dict:to_list(NodeInfo)),loop(NodeInfo)).
+-else.
+-define(get_status,).
+-endif.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Open a trace port on all given nodes and create the meta data file
+tracer() -> tracer(node()).
+tracer(Nodes) -> tracer(Nodes,[]).
+tracer(Nodes,Opt) ->
+ start(),
+ store(tracer,[Nodes,Opt]),
+ {PI,Client,Traci} = opt(Opt),
+ do_tracer(Nodes,PI,Client,Traci).
+
+do_tracer(Nodes0,PI,Client,Traci) ->
+ Nodes = nods(Nodes0),
+ Clients = clients(Nodes,Client),
+ do_tracer(Clients,PI,Traci).
+
+do_tracer(Clients,PI,Traci) ->
+ {ClientSucc,Succ} =
+ lists:foldl(
+ fun({N,{local,File},TF},{CS,S}) ->
+ [_Sname,Host] = string:tokens(atom_to_list(N),"@"),
+ case catch dbg:tracer(N,port,dbg:trace_port(ip,0)) of
+ {ok,N} ->
+ {ok,Port} = dbg:trace_port_control(N,get_listen_port),
+ {ok,T} = dbg:get_tracer(N),
+ rpc:call(N,seq_trace,set_system_tracer,[T]),
+ dbg:trace_client(ip,{Host,Port},
+ {fun ip_to_file/2,{file,File}}),
+ {[{N,{local,File,Port},TF}|CS], [N|S]};
+ Other ->
+ display_warning(N,{cannot_open_ip_trace_port,
+ Host,
+ Other}),
+ {CS, S}
+ end;
+ ({N,C,_}=Client,{CS,S}) ->
+ case catch dbg:tracer(N,port,dbg:trace_port(file,C)) of
+ {ok,N} ->
+ {ok,T} = dbg:get_tracer(N),
+ rpc:call(N,seq_trace,set_system_tracer,[T]),
+ {[Client|CS], [N|S]};
+ Other ->
+ display_warning(N,Other),
+ {CS,S}
+ end
+ end,
+ {[],[]},
+ Clients),
+ case Succ of
+ [] ->
+ {ok,Succ};
+ _list ->
+ write_info(ClientSucc,PI,Traci),
+ {ok,Succ}
+ end.
+
+opt(Opt) ->
+ opt(Opt,{true,?MODULE,[]}).
+
+opt([{process_info,PI}|O],{_,Client,Traci}) ->
+ opt(O,{PI,Client,Traci});
+opt([{file,Client}|O],{PI,_,Traci}) ->
+ opt(O,{PI,Client,Traci});
+opt([{handler,Handler}|O],{PI,Client,Traci}) ->
+ opt(O,{PI,Client,[{handler,Handler}|Traci]});
+opt([],Opt) ->
+ Opt.
+
+nods(all) ->
+ Nodes1 = remove_active([node()|nodes()]),
+ remove_faulty_runtime_tools_vsn(Nodes1);
+nods(Node) when is_atom(Node) ->
+ nods([Node]);
+nods(Nodes) when is_list(Nodes) ->
+ Nodes1 = remove_active(Nodes),
+ Nodes2 = remove_noexist(Nodes1),
+ remove_faulty_runtime_tools_vsn(Nodes2).
+
+remove_active(Nodes) ->
+ Active = get_nodes(),
+ lists:filter(
+ fun(N) -> case lists:member(N,Active) of
+ false -> true;
+ true -> display_warning(N,already_started), false
+ end
+ end, Nodes).
+
+remove_noexist(Nodes) ->
+ lists:filter(
+ fun(N) when N=:=node() ->
+ true;
+ (N) ->
+ case net_adm:ping(N) of
+ pong -> true;
+ pang -> display_warning(N,no_connection), false
+ end
+ end, Nodes).
+
+remove_faulty_runtime_tools_vsn(Nodes) ->
+ lists:filter(
+ fun(N) ->
+ case rpc:call(N,observer_backend,vsn,[]) of
+ {ok,Vsn} -> check_vsn(N,Vsn);
+ _Error -> display_warning(N,faulty_vsn_of_runtime_tools), false
+ end
+ end,Nodes).
+
+check_vsn(_Node,_Vsn) -> true.
+%check_vsn(Node,_Vsn) ->
+% display_warning(Node,faulty_vsn_of_runtime_tools),
+% false.
+
+clients(Nodes, {wrap,Name}) ->
+ F = fun(Node) ->
+ TraceFile = name(Node,Name),
+ {Node,{TraceFile++".",wrap,".wrp"},TraceFile}
+ end,
+ lists:map(F,Nodes);
+clients(Nodes, {wrap,Name,Size,Count}) ->
+ F = fun(Node) ->
+ TraceFile = name(Node,Name),
+ {Node,{TraceFile++".",wrap,".wrp",Size,Count},TraceFile}
+ end,
+ lists:map(F,Nodes);
+clients(Nodes, {local,RealClient}) ->
+ WrapClients = clients(Nodes,RealClient),
+ F = fun({Node,Client,TraceFile}) ->
+ {Node,{local,Client},TraceFile}
+ end,
+ lists:map(F,WrapClients);
+clients(Nodes, Name) ->
+ F = fun(Node) ->
+ TraceFile = name(Node,Name),
+ {Node,TraceFile,TraceFile}
+ end,
+ lists:map(F,Nodes).
+
+name(Node,Filename) ->
+ Dir = filename:dirname(Filename),
+ File = filename:basename(Filename),
+ filename:join(Dir,atom_to_list(Node) ++ "-" ++ File).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Handling of config file
+store(Func,Args) ->
+ Last = case ets:last(?history_table) of
+ '$end_of_table' -> 0;
+ Int when is_integer(Int) -> Int
+ end,
+ ets:insert(?history_table,{Last+1,{?MODULE,Func,Args}}).
+
+list_history() ->
+ %% the check is only to see if the tool is started.
+ case ets:info(?history_table) of
+ undefined -> {error, not_running};
+ _info -> ets:tab2list(?history_table)
+ end.
+
+run_history([H|T]) ->
+ case run_history(H) of
+ ok -> run_history(T);
+ {error,not_found} -> {error,{not_found,H}}
+ end;
+run_history([]) ->
+ ok;
+run_history(N) ->
+ case catch ets:lookup(?history_table,N) of
+ [{N,{M,F,A}}] ->
+ print_func(M,F,A),
+ R = apply(M,F,A),
+ print_result(R);
+ _ ->
+ {error, not_found}
+ end.
+
+write_config(ConfigFile,all) ->
+ write_config(ConfigFile,['_']);
+write_config(ConfigFile,Config) ->
+ write_config(ConfigFile,Config,[]).
+write_config(ConfigFile,all,Opt) ->
+ write_config(ConfigFile,['_'],Opt);
+write_config(ConfigFile,Nums,Opt) when is_list(Nums), is_integer(hd(Nums));
+ Nums=:=['_'] ->
+ F = fun(N) -> ets:select(?history_table,
+ [{{N,'$1'},[],['$1']}])
+ end,
+ Config = lists:append(lists:map(F,Nums)),
+ do_write_config(ConfigFile,Config,Opt);
+write_config(ConfigFile,Config,Opt) when is_list(Config) ->
+ case check_config(Config,[]) of
+ {ok,Config1} -> do_write_config(ConfigFile,Config1,Opt);
+ Error -> Error
+ end.
+
+do_write_config(ConfigFile,Config,Opt) ->
+ case Opt of
+ [append] -> ok;
+ [] -> file:delete(ConfigFile)
+ end,
+ write_binary(ConfigFile,Config).
+
+check_config([{?MODULE=Mod,Func,Args}|Rest],Acc) ->
+ %% Check only in this module, since other modules might not
+ %% be loaded at the time of creating the config file.
+ case erlang:function_exported(Mod,Func,length(Args)) of
+ true -> check_config(Rest,[{Mod,Func,Args}|Acc]);
+ false -> {error, {not_exported,{Mod,Func,Args}}}
+ end;
+check_config([{Mod,Func,Args}|Rest],Acc) ->
+ check_config(Rest,[{Mod,Func,Args}|Acc]);
+check_config([],Acc) ->
+ {ok,lists:reverse(Acc)};
+check_config([Other|_Rest],_Acc) ->
+ {error,{illegal_config,Other}}.
+
+
+list_config(ConfigFile) ->
+ case file:read_file(ConfigFile) of
+ {ok,B} -> read_config(B,[],1);
+ Error -> Error
+ end.
+
+read_config(<<>>,Acc,_N) ->
+ lists:reverse(Acc);
+read_config(B,Acc,N) ->
+ {{M,F,A},Rest} = get_term(B),
+ read_config(Rest,[{N,{M,F,A}}|Acc],N+1).
+
+
+run_config(ConfigFile) ->
+ case list_config(ConfigFile) of
+ Config when is_list(Config) ->
+ lists:foreach(fun({_,{M,F,A}}) -> print_func(M,F,A),
+ R = apply(M,F,A),
+ print_result(R)
+ end,
+ Config);
+ Error -> Error
+ end.
+
+run_config(ConfigFile,N) ->
+ case list_config(ConfigFile) of
+ Config when is_list(Config) ->
+ case lists:keysearch(N,1,Config) of
+ {value,{N,{M,F,A}}} ->
+ print_func(M,F,A),
+ apply(M,F,A);
+ false ->
+ {error, not_found}
+ end;
+ Error -> Error
+ end.
+
+
+print_func(M,F,A) ->
+ Args = arg_list(A,[]),
+ io:format("~w:~w(~s) ->~n",[M,F,Args]).
+print_result(R) ->
+ io:format("~p~n~n",[R]).
+
+arg_list([],[]) ->
+ "";
+arg_list([A1],Acc) ->
+ Acc++io_lib:format("~w",[A1]);
+arg_list([A1|A],Acc) ->
+ arg_list(A,Acc++io_lib:format("~w,",[A1])).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Set trace flags on processes
+p(Procs0,Flags0) ->
+ store(p,[Procs0,Flags0]),
+ no_store_p(Procs0,Flags0).
+no_store_p(Procs0,Flags0) ->
+ case transform_flags(to_list(Flags0)) of
+ {error,Reason} ->
+ {error,Reason};
+ Flags ->
+ Procs = procs(Procs0),
+ case lists:foldl(fun(P,{PMatched,Ps}) -> case dbg:p(P,Flags) of
+ {ok,Matched} ->
+ {[{P,Matched}|PMatched],[P|Ps]};
+ {error,Reason} ->
+ display_warning(P,Reason),
+ {PMatched,Ps}
+ end
+ end,{[],[]},Procs) of
+ {[],[]} -> {error, no_match};
+ {SuccMatched,Succ} ->
+ no_store_write_trace_info(flags,{Succ,Flags}),
+ {ok,SuccMatched}
+ end
+ end.
+
+transform_flags([clear]) ->
+ [clear];
+transform_flags(Flags) ->
+ dbg:transform_flags(Flags).
+
+
+procs(Procs) when is_list(Procs) ->
+ lists:foldl(fun(P,Acc) -> proc(P)++Acc end,[],Procs);
+procs(Proc) ->
+ proc(Proc).
+
+proc(Procs) when Procs=:=all; Procs=:=existing; Procs=:=new ->
+ [Procs];
+proc(Name) when is_atom(Name) ->
+ [Name]; % can be registered on this node or other node
+proc(Pid) when is_pid(Pid) ->
+ [Pid];
+proc({global,Name}) ->
+ case global:whereis_name(Name) of
+ Pid when is_pid(Pid) ->
+ [Pid];
+ undefined ->
+ []
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Trace pattern
+tp(A,B) ->
+ store(tp,[A,B]),
+ dbg:tp(A,B).
+tp(A,B,C) ->
+ store(tp,[A,B,C]),
+ dbg:tp(A,B,C).
+tp(A,B,C,D) ->
+ store(tp,[A,B,C,D]),
+ dbg:tp(A,B,C,D).
+
+tpl(A,B) ->
+ store(tpl,[A,B]),
+ dbg:tpl(A,B).
+tpl(A,B,C) ->
+ store(tpl,[A,B,C]),
+ dbg:tpl(A,B,C).
+tpl(A,B,C,D) ->
+ store(tpl,[A,B,C,D]),
+ dbg:tpl(A,B,C,D).
+
+ctp() ->
+ store(ctp,[]),
+ dbg:ctp().
+ctp(A) ->
+ store(ctp,[A]),
+ dbg:ctp(A).
+ctp(A,B) ->
+ store(ctp,[A,B]),
+ dbg:ctp(A,B).
+ctp(A,B,C) ->
+ store(ctp,[A,B,C]),
+ dbg:ctp(A,B,C).
+
+ctpl() ->
+ store(ctpl,[]),
+ dbg:ctpl().
+ctpl(A) ->
+ store(ctpl,[A]),
+ dbg:ctpl(A).
+ctpl(A,B) ->
+ store(ctpl,[A,B]),
+ dbg:ctpl(A,B).
+ctpl(A,B,C) ->
+ store(ctpl,[A,B,C]),
+ dbg:ctpl(A,B,C).
+
+ctpg() ->
+ store(ctpg,[]),
+ dbg:ctpg().
+ctpg(A) ->
+ store(ctpg,[A]),
+ dbg:ctpg(A).
+ctpg(A,B) ->
+ store(ctpg,[A,B]),
+ dbg:ctpg(A,B).
+ctpg(A,B,C) ->
+ store(ctpg,[A,B,C]),
+ dbg:ctpg(A,B,C).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Support for sequential trace
+seq_trigger_ms() -> seq_trigger_ms(all).
+seq_trigger_ms(all) -> seq_trigger_ms(?seq_trace_flags);
+seq_trigger_ms(Flag) when is_atom(Flag) -> seq_trigger_ms([Flag],[]);
+seq_trigger_ms(Flags) -> seq_trigger_ms(Flags,[]).
+seq_trigger_ms([Flag|Flags],Body) ->
+ case lists:member(Flag,?seq_trace_flags) of
+ true -> seq_trigger_ms(Flags,[{set_seq_token,Flag,true}|Body]);
+ false -> {error,{illegal_flag,Flag}}
+ end;
+seq_trigger_ms([],Body) ->
+ [{'_',[],Body}].
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Write information to the .ti file
+write_trace_info(Key,What) ->
+ store(write_trace_info,[Key,What]),
+ no_store_write_trace_info(Key,What).
+
+no_store_write_trace_info(Key,What) ->
+ case whereis(?MODULE) of
+ undefined -> ok;
+ Pid when is_pid(Pid) -> ?MODULE ! {write_trace_info,Key,What}
+ end,
+ ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Stop tracing on all nodes
+stop() ->
+ stop([]).
+stop(Opts) ->
+ Fetch = stop_opts(Opts),
+ case whereis(?MODULE) of
+ undefined -> ok;
+ Pid when is_pid(Pid) ->
+ ?MODULE ! {stop,Fetch,self()},
+ receive {?MODULE,stopped} -> ok end
+ end,
+ stopped.
+
+stop_opts(Opts) ->
+ case lists:member(format,Opts) of
+ true ->
+ format; % format implies fetch
+ false ->
+ case lists:member(fetch,Opts) of
+ true -> fetch;
+ false -> nofetch
+ end
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Process implementation
+start() ->
+ case whereis(?MODULE) of
+ undefined ->
+ Parent = self(),
+ Pid = spawn(fun() -> init(Parent) end),
+ receive {started,Pid} -> ok end;
+ Pid when is_pid(Pid) ->
+ ok
+ end.
+
+
+init(Parent) ->
+ register(?MODULE,self()),
+ ets:new(?history_table,[ordered_set,named_table,public]),
+ Parent ! {started,self()},
+ loop(dict:new()).
+
+loop(NodeInfo) ->
+ receive
+ {init_node,Node,MetaFile,PI,Traci} ->
+ erlang:monitor_node(Node,true),
+ MetaPid =
+ case rpc:call(Node,
+ observer_backend,
+ ttb_init_node,
+ [MetaFile,PI,Traci]) of
+ {ok,MP} ->
+ MP;
+ {badrpc,nodedown} ->
+ %% We will get a nodedown message
+ undefined
+ end,
+ loop(dict:store(Node,{MetaFile,MetaPid},NodeInfo));
+ {get_nodes,Sender} ->
+ Sender ! {?MODULE,dict:fetch_keys(NodeInfo)},
+ loop(NodeInfo);
+ {write_trace_info,Key,What} ->
+ dict:fold(fun(Node,{_MetaFile,MetaPid},_) ->
+ rpc:call(Node,observer_backend,
+ ttb_write_trace_info,[MetaPid,Key,What])
+ end,
+ ok,
+ NodeInfo),
+ loop(NodeInfo);
+ {nodedown,Node} ->
+ loop(dict:erase(Node,NodeInfo));
+ {stop,nofetch,Sender} ->
+ dict:fold(
+ fun(Node,{_,MetaPid},_) ->
+ rpc:call(Node,observer_backend,ttb_stop,[MetaPid])
+ end,
+ ok,
+ NodeInfo),
+ dbg:stop_clear(),
+ ets:delete(?history_table),
+ Sender ! {?MODULE,stopped};
+ {stop,FetchOrFormat,Sender} ->
+ Localhost = host(node()),
+ Dir = ?upload_dir++ts(),
+ file:make_dir(Dir),
+ %% The nodes are traversed twice here because
+ %% the meta tracing in observer_backend must be
+ %% stopped before dbg is stopped, and dbg must
+ %% be stopped before the trace logs are moved orelse
+ %% windows complains.
+ AllNodesAndMeta =
+ dict:fold(
+ fun(Node,{MetaFile,MetaPid},Nodes) ->
+ rpc:call(Node,observer_backend,ttb_stop,[MetaPid]),
+ [{Node,MetaFile}|Nodes]
+ end,
+ [],
+ NodeInfo),
+ dbg:stop_clear(),
+ AllNodes =
+ lists:map(
+ fun({Node,MetaFile}) ->
+ spawn(fun() -> fetch(Localhost,Dir,Node,MetaFile) end),
+ Node
+ end,
+ AllNodesAndMeta),
+ ets:delete(?history_table),
+ wait_for_fetch(AllNodes),
+ io:format("Stored logs in ~s~n",[filename:absname(Dir)]),
+ case FetchOrFormat of
+ format -> format(Dir);
+ fetch -> ok
+ end,
+ Sender ! {?MODULE,stopped}
+ ?get_status
+ end.
+
+get_nodes() ->
+ ?MODULE ! {get_nodes,self()},
+ receive {?MODULE,Nodes} -> Nodes end.
+
+ts() ->
+ {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(now()),
+ io_lib:format("-~4.4.0w~2.2.0w~2.2.0w-~2.2.0w~2.2.0w~2.2.0w",
+ [Y,M,D,H,Min,S]).
+
+
+
+fetch(Localhost,Dir,Node,MetaFile) ->
+ case host(Node) of
+ Localhost -> % same host, just move the files
+ Files = rpc:call(Node,observer_backend,ttb_get_filenames,[MetaFile]),
+ lists:foreach(
+ fun(File0) ->
+ File = filename:join(Dir,filename:basename(File0)),
+ file:rename(File0,File)
+ end,
+ Files);
+ _Otherhost ->
+ {ok, LSock} = gen_tcp:listen(0, [binary,{packet,2},{active,false}]),
+ {ok,Port} = inet:port(LSock),
+ rpc:cast(Node,observer_backend,ttb_fetch,
+ [MetaFile,{Port,Localhost}]),
+ {ok, Sock} = gen_tcp:accept(LSock),
+ receive_files(Dir,Sock,undefined),
+ ok = gen_tcp:close(LSock),
+ ok = gen_tcp:close(Sock)
+ end,
+ ?MODULE ! {fetch_complete,Node}.
+
+receive_files(Dir,Sock,Fd) ->
+ case gen_tcp:recv(Sock, 0) of
+ {ok, <<0,Bin/binary>>} ->
+ file:write(Fd,Bin),
+ receive_files(Dir,Sock,Fd);
+ {ok, <<1,Bin/binary>>} ->
+ File0 = binary_to_list(Bin),
+ File = filename:join(Dir,File0),
+ {ok,Fd1} = file:open(File,[raw,write]),
+ receive_files(Dir,Sock,Fd1);
+ {error, closed} ->
+ ok = file:close(Fd)
+ end.
+
+host(Node) ->
+ [_name,Host] = string:tokens(atom_to_list(Node),"@"),
+ Host.
+
+
+wait_for_fetch([]) ->
+ ok;
+wait_for_fetch(Nodes) ->
+ receive
+ {fetch_complete,Node} ->
+ wait_for_fetch(lists:delete(Node,Nodes))
+ end.
+
+%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+%%% TRACE INFORMATION FILE
+%%% ======================
+%%% The trace information file has the same name as the trace log,
+%%% but with the extension ".ti". It contains process information,
+%%% trace information and any data the user writes with the
+%%% function write_trace_info/2.
+%%%
+%%% The file is read during formatting of trace logs, and all data
+%%% except process information is included in the handler function.
+%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+write_info(Nodes,PI,Traci) ->
+ lists:foreach(fun({N,{local,C,_},F}) ->
+ MetaFile = F ++ ".ti",
+ file:delete(MetaFile),
+ Traci1 = [{node,N},{file,C}|Traci],
+ {ok,Port} = dbg:get_tracer(N),
+ ?MODULE !
+ {init_node, N, {local,MetaFile,Port}, PI, Traci1};
+ ({N,C,F}) ->
+ MetaFile = F ++ ".ti",
+ Traci1 = [{node,N},{file,C}|Traci],
+ ?MODULE ! {init_node, N, MetaFile, PI, Traci1}
+ end,
+ Nodes).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Format binary trace logs
+format(Files) ->
+ format(Files,[]).
+format(Files,Opt) ->
+ {Out,Handler} = format_opt(Opt),
+ ets:new(?MODULE,[named_table]),
+ format(Files,Out,Handler).
+format(File,Out,Handler) when is_list(File), is_integer(hd(File)) ->
+ Files =
+ case filelib:is_dir(File) of
+ true -> % will merge all files in the directory
+ MetaFiles = filelib:wildcard(filename:join(File,"*.ti")),
+ lists:map(fun(M) ->
+ Sub = string:left(M,length(M)-3),
+ case filelib:is_file(Sub) of
+ true -> Sub;
+ false -> Sub++".*.wrp"
+ end
+ end,
+ MetaFiles);
+ false -> % format one file
+ [File]
+ end,
+ format(Files,Out,Handler);
+format(Files,Out,Handler) when is_list(Files), is_list(hd(Files)) ->
+ StopDbg = case whereis(dbg) of
+ undefined -> true;
+ _ -> false
+ end,
+ Details = lists:foldl(fun(File,Acc) -> [prepare(File,Handler)|Acc] end,
+ [],Files),
+ Fd = get_fd(Out),
+ R = do_format(Fd,Details),
+ file:close(Fd),
+ ets:delete(?MODULE),
+ case StopDbg of
+ true -> dbg:stop_clear();
+ false -> ok
+ end,
+ R.
+
+prepare(File,Handler) ->
+ {Traci,Proci} = read_traci(File),
+ Node = get_node(Traci),
+ lists:foreach(fun({Pid,PI}) ->
+ %% The last definition for a Pid will overwrite
+ %% any previous definitions. That should be what
+ %% we want (we will get the registered name for
+ %% the process, rather than the initial call if
+ %% both are present in the list).
+ ets:insert(?MODULE,{Pid,PI,Node})
+ end,Proci),
+ FileOrWrap = get_file(File,Traci),
+ Handler1 = get_handler(Handler,Traci),
+ {FileOrWrap,Traci,Handler1}.
+
+format_opt(Opt) ->
+ Out = case lists:keysearch(out,1,Opt) of
+ {value,{out,O}} -> O;
+ _ -> standard_io
+ end,
+ Handler = case lists:keysearch(handler,1,Opt) of
+ {value,{handler,H}} -> H;
+ _ -> undefined
+ end,
+ {Out,Handler}.
+
+
+read_traci(File) ->
+ MetaFile = get_metafile(File),
+ case file:read_file(MetaFile) of
+ {ok,B} ->
+ interpret_binary(B,dict:new(),[]);
+ _ ->
+ io:format("Warning: no meta data file: ~s~n",[MetaFile]),
+ {dict:new(),[]}
+ end.
+
+get_metafile(File) ->
+ case filename:rootname(File,".wrp") of
+ File -> File++".ti";
+ Wrap -> filename:rootname(Wrap)++".ti"
+ end.
+
+
+interpret_binary(<<>>,Dict,P) ->
+ {Dict,lists:reverse(P)};
+interpret_binary(B,Dict,P) ->
+ {Term,Rest} = get_term(B),
+ {Dict1,P1} =
+ case Term of
+ {pid,PI} ->
+ {Dict,[PI|P]};
+ {Key,Val} ->
+ {dict:update(Key,fun(Val0) -> [Val|Val0] end, [Val], Dict),P}
+ end,
+ interpret_binary(Rest,Dict1,P1).
+
+get_fd(Out) ->
+ case Out of
+ standard_io ->
+ Out;
+ _file ->
+ file:delete(Out),
+ case file:open(Out,[append]) of
+ {ok,Fd} -> Fd;
+ Error -> exit(Error)
+ end
+ end.
+
+get_node(Traci) ->
+ case dict:find(node,Traci) of
+ {ok,[Node]} -> Node;
+ error -> unknown
+ end.
+
+get_file(File,Traci) ->
+ case dict:find(file,Traci) of
+ {ok,[Client]} ->
+ check_client(Client,File);
+ error ->
+ check_exists(File)
+ end.
+
+check_client(Client,File) when is_list(Client) ->
+ check_exists(File);
+check_client(Client,File) when is_tuple(Client),element(2,Client)==wrap ->
+ Root = filename:rootname(File,".wrp"),
+ case filename:extension(Root) of
+ ".*" ->
+ Part1 = filename:rootname(Root,"*"),
+ setelement(1,Client,Part1);
+ _ ->
+ check_exists(File)
+ end.
+
+check_exists(File) ->
+ case file:read_file_info(File) of
+ {ok,#file_info{type=regular}} -> File;
+ _ ->
+ exit({error,no_file})
+ end.
+
+
+get_handler(Handler,Traci) ->
+ case Handler of
+ undefined ->
+ case dict:find(handler,Traci) of
+ {ok,[H]} -> H;
+ error -> undefined
+ end;
+ _ ->
+ Handler
+ end.
+
+do_format(Fd,Details) ->
+ Clients = lists:foldl(fun({FileOrWrap,Traci,Handler},Acc) ->
+ [start_client(FileOrWrap,Traci,Handler)
+ |Acc]
+ end,[],Details),
+ init_collector(Fd,Clients).
+
+
+start_client(FileOrWrap,Traci,et) ->
+ dbg:trace_client(file, FileOrWrap,
+ {fun handler/2,
+ {dict:to_list(Traci),{{ttb_et,handler},initial}}});
+start_client(FileOrWrap,Traci,undefined) ->
+ dbg:trace_client(file, FileOrWrap,
+ {fun handler/2,
+ {dict:to_list(Traci),{fun defaulthandler/4,initial}}});
+start_client(FileOrWrap,Traci,Handler) ->
+ dbg:trace_client(file, FileOrWrap,
+ {fun handler/2, {dict:to_list(Traci),Handler}}).
+
+handler(Trace,State) ->
+ %% State here is only used for the initial state. The accumulated
+ %% State is maintained by collector!!!
+ receive
+ {get,Collector} -> Collector ! {self(),{Trace,State}};
+ done -> ok
+ end,
+ State.
+
+handler1(Trace,{Fd,{Traci,{Fun,State}}}) when is_function(Fun) ->
+ {Traci,{Fun,Fun(Fd,Trace,Traci,State)}};
+handler1(Trace,{Fd,{Traci,{{M,F},State}}}) when is_atom(M), is_atom(F) ->
+ {Traci,{{M,F},M:F(Fd,Trace,Traci,State)}}.
+
+defaulthandler(Fd,Trace,_Traci,initial) ->
+ dbg:dhandler(Trace,Fd);
+defaulthandler(_Fd,Trace,_Traci,State) ->
+ dbg:dhandler(Trace,State).
+
+init_collector(Fd,Clients) ->
+ Collected = get_first(Clients),
+ collector(Fd,sort(Collected)).
+
+collector(Fd,[{_,{Client,{Trace,State}}}|Rest]) ->
+ Trace1 = update_procinfo(Trace),
+ State1 = handler1(Trace1,{Fd,State}),
+ case get_next(Client,State1) of
+ end_of_trace ->
+ handler1(end_of_trace,{Fd,State1}),
+ collector(Fd,Rest);
+ Next -> collector(Fd,sort([Next|Rest]))
+ end;
+collector(_Fd,[]) ->
+ ok.
+
+update_procinfo({drop,_N}=Trace) ->
+ Trace;
+update_procinfo(Trace) when element(1,Trace)==seq_trace ->
+ Info = element(3,Trace),
+ Info1 =
+ case Info of
+ {send, Serial, From, To, Msg} ->
+ {send, Serial, get_procinfo(From), get_procinfo(To), Msg};
+ {'receive', Serial, From, To, Msg} ->
+ {'receive', Serial, get_procinfo(From), get_procinfo(To), Msg};
+ {print, Serial, From, Void, UserInfo} ->
+ {print, Serial, get_procinfo(From), Void, UserInfo};
+ Other ->
+ Other
+ end,
+ setelement(3,Trace,Info1);
+update_procinfo(Trace) when element(3,Trace)==send ->
+ PI = get_procinfo(element(5,Trace)),
+ setelement(5,Trace,PI);
+update_procinfo(Trace) ->
+ Pid = element(2,Trace),
+ ProcInfo = get_procinfo(Pid),
+ setelement(2,Trace,ProcInfo).
+
+get_procinfo(Pid) when is_pid(Pid) ->
+ case ets:lookup(?MODULE,Pid) of
+ [PI] -> PI;
+ [] -> Pid
+ end;
+get_procinfo(Name) when is_atom(Name) ->
+ case ets:match_object(?MODULE,{'_',Name,node()}) of
+ [PI] -> PI;
+ [] -> Name
+ end;
+get_procinfo({Name,Node}) when is_atom(Name) ->
+ case ets:match_object(?MODULE,{'_',Name,Node}) of
+ [PI] -> PI;
+ [] -> {Name,Node}
+ end.
+
+get_first([Client|Clients]) ->
+ Client ! {get,self()},
+ receive
+ {Client,{end_of_trace,_}} ->
+ get_first(Clients);
+ {Client,{Trace,_State}}=Next ->
+ [{timestamp(Trace),Next}|get_first(Clients)]
+ end;
+get_first([]) -> [].
+
+get_next(Client,State) when is_pid(Client) ->
+ Client ! {get,self()},
+ receive
+ {Client,{end_of_trace,_}} ->
+ end_of_trace;
+ {Client,{Trace,_OldState}} ->
+ {timestamp(Trace),{Client,{Trace,State}}} % inserting new state!!
+ end.
+
+sort(List) ->
+ lists:keysort(1,List).
+
+
+timestamp(Trace) when element(1,Trace) =:= trace_ts;
+ element(1,Trace) =:= seq_trace, tuple_size(Trace) =:= 4 ->
+ element(tuple_size(Trace),Trace);
+timestamp(_Trace) ->
+ 0.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% common internal functions
+to_list(Atom) when is_atom(Atom) -> [Atom];
+to_list(List) when is_list(List) -> List.
+
+write_binary(File,TermList) ->
+ {ok,Fd} = file:open(File,[raw,append]),
+ %% Using the function implemented in observer_backend, only because
+ %% is exists - so I don't have to write the same code twice.
+ observer_backend:ttb_write_binary(Fd,TermList),
+ file:close(Fd).
+
+get_term(B) ->
+ <<S:8, B2/binary>> = B,
+ <<T:S/binary, Rest/binary>> = B2,
+ case binary_to_term(T) of
+ {'$size',Sz} ->
+ %% size of the actual term was bigger than 8 bits
+ <<T1:Sz/binary, Rest1/binary>> = Rest,
+ {binary_to_term(T1),Rest1};
+ Term ->
+ {Term,Rest}
+ end.
+
+display_warning(Item,Warning) ->
+ io:format("Warning: {~w,~w}~n",[Warning,Item]).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Trace client which reads an IP port and puts data directly to a file.
+%%% This is used when tracing remote nodes with no file system.
+ip_to_file(Trace,{file,File}) ->
+ Fun = dbg:trace_port(file,File), %File can be a filename or a wrap spec
+ Port = Fun(),
+ ip_to_file(Trace,Port);
+ip_to_file({metadata,MetaFile,MetaData},Port) ->
+ {ok,MetaFd} = file:open(MetaFile,[write,raw,append]),
+ file:write(MetaFd,MetaData),
+ file:close(MetaFd),
+ Port;
+ip_to_file(Trace,Port) ->
+ B = term_to_binary(Trace),
+ erlang:port_command(Port,B),
+ Port.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% For debugging
+dump_ti(File) ->
+ {ok,B} = file:read_file(File),
+ dump_ti(B,[]).
+
+dump_ti(<<>>,Acc) ->
+ lists:reverse(Acc);
+dump_ti(B,Acc) ->
+ {Term,Rest} = get_term(B),
+ dump_ti(Rest,[Term|Acc]).
+
+
diff --git a/lib/observer/src/ttb_et.erl b/lib/observer/src/ttb_et.erl
new file mode 100644
index 0000000000..60769f1cc2
--- /dev/null
+++ b/lib/observer/src/ttb_et.erl
@@ -0,0 +1,267 @@
+%%
+%% %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(ttb_et).
+-author('[email protected]').
+
+-include("et.hrl").
+-export([handler/4]).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% ----------- TTB format handler -----------
+
+handler(Out,Trace,Traci,initial) ->
+ S = self(),
+ spawn(fun() -> init_et(S) end),
+ receive {et_started,Collector} -> ok end,
+ handler(Out,Trace,Traci,Collector);
+handler(_,end_of_trace,_Traci,Col) ->
+ get_returns(Col),
+ ok;
+handler(_,Trace,_Traci,Col) ->
+ {ok,NewCol} = et_collector:report(Col,Trace),
+ NewCol.
+
+
+%%% ----------- Collector Filter -----------
+
+collector(Event) when is_record(Event,event) ->
+ %% if collector is selected from viewer menu
+ true;
+collector(Trace) ->
+ et_selector:parse_event(undefined,Trace).
+
+%% After applying collector filter to all events, iterate over
+%% all events backwards and collect call/return information:
+%%
+%% MFA collected from return_to events is added to call and
+%% return_from events as {caller,MFA} and {return_to,MFA} respecively.
+%% MFA collected from call events is added to return_to events as
+%% {return_from,MFA}
+%%
+%% This information can then be used by any filter for generating to-
+%% and from fields.
+get_returns(Col) ->
+ Fun = fun(Event,Acc) -> collect_return_info(Event,Acc,Col) end,
+ et_collector:iterate(Col, last, '-infinity', Fun, dict:new()).
+
+collect_return_info(#event{label=L,from=Pid}=E,Acc,_Col)
+ when L==return_to;L==return_from->
+ %% Stacking all return_to and return_from events
+ dict:update(Pid,fun(Old) -> [E|Old] end, [E], Acc);
+collect_return_info(#event{label=call,from=Pid,contents=Contents}=E,Acc,Col) ->
+ %% Popping return_from and return_to events
+ %% If both exist, return_from will _always_ be first!!!
+ MFA = get_mfarity(Contents),
+ {Caller,NewAcc} =
+ case dict:find(Pid,Acc) of
+ {ok,[#event{label=return_from}=RetFrom,
+ #event{label=return_to}=RetTo | Rets]} ->
+ RetToCont = RetTo#event.contents,
+ C = get_mfarity(RetToCont),
+ NewRetTo = RetTo#event{contents=RetToCont++[{return_from,MFA}]},
+ RetFromCont = RetFrom#event.contents,
+ NewRetFrom =
+ RetFrom#event{contents=RetFromCont++[{return_to,C}]},
+ et_collector:report(Col,NewRetTo),
+ et_collector:report(Col,NewRetFrom),
+ {C, dict:store(Pid,Rets,Acc)};
+ {ok,[#event{label=return_to}=RetTo | Rets]} ->
+ %% No return_from
+ RetToCont = RetTo#event.contents,
+ C = get_mfarity(RetToCont),
+ NewRetTo = RetTo#event{contents=RetToCont++[{return_from,MFA}]},
+ et_collector:report(Col,NewRetTo),
+ {C, dict:store(Pid,Rets,Acc)};
+ {ok,[#event{label=return_from}=RetFrom | Rets]} ->
+ %% No return_to, check if caller(pam_result) is in call event
+ C = get_caller(Contents),
+ RetFromCont = RetFrom#event.contents,
+ NewRetFrom =
+ RetFrom#event{contents=RetFromCont++[{return_to,C}]},
+ et_collector:report(Col,NewRetFrom),
+ {C, dict:store(Pid,Rets,Acc)};
+ _noreturn ->
+ {nocaller,Acc}
+ end,
+ NewE = E#event{contents=Contents++[{caller,Caller}]},
+ et_collector:report(Col,NewE),
+ NewAcc;
+collect_return_info(_E,Acc,_Col) ->
+ Acc.
+
+init_et(Parent) ->
+ process_flag(trap_exit,true),
+% ets:new(ttb_et_table,[set,named_table,public]),
+% ets:insert(ttb_et_table,{traci,Traci}),
+ EtOpt = [{active_filter,processes},
+ {dict_insert, {filter, collector}, fun collector/1},
+ {dict_insert, {filter, processes}, fun processes/1},
+ {dict_insert, {filter, modules}, fun modules/1},
+ {dict_insert, {filter, mods_and_procs}, fun mods_and_procs/1},
+ {dict_insert, {filter, functions}, fun functions/1},
+ {dict_insert, {filter, funcs_and_procs}, fun funcs_and_procs/1},
+ {hide_actions, false},
+ {max_events, infinity},
+ {max_actors, infinity}],
+ {ok, Viewer} = et_viewer:start_link(EtOpt),
+ Collector = et_viewer:get_collector_pid(Viewer),
+ Parent ! {et_started,Collector},
+ receive
+ {'EXIT',Viewer,shutdown} ->
+ ok
+ end.
+
+
+
+%%% ----------- Viewer Filters -----------
+
+processes(E0) ->
+ E = label(E0),
+ {{FromProc,FromNode},{ToProc,ToNode}} =
+ get_actors(E#event.from,E#event.to),
+ {true,E#event{from = io_lib:format("~w~n~w",[FromProc,FromNode]),
+ to = io_lib:format("~w~n~w",[ToProc,ToNode])}}.
+
+
+mods_and_procs(E) ->
+ ActorFun = fun({M,_F,_A},{Proc,Node}) ->
+ io_lib:format("~w~n~w~n~w",[M,Proc,Node])
+ end,
+ calltrace_filter(E,ActorFun).
+
+modules(E) ->
+ ActorFun = fun({M,_F,_A},{_Proc,Node}) ->
+ io_lib:format("~w~n~w",[M,Node])
+ end,
+ calltrace_filter(E,ActorFun).
+
+funcs_and_procs(E) ->
+ ActorFun = fun({M,F,A},{Proc,Node}) ->
+ io_lib:format("~s~n~w~n~w",[mfa(M,F,A),Proc,Node])
+ end,
+ calltrace_filter(E,ActorFun).
+
+functions(E) ->
+ ActorFun = fun({M,F,A},{_Proc,Node}) ->
+ io_lib:format("~s~n~w",[mfa(M,F,A),Node])
+ end,
+ calltrace_filter(E,ActorFun).
+
+
+
+%% Common filter used by mods_and_procs/1 and modules/1
+calltrace_filter(E,ActorFun) ->
+ {From,To} = get_actors(E#event.from,E#event.to),
+ calltrace_filter(E,From,To,ActorFun).
+
+calltrace_filter(#event{label=call}=E,From,To,ActorFun) ->
+ Cont = E#event.contents,
+ MFA = get_mfarity(Cont),
+ case lists:keysearch(caller,1,Cont) of
+ {value,{_,{_CM,_CF,_CA}=Caller}} ->
+ {true, E#event{label = label(call,MFA),
+ from = ActorFun(Caller,From),
+ to = ActorFun(MFA,To)}};
+ {value,{_, _}} ->
+ {true, E#event{label = label(call,MFA),
+ from = ActorFun(MFA,From),
+ to = ActorFun(MFA,To)}}
+ end;
+calltrace_filter(#event{label=return_from}=E,From,To,ActorFun) ->
+ Cont = E#event.contents,
+ MFA = get_mfarity(Cont),
+ case lists:keysearch(return_to,1,Cont) of
+ {value,{_,{_M2,_F2,_A2}=MFA2}} ->
+ {true, E#event{label = label(return_from,MFA),
+ from = ActorFun(MFA,From),
+ to = ActorFun(MFA2,To)}};
+ {value,{_, _}} ->
+ {true, E#event{label = label(return_from,MFA),
+ from = ActorFun(MFA,From),
+ to = ActorFun(MFA,To)}}
+ end;
+calltrace_filter(#event{label=return_to}=E,From,To,ActorFun) ->
+ Cont = E#event.contents,
+ {value,{_,{_M2,_F2,_A2}=MFA2}} = lists:keysearch(return_from,1,Cont),
+ case get_mfarity(Cont) of
+ {_M,_F,_A}=MFA ->
+ {true, E#event{label = label(return_to,MFA),
+ from = ActorFun(MFA2,From),
+ to = ActorFun(MFA,To)}};
+ undefined ->
+ {true, E#event{label = "return_to unknown",
+ from = ActorFun(MFA2,From),
+ to = ActorFun(MFA2,To)}}
+ end;
+calltrace_filter(_E,_From,_To,_ActorFun) ->
+ false.
+
+
+label(Event=#event{label=L,contents=C}) ->
+ case lists:keysearch(mfa,1,C) of
+ {value,{mfa,MFA}} -> Event#event{label=label(L,MFA)};
+ false -> Event
+ end.
+label(L,{M,F,A}) -> label(L,M,F,A);
+label(L,Other) -> io_lib:format("~w ~w",[L,Other]).
+label(call,M,F,A) -> "call " ++ mfa(M,F,A);
+label(return_from,M,F,A) -> "return_from " ++ mfa(M,F,A);
+label(return_to,M,F,A) -> "return_to " ++ mfa(M,F,A);
+label(spawn,M,F,A) -> "spawn " ++ mfa(M,F,A);
+label(out,M,F,A) -> "out " ++ mfa(M,F,A);
+label(in,M,F,A) -> "in " ++ mfa(M,F,A).
+
+mfa(M,F,A) -> atom_to_list(M) ++ ":" ++ fa(F,A).
+fa(F,A) -> atom_to_list(F) ++ "/" ++ integer_to_list(arity(A)).
+
+arity(L) when is_list(L) -> length(L);
+arity(I) when is_integer(I) -> I.
+
+get_actors(From,To) ->
+ case {get_proc(From),get_proc(To)} of
+ {{_FP,_FN},{_TP,_TN}}=R -> R;
+ {{FP,FN},T} -> {{FP,FN},{T,FN}};
+ {F,{TP,TN}} -> {{F,TN},{TP,TN}};
+ {F,T} -> {{F,unknown},{T,unknown}}
+ end.
+
+get_proc({_Pid,Name,Node}) when is_atom(Name) -> {Name,Node};
+get_proc({Pid,_initfunc,Node}) -> {Pid,Node};
+get_proc(P) when is_pid(P); is_port(P) -> {P,node(P)};
+get_proc(P) -> P.
+
+get_mfarity(List) ->
+ case get_mfa(List) of
+ {M,F,A} -> {M,F,arity(A)};
+ Other -> Other
+ end.
+get_mfa(List) ->
+ {value,{mfa,MFA}} = lists:keysearch(mfa,1,List),
+ MFA.
+
+get_caller(List) ->
+ case lists:keysearch(pam_result,1,List) of
+ {value,{pam_result,{M,F,A}}} -> {M,F,arity(A)};
+ {value,{pam_result,undefined}} -> undefined;
+ {value,{pam_result,_Other}} -> nocaller;
+ false -> nocaller
+ end.
+
+
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-29 08:50:50 +0000