aboutsummaryrefslogtreecommitdiffstats
path: root/lib/appmon/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/appmon/src')
-rw-r--r--lib/appmon/src/Makefile101
-rw-r--r--lib/appmon/src/appmon.app.src24
-rw-r--r--lib/appmon/src/appmon.appup.src18
-rw-r--r--lib/appmon/src/appmon.erl1079
-rw-r--r--lib/appmon/src/appmon_a.erl1117
-rw-r--r--lib/appmon/src/appmon_dg.erl205
-rw-r--r--lib/appmon/src/appmon_dg.hrl45
-rw-r--r--lib/appmon/src/appmon_info.erl963
-rw-r--r--lib/appmon/src/appmon_lb.erl689
-rw-r--r--lib/appmon/src/appmon_place.erl194
-rw-r--r--lib/appmon/src/appmon_txt.erl302
-rw-r--r--lib/appmon/src/appmon_web.erl1037
-rw-r--r--lib/appmon/src/process_info.erl662
13 files changed, 6436 insertions, 0 deletions
diff --git a/lib/appmon/src/Makefile b/lib/appmon/src/Makefile
new file mode 100644
index 0000000000..43f4f085b8
--- /dev/null
+++ b/lib/appmon/src/Makefile
@@ -0,0 +1,101 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1996-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(APPMON_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/appmon-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+
+MODULES= \
+ appmon \
+ appmon_a \
+ appmon_dg \
+ appmon_info \
+ appmon_place \
+ appmon_txt \
+ appmon_lb \
+ process_info \
+ appmon_web
+
+HRL_FILES= appmon_dg.hrl
+
+ERL_FILES= $(MODULES:%=%.erl)
+
+TARGET_FILES= $(MODULES:%=../ebin/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET)
+
+APP_FILE= appmon.app
+APPUP_FILE= appmon.appup
+
+APP_SRC= $(APP_FILE).src
+APPUP_SRC= $(APPUP_FILE).src
+
+APP_TARGET= ../ebin/$(APP_FILE)
+APPUP_TARGET= ../ebin/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+ERL_COMPILE_FLAGS += +warn_obsolete_guard
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f core
+
+docs:
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+$(APP_TARGET): $(APP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(VSN);' $< > $@
+
+$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(VSN);' $< > $@
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/src
+ $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/src
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
diff --git a/lib/appmon/src/appmon.app.src b/lib/appmon/src/appmon.app.src
new file mode 100644
index 0000000000..2e1aa3ef3b
--- /dev/null
+++ b/lib/appmon/src/appmon.app.src
@@ -0,0 +1,24 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-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, appmon,
+ [{description, "DEVTOOLS CXC 138 16"},
+ {vsn, "%VSN%"},
+ {modules, [appmon, appmon_a, appmon_dg, appmon_info,
+ appmon_lb, appmon_place, appmon_txt,process_info,appmon_web]},
+ {registered,[appmon, appmon_info, appmon_txt,webappmon_server,proc_info]},
+ {applications, [kernel, stdlib]}]}.
diff --git a/lib/appmon/src/appmon.appup.src b/lib/appmon/src/appmon.appup.src
new file mode 100644
index 0000000000..0d918b6081
--- /dev/null
+++ b/lib/appmon/src/appmon.appup.src
@@ -0,0 +1,18 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-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/appmon/src/appmon.erl b/lib/appmon/src/appmon.erl
new file mode 100644
index 0000000000..6f5d2824d2
--- /dev/null
+++ b/lib/appmon/src/appmon.erl
@@ -0,0 +1,1079 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+-module(appmon).
+-behaviour(gen_server).
+
+%%%---------------------------------------------------------------------
+%%% Appmon main module.
+%%% Creates the main window and receives load and application
+%%% information from all connected nodes.
+%%%---------------------------------------------------------------------
+
+%% External exports
+-export([start/0, stop/0]).
+
+%% gen_server callbacks
+-export([init/1, handle_cast/2, handle_info/2, terminate/2]).
+-export([handle_call/3, code_change/3]). % not used
+
+%% Canvas button data
+-record(canvasbutton, {text, ul, ll, rect, x, y, w, h}).
+
+%% Options - all the fields are GS radio buttons
+-record(options, {single, many, time, queue, prog, linear}).
+
+%% Main window data
+-record(win, {name, % atom() Monitored node
+ window, % gsobj()
+ wwindow, % int() Window width
+ hwindow, % int() Window height
+ options, % #options{}
+ canvas, % gsobj()
+ wcanvas, % int() Canvas width
+ hcanvas, % int() Canvas height
+ l1, l2, % gsobj() Canvas lines
+ leds, % [gsobj()] Load meter
+ nodelabel, % {gsobj(),gsobj()}
+ appobjs=[], % [gsobj()] Buttons etc.
+ nodemenu}). % gsobj() Node menu
+
+%% Node data
+-record(mnode, {name, % atom() Node name
+ status, % alive | dead
+ pid, % pid()
+ apps, % [{Pid,App,Descr}]
+ load}). % {Old, New}
+
+%% Internal state data
+-record(state, {gs, % pid()
+ wins=[], % [#win()] GUIs
+ window_mode, % single | many
+ load_mode1, % time | queue
+ load_mode2, % prog | linear
+ lbpid, % pid()
+ mnodes=[]}). % [#mnode{}]
+
+%%%---------------------------------------------------------------------
+%%% External exports
+%%%---------------------------------------------------------------------
+
+start() ->
+ gen_server:start({local, appmon}, ?MODULE, [], []).
+
+stop() ->
+ gen_server:cast(appmon, stop).
+
+
+%%%---------------------------------------------------------------------
+%%% gen_server callbacks
+%%%---------------------------------------------------------------------
+
+%%----------------------------------------------------------------------
+%% Func: init/1
+%% Returns: {ok, State} |
+%% {ok, State, Timeout} |
+%% ignore |
+%% {stop, Reason}
+%%----------------------------------------------------------------------
+init([]) ->
+ process_flag(trap_exit, true),
+
+ %% Subscribe to {nodeup,Node} and {nodedown,Node} messages
+ net_kernel:monitor_nodes(true),
+
+ LbPid = appmon_lb:start(self ()),
+
+ %% Check which remote nodes have appmon code available (OTP-4887)
+ NodesOk = lists:filter(fun(Node) -> check_node(Node) end, nodes()),
+ Nodes = [node()|NodesOk],
+
+ %% Start monitoring the existing nodes
+ MNodes = mk_mnodes(Nodes, LbPid),
+
+ %% Draw the main window
+ GS = gs:start([{kernel,true}]),
+ GUI = draw_win(GS, node()),
+
+ %% Update the Nodes menu with all known nodes
+ lists:foreach(fun(Node) ->
+ display_addnode(GUI, Node)
+ end,
+ Nodes),
+
+ %% Mark the default options as selected in the Options menu
+ display_setopt(GUI, single),
+ display_setopt(GUI, time),
+ display_setopt(GUI, prog),
+
+ {ok, #state{gs=GS, wins=[GUI],
+ window_mode=single, load_mode1=time, load_mode2=prog,
+ lbpid=LbPid, mnodes=MNodes}}.
+
+check_node(Node) ->
+ case rpc:call(Node, code, which, [appmon]) of
+ File when is_list(File) ->
+ true;
+ _ -> % non_existing (| cover_compiled)
+ false
+ end.
+
+%%----------------------------------------------------------------------
+%% Func: handle_call/3
+%% 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(norequest, _From, State) ->
+ {reply, null, State}.
+
+%%----------------------------------------------------------------------
+%% Func: handle_cast/2
+%% Returns: {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_cast(stop, State) ->
+ {stop, normal, State}.
+
+%%----------------------------------------------------------------------
+%% Func: handle_info/2
+%% Returns: {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%%----------------------------------------------------------------------
+%% Load information from a node
+handle_info({delivery, _Serv, load, Node, Load}, State) ->
+
+ %% Update node information
+ MNode = get_mnode(Node, State#state.mnodes),
+ MNode1 = MNode#mnode{load=Load},
+ MNodes = replace_mnode(Node, MNode1, State#state.mnodes),
+
+ %% If Node is currently displayed, update graphics
+ case get_win(Node, State#state.wins) of
+ {ok, GUI} ->
+ display_load(GUI, Load);
+ false ->
+ ignore
+ end,
+
+ {noreply, State#state{mnodes=MNodes}};
+
+%% Application information from a node
+handle_info({delivery, _Serv, app_ctrl, Node, Apps}, State) ->
+
+ %% Update node information
+ MNode = get_mnode(Node, State#state.mnodes),
+ MNode1 = MNode#mnode{apps=Apps},
+ MNodes = replace_mnode(Node, MNode1, State#state.mnodes),
+
+ %% If Node is currently displayed, update graphics
+ Wins = case get_win(Node, State#state.wins) of
+ {ok, GUI} ->
+ draw_clear(GUI),
+ GUI1 = draw_apps(GUI, Apps),
+ replace_win(Node, GUI1, State#state.wins);
+ false ->
+ State#state.wins
+ end,
+
+ appmon_lb:add_apps (State#state.lbpid, Apps, Node),
+ {noreply, State#state{wins=Wins, mnodes=MNodes}};
+
+handle_info({nodeup, Node}, State) ->
+
+ %% First, make sure appmon code is available at remode node,
+ %% or the node should be ignored (OTP-3591)
+ case check_node(Node) of
+ true ->
+
+ %% If this is a previously unknown node, update window's
+ %% 'Nodes' menu
+ case get_mnode(Node, State#state.mnodes) of
+ false ->
+ display_addnode(State#state.wins, Node);
+ _OldMnode ->
+ ignore
+ end,
+
+ %% Update node information (=> state is automatically
+ %% changed to 'alive')
+ MNode = mk_mnode(Node, State#state.lbpid),
+ MNodes = replace_mnode(Node, MNode, State#state.mnodes),
+
+ %% If Node is currently displayed, update graphics
+ case get_win(Node, State#state.wins) of
+ {ok, GUI} ->
+ display_nodeup(GUI, Node);
+ false ->
+ ignore
+ end,
+
+ appmon_lb:update_status(State#state.lbpid, Node, alive),
+ {noreply, State#state{mnodes=MNodes}};
+
+ false ->
+ {noreply, State}
+ end;
+
+handle_info({nodedown, Node}, State) ->
+
+ %% If this is a previously unknown node, ignore the message.
+ %% (The situation occurs when failing to connect to another node).
+ %% Otherwise, update the node information.
+ case get_mnode(Node, State#state.mnodes) of
+ false ->
+ {noreply, State};
+ MNode ->
+ MNode1 = MNode#mnode{status=dead},
+ MNodes = replace_mnode(Node, MNode1, State#state.mnodes),
+
+ %% If Node is currently displayed, update graphics
+ Wins = case get_win(Node, State#state.wins) of
+ {ok, GUI} ->
+ display_nodedown(GUI),
+ GUI1 = draw_clear(GUI),
+ replace_win(Node, GUI1, State#state.wins);
+ false ->
+ State#state.wins
+ end,
+
+ appmon_lb:remove_node(State#state.lbpid, Node),
+ {noreply, State#state{wins=Wins, mnodes=MNodes}}
+ end;
+
+%% Application 'button' events
+handle_info({gs, _Obj, buttonpress, Data, _Arg}, State) ->
+ {canvasbutton, CBtn, _App} = Data,
+ press(CBtn),
+ {noreply, State};
+handle_info({gs, _Obj, buttonrelease, Data, [_,X,Y|_]}, State) ->
+ {canvasbutton, CBtn, {application, App, Node}} = Data,
+ release(CBtn),
+
+ %% Check that mouse button was released over the button!
+ L = CBtn#canvasbutton.x, R = L + CBtn#canvasbutton.w,
+ T = CBtn#canvasbutton.y, B = T + CBtn#canvasbutton.h,
+ if
+ X>L, X<R, Y>T, Y<B ->
+ MNode = get_mnode(Node, State#state.mnodes),
+ {value, {Pid, _App, _Descr}} =
+ lists:keysearch(App, 2, MNode#mnode.apps),
+ appmon_a:start(Node, App, Pid);
+ true ->
+ ignore
+ end,
+ {noreply, State};
+
+handle_info({gs, _Button, click, Data, _Arg}, State) ->
+ ThisNode = node(),
+ case Data of
+
+ %% File menu item
+ listbox ->
+ appmon_lb:open_win(State#state.lbpid,
+ parse_nodes(State#state.mnodes)),
+ {noreply, State};
+ {close, WinObj} ->
+ {ok, GUI} = get_win2(WinObj, State#state.wins),
+ gs:destroy(WinObj),
+
+ %% Terminate if this was the only open window
+ case remove_win(GUI#win.name, State#state.wins) of
+ [] ->
+ {stop, normal, State};
+ Wins ->
+ {noreply, State#state{wins=Wins}}
+ end;
+ exit ->
+ {stop, normal, State};
+
+ %% Actions menu item
+ {action, Action, WinObj} ->
+ {ok, GUI} = get_win2(WinObj, State#state.wins),
+ Node = GUI#win.name,
+
+ if
+ Node==ThisNode ->
+ case Action of
+ ping ->
+ %% Ignore - makes no sense to ping yourself
+ ignore;
+ _ -> % reboot | restart | stop
+ apply(init, Action, [])
+ end;
+
+ Node/=ThisNode ->
+ case Action of
+ ping ->
+ net_adm:ping(Node);
+ _ -> % reboot | restart | stop
+ rpc:cast(Node, init, Action, [])
+ end
+ end,
+ {noreply, State};
+
+ %% Options menu item
+ {window_mode, Mode} ->
+
+ %% Update windows so they all show the same options
+ lists:foreach(fun(GUI) ->
+ display_setopt(GUI, Mode)
+ end,
+ State#state.wins),
+ {noreply, State#state{window_mode=Mode}};
+
+ {option, Tag, Option} ->
+
+ %% Update windows so they all show the same options
+ lists:foreach(fun(GUI) ->
+ display_setopt(GUI, Tag)
+ end,
+ State#state.wins),
+
+ %% Update all appmon_info processes about which kind of
+ %% load data is desired
+ lists:foreach(fun(MNode) ->
+ appmon_info:load(MNode#mnode.pid,
+ MNode#mnode.name,
+ true,
+ Option)
+ end,
+ State#state.mnodes),
+
+ if
+ Tag==time; Tag==queue ->
+ {noreply, State#state{load_mode1=Tag}};
+ Tag==prog; Tag==linear ->
+ {noreply, State#state{load_mode2=Tag}}
+ end;
+
+ %% Nodes menu item
+ {node, Node, WinObj} ->
+
+ %% Check first if this window is already displayed
+ case get_win(Node, State#state.wins) of
+ {ok, GUI} ->
+
+ %% Node is already displayed, raise its window
+ gs:config(GUI#win.window, raise),
+
+ {noreply, State};
+
+ %% Node is not displayed
+ false ->
+
+ %% Redraw existing window or create a new window
+ %% depending on window mode
+ case State#state.window_mode of
+
+ single ->
+ {ok, GUI} =
+ get_win2(WinObj, State#state.wins),
+
+ %% Clear window and correct the node name
+ draw_clear(GUI),
+ GUI1 = draw_nodename(GUI, Node),
+
+ %% Update window with the correct node name
+ %% and the applications running at the node
+ MNode = get_mnode(Node, State#state.mnodes),
+ GUI2 = case MNode#mnode.status of
+ dead ->
+ display_nodedown(GUI1),
+ GUI1;
+ alive ->
+ display_nodeup(GUI1, Node),
+ draw_apps(GUI1,
+ MNode#mnode.apps)
+ end,
+ Wins = replace_win(GUI#win.name, GUI2,
+ State#state.wins),
+
+ {noreply, State#state{wins=Wins}};
+
+ many ->
+ GUI = draw_win(State#state.gs, Node),
+
+ %% Update Nodes menu with all known nodes -
+ %% use MNodes to get them in the right order
+ lists:foreach(fun(MNode) ->
+ Name =
+ MNode#mnode.name,
+ display_addnode(GUI,
+ Name)
+ end,
+ State#state.mnodes),
+
+ %% Mark selected options in the Options menu
+ display_setopt(GUI, many),
+ display_setopt(GUI, State#state.load_mode1),
+ display_setopt(GUI, State#state.load_mode2),
+
+ %% Add the applications running at the node
+ MNode = get_mnode(Node, State#state.mnodes),
+
+ GUI1 = case MNode#mnode.status of
+ dead ->
+ display_nodedown(GUI),
+ GUI;
+ alive ->
+ display_nodeup(GUI, Node),
+ draw_apps(GUI,
+ MNode#mnode.apps)
+ end,
+ Wins = [GUI1|State#state.wins],
+
+ {noreply, State#state{wins=Wins}}
+ end
+ end;
+
+ %% Help menu = Help button
+ help ->
+ HelpFile = filename:join([code:lib_dir(appmon),
+ "doc", "html", "part_frame.html"]),
+ case State#state.wins of
+ [Win] ->
+ tool_utils:open_help(Win#win.window, HelpFile);
+ _ ->
+ tool_utils:open_help(State#state.gs, HelpFile)
+ end,
+ {noreply, State};
+
+ _Other ->
+ {noreply, State}
+ end;
+handle_info({gs, WinObj, configure, _, [WWindow, HWindow|_]}, State) ->
+ {ok, GUI} = get_win2(WinObj, State#state.wins),
+ GUI1 = draw_resize(GUI, WWindow, HWindow),
+ display_scrollbar(GUI1),
+ Wins = replace_win(GUI#win.name, GUI1, State#state.wins),
+ {noreply, State#state{wins=Wins}};
+handle_info({gs, WinObj, destroy, _, _}, State) -> % OTP-1179
+ {ok, GUI} = get_win2(WinObj, State#state.wins),
+
+ %% Terminate if this was the only open window
+ case remove_win(GUI#win.name, State#state.wins) of
+ [] ->
+ {stop, normal, State};
+ Wins ->
+ {noreply, State#state{wins=Wins}}
+ end;
+
+handle_info(stop, State) ->
+ {stop, normal, State};
+handle_info({'EXIT', Pid, Reason}, State) ->
+ case Reason of
+ shutdown ->
+ %% Appmon is being asked to shut down, eg during reboot
+ {stop, Reason, State};
+ _ ->
+ case State#state.gs of
+
+ %% GS exited, kill appmon
+ {0, Pid} ->
+ {stop, normal, State};
+
+ _ ->
+ {noreply, State}
+ end
+ end;
+handle_info(_Info, State) ->
+ {noreply, State}.
+
+%%----------------------------------------------------------------------
+%% Func: terminate/2
+%% Purpose: Shutdown the server
+%% Returns: any (ignored by gen_server)
+%%----------------------------------------------------------------------
+terminate(_Reason, State) ->
+ bcast(State#state.mnodes, {kill}),
+ appmon_lb:stop(State#state.lbpid),
+ 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
+%%%---------------------------------------------------------------------
+
+%%----------------------------------------------------------------------
+%% MNode manipulating functions
+%%----------------------------------------------------------------------
+
+%% mk_mnodes(Nodes, LbPid) -> MNodes
+%% Nodes -> [atom()]
+%% LbPid -> pid()
+%% MNodes -> [#mnode{}]
+mk_mnodes([Node|Nodes], LbPid) ->
+ [mk_mnode(Node, LbPid) | mk_mnodes(Nodes, LbPid)];
+mk_mnodes([], _LbPid) ->
+ [].
+
+mk_mnode(Node, LbPid) ->
+
+ %% Create an appmon process at the node
+ {ok, Pid} = appmon_info:start_link(Node, self(), []),
+
+ appmon_lb:add_node(LbPid, Node),
+ appmon_info:load(Pid, Node, true, [{timeout,1000}]),
+ appmon_info:app_ctrl(Pid, Node, true, []),
+
+ #mnode{name=Node, status=alive, pid=Pid}.
+
+%% get_mnode(Node, MNodes) -> MNode | false
+%% Node -> atom()
+%% MNodes -> [#mnode{}]
+%% MNode -> #mnode{}
+get_mnode(Node, MNodes) ->
+ case lists:keysearch(Node, #mnode.name, MNodes) of
+ {value, MNode} ->
+ MNode;
+ false ->
+ false
+ end.
+
+%% replace_mnode(Node, MNode, MNodes1) -> Mnodes2
+%% Node -> atom()
+%% MNode -> #mnode{}
+%% MNodes1 -> MNodes2 -> [#mnode{}]
+%% Replaces, or adds if previously not included, the mnode with name
+%% Node in MNodes1 with MNode.
+replace_mnode(Node, MNode, [#mnode{name=Node} | MNodes]) ->
+ [MNode | MNodes];
+replace_mnode(Node, MNode, [MNode2 | MNodes]) ->
+ [MNode2 | replace_mnode(Node, MNode, MNodes)];
+replace_mnode(_Node, MNode, []) ->
+ [MNode].
+
+
+%%----------------------------------------------------------------------
+%% GUI list manipulating functions
+%%----------------------------------------------------------------------
+
+%% get_win(Node, Wins) -> Win
+%% Node -> atom()
+%% Wins -> [#win{}]
+%% Win -> #win{}
+get_win(Node, Wins) ->
+ case lists:keysearch(Node, #win.name, Wins) of
+ {value, Win} ->
+ {ok, Win};
+ false ->
+ false
+ end.
+
+%% get_win2(WinObj, Wins) -> Win
+%% Window -> gsobj()
+%% Wins -> [#win{}]
+%% Win -> #win{}
+get_win2(WinObj, Wins) ->
+ case lists:keysearch(WinObj, #win.window, Wins) of
+ {value, Win} ->
+ {ok, Win};
+ false ->
+ false
+ end.
+
+%% replace_win(Node, Win, Wins) -> Wins2
+%% Node -> atom()
+%% Win -> #win{}
+%% Wins -> Wins2 -> [#win{}]
+replace_win(Node, Win, Wins) ->
+ lists:keyreplace(Node, #win.name, Wins, Win).
+
+%% remove_win(Node, Wins) -> Wins2
+%% Node -> atom()
+%% Wins -> Wins2 -> [#win{}]
+remove_win(Node, Wins) ->
+ lists:keydelete(Node, #win.name, Wins).
+
+
+
+
+%%----------------------------------------------------------------------
+%% GUI manipulating functions
+%%----------------------------------------------------------------------
+-define(PAD, 10). % Pad between objects
+-define(PAD2, 4*?PAD). % Pad betw. node lbl and app
+
+-define(hMENUBAR, 25). % Note: Hardwired in Tcl/Tk
+
+-define(xNODELBL, 60). % Node label
+-define(yNODELBL, 35).
+-define(hNODELBL, 20).
+
+-define(xMETER, 5). % Meter
+-define(yMETER, ?yNODELBL).
+-define(wMETER, 20).
+-define(hMETER, ?hNODELBL + ?PAD + ?PAD2 + ?hBTN).
+-define(LEDCOUNT, 16).
+
+-define(xBTN, ?xNODELBL). % Application buttons
+-define(yBTN, ?yNODELBL + ?hNODELBL + ?PAD + ?PAD2).
+-define(wBTN, 70). % min width
+-define(hBTN, 20).
+
+-define(wCANVAS, 470 + ?wMETER + 3*?PAD). % Canvas
+-define(hCANVAS, ?yNODELBL + ?hNODELBL + ?PAD + ?PAD2 + ?hBTN + 2*?PAD).
+
+-define(wWIN, ?wCANVAS). % Window
+-define(hWIN, ?hMENUBAR + ?hCANVAS).
+
+%%--Main window---------------------------------------------------------
+
+draw_win(GS, Node) ->
+
+ %% Main window
+ NodeStr = atom_to_list(Node),
+ Win = gs:create(window, GS, [{title,
+ "APPMON: Overview on " ++ NodeStr},
+ {width, ?wWIN}, {height, ?hWIN},
+ {configure, true}]),
+ Canvas = gs:create(canvas, Win, [{x, 0}, {y, ?hMENUBAR},
+ {width, ?wCANVAS},
+ {height, ?hCANVAS}]),
+ L1 = gs:create(line, Canvas, [{coords,
+ [{0,?yNODELBL-?PAD},
+ {?wCANVAS,?yNODELBL-?PAD}]}]),
+ L2 = gs:create(line, Canvas, [{coords,
+ [{0,?hCANVAS-?PAD},
+ {?wCANVAS,?hCANVAS-?PAD}]}]),
+
+ %% Standard buttons
+ MenuBar = gs:create(menubar, Win, [{height, ?hMENUBAR}]),
+
+ FileMenuBtn = gs:create(menubutton, MenuBar,
+ [{label, {text,"File"}}]),
+ FileMenu = gs:create(menu, FileMenuBtn, []),
+ gs:create(menuitem, FileMenu, [{label, {text,"Show List Box..."}},
+ {data, listbox}]),
+ gs:create(menuitem, FileMenu, [{label, {text, "Close"}},
+ {data, {close, Win}}]),
+ gs:create(menuitem, FileMenu, [{itemtype, separator}]),
+ gs:create(menuitem, FileMenu, [{label, {text, "Exit"}},
+ {data, exit}]),
+
+ ActionMenuBtn = gs:create(menubutton, MenuBar,
+ [{label,{text,"Actions"}}]),
+ ActionMenu = gs:create(menu, ActionMenuBtn, []),
+ gs:create(menuitem, ActionMenu, [{label, {text,"Reboot"}},
+ {data, {action, reboot, Win}}]),
+ gs:create(menuitem, ActionMenu, [{label, {text,"Restart"}},
+ {data, {action, restart, Win}}]),
+ gs:create(menuitem, ActionMenu, [{label, {text,"Stop"}},
+ {data, {action, stop, Win}}]),
+ gs:create(menuitem, ActionMenu, [{label, {text,"Ping"}},
+ {data, {action, ping, Win}}]),
+
+ OptMenuBtn = gs:create(menubutton, MenuBar,
+ [{label, {text,"Options"}}]),
+ OptMenu = gs:create(menu, OptMenuBtn, []),
+ G0 = now(), % Group identity unique per window!
+ SMI = gs:create(menuitem, OptMenu, [{label, {text,"One window"}},
+ {itemtype, radio}, {group, G0},
+ {data, {window_mode, single}}]),
+ MMI = gs:create(menuitem, OptMenu, [{label, {text,"Many windows"}},
+ {itemtype, radio}, {group, G0},
+ {data, {window_mode, many}}]),
+ gs:create(menuitem, OptMenu, [{itemtype, separator}]),
+ G1 = now(),
+ TMI = gs:create(menuitem, OptMenu, [{label, {text,"Load: time"}},
+ {itemtype, radio}, {group, G1},
+ {data,
+ {option, time,
+ [{load_method,time}]}}]),
+ QMI = gs:create(menuitem, OptMenu, [{label, {text,"Load: queue"}},
+ {itemtype, radio}, {group, G1},
+ {data,
+ {option, queue,
+ [{load_method,queue}]}}]),
+ G2 = now(),
+ PMI = gs:create(menuitem, OptMenu,
+ [{label, {text,"Load: progressive"}},
+ {itemtype, radio}, {group, G2},
+ {data, {option, prog, [{load_scale,prog}]}}]),
+ LMI = gs:create(menuitem, OptMenu, [{label, {text,"Load: linear"}},
+ {itemtype, radio}, {group, G2},
+ {data,
+ {option, linear,
+ [{load_scale,linear}]}}]),
+
+ NodeMenuBtn = gs:create(menubutton, MenuBar,
+ [{label, {text,"Nodes"}}]),
+ NodeMenu = gs:create(menu, NodeMenuBtn, []),
+
+ HelpMenuBtn = gs:create(menubutton, MenuBar,
+ [{label, {text,"Help"}}, {side, right}]),
+ HelpMenu = gs:create(menu, HelpMenuBtn, []),
+ gs:create(menuitem, HelpMenu, [{label, {text,"Help"}},
+ {data, help}]),
+
+ %% Meter
+ HLed = trunc((?hMETER)/(?LEDCOUNT)),
+ Leds = draw_leds(?LEDCOUNT, Canvas, ?yMETER, HLed, []),
+ leds_down(Leds, ?LEDCOUNT, 0),
+ gs:create(text, Canvas, [{coords,
+ [{?xMETER, ?yMETER+HLed*?LEDCOUNT}]},
+ {anchor, nw},
+ {font, {screen,8}},
+ {text, "Load"}]),
+ gs:create(text, Canvas, [{coords, [{?xMETER+?wMETER, ?yMETER}]},
+ {anchor, nw},
+ {font, {screen,8}},
+ {text, "Hi"}]),
+ gs:create(text, Canvas, [{coords, [{?xMETER+?wMETER,
+ ?yMETER+HLed*?LEDCOUNT}]},
+ {anchor, w},
+ {font, {screen,8}},
+ {text, "Lo"}]),
+
+ %% Node label
+ WNodeLbl = 8*length(NodeStr)+10,
+ NLRect = gs:create(rectangle, Canvas,
+ [{coords, [{?xNODELBL,?yNODELBL},
+ {?xNODELBL+WNodeLbl,
+ ?yNODELBL+?hNODELBL}]},
+ {fill, black}]),
+ Xc = ?xNODELBL + round(WNodeLbl/2),
+ Yc = ?yNODELBL + round(?hNODELBL/2),
+ NLText = gs:create(text, Canvas, [{text, NodeStr},
+ {fg, {250,235,215}},
+ {coords, [{Xc,Yc}]},
+ {anchor, c}]),
+ NodeLbl = {NLRect, NLText},
+
+ gs:config(Win, {map, true}),
+ #win{name=Node,
+ window=Win, wwindow=?wWIN, hwindow=?hCANVAS,
+ options=#options{single=SMI, many=MMI,
+ time=TMI, queue=QMI, prog=PMI, linear=LMI},
+ canvas=Canvas, wcanvas=?wCANVAS, hcanvas=?hCANVAS,
+ l1=L1, l2=L2, leds=Leds, nodelabel=NodeLbl, nodemenu=NodeMenu}.
+
+draw_leds(N, Canvas, Y, HLed, Leds) when N>0 ->
+ Led = gs:create(rectangle, Canvas,
+ [{coords,
+ [{?xMETER,Y}, {?xMETER+?wMETER,Y+HLed}]}]),
+ draw_leds(N-1, Canvas, Y+HLed, HLed, [Led | Leds]);
+draw_leds(0, _Canvas, _Y, _HLed, Leds) ->
+ Leds.
+
+%%--Draw functions------------------------------------------------------
+%% Functions that modify the GUI and its data (win{})
+
+%% Display the node name in the window title
+%% (The name in the node label is changed by display_nodeup|nodedown)
+%% Used when a changing the node to display
+draw_nodename(GUI, Node) ->
+ NodeStr = atom_to_list(Node),
+ gs:config(GUI#win.window,
+ {title, "APPMON: Overview on " ++ NodeStr}),
+ GUI#win{name=Node}.
+
+%% Resize the canvas (when the window has been resized)
+draw_resize(GUI, W, H) ->
+ Hc = H - ?hMENUBAR,
+ gs:config(GUI#win.canvas, [{width, W}, {height, Hc}]),
+ Yline1 = ?yNODELBL-?PAD,
+ Yline2 = ?hCANVAS-?PAD,
+ gs:config(GUI#win.l1, [{coords, [{0,Yline1},{W,Yline1}]}]),
+ gs:config(GUI#win.l2, [{coords, [{0,Yline2},{W,Yline2}]}]),
+ GUI#win{wwindow=W, hwindow=Hc}.
+
+%% Clear the GUI from applications and connecting lines
+draw_clear(GUI) ->
+ draw_clear2(GUI#win.appobjs),
+ gs:config(GUI#win.canvas, [{hscroll, false}]),
+ GUI#win{appobjs=[]}.
+draw_clear2([CBtn | AppObjs]) when is_record(CBtn, canvasbutton) ->
+ gs:destroy(CBtn#canvasbutton.text),
+ gs:destroy(CBtn#canvasbutton.ul),
+ gs:destroy(CBtn#canvasbutton.ll),
+ gs:destroy(CBtn#canvasbutton.rect),
+ draw_clear2(AppObjs);
+draw_clear2([GSObj | AppObjs]) ->
+ gs:destroy(GSObj),
+ draw_clear2(AppObjs);
+draw_clear2([]) ->
+ ignore.
+
+%% Display the applications, which are a list of tuples: {Pid,App,Descr}
+%% Display them in the reversed order to get them chronologically
+%% from left to right.
+draw_apps(GUI, Apps) ->
+ {AppObjs, WCanvas} = draw_apps(GUI, lists:reverse(Apps), ?xNODELBL,
+ undefined, 0, []),
+ NewGUI = GUI#win{wcanvas=WCanvas, appobjs=AppObjs},
+ display_scrollbar(NewGUI),
+ NewGUI.
+
+draw_apps(GUI, [App | Apps], X, Lx0, N, GSObjs) ->
+
+ %% Some necessary data
+ {_Pid, AppName, _Descr} = App,
+ Text = atom_to_list(AppName),
+ Width = max(8*length(Text)+10, ?wBTN),
+
+ %% Connect the application to the node label with a line
+ %% Lx0 = leftmost X coordinate (above previous application button)
+ %% Lx = X coordinate, Ly1, Ly2 = top and bottom Y coordinates
+ Lx = X + trunc(Width/2),
+ Line = case N of
+ %% First (leftmost application) - draw a vertical line
+ %% between the node label and application button
+ 0 ->
+ Ly1 = ?yNODELBL + ?hNODELBL +?PAD,
+ Ly2 = Ly1 + ?PAD2,
+ gs:create(line, GUI#win.canvas,
+ [{coords, [{Lx, Ly1}, {Lx, Ly2}]}]);
+ %% Nth application, N>1 - draw a horizontal line from
+ %% line connecting to the previous application button,
+ %% to above this application button, then vertically down
+ %% to the application button
+ _ ->
+ Ly1 = ?yNODELBL + ?hNODELBL + ?PAD + ?PAD2/2,
+ Ly2 = Ly1 + ?PAD2/2,
+ gs:create(line, GUI#win.canvas,
+ [{coords, [{Lx0, Ly1}, {Lx, Ly1},
+ {Lx, Ly2}]}])
+ end,
+
+ %% The application is represented using a 'canvasbutton'
+ Data = {application, AppName, GUI#win.name},
+ AppBtn = canvasbutton(GUI#win.canvas, Text, X, ?yBTN, Width, ?hBTN,
+ Data),
+
+ draw_apps(GUI, Apps, X+Width+?PAD, Lx, N+1, [AppBtn, Line|GSObjs]);
+draw_apps(_GUI, [], X, _N, _Lx0, GSObjs) ->
+ {GSObjs, X}.
+
+%%--Display functions---------------------------------------------------
+%% Functions that modify the GUI but not its data
+
+%% Add a new node to the Nodes menu
+%% Used when a new node has connected
+display_addnode([GUI|GUIs], Node) ->
+ display_addnode(GUI, Node),
+ display_addnode(GUIs, Node);
+display_addnode([], _Node) ->
+ ignore;
+display_addnode(GUI, Node) ->
+ Txt = "Show " ++ atom_to_list(Node),
+ gs:create(menuitem, GUI#win.nodemenu,
+ [{label, {text,Txt}},
+ {data, {node, Node, GUI#win.window}}]).
+
+%% Show that a node has come back up
+display_nodeup(GUI, Node) ->
+ {Rect, Text} = GUI#win.nodelabel,
+
+ %% Check coordinates for the rectangle and compute the new width
+ [{L, T}, {_R, B}] = gs:read(Rect, coords),
+ NodeStr = atom_to_list(Node),
+ W = 8*length(NodeStr)+10,
+
+ gs:config(Rect, [{coords, [{L, T}, {L+W, B}]}, {fill, black}]),
+ gs:config(Text, [{text, NodeStr}, {fg, {250,235,215}},
+ {coords,
+ [{L+round(W/2), T+round((?hNODELBL)/2)}]}]).
+
+%% Show that a node has gone down
+display_nodedown(GUI) ->
+ {Rect, Text} = GUI#win.nodelabel,
+
+ [{L, T}, {_R, B}] = gs:read(Rect, coords),
+ gs:config(Rect, [{coords, [{L, T}, {L+114, B}]}, {fill, gray}]),
+ gs:config(Text, [{text, "No connection"}, {fg, black},
+ {coords, [{L+57, T+round((?hNODELBL)/2)}]}]).
+
+%% Add/remove scrollbars as necessary
+display_scrollbar(GUI) ->
+
+ WWindow = GUI#win.wwindow,
+ HWindow = GUI#win.hwindow,
+ WCanvas = GUI#win.wcanvas,
+ HCanvas = GUI#win.hcanvas,
+ if
+ WCanvas>WWindow ->
+ gs:config(GUI#win.canvas,
+ [{hscroll, bottom},
+ {scrollregion,{0,0,WCanvas,HCanvas}}]);
+ true ->
+ gs:config(GUI#win.canvas, [{hscroll, false}])
+ end,
+ if
+ HCanvas>HWindow ->
+ gs:config(GUI#win.canvas,
+ [{vscroll, left},
+ {scrollregion,{0,0,WCanvas,HCanvas}}]);
+
+ true ->
+ gs:config(GUI#win.canvas, [{vscroll, false}])
+ end.
+
+%% Select option radio buttons
+display_setopt(GUI, Option) ->
+ gs:config(radiobutton(GUI, Option), {select,true}).
+
+radiobutton(GUI, single) -> (GUI#win.options)#options.single;
+radiobutton(GUI, many) -> (GUI#win.options)#options.many;
+radiobutton(GUI, time) -> (GUI#win.options)#options.time;
+radiobutton(GUI, queue) -> (GUI#win.options)#options.queue;
+radiobutton(GUI, prog) -> (GUI#win.options)#options.prog;
+radiobutton(GUI, linear) -> (GUI#win.options)#options.linear.
+
+%% Display load
+%% Used when load information is received from the displayed node
+-define(highloadfg, {255,99,71}).
+-define(midloadfg, yellow).
+-define(lowloadfg, green).
+-define(highloadbg, {140,157,178}).
+-define(midloadbg, ?highloadbg).
+-define(lowloadbg, ?highloadbg).
+
+display_load(GUI, {Old, New}) ->
+ if
+ Old == New ->
+ true;
+ Old > New ->
+ leds_down(GUI#win.leds, Old, New);
+ true ->
+ leds_up(GUI#win.leds, Old, New)
+ end.
+
+leds_down(_Leds, Old, New) when Old == New ->
+ done;
+leds_down(Leds, Old, New) when Old > New ->
+ reset_led(Leds, Old),
+ leds_down(Leds, Old-1, New).
+leds_up(_Leds, Old, New) when Old == New ->
+ done;
+leds_up(Leds, Old, New) when Old < New ->
+ set_led(Leds, Old),
+ leds_up(Leds, Old+1, New).
+
+led_on_col(N) when N > 13 -> ?highloadfg;
+led_on_col(N) when N > 9 -> ?midloadfg;
+led_on_col(_) -> ?lowloadfg.
+
+led_off_col(N) when N > 13 -> ?highloadbg;
+led_off_col(N) when N > 9 -> ?midloadbg;
+led_off_col(_) -> ?lowloadbg.
+
+reset_led(_Leds, 0) -> ok;
+reset_led(Leds, N) ->
+ gs:config(lists:nth(N, Leds), [{fill, led_off_col(N)}]).
+
+set_led(_Leds, 0) -> ok;
+set_led(Leds, N) ->
+ gs:config(lists:nth(N, Leds), [{fill, led_on_col(N)}]).
+
+%%----------------------------------------------------------------------
+%% Utilities
+%%----------------------------------------------------------------------
+
+bcast(MNodes, Msg) ->
+ lists:foreach(fun(MNode) ->
+ case MNode#mnode.status of
+ alive ->
+ MNode#mnode.pid ! Msg;
+ dead ->
+ ignore
+ end
+ end,
+ MNodes).
+
+max(X, Y) when X>Y -> X;
+max(_, Y) -> Y.
+
+%% parse_nodes(MNodes) -> NodeApps
+%% MNodes -> [#mnode{}]
+%% NodeApps -> [{Node, Status, Apps}]
+%% Node -> atom()
+%% Status -> alive | dead
+%% Apps -> [{Pid, App}]
+%% Pid -> pid()
+%% App -> atom()
+parse_nodes(MNodes) ->
+ parse_nodes(MNodes, []).
+parse_nodes([MNode|MNodes], NodeApps) ->
+ Apps = parse_apps(MNode#mnode.apps, []),
+ parse_nodes(MNodes,
+ [{MNode#mnode.name,MNode#mnode.status,Apps}|NodeApps]);
+parse_nodes([], NodeApps) ->
+ NodeApps.
+
+parse_apps([{Pid, App, _Descr}|Rest], Apps) ->
+ parse_apps(Rest, [{Pid, App}|Apps]);
+parse_apps([], Apps) ->
+ Apps.
+
+%%----------------------------------------------------------------------
+%% Canvas buttons
+%%----------------------------------------------------------------------
+
+canvasbutton(Canvas, Text, X, Y, W, H, Data) ->
+
+ %% Draw a rectangle (for event catching)
+ Rect = gs:create(rectangle, Canvas, [{coords, [{X,Y}, {X+W,Y+H}]},
+ {fill, gs:read(Canvas, bg)},
+ {buttonpress, true},
+ {buttonrelease, true}]),
+
+ %% Make the rectangle area look like a 3D button by using lines
+ Ul = gs:create(line, Canvas, [{coords, [{X,Y+H},{X,Y},{X+W,Y}]},
+ {fg, white}, {width, 2}]),
+ Ll = gs:create(line, Canvas, [{coords, [{X,Y+H},{X+W,Y+H},{X+W,Y}]},
+ {fg, {87,87,87}}, {width, 2}]),
+
+ %% Write the text in the middle
+ Xc = X + round(W/2),
+ Yc = Y + round(H/2),
+ T = gs:create(text, Canvas, [{text, Text}, {coords, [{Xc,Yc}]},
+ {anchor, c},
+ {buttonpress, true},
+ {buttonrelease, true}]),
+
+ %% Create the canvasbutton object
+ CBtn = #canvasbutton{text=T, ul=Ul, ll=Ll, rect=Rect,
+ x=X, y=Y, w=W, h=H},
+
+ %% Configure the data
+ gs:config(T, {data, {canvasbutton, CBtn, Data}}),
+ gs:config(Rect, {data, {canvasbutton, CBtn, Data}}),
+
+ CBtn.
+
+press(Canvasbutton) ->
+ gs:config(Canvasbutton#canvasbutton.ul, {fg, {87,87,87}}),
+ gs:config(Canvasbutton#canvasbutton.ll, {fg, white}).
+
+release(Canvasbutton) ->
+ gs:config(Canvasbutton#canvasbutton.ul, {fg, white}),
+ gs:config(Canvasbutton#canvasbutton.ll, {fg, {87,87,87}}).
diff --git a/lib/appmon/src/appmon_a.erl b/lib/appmon/src/appmon_a.erl
new file mode 100644
index 0000000000..b0b5847343
--- /dev/null
+++ b/lib/appmon/src/appmon_a.erl
@@ -0,0 +1,1117 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(appmon_a).
+
+%%----------------------------------------------------------------------
+%%
+%% Monitors an application, i.e its supervision tree.
+%%
+%%----------------------------------------------------------------------
+%%
+%%
+%% INTRODUCTION
+%% ------------
+%%
+%% This file contains a description of the files involved
+%% and the communication between the appmon_a display
+%% manager and the appmon_a2 information gatherer. Further
+%% information on the placement algorithm can be found in
+%% the place.erl file.
+%%
+%%
+%% FILES
+%% -----
+%%
+%% The supervision tree graphical software consists of
+%% the following files:
+%%
+%% appmon_a Gen server driving the process display window.
+%% Responsible for assigning gs identifiers to all
+%% processes and process link
+%% appmon_a2 The process information gathering routines.
+%% Works by following the process links from application
+%% master once every second
+%% dg The process database is implemented as a shared
+%% digraph (see manual pages for digraph) and this is
+%% the routines handling this digraph. Since the digraph
+%% is shared appmon_a2 will put some info into it that the
+%% appmon_a later will modify. The structures used are
+%% described in dg.hrl
+%% place Places a tree, decides the x and y coordinates (not
+%% necessarily corresponding to window coordinates) of
+%% processes (or vertices to be specific). Note that
+%% special routines are used to transform the possibly
+%% cyclic digraph into a strict tree before trying to
+%% place it.
+%%
+%%
+%%
+%% IMPLEMENTATION DETAIL
+%% ---------------------
+%%
+%% The appmon_a module will follow links between processes,
+%% starting with the application master. A unique
+%% reference is used to prevent infinite recursion. Note
+%% that this process and link gathering is done in the
+%% live digraph so that already known processes are
+%% updated with the reference and new ones are added to
+%% the digraph. After all processes and links have been
+%% added or updated a search is made for those processes
+%% and links that have an old reference. These are those
+%% processes and links that are not present in the
+%% application any more. Those are extracted from the
+%% digraph and then deleted and the extracts are then
+%% used (by appmon_a) to delete the appropriate gs
+%% objects. The responsibilities of appmon_a is thus 1) add
+%% all new processes and links to the digraph and 2) make
+%% a list of all those objects from the digraph that have
+%% been deleted.
+%%
+%% When appmon_a2 has gathered all necessary information it
+%% notifies the appmon_a display manager. Note that this is
+%% implemented as a call (as opposed to a cast) to
+%% prevent appmon_a2 from changing the digraph while appmon_a
+%% uses it. appmon_a places all processes using the place
+%% module. place will place the processes in the x y
+%% planes, hopefully in a nice way, re-forming the
+%% digraph during the process into a strict tree using
+%% some simple heuristics, some links that makes the
+%% graph cyclic will be considered secondary and later
+%% coloured red. Note that the process links are not
+%% placed since their coordinates are those of the
+%% processes that they are links between. The place
+%% module is only concerned at a fairly high level of
+%% abstraction. Currently its x coordinates are used as
+%% real coordinates while the y coordinates must be
+%% scaled to correct values, thus the x plane is
+%% continous and the y plane is disctrete.
+%%
+%% Having placed processes the new ones are drawn on the
+%% display along with all new process links, then all
+%% processes and process links are moved to their
+%% possibly new positions. The place module is not
+%% sensitive to changes in position and therefore has no
+%% concept of which nodes will have to be moved. hence
+%% all nodes are moved (but most of them probably to the
+%% same position as before)
+%%
+%%
+%%
+%%
+%%----------------------------------------------------------------------
+
+
+
+-export([start/2, start/3, stop/0]).
+
+
+-record(astate, {app, name, client, digraph}).
+
+-import(lists, [foreach/2]).
+
+%% gen server stuff
+-behaviour(gen_server).
+-export([init/1, handle_cast/2, handle_info/2, terminate/2]).
+-export([handle_call/3, code_change/3]).
+
+
+-define(APPSPACE, 10). % The space between apps
+-define(NODEAREA_H, 90). % The height of a node
+-define(BUTTAREA_H, 80). % The button area height
+-define(APPBUTT_H, 20). % Height of appl button
+-define(EDITORW, 260).
+
+-define(MAXWIDTH, 800).
+-define(MINWIDTH, 382).
+-define(MAXHEIGHT, 450).
+-define(MINHEIGHT, 325).
+
+-define(SUPVIEWTXT, "Sup. view").
+-define(PROCVIEWTXT, "Proc. view").
+-define(CLOSETXT, "Close").
+-define(REFRESHTXT, "Refresh").
+-define(SAVEOPTSTXT, "Save options").
+-define(HELPTXT, "Help").
+
+-define(CHARWIDTH, 7). %Should use GS primitives
+
+-define( darkkhaki, {189, 183, 107}).
+-define( palegoldenrod, {238, 232, 170}).
+-define( peachpuff4, {139, 119, 101}).
+-define( red, red).
+-define( darkgrey, {169, 169, 169}).
+-define( lightgrey, {211, 211, 211}).
+-define( royalblue, {65, 105, 225}).
+-define( aquamarine4, {69, 139, 116}).
+-define( palegreen4, {84, 139, 84}).
+-define( darkseagreen, {105, 139, 105}).
+-define( f_line_col, {150, 150, 255}).
+
+
+-include("appmon_dg.hrl").
+
+
+%%------------------------------------------------------------
+%%------------------------------------------------------------
+
+
+start(NodeName, AppName) ->
+ gen_server:start_link(?MODULE, {NodeName, AppName, AppName}, []).
+
+start(NodeName, AppName, AppId) ->
+ gen_server:start_link(?MODULE, {NodeName, AppName, AppId}, []).
+
+
+stop() ->
+ ok.
+
+
+
+%%------------------------------------------------------------
+%% Public interface
+
+
+%%------------------------------------------------------------
+%% Administration
+
+%% AppName is the name of the application, usually an atom like sasl
+%% or kernel, AppId is the application pid or the application name,
+%% either goes.
+init({NodeName, AppName, AppId}) ->
+ process_flag(trap_exit, true),
+ {ok, Client} = appmon_info:start_link(NodeName, self(), []),
+ init_ref(),
+ init_foreign_places(),
+ DG = digraph:new([cyclic, private]),
+ State = #astate{app=AppId, name=AppName, client=Client, digraph=DG},
+ refresh(State),
+ setup_base_win(NodeName, AppName),
+ {ok, State}.
+
+terminate(_Reason, _State) ->
+ ok.
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+handle_call(norequest, _From, State) ->
+ {reply, null, State}.
+
+%%------------------------------------------------------------
+%% handle casts
+
+handle_cast({ping, _Node, _From}, State) ->
+ {noreply, State};
+handle_cast(_Other, State) ->
+ {noreply, State}.
+
+
+
+%%------------------------------------------------------------
+%% handle info
+
+handle_info({gs, _, click, _, [?CLOSETXT|_]}, State) ->
+ {stop, normal, State};
+handle_info({gs, _, destroy, _, _}, State) ->
+ {stop, normal, State};
+handle_info({gs, _, click, _, [?REFRESHTXT|_]}, State) ->
+ refresh(State),
+ {noreply, State};
+handle_info({gs, _, click, _, [?HELPTXT|_]}, State) ->
+ HelpFile = filename:join([code:lib_dir(appmon),
+ "doc", "html", "part_frame.html"]),
+ tool_utils:open_help(win(), HelpFile),
+ {noreply, State};
+handle_info({gs, Id, click, {mode, Mode}, _}, State) ->
+ %%io:format("handle_info: Setting mode: ~p~n", [Mode]),
+ set_mode(Id, Mode),
+ {noreply, State};
+handle_info({gs, _, click, _, [?SUPVIEWTXT|_]}, State) ->
+ refresh(State, [{info_type, sup}]),
+ {noreply, State};
+handle_info({gs, _, click, _, [?PROCVIEWTXT|_]}, State) ->
+ refresh(State, [{info_type, link}]),
+ {noreply, State};
+handle_info({gs, Id, buttonpress, _,[1, X, Y|_]}, State) ->
+ %%io:format("Id clicked: ~p~n", [gs:read(Id, {find, {X, Y}})]),
+ catch find_pid(State, Id, X, Y),
+ set_default_mode(),
+ {noreply, State};
+handle_info({gs, Win, configure, _Data, [W, H|_]}, State) ->
+ case win() of Win -> user_driven_resize(W, H);
+ _-> ok
+ end,
+ {noreply, State};
+
+handle_info({delivery, _S, pinfo, _N, Res}, State) ->
+ appmon_txt:print(Res),
+ {noreply, State};
+handle_info({delivery, S, app, N, Res}, State) ->
+ {delivery, _Serv, app, _Name, {Root, Vs, Ls, SecLs}} =
+ flush({delivery, S, app, N, Res}),
+ update2(Vs, Root, Ls, SecLs, State),
+ {noreply, State};
+
+handle_info({kill}, State) ->
+ {stop, normal, State};
+handle_info({state}, State) ->
+ {noreply, State};
+handle_info({'EXIT', _Pid, _Reason}, State) ->
+ {noreply, State};
+handle_info(_Other, State) ->
+ {noreply, State}.
+
+
+%% Refresh sets new options for the request and forces an update of
+%% the screen ant status.
+refresh(State) ->
+ refresh(State, []).
+refresh(State, Opts) ->
+ appmon_info:app(State#astate.client,
+ State#astate.name, true, Opts).
+
+
+
+%% find_pid finds the pid of the clicked object. The scenario is that
+%% the user clicks on an item in his window, that ObjId is searched
+%% for among all nodes (vertices) and if found action is taken
+%% depending on the current mode (see handle_info)
+find_pid(State, Id, X, Y) ->
+ %% Try to manage both versions of GS, remove first case later.
+ ObjList = case gs:read(Id, {find, {X, Y}}) of
+ {error, _} ->
+ gs:read(Id, {hit, {X, Y}}); % Try new format
+ Num when is_integer(Num) -> [Num];
+ _Other -> []
+ end,
+ DG = State#astate.digraph,
+ All = appmon_dg:get(all, DG),
+ find_pid2(ObjList, All, DG, State).
+
+find_pid2([Id | Ids], All, DG, State) ->
+ case search_for_pid(All, DG, Id) of
+ {ok, _KeyStr, Pid} ->
+ handle_proc_press(mode(), Pid, State);
+ _ -> find_pid2(Ids, All, DG, State)
+ end;
+find_pid2([], _All, _DG, _State) -> ok.
+
+search_for_pid([V|Vs], DG, ObjId) ->
+ VD = appmon_dg:get(data, DG, V),
+ if ObjId==VD#vdata.txt_obj ->
+ {ok, V, VD#vdata.type};
+ true -> search_for_pid(Vs, DG, ObjId)
+ end;
+search_for_pid([], _DG, _ObjId) -> false.
+
+
+%%
+%% called when a process has been clicked on.
+%%
+handle_proc_press(info, Pid, State) ->
+ appmon_info:pinfo(State#astate.client, Pid, true,
+ [{timeout, at_most_once}]);
+handle_proc_press(send, Pid, _State) ->
+ {P, RawStr} = two_entries(winroot(), 250, 70,
+ "Send", "To: ", "Msg: ",
+ pid_to_list(Pid), "", bg()),
+ Str = case lists:last(RawStr) of
+ 46 -> RawStr;
+ _ -> RawStr++"."
+ end,
+ case erl_scan:string(Str) of
+ {ok, Tokens, _} ->
+ case erl_parse:parse_term(Tokens) of
+ {ok, Term} ->
+ case catch list_to_pid(P) of
+ To when is_pid(To) -> To ! Term;
+ _ -> error
+ end;
+ _Error -> error
+ end;
+ _Error -> error
+ end;
+handle_proc_press(trace, Pid, _State) ->
+ case trace_state(Pid) of
+ true ->
+ io:format("Removing trace on ~p~n", [Pid]),
+ sys:trace(Pid, false),
+ set_trace_state(Pid, false);
+ _Other ->
+ io:format("Putting trace on ~p~n", [Pid]),
+ sys:trace(Pid, true, 1000),
+ set_trace_state(Pid, true)
+ end;
+handle_proc_press(kill, Pid, _State) ->
+ exit(Pid, kill).
+
+
+trace_state(Pid) -> get({trace_state, Pid}).
+set_trace_state(Pid, State) -> put({trace_state, Pid}, State).
+
+set_default_mode() ->
+ {Id, Mode} = get(default_mode),
+ case mode() of
+ Mode -> true;
+ _Other -> set_mode(Id, Mode)
+ end.
+set_default_mode(Id, Mode) ->
+ put(default_mode, {Id, Mode}),
+ select(Id), %Dirty workaround
+ set_default_mode().
+
+set_mode(Id, Mode) ->
+ %%io:format("mode=~p~n", [Mode]),
+ set_mode(Mode),
+ deselect(),
+ select(Id).
+
+set_mode(Mode) -> put(mode, Mode).
+mode() -> get(mode).
+
+flush({delivery, S, A, N, R}) ->
+ receive
+ {delivery, S, A, N, R2} ->
+ flush({delivery, S, A, N, R2})
+ after 0 ->
+ {delivery, S, A, N, R}
+ end.
+
+
+%%------------------------------------------------------------
+%% Real stuff
+%%
+update2(Vs, Root, Ls, SecLs, State) ->
+ DG = State#astate.digraph,
+ Ref = mk_ref(),
+ Added = add_procs(Vs, DG, Ref),
+ AddedLs = add_links(Ls, DG, Ref, primary),
+ AddedLs2 = add_links(SecLs, DG, Ref, secondary),
+ DelLs = del_links(appmon_dg:eget(all, DG), DG, Ref),
+ Dels = del_procs(appmon_dg:get(all, DG), DG, Ref),
+
+ LastX = appmon_place:place(DG, Root),
+ Width = lists:max(LastX),
+ Height = length(LastX),
+
+ %% Delete things from screen
+ del(Dels), del(DelLs),
+
+ %% Add vertices to screen
+ foreach(fun(V) -> draw_node(DG, V) end, Added),
+
+ %% Add edges to screen
+ foreach(fun(E) -> draw_edge(DG, E) end, AddedLs),
+ foreach(fun(E) -> draw_edge(DG, E) end, AddedLs2),
+
+ %% Move vertices on screen
+ foreach(fun(V) -> move_vertex(DG, V) end, appmon_dg:get(all, DG)),
+
+ tree_driven_resize(Width, Height),
+
+ gs:config(win(), {map, true}), %Make win visible
+ ok.
+
+%% Make an integer reference, could have used make_ref BIF but didn't
+mk_ref() -> put(reference, get(reference)+1).
+init_ref() -> put(reference, 0).
+
+
+%% Add processes (vertices) to digraph, use the string repr of pid as
+%% key in digraph.
+add_procs([{Pid, Str}|Vs], DG, Ref) ->
+ case appmon_dg:add(DG, Str, mk_vdata(Str, Pid, Ref), Ref) of
+ known -> add_procs(Vs, DG, Ref);
+ updated -> add_procs(Vs, DG, Ref);
+ _ ->
+ case lists:member(32, Str) of
+ true ->
+ appmon_dg:set(x, DG, Str, foreign), % UNHOLY!
+ add_procs(Vs, DG, Ref); % Don't add foreign
+ _ -> [Str | add_procs(Vs, DG, Ref)]
+ end
+ end;
+add_procs([], _DG, _Ref) -> [].
+
+
+%% Add links to digraph. NOTE that foreign links get a special weight
+%% and that no link is added if it goes to a process not in the set of
+%% vertices.
+%%
+%% OTP-1970: Check that linked-to processes really exist.
+%%
+add_links([{V1, V2}|Ls], DG, Ref, Weight) ->
+ L = case lists:member(32, V2) of
+ true -> {V1, V2, foreign};
+ _ -> {V1, V2, Weight}
+ end,
+ case appmon_dg:get(data, DG, V2) of
+ false -> add_links(Ls, DG, Ref, Weight);
+ VD ->
+ if VD#vdata.ref == Ref -> % OTP-1970
+ case appmon_dg:eadd(DG, L, mk_edata(L, Ref), Ref) of
+ known -> add_links(Ls, DG, Ref, Weight);
+ updated -> add_links(Ls, DG, Ref, Weight);
+ _Other -> [L | add_links(Ls, DG, Ref, Weight)]
+ end;
+ true ->
+ add_links(Ls, DG, Ref, Weight)
+ end
+ end;
+add_links([], _DG, _Ref, _Weight) -> [].
+
+%% Make an edge data structure
+mk_edata(_L, Ref) ->
+ #edata{ref=Ref}.
+
+%% Make a vertex data structure, note that pid can be either a pid or
+%% a port, we're not picky here.
+mk_vdata(P, Pid, Ref) ->
+ #vdata{ref=Ref, type=Pid, txt=P, width=width(P)}.
+width(Txt) -> ?CHARWIDTH*length(Txt)+10. % Should use GS stuff instead
+
+
+%% Delete those processes that have the wrong reference from the
+%% digraph. Returns a list of deleted procs and their data (to be able
+%% to erase things on screen).
+del_procs([V|Vs], DG, Ref) ->
+ VD = appmon_dg:get(data, DG, V),
+ if VD#vdata.ref /= Ref -> appmon_dg:del(DG, V),
+ [{V, VD} | del_procs(Vs, DG, Ref)];
+ true -> del_procs(Vs, DG, Ref)
+ end;
+del_procs([], _DG, _Ref) -> [].
+
+
+%% Deletes links that have the wrong reference from the digraph, note
+%% that the weight of the edge is not considered here. Returns a list
+%% of deleted links and their data (to be able to erase things on
+%% screen).
+del_links([L | Ls], DG, Ref) ->
+ ED = appmon_dg:eget(data, DG, L),
+ if ED#edata.ref /= Ref -> appmon_dg:edel(DG, L),
+ [{L, ED} | del_links(Ls, DG, Ref)];
+ true -> del_links(Ls, DG, Ref)
+ end;
+del_links([], _DG, _Ref) -> [].
+
+%% Del deletes the GS objects of the list of should-be-deleted
+%% items. Returns nothing particular.
+del(L) ->
+ lists:foreach(fun({{V1, V2, Weight}, D}) when is_record(D, edata) ->
+ if Weight== foreign ->
+ dealloc_foreign({V1, V2, Weight});
+ true -> ok end,
+ destroy(D#edata.line);
+ ({_I, D}) when is_record(D, vdata) ->
+ destroy(D#vdata.sym_obj),
+ destroy(D#vdata.txt_obj)
+ end, L).
+
+
+move_vertex(DG, V) ->
+ VData = appmon_dg:get(data, DG, V),
+%% io:format("Vertex ~p data: x:~p, oldx:~p, y:~p, oldy:~p offs:~p~n",
+%% [V, VData#vdata.x, VData#vdata.origx,
+%% VData#vdata.y, VData#vdata.origy, offsetx()]),
+ if VData#vdata.x == foreign -> ok;
+ true ->
+ X = VData#vdata.x,
+ Y = scaley(VData#vdata.y),
+ OldX = VData#vdata.origx,
+ OldY = scaley(VData#vdata.origy),
+ if X==OldX, Y==OldY -> true;
+ true ->
+ %%io:format("Moving vertex: ~p~n", [V]),
+
+ W = VData#vdata.width,
+ {BoxC, TxtC} = calc_box_coords(X, Y, W),
+
+ %% move the symbol and text
+ gs:config(VData#vdata.sym_obj, [{coords, BoxC}]),
+ gs:config(VData#vdata.txt_obj, [{coords, TxtC}]),
+ foreach(fun(E) -> move_edge(DG, E) end,
+ appmon_dg:get(edges, DG, V))
+ end
+ end.
+
+
+move_edge(DG, E) ->
+ {{V1, V2, Weight}, V1, V2, ED} = appmon_dg:eget(edge, DG, E),
+ VD1 = appmon_dg:get(data, DG, V1),
+ VD2 = appmon_dg:get(data, DG, V2),
+ Line = ED#edata.line,
+ move_line(DG, VD1, VD2, Line, Weight).
+move_line(DG, VD1, VD2, Line, Weight) when is_list(Line) ->
+ move_line(DG, VD1, VD2, hd(Line), Weight);
+move_line(_DG, VD1, VD2, Line, Weight) ->
+ Coords = calc_coords(VD1, VD2, Weight),
+ gs:config(Line, [{coords, Coords} | line_opts(Weight)]).
+
+%% Draw the vertex on the canvas
+draw_node(DG, V) ->
+ %%io:format("Drawing~n",[]),
+ Data = appmon_dg:get(data, DG, V),
+
+ X = Data#vdata.x,
+ Y = scaley(Data#vdata.y),
+
+ {Sym, Txt} = draw(rectangle, sup_col(), Data#vdata.txt, X, Y,
+ Data#vdata.width),
+
+ appmon_dg:av(DG, V, Data#vdata{sym_obj=Sym, txt_obj=Txt}),
+ true.
+
+%% Draws a symbol (rectangle for instance) on the canvas.
+draw(Symbol, Col, Txt, X, Y, W) ->
+ {BoxC, TxtC} = calc_box_coords(X, Y, W),
+ Box = gs:create(Symbol, canvas(), [{coords, BoxC}, {fill, Col}]),
+
+ TxtObj = gs:create(text, canvas(), [{coords, TxtC},
+ {anchor, c},
+ %%{buttonpress, true},
+ {text, Txt}]),
+ {Box, TxtObj}.
+
+%% Returns {BoxCoords, TextCoords}
+calc_box_coords(X, Y, W) ->
+ {[{X, Y-radius()}, {X+W, Y+radius()}], [{X+trunc(W/2), Y}]}.
+
+
+%% Draw a line on the canvas
+draw_edge(DG, E) ->
+ {V1, V2, Weight} = E,
+ Line = draw_line(DG, V1, V2, Weight),
+%% io:format("Line: ~p~n", [Line]),
+ appmon_dg:eset(line, DG, E, Line).
+
+
+%% From is parent, To is child. If To is not a record then we are
+%% dealing with a link to a process on another node. Find a suitable
+%% place at the left margin and write the process name there and draw
+%% a line to it.
+%%
+draw_line(DG, From, To, foreign) ->
+ VD1 = appmon_dg:get(data, DG, From),
+ Y = find_foreign_place(VD1#vdata.y+0.5, foreign_places()),
+ add_foreign_place({From, To, foreign}, Y),
+%% io:format("New Y: ~p~n", [Y]),
+ appmon_dg:set(x, DG, To, 0),
+ appmon_dg:set(y, DG, To, Y),
+ VD2 = appmon_dg:get(data, DG, To),
+ Coords = calc_coords(VD1, VD2, foreign),
+%% io:format("Node coords: ~p~n", [Coords]),
+ L = gs:create(line, canvas(), [{coords, Coords} | line_opts(foreign)]),
+ T = gs:create(text, canvas(), [{coords, [{0, 5+scaley(Y)}]},
+ {anchor, nw}, {fg, f_line_col()},
+%% {font, {screen, 10}},
+ {text, To}]),
+ [L, T];
+
+draw_line(DG, From, To, Weight) ->
+ VD1 = appmon_dg:get(data, DG, From),
+ VD2 = appmon_dg:get(data, DG, To),
+ Coords = calc_coords(VD1, VD2, Weight),
+ gs:create(line, canvas(), [{coords, Coords} | line_opts(Weight)]).
+
+%%----------------------------------------------------------------------
+%%
+%% Line coordinate calculation
+%%
+%% Calculate coordinates for edges (links, lines). Primaries have a
+%% nice knee and secondaries are oriented differently. If weight is
+%% foreign then we will calculate a nice line to the left margin.
+%%
+calc_coords(From, To, foreign) ->
+ Y = scaley(To#vdata.y),
+ X1 = From#vdata.x+trunc(From#vdata.width/2),
+ Y1 = scaley(From#vdata.y)+radius(),
+ [{0, Y}, {X1-40, Y}, {X1, Y1}];
+calc_coords(From, To, primary) ->
+ X1 = From#vdata.x+trunc(From#vdata.width/2),
+ Y1 = scaley(From#vdata.y)+radius(),
+
+ X2 = To#vdata.x+trunc(To#vdata.width/2),
+ Y2 = scaley(To#vdata.y)-radius(),
+
+ Y3 = trunc((Y1+Y2)/2),
+ [{X1, Y1}, {X1, Y3}, {X2, Y3}, {X2, Y2}];
+
+calc_coords(V1, V2, _Weight) ->
+ Y1 = scaley(V1#vdata.y),
+ X1 = V1#vdata.x,
+ X1w = X1+V1#vdata.width,
+ Y2 = scaley(V2#vdata.y),
+ X2 = V2#vdata.x,
+ X2w = X2+V2#vdata.width,
+
+ if Y1 == Y2 -> calc_u(X1, X1w, Y1, X2, X2w);
+ X1w < X2 -> calc_s(X1w, Y1, X2, Y2);
+ X2w < X1 -> calc_s(X1, Y1, X2w, Y2);
+ true ->
+ D1 = abs(X1-X2), D2 = abs(X1w-X2w),
+ if D1 > D2 -> calc_rbrack(X1w, Y1, X2w, Y2);
+ true -> calc_lbrack(X1, Y1, X2, Y2)
+ end
+ end.
+
+%% Calculates line coordinates that will go from bottom of one node to
+%% bottom of another on the same level. The line will form a nice "U".
+calc_u(X1, X1w, Y, X2, X2w) ->
+ X3 = trunc((X1+X1w)/2),
+ X4 = trunc((X2+X2w)/2),
+ Y2 = Y+radius(),
+ Y3 = Y2+20,
+ [{X3, Y2}, {X3, Y3}, {X4, Y3}, {X4, Y2}].
+
+%% Calculates line coordinates that will go from right (or left) side
+%% to right (or left) side, thus forming a "[" or a "]" (bracket).
+calc_rbrack(X1, Y1, X2, Y2) ->
+ X3 = 20 + if X1 > X2 -> X1;
+ true -> X2
+ end,
+ [{X1, Y1}, {X3, Y1}, {X3, Y2}, {X2, Y2}].
+calc_lbrack(X1, Y1, X2, Y2) ->
+ X3 = -20 + if X1 < X2 -> X1;
+ true -> X2
+ end,
+ [{X1, Y1}, {X3, Y1}, {X3, Y2}, {X2, Y2}].
+
+%% Calculates line coordinates that will form a nice "S"
+calc_s(X1, Y1, X2, Y2) ->
+ X3 = trunc((X1+X2)/2),
+ [{X1, Y1}, {X3, Y1}, {X3, Y2}, {X2, Y2}].
+
+
+%% Options for lines (edges, links)
+line_opts(foreign) -> [{width, 2}, {smooth, true}, {fg, f_line_col()}];
+line_opts(primary) -> [{width, 2}, {smooth, false}, {fg, line_col()}];
+line_opts(_) -> [{width, 2}, {smooth, true}, {fg, sec_line_col()}].
+
+
+
+%%----------------------------------------------------------------------
+%%
+%% Handling of links to foreign processes
+%%
+%%----------------------------------------------------------------------
+dealloc_foreign(L) ->
+%% io:format("deallocing foreign: ~p~n", [L]),
+ put(foreign_places, lists:keydelete(L, 1, foreign_places())).
+add_foreign_place(V, Y) ->
+%% io:format("Adding foreign: ~p~n", [V]),
+ put(foreign_places, [{V, Y} | foreign_places()]).
+foreign_places() ->
+ get(foreign_places).
+init_foreign_places() ->
+ put(foreign_places, []).
+
+%% Find a good place for the foreign node
+find_foreign_place(StartY, L) ->
+ case lists:keysearch(StartY, 2, L) of
+ {value, _} -> find_foreign_place(StartY + 1, L);
+ _ -> StartY
+ end.
+
+
+%%------------------------------------------------------------
+%%
+%% Graphical stuff
+%%
+
+setup_base_win(NodeName, AppName) ->
+ set_winroot(gs:start([{kernel,true}])),
+
+ W = ?MINWIDTH, H = ?MINHEIGHT,
+
+ Name = "APPMON: " ++ atom_to_list(AppName) ++ " on " ++
+ atom_to_list(NodeName),
+
+ set_win(gs:create(window, winroot(), [{title, Name}, %%{bg, red},
+ {x, 250}, {y, 100},
+ {width, W}, {bg, win_col()},
+ {height, H+?BUTTAREA_H}])),
+ %% standard buttons
+ mk_std_butts(win(), W),
+ set_canvas(gs:create(canvas, win(),[{x,0}, {y,?BUTTAREA_H},
+ {width, W}, {height, H},
+ {bg, bg()},
+ {buttonpress, true}])),
+
+ set_old_win_size(width, gs:read(win(), width)),
+ set_old_win_size(height, gs:read(win(), height)),
+
+%% gs:config(win(), {map, true}), %Make win visible
+ ok.
+
+
+nice_line_coords(W, H) ->
+ [{0,H-10}, {W,H-10}].
+
+%%------------------------------
+%% Button stuff
+
+mk_butt_area(Win, W) ->
+ H = ?BUTTAREA_H,
+ F = gs:create(frame, Win,[{x,0}, {y,0}, %%{bg, frame_col()},
+ {width,W}, {height,H}]),
+ C = gs:create(canvas,F,[{x,0}, {y,0}, {width, W}, {height, H-9},
+ {bg, bg()}]),
+ L = gs:create(line,C,[{coords,nice_line_coords(W, H)}]),
+
+ MB = gs:create(menubar, Win, []),
+
+ FMB = gs:create(menubutton, MB, [{label, {text, "File"}}]),
+ FM = gs:create(menu, FMB, []),
+ gs:create(menuitem, FM, [{label, {text, ?CLOSETXT}}]),
+
+ OMB = gs:create(menubutton, MB, [{label, {text, "Options"}}]),
+ OM = gs:create(menu, OMB, []),
+ gs:create(menuitem, OM, [{label, {text, ?REFRESHTXT}}]),
+ Group = now(),
+ gs:create(menuitem, OM, [{itemtype, separator}]),
+ gs:create(menuitem, OM, [{label, {text, ?SUPVIEWTXT}}, {itemtype, radio},
+ {group, Group}]),
+ gs:create(menuitem, OM, [{label, {text, ?PROCVIEWTXT}}, {select, true},
+ {group, Group}, {itemtype, radio}]),
+
+ HMB = gs:create(menubutton, MB, [{label, {text, "Help"}}, {side, right}]),
+ HM = gs:create(menu, HMB, []),
+ gs:create(menuitem, HM, [{label, {text, ?HELPTXT}}]),
+
+ {F, C, L}.
+
+mk_std_butts(Win, W) ->
+ {F, C, L} = mk_butt_area(Win, W),
+ set_bframe(F), set_bcanvas(C), set_bline(L),
+
+ IButt = mk_mode_butt({text, "Info"}, {mode, info}, 10),
+ mk_mode_butt({text, "Send"}, {mode, send}, 90),
+ mk_mode_butt({text, "Trace"}, {mode, trace}, 170),
+ mk_mode_butt({text, "Kill"}, {mode, kill}, 250),
+
+ set_default_mode(IButt, info),
+
+ true.
+
+select(Id) ->
+ gs:config(Id, {bg, sel_col()}),
+ set_selected(Id).
+
+deselect() ->
+ gs:config(selected(), {bg, de_sel_col()}).
+
+mk_mode_butt(Label, Data, X) ->
+ gs:create(button, bframe(), [{label, Label}, {x, X}, {y, 35},
+ {data, Data}, {width, 70}, {height, 25}]).
+
+%%------------------------------------------------------------
+%% Graphical utilities
+
+mk_frame(P, X, Y, W, H, BG) ->
+ gs:create(frame, P, [{x, X}, {y, Y}, {width, W}, {height, H}, {bg, BG}]).
+
+mk_butt(P, X, Y, W, H, Txt) ->
+ gs:create(button, P, [{x, X}, {y, Y}, {height, H}, {width, W},
+ {label, {text, Txt}}]).
+
+mk_butt(P, X, Y, Txt) ->
+ mk_butt(P, X, Y, 70, 20, Txt).
+
+mk_label(P, X, Y, W, H, Txt, BG) ->
+ gs:create(label, P, [{x, X}, {y, Y}, {height, H}, {width, W},
+ {label, {text, Txt}}, {bg, BG}]).
+
+mk_entry(P, X, Y, W, H, Txt, BG) ->
+ gs:create(entry, P, [{x, X}, {y, Y}, {height, H}, {width, W}, {text, Txt},
+ {bg, BG}, {keypress, true}]).
+
+
+two_entries(Root, W, H, Name, LTxt1, LTxt2, StartTxt1, StartTxt2, BG) ->
+ Win = gs:create(window, Root, [{title, Name}, %%{bg, red},
+ %%{x, X}, {y, Y},
+ {width, W}, {bg, BG},
+ {height, H}]),
+ F = mk_frame(Win, 0, 0, W, H, BG),
+
+ mk_label(F, 10, 10, 30, 20, LTxt1, BG),
+ mk_label(F, 10, 40, 30, 20, LTxt2, BG),
+
+ E1 = mk_entry(F, 40, 10, 120, 20, StartTxt1, BG),
+ E2 = mk_entry(F, 40, 40, 120, 20, StartTxt2, BG),
+
+ Ok = mk_butt(F, 170, 10, "Ok"),
+ Cn = mk_butt(F, 170, 40, "Cancel"),
+ gs:config(Win, {map, true}),
+
+ Ret = case catch two_entries_loop(E1, E2, Ok, Cn) of
+ {P2, Msg} -> {P2, Msg};
+ _Other ->
+ false
+ end,
+ gs:destroy(Win),
+ Ret.
+
+
+two_entries_loop(E1, E2, Ok, Cn) ->
+ receive
+ {gs, Ok, click, _, _} ->
+ {gs:read(E1, text),
+ gs:read(E2, text)};
+ {gs, E1, keypress, _, ['Return'|_]} ->
+ {gs:read(E1, text),
+ gs:read(E2, text)};
+ {gs, E2, keypress, _, ['Return'|_]} ->
+ {gs:read(E1, text),
+ gs:read(E2, text)};
+ {gs, _, keypress, _, _} ->
+ two_entries_loop(E1, E2, Ok, Cn);
+ {gs, Cn, click, _, _} ->
+ true
+ end.
+
+%%--------------------------------------------------------------------
+%%
+%% Resizing routines.
+%%
+%% Resizing deals with a number of different interdependent
+%% sizes. Top size is the window size. From window size all other
+%% sizes are calculated, we call this the "leader" size. The
+%% canvas is usually the same size as the window, except for the
+%% row of buttons at the top of the windoww. The canvas is also
+%% displaced when the tree is smaller than the minimum window
+%% size.
+%%
+%%
+%% Window size - the size of the outer window. Note that
+%% provisions must be made for the button area at the top of the
+%% window, this is called WinAdj. this is the only item taht
+%% changes when the user manually resizes the window.
+%%
+%% Canvas size - The size of the canvas, should be equal to
+%% window size less the button area. Must be adjusted when the
+%% window has been manually resized. The canvas also has a
+%% scrollregion which must be maintained. Note that we could have
+%% used the canvas size as "leading" size, but this did not work
+%% since the canvas doesn't fill the complete window when the
+%% tree is smaller than the window.
+%%
+%% Tree size - The size of the tree. This may change whenever a
+%% new tree is delivered from the info routine.
+%%
+%% Dim - All these size adjustments are done in some dimension
+%% (width or height).
+%%
+%% Max, Min - The outmost window may not become larger than Max
+%% size or smaller than Min size when resized by the tree
+%% size. The user resizing is not restricted to these sizes.
+%%
+%% Scrollbars:
+%%
+%% Scrollbars are used whenever necessary, whenever the tree size
+%% is bigger than canvas size (in any dimension).
+%%
+%% Invariants:
+%%
+%% The three sizes are not varied at the same time. When the
+%% window is resized because of a new tree, then window and
+%% canvas must be updated. When the user has resized, then only
+%% the canvas must be changed (to fit in the window)
+%%
+%% Tree driven resize
+%%
+%% This occurs when the tree has been updated. The window may
+%% grow and shrink to fit the tree, but may not be smaller than
+%% Min and not bigger than Max (scrollbars will be used instead)
+%%
+
+tree_driven_resize(TWidth, THeight) ->
+ gs:config(win(), {configure, false}),
+ Width = TWidth+20,
+ Height = scaley(THeight+1),
+ put({width, tree}, Width),
+ put({height, tree}, Height),
+ adjust_win(width, Width),
+ adjust_win(height, Height),
+ fit_tree_to_win(width, Width),
+ fit_tree_to_win(height, Height),
+ check_scroll_region(Width, Height, gs:read(canvas(), scrollregion)),
+ gs:config(win(), {configure, true}),
+ ok.
+
+
+%% Will adjust the window size to the tree size (given the max and min
+%% restrictions.
+adjust_win(Dim, TreeSize) ->
+ case get({Dim, user_resize}) of
+ true -> ok;
+ _ ->
+ WinSize = gs:read(win(), Dim),%%get_dim(Dim, win()),
+ case get_wanted_winsize(Dim, TreeSize) + winadj(Dim) of
+ WinSize -> ok;
+ NewSize ->
+ %%set(Dim, win(), NewSize+winadj(Dim))
+ set_old_win_size(Dim, NewSize),
+ gs:config(win(), {Dim, NewSize})
+ end
+ end.
+
+get_wanted_winsize(Dim, Size) ->
+ Max = maxsize(Dim), Min = minsize(Dim),
+ if Size > Max -> Max;
+ Size < Min -> Min;
+ true -> Size
+ end.
+
+set_old_win_size(Dim, Size) -> put({Dim, winsize}, Size).
+old_win_size(Dim) -> get({Dim, winsize}).
+
+
+%%--------------------------------------------------------------------
+%%
+%% user_driven_resize
+%%
+%% This is when the user drags the window to some size. This is
+%% basically the same as a tree resize, only this time the window
+%% itself must not be fiddled with. When the window has been
+%% resized this way then normal tree driven resize is not allow
+%% to alter the size in that dimension. User overrides.
+%%
+user_driven_resize(W, H) ->
+ gs:config(win(), {configure, false}),
+ check_user_resize(width, W),
+ check_user_resize(height, H),
+ check_scroll_region(get({width, tree}), get({height, tree}),
+ gs:read(canvas(), scrollregion)),
+ gs:config(win(), {configure, true}).
+
+check_user_resize(Dim, Size) ->
+ case old_win_size(Dim) of
+ Size -> false;
+ _ ->
+ put({Dim, user_resize}, true),
+ set_old_win_size(Dim, Size),
+ fit_tree_to_win(Dim, get({Dim, tree}))
+ end.
+
+
+
+%%--------------------------------------------------------------------
+%%
+%% General resizing routines
+%%
+%% fit_tree_to_win - Will fit the canvas into a pre-sized window in
+%% one dimension.
+%%
+fit_tree_to_win(Dim, TreeSize) ->
+ Size = gs:read(win(), Dim) - winadj(Dim),
+ set_canvas_offset(Dim, Size, TreeSize),
+ set_button_width(Dim, Size),
+ if TreeSize > Size ->
+ gs:config(canvas(), {trans_dim2vh(Dim), trans_dim2enable(Dim)});
+ TreeSize < Size ->
+ gs:config(canvas(), {trans_dim2vh(Dim), false});
+ true ->
+ gs:config(canvas(), {trans_dim2vh(Dim), false})
+ end.
+
+
+%%------------------------------
+%% Set the canvas width and displacement in x.
+set_canvas_offset(height, Size, _) ->
+ gs:config(canvas(), {height, Size});
+set_canvas_offset(width, Size, Size) ->
+ gs:config(canvas(), [{x, 0}, {width, Size}]);
+set_canvas_offset(width, Size, TreeSize) when Size<TreeSize ->
+ gs:config(canvas(), [{x, 0}, {width, Size}]);
+set_canvas_offset(width, Size, TreeSize) when Size>TreeSize->
+ Val = trunc((Size-TreeSize)/2),
+ gs:config(canvas(), [{x, Val}, {width, Size-Val}]).
+
+%%------------------------------
+%% Set the button area width
+set_button_width(height,_) -> ok;
+set_button_width(width, W) ->
+ gs:config(bcanvas(), [{width, W}]),
+ gs:config(bframe(), [{width, W}]),
+ gs:config(bline(), [{coords, nice_line_coords(W, ?BUTTAREA_H)}]).
+
+
+%%------------------------------
+%% Update the scrollregion size if needed.
+check_scroll_region(W, H, {_, _, W, H}) -> ok;
+check_scroll_region(W, H, {_, _, _, _}) ->
+ gs:config(canvas(), {scrollregion, {0, 0, W, H}}).
+
+
+%% Window sizing primitives
+winadj(width) -> 0;
+winadj(height) -> ?BUTTAREA_H.
+maxsize(width) -> ?MAXWIDTH;
+maxsize(height) -> ?MAXHEIGHT.
+minsize(width) -> ?MINWIDTH;
+minsize(height) -> ?MINHEIGHT.
+
+
+
+trans_dim2vh(width) -> hscroll;
+trans_dim2vh(height) -> vscroll.
+trans_dim2enable(width) -> bottom;
+trans_dim2enable(height) -> right.
+
+
+
+
+
+%%------------------------------------------------------------
+%% Global Window info
+
+winroot() -> get(winroot).
+win() -> get(win).
+canvas() -> get(canvas).
+bframe() -> get(bframe).
+bcanvas() -> get(bcanvas).
+bline() -> get(bline).
+set_winroot(X) -> put(winroot, X).
+set_win(X) -> put(win, X).
+set_canvas(X) -> put(canvas, X).
+set_bframe(X) -> put(bframe, X).
+set_bcanvas(X) -> put(bcanvas, X).
+set_bline(X) -> put(bline, X).
+
+sup_col() -> ?darkkhaki.
+%%work_col() -> ?orange.
+bg() -> ?palegoldenrod.
+line_col() -> ?peachpuff4. %% saddlebrown.darkgoldenrod
+f_line_col() -> ?royalblue. %% saddlebrown.darkgoldenrod
+sec_line_col() -> ?red.
+win_col() -> bg(). %%darkolivegreen.
+
+sel_col() -> ?darkgrey.
+de_sel_col() -> ?lightgrey.
+set_selected(Id)-> put(selected, Id).
+selected() -> get(selected).
+
+scaley(Y) -> 55*Y.
+radius() -> 10.
+
+destroy(undefined) -> true;
+destroy(L) when is_list(L) -> lists:foreach(fun(X) -> destroy(X) end , L);
+destroy(Win) -> gs:destroy(Win).
+
diff --git a/lib/appmon/src/appmon_dg.erl b/lib/appmon/src/appmon_dg.erl
new file mode 100644
index 0000000000..f53defa946
--- /dev/null
+++ b/lib/appmon/src/appmon_dg.erl
@@ -0,0 +1,205 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%------------------------------------------------------------
+%%
+%% Digraph handling for process view GUI. Feeble attempt at data
+%% separation. Provides functional interface to the data structures
+%% vdata and edata, v for vertex and e for edge.
+%%
+%%------------------------------------------------------------
+-module(appmon_dg).
+
+-include("appmon_dg.hrl").
+
+%% Exports for vertices
+-export([get/3, get/2, set/4, av/3, add/4, del/2, visited/3]).
+
+%% Exports for edges
+-export([eget/2, eget/3, eset/4, eadd/4, edel/2, ae/3]).
+
+%% Exports for convenience
+-export([print_dg/1]).
+
+
+%%------------------------------------------------------------
+
+
+eget(all, DG) ->
+ digraph:edges(DG).
+
+eget(data, DG, E) ->
+ case digraph:edge(DG, E) of
+ {_, _V1, _V2, Data} -> Data;
+ _Other -> false
+ end;
+eget(edge, DG, {V1, V2}) ->
+ case digraph:edge(DG, {V1, V2}) of
+ {E, W1, W2, ED} -> {E, W1, W2, ED};
+ Other ->
+ case digraph:edge(DG, {V2, V1}) of
+ {E, W1, W2, ED} -> {E, W1, W2, ED};
+ Other -> false
+ end
+ end;
+
+%% Weight in edge name
+eget(edge, DG, {V1, V2, Weight}) ->
+ case digraph:edge(DG, {V1, V2, Weight}) of
+ {E, W1, W2, ED} -> {E, W1, W2, ED};
+ _Other -> false
+ end;
+eget(in, DG, V) ->
+ efilter(digraph:in_edges(DG, V)).
+
+efilter(Es) ->
+ lists:filter(fun({_V1, _V2, primary}) -> true;
+ (_E) -> false end,
+ Es).
+
+eset(ref, DG, E, Ref) ->
+ {E2, _V1, _V2, D} = eget(edge, DG, E),
+ update_e(DG, E2, D#edata{ref=Ref});
+eset(line, DG, E, Line) ->
+ {E2, _V1, _V2, D} = eget(edge, DG, E),
+ update_e(DG, E2, D#edata{line=Line}).
+
+edel(DG, E) ->
+ digraph:del_edge(DG, E).
+
+eadd(DG, E, D, Ref) ->
+ case eget(edge, DG, E) of
+ {_, _, _, ED} when is_record(ED, edata), ED#edata.ref == Ref ->
+ known;
+ {_, _, _, ED} when is_record(ED, edata), ED#edata.ref /= Ref ->
+ update_e(DG, E, ED#edata{ref=Ref}),
+ updated;
+ _Other ->
+ ae(DG, E, D)
+ end.
+
+ae(DG, {V1, V2, Weight}, D) ->
+ digraph:add_edge(DG, {V1, V2, Weight}, V1, V2, D).
+
+update_e(DG, {V1, V2, Weight}, D) ->
+ digraph:del_edge(DG, {V1, V2, Weight}),
+ digraph:add_edge(DG, {V1, V2, Weight}, V1, V2, D).
+
+%% Filter destination vertex from a list of edges
+vfilter(Vs) ->
+ lists:map(fun({_V1, V2, _Weight}) -> V2;
+ ({_V1, V2}) -> V2
+ end, Vs).
+
+get(all, DG) ->
+ digraph:vertices(DG).
+
+get(data, DG, {V1, V2}) ->
+ case digraph:edge(DG, {V1, V2}) of
+ {_,_,_,Data} -> Data;
+ _Other -> false
+ end;
+get(data, DG, V) ->
+ case digraph:vertex(DG, V) of
+ {_,Data} -> Data;
+ _Other -> false
+ end;
+
+%% Return all children of vertex V (those which V has edges to)
+get(out, DG, V) ->
+ vfilter(efilter(digraph:out_edges(DG, V)));
+get(in, DG, V) ->
+ digraph:in_neighbours(DG, V);
+get(edges, DG, V) ->
+ digraph:edges(DG, V);
+get(w, DG, V) ->
+ Data = get(data, DG, V),
+ Data#vdata.width;
+get(x, DG, V) ->
+ Data = get(data, DG, V),
+ Data#vdata.x.
+
+set(type, DG, V, Type) ->
+ D = get(data, DG, V),
+ av(DG, V, D#vdata{type=Type});
+
+set(ref, DG, V, Ref) ->
+ D = get(data, DG, V),
+ av(DG, V, D#vdata{ref=Ref});
+
+set(y, DG, V, Y) ->
+ D = get(data, DG, V),
+ av(DG, V, D#vdata{y=Y});
+
+set(data, DG, V, D) when is_record(D, vdata)->
+ av(DG, V, D);
+
+set(x, DG, V, X) ->
+ D = get(data, DG, V),
+ if D#vdata.x /= X ->
+ av(DG, V, D#vdata{x=X});
+ true -> true
+ end.
+
+visited(DG, {V1, V2}, Ref) -> % for edge
+ D = eget(data, DG, {V1, V2}),
+ if is_record(D, edata), D#edata.ref == Ref -> true;
+ true -> false
+ end;
+visited(DG, V, Ref) ->
+ D = get(data, DG, V),
+ if is_record(D, vdata), D#vdata.ref == Ref -> true;
+ true -> false
+ end.
+
+add(DG, V, D, Ref) ->
+ case get(data, DG, V) of
+ D2 when is_record(D2, vdata), D2#vdata.ref==Ref ->
+ io:format("Ooops in ~p:add vertex~n", [?MODULE]),
+ known;
+ D2 when is_record(D2, vdata) ->
+ %%io:format("~p touch vertex ~p~n", [self(), V]),
+ set(ref, DG, V, Ref),
+ set(type, DG, V, D#vdata.type),
+ save_coords(DG, V),
+ updated;
+ _Other ->
+ av(DG, V, D), added
+ end.
+
+save_coords(DG, V) ->
+ D = get(data, DG, V),
+ D2 = D#vdata{origx=D#vdata.x, origy=D#vdata.y},
+ av(DG, V, D2).
+
+del(DG, V) ->
+ digraph:del_vertex(DG, V).
+
+
+av(DG, V, D) ->
+ digraph:add_vertex(DG, V, D).
+
+print_dg(DG) ->
+ io:format("Vertices:~n", []),
+ lists:foreach(fun(V) -> io:format(" ~p ~p~n",
+ [V, get(data, DG, V)]) end,
+ get(all, DG)),
+ io:format("Edges:~n", []),
+ lists:foreach(fun(V) -> io:format(" ~p ~p~n",
+ [V, eget(edge, DG, V)]) end,
+ eget(all, DG)),
+ true.
diff --git a/lib/appmon/src/appmon_dg.hrl b/lib/appmon/src/appmon_dg.hrl
new file mode 100644
index 0000000000..c3485cf1fd
--- /dev/null
+++ b/lib/appmon/src/appmon_dg.hrl
@@ -0,0 +1,45 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+
+
+
+%%
+%% The dg package record definitions
+%%
+%% This is the declarations of the datastructures used for the
+%% application monitoring software. All fields are reserved for the
+%% implementation except those stated otherwise
+%%
+
+-record(vdata, {ref, %
+ type, %
+ x, %
+ origx=-1, %
+ y, %
+ origy=-1, %
+ txt="", % Set by user
+ width=0, % Set by user
+ sym_obj=undefined, %
+ txt_obj}). %
+
+
+
+-record(edata, {ref, %
+ line, %
+ weight}). %
+
diff --git a/lib/appmon/src/appmon_info.erl b/lib/appmon/src/appmon_info.erl
new file mode 100644
index 0000000000..4e36d3a13f
--- /dev/null
+++ b/lib/appmon/src/appmon_info.erl
@@ -0,0 +1,963 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%----------------------------------------------------------------------
+%%
+%% Information centre for appmon. Must be present on each node
+%% monitored.
+%%
+%%
+%% A worklist is maintained that contain all current work that
+%% should be performed at each timeout. Each entry in the
+%% worklist describes where the result shall be sent and a list
+%% of options relevant for that particular task
+%%
+%%
+%% Maintenance Note:
+%%
+%% This module is supposed to be updated by any who would like to
+%% subscribe for information. The idea is that several tools
+%% could use this module for their core information gathering
+%% services.
+%%
+%% The module is based on the notion of tasks. Each task should
+%% have a nice public interface function which should handle task
+%% administration. Tasks are identified by a "key" consisting of
+%% three items, the requesting pid, the name of the task and the
+%% task auxillary parameter. The requesting pid is the pid of the
+%% callee (in the appmon case it can be the node window for
+%% instance), the task name is whatever name the task is given
+%% (in the appmon case it can be app, app_ctrl or load). The task
+%% name can be seen as the type of the task. The task auxillary
+%% parameter is an all purpose parameter that have a different
+%% meaning for each type of task so in appmon the Aux for app
+%% contains the root pid of the monitored application and in
+%% app_ctrl it contains the node name (just to distinguish from
+%% the other app_ctrl tasks, if any) while the Aux parameter is
+%% not used for the load task at all.
+%%
+%% Each task also carries a list of options for
+%% customisation. The options valid for a task is completely
+%% internal to that task type except for the timeout option which
+%% is used by do_work to determine the interval at which to
+%% perform the task. The timeout option may also have the value
+%% at_most_once that indicates that the task should not be done
+%% more than once, in appmon the remote port (or process) info
+%% (pinfo) task is such a task that is only done once for each
+%% call. Note that the only way to change or update options is to
+%% call the public interface function for the task, this will
+%% merge the old options with the new ones and also force the
+%% task to be executed.
+%%
+%% All tasks are managed by the do_work function. The basic
+%% functionality being that the result of the task is compared to
+%% the previous result and a delivery is sent to the callee if
+%% they differ. Most tasks are then done on a regular basis using
+%% the timer module for a delay.
+%%
+%% There are a limited number of places where the module need to
+%% be updated when new services are added, they are all marked
+%% with "Maintenance Note", and here is a quick guide:
+%%
+%% First implement the task. Put the functions in this module
+%% among the other task implementations. Currently all task
+%% implementations should be put in this file to make it simple
+%% to monitor a node, this module should be the only one
+%% needed. Then add your implementation to the do_work2 function
+%% and finally add a public interface function among the other
+%% public interface functions. Voila.
+%%
+%%
+%%
+%% Future ideas:
+%%
+%% Appmon should maybe be enhanced to show all processes on a
+%% node. First put all processes in an ets P, then pick those
+%% that belong to applications (the normal way), then try to find
+%% those processes that are roots in process link trees and pick
+%% them. The final step would be to do something with those
+%% processes that are left.
+%%
+%%----------------------------------------------------------------------
+-module(appmon_info).
+-behaviour(gen_server).
+
+%% Exported functions
+-export([start_link/3, app/4, pinfo/4, load/4, app_ctrl/4]).
+
+%% For internal use (RPC call)
+-export([start_link2/3]).
+
+%% For debugging
+-export([status/0]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+
+%%----------------------------------------------------------------------
+%% The records
+%%
+%% state is used for keeping track of all tasks.
+%%
+%% db is the database used in the app task.
+%%
+
+-record(state, {starter, opts=[], work=[], clients=[]}).
+-record(db, {q, p, links, links2}).
+
+
+%%----------------------------------------------------------------------
+%% Macros
+%%
+
+-define(MK_KEY(CMD, AUX, FROM, OPTS), {CMD, AUX, FROM}).
+-define(MK_DOIT(KEY), {do_it, KEY}).
+-define(ifthen(P,S), if P -> S; true -> ok end).
+
+
+%%----------------------------------------------------------------------
+%% Public interface
+%%
+%% The Aux parameter is an auxillary parameter that can be used
+%% freely by the requesting process, it is included in the work
+%% task key. appmon uses it for storing the node name when
+%% requesting load and app_ctrl tasks, and appmon_a uses it for
+%% storing application name when requesting app task.
+%%
+%% Maintenance Note: Put new tasks at the end, please.
+%%
+
+
+%% Do not use gen_server:start_link because we do not want the
+%% appmon_info to die when initiating process dies unless special
+%% conditions apply.
+%% Uhu, we don't??? Made a fix so that this proces DOES indeed die
+%% if it's starter dies. /Gunilla
+start_link(Node, Client, Opts) ->
+ rpc:call(Node, ?MODULE, start_link2, [self(), Client, Opts]).
+start_link2(Starter, Client, Opts) ->
+ Name = {local, ?MODULE},
+ Args = {Starter, Opts, Client},
+ case gen_server:start(Name, ?MODULE, Args, []) of
+ {ok, Pid} ->
+ {ok, Pid};
+ {error, {already_started, Pid}} ->
+ register_client(Pid, Client),
+ {ok, Pid}
+ end.
+
+
+%% app_ctrl
+%%
+%% Monitors which applications exist on a node
+%%
+app_ctrl(Serv, Aux, OnOff, Opts) ->
+ gen_server:cast(Serv, {self(), app_ctrl, Aux, OnOff, Opts}).
+
+
+%% load
+%%
+%% Monitors load on a node
+%%
+load(Serv, Aux, OnOff, Opts) ->
+ gen_server:cast(Serv, {self(), load, Aux, OnOff, Opts}).
+
+
+%% app
+%%
+%% Monitors one application given by name (this ends up in a
+%% process tree
+%%
+app(Serv, AppName, OnOff, Opts) ->
+ gen_server:cast(Serv, {self(), app, AppName, OnOff, Opts}).
+
+%% pinfo
+%%
+%% Process or Port info
+%%
+pinfo(Serv, Pid, OnOff, Opt) ->
+ gen_server:cast(Serv, {self(), pinfo, Pid, OnOff, Opt}).
+
+%% register_client
+%%
+%% Registers a client (someone subscribing for information)
+%%
+
+register_client(Serv, P) ->
+ link(Serv),
+ gen_server:call(Serv, {register_client, P}).
+
+%% status
+%%
+%% Status of appmon_info
+%%
+
+status() ->
+ gen_server:cast(?MODULE, status).
+
+%%----------------------------------------------------------------------
+%%
+%% Gen server administration
+%%
+%%----------------------------------------------------------------------
+
+init({Starter, Opts, Pid}) ->
+ link(Pid),
+ process_flag(trap_exit, true),
+ WorkStore = ets:new(workstore, [set, public]),
+ {ok, #state{starter=Starter, opts=Opts, work=WorkStore,
+ clients=[Pid]}}.
+
+terminate(_Reason, State) ->
+ ets:delete(State#state.work),
+ ok.
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+
+%%----------------------------------------------------------------------
+%%
+%% Gen server calls
+%%
+%%----------------------------------------------------------------------
+
+handle_call({register_client, Pid}, _From, State) ->
+ NewState = case lists:member(Pid, State#state.clients) of
+ true -> State;
+ _ -> State#state{clients=[Pid | State#state.clients]}
+ end,
+ {reply, ok, NewState};
+handle_call(_Other, _From, State) ->
+ {reply, ok, State}.
+
+%%----------------------------------------------------------------------
+%%
+%% Gen server casts
+%%
+%%----------------------------------------------------------------------
+
+%% Cmd = app_ctrl | load | app | pinfo
+handle_cast({From, Cmd, Aux, OnOff, Opts}, State) ->
+ NewState = update_worklist(Cmd, Aux, From, OnOff, Opts, State),
+ {noreply, NewState};
+handle_cast(status, State) ->
+ print_state(State),
+ {noreply, State};
+handle_cast(_Other, State) ->
+ {noreply, State}.
+
+
+%%----------------------------------------------------------------------
+%%
+%% Gen server info's
+%%
+%%----------------------------------------------------------------------
+
+handle_info({do_it, Key}, State) ->
+ ok = do_work(Key, State),
+ {noreply, State};
+
+handle_info({'EXIT', Pid, Reason}, State) ->
+ case State#state.starter of
+ Pid ->
+ {stop, Reason, State};
+ _Other ->
+ Work = State#state.work,
+ del_work(ets:match(Work, {{'$1','$2',Pid}, '_', '_', '_'}),
+ Pid, Work),
+ case lists:delete(Pid, State#state.clients) of
+ [] -> case get_opt(stay_resident, State#state.opts) of
+ true -> {noreply, State#state{clients=[]}};
+ _ -> {stop, normal, State}
+ end;
+ NewClients -> {noreply, State#state{clients=NewClients}}
+ end
+ end;
+handle_info(_Other, State) ->
+ {noreply, State}.
+
+
+%%----------------------------------------------------------------------
+%%
+%% Doing actual work
+%%
+%%----------------------------------------------------------------------
+
+do_work(Key, State) ->
+ WorkStore = State#state.work,
+ {Cmd, Aux, From, _OldRef, Old, Opts} = retrieve(WorkStore, Key),
+ {ok, Result} = do_work2(Cmd, Aux, From, Old, Opts),
+ if
+ Result==Old -> ok;
+ true ->
+ From ! {delivery, self(), Cmd, Aux, Result}
+ end,
+ case get_opt(timeout, Opts) of
+ at_most_once ->
+ del_task(Key, WorkStore);
+ T when is_integer(T) ->
+ {ok, Ref} = timer:send_after(T, ?MK_DOIT(Key)),
+ store(WorkStore, Key, Ref, Result, Opts)
+ end,
+ ok.
+
+
+%%----------------------------------------------------------------------
+%%
+%% Name: do_work2
+%%
+%% Maintenance Note: Add a clause here for each new task.
+%%
+do_work2(load, _Aux, _From, Old, Opts) ->
+ calc_load(Old, Opts);
+do_work2(app_ctrl, _Aux, _From, _Old, _Opts) ->
+ calc_app_on_node();
+do_work2(app, Aux, _From, _Old, Opts) ->
+ calc_app_tree(Aux, Opts);
+do_work2(pinfo, Aux, _From, _Old, _Opts) ->
+ calc_pinfo(pinfo, Aux);
+do_work2(Cmd, Aux, _From, _Old, _Opts) ->
+ {Cmd, Aux}.
+
+
+retrieve(Tab, Key) ->
+ case ets:lookup(Tab, Key) of
+ [{{Cmd, Aux, From}, Ref, Old, Opts}] ->
+ {Cmd, Aux, From, Ref, Old, Opts};
+ _Other ->
+ false
+ end.
+
+store(Tab, Key, Ref, Old, Opts) ->
+ ets:insert(Tab, {Key, Ref, Old, Opts}),
+ Key.
+
+
+%%----------------------------------------------------------------------
+%%
+%% WorkStore handling
+%%
+%%----------------------------------------------------------------------
+
+update_worklist(Cmd, Aux, From, true, Opts, State) ->
+ add_task(Cmd, Aux, From, Opts, State),
+ State;
+update_worklist(Cmd, Aux, From, _Other, _Opts, State) ->
+ del_task(Cmd, Aux, From, State#state.work),
+ State.
+
+%% First check if a task like this already exists and if so cancel its
+%% timer and make really sure that no stray do it command will come
+%% later. Then start a new timer for the task and store it i
+%% WorkStorage
+add_task(Cmd, Aux, From, Opts, State) ->
+ WorkStore = State#state.work,
+ Key = ?MK_KEY(Cmd, Aux, From, Opts),
+ OldOpts = del_task(Key, WorkStore),
+ store(WorkStore, Key, nil, nil, ins_opts(Opts, OldOpts)),
+ catch do_work(Key, State),
+ ok.
+
+%% Delete a list of tasks belonging to a pid
+del_work([[Cmd, Aux] | Ws], Pid, Work) ->
+ del_task(Cmd, Aux, Pid, Work),
+ del_work(Ws, Pid, Work);
+del_work([], _Pid, _Work) -> ok.
+
+%% Must return old options or empty list
+del_task(Cmd, Aux, From, WorkStore) ->
+ del_task(?MK_KEY(Cmd, Aux, From, []), WorkStore).
+del_task(Key, WorkStore) ->
+ OldStuff = retrieve(WorkStore, Key),
+ ets:delete(WorkStore, Key),
+ case OldStuff of
+ {_Cmd, _Aux, _From, Ref, _Old, Opts} ->
+ if
+ Ref /= nil ->
+ timer:cancel(Ref),
+ receive
+ {do_it, Key} ->
+ Opts
+ after 10 ->
+ Opts
+ end;
+ true -> Opts
+ end;
+ _ ->
+ []
+ end.
+
+
+%%
+%% Maintenance Note:
+%%
+%% Add new task implementations somewhere here below.
+%%
+
+
+%%----------------------------------------------------------------------
+%%**********************************************************************
+%%
+%%
+%% BEGIN OF calc_app_tree
+%%
+%% App tree is the process tree shown in the application window
+%%
+%% The top (root) pid is found by calling
+%% application_controller:get_master(AppName) and this is done in
+%% calc_app_on_node (before the call to calc_app_tree).
+%%
+%% We are going to add processes to the P ets and we are doing it
+%% in a two step process. First all prospect processes are put on
+%% the queue Q. Then we examine the front of Q and add this
+%% process to P if it's not already in P. Then all children of
+%% the process is put on the queue Q and the process is repeated.
+%%
+%% We also maintain two link ets'es, one for primary links and
+%% one for secondary links. These databases are updated at the
+%% same time as the queue is updated with children.
+%%
+%%**********************************************************************
+%%----------------------------------------------------------------------
+
+
+calc_app_tree(Name, Opts) ->
+ Mode = get_opt(info_type, Opts),
+ case application_controller:get_master(Name) of
+ Pid when is_pid(Pid) ->
+ DB = new_db(Mode, Pid),
+ GL = groupl(Pid),
+ R = case catch do_find_proc(Mode, DB, GL, find_avoid()) of
+ {ok, DB2} ->
+ {ok, {format(Pid),
+ format(ets:tab2list(DB2#db.p)),
+ format(ets:tab2list(DB2#db.links)),
+ format(ets:tab2list(DB2#db.links2))}};
+ {error, Reason} ->
+ {error, Reason};
+ Other ->
+ {error, Other}
+ end,
+ ets:delete(DB#db.p),
+ ets:delete(DB#db.links),
+ ets:delete(DB#db.links2),
+ R;
+ _ ->
+ {ok, {[], [], [], []}}
+ end.
+
+get_pid(P) when is_pid(P) -> P;
+get_pid(P) when is_port(P) -> P;
+get_pid(X) when is_tuple(X) -> element(2, X).
+
+
+%----------------------------------------------------------------------
+%%---------------------------------------------------------------------
+%% Handling process trees of processses that are linked to each other
+
+do_find_proc(Mode, DB, GL, Avoid) ->
+ case get_next(DB) of
+ {{value, V}, DB2} ->
+ do_find_proc2(V, Mode, DB2, GL, Avoid);
+ {empty, DB2} ->
+ {ok, DB2}
+ end.
+
+do_find_proc2(X, Mode, DB, GL, Avoid) when is_port(X) ->
+ %% There used to be a broken attempt here to handle ports,
+ %% but the rest of appmon can't handle ports, so now we
+ %% explicitly ignore ports.
+ do_find_proc(Mode, DB, GL, Avoid);
+do_find_proc2(X, Mode, DB, GL, Avoid) ->
+ Xpid = get_pid(X),
+ DB2 = case is_proc(DB, Xpid) of
+ false ->
+ add_proc(DB, Xpid),
+ C1 = find_children(X, Mode),
+ add_children(C1, Xpid, DB, GL, Avoid, Mode);
+ _ ->
+ DB
+ end,
+ do_find_proc(Mode, DB2, GL, Avoid).
+
+
+%% Find children finds the children of a process. The method varies
+%% with the selected mode (sup or link) and there are also some
+%% processes that must be treated differently, notably the application
+%% master.
+%%
+find_children(X, sup) when is_pid(X) ->
+ %% This is the first (root) process of a supervision tree and it
+ %% better be a supervisor, we are smoked otherwise
+ supervisor:which_children(X);
+find_children(X, link) when is_pid(X), node(X) /= node() ->
+ [];
+find_children(X, link) when is_pid(X) ->
+ case process_info(X, links) of
+ {links, Links} ->
+ lists:reverse(Links); % OTP-4082
+ _ -> []
+ end;
+find_children({master, X}, sup) ->
+ case application_master:get_child(X) of
+ {Pid, _Name} when is_pid(Pid) -> [Pid];
+ Pid when is_pid(Pid) -> [Pid]
+ end;
+find_children({_, _X, worker, _}, sup) -> [];
+find_children({_, X, supervisor, _}, sup) ->
+ lists:filter(fun(Thing) ->
+ Pid = get_pid(Thing),
+ if
+ is_pid(Pid) -> true;
+ true -> false
+ end
+ end,
+ supervisor:which_children(X)).
+
+
+%% Add links to primary (L1) or secondary (L2) sets and return an
+%% updated queue. A link is considered secondary if its endpoint is in
+%% the queue of un-visited but known processes.
+add_children(CList, Paren, DB, _GL, _Avoid, sup) ->
+ lists:foldr(fun(C, DB2) ->
+ case get_pid(C) of
+ P when is_pid(P) ->
+ add_prim(C, Paren, DB2);
+ _ -> DB2 end end,
+ DB, CList);
+
+add_children(CList, Paren, DB, GL, Avoid, _Mode) ->
+ lists:foldr(fun(C, DB2) ->
+ maybe_add_child(C, Paren, DB2, GL, Avoid)
+ end, DB, CList).
+
+%% Check if the child is already in P
+maybe_add_child(C, Paren, DB, GL, Avoid) ->
+ case is_proc(DB, C) of
+ false ->
+ maybe_add_child_node(C, Paren, DB, GL, Avoid);
+ _ -> DB % In P: no action
+ end.
+
+%% Check if process on this node
+maybe_add_child_node(C, Paren, DB, GL, Avoid) ->
+ if
+ node(C) /= node() ->
+ add_foreign(C, Paren, DB);
+ true ->
+ maybe_add_child_avoid(C, Paren, DB, GL, Avoid)
+ end.
+
+%% Check if child is on the avoid list
+maybe_add_child_avoid(C, Paren, DB, GL, Avoid) ->
+ case lists:member(C, Avoid) of
+ true -> DB;
+ false ->
+ maybe_add_child_port(C, Paren, DB, GL)
+ end.
+
+%% Check if it is a port, then it is added
+maybe_add_child_port(C, Paren, DB, GL) ->
+ if
+ is_port(C) ->
+ add_prim(C, Paren, DB);
+ true ->
+ maybe_add_child_sasl(C, Paren, DB, GL)
+ end.
+
+%% Use SASL stuff if present
+maybe_add_child_sasl(C, Paren, DB, GL) ->
+ case check_sasl_ancestor(Paren, C) of
+ yes -> % Primary
+ add_prim(C, Paren, DB);
+ no -> % Secondary
+ add_sec(C, Paren, DB);
+ dont_know ->
+ maybe_add_child_gl(C, Paren, DB, GL)
+ end.
+
+%% Check group leader
+maybe_add_child_gl(C, Paren, DB, GL) ->
+ case cmp_groupl(GL, groupl(C)) of
+ true -> maybe_add_child_sec(C, Paren, DB);
+ _ -> DB
+ end.
+
+%% Check if the link should be a secondary one. Note that this part is
+%% pretty much a guess.
+maybe_add_child_sec(C, Paren, DB) ->
+ case is_in_queue(DB, C) of
+ true -> % Yes, secondary
+ add_sec(C, Paren, DB);
+ _ -> % Primary link
+ add_prim(C, Paren, DB)
+ end.
+
+check_sasl_ancestor(Paren, C) ->
+ case lists:keysearch('$ancestors', 1,
+ element(2,process_info(C, dictionary))) of
+ {value, {_, L}} when is_list(L) ->
+ H = if
+ is_atom(hd(L)) -> whereis(hd(L));
+ true -> hd(L)
+ end,
+ if
+ H == Paren -> yes;
+ true -> no
+ end;
+ _ -> dont_know
+ end.
+
+
+%----------------------------------------------------------------------
+%%---------------------------------------------------------------------
+%% Primitives for the database DB of all links, processes and the
+%% queue of not visited yet processes.
+
+-define(add_link(C, Paren, L), ets:insert(L, {Paren, C})).
+
+new_db(Mode, Pid) ->
+ P = ets:new(processes, [set, public]),
+ L1 = ets:new(links, [bag, public]),
+ L2 = ets:new(extralinks, [bag, public]),
+ Q = if
+ Mode =:= sup -> queue:in({master, Pid}, queue:new());
+ true -> queue:in(Pid, queue:new())
+ end,
+ #db{q=Q, p=P, links=L1, links2=L2}.
+
+get_next(DB) ->
+ {X, Q} = queue:out(DB#db.q),
+ {X, DB#db{q=Q}}.
+add_proc(DB, P) ->
+ ets:insert(DB#db.p, {P}).
+add_prim(C, Paren, DB) ->
+ ?add_link(get_pid(C), Paren, DB#db.links),
+ DB#db{q=queue:in(C, DB#db.q)}.
+add_foreign(C, Paren, DB) ->
+ ?add_link(C, Paren, DB#db.links2),
+ DB#db{q=queue:in(C, DB#db.q)}.
+add_sec(C, Paren, DB) ->
+ ?add_link(C, Paren, DB#db.links2),
+ DB.
+
+is_proc(#db{p=Tab}, P) ->
+ ets:member(Tab, P).
+
+is_in_queue(#db{q=Q}, P) ->
+ queue:member(P, Q).
+
+%% Group leader handling. No processes or Links to processes must be
+%% added when group leaders differ. Note that catch all is needed
+%% because net_sup is undefined when not networked but still present
+%% in the kernel_sup child list. Blahh, didn't like that.
+groupl(P) ->
+ case process_info(P, group_leader) of
+ {group_leader, GL} -> GL;
+ _Other -> nil
+ end.
+
+cmp_groupl(_GL1, nil) -> true;
+cmp_groupl(GL1, GL1) -> true;
+cmp_groupl(_, _) -> false.
+
+
+%% Do some intelligent guessing as to cut in the tree
+find_avoid() ->
+ lists:foldr(fun(X, Accu) ->
+ case whereis(X) of
+ P when is_pid(P) ->
+ [P|Accu];
+ _ -> Accu end end,
+ [undefined],
+ [application_controller, init, error_logger, gs,
+ node_serv, appmon, appmon_a, appmon_info]).
+
+
+
+%%----------------------------------------------------------------------
+%%
+%% Formats the output strings
+%%
+%%----------------------------------------------------------------------
+format([{P} | Fs]) -> % Process or port
+ [{P, format(P)} | format(Fs)];
+format([{P1, P2} | Fs]) -> % Link
+ [{format(P1), format(P2)} | format(Fs)];
+format([]) -> [];
+format(P) when is_pid(P), node(P) /= node() ->
+ pid_to_list(P) ++ " " ++ atom_to_list(node(P));
+format(P) when is_pid(P) ->
+ case process_info(P, registered_name) of
+ {registered_name, Name} -> atom_to_list(Name);
+ _ -> pid_to_list(P)
+ end;
+format(P) when is_port(P) ->
+ "port " ++ integer_to_list(element(2, erlang:port_info(P, id)));
+format(X) ->
+ io:format("What: ~p~n", [X]),
+ "???".
+
+
+%%----------------------------------------------------------------------
+%%**********************************************************************
+%%
+%%
+%% END OF calc_app_tree
+%%
+%%
+%%**********************************************************************
+%%----------------------------------------------------------------------
+
+
+
+
+%%----------------------------------------------------------------------
+%%**********************************************************************
+%%
+%%
+%% BEGIN OF calc_app_on_node
+%%
+%%
+%%**********************************************************************
+%%----------------------------------------------------------------------
+
+%% Finds all applications on a node
+calc_app_on_node() ->
+ NewApps = reality_check(application:which_applications()),
+ {ok, NewApps}.
+
+
+reality_check([E|Es]) ->
+ N = element(1, E),
+ case catch application_controller:get_master(N) of
+ P when is_pid(P) -> [{P, N, E} | reality_check(Es)];
+ _ -> reality_check(Es)
+ end;
+reality_check([]) -> [].
+
+
+
+
+%%----------------------------------------------------------------------
+%%**********************************************************************
+%%
+%%
+%% END OF calc_app_on_node
+%%
+%%
+%%**********************************************************************
+%%----------------------------------------------------------------------
+
+
+
+%%----------------------------------------------------------------------
+%%**********************************************************************
+%%
+%%
+%% BEGIN OF calc_load
+%%
+%%
+%%**********************************************************************
+%%----------------------------------------------------------------------
+
+calc_load(Old, Opts) ->
+ L = load(Opts),
+ case get_opt(load_average, Opts) of
+ true ->
+ case Old of
+ {_, L} -> {ok, {L, L}};
+ {_, O2} when abs(L-O2) < 3 -> {ok, {O2, L}};
+ {_, O2} -> {ok, {O2, trunc((2*L+O2)/3)}};
+ _ -> {ok, {0, L}}
+ end;
+ _ ->
+ case Old of
+ {_, O2} -> {ok, {O2, L}};
+ _ -> {ok, {0, L}}
+ end
+ end.
+
+
+load(Opts) ->
+ Q = get_sample(queue),
+
+ case get_opt(load_method, Opts) of
+ time ->
+ Td = get_sample(runtime),
+ Tot = get_sample(tot_time),
+
+ case get_opt(load_scale, Opts) of
+ linear ->
+ min(trunc(load_range()*(Td/Tot+Q/6)),
+ load_range());
+ prog ->
+ min(trunc(load_range()*prog(Td/Tot+Q/6)),
+ load_range())
+ end;
+ queue ->
+ case get_opt(load_scale, Opts) of
+ linear ->
+ min(trunc(load_range()*Q/6), load_range());
+ prog ->
+ min(trunc(load_range()*prog(Q/6)), load_range())
+ end
+ end.
+
+min(X,Y) when X<Y -> X;
+min(_,Y)->Y.
+
+
+%%
+%% T shall be within 0 and 0.9 for this to work correctly
+prog(T) ->
+ math:sqrt(abs(T)/0.9).
+
+
+get_sample(queue) -> statistics(run_queue);
+get_sample(runtime) -> {Rt,Rd} = statistics(runtime),
+ delta(runtime, Rt, Rd);
+get_sample(tot_time) -> {Rt,Rd} = statistics(wall_clock),
+ delta(tot_time, Rt, Rd).
+
+
+%% Keeps track of differences between calls
+%% Needed because somebody else might have called
+%% statistics/1.
+%%
+%% Note that due to wrap-arounds, we use a cheating
+%% delta which is correct unless somebody else
+%% uses statistics/1
+delta(KeyWord, Val, CheatDelta) ->
+ RetVal = case get(KeyWord) of
+ undefined ->
+ Val;
+ Other ->
+ if
+ Other > Val ->
+ CheatDelta;
+ true ->
+ Val-Other
+ end
+ end,
+ put(KeyWord, Val),
+ RetVal.
+
+
+load_range() -> 16.
+
+
+
+%%----------------------------------------------------------------------
+%%**********************************************************************
+%%
+%%
+%% END OF calc_load
+%%
+%%
+%%**********************************************************************
+%%----------------------------------------------------------------------
+
+
+%%----------------------------------------------------------------------
+%%**********************************************************************
+%%
+%%
+%% BEGIN OF calc_pinfo
+%%
+%%
+%%**********************************************************************
+%%----------------------------------------------------------------------
+
+calc_pinfo(pinfo, Pid) when is_pid(Pid) ->
+ Info = process_info(Pid),
+ {ok, io_lib:format("Node: ~p, Process: ~p~n~p~n~n",
+ [node(), Pid, Info])};
+calc_pinfo(pinfo, Pid) when is_port(Pid) ->
+ Info = lists:map(fun(Key) ->erlang:port_info(Pid, Key) end,
+ [id, name, connected, links, input, output]),
+
+ {ok, io_lib:format("Node: ~p, Port: ~p~n~p~n~n",
+ [node(), element(2, erlang:port_info(Pid, id)),
+ Info])};
+calc_pinfo(pinfo, _Pid) ->
+ {ok, ""}.
+
+
+%%----------------------------------------------------------------------
+%%**********************************************************************
+%%
+%%
+%% END OF calc_pinfo
+%%
+%%
+%%**********************************************************************
+%%----------------------------------------------------------------------
+
+
+
+%%----------------------------------------------------------------------
+%%
+%% Print the State
+%%
+%% -record(state, {opts=[], work=[], clients=[]}).
+%%
+%%----------------------------------------------------------------------
+print_state(State) ->
+ io:format("Status:~n Opts: ~p~n"
+ "Clients: ~p~n WorkStore:~n",
+ [State#state.opts, State#state.clients]),
+ print_work(ets:tab2list(State#state.work)).
+
+print_work([W|Ws]) ->
+ io:format(" ~p~n", [W]), print_work(Ws);
+print_work([]) -> ok.
+
+
+%%----------------------------------------------------------------------
+%%
+%% Option handling
+%%
+%%----------------------------------------------------------------------
+
+%% The only options ever set by a user is info_type, timeout,
+%% load_scale and load_method.
+get_opt(Name, Opts) ->
+ case lists:keysearch(Name, 1, Opts) of
+ {value, Val} -> element(2, Val);
+ false -> default(Name)
+ end.
+
+%% not all options have default values
+default(info_type) -> link;
+default(load_average) -> true;
+default(load_method) -> time;
+default(load_scale) -> prog;
+default(stay_resident) -> false;
+default(timeout) -> 2000.
+
+ins_opts([Opt | Opts], Opts2) ->
+ ins_opts(Opts, ins_opt(Opt, Opts2));
+ins_opts([], Opts2) -> Opts2.
+
+ins_opt({Opt, Val}, [{Opt, _} | Os]) -> [{Opt, Val} | Os];
+ins_opt(Opt, [Opt2 | Os]) -> [Opt2 | ins_opt(Opt, Os)];
+ins_opt(Opt, []) -> [Opt].
diff --git a/lib/appmon/src/appmon_lb.erl b/lib/appmon/src/appmon_lb.erl
new file mode 100644
index 0000000000..4e433f37c5
--- /dev/null
+++ b/lib/appmon/src/appmon_lb.erl
@@ -0,0 +1,689 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-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%
+
+%%% Due to the fact that the application buttons in the appmon window
+%%% gets too small to read when the number of applications increases,
+%%% this listbox window has been created.
+%%% Because of the limitations of GS a listbox was chosen to keep
+%%% the nodes and applications. When it's possible to scroll a frame I
+%%% think one should put in scrollbars in the appmon main window.
+%%% The listbox solution is too slow with lots of applications.
+%%%
+%%% In the listbox the nodes are shown with their applications beneith.
+%%% By double clicking on an application name, or a single click and
+%%% then pressing the load button, its application window is started.
+
+-module(appmon_lb).
+
+-export ([
+ start/1,
+ stop/1,
+ add_node/2,
+ remove_node/2,
+ add_apps/3,
+ remove_app/3,
+ open_win/2,
+ update_status/3
+ ]).
+
+-export ([init/1]).
+
+-define (LB_W, 200). % List box width
+-define (LB_H, 400). % List box height
+-define (BUTT_W, 100).
+-define (WIN_W, ?LB_W + ?BUTT_W + 25). % Window width
+-define (WIN_H, ?LB_H + 20). % Window height
+
+
+%%% #node{}
+%%%
+%%% The record 'node' contains the name of the node, its status and
+%%% the applications running on that node.
+%%%
+%%% node == atom ()
+%%% status == alive || dead
+%%% apps == [#app{}]
+%%%
+
+-record (node, {node, %% Name of the node
+ status = alive,
+ apps = []}).
+
+%%% #app{}
+%%%
+%%% The record 'app' contains the name of the application and its pid
+%%%
+%%% app == atom ()
+%%% pid == pid ()
+%%%
+
+-record (app, {app,
+ pid}).
+
+
+%%% #win{}
+%%%
+%%% The record 'win' contains the pid of the listbox window,
+%%% its x and y position, its width and height.
+%%%
+%%% pid == win_closed || pid ()
+%%% x == integer ()
+%%% y == integer ()
+%%% width == integer ()
+%%% height == integer ()
+%%%
+
+-record (win, {pid = win_closed,
+ x = 50,
+ y = 50,
+ width = ?WIN_W,
+ height = ?WIN_H}).
+
+
+
+%%% Every function in the interface is called with the pid
+%%% of this recieve loop, called 'LbPid'.
+%%%
+
+
+%%% start /1
+%%%
+%%% start returns the pid of the spawned receive loop or
+%%% it will call exit/2 after a timeout.
+%%%
+%%% Pre:
+%%% CallingPid == pid ()
+%%%
+%%% Def:
+%%% pid () || exit/2
+%%%
+
+start (CallingPid) ->
+ PidInit = spawn (?MODULE, init, [CallingPid]),
+
+ %% Wait for a initialization completion message from
+ %% the spawned process before returning its Pid.
+
+ receive
+ {initialization_complete, PidInit} ->
+ PidInit
+
+ %% (Conditional) Failure to start within the time limit
+ %% will result in termination (Timeout may be infinite).
+
+ after
+ 60000 ->
+ exit (PidInit, kill),
+ exit ({startup_timeout, ?MODULE})
+ end.
+
+
+
+%%% stop /1
+%%%
+%%% stop exits the receive loop
+%%%
+%%% Post:
+%%% exiting the receive loop
+%%%
+
+stop (LbPid) ->
+ call (LbPid, stop).
+
+
+
+%%% add_node /2
+%%%
+%%% add_node adds the given node to the DB list.
+%%%
+%%% Pre:
+%%% Node == atom ()
+%%%
+%%% Post:
+%%% Node is added to the DB list
+%%%
+
+add_node (LbPid, Node) ->
+ call (LbPid, {add_node, Node}).
+
+
+
+%%% remove_node /2
+%%%
+%%% remove_node removes the given node from the DB list.
+%%%
+%%% Pre:
+%%% Node == atom ()
+%%%
+%%% Post:
+%%% Node is removed from the DB list
+%%%
+
+remove_node (LbPid, Node) ->
+ call (LbPid, {remove_node, Node}).
+
+
+
+%%% add_apps /3
+%%%
+%%% add_apps add the given applications to the given
+%%% node in the DB list.
+%%%
+%%% Pre:
+%%% Apps == [App]
+%%% App == {Name, Pid}
+%%% Name == atom ()
+%%% Pid == pid ()
+%%% Node == atom ()
+%%%
+%%% Post:
+%%% Node#node{apps = Apps}
+%%%
+
+add_apps (LbPid, Apps, Node) ->
+ call (LbPid, {add_apps, Apps, Node}).
+
+
+
+%%% remove_app /3
+%%%
+%%% remove_app remove the given application from the
+%%% given node in the DB list.
+%%%
+%%% Pre:
+%%% App == atom ()
+%%% Node == atom ()
+%%%
+%%% Def:
+%%% Node#node{apps = OldApps - App}
+%%%
+
+remove_app (LbPid, App, Node) ->
+ call (LbPid, {remove_app, App, Node}).
+
+
+
+%%% open_win /3
+%%%
+%%% open_win opens the listbox window with the given nodes
+%%% and their applications.
+%%%
+%%% Pre:
+%%% Nodes_apps == [{Node, Status, Apps}]
+%%% Node == atom ()
+%%% Status == alive || dead
+%%% Apps == [App]
+%%% App == {AppName, AppPid}
+%%% AppName == atom ()
+%%% AppPid == pid ()
+%%%
+%%% Post:
+%%% Window with listbox
+%%%
+
+open_win (LbPid, Nodes_apps) ->
+ call (LbPid, {open_win, Nodes_apps}).
+
+
+
+%%% update_status /3
+%%%
+%%% update_status changes the status for the given node.
+%%%
+%%% Pre:
+%%% Node == atom ()
+%%% Status == alive || dead
+%%%
+%%% Def:
+%%% Node#node{status = Status}
+%%%
+
+update_status (LbPid, Node, Status) ->
+ call (LbPid, {update_status, Node, Status}).
+
+
+
+%%% call /2
+%%%
+%%% call sends the given action to the listbox receive loop.
+%%%
+%%% Pre:
+%%% Action == atom () || tuple ()
+%%%
+
+call (LbPid, Action) ->
+ LbPid ! Action.
+
+
+
+%%% init /1
+%%%
+
+init (CallingPid) ->
+ CallingPid ! {initialization_complete, self ()},
+ loop (#win{}, []).
+
+
+
+%%% loop /2
+%%%
+%%% loop is the recive loop for the listbox window process.
+%%%
+%%% Pre:
+%%% Win == #win{}
+%%% Data == [#node{}]
+%%%
+
+loop (Win, Data) ->
+ receive
+ {add_node, Node} ->
+ NewData = add_node_1 (Node, Data),
+ update (NewData, Win#win.pid),
+ loop (Win, NewData);
+
+ {remove_node, Node} ->
+ NewData = dead_node (Node, Data),
+ update (NewData, Win#win.pid),
+ loop (Win, NewData);
+
+ {add_apps, Apps, Node} ->
+ NewData = add_apps_1 (Apps, Node, Data),
+ update (NewData, Win#win.pid),
+ loop (Win, NewData);
+
+ {remove_app, App, Node} ->
+ NewData = remove_app_1 (App, Node, Data),
+ update (NewData, Win#win.pid),
+ loop (Win, NewData);
+
+ {open_win, Nodes_apps} ->
+ NewData = parse_data ([], Nodes_apps),
+ NewWin = Win#win{pid = init_win ({Win#win.x, Win#win.y})},
+ update (NewData, NewWin#win.pid),
+ loop (NewWin, NewData);
+
+ {update_status, Node, Status} ->
+ NewData = update_status_1 (Node, Status, Data),
+ update (NewData, Win#win.pid),
+ loop (Win, NewData);
+
+ stop ->
+ true;
+
+
+ {gs, _Id, destroy, _D, _Arg} ->
+ bye;
+
+ {gs, _Id, configure, _D, [W, H | _]} ->
+ NewWin = configure (Win#win.pid, W, H),
+ loop (NewWin, Data);
+
+ {gs, lb, doubleclick, _, _Txt} ->
+ load_app (gs:read (lb, selection), Data),
+ loop (Win, Data);
+
+ {gs, lb, click, _, _Txt} ->
+ loop (Win, Data);
+
+ {gs, close, click, _D, _Arg} ->
+ case Win#win.pid of
+ win_closed ->
+ true;
+
+ _opened ->
+ gs:destroy (Win#win.pid)
+ end,
+ loop (#win{}, Data);
+
+ {gs, load, click, _D, _Txt} ->
+ load_app (gs:read (lb, selection), Data),
+ loop (Win, Data);
+
+ {gs, clear, click, _D, _Txt} ->
+ gs:config (lb, {selection, clear}),
+ loop (Win, Data);
+
+
+ _ ->
+ loop (Win, Data)
+ end.
+
+
+
+%%% init_win /1
+%%%
+
+init_win ({X, Y}) ->
+ GS = gs:start (),
+
+ Win = gs:window (win, GS, [{x, X},
+ {y, Y},
+ {width, ?WIN_W},
+ {height, ?WIN_H},
+ {title,"Appmon: nodes and applications"},
+ {configure, true}]),
+
+ gs:listbox (lb, Win, [{x, 5},
+ {y, 10},
+ {width, ?LB_W},
+ {height, ?LB_H},
+ {vscroll, right},
+ {hscroll, bottom},
+ {selectmode, single},
+ {click, true},
+ {doubleclick, true}]),
+
+ gs:button (load, Win, [{x, ?WIN_W - ?BUTT_W - 10},
+ {y, ?WIN_H - 120},
+ {width, ?BUTT_W},
+ {label, {text, "Load"}}]),
+
+ gs:button (clear, Win, [{x, ?WIN_W - ?BUTT_W - 10},
+ {y, ?WIN_H - 80},
+ {width, ?BUTT_W},
+ {label, {text, "Clear"}}]),
+
+ gs:button (close, Win, [{x, ?WIN_W - ?BUTT_W - 10},
+ {y, ?WIN_H - 40},
+ {width, ?BUTT_W},
+ {label, {text, "Close"}}]),
+
+ gs:config (Win, {map, true}),
+ Win.
+
+
+
+%%% add_node_1 /2
+%%%
+%%% add_node adds the given node in the given window
+%%% with its appications in a listbox.
+%%%
+
+add_node_1 (Node, []) ->
+ [new_node (Node)];
+
+add_node_1 (Node, [H | T]) ->
+ T1 = lists:keysort (#node.node, [new_node (Node) | T]),
+ [H | T1].
+
+
+
+%%% dead_node /2
+%%%
+%%% dead_node returns a list with the given node's
+%%% status changed to dead.
+%%%
+
+dead_node (Node, Data) ->
+ case lists:keysearch (Node, #node.node, Data) of
+ {value, Node_rec} ->
+ L = Node_rec#node.apps,
+ lists:keyreplace (Node, #node.node,
+ Data, new_node (Node, dead, L));
+
+ _false ->
+ Data
+ end.
+
+
+
+
+
+%%% add_apps_1 /3
+%%%
+%%% add_apps_1 returns a list with the given application
+%%% into the old list inserted.
+%%%
+
+add_apps_1 (Apps, Node, Data) ->
+ case lists:keysearch (Node, #node.node, Data) of
+ {value, _Node_rec} ->
+ NewApps = parse_apps (Apps, []),
+ lists:keyreplace (Node, #node.node,
+ Data, new_node (Node, NewApps));
+
+ _false ->
+ Data
+ end.
+
+
+
+%%% remove_app_1 /3
+%%%
+%%% remove_app_1 returns a list with the given application
+%%% removed from the old list.
+%%%
+
+remove_app_1 (App, Node, Data) ->
+
+ case lists:keysearch (Node, #node.node, Data) of
+ {value, Node_rec} ->
+ L = Node_rec#node.apps,
+ L2 = lists:keydelete (App, #app.app, L),
+ lists:keyreplace(Node, #node.node, Data, new_node(Node,L2));
+
+ _false ->
+ Data
+ end.
+
+
+
+%%% configure /3
+%%%
+%%% configure returns a win record after the window has been
+%%% configured.
+%%%
+
+configure (WPid, W, H) ->
+ X = gs:read (WPid, x),
+ Y = gs:read (WPid, y),
+
+ gs:config (lb, [{width, W - ?BUTT_W - 25}, {height, H - 20}]),
+ gs:config (load, [{x, W - ?BUTT_W - 10}, {y, H - 120}]),
+ gs:config (clear, [{x, W - ?BUTT_W - 10}, {y, H - 80}]),
+ gs:config (close, [{x, W - ?BUTT_W - 10}, {y, H - 40}]),
+
+ #win{pid = WPid, x = X, y = Y, width = W, height = H}.
+
+
+
+
+
+%%% load_app /2
+%%%
+%%% load_app opens the application window by calling
+%%% the appmon_a module.
+%%%
+
+load_app ([], _Data) -> %% no application chosen
+ ok;
+
+load_app ([Index], Data) ->
+ App = gs:read (lb, {get, Index}),
+
+ case string:substr (App, 1, 3) of
+ " " ->
+ AppName = list_to_atom (string:substr (App, 4)),
+
+ case get_node (AppName, Index, Data) of
+ no_node ->
+ ok;
+
+ NodeName ->
+ appmon_a:start (NodeName, AppName)
+ end;
+
+ _ ->
+ ok
+ end.
+
+
+
+%%% update_status_1 /3
+%%%
+%%% update_status_1 returns a list with the given
+%%% node's status updated.
+%%%
+
+update_status_1 (Node, Status, Data) ->
+ case lists:keysearch (Node, #node.node, Data) of
+ {value, Node_rec} ->
+ lists:keyreplace (Node,
+ #node.node,
+ Data,
+ new_node(Node,Status,Node_rec#node.apps));
+
+ _not_found ->
+ Data
+ end.
+
+
+
+%%% update /2
+%%%
+%%% update updates the listbox with new data.
+%%%
+
+update (_Data, win_closed) ->
+ true;
+
+update (Data, _Win) ->
+ gs:config (lb, clear),
+ lb_print (Data).
+
+
+
+%%% lb_print /1
+%%%
+%%% lb_print prints the list into the listbox.
+%%%
+
+lb_print ([]) ->
+ ok;
+
+lb_print ([#node{node = Node, status = Status, apps = Apps} | T]) ->
+ Str = io_lib:format ("~p (~p)", [Node, Status]),
+ gs:config (lb, {add, Str}),
+
+ case Status of
+ alive ->
+ lb_print_apps (Apps);
+
+ _dead ->
+ gs:config (lb, {add, ""}),
+ ok
+ end,
+
+ lb_print (T).
+
+
+
+%%% lb_print_apps /1
+%%%
+%%% lb_print_apps prints the applications into the listbox.
+%%%
+
+lb_print_apps ([]) ->
+ ok;
+
+lb_print_apps ([#app{app = App} | T]) ->
+ Str = io_lib:format (" ~p", [App]),
+ gs:config (lb, {add, Str}),
+ lb_print_apps (T).
+
+
+
+%%% new_node /1, 2, 3
+%%%
+%%% new_node returna a new node record constructed
+%%% with the given data
+%%%
+
+new_node (Node) ->
+ #node{node = Node}.
+
+new_node (Node, Apps) ->
+ #node{node = Node, apps = Apps}.
+
+new_node (Node, Status, Apps) ->
+ #node{node = Node, status = Status, apps = Apps}.
+
+
+
+%%% new_app /2
+%%%
+%%% new_app returns a new application record
+%%% constructed with the given data.
+%%%
+
+new_app (App, Pid) ->
+ #app{app = App, pid = Pid}.
+
+
+
+%%% parse_apps /2
+%%%
+%%% parse_apps returns a list of application records.
+%%%
+
+parse_apps ([], [H | T]) ->
+ [H | lists:keysort (#app.app, T)];
+
+parse_apps ([App | T], L) ->
+ Pid = element (1, App),
+ Name = element (2, App),
+ parse_apps (T, [new_app (Name, Pid) | L]).
+
+
+
+%%% get_node /3
+%%%
+%%% get_node returns the node from the given list
+%%% or else no_node if it doesn't exists.
+%%%
+
+get_node (_App, _Index, []) ->
+ no_node;
+
+get_node (App, Index, [Node | T]) ->
+ Length = length (Node#node.apps) + 1,
+
+ case Length < Index of
+ true ->
+ get_node (App, Index - Length, T);
+
+ false ->
+ Node#node.node
+ end.
+
+
+
+%%% parse_data /2
+%%%
+%%% parse_data returns a list with node records.
+%%%
+
+parse_data (Data, []) ->
+ Data;
+
+parse_data (Data, [{Node, Status, Apps} | T]) ->
+ Apps_1 = parse_apps (Apps, []),
+ parse_data ([new_node (Node, Status, Apps_1) | Data], T).
+
+
+
diff --git a/lib/appmon/src/appmon_place.erl b/lib/appmon/src/appmon_place.erl
new file mode 100644
index 0000000000..5a6ae6aa48
--- /dev/null
+++ b/lib/appmon/src/appmon_place.erl
@@ -0,0 +1,194 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%------------------------------------------------------------
+%%
+%% Places a Digraph in a tree-like manner. The vertices in the digraph
+%% is updated with x and y positions. The operation is not atomic. The
+%% digraph may be cyclic but edges must then have been labeled primary
+%% or secondary and the set of primary links must make up a non-cyclic
+%% graph (a tree).
+%%
+%%
+%% IMPLEMENTATION DETAIL
+%% ---------------------
+%%
+%% The placement algorithm is straightforward, place the
+%% nodes in the vertical plane (y-plane) and then place
+%% nodes in the horisontal plane (x-plane).
+%%
+%% First all nodes are placed in the y (vertical) plane
+%% by a standard traversing of the tree. We then place
+%% the tree in the x (horisontal) plane. Each node is
+%% placed in the middle of its children as far to the
+%% left as possible, preferably at the left margin. Two
+%% things can make a node not be placed at the left
+%% margin and that is the case when a previous node has
+%% been placed at the same vertical level as the node we
+%% are trying to place (thus forcing a placement further
+%% to the right), and the second case is when the middle
+%% of the subtree of the node is not at the left margin
+%% (which it only is when the subtree is empty). The
+%% algorithm obviously depends on keeping track of the
+%% rightmost positions at all depths, and this
+%% information is also usefull when calculating the width
+%% of the tree.
+%%
+%%
+%%
+%%------------------------------------------------------------
+
+
+
+-module(appmon_place).
+
+-export([place/2]).
+
+-include("appmon_dg.hrl").
+
+
+-import(lists, [foreach/2, foldl/3]).
+
+
+place(DG, Root) ->
+ case appmon_dg:get(data, DG, Root) of
+ false -> [0];
+ _Other ->
+ placey(DG, Root, 1),
+ placex(DG, Root, [])
+ end.
+
+
+%%------------------------------------------------------------
+%%
+%%
+%% Placing a graph in y plane
+%% --------------------------
+%%
+%% Place nodes in the graph in the y plane rather stupidly
+%%
+
+placey(DG, V, Y) ->
+ appmon_dg:set(y, DG, V, Y),
+ Y1 = Y+1,
+ foreach(fun(C) -> placey(DG, C, Y1) end, appmon_dg:get(out, DG, V)).
+
+
+
+
+%%------------------------------------------------------------
+%%
+%%
+%% Place a tree in the x plane
+%% ---------------------------
+%%
+%% Place nodes in the tree in the x plane. The goal of the x
+%% placement is to place all nodes as far to the left as possible
+%% while maintaining a nice tree shape.
+%%
+%% To place a node we must first place its children, the
+%% intention is to place the current node in the middle and above
+%% its children. The calc_mid function will place the node in the
+%% middle of its children. If the node should be placed further
+%% to the right than the middle of its children, then its
+%% children are moved DeltaX positions to be balanced under the
+%% node. Thus at the end the node and its children form a nice
+%% looking tree.
+%%
+%% The function also maintains the 'rightmost x on each level'
+%% list LastX by putting its own position on top of the list
+%%
+%%
+
+placex(DG, V, LastX) ->
+ Ch = appmon_dg:get(out, DG, V),
+ ChLX = foldl(fun(C, Accu) -> placex(DG, C, Accu) end,
+ tll(LastX),
+ Ch),
+
+ Width = appmon_dg:get(w, DG, V),
+ MyX = calc_mid(DG, Width, Ch),
+ DeltaX = calc_delta(MyX, hdd(LastX)+spacex()),
+
+ appmon_dg:set(x, DG, V, MyX),
+ move(DG, V, [MyX+Width | ChLX], DeltaX).
+
+
+%%------------------------------------------------------------
+%%
+%%
+%% Move a subtree DeltaX positions to the right
+%% --------------------------------------------
+%%
+%% Used when moving children to balance under an already placed
+%% parent. Note that the correct LastX depends on the ordering of
+%% the children which must be the same as when the children were
+%% first placed. It must be ensured that hdd(NewLastX) is the
+%% same as hdd(NewLastX)+DeltaX. If the order of children is
+%% preserved then so is hdd(LastX). Another solution would be to
+%% set hdd(LastX) from the parent
+%%
+%% Note the two base clauses, one for the no-children case and
+%% one optimisation clause (unneccessary perhaps) for DeltaX==0
+%%
+
+move(_DG, _L, LastX, 0) -> LastX;
+move(DG, V, LastX, DeltaX) -> move2(DG, V, LastX, DeltaX).
+
+move2(DG, V, LastX, DeltaX) ->
+ NewX = appmon_dg:get(x, DG, V)+DeltaX,
+ appmon_dg:set(x, DG, V, NewX),
+ ChLX = foldl(fun(C, LX) -> move2(DG, C, LX, DeltaX) end,
+ tll(LastX),
+ appmon_dg:get(out, DG, V)),
+ [max(NewX+appmon_dg:get(w, DG, V), hdd(LastX)) | ChLX].
+
+max(A, B) when A>B -> A;
+max(_, B) -> B.
+
+%%------------------------------------------------------------
+%%
+%%
+%% Calculate the middle position of the children
+%% ---------------------------------------------
+%%
+%% Calculates the mid x position for a list of children. This
+%% position is later compared to the position dictated by LastX
+%% in calc_delta.
+
+calc_mid(_DG, _Width, []) -> 0;
+calc_mid(DG, Width, ChList) ->
+ LeftMostX = appmon_dg:get(x, DG, hd(ChList)),
+ Z2 = lists:last(ChList),
+ RightMostX = appmon_dg:get(x, DG, Z2)+appmon_dg:get(w, DG, Z2),
+ trunc((LeftMostX+RightMostX)/2)-trunc(Width/2).
+
+calc_delta(Mid, Right) ->
+ if Right>Mid -> Right-Mid;
+ true -> 0
+ end.
+
+
+
+%% Special head and tail
+%% Handles empty list in a non-standard way
+tll([]) -> [];
+tll([_|T]) -> T.
+hdd([]) -> 0;
+hdd([H|_]) -> H.
+
+spacex() -> 20. % Should be macro??
diff --git a/lib/appmon/src/appmon_txt.erl b/lib/appmon/src/appmon_txt.erl
new file mode 100644
index 0000000000..4e1785c53f
--- /dev/null
+++ b/lib/appmon/src/appmon_txt.erl
@@ -0,0 +1,302 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%------------------------------------------------------------
+%%
+%% Simple text viewer
+%%
+%%------------------------------------------------------------
+
+-module(appmon_txt).
+-export([start/0, start/1, print/1, fprint/1]).
+
+%% gen_server stuff
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2]).
+
+-define(LOADTXT, "Load file").
+-define(SAVETXT, "Save file").
+-define(SAVEASTXT, "Save as").
+-define(CLOSETXT, "Close").
+-define(HELPTXT, "Help").
+
+%%------------------------------------------------------------
+%%
+%% start/0 starts an open text viewer that can be filled with
+%% whatever.
+%%
+%%------------------------------------------------------------
+start() ->
+ start([]).
+
+%%------------------------------------------------------------
+%%
+%% start(ListOfOptions) starts an open text viewer with options
+%%
+%% Options can be
+%% {file, FileName} - insert contents of file
+%% locked - the text cannot be edited
+%% {text, Text} - insert text at startup
+%%
+%%------------------------------------------------------------
+start(Opts) ->
+ gen_server:start_link({local, ?MODULE}, ?MODULE, Opts, []).
+
+%% Start a text viewer if necessary
+print(Txt) ->
+ catch start(),
+ gen_server:call(?MODULE, {add_txt, Txt}),
+ ok.
+
+fprint(File) ->
+ catch start(),
+ gen_server:call(?MODULE, {add_file, File}),
+ ok.
+
+
+%%------------------------------------------------------------
+%% gen server admin
+
+init(Opts) ->
+ process_flag(trap_exit, true),
+ setup_base_win(),
+ default_status(),
+ setup_opts(Opts),
+ {ok, []}.
+
+terminate(_Reason, _State) ->
+ ok.
+
+%%------------------------------------------------------------
+%% gen server stuff
+handle_call({add_txt, Txt}, _From, State) ->
+ do_insert_text(Txt),
+ scroll_to_last_line(),
+ {reply, ok, State};
+handle_call({add_file, FileName}, _From, State) ->
+ do_load_file(FileName),
+ {reply, ok, State};
+handle_call(_Request, _From, State) ->
+ {reply, ok, State}.
+handle_cast(_Request, State) ->
+ {noreply, State}.
+handle_info({gs, _, click, _, [?CLOSETXT|_]}, State) ->
+ {stop, normal, State};
+handle_info({gs, _, click, _, [?LOADTXT|_]}, State) ->
+ ui_load(),
+ {noreply, State};
+handle_info({gs, _, configure, _, [W, H | _]}, State) ->
+ resize(W, H),
+ {noreply, State};
+
+handle_info({gs, _, destroy, _, _}, State) ->
+ {stop, normal, State};
+handle_info(Request, State) ->
+ io:format("~p got info: ~p~n", [self(), Request]),
+ print_status("Not implemented"),
+ {noreply, State}.
+
+
+%%------------------------------------------------------------
+%% Handle options
+
+setup_opts([Opt|Opts]) ->
+ setup_opt(Opt),
+ setup_opts(Opts);
+setup_opts([]) -> ok.
+
+setup_opt(Opt) ->
+ case Opt of
+ {file, FileName} ->
+ do_load_file(FileName);
+ locked ->
+ do_lock();
+ {text, Text} ->
+ do_insert_text(Text);
+ _Other ->
+ ok
+ end.
+
+do_load_file(FileName) ->
+ case catch i_load_file(FileName) of
+ ok ->
+ default_status();
+ _Other ->
+ print_status(lists:append(["File not found: ", FileName]))
+ end.
+
+i_load_file(FileName) ->
+ {ok, Bin} = file:read_file(FileName),
+ L = binary_to_list(Bin),
+ i_do_clear(),
+ do_insert_text(L),
+ ok.
+
+ui_load() ->
+ Title = "Load file",
+ Files = get_file_list(),
+ case catch ui_list_dialog(Title, "File: ", Files) of
+ {ok, FileName} ->
+ do_load_file(FileName);
+ _Other ->
+ print_status("Load cancelled")
+ end.
+
+get_file_list() ->
+ case file:list_dir(".") of
+ {ok, FileList} -> lists:sort(FileList);
+ _Other -> []
+ end.
+
+do_insert_text(Text) ->
+ gs:config(editor(), {insert, {'end', Text}}),
+ ok.
+
+%% Scrolls editor to show the last rows
+scroll_to_last_line() ->
+ H = gs:read(editor(), size),
+ R = gs:read(editor(), height),
+ TopRow = H-R/15,
+ if TopRow > 0 -> gs:config(editor(), {vscrollpos, TopRow});
+ true -> gs:config(editor(), {vscrollpos, 0})
+ end,
+ ok.
+
+do_lock() ->
+ gs:config(editor(), {enable, false}).
+
+i_do_clear() ->
+ gs:config(editor(), clear).
+
+%%------------------------------------------------------------
+%% Graphical stuff
+
+label_h() -> 20.
+menu_h() -> 29.
+
+setup_base_win() ->
+ H = 400, W=580,
+ LabelHeight=label_h(), MenuHeight=menu_h(),
+
+ F = gs:start([{kernel,true}]),
+ set_winroot(F),
+
+ Win = gs:create(window, F, [{width, W}, {height, H},
+ {title,"APPMON: Process Information"}]),
+
+ E = gs:create(editor, Win, [{x, 0}, {y, MenuHeight},
+ {width, W},
+ {height, H-MenuHeight-LabelHeight-1},
+ {vscroll, right}]),
+ set_editor(E),
+
+ L = gs:create(label, Win, [{x, 0}, {y, H-LabelHeight},
+ {height,LabelHeight }, {width, W},
+ {align, w}]),
+ set_status(L),
+ print_status("Loading"),
+
+ gs:config(Win, {map, true}),
+
+ MB = gs:create(menubar, Win, []),
+
+ FMB = gs:create(menubutton, MB, [{label, {text, "File"}}]),
+ FM = gs:create(menu, FMB, []),
+ gs:create(menuitem, FM, [{label, {text, ?CLOSETXT}}]),
+
+ gs:config(Win, {configure, true}),
+ ok.
+
+resize(W, H) ->
+ gs:config(editor(), [{width, W}, {height, H-label_h()-menu_h()}]),
+ gs:config(status(), [{y, H-label_h()}, {width, W}]),
+ ok.
+
+%%------------------------------------------------------------
+%% ui_list_dialog(
+%%
+%% Traditional dialog with a list box and a selection field that
+%% is updated from the list box.
+%%
+%% Returns {ok, String} if successful and something else if not
+%%
+%% Title - the name of the window
+%% LeadText - the lead text on the selection field
+%% List - a list of items that will be displayed in the list box
+%%
+%%------------------------------------------------------------
+
+ui_list_dialog(Title, LeadText, TxtList) ->
+ W = 200, H = 300,
+
+ Win = gs:create(window, winroot(), [{title, Title},
+ {width, W},{height, H}]),
+ Ok = gs:create(button, Win, [{x, 10}, {y,10},
+ {width, 50}, {height, 20},
+ {label, {text, "Ok"}}]),
+ Cn = gs:create(button, Win, [{x, 70}, {y,10},
+ {width, 50}, {height, 20},
+ {label, {text, "Cancel"}}]),
+
+ gs:create(label, Win, [{x, 10}, {y, 50},
+ {width, 60}, {height, 20},
+ {label, {text, LeadText}}]),
+ Box = gs:create(entry, Win, [{x, 10}, {y, 70},
+ {width, 160}, {height, 20},
+ {keypress, true}]),
+ List = gs:create(listbox, Win, [{x, 10}, {y, 100}, {width, 180},
+ {height, 190},
+ {items, TxtList}, {vscroll, right},
+ {hscroll, false}, {click, true},
+ {doubleclick, true},
+ {keypress, true}]),
+ gs:config(Win, {map, true}),
+
+ RetVal = ui_load_loop(Box, List, Ok, Cn),
+
+ gs:destroy(Win),
+
+ RetVal.
+
+ui_load_loop(Box, List, Ok, Cn) ->
+ receive
+ {gs, Box, keypress, _, ['Return'|_]} ->
+ {ok, gs:read(Box, text)};
+ {gs, Box, keypress, _, _} ->
+ ui_load_loop(Box, List, Ok, Cn);
+ {gs, Ok, click, _, _} ->
+ {ok, gs:read(Box, text)};
+ {gs, List, doubleclick, _, [_Idx, Txt|_]} ->
+ {ok, Txt};
+ {gs, List, click, _, [_Idx, Txt|_]} ->
+ gs:config(Box, {text, Txt}),
+ ui_load_loop(Box, List, Ok, Cn);
+ _Other ->
+ something_else
+ end.
+
+%% The status row at the bottom of the window
+set_status(Id) -> put(status_row, Id).
+status() -> get(status_row).
+print_status(Msg) -> gs:config(get(status_row), {label, {text, Msg}}).
+default_status() -> print_status("Done").
+
+set_editor(X) -> put(editor, X).
+editor() -> get(editor).
+
+winroot() -> get(winroot).
+set_winroot(X) -> put(winroot, X).
diff --git a/lib/appmon/src/appmon_web.erl b/lib/appmon/src/appmon_web.erl
new file mode 100644
index 0000000000..e8a8422a80
--- /dev/null
+++ b/lib/appmon/src/appmon_web.erl
@@ -0,0 +1,1037 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-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%
+%%
+
+%%%---------------------------------------------------------------------
+%%% File : webappmon.erl
+%%% Author : Martin G. <[email protected]>
+%%% Purpose : Frontend to the webbased version of appmon.
+%%% Created : 24 Apr 2001 by Martin G. <[email protected]>
+%%%---------------------------------------------------------------------
+
+-module(appmon_web).
+
+%% The functions that the user can call to interact with the genserver
+-export([init/1,handle_call/3,handle_cast/2,handle_info/2]).
+-export([terminate/2,code_change/3]).
+
+-export([node_info/2,application_info/2,application_env/2]).
+-export([proc_info/2,trace/2]).
+-export([start/0,stop/0,start_link/0]).
+
+%% Export the function that returns the configuration data needed by
+%% webtool
+-export([configData/0]).
+
+
+%% The following directive caters for (significantly) faster native
+%% code compilation of one function in this file by the HiPE compiler
+%% on register-poor architectures like the x86.
+-compile([{hipe,[{regalloc,graph_color}]}]).
+
+-behaviour(gen_server).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Start the genserver %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+start_link()->
+ gen_server:start_link({local,webappmon_server},appmon_web,[],[]).
+start()->
+ gen_server:start({local,webappmon_server},appmon_web,[],[]).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Stop the genserver %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+stop()->
+ gen_server:call(webappmon_server,stop,1000).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Get the page that shows the nodes and the apps on the sel node %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+node_info(Env,Input)->
+ gen_server:call(webappmon_server,{node_data,Env,Input}).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Get the application process tree %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+application_info(Env,Input)->
+ gen_server:call(webappmon_server,{app_data,Env,Input}).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Get the page that shows the data about the process %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+proc_info(Env,Input)->
+ gen_server:call(webappmon_server,{proc_data,Env,Input}).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Get the spec on the app %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+application_env(Env,Input)->
+ gen_server:call(webappmon_server,{app_env,Env,Input}).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Toggle the trace flag for the selected process %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+trace(Env,Input)->
+ gen_server:call(webappmon_server,{trace,Env,Input}).
+
+configData()->
+ {appmon,[{web_data,{"WebAppmon","/appmon/main_frame.html"}},
+ {alias,{"/appmon",code:priv_dir(appmon)}},
+ {alias,{erl_alias,"/erl",[appmon_web]}},
+ {start,{child,{backend,{process_info,start_link,[]},
+ permanent,100,worker,[process_info]}}},
+ {start,{child,{{local,webappmon_server},
+ {appmon_web,start_link,[]},
+ permanent,100,worker,[appmon_web]}}}
+ ]}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% %
+% Callback functions for the genserver %
+% %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+init(_Arg)->
+ {ok,[]}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Create the different pages %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+handle_call({node_data,_Env,Input},_From,State)->
+ {reply,app_and_node_sel_page(Input),State};
+
+handle_call({app_data,_Env,Input},_From,State)->
+ {reply,process_tree_page(Input),State};
+
+handle_call({proc_data,_Env,Input},_From,State)->
+ {reply,process_specifickation_page(Input),State};
+
+handle_call({app_env,_Env,Input},_From,State)->
+ {reply,application_specifickation_page(Input),State};
+
+handle_call({trace,_Env,Input},_From,State)->
+ {reply,toggle_trace(Input),State}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Shutdown the genserver %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+terminate(_,_State)->
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Callback function currently not used ... %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+handle_cast(_,State)->
+ {noreply,State}.
+
+handle_info(_,State)->
+ {noreply,State}.
+
+code_change(_OldVsn,State,_Extra)->
+ {ok,State}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Private functions to create the part of the sides that is common %%
+%% to all sides %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Create the Header for the page If we now the mimetype use that type%%
+%% otherwise use text %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+header() ->
+ header("text/html").
+header(MimeType) ->
+ "Content-type: " ++ MimeType ++ "\r\n\r\n".
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Create the Htmlheader sett the title of the side to nothing if %%
+%% we dont know the name of the side %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+html_header()->
+ html_header("").
+
+html_header(Part) ->
+ "<HTML BGCOLOR=\"#FFFFFF\">\n" ++
+ "<HEAD>\n" ++
+ "<TITLE>Appmon " ++ Part ++ "</TITLE>\n" ++
+ "</HEAD>\n".
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Close the Html tag and if neccessay add some clean upp %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+html_end()->
+ "</HTML>".
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% The functions that creates the whole pages by collecting %%
+%% the necessary data %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Returns the page where the user see's which nodes and apps that %%
+%% are availible for monitoring %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+app_and_node_sel_page(Input)->
+ [header(),
+ html_header(),
+ node_body(httpd:parse_query(Input)),
+ html_end()].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Returns the process tree for the application whose name is %%
+%% the first value in the Inputs key/value list %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+process_tree_page(Input)->
+ [header(),
+ html_header(),
+ application_javascript(httpd:parse_query(Input)),
+ application_body(httpd:parse_query(Input)),
+ html_end()].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Send trace on or off to the process thats pid is the third arg of %%
+%% the inputs key/val list. Then it returns the process tree for the %%
+%% the application that is the first key/val pair of input %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+toggle_trace(Input)->
+ send_trace(httpd:parse_query(Input)),
+ [header(),
+ html_header(),
+ application_javascript(httpd:parse_query(Input)),
+ application_body(httpd:parse_query(Input)),
+ html_end()].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Creates the page that shows all information about the process that %%
+%% that is the first arg of th input key/val pairs %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+process_specifickation_page(Input)->
+ [header(),
+ html_header(),
+ process_body(httpd:parse_query(Input)),
+ html_end()].
+
+application_specifickation_page(Input)->
+ [header(),
+ html_header(),
+ application_env_body(httpd:parse_query(Input)),
+ html_end()].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The Private functions that do the job %%
+%% To build the the page that shows the applications %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Build the body of the side that shows the node name and %%
+%% the application list %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+node_body([{"node",Node}|_Rest])->
+ case process_info:is_node(Node) of
+ {true,Controlled_node,Name} ->
+ "<BODY BGCOLOR=\"#FFFFFF\">" ++
+ node_selections_javascripts() ++
+ node_selection(Controlled_node) ++
+ node_title() ++
+ application_tree(Controlled_node,Name) ++
+ "</BODY>";
+
+ {false,Server_node,Name} ->
+ "<BODY BGCOLOR=\"#FFFFFF\">" ++
+ node_selections_javascripts() ++
+ node_selection(Server_node) ++
+ node_title() ++
+ application_tree(Server_node,Name) ++
+ "</BODY>"
+ end;
+
+node_body(_Whatever)->
+ node_body([{atom_to_list(node),atom_to_list(node())}]).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Returns the javascript that sets a new node to monitor %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+node_selections_javascripts()->
+ "<SCRIPT>
+ function node_selected()
+ {
+ parent.frames.base_frames.location=\"../../appmon/start_info.html\"
+ window.location =\"./node_info?node=\" + " ++
+ "document.node_selection.nodes[document.node_selection.nodes.selectedIndex].value;
+ }
+ </SCRIPT>".
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Insert the html code that shows the combobox where the user can %%
+%% select another node to monitor %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+node_selection(Node)->
+ " <FORM ACTION=\"./node_info\" NAME=node_selection>\n
+ <TABLE WIDTH=\"100%\" BORDER=\"0\">\n
+ <TR><TD ALIGN=\"center\">\n
+ <SELECT NAME=nodes onChange=\"node_selected()\">\n" ++
+ print_nodes(order_nodes(Node,process_info:get_nodes())) ++
+ "</SELECT>\n
+ </TD></TR>\n
+ </TABLE>\n
+ </FORM>".
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Add the node we are working with in the beginning of the list and %%
+%% remove it from other places so its always the first in the listbox %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+order_nodes(Node,Node_list)->
+ [Node|lists:delete(Node,Node_list)].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Take the list of nodes and make it to a list of options to the %%
+%% the combobox %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+print_nodes([])->
+ [];
+print_nodes([Node|Rest])->
+ "<OPTION value=\"" ++
+ atom_to_list(Node) ++
+ "\">" ++
+ atom_to_list(Node) ++
+ "\n" ++
+ print_nodes(Rest).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Create the header of the node info page i.e. the name of the node %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+node_title()->
+ " <TABLE WIDTH=\"100%\" BORDER=\"0\">
+ <TR><TD ALIGN=\"center\"><FONT SIZE=5>Applications</FONT></TD></TR>
+ </TABLE>\n".
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Build the body of the side that shows the node i.e the application %%
+%% list %%
+%% Node and Node_name are the same just different types %%
+%% Node are the atom Node_name the string of the node name %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+application_tree(Node,Node_name)->
+ Fun=fun(Name)->
+ Name_str =atom_to_list(Name),
+ "<LI><A HREF=\"./application_info?name=" ++ Name_str ++
+ "&mode=all&node=" ++ Node_name ++
+ "\" TARGET=main><B>" ++ Name_str ++
+ "</B></A>" ++ print_space(15-length(Name_str),[]) ++
+ "<A HREF=\"./application_env?name=" ++ Name_str ++
+ "&node=" ++ Node_name ++
+ "\" TARGET=\"main\"><FONT SIZE=2>spec</FONT></A></LI>\n"
+ end,
+ "<UL>" ++
+ lists:map(Fun, (process_info:get_applications(Node))) ++
+ "</UL>" ++
+ "<FORM Name=reload>" ++
+ "<INPUT TYPE=\"button\" onClick=\"node_selected()\"
+ VALUE=\"Reload\">\n" ++
+ "</FORM>" ++
+ "<!--<A HREF=\"../../appmon/application_help.html\" TARGET=main>Help</A>-->".
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Print spaces between the application name and the spec link %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+print_space(N,Space)when N >0 ->
+ print_space(N-1,"&nbsp;" ++ Space);
+print_space(_N,Space)->
+ Space.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The Private functions that do the job %%
+%% To build the the page that shows process in an application %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%Generates the javascript that govern the look of the page that %%
+%%the processes of an application %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%Args is the list whit input args should be App Mode, Node
+application_javascript(Args)when length(Args)>=3 ->
+ Vars=
+ "<SCRIPT>
+ var proc;
+ var app=\"" ++ element(2,lists:nth(1,Args)) ++ "\";
+ var node=\"" ++ element(2,lists:nth(3,Args)) ++ "\";",
+ CommonFuncs=
+ " function reload_bottom_frame()
+ {parent.proc_data.location.href=\"/appmon/blank.html\";}
+
+ function show_process_info()
+ {
+ if(proc.indexOf(\"#Port\")== -1)
+ {
+ if(proc.charAt(0)==\'<\')
+ window.location=\"./proc_info?name=\" + proc + \"&node=\" + node
+ else
+ {
+ start=proc.indexOf(\"<\");
+ endpoint=proc.lastIndexOf(\">\");
+ window.location=\"./proc_info?name=\" + proc.slice(start,endpoint+1) + \"&node=\" + node ;
+ }
+ }
+ }
+
+ function trace()
+ {
+ if(proc.charAt(0)==\'<\')
+ window.location=\"./trace?name=\" + app + \"&mode=\" + get_mode() + \"&node=\" + node + \"&proc=\" + proc;
+ else
+ {
+ start=proc.indexOf(\"<\");
+ endpoint=proc.lastIndexOf(\">\");
+ window.location=\"./trace?name=\" + app + \"&mode=\" + get_mode() + \"&node=\" + node + \"&proc=\" +
+ proc.slice(start,endpoint+1) ;
+ }
+
+ }
+
+ function reload_page()\n
+ {
+ window.location=\"./application_info?name=\" + app + \"&mode=\" + get_mode() + \"&node=\" + node ;
+ }
+ function get_mode()
+ {
+ for (i= 0; i < document.reload_form.mode.length; i++)
+ {
+ if (document.reload_form.mode[i].checked)
+ return(document.reload_form.mode[i].value);
+ }
+ return(\"all\");
+ }",
+ Vars++CommonFuncs++"</SCRIPT>";
+application_javascript(_)->
+ "<SCRIPT></SCRIPT>".
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Create the body i.e the process tree for the applications whose %%
+%% name is the second arg in the first tuple %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%args is the list [{_,Appname},{_,Mode},{_Node}]
+application_body(Args) when is_list(Args),length(Args) >= 3 ->
+ App=element(2,lists:nth(1,Args)),
+ Mode=element(2,lists:nth(2,Args)),
+ Node=element(2,lists:nth(3,Args)),
+ "<BODY BGCOLOR=\"FFFFFF\" onLoad=reload_bottom_frame() >"
+ ++ mode_selection(Mode) ++
+ selected_app_header(App,Node) ++ process_tree(App,Mode,Node)++
+ "</BODY>";
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% If the pattern above ain't match then something is wrong %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+application_body(_Whatever)->
+ "Please use the links to the left".
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Create the part of the process tree page side where the user can %%
+%% select the mode the view the tree in. %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+mode_selection(Mode)->
+ "<FORM NAME=\"reload_form\">\n" ++
+ "<TABLE>" ++
+ "<TR>\n" ++
+ "<!--<TD><INPUT TYPE=\"button\" NAME=\"refresh_but\" VALUE=\"Reload\" onClick=\"reload_page()\">
+ &nbsp;&nbsp;&nbsp;&nbsp;</TD>\n-->" ++
+ print_radio_buttons([{"all","All processes"},{"sup_child","Supervised processes"},
+ {"sup","Only supervisors"}],Mode) ++
+ "</TR>\n </TABLE>\n" ++
+ "</FORM>".
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Print the radiobuttons. if the mode is the one the current %%
+%% radiobutton represent set the one checked %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+print_radio_buttons([],_)->
+ [];
+print_radio_buttons([{Mode,Name}|Rest],Mode)->
+ "<TD><INPUT TYPE=\"radio\" NAME=\"mode\" CHECKED=\"true\" VALUE=\""++
+ Mode ++"\" onClick=\"reload_page()\">&nbsp;&nbsp;" ++Name ++
+ "</TD>\n" ++ print_radio_buttons(Rest,Mode);
+print_radio_buttons([{Mode1,Name}|Rest],Mode)->
+ "<TD><INPUT TYPE=\"radio\" NAME=\"mode\" VALUE=\""++ Mode1 ++
+ "\" onClick=\"reload_page()\">&nbsp;&nbsp;" ++ Name ++
+ "</TD>\n" ++
+ print_radio_buttons(Rest,Mode).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The part that shows the name of the application that the process %%
+%% tree represent %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+selected_app_header(App,Node)->
+ {Year,Mon,Day}=date(),
+ "<TABLE>
+ <TR>
+ <TD>Node:</TD>
+ <TD>" ++Node ++"</TD>
+ </TR>
+ <TR>
+ <TD>Application:</TD>
+ <TD>" ++App ++"</TD>
+ </TR>
+ <TR>
+ <TD>Date:</TD>
+ <TD>" ++ integer_to_list(Day) ++ "/" ++
+ integer_to_list(Mon) ++"&nbsp;-&nbsp;"++
+ integer_to_list(Year) ++
+ "</TD>
+ </TR>
+ </TABLE>
+ <TABLE WIDTH=100%>
+ <TR>
+ <TD>
+ <HR WIDTH=\"80%\">
+ <!--<FONT SIZE=4>Process tree</FONT>
+ <HR ALIGN=\"center\" WIDTH=\"80%\">-->
+ </TD>
+ </TR>
+ </TABLE>".
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%get the process tree from process_info and build the nested %%
+%% unordered list that represent the applications process tree %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+process_tree(App,Mode,Node)->
+ case process_info:get_processes(list_to_atom(App),
+ list_to_atom(Mode),
+ list_to_atom(Node)) of
+ unknown->
+ "Unknown application please update application tree";
+ {Tree,Traced_dict} ->
+ "<UL>" ++
+ htmlify_tree(Tree,Traced_dict,1,Node,Mode,App) ++
+ "</UL>"
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Build each node in the tree and then build its children %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+htmlify_tree({Pid,Childs,Childs2},Proc_tab,N,Node,Mode,App)->
+ case ets:lookup(Proc_tab,Pid) of
+ [] when N<3->
+ print_pid(Pid,Node,Mode,App,notrace)++
+ htmlify_prim_child(Childs,Proc_tab,N+1,Node,Mode,App) ++
+ htmlify_sec_child(Childs2);
+ [_Traced]->
+ print_pid(Pid,Node,Mode,App,"<FONT SIZE=2 COLOR=\"firebrick\">Stop Trace</FONT>")++
+ htmlify_prim_child(Childs,Proc_tab,N+1,Node,Mode,App) ++
+ htmlify_sec_child(Childs2);
+ []->
+ print_pid(Pid,Node,Mode,App,"<FONT SIZE=2>Start Trace</FONT>")++
+ htmlify_prim_child(Childs,Proc_tab,N+1,Node,Mode,App) ++
+ htmlify_sec_child(Childs2)
+ end.
+
+print_pid(Pid,Node,_Mode,_App,notrace)->
+ "<LI><A TARGET=\"proc_data\" STYLE=\"text-decoration:none; color:blue\" HREF=\"./proc_info?name=" ++ urlify_pid(Pid) ++
+ "&node="++ Node ++" \" >"++ htmlify_pid(Pid,[]) ++
+ "</A>";
+
+print_pid([$P,$o,$r,$t|Rest],_Node,_Mode,_App,_TrMode)->
+ "<LI>" ++ htmlify_pid([$P,$o,$r,$t|Rest],[]);
+
+print_pid(Pid,Node,Mode,App,TrMode)->
+ "<LI><A TARGET=\"proc_data\" STYLE=\"text-decoration:none; color:blue\" HREF=\"./proc_info?name=" ++
+ urlify_pid(Pid) ++ "&node="++ Node ++" \" >"++
+ htmlify_pid(Pid,[]) ++ "</A>"++
+ "&nbsp;&nbsp;&nbsp
+ <A HREF=\"./trace?app="++App++"&mode="++Mode++
+ "&node="++Node++"&proc="++urlify_pid(Pid)++"\">
+ "++TrMode++"</A>".
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Change the '<' sign and the '>' sign to the html representation %%
+%% of the sign %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+htmlify_pid([60|Pid],New)->
+ htmlify_pid(Pid,";tl&"++New);
+htmlify_pid([139|Pid],New)->
+ htmlify_pid(Pid,";tl&"++New);
+
+htmlify_pid([62|Pid],New)->
+ htmlify_pid(Pid,";tg&"++New);
+htmlify_pid([155|Pid],New)->
+ htmlify_pid(Pid,";tg&"++New);
+htmlify_pid([Chr|Pid],New)->
+ htmlify_pid(Pid,[Chr|New]);
+htmlify_pid([],New)->
+ lists:reverse(New).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Change the < and > sign to the representation of the signs in %%
+%% the HTTP protocol %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+urlify_pid(Pid) ->
+ case regexp:first_match(Pid,"[<].*[>]") of
+ {match,Start,Len}->
+ "%3C"++string:substr(Pid,Start+1,Len-2)++"%3E";
+ _->
+ Pid
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Change the < and > sign from the representation of the signs in %%
+%% the HTTP protocol %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+unurlify_pid(Pid)->
+ unurlify_pid(Pid,[]).
+
+unurlify_pid([$%,$3,$C|Rest],New)->
+ unurlify_pid(Rest,[60|New]);
+
+unurlify_pid([$%,$3,$E|Rest],New)->
+ unurlify_pid(Rest,[62|New]);
+unurlify_pid([Chr|Rest],New)->
+ unurlify_pid(Rest,[Chr|New]);
+
+unurlify_pid([],New)->
+ lists:reverse(New).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Make html of the list of primary childs %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+htmlify_prim_child([],_Proc_tab,_N,_Node,_Mode,_App)->
+ [];
+
+htmlify_prim_child(Childs,Proc_tab,N,Node,Mode,App)->
+ Fun=fun(Child)->
+ htmlify_tree(Child,Proc_tab,N,Node,Mode,App)
+ end,
+ "<UL>\n" ++ lists:map(Fun,Childs) ++ "</UL>\n".
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Make html of hte list whit sedondary childs, they has no childs %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+htmlify_sec_child([])->
+ [];
+
+htmlify_sec_child(Sec_child_list)->
+ Htmlify_child=fun(Pid1)->
+ "<LI><FONT COLOR=\"#FF2222\">" ++ Pid1 ++
+ "</FONT></LI>\n"
+ end,
+ "<UL>" ++ lists:map(Htmlify_child,Sec_child_list) ++ "</UL>\n".
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The Private functions that do the job %%
+%% To build the the page that shows process data %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The function that creates the collects the various part of %%
+%% the side that shows information about a specific process, %%
+%% Pid_name should be the list representation of a pid %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+process_body(Args) when length(Args)==2->
+ Pid=element(2,lists:nth(1,Args)),
+ Node=element(2,lists:nth(2,Args)),
+ "<BODY BGCOLOR=\"#FFFFFF\">" ++
+ process_information_table(Pid,Node) ++ "</BODY>";
+
+process_body(_)->
+ "<BODY BGCOLOR=\"#FFFFFF\">Please dont call this side manually</BODY>".
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Create the table that shows the name of the pid to show extended %%
+%% info about %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Get the table that shows the extended info about a process %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+process_information_table(Pid_name,Node)->
+ PidID=unurlify_pid(Pid_name),
+ case catch list_to_pid(PidID) of
+ Pid when is_pid(Pid) ->
+ get_process_table(Pid,Node);
+ _Other ->
+ io_lib:format("Not a process id ~s",[PidID])
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Create the table that shoows the extended info about processes %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+get_process_table(Pid,Node_name) when is_list(Node_name)->
+ Node=list_to_atom(Node_name),
+ get_process_table(Pid,Node);
+
+get_process_table(Pid,Node) when is_atom(Node)->
+ case lists:member(Node,[node()|nodes()]) of
+ true->
+ Proc_data=process_info:get_process_data(Pid,Node),
+ "<TABLE BORDER=1 >
+ <TR BGCOLOR=\"#8899AA\"><TD COLSPAN=6 ALIGN=\"center\" >
+ <FONT size=4> Process" ++
+ htmlify_pid(pid_to_list(Pid),[]) ++ "</FONT>
+ </TD></TR>" ++
+ start_process_proc_data(Proc_data) ++
+ "</TABLE><BR><BR>";
+ _ ->
+ "Please try again the Node dont exists"
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The process information is quite messy tidi it up by creating a %%
+%% table that looks like key val %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+start_process_proc_data(Proc_data)->
+ %%Pic out the special cases the links and the process dict
+ {Special,Usual}=split_proc_data(Proc_data),
+ Usual2=append_empty(Usual),
+ UsualProcData=process_proc_data(Usual2,0),
+ SpecProcData=process_proc_data(Special),
+ UsualProcData++SpecProcData.
+
+append_empty(List) when length(List) rem 2 == 0 ->
+ List;
+append_empty(List)->
+ append_empty(lists:append(List,[empty])).
+
+split_proc_data(Proc_data)->
+ Spec=lists:map(fun(Key)->
+ case lists:keysearch(Key,1,Proc_data) of
+ {value,Data}->
+ Data;
+ _ ->
+ not_included
+ end
+ end,[links,dictionary,messages]),
+ Spec2=clear(Spec,[]),
+ Usual=lists:filter(fun({Key,_Val})->
+ case Key of
+ messages ->
+ false;
+ links ->
+ false;
+ dictionary ->
+ false;
+ _ ->
+ true
+ end
+ end,Proc_data),
+ {Spec2,Usual}.
+
+clear([],New)->
+ New;
+clear([not_included|Spec],New)->
+ clear(Spec,New);
+clear([Other|Spec],New)->
+ clear(Spec,[Other|New]).
+
+process_proc_data(Data,3)->
+ "</TR>"++process_proc_data(Data,0);
+process_proc_data([],_N)->
+ [];
+process_proc_data(Data,0)->
+ "<TR>"++process_proc_data(Data,1);
+
+process_proc_data([empty|Data],N)->
+ "<TD>&nbsp;</TD><TD>&nbsp;</TD> "++process_proc_data(Data,N+1);
+
+process_proc_data([{current_function,MFA}|Rest],N)->
+ "<TD NOWRAP=true><FONT SIZE=3><B>Current function:</B></TD><TD><FONT SIZE=3>"++
+ io_lib:format("~p",[MFA]) ++"</TD>\n " ++
+ process_proc_data(Rest,N+1);
+
+process_proc_data([{error_handler,Mod}|Rest],N)->
+ "<TD NOWRAP=\"true\"><B><FONT SIZE=3>Error handler:</B></TD><TD><FONT SIZE=3>"
+ ++ atom_to_list(Mod) ++ "</TD>\n" ++
+ process_proc_data(Rest,N+1);
+
+process_proc_data([{group_leader,Grp}|Rest],N)->
+ "<TD NOWRAP=\"true\"><FONT SIZE=3><B>Group leader:</B></TD><TD><FONT SIZE=3>" ++
+ htmlify_pid(pid_to_list(Grp),[]) ++ "</TD>\n " ++
+ process_proc_data(Rest,N+1);
+
+process_proc_data([{heap_size,Size}|Rest],N)->
+ "<TD NOWRAP=\"true\"><FONT SIZE=3><B>Heap size:</B></TD><TD><FONT SIZE=3>"
+ ++ integer_to_list(Size) ++ "</TD>\n " ++
+ process_proc_data(Rest,N+1);
+
+process_proc_data([{initial_call,MFA}|Rest],N)->
+ "<TD NOWRAP=\"true\"><FONT SIZE=3><B>Initial call:</B></TD><TD><FONT SIZE=3>"++
+ io_lib:format("~p",[MFA]) ++"</TD>\n " ++
+ process_proc_data(Rest,N+1);
+
+process_proc_data([{message_queue_len,Size}|Rest],N)->
+ "<TD NOWRAP=\"true\"><FONT SIZE=3><B>Message queue length:</B></TD><TD><FONT SIZE=3>" ++
+ integer_to_list(Size) ++ "</TD>\n " ++
+ process_proc_data(Rest,N+1);
+
+process_proc_data([{priority,Level}|Rest],N)->
+ "<TD><FONT SIZE=3><B>Process priority:</B></TD><TD><FONT SIZE=3>" ++
+ atom_to_list(Level) ++ "</TD>\n " ++
+ process_proc_data(Rest,N+1);
+
+process_proc_data([{reductions,Number}|Rest],N)->
+ "<TD ><FONT SIZE=3><B>Number of executed reductions:</B></TD>
+ <TD><FONT SIZE=3>" ++ integer_to_list(Number) ++ "</TD>\n " ++
+ process_proc_data(Rest,N+1);
+
+process_proc_data([{registered_name,Name}|Rest],N)->
+ "<TD NOWRAP=\"true\"><FONT SIZE=3><B>Process Name:</B></TD><TD><FONT SIZE=3>"
+ ++ atom_to_list(Name) ++ "</TD>\n" ++
+ process_proc_data(Rest,N+1);
+
+process_proc_data([{stack_size,Size}|Rest],N)->
+ "<TD NOWRAP=\"true\"><FONT SIZE=3><B>Stack size:</B></TD><TD><FONT SIZE=3>"
+ ++ integer_to_list(Size) ++ "</TD>\n " ++
+ process_proc_data(Rest,N+1);
+
+process_proc_data([{status,Status}|Rest],N)->
+ "<TD NOWRAP=\"true\"><FONT SIZE=3><B>Process status:</B></TD><TD><FONT SIZE=3>"
+ ++ atom_to_list(Status) ++ "</TD>\n " ++
+ process_proc_data(Rest,N+1);
+
+process_proc_data([{trap_exit,Boolean}|Rest],N)->
+ "<TD NOWRAP=\"true\" ><FONT SIZE=3><B>Trap Exit:</B></TD><TD><FONT SIZE=3>"
+ ++ atom_to_list(Boolean) ++ "</TD>\n " ++
+ process_proc_data(Rest,N+1);
+
+process_proc_data([{Key,Val}|Rest],N)->
+ "<TD NOWRAP=\"true\" ><FONT SIZE=3><B>" ++ io_lib:write(Key) ++
+ "</B></TD><TD><FONT SIZE=3>" ++ io_lib:write(Val) ++
+ "</TD>\n " ++
+ process_proc_data(Rest,N).
+
+process_proc_data([])->
+ [];
+process_proc_data([{links,List_of_pids}|Rest])->
+ "<TR><TD NOWRAP=\"true\"><FONT SIZE=3><B>Links:</B></TD><TD COLSPAN=5><FONT SIZE=3>"++ print_links(List_of_pids) ++"</TD></TR>\n " ++
+ process_proc_data(Rest);
+
+process_proc_data([{messages,Queue}|Rest])->
+ "<TR><TD NOWRAP=\"true\"><FONT SIZE=3><B>Message Queue:</B></TD><TD COLSPAN=5><FONT SIZE=3>" ++ io_lib:write(Queue) ++ "</TD></TR>\n " ++
+ process_proc_data(Rest);
+
+process_proc_data([{dictionary,Dict}|Rest])->
+ "<TR><TD NOWRAP=\"true\"><FONT SIZE=3><B>Process dictionary:</B></TD><TD COLSPAN=5><FONT SIZE=3>&nbsp;</TD></TR>\n " ++
+ get_dictionary_data(Dict) ++
+ process_proc_data(Rest).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% In the process info there are the links to other processes print %%
+%% this pid %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+print_links(Pids)->
+ print_links(Pids,[]).
+
+print_links([],Links)->
+ htmlify_pid(Links,[]);
+
+print_links([Pid],Links) when is_pid(Pid) ->
+ print_links([],Links ++ pid_to_list(Pid));
+
+print_links([Pid],Links) when is_port(Pid) ->
+ print_links([],Links ++ erlang:port_to_list(Pid));
+
+print_links([Pid|Rest],Links) when is_pid(Pid) ->
+ print_links(Rest,Links ++ pid_to_list(Pid) ++ ", ");
+
+print_links([Pid|Rest],Links) when is_port(Pid) ->
+ print_links(Rest,Links ++ erlang:port_to_list(Pid) ++ ", ").
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Fix the data in the process dictionary %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+get_dictionary_data([])->
+ [];
+
+get_dictionary_data([{Key,Val}|Dict])->
+ FormatedVal=add_space(htmlify_pid(lists:flatten(fix_type(Val)),[])),
+ "<TR><TD><FONT SIZE=3>" ++
+ htmlify_pid(lists:flatten(fix_type(Key)),[]) ++
+ "</TD><TD COLSPAN=5><FONT SIZE=3>" ++
+ FormatedVal++ "</TD></TR>\n" ++
+ get_dictionary_data(Dict).
+
+add_space(List)->
+ add_space(List,0,[]).
+add_space([],_Len,New) ->
+ lists:reverse(New);
+add_space([Char|Rest],Len,New)when Len<50 ->
+ add_space(Rest,Len+1,[Char|New]);
+
+add_space([$\,|Rest],_Len,New) ->
+ add_space(Rest,0,[$\ ,$,|New]);
+
+add_space([Char|Rest],Len,New) ->
+ add_space(Rest,Len+1,[Char|New]).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Interpret the type of the data and make it to a list %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+fix_type(Val) when is_atom(Val) ->
+ atom_to_list(Val);
+fix_type(Val) when is_float(Val) ->
+ float_to_list(Val);
+fix_type(Val) when is_integer(Val) ->
+ integer_to_list(Val);
+fix_type(Val) when is_list(Val) ->
+ case io_lib:printable_list(Val) of
+ true->
+ case Val of
+ []->
+ io_lib:write(Val);
+ _->
+ Val
+ end;
+ _->
+ io_lib:write(Val)
+ end;
+fix_type(Val) when is_pid(Val) ->
+ pid_to_list(Val);
+fix_type(Val) when is_port(Val) ->
+ erlang:port_to_list(Val);
+fix_type(Val) when is_tuple(Val) ->
+ io_lib:write(Val);
+fix_type(_Val) ->
+ [].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The Private functions that send the trace signal to the process %%
+%% thats the 4 member of the Arg list %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+send_trace(Args)when length(Args)>=4->
+ {_,Proc}=lists:nth(4,Args),
+ Pid2=unurlify_pid(Proc),
+ process_info:send_trace(Pid2);
+
+send_trace(_Args)->
+ arg_error.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Private functions that prints the application environment %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+application_env_body(Args)when length(Args)>=2 ->
+ App=element(2,lists:nth(1,Args)),
+ Node=element(2,lists:nth(2,Args)),
+ "<SCRIPT>
+ function reload_bottom_frame()
+ {parent.proc_data.location.href=\"/appmon/blank.html\";}
+ </SCRIPT>
+ <BODY BGCOLOR=\"#FFFFFF\" onLoad=reload_bottom_frame()>"
+ ++ application_env_table(App,Node) ++ "</BODY>";
+
+application_env_body(_)->
+ "<BODY BGCOLOR=\"#FFFFFF\">Please dont call this side manually</BODY>".
+
+application_env_table(App,Node)->
+ case process_info:get_application_keys(list_to_atom(App),
+ list_to_atom(Node)) of
+ {ok,List}->
+ "<TABLE BORDER=1>" ++ application_env_head(App,Node) ++
+ print_key_list(List,[]) ++ "</TABLE>";
+ _ ->
+ "Please try again,something went wrong"
+ end.
+
+application_env_head(App,Node)->
+ "<TR BGCOLOR=\"#8899AA\"><TD ALIGN=\"center\" COLSPAN=3>
+ <FONT SIZE=6>" ++ App ++ "@" ++ Node ++ "</FONT>\n
+ </TD></TR>
+ <TR><TD COLSPAN=3>&nbsp</TD></TR>
+ <TR BGCOLOR=\"#8899AA\">
+ <TD><B>Key</B></TD><TD><B>Val/Sec. key</B></TD><TD><B>Sec. Val</B></TD>
+ </TR>".
+
+print_key_list([],Result)->
+ Result;
+
+print_key_list([{application,Name}|Rest],Result)->
+ print_key_list(Rest,Result ++ print_key("Application name :",Name));
+
+print_key_list([{description,Desc}|Rest],Result)->
+ print_key_list(Rest,Result ++ print_key("Description :",Desc));
+
+print_key_list([{vsn,Ver}|Rest],Result)->
+ print_key_list(Rest,Result ++ print_key("Version :",Ver));
+
+print_key_list([{id,Id}|Rest],Result)->
+ print_key_list(Rest,Result ++ print_key("ID:",fix_type(Id)));
+
+print_key_list([{modules,Mods}|Rest],Result)->
+ print_key_list(Rest,Result ++ print_key("Modules:","&nbsp;") ++
+ print_secondary_list(Mods,[]));
+
+print_key_list([{maxP,Max}|Rest],Result)->
+ print_key_list(Rest,Result ++
+ print_key("Max nr of processes",fix_type(Max)));
+
+print_key_list([{maxT,Max}|Rest],Result)->
+ print_key_list(Rest,Result ++
+ print_key("Max running sec:",fix_type(Max)));
+
+print_key_list([{registered,Names}|Rest],Result)->
+ print_key_list(Rest,Result ++
+ print_key("Registered names:","&nbsp;") ++
+ print_secondary_list(Names,[]));
+
+print_key_list([{applications,Apps}|Rest],Result)->
+ print_key_list(Rest,Result ++ print_key("Depends on:","&nbsp") ++
+ print_secondary_list(Apps,[]));
+
+print_key_list([{included_applications,Inc_apps}|Rest],Result)->
+ print_key_list(Rest,Result ++
+ print_key("Included applications:",
+ fix_type(Inc_apps)));
+
+print_key_list([{env,Env}|Rest],Result)->
+ print_key_list(Rest,Result ++
+ print_key("Environment:",fix_type(Env)));
+
+print_key_list([{mod,Mod}|Rest],Result)->
+ print_key_list(Rest,Result ++
+ print_key("Application callback mod:",
+ fix_type(Mod)));
+
+print_key_list([{start_phases,Phase_arg}|Rest],Result)->
+ print_key_list(Rest,Result ++
+ print_key("Application callback mod:",
+ fix_type(Phase_arg)));
+
+print_key_list([_|Rest],Result)->
+ print_key_list(Rest,Result).
+
+print_key(Label,Val)->
+ "<TR>
+ <TD><B>" ++ Label ++ "</B></TD><TD>" ++ Val ++
+ "</TD><TD>&nbsp;</TD>
+ </TR>".
+
+print_key2(Label,Val)->
+ "<TR>
+ <TD>&nbsp;</TD><TD>" ++ Label ++ "</TD><TD>" ++ Val ++ "</TD>
+ </TR>".
+
+print_secondary_list([],Result)->
+ Result;
+print_secondary_list([{Mod,Ver}|Rest],Result) ->
+ print_secondary_list(Rest,Result ++
+ print_key2(fix_type(Mod),fix_type(Ver)));
+
+print_secondary_list([Mod|Rest],Result) ->
+ print_secondary_list(Rest,Result ++
+ print_key2(fix_type(Mod),"&nbsp;")).
diff --git a/lib/appmon/src/process_info.erl b/lib/appmon/src/process_info.erl
new file mode 100644
index 0000000000..e5d44ae50e
--- /dev/null
+++ b/lib/appmon/src/process_info.erl
@@ -0,0 +1,662 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-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(process_info).
+-behavior(gen_server).
+
+-export([start/0, start_link/0, stop/0]).
+-export([is_node/1, get_nodes/0,
+ get_applications/1, get_application_keys/2,
+ get_processes/3, get_process_data/2,
+ send_trace/1]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+-record(data, {que=undef,
+ procs=undef,
+ links=undef,
+ links2=undef}).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Functions to retrieve information about which application %%
+%% at the node %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+start() ->
+ gen_server:start({local, proc_info}, process_info, [], []).
+
+start_link() ->
+ gen_server:start_link({local, proc_info}, process_info, [], []).
+
+stop() ->
+ gen_server:call(proc_info, stop, 1000).
+
+%% is_node(NodeS) -> {bool(), Node, NodeS2}
+%% NodeS = NodeS2 = string()
+%% Node = node()
+is_node(NodeS) ->
+ Node = list_to_atom(NodeS),
+ case lists:member(Node, [node()|nodes()]) of
+ true->
+ {true, Node, NodeS};
+ false ->
+ {false, node(), atom_to_list(node())}
+ end.
+
+%% get_nodes() -> [node()]
+get_nodes() ->
+ [node()|nodes()].
+
+%% get_applications(Node) -> [App]
+%% Node = node()
+%% App = atom()
+%% Returns the list of all applications with a supervision tree (that
+%% is, not library applications such as stdlib) at Node.
+get_applications(Node) ->
+ Info = rpc:call(Node, application, info, []),
+ {value, {running, Apps}} = lists:keysearch(running, 1, Info),
+ [App || {App, Pid} <- Apps, is_pid(Pid)].
+
+%% get_application_keys(App, Node) -> {ok, Keys} | {error, Reason}
+%% Node = node()
+%% App = atom()
+%% Keys = [{Key, Val}]
+%% Key = atom()
+%% Val = term()
+%% Reason = badapp | badrpc
+get_application_keys(App, Node) ->
+ case rpc:call(Node, application, get_all_key, [App]) of
+ {ok, Keys} ->
+ {ok, Keys};
+ undefined ->
+ {error, badapp};
+ {badrpc, _} ->
+ {error, badrpc}
+ end.
+
+%% get_processes(App, Mode, Node) -> {Tree, Dict} | unknown
+%% App = atom()
+%% Mode = sup | sup_child | all
+%% Node = node()
+get_processes(App, Mode, Node) ->
+ gen_server:call(proc_info, {get_processes, App, Mode, Node}).
+
+%% get_process_data(Pid, Node) -> ProcData
+%% Pid = pid()
+%% Node = node()
+%% ProcData -- see erlang:process_info/1
+get_process_data(Pid, Node) ->
+ case rpc:call(Node, erlang, process_info, [Pid]) of
+ {badrpc, _} ->
+ [{error,"Please try again"}];
+ Res ->
+ Res
+ end.
+
+%% send_trace(PidL) -> void()
+send_trace(PidL) ->
+ gen_server:call(proc_info, {send_trace, PidL}).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% gen_server callbacks %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+init([]) ->
+ {ok, ets:new(procs, [])}.
+
+handle_call({get_processes, App, Mode, Node}, _From, State) ->
+ case do_get_processes(App, Mode, Node) of
+ unknown ->
+ {reply, unknown, State};
+ Tree ->
+ {reply, {Tree, State}, State}
+ end;
+handle_call({send_trace, PidL}, _From, State) ->
+ do_send_trace(PidL, State),
+ {reply, ok, State};
+handle_call(stop, _From, State) ->
+ {stop, normal, ok, State}.
+
+handle_cast(_, State) ->
+ {noreply, State}.
+
+handle_info(_, State) ->
+ {noreply, State}.
+
+terminate(_Reason, _State) ->
+ ok.
+
+code_change(_, State, _) ->
+ {ok, State}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Internal functions %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% do_get_processes(App, Mode, Node) -> Tree | unknown
+%% App = atom()
+%% Mode = all | sup | sup_childs
+%% Node = node()
+%% Tree = term()
+do_get_processes(App, Mode, Node) ->
+ case rpc:call(Node, application_controller, get_master, [App]) of
+ Pid when is_pid(Pid) ->
+ start_collecting_data(Pid, Mode, Node);
+ undefined ->
+ unknown
+ end.
+
+%% Initiate the database, get the processes and the links.
+%% Then build lists and return them.
+start_collecting_data(Pid, Mode, Node) ->
+ Db = get_database(),
+ {Db2, Tree} = build_graph({master,Pid}, Db, Pid, Mode, Node),
+ delete_database(Db2),
+ Tree.
+
+get_database() ->
+ P = ets:new(procs,[]),
+ L = ets:new(link,[bag]),
+ L2 = ets:new(link2,[bag]),
+ Q = queue:new(),
+ ets:insert(P, {whereis(application_controller), crap}),
+ ets:insert(P, {whereis(gs), crap}),
+ #data{que=Q, procs=P, links=L, links2=L2}.
+
+delete_database(Db) ->
+ ets:delete(Db#data.procs),
+ ets:delete(Db#data.links),
+ ets:delete(Db#data.links2).
+
+%% The thought is
+%% 1. Get the processes that links to Pid.
+%% Pid is the application master the first time.
+%% 2. Add the processes to the database and clear the list of children
+%% from processes which for some resason not should be there.
+%% 3. Queue the children, so we later can se if they have any links.
+%% 4. Add links to the childrens.
+%% 5. When the whole tree is retreived remove the unnecessary processes
+%% depending on the mode.
+%% 6. Take all links that point to the same pid and sort out
+%% the primary and secondary relations.
+%% If more than one process links to the same process, the relation
+%% between a supervisor and a process is primary. The rest is
+%% secondary, there is no different in real world just in logic
+%% between a secondary and a primary relation.
+%% When all processes in the application is collected,
+%% fix secondary links and return the tree.
+build_graph(finish, Db, Grp, Mode, Node) ->
+ Db = fix_links(Db, Grp, Node),
+ delete_unwanted(Db, Mode, Grp),
+ Tree = start_tree(Db, Node),
+ {Db, Tree};
+build_graph(Pid, Db, Grp, Mode, Node) ->
+ Children = get_children(Pid, Mode, Node),
+ Children2 = add_and_remove(Children, Pid, Db, Grp, Node),
+ Q2 = queue_children(Db#data.que, Children2),
+ add_children(Pid, Db, Children2, 1),
+ case queue:out(Q2) of
+ {empty, _}->
+ build_graph(finish, Db, Grp, Mode, Node);
+ {{value,NPid}, Q3}->
+ Db2 = Db#data{que=Q3},
+ build_graph(NPid,Db2,Grp,Mode,Node)
+ end.
+
+%% Collect the processes which the current process has a link to
+%% Pid is now the application_master and the application master's
+%% child is the application supervisor but in reality there are two
+%% application master processes.
+%% Fix this by reordering the processes a little.
+get_children({master,Pid}, _Mode, Node) when is_pid(Pid) ->
+ %% Get the master pid
+ MPid = case application_master:get_child(Pid) of
+ {Pid1, _App} -> Pid1;
+ Pid1 -> Pid1
+ end,
+ %% Get the second appplication master process and order them
+ %% correctly
+ case rpc:call(Node, erlang, process_info, [MPid,links]) of
+ {links, [H|T]} -> [H,MPid|T];
+ {links, []} -> MPid
+ end;
+get_children({Pid, _Name}, _Mode, Node) when is_pid(Pid),
+ Node==node(Pid) ->
+ {links,Links} = rpc:call(Node, erlang, process_info, [Pid,links]),
+ Links;
+get_children(Pid, _Mode, Node) when is_pid(Pid), Node==node(Pid) ->
+ {links,Links} = rpc:call(Node, erlang, process_info, [Pid,links]),
+ Links;
+get_children(Pid, _Mode, Node) when is_pid(Pid), Node/=node(Pid) ->
+ [];
+get_children(Port, _Mode, _Node) when is_port(Port) ->
+ [].
+
+%% Add the links to the database.
+%% The first case -- when it is the application master process -- there
+%% is only one real child even though there are more links.
+add_children({master,Pid}, Db, [Child|_Rest], N) ->
+ add_child(Pid, Db, Child, N);
+add_children(_Pid, _Db, [], _N) ->
+ ok;
+add_children(Pid, Db, [Child|Rest], N) ->
+ add_child(Pid, Db, Child, N),
+ add_children(Pid, Db, Rest, N+1).
+
+add_child(Pid, Db, Child, N) ->
+ case ets:match_object(Db#data.links, {Pid,Child,'_'}) of
+ [] ->
+ ets:insert(Db#data.links, {Pid,Child,N});
+ _ ->
+ ok
+ end.
+
+%% Add the list of processes to the queue.
+queue_children(Queue, []) ->
+ Queue;
+queue_children(Queue, [H|T]) ->
+ Q = queue:in(H, Queue),
+ queue_children(Q, T).
+
+%% The processess that we already has added to the database are
+%% not children to the current process, so we don't need to add them a
+%% second time.
+remove_used_children([], _Db, New_list) ->
+ lists:reverse(New_list);
+remove_used_children([Child|Rest], Db, New) ->
+ case ets:lookup(Db#data.procs, Child) of
+ [] ->
+ remove_used_children(Rest, Db, [Child|New]);
+ _ ->
+ remove_used_children(Rest, Db, New)
+ end.
+
+%% Take the list of links and separate it into a list with ports and a
+%% list with pids.
+separate_ports([], Pids, Ports) ->
+ {Pids, Ports};
+separate_ports([Child|Rest], Pids, Ports) ->
+ if
+ is_port(Child) ->
+ separate_ports(Rest, Pids, [Child|Ports]);
+ is_pid(Child) ->
+ separate_ports(Rest, [Child|Pids], Ports)
+ end.
+
+%% Add the current pid to the ets table with processes and clear
+%% the list of children from processes that should not be there.
+%% In the first case, no children are used so it's not necessary.
+add_and_remove(Children, {master,Pid}, Db, _Grp, Node)
+ when is_pid(Pid), Node==node(Pid) ->
+ ets:insert(Db#data.procs, {Pid, {master,master}, controller}),
+ {_Pids,Ports} = separate_ports(Children, [], []),
+ Ports++Children;
+%% This clause is removable when using only link as retrieving mode .
+add_and_remove(Children, {Pid,_Name}, Db, Grp, Node)
+ when is_pid(Pid), Node==node(Pid) ->
+ ets:insert(Db#data.procs, {Pid,
+ rpc:call(Node,erlang,process_info,
+ [Pid,registered_name])}),
+ {Pids, Ports} = separate_ports(Children, [], []),
+ Children1 = remove_used_children(Pids, Db, []),
+ Children2 = remove_others_children(Children1, Grp, Node),
+ Ports++Children2;
+add_and_remove(Children, Pid, Db, Grp, Node) when is_pid(Pid),
+ Node==node(Pid) ->
+ ets:insert(Db#data.procs, {Pid,
+ rpc:call(Node,erlang,process_info,
+ [Pid,registered_name])}),
+ {Pids, Ports} = separate_ports(Children, [], []),
+ Children1 = remove_used_children(Pids, Db, []),
+ Children2 =remove_others_children(Children1, Grp, Node),
+ Ports++Children2;
+add_and_remove(_Children, Pid, _Db, _Grp, Node) when is_pid(Pid),
+ Node/=node(Pid) ->
+ [];
+%% Take care of the ports, don't add them to the table with processes.
+add_and_remove(_Children, Pid, _Db, _Grp, _Node) when is_port(Pid) ->
+ [].
+
+%% Control that the application's group leader is the group leader of
+%% Pid
+group_leader_check({Pid,_Name}, Grp, Node) ->
+ group_leader_check(Pid, Grp, Node);
+group_leader_check(Pid, Grp, Node) ->
+ case rpc:call(Node, erlang, process_info, [Pid,group_leader]) of
+ {_Item, Grp} -> yes;
+ _ -> no
+ end.
+
+%% Take the list of children and remove the ones with anoother group
+%% leader.
+remove_others_children(Children, Grp, Node) ->
+ lists:filter(fun(Child) ->
+ case group_leader_check(Child, Grp, Node) of
+ yes -> true;
+ no -> false
+ end
+ end,
+ Children).
+
+%% Mark the processes in the procs table as either supervisor or worker.
+fix_links(Db, Leader, Node) ->
+ {Sup,_Work} = mark_supervisors_workers(Db, Leader, Node),
+ ets:match_delete(Db#data.procs, {'_',crap}),
+ [_Pid|Procs] = ets:tab2list(Db#data.procs),
+ N_links = get_n_links(Procs, Db#data.links, []),
+ N_links2 = take_sup_links(Sup, Db#data.links, N_links),
+ add_shared_links(N_links2, Db#data.links2),
+ Db.
+
+%% Add the links that point to the same child to the shared links table
+add_shared_links(N_links, Links2) ->
+ Insert_fun = fun(Link) -> ets:insert(Links2, Link) end,
+ lists:map(fun(List) -> lists:map(Insert_fun, List) end, N_links).
+
+%% Take the list of links that point to the same children and remove
+%% the ones that are children to supervisors.
+%% The first argument is a list of the supervisors.
+%% N_links contains a list of list of links that points to the same
+%% child.
+take_sup_links([], _Db, N_links) ->
+ N_links;
+take_sup_links([H|Supervised], Links_table, N_links) ->
+ N_list_fun = fun(Link) ->
+ insert_sup_links(Link, H, Links_table)
+ end,
+ N_links2 = lists:map(fun(Link_list) ->
+ lists:filter(N_list_fun,Link_list)
+ end,
+ N_links),
+ take_sup_links(Supervised, Links_table, N_links2).
+
+%% Insert the supervised links in the primary links list.
+%% This function should be used as a fun to the filter function in
+%% take_sup_links/3.
+insert_sup_links({From,To,N}, Sup, Links_table) ->
+ case From of
+ Sup ->
+ ets:insert(Links_table, {From,To,N}),
+ false;
+ _ ->
+ true
+ end.
+
+%% Get the links which points to the same children.
+get_n_links([], _Links, N_link) ->
+ N_link;
+get_n_links([{Pid,_,_}|Procs], Links, N_link) ->
+ case ets:match_object(Links, {'_',Pid,'_'}) of
+ L when length(L)>1 ->
+ ets:match_delete(Links, {'_',Pid,'_'}),
+ get_n_links(Procs, Links, [L|N_link]);
+ _L ->
+ get_n_links(Procs, Links, N_link)
+ end;
+get_n_links([{Pid,_}|Procs], Links, N_link) ->
+ case ets:match_object(Links, {'_',Pid,'_'}) of
+ L when length(L)>1 ->
+ ets:match_delete(Links, {'_',Pid,'_'}),
+ get_n_links(Procs, Links, [L|N_link]);
+ _L ->
+ get_n_links(Procs, Links, N_link)
+ end.
+
+%% Mark the processes that are in the supervisor tree as either worker
+%% or supervisor.
+mark_supervisors_workers(Db, Leader, Node) ->
+ %% Get the supervisors and workers.
+ {Sup_list, Worker_list} = get_by_supervisors1(Leader),
+ %% Update the supervisor pids.
+ lists:map(fun(Pid) ->
+ ets:insert(Db#data.procs,
+ {Pid,
+ rpc:call(Node, erlang,process_info,
+ [Pid,registered_name]),
+ supervisor})
+ end,
+ Sup_list),
+ %% Update the worker pids.
+ lists:map(fun(Pid) ->
+ ets:insert(Db#data.procs,
+ {Pid,
+ rpc:call(Node, erlang,process_info,
+ [Pid,registered_name]),
+ worker})
+ end,
+ Worker_list),
+ {lists:reverse(Sup_list), Worker_list}.
+
+%% The second way to retrieve the applications processes is to go by
+%% the supervision tree.
+get_by_supervisors1(Leader) ->
+ case application_master:get_child(Leader) of
+ {Pid, _Name}->
+ get_by_supervisors([{namn,Pid,supervisor,list_of_mods}],
+ [], []);
+ Pid ->
+ get_by_supervisors([{namn,Pid,supervisor,list_of_mods}],
+ [], [])
+ end.
+
+get_by_supervisors([], Sup, Work) ->
+ {Sup, Work};
+get_by_supervisors([{_,Pid,supervisor,_}|Rest], Sup, Work)
+ when is_pid(Pid) ->
+ Children = supervisor:which_children(Pid),
+ Children2 = lists:append(Children, Rest),
+ get_by_supervisors(Children2, [Pid|Sup], Work);
+get_by_supervisors([{_,Pid,_,_}|Rest], Sup, Work) when is_pid(Pid) ->
+ get_by_supervisors(Rest, Sup, [Pid|Work]);
+get_by_supervisors([_Whatever|Rest], Sup, Work) ->
+ get_by_supervisors(Rest, Sup, Work).
+
+%% Use pattern matching to select mode and delete the unneccesary pids
+delete_unwanted(Db, sup_child, App_pid) ->
+ delete_not_in_supervisor_tree(Db),
+ add_main_link(Db, App_pid),
+ Db;
+delete_unwanted(Db, all, _App_pid) ->
+ Db;
+delete_unwanted(Db, sup, App_pid) ->
+ delete_workers(Db),
+ delete_not_in_supervisor_tree(Db),
+ add_main_link(Db, App_pid),
+ Db.
+
+add_main_link(Db, App_pid) ->
+ case application_master:get_child(App_pid) of
+ {Pid, _Name} when is_pid(Pid) ->
+ ets:insert(Db#data.links, {App_pid,Pid,1});
+ Pid when is_pid(Pid) ->
+ ets:insert(Db#data.links, {App_pid,Pid,1});
+ _ ->
+ false
+ end.
+
+%% Delete the processes that are in the supervision tree but are
+%% workers, and their links.
+delete_workers(Db) ->
+ Pids = ets:match_object(Db#data.procs, {'_','_',worker}),
+ Pids2 =
+ lists:map(
+ fun({Pid,_,_}) ->
+ %% Remove the unwanted pids from the process table.
+ ets:match_delete(Db#data.procs, {Pid,'_','_'}),
+ %% Remove the links to and from the pid.
+ ets:match_delete(Db#data.links, {Pid,'_','_'}),
+ ets:match_delete(Db#data.links, {'_',Pid,'_'}),
+ ets:match_delete(Db#data.links2, {Pid,'_','_'}),
+ ets:match_delete(Db#data.links2, {'_',Pid,'_'})
+ end,
+ Pids),
+ Pids2.
+
+%% Delete the processes that are not in the supervision tree.
+delete_not_in_supervisor_tree(Db) ->
+ Pids = ets:match_object(Db#data.procs,{'_','_'}),
+ Pids2 =
+ lists:map(
+ fun({Pid,_}) ->
+ %% Remove the unwanted from the process table.
+ ets:match_delete(Db#data.procs, {Pid,'_'}),
+ %% Remove the links to and from the pid.
+ ets:match_delete(Db#data.links, {Pid,'_','_'}),
+ ets:match_delete(Db#data.links, {'_',Pid,'_'}),
+ ets:match_delete(Db#data.links2, {Pid,'_','_'}),
+ ets:match_delete(Db#data.links2, {'_',Pid,'_'})
+ end,
+ Pids),
+ Pids2.
+
+%% Start generating the tree.
+start_tree(Db, Node) ->
+ case get_master(Db) of
+ no -> false;
+ Pid ->
+ build_node(Pid, Db, Node)
+ end.
+
+%% Build a node and then it runs itself on every child to the current
+%% pid.
+build_node(Pid, Db, Node) when is_pid(Pid), Node==node(Pid) ->
+ Sort_fun = fun sort_order/2,
+ Fix_sec_name_fun = fun(Pid2) -> get_link_name(Pid2, Db) end,
+ Build_tree_fun = fun({_,Pid1,_}) -> build_node(Pid1,Db,Node) end,
+ Children = ets:match_object(Db#data.links, {Pid,'_','_'}),
+ Children1 = lists:sort(Sort_fun, Children),
+ Sec_children = ets:match_object(Db#data.links2, {Pid,'_','_'}),
+ {get_name(Pid,Db),
+ lists:map(Build_tree_fun,Children1),
+ lists:map(Fix_sec_name_fun,Sec_children)};
+build_node(Pid, _Db, Node) when is_pid(Pid), Node/=node(Pid) ->
+ {"Runs on another node:"++erlang:pid_to_list(Pid), [], []};
+build_node(Pid, _Db, _Node) when is_port(Pid) ->
+ {"Port :"++erlang:port_to_list(Pid), [], []}.
+
+%% Select the name of the pid from the database where we previosly
+%% added it.
+get_name(Pid, Db) ->
+ case ets:lookup(Db#data.procs, Pid) of
+ [{_,{_,master},_}] -> pid_to_list(Pid);
+ [{_,{_,Name}}] -> atom_to_list(Name)++" : "++pid_to_list(Pid);
+ [{_,{_,Name},_}] -> atom_to_list(Name)++" : "++pid_to_list(Pid);
+ _ -> pid_to_list(Pid)
+ end.
+
+%% Select the name of the process which we have a link to.
+get_link_name({_,Pid,_}, Db) when is_pid(Pid) ->
+ case ets:lookup(Db#data.procs, Pid) of
+ [{_,{_,Name}}] -> atom_to_list(Name)++" : "++pid_to_list(Pid);
+ [{_,{_,Name},_}] -> atom_to_list(Name)++" : "++pid_to_list(Pid);
+ _ -> pid_to_list(Pid)
+ end;
+get_link_name({_,Port,_}, _Db) when is_port(Port) ->
+ "Port :"++" : ";
+get_link_name(_, _) ->
+ "".
+
+%% Sort the links in the order they where added, in ascending order.
+sort_order({_,_,N1}, {_,_,N2}) when N1>N2 -> true;
+sort_order(_N1, _N2) -> false.
+
+%% Select the pid of the application master.
+get_master(Db) ->
+ case ets:match_object(Db#data.procs,
+ {'_',{master,master},controller}) of
+ [{Pid,_,_}|_Rest] -> Pid;
+ _ -> no
+ end.
+
+%% The main function to handle tracing.
+%% Checks if the process is in the table with traced processes. If so,
+%% it stops the trace, otherwise it starts the trace.
+do_send_trace(PidL, Traced_tab) ->
+ Pid = list_to_pid(PidL),
+ Key = get_key(Pid),
+ case catch ets:lookup(Traced_tab, Key) of
+ [] ->
+ trace_process(Pid, Key, true, Traced_tab);
+ [_Object]->
+ trace_process(Pid, Key, false, Traced_tab)
+ end,
+ filter_procs(Traced_tab, ets:tab2list(Traced_tab)).
+
+get_key(Pid) ->
+ Node = node(Pid),
+ case rpc:call(Node, erlang, process_info, [Pid,registered_name]) of
+ [] -> pid_to_list(Pid);
+ {registered_name, Name} ->
+ atom_to_list(Name)++" : "++pid_to_list(Pid)
+ end.
+
+%% Tries to toggle the trace flag for the process.
+trace_process(Pid, Key, On_or_off, Procs_tab) ->
+ case rpc:call(node(Pid), sys, trace, [Pid,On_or_off,1000]) of
+ timeout ->
+ Node = node(Pid),
+ io:fwrite("timeout node= ~w, Pid= ~w mode= ~w ~n",
+ [Node, Pid, On_or_off]);
+ {badrpc, _} ->
+ Node = node(Pid),
+ io:fwrite("badrpc node= ~w, Pid= ~w mode= ~w ~n",
+ [Node, Pid, On_or_off]);
+ Res ->
+ Node = node(Pid),
+ io:fwrite("anymode ~w node= ~w, Pid= ~w mode= ~w ~n",
+ [Res, Node, Pid,On_or_off]),
+ case On_or_off of
+ true -> ets:insert(Procs_tab, {Key,On_or_off});
+ false -> ets:delete(Procs_tab, Key)
+ end
+ end.
+
+%% Check if the processes in the ets table with traced processes
+%% are alive. If not, remove them.
+filter_procs(Tab, Tab_list) ->
+ lists:foreach(fun({Key,_Val}) -> is_alive(Key, Tab) end, Tab_list).
+
+is_alive(Key, Tab) ->
+ case get_pid(Key) of
+ nopid -> false;
+ Pid -> is_alive2(Pid, Key, Tab)
+ end.
+
+%% Key is either a pid in list form or Pidname:Pid in list form.
+get_pid(Key) ->
+ case catch list_to_pid(string:substr(Key,string:rchr(Key,$<))) of
+ Pid when is_pid(Pid) ->
+ Pid;
+ _ ->
+ nopid
+ end.
+
+is_alive2(Pid, Key, Tab) ->
+ case catch rpc:call(node(Pid), erlang, is_process_alive, [Pid]) of
+ true -> true;
+ false ->
+ catch ets:delete(Tab, Key),
+ ok
+ end.