1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20%%----------------------------------------------------------------------
21%%
22%% Information centre for appmon. Must be present on each node
23%% monitored.
24%%
25%%
26%%	A worklist is maintained that contain all current work that
27%%	should be performed at each timeout. Each entry in the
28%%	worklist describes where the result shall be sent and a list
29%%	of options relevant for that particular task
30%%
31%%
32%% Maintenance Note:
33%%
34%%	This module is supposed to be updated by any who would like to
35%%	subscribe for information. The idea is that several tools
36%%	could use this module for their core information gathering
37%%	services.
38%%
39%%	The module is based on the notion of tasks. Each task should
40%%	have a nice public interface function which should handle task
41%%	administration. Tasks are identified by a "key" consisting of
42%%	three items, the requesting pid, the name of the task and the
43%%	task auxillary parameter. The requesting pid is the pid of the
44%%	callee (in the appmon case it can be the node window for
45%%	instance), the task name is whatever name the task is given
46%%	(in the appmon case it can be app, app_ctrl or load). The task
47%%	name can be seen as the type of the task. The task auxillary
48%%	parameter is an all purpose parameter that have a different
49%%	meaning for each type of task so in appmon the Aux for app
50%%	contains the root pid of the monitored application and in
51%%	app_ctrl it contains the node name (just to distinguish from
52%%	the other app_ctrl tasks, if any) while the Aux parameter is
53%%	not used for the load task at all.
54%%
55%%	Each task also carries a list of options for
56%%	customisation. The options valid for a task is completely
57%%	internal to that task type except for the timeout option which
58%%	is used by do_work to determine the interval at which to
59%%	perform the task. The timeout option may also have the value
60%%	at_most_once that indicates that the task should not be done
61%%	more than once, in appmon the remote port (or process) info
62%%	(pinfo) task is such a task that is only done once for each
63%%	call. Note that the only way to change or update options is to
64%%	call the public interface function for the task, this will
65%%	merge the old options with the new ones and also force the
66%%	task to be executed.
67%%
68%%	All tasks are managed by the do_work function. The basic
69%%	functionality being that the result of the task is compared to
70%%	the previous result and a delivery is sent to the callee if
71%%	they differ. Most tasks are then done on a regular basis using
72%%	the timer module for a delay.
73%%
74%%	There are a limited number of places where the module need to
75%%	be updated when new services are added, they are all marked
76%%	with "Maintenance Note", and here is a quick guide:
77%%
78%%	First implement the task. Put the functions in this module
79%%	among the other task implementations. Currently all task
80%%	implementations should be put in this file to make it simple
81%%	to monitor a node, this module should be the only one
82%%	needed. Then add your implementation to the do_work2 function
83%%	and finally add a public interface function among the other
84%%	public interface functions. Voila.
85%%
86%%
87%%
88%%	Future ideas:
89%%
90%%	Appmon should maybe be enhanced to show all processes on a
91%%	node. First put all processes in an ets P, then pick those
92%%	that belong to applications (the normal way), then try to find
93%%	those processes that are roots in process link trees and pick
94%%	them. The final step would be to do something with those
95%%	processes that are left.
96%%
97%%----------------------------------------------------------------------
98-module(appmon_info).
99-behaviour(gen_server).
100
101%% Exported functions
102-export([start_link/3, app/4, pinfo/4, load/4, app_ctrl/4]).
103
104%% For internal use (RPC call)
105-export([start_link2/3]).
106
107%% For debugging
108-export([status/0]).
109
110%% gen_server callbacks
111-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
112	 terminate/2, code_change/3]).
113
114
115%%----------------------------------------------------------------------
116%% The records
117%%
118%%	state is used for keeping track of all tasks.
119%%
120%%	db is the database used in the app task.
121%%
122
123-record(state, {starter, opts=[], work=[], clients=[]}).
124-record(db, {q, p, links, links2}).
125
126
127%%----------------------------------------------------------------------
128%% Macros
129%%
130
131-define(MK_KEY(CMD, AUX, FROM, OPTS), {CMD, AUX, FROM}).
132-define(MK_DOIT(KEY), {do_it, KEY}).
133-define(ifthen(P,S), if P -> S; true -> ok end).
134
135
136%%----------------------------------------------------------------------
137%% Public interface
138%%
139%%	The Aux parameter is an auxillary parameter that can be used
140%%	freely by the requesting process, it is included in the work
141%%	task key. appmon uses it for storing the node name when
142%%	requesting load and app_ctrl tasks, and appmon_a uses it for
143%%	storing application name when requesting app task.
144%%
145%%	Maintenance Note: Put new tasks at the end, please.
146%%
147
148
149%% Do not use gen_server:start_link because we do not want the
150%% appmon_info to die when initiating process dies unless special
151%% conditions apply.
152%% Uhu, we don't??? Made a fix so that this proces DOES indeed die
153%% if it's starter dies. /Gunilla
154start_link(Node, Client, Opts) ->
155    rpc:call(Node, ?MODULE, start_link2, [self(), Client, Opts]).
156start_link2(Starter, Client, Opts) ->
157    Name = {local, ?MODULE},
158    Args = {Starter, Opts, Client},
159    case gen_server:start(Name, ?MODULE, Args, []) of
160	{ok, Pid} ->
161	    {ok, Pid};
162	{error, {already_started, Pid}} ->
163	    register_client(Pid, Client),
164	    {ok, Pid}
165    end.
166
167
168%% app_ctrl
169%%
170%%	Monitors which applications exist on a node
171%%
172app_ctrl(Serv, Aux, OnOff, Opts) ->
173    gen_server:cast(Serv, {self(), app_ctrl, Aux, OnOff, Opts}).
174
175
176%% load
177%%
178%%	Monitors load on a node
179%%
180load(Serv, Aux, OnOff, Opts) ->
181    gen_server:cast(Serv, {self(), load, Aux, OnOff, Opts}).
182
183
184%% app
185%%
186%%	Monitors one application given by name (this ends up in a
187%%	process tree
188%%
189app(Serv, AppName, OnOff, Opts) ->
190    gen_server:cast(Serv, {self(), app, AppName, OnOff, Opts}).
191
192%% pinfo
193%%
194%%	Process or Port info
195%%
196pinfo(Serv, Pid, OnOff, Opt) ->
197    gen_server:cast(Serv, {self(), pinfo, Pid, OnOff, Opt}).
198
199%% register_client
200%%
201%%	Registers a client (someone subscribing for information)
202%%
203
204register_client(Serv, P) ->
205    link(Serv),
206    gen_server:call(Serv, {register_client, P}).
207
208%% status
209%%
210%%	Status of appmon_info
211%%
212
213status() ->
214    gen_server:cast(?MODULE, status).
215
216%%----------------------------------------------------------------------
217%%
218%% Gen server administration
219%%
220%%----------------------------------------------------------------------
221
222init({Starter, Opts, Pid}) ->
223    link(Pid),
224    process_flag(trap_exit, true),
225    WorkStore = ets:new(workstore, [set, public]),
226    {ok, #state{starter=Starter, opts=Opts, work=WorkStore,
227		clients=[Pid]}}.
228
229terminate(_Reason, State) ->
230    ets:delete(State#state.work),
231    ok.
232
233code_change(_OldVsn, State, _Extra) ->
234    {ok, State}.
235
236
237%%----------------------------------------------------------------------
238%%
239%% Gen server calls
240%%
241%%----------------------------------------------------------------------
242
243handle_call({register_client, Pid}, _From, State) ->
244    NewState = case lists:member(Pid, State#state.clients) of
245		   true -> State;
246		   _ -> State#state{clients=[Pid | State#state.clients]}
247	       end,
248    {reply, ok, NewState};
249handle_call(_Other, _From, State) ->
250    {reply, ok, State}.
251
252%%----------------------------------------------------------------------
253%%
254%% Gen server casts
255%%
256%%----------------------------------------------------------------------
257
258%% Cmd = app_ctrl | load | app | pinfo
259handle_cast({From, Cmd, Aux, OnOff, Opts}, State) ->
260    NewState = update_worklist(Cmd, Aux, From, OnOff, Opts, State),
261    {noreply, NewState};
262handle_cast(status, State) ->
263    print_state(State),
264    {noreply, State};
265handle_cast(_Other, State) ->
266    {noreply, State}.
267
268
269%%----------------------------------------------------------------------
270%%
271%% Gen server info's
272%%
273%%----------------------------------------------------------------------
274
275handle_info({do_it, Key}, State) ->
276    ok = do_work(Key, State),
277    {noreply, State};
278
279handle_info({'EXIT', Pid, Reason}, State) ->
280    case State#state.starter of
281	Pid ->
282	    {stop, Reason, State};
283	_Other ->
284	    Work = State#state.work,
285	    del_work(ets:match(Work, {{'$1','$2',Pid}, '_', '_', '_'}),
286		     Pid, Work),
287	    case lists:delete(Pid, State#state.clients) of
288		[] -> case get_opt(stay_resident, State#state.opts) of
289			  true -> {noreply, State#state{clients=[]}};
290			  _ -> {stop, normal, State}
291		      end;
292		NewClients -> {noreply, State#state{clients=NewClients}}
293	    end
294    end;
295handle_info(_Other, State) ->
296    {noreply, State}.
297
298
299%%----------------------------------------------------------------------
300%%
301%% Doing actual work
302%%
303%%----------------------------------------------------------------------
304
305do_work(Key, State) ->
306    WorkStore = State#state.work,
307    {Cmd, Aux, From, _OldRef, Old, Opts} = retrieve(WorkStore, Key),
308    {ok, Result} = do_work2(Cmd, Aux, From, Old, Opts),
309    if
310        Result==Old -> ok;
311        true ->
312            From ! {delivery, self(), Cmd, Aux, Result},
313            ok
314    end,
315    case get_opt(timeout, Opts) of
316	at_most_once ->
317	    del_task(Key, WorkStore);
318	T when is_integer(T) ->
319	    {ok, Ref} = timer:send_after(T, ?MK_DOIT(Key)),
320	    store(WorkStore, Key, Ref, Result, Opts)
321    end,
322    ok.
323
324
325%%----------------------------------------------------------------------
326%%
327%% Name: do_work2
328%%
329%% Maintenance Note: Add a clause here for each new task.
330%%
331do_work2(load, _Aux, _From, Old, Opts) ->
332    calc_load(Old, Opts);
333do_work2(app_ctrl, _Aux, _From, _Old, _Opts) ->
334    calc_app_on_node();
335do_work2(app, Aux, _From, _Old, Opts) ->
336    calc_app_tree(Aux, Opts);
337do_work2(pinfo, Aux, _From, _Old, _Opts) ->
338    calc_pinfo(pinfo, Aux);
339do_work2(Cmd, Aux, _From, _Old, _Opts) ->
340    {Cmd, Aux}.
341
342
343retrieve(Tab, Key) ->
344    case ets:lookup(Tab, Key) of
345	[{{Cmd, Aux, From}, Ref, Old, Opts}] ->
346	    {Cmd, Aux, From, Ref, Old, Opts};
347	_Other ->
348	    false
349    end.
350
351store(Tab, Key, Ref, Old, Opts) ->
352    ets:insert(Tab, {Key, Ref, Old, Opts}),
353    Key.
354
355
356%%----------------------------------------------------------------------
357%%
358%% WorkStore handling
359%%
360%%----------------------------------------------------------------------
361
362update_worklist(Cmd, Aux, From, true, Opts, State) ->
363    add_task(Cmd, Aux, From, Opts, State),
364    State;
365update_worklist(Cmd, Aux, From, _Other, _Opts, State) ->
366    del_task(Cmd, Aux, From, State#state.work),
367    State.
368
369%% First check if a task like this already exists and if so cancel its
370%% timer and make really sure that no stray do it command will come
371%% later. Then start a new timer for the task and store it i
372%% WorkStorage
373add_task(Cmd, Aux, From, Opts, State) ->
374    WorkStore = State#state.work,
375    Key = ?MK_KEY(Cmd, Aux, From, Opts),
376    OldOpts = del_task(Key, WorkStore),
377    store(WorkStore, Key, nil, nil, ins_opts(Opts, OldOpts)),
378    catch do_work(Key, State),
379    ok.
380
381%% Delete a list of tasks belonging to a pid
382del_work([[Cmd, Aux] | Ws], Pid, Work) ->
383    del_task(Cmd, Aux, Pid, Work),
384    del_work(Ws, Pid, Work);
385del_work([], _Pid, _Work) -> ok.
386
387%% Must return old options or empty list
388del_task(Cmd, Aux, From, WorkStore) ->
389    del_task(?MK_KEY(Cmd, Aux, From, []), WorkStore).
390del_task(Key, WorkStore) ->
391    OldStuff = retrieve(WorkStore, Key),
392    ets:delete(WorkStore, Key),
393    case OldStuff of
394	{_Cmd, _Aux, _From, Ref, _Old, Opts} ->
395	    if
396		Ref /= nil ->
397                    {ok,_} = timer:cancel(Ref),
398		    receive
399			{do_it, Key} ->
400			    Opts
401		    after 10 ->
402			    Opts
403		    end;
404		true -> Opts
405	    end;
406	_ ->
407	    []
408    end.
409
410
411%%
412%% Maintenance Note:
413%%
414%% Add new task implementations somewhere here below.
415%%
416
417
418%%----------------------------------------------------------------------
419%%**********************************************************************
420%%
421%%
422%% BEGIN OF calc_app_tree
423%%
424%%	App tree is the process tree shown in the application window
425%%
426%%	The top (root) pid is found by calling
427%%	application_controller:get_master(AppName) and this is done in
428%%	calc_app_on_node (before the call to calc_app_tree).
429%%
430%%	We are going to add processes to the P ets and we are doing it
431%%	in a two step process. First all prospect processes are put on
432%%	the queue Q. Then we examine the front of Q and add this
433%%	process to P if it's not already in P. Then all children of
434%%	the process is put on the queue Q and the process is repeated.
435%%
436%%	We also maintain two link ets'es, one for primary links and
437%%	one for secondary links. These databases are updated at the
438%%	same time as the queue is updated with children.
439%%
440%%**********************************************************************
441%%----------------------------------------------------------------------
442
443
444calc_app_tree(Name, Opts) ->
445    Mode = get_opt(info_type, Opts),
446    case application_controller:get_master(Name) of
447	Pid when is_pid(Pid) ->
448	    DB = new_db(Mode, Pid),
449	    GL = groupl(Pid),
450	    R = case catch do_find_proc(Mode, DB, GL, find_avoid()) of
451		    {ok, DB2} ->
452			{ok, {format(Pid),
453			      format(ets:tab2list(DB2#db.p)),
454			      format(ets:tab2list(DB2#db.links)),
455			      format(ets:tab2list(DB2#db.links2))}};
456		    {error, Reason} ->
457			{error, Reason};
458		    Other ->
459			{error, Other}
460		end,
461	    ets:delete(DB#db.p),
462	    ets:delete(DB#db.links),
463	    ets:delete(DB#db.links2),
464	    R;
465	_ ->
466	    {ok, {[], [], [], []}}
467    end.
468
469get_pid(P) when is_pid(P) -> P;
470get_pid(P) when is_port(P) -> P;
471get_pid(X) when is_tuple(X) -> element(2, X).
472
473
474%----------------------------------------------------------------------
475%%---------------------------------------------------------------------
476%% Handling process trees of processses that are linked to each other
477
478do_find_proc(Mode, DB, GL, Avoid) ->
479    case get_next(DB) of
480	{{value, V}, DB2} ->
481	    do_find_proc2(V, Mode, DB2, GL, Avoid);
482	{empty, DB2} ->
483	    {ok, DB2}
484    end.
485
486do_find_proc2(X, Mode, DB, GL, Avoid) when is_port(X) ->
487    %% There used to be a broken attempt here to handle ports,
488    %% but the rest of appmon can't handle ports, so now we
489    %% explicitly ignore ports.
490    do_find_proc(Mode, DB, GL, Avoid);
491do_find_proc2(X, Mode, DB, GL, Avoid) ->
492    Xpid = get_pid(X),
493    DB2 = case is_proc(DB, Xpid) of
494	      false ->
495		  add_proc(DB, Xpid),
496		  C1 = find_children(X, Mode),
497		  add_children(C1, Xpid, DB, GL, Avoid, Mode);
498	      _ ->
499		  DB
500	  end,
501    do_find_proc(Mode, DB2, GL, Avoid).
502
503
504%% Find children finds the children of a process. The method varies
505%% with the selected mode (sup or link) and there are also some
506%% processes that must be treated differently, notably the application
507%% master.
508%%
509find_children(X, sup) when is_pid(X) ->
510    %% This is the first (root) process of a supervision tree and it
511    %% better be a supervisor, we are smoked otherwise
512    supervisor:which_children(X);
513find_children(X, link) when is_pid(X), node(X) /= node() ->
514    [];
515find_children(X, link) when is_pid(X) ->
516    case process_info(X, links) of
517	{links, Links} ->
518	    lists:reverse(Links); % OTP-4082
519	_ -> []
520    end;
521find_children({master, X}, sup) ->
522    case application_master:get_child(X) of
523	{Pid, _Name} when is_pid(Pid) -> [Pid];
524	Pid when is_pid(Pid) -> [Pid]
525    end;
526find_children({_, _X, worker, _}, sup) -> [];
527find_children({_, X, supervisor, _}, sup) ->
528    lists:filter(fun(Thing) ->
529			 Pid = get_pid(Thing),
530			 if
531			     is_pid(Pid) -> true;
532			     true -> false
533			 end
534		 end,
535		 supervisor:which_children(X)).
536
537
538%% Add links to primary (L1) or secondary (L2) sets and return an
539%% updated queue. A link is considered secondary if its endpoint is in
540%% the queue of un-visited but known processes.
541add_children(CList, Paren, DB, _GL, _Avoid, sup) ->
542    lists:foldr(fun(C, DB2) ->
543			case get_pid(C) of
544			    P when is_pid(P) ->
545				add_prim(C, Paren, DB2);
546			    _ -> DB2 end end,
547		DB, CList);
548
549add_children(CList, Paren, DB, GL, Avoid, _Mode) ->
550    lists:foldr(fun(C, DB2) ->
551			maybe_add_child(C, Paren, DB2, GL, Avoid)
552		end, DB, CList).
553
554%% Check if the child is already in P
555maybe_add_child(C, Paren, DB, GL, Avoid) ->
556    case is_proc(DB, C) of
557	false ->
558	    maybe_add_child_node(C, Paren, DB, GL, Avoid);
559	_ -> DB					% In P: no action
560    end.
561
562%% Check if process on this node
563maybe_add_child_node(C, Paren, DB, GL, Avoid) ->
564    if
565	node(C) /= node() ->
566	    add_foreign(C, Paren, DB);
567	true ->
568	    maybe_add_child_avoid(C, Paren, DB, GL, Avoid)
569    end.
570
571%% Check if child is on the avoid list
572maybe_add_child_avoid(C, Paren, DB, GL, Avoid) ->
573    case lists:member(C, Avoid) of
574	true -> DB;
575	false ->
576	    maybe_add_child_port(C, Paren, DB, GL)
577    end.
578
579%% Check if it is a port, then it is added
580maybe_add_child_port(C, Paren, DB, GL) ->
581    if
582	is_port(C) ->
583	    add_prim(C, Paren, DB);
584	true ->
585	    maybe_add_child_sasl(C, Paren, DB, GL)
586    end.
587
588%% Use SASL stuff if present
589maybe_add_child_sasl(C, Paren, DB, GL) ->
590    case check_sasl_ancestor(Paren, C) of
591	yes ->					% Primary
592	    add_prim(C, Paren, DB);
593	no ->					% Secondary
594	    add_sec(C, Paren, DB);
595	dont_know ->
596	    maybe_add_child_gl(C, Paren, DB, GL)
597    end.
598
599%% Check group leader
600maybe_add_child_gl(C, Paren, DB, GL) ->
601    case cmp_groupl(GL, groupl(C)) of
602	true -> maybe_add_child_sec(C, Paren, DB);
603	_ -> DB
604    end.
605
606%% Check if the link should be a secondary one. Note that this part is
607%% pretty much a guess.
608maybe_add_child_sec(C, Paren, DB) ->
609    case is_in_queue(DB, C) of
610	true ->					% Yes, secondary
611	    add_sec(C, Paren, DB);
612	_ ->					% Primary link
613	    add_prim(C, Paren, DB)
614    end.
615
616check_sasl_ancestor(Paren, C) ->
617    case lists:keysearch('$ancestors', 1,
618			 element(2,process_info(C, dictionary))) of
619	{value, {_, L}} when is_list(L) ->
620	    H = if
621		    is_atom(hd(L)) -> whereis(hd(L));
622		    true -> hd(L)
623		end,
624	    if
625		H == Paren -> yes;
626		true -> no
627	    end;
628	_ -> dont_know
629    end.
630
631
632%----------------------------------------------------------------------
633%%---------------------------------------------------------------------
634%% Primitives for the database DB of all links, processes and the
635%% queue of not visited yet processes.
636
637-define(add_link(C, Paren, L), ets:insert(L, {Paren, C})).
638
639new_db(Mode, Pid) ->
640    P  = ets:new(processes, [set, public]),
641    L1 = ets:new(links, [bag, public]),
642    L2 = ets:new(extralinks, [bag, public]),
643    Q = if
644	    Mode =:= sup -> queue:in({master, Pid}, queue:new());
645	    true -> queue:in(Pid, queue:new())
646	end,
647    #db{q=Q, p=P, links=L1, links2=L2}.
648
649get_next(DB) ->
650    {X, Q} = queue:out(DB#db.q),
651    {X, DB#db{q=Q}}.
652add_proc(DB, P) ->
653    ets:insert(DB#db.p, {P}).
654add_prim(C, Paren, DB) ->
655    ?add_link(get_pid(C), Paren, DB#db.links),
656    DB#db{q=queue:in(C, DB#db.q)}.
657add_foreign(C, Paren, DB) ->
658    ?add_link(C, Paren, DB#db.links2),
659    DB#db{q=queue:in(C, DB#db.q)}.
660add_sec(C, Paren, DB) ->
661    ?add_link(C, Paren, DB#db.links2),
662    DB.
663
664is_proc(#db{p=Tab}, P) ->
665    ets:member(Tab, P).
666
667is_in_queue(#db{q=Q}, P) ->
668    queue:member(P, Q).
669
670%% Group leader handling. No processes or Links to processes must be
671%% added when group leaders differ. Note that catch all is needed
672%% because net_sup is undefined when not networked but still present
673%% in the kernel_sup child list. Blahh, didn't like that.
674groupl(P) ->
675    case process_info(P, group_leader) of
676	{group_leader, GL} -> GL;
677	_Other -> nil
678    end.
679
680cmp_groupl(_GL1, nil) -> true;
681cmp_groupl(GL1, GL1) -> true;
682cmp_groupl(_, _) -> false.
683
684
685%% Do some intelligent guessing as to cut in the tree
686find_avoid() ->
687    lists:foldr(fun(X, Accu) ->
688		       case whereis(X) of
689			   P when is_pid(P) ->
690			       [P|Accu];
691			   _ -> Accu end end,
692		[undefined],
693		[application_controller, init, gs,
694		 node_serv, appmon, appmon_a, appmon_info]).
695
696
697
698%%----------------------------------------------------------------------
699%%
700%% Formats the output strings
701%%
702%%----------------------------------------------------------------------
703format([{P} | Fs]) ->				% Process or port
704    [{P, format(P)} | format(Fs)];
705format([{P1, P2} | Fs]) ->			% Link
706    [{format(P1), format(P2)} | format(Fs)];
707format([]) -> [];
708format(P) when is_pid(P), node(P) /= node() ->
709    pid_to_list(P) ++ " " ++ atom_to_list(node(P));
710format(P) when is_pid(P) ->
711    case process_info(P, registered_name) of
712	{registered_name, Name} -> atom_to_list(Name);
713	_ -> pid_to_list(P)
714    end;
715format(P) when is_port(P) ->
716    case erlang:port_info(P, id) of
717        undefined -> "port closed";
718        {_, Pid} ->
719            "port " ++ integer_to_list(Pid)
720    end;
721format(X) ->
722    io:format("What: ~p~n", [X]),
723    "???".
724
725
726%%----------------------------------------------------------------------
727%%**********************************************************************
728%%
729%%
730%% END OF calc_app_tree
731%%
732%%
733%%**********************************************************************
734%%----------------------------------------------------------------------
735
736
737
738
739%%----------------------------------------------------------------------
740%%**********************************************************************
741%%
742%%
743%% BEGIN OF calc_app_on_node
744%%
745%%
746%%**********************************************************************
747%%----------------------------------------------------------------------
748
749%% Finds all applications on a node
750calc_app_on_node() ->
751    NewApps = reality_check(application:which_applications()),
752    {ok, NewApps}.
753
754
755reality_check([E|Es]) ->
756    N = element(1, E),
757    case catch application_controller:get_master(N) of
758        P when is_pid(P) -> [{P, N, E} | reality_check(Es)];
759        _ -> reality_check(Es)
760    end;
761reality_check([]) -> [].
762
763
764
765
766%%----------------------------------------------------------------------
767%%**********************************************************************
768%%
769%%
770%% END OF calc_app_on_node
771%%
772%%
773%%**********************************************************************
774%%----------------------------------------------------------------------
775
776
777
778%%----------------------------------------------------------------------
779%%**********************************************************************
780%%
781%%
782%% BEGIN OF calc_load
783%%
784%%
785%%**********************************************************************
786%%----------------------------------------------------------------------
787
788calc_load(Old, Opts) ->
789    L = load(Opts),
790    case get_opt(load_average, Opts) of
791	true ->
792	    case Old of
793		{_, L} -> {ok, {L, L}};
794		{_, O2} when abs(L-O2) < 3 -> {ok, {O2, L}};
795		{_, O2}	-> {ok, {O2, trunc((2*L+O2)/3)}};
796		_ -> {ok, {0, L}}
797	    end;
798	_ ->
799	    case Old of
800		{_, O2} -> {ok, {O2, L}};
801		_ -> {ok, {0, L}}
802	    end
803    end.
804
805
806load(Opts) ->
807    Q   = get_sample(queue),
808
809    case get_opt(load_method, Opts) of
810	time ->
811	    Td  = get_sample(runtime),
812	    Tot = get_sample(tot_time),
813
814	    case get_opt(load_scale, Opts) of
815		linear ->
816		    erlang:min(trunc(load_range()*(Td/Tot+Q/6)),
817			load_range());
818		prog ->
819		    erlang:min(trunc(load_range()*prog(Td/Tot+Q/6)),
820			load_range())
821	    end;
822	queue ->
823	    case get_opt(load_scale, Opts) of
824		linear ->
825		    erlang:min(trunc(load_range()*Q/6), load_range());
826		prog ->
827		    erlang:min(trunc(load_range()*prog(Q/6)), load_range())
828		end
829    end.
830
831
832%%
833%% T shall be within 0 and 0.9 for this to work correctly
834prog(T) ->
835    math:sqrt(abs(T)/0.9).
836
837
838get_sample(queue)  -> statistics(run_queue);
839get_sample(runtime)  -> {Rt,Rd} = statistics(runtime),
840			delta(runtime, Rt, Rd);
841get_sample(tot_time)  -> {Rt,Rd} = statistics(wall_clock),
842			 delta(tot_time, Rt, Rd).
843
844
845%% Keeps track of differences between calls
846%% Needed because somebody else might have called
847%% statistics/1.
848%%
849%% Note that due to wrap-arounds, we use a cheating
850%% delta which is correct unless somebody else
851%% uses statistics/1
852delta(KeyWord, Val, CheatDelta) ->
853    RetVal = case get(KeyWord) of
854		 undefined ->
855		     Val;
856		 Other ->
857		     if
858			 Other > Val ->
859			     CheatDelta;
860			 true ->
861			     Val-Other
862		     end
863	     end,
864    put(KeyWord, Val),
865    RetVal.
866
867
868load_range() -> 16.
869
870
871
872%%----------------------------------------------------------------------
873%%**********************************************************************
874%%
875%%
876%% END OF calc_load
877%%
878%%
879%%**********************************************************************
880%%----------------------------------------------------------------------
881
882
883%%----------------------------------------------------------------------
884%%**********************************************************************
885%%
886%%
887%% BEGIN OF calc_pinfo
888%%
889%%
890%%**********************************************************************
891%%----------------------------------------------------------------------
892
893calc_pinfo(pinfo, Pid) when is_pid(Pid) ->
894    Info = process_info(Pid),
895    {ok, io_lib:format("Node: ~p, Process: ~p~n~p~n~n",
896		       [node(), Pid, Info])};
897calc_pinfo(pinfo, Pid) when is_port(Pid) ->
898    Info = lists:map(fun(Key) ->erlang:port_info(Pid, Key) end,
899		     [id, name, connected, links, input, output]),
900
901    {ok, io_lib:format("Node: ~p, Port: ~p~n~p~n~n",
902		       [node(),  element(2, erlang:port_info(Pid, id)),
903			Info])};
904calc_pinfo(pinfo, _Pid) ->
905    {ok, ""}.
906
907
908%%----------------------------------------------------------------------
909%%**********************************************************************
910%%
911%%
912%% END OF calc_pinfo
913%%
914%%
915%%**********************************************************************
916%%----------------------------------------------------------------------
917
918
919
920%%----------------------------------------------------------------------
921%%
922%% Print the State
923%%
924%%	-record(state, {opts=[], work=[], clients=[]}).
925%%
926%%----------------------------------------------------------------------
927print_state(State) ->
928    io:format("Status:~n    Opts: ~p~n"
929	      "Clients: ~p~n    WorkStore:~n",
930	      [State#state.opts, State#state.clients]),
931    print_work(ets:tab2list(State#state.work)).
932
933print_work([W|Ws]) ->
934    io:format("        ~p~n", [W]), print_work(Ws);
935print_work([]) -> ok.
936
937
938%%----------------------------------------------------------------------
939%%
940%% Option handling
941%%
942%%----------------------------------------------------------------------
943
944%% The only options ever set by a user is info_type, timeout,
945%% load_scale and load_method.
946get_opt(Name, Opts) ->
947    case lists:keysearch(Name, 1, Opts) of
948	{value, Val} -> element(2, Val);
949	false -> default(Name)
950    end.
951
952%% not all options have default values
953default(info_type)	-> link;
954default(load_average)	-> true;
955default(load_method)	-> time;
956default(load_scale)	-> prog;
957default(stay_resident)	-> false;
958default(timeout)	-> 2000.
959
960ins_opts([Opt | Opts], Opts2) ->
961    ins_opts(Opts, ins_opt(Opt, Opts2));
962ins_opts([], Opts2) -> Opts2.
963
964ins_opt({Opt, Val}, [{Opt, _} | Os]) -> [{Opt, Val} | Os];
965ins_opt(Opt, [Opt2 | Os]) -> [Opt2 | ins_opt(Opt, Os)];
966ins_opt(Opt, []) -> [Opt].
967