diff options
| author | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
|---|---|---|
| committer | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
| commit | 84adefa331c4159d432d22840663c38f155cd4c1 (patch) | |
| tree | bff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/appmon/src | |
| download | otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2 otp-84adefa331c4159d432d22840663c38f155cd4c1.zip | |
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/appmon/src')
| -rw-r--r-- | lib/appmon/src/Makefile | 101 | ||||
| -rw-r--r-- | lib/appmon/src/appmon.app.src | 24 | ||||
| -rw-r--r-- | lib/appmon/src/appmon.appup.src | 18 | ||||
| -rw-r--r-- | lib/appmon/src/appmon.erl | 1079 | ||||
| -rw-r--r-- | lib/appmon/src/appmon_a.erl | 1117 | ||||
| -rw-r--r-- | lib/appmon/src/appmon_dg.erl | 205 | ||||
| -rw-r--r-- | lib/appmon/src/appmon_dg.hrl | 45 | ||||
| -rw-r--r-- | lib/appmon/src/appmon_info.erl | 963 | ||||
| -rw-r--r-- | lib/appmon/src/appmon_lb.erl | 689 | ||||
| -rw-r--r-- | lib/appmon/src/appmon_place.erl | 194 | ||||
| -rw-r--r-- | lib/appmon/src/appmon_txt.erl | 302 | ||||
| -rw-r--r-- | lib/appmon/src/appmon_web.erl | 1037 | ||||
| -rw-r--r-- | lib/appmon/src/process_info.erl | 662 |
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," " ++ 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()\"> + </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()\"> " ++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()\"> " ++ 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) ++" - "++ + 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>"++ + "   + <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> </TD><TD> </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> </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> </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:"," ") ++ + 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:"," ") ++ + print_secondary_list(Names,[])); + +print_key_list([{applications,Apps}|Rest],Result)-> + print_key_list(Rest,Result ++ print_key("Depends on:"," ") ++ + 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> </TD> + </TR>". + +print_key2(Label,Val)-> + "<TR> + <TD> </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)," ")). 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. |