diff options
Diffstat (limited to 'lib/runtime_tools/src')
19 files changed, 2772 insertions, 5539 deletions
diff --git a/lib/runtime_tools/src/Makefile b/lib/runtime_tools/src/Makefile index 810e3e8741..2c902952a1 100644 --- a/lib/runtime_tools/src/Makefile +++ b/lib/runtime_tools/src/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2012. All Rights Reserved. +# Copyright Ericsson AB 1999-2016. 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. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -35,20 +36,18 @@ RELSYSDIR = $(RELEASE_PATH)/lib/runtime_tools-$(VSN) # ---------------------------------------------------- MODULES= \ + appmon_info \ erts_alloc_config \ - inviso_rt \ - inviso_rt_meta \ - inviso_rt_lib \ - inviso_as_lib \ - inviso_autostart \ - inviso_autostart_server \ runtime_tools \ runtime_tools_sup \ dbg \ dyntrace \ percept_profile \ + system_information \ observer_backend \ - ttb_autostart + ttb_autostart\ + msacc + HRL_FILES= ../include/observer_backend.hrl ERL_FILES= $(MODULES:%=%.erl) @@ -73,7 +72,8 @@ EXAMPLE_FILES= \ ERL_COMPILE_FLAGS += \ -I../include \ -I ../../et/include \ - -I ../../../libraries/et/include + -I ../../../libraries/et/include \ + -Werror # ---------------------------------------------------- # Targets @@ -86,10 +86,10 @@ clean: rm -f errs core *~ $(APP_TARGET): $(APP_SRC) ../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ + $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ + $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ docs: diff --git a/lib/runtime_tools/src/appmon_info.erl b/lib/runtime_tools/src/appmon_info.erl new file mode 100644 index 0000000000..b5500085a3 --- /dev/null +++ b/lib/runtime_tools/src/appmon_info.erl @@ -0,0 +1,962 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions 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}, + ok + 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 -> + {ok,_} = 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 -> + erlang:min(trunc(load_range()*(Td/Tot+Q/6)), + load_range()); + prog -> + erlang:min(trunc(load_range()*prog(Td/Tot+Q/6)), + load_range()) + end; + queue -> + case get_opt(load_scale, Opts) of + linear -> + erlang:min(trunc(load_range()*Q/6), load_range()); + prog -> + erlang:min(trunc(load_range()*prog(Q/6)), load_range()) + end + end. + + +%% +%% 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/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl index 385047ee73..f17aa528ed 100644 --- a/lib/runtime_tools/src/dbg.erl +++ b/lib/runtime_tools/src/dbg.erl @@ -1,24 +1,26 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(dbg). -export([p/1,p/2,c/3,c/4,i/0,start/0,stop/0,stop_clear/0,tracer/0, tracer/2, tracer/3, get_tracer/0, get_tracer/1, tp/2, tp/3, tp/4, + tpe/2, ctpe/1, ctp/0, ctp/1, ctp/2, ctp/3, tpl/2, tpl/3, tpl/4, ctpl/0, ctpl/1, ctpl/2, ctpl/3, ctpg/0, ctpg/1, ctpg/2, ctpg/3, ltp/0, wtp/1, rtp/1, dtp/0, dtp/1, n/1, cn/1, ln/0, h/0, h/1]). @@ -127,7 +129,12 @@ tpl(Module, Pattern) when is_atom(Module) -> do_tp({Module, '_', '_'}, Pattern, [local]); tpl({_Module, _Function, _Arity} = X, Pattern) -> do_tp(X,Pattern,[local]). -do_tp({_Module, _Function, _Arity} = X, Pattern, Flags) + +tpe(Event, Pattern) when Event =:= send; + Event =:= 'receive' -> + do_tp(Event, Pattern, []). + +do_tp(X, Pattern, Flags) when is_integer(Pattern); is_atom(Pattern) -> case ets:lookup(get_pattern_table(), Pattern) of @@ -136,17 +143,16 @@ do_tp({_Module, _Function, _Arity} = X, Pattern, Flags) _ -> {error, unknown_pattern} end; -do_tp({Module, _Function, _Arity} = X, Pattern, Flags) when is_list(Pattern) -> +do_tp(X, Pattern, Flags) when is_list(Pattern) -> Nodes = req(get_nodes), - case Module of - '_' -> - ok; - M when is_atom(M) -> + case X of + {M,_,_} when is_atom(M) -> %% Try to load M on all nodes lists:foreach(fun(Node) -> rpc:call(Node, M, module_info, []) end, - Nodes) + Nodes); + _ -> ok end, case lint_tp(Pattern) of {ok,_} -> @@ -162,9 +168,9 @@ do_tp({Module, _Function, _Arity} = X, Pattern, Flags) when is_list(Pattern) -> end. %% All nodes are handled the same way - also the local node if it is traced -do_tp_on_nodes(Nodes, MFA, P, Flags) -> +do_tp_on_nodes(Nodes, X, P, Flags) -> lists:map(fun(Node) -> - case rpc:call(Node,erlang,trace_pattern,[MFA,P, Flags]) of + case rpc:call(Node,erlang,trace_pattern,[X,P, Flags]) of N when is_integer(N) -> {matched, Node, N}; Else -> @@ -209,13 +215,19 @@ ctpg(Module) when is_atom(Module) -> do_ctp({Module, '_', '_'}, [global]); ctpg({_Module, _Function, _Arity} = X) -> do_ctp(X,[global]). + do_ctp({Module, Function, Arity},[]) -> - do_ctp({Module, Function, Arity},[global]), + {ok,_} = do_ctp({Module, Function, Arity},[global]), do_ctp({Module, Function, Arity},[local]); do_ctp({_Module, _Function, _Arity}=MFA,Flags) -> Nodes = req(get_nodes), {ok,do_tp_on_nodes(Nodes,MFA,false,Flags)}. +ctpe(Event) when Event =:= send; + Event =:= 'receive' -> + Nodes = req(get_nodes), + {ok,do_tp_on_nodes(Nodes,Event,true,[])}. + %% %% ltp() -> ok %% List saved and built-in trace patterns. @@ -259,8 +271,7 @@ wtp(FileName) -> ok end, []), - file:close(File), - ok + ok = file:close(File) end. %% @@ -297,7 +308,12 @@ tracer(port, Port) when is_port(Port) -> start(fun() -> Port end); tracer(process, {Handler,HandlerData}) -> - start(fun() -> start_tracer_process(Handler, HandlerData) end). + start(fun() -> start_tracer_process(Handler, HandlerData) end); + +tracer(module, Fun) when is_function(Fun) -> + start(Fun); +tracer(module, {Module, State}) -> + start(fun() -> {Module, State} end). remote_tracer(port, Fun) when is_function(Fun) -> @@ -307,7 +323,13 @@ remote_tracer(port, Port) when is_port(Port) -> remote_start(fun() -> Port end); remote_tracer(process, {Handler,HandlerData}) -> - remote_start(fun() -> start_tracer_process(Handler, HandlerData) end). + remote_start(fun() -> start_tracer_process(Handler, HandlerData) end); + +remote_tracer(module, Fun) when is_function(Fun) -> + remote_start(Fun); +remote_tracer(module, {Module, State}) -> + remote_start(fun() -> {Module, State} end). + remote_start(StartTracer) -> case (catch StartTracer()) of @@ -405,7 +427,7 @@ trace_port(file, Filename) -> trace_port1(file, Filename, nowrap); trace_port(ip, Portno) when is_integer(Portno) -> - trace_port(ip,{Portno,50}); + trace_port(ip,{Portno,200}); trace_port(ip, {Portno, Qsiz}) when is_integer(Portno), is_integer(Qsiz) -> fun() -> @@ -431,10 +453,8 @@ trace_port1(file, Filename, Options) -> fun() -> Name = filename:absname(Filename), %% Absname is needed since the driver uses - %% the supplied name without further investigations, - %% and if the name is relative the resulting path - %% might be too long which can cause a bus error - %% on vxworks instead of a nice error code return. + %% the supplied name without further investigations. + %% Also, the absname must be found inside the fun, %% in case the actual node where the port shall be %% started is on another node (or even another host) @@ -544,17 +564,15 @@ c(M, F, A, Flags) -> {error,Reason} -> {error,Reason}; Flags1 -> tracer(), - {ok, Tracer} = get_tracer(), S = self(), - Pid = spawn(fun() -> c(S, M, F, A, [{tracer, Tracer} | Flags1]) end), + Pid = spawn(fun() -> c(S, M, F, A, [get_tracer_flag() | Flags1]) end), Mref = erlang:monitor(process, Pid), receive {'DOWN', Mref, _, _, Reason} -> stop_clear(), {error, Reason}; {Pid, Res} -> - erlang:demonitor(Mref), - receive {'DOWN', Mref, _, _, _} -> ok after 0 -> ok end, + erlang:demonitor(Mref, [flush]), %% 'sleep' prevents the tracer (recv_all_traces) from %% receiving garbage {'EXIT',...} when dbg i stopped. timer:sleep(1), @@ -581,7 +599,7 @@ stop() -> end. stop_clear() -> - ctp(), + {ok, _} = ctp(), stop(). %%% Calling the server. @@ -594,8 +612,7 @@ req(R) -> {'DOWN', Mref, _, _, _} -> % If server died exit(dbg_server_crash); {dbg, Reply} -> - erlang:demonitor(Mref), - receive {'DOWN', Mref, _, _, _} -> ok after 0 -> ok end, + erlang:demonitor(Mref, [flush]), Reply end. @@ -663,6 +680,9 @@ loop({C,T}=SurviveLinks, Table) -> reply(From, {error, Reason}); Tracer when is_pid(Tracer); is_port(Tracer) -> put(node(),{self(),Tracer}), + reply(From, {ok,self()}); + {Module, _State} = Tracer when is_atom(Module) -> + put(node(),{self(),Tracer}), reply(From, {ok,self()}) end; {_Relay,_Tracer} -> @@ -713,6 +733,9 @@ loop({C,T}=SurviveLinks, Table) -> {_LocalRelay,Tracer} when is_port(Tracer) -> reply(From, {error, cant_trace_remote_pid_to_local_port}), loop(SurviveLinks, Table); + {_LocalRelay,Tracer} when is_tuple(Tracer) -> + reply(From, {error, cant_trace_remote_pid_to_local_module}), + loop(SurviveLinks, Table); {_LocalRelay,Tracer} when is_pid(Tracer) -> case (catch relay(Node, Tracer)) of {ok,Relay} -> @@ -767,7 +790,8 @@ loop({C,T}=SurviveLinks, Table) -> end. reply(Pid, Reply) -> - Pid ! {dbg,Reply}. + Pid ! {dbg,Reply}, + ok. %%% A process-based tracer. @@ -782,50 +806,50 @@ tracer_init(Handler, HandlerData) -> tracer_loop(Handler, HandlerData). tracer_loop(Handler, Hdata) -> - receive - Msg -> - %% Don't match in receive to avoid giving EXIT message higher - %% priority than the trace messages. - case Msg of - {'EXIT',_Pid,_Reason} -> - ok; - Trace -> - NewData = recv_all_traces(Trace, Handler, Hdata), - tracer_loop(Handler, NewData) - end + {State, Suspended, Traces} = recv_all_traces(), + NewHdata = handle_traces(Suspended, Traces, Handler, Hdata), + case State of + done -> + exit(normal); + loop -> + tracer_loop(Handler, NewHdata) end. - -recv_all_traces(Trace, Handler, Hdata) -> - Suspended = suspend(Trace, []), - recv_all_traces(Suspended, Handler, Hdata, [Trace]). -recv_all_traces(Suspended0, Handler, Hdata, Traces) -> +recv_all_traces() -> + recv_all_traces([], [], infinity). + +recv_all_traces(Suspended0, Traces, Timeout) -> receive Trace when is_tuple(Trace), element(1, Trace) == trace -> Suspended = suspend(Trace, Suspended0), - recv_all_traces(Suspended, Handler, Hdata, [Trace|Traces]); + recv_all_traces(Suspended, [Trace|Traces], 0); Trace when is_tuple(Trace), element(1, Trace) == trace_ts -> Suspended = suspend(Trace, Suspended0), - recv_all_traces(Suspended, Handler, Hdata, [Trace|Traces]); + recv_all_traces(Suspended, [Trace|Traces], 0); Trace when is_tuple(Trace), element(1, Trace) == seq_trace -> Suspended = suspend(Trace, Suspended0), - recv_all_traces(Suspended, Handler, Hdata, [Trace|Traces]); + recv_all_traces(Suspended, [Trace|Traces], 0); Trace when is_tuple(Trace), element(1, Trace) == drop -> Suspended = suspend(Trace, Suspended0), - recv_all_traces(Suspended, Handler, Hdata, [Trace|Traces]); + recv_all_traces(Suspended, [Trace|Traces], 0); + {'EXIT', _Pid, _Reason} -> + {done, Suspended0, Traces}; Other -> %%% Is this really a good idea? io:format(user,"** tracer received garbage: ~p~n", [Other]), - recv_all_traces(Suspended0, Handler, Hdata, Traces) - after 0 -> - case catch invoke_handler(Traces, Handler, Hdata) of - {'EXIT',Reason} -> - resume(Suspended0), - exit({trace_handler_crashed,Reason}); - NewHdata -> - resume(Suspended0), - NewHdata - end + recv_all_traces(Suspended0, Traces, Timeout) + after Timeout -> + {loop, Suspended0, Traces} + end. + +handle_traces(Suspended, Traces, Handler, Hdata) -> + case catch invoke_handler(Traces, Handler, Hdata) of + {'EXIT',Reason} -> + resume(Suspended), + exit({trace_handler_crashed,Reason}); + NewHdata -> + resume(Suspended), + NewHdata end. invoke_handler([Tr|Traces], Handler, Hdata0) -> @@ -882,9 +906,9 @@ trac(Proc, How, Flags) -> end end. -trac(Node, {_Relay, Tracer}, AtomPid, How, Flags) -> +trac(Node, {_Replay, Tracer}, AtomPid, How, Flags) -> case rpc:call(Node, ?MODULE, erlang_trace, - [AtomPid, How, [{tracer, Tracer} | Flags]]) of + [AtomPid, How, [get_tracer_flag(Tracer) | Flags]]) of N when is_integer(N) -> {matched, Node, N}; {badrpc,Reason} -> @@ -920,9 +944,11 @@ do_relay(Parent,RelP) -> case RelP of {Type,Data} -> {ok,Tracer} = remote_tracer(Type,Data), - Parent ! {started,Tracer}; + Parent ! {started,Tracer}, + ok; Pid when is_pid(Pid) -> - Parent ! {started,self()} + Parent ! {started,self()}, + ok end, do_relay_1(RelP). @@ -1117,7 +1143,7 @@ transform_flags([sos|Tail],Acc) -> transform_flags(Tail,[set_on_spawn|Acc]); transform_flags([sol|Tail],Acc) -> transform_flags(Tail,[set_on_link|Acc]); transform_flags([sofs|Tail],Acc) -> transform_flags(Tail,[set_on_first_spawn|Acc]); transform_flags([sofl|Tail],Acc) -> transform_flags(Tail,[set_on_first_link|Acc]); -transform_flags([all|_],_Acc) -> all(); +transform_flags([all|_],_Acc) -> all()--[silent,running]; transform_flags([F|Tail]=List,Acc) when is_atom(F) -> case lists:member(F, all()) of true -> transform_flags(Tail,[F|Acc]); @@ -1126,9 +1152,10 @@ transform_flags([F|Tail]=List,Acc) when is_atom(F) -> transform_flags(Bad,_Acc) -> {error,{bad_flags,Bad}}. all() -> - [send,'receive',call,procs,garbage_collection,running, + [send,'receive',call,procs,ports,garbage_collection,running, set_on_spawn,set_on_first_spawn,set_on_link,set_on_first_link, - timestamp,arity,return_to]. + timestamp,monotonic_timestamp,strict_monotonic_timestamp, + arity,return_to,silent,running_procs,running_ports,exiting]. display_info([Node|Nodes]) -> io:format("~nNode ~w:~n",[Node]), @@ -1149,24 +1176,34 @@ display_info1([]) -> ok. get_info() -> - get_info(processes(),[]). + get_info(processes(),get_info(erlang:ports(),[])). +get_info([Port|T], Acc) when is_port(Port) -> + case pinfo(Port, name) of + undefined -> + get_info(T,Acc); + {name, Name} -> + get_info(T,get_tinfo(Port, Name, Acc)) + end; get_info([Pid|T],Acc) -> case pinfo(Pid, initial_call) of undefined -> get_info(T,Acc); {initial_call, Call} -> - case tinfo(Pid, flags) of - undefined -> - get_info(T,Acc); - {flags,[]} -> - get_info(T,Acc); - {flags,Flags} -> - get_info(T,[{Pid,Call,Flags}|Acc]) - end + get_info(T,get_tinfo(Pid, Call, Acc)) end; get_info([],Acc) -> Acc. +get_tinfo(P, Id, Acc) -> + case tinfo(P, flags) of + undefined -> + Acc; + {flags,[]} -> + Acc; + {flags,Flags} -> + [{P,Id,Flags}|Acc] + end. + format_trace([]) -> []; format_trace([Item]) -> [ts(Item)]; format_trace([Item|T]) -> [ts(Item) ," | ", format_trace(T)]. @@ -1191,9 +1228,22 @@ to_pidspec(X) when is_pid(X) -> true -> X; false -> {badpid,X} end; -to_pidspec(new) -> new; -to_pidspec(all) -> all; -to_pidspec(existing) -> existing; +to_pidspec(X) when is_port(X) -> + case erlang:port_info(X) of + undefined -> {badport, X}; + _ -> X + end; +to_pidspec(Tag) + when Tag =:= all; + Tag =:= ports; + Tag =:= processes; + Tag =:= new; + Tag =:= new_ports; + Tag =:= new_processes; + Tag =:= existing; + Tag =:= existing_ports; + Tag =:= existing_processes -> + Tag; to_pidspec(X) when is_atom(X) -> case whereis(X) of undefined -> {badpid,X}; @@ -1206,6 +1256,7 @@ to_pidspec(X) -> {badpid,X}. %% to_pid(X) when is_pid(X) -> X; +to_pid(X) when is_port(X) -> X; to_pid(X) when is_integer(X) -> to_pid({0,X,0}); to_pid({X,Y,Z}) -> to_pid(lists:concat(["<",integer_to_list(X),".", @@ -1220,9 +1271,12 @@ to_pid(X) when is_list(X) -> to_pid(X) -> {badpid,X}. +pinfo(P, X) when node(P) == node(), is_port(P) -> erlang:port_info(P, X); pinfo(P, X) when node(P) == node() -> erlang:process_info(P, X); +pinfo(P, X) when is_port(P) -> check(rpc:call(node(P), erlang, port_info, [P, X])); pinfo(P, X) -> check(rpc:call(node(P), erlang, process_info, [P, X])). + tinfo(P, X) when node(P) == node() -> erlang:trace_info(P, X); tinfo(P, X) -> check(rpc:call(node(P), erlang, trace_info, [P, X])). @@ -1259,6 +1313,9 @@ tc_loop(Other, _Handler, _HData) -> gen_reader(ip, {Host, Portno}) -> case gen_tcp:connect(Host, Portno, [{active, false}, binary]) of {ok, Sock} -> + %% Just in case this is on the traced node, + %% make sure the port is not traced. + p(Sock,clear), mk_reader(fun ip_read/2, Sock); Error -> exit(Error) @@ -1272,13 +1329,15 @@ gen_reader(follow_file, Filename) -> %% Opens a file and returns a reader (lazy list). gen_reader_file(ReadFun, Filename) -> - case file:open(Filename, [read, raw, binary]) of + case file:open(Filename, [read, raw, binary, read_ahead]) of {ok, File} -> mk_reader(ReadFun, File); Error -> exit({client_cannot_open, Error}) end. +-dialyzer({no_improper_lists, mk_reader/2}). + %% Creates and returns a reader (lazy list). mk_reader(ReadFun, Source) -> fun() -> @@ -1297,20 +1356,22 @@ mk_reader(ReadFun, Source) -> mk_reader_wrap([]) -> []; mk_reader_wrap([Hd | _] = WrapFiles) -> - case file:open(wrap_name(Hd), [read, raw, binary]) of + case file:open(wrap_name(Hd), [read, raw, binary, read_ahead]) of {ok, File} -> mk_reader_wrap(WrapFiles, File); Error -> exit({client_cannot_open, Error}) end. +-dialyzer({no_improper_lists, mk_reader_wrap/2}). + mk_reader_wrap([_Hd | Tail] = WrapFiles, File) -> fun() -> case read_term(fun file_read/2, File) of {ok, Term} -> [Term | mk_reader_wrap(WrapFiles, File)]; eof -> - file:close(File), + ok = file:close(File), case Tail of [_|_] -> mk_reader_wrap(Tail); @@ -1410,6 +1471,13 @@ get_tracer() -> req({get_tracer,node()}). get_tracer(Node) -> req({get_tracer,Node}). +get_tracer_flag() -> + {ok, Tracer} = get_tracer(), + get_tracer_flag(Tracer). +get_tracer_flag({Module,State}) -> + {tracer, Module, State}; +get_tracer_flag(Port = Pid) when is_port(Port); is_pid(Pid)-> + {tracer, Pid = Port}. save_pattern([]) -> 0; @@ -1790,12 +1858,12 @@ h(get_tracer) -> " - Returns the process or port to which all trace messages are sent."]); h(stop) -> help_display( - ["stop() -> stopped", + ["stop() -> ok", " - Stops the dbg server and the tracing of all processes.", " Does not clear any trace patterns."]); h(stop_clear) -> help_display( - ["stop_clear() -> stopped", + ["stop_clear() -> ok", " - Stops the dbg server and the tracing of all processes,", " and clears all trace patterns."]). diff --git a/lib/runtime_tools/src/dyntrace.erl b/lib/runtime_tools/src/dyntrace.erl index b4579fd5ce..58c5a773c3 100644 --- a/lib/runtime_tools/src/dyntrace.erl +++ b/lib/runtime_tools/src/dyntrace.erl @@ -41,6 +41,27 @@ pn/1, pn/2, pn/3, pn/4, pn/5, pn/6, pn/7, pn/8, pn/9]). -export([put_tag/1, get_tag/0, get_tag_data/0, spread_tag/1, restore_tag/1]). +-export([trace/5, + trace_procs/5, + trace_ports/5, + trace_running_procs/5, + trace_running_ports/5, + trace_call/5, + trace_send/5, + trace_receive/5, + trace_garbage_collection/5]). + +-export([enabled_procs/3, + enabled_ports/3, + enabled_running_procs/3, + enabled_running_ports/3, + enabled_call/3, + enabled_send/3, + enabled_receive/3, + enabled_garbage_collection/3, + enabled/3]). + + -export([user_trace_i4s4/9]). % Know what you're doing! -on_load(on_load/0). @@ -105,7 +126,7 @@ available() -> user_trace_s1(_Message) -> erlang:nif_error(nif_not_loaded). --spec user_trace_i4s4(iolist(), +-spec user_trace_i4s4(binary() | undefined, integer_maybe(), integer_maybe(), integer_maybe(), integer_maybe(), iolist_maybe(), iolist_maybe(), @@ -115,7 +136,7 @@ user_trace_s1(_Message) -> user_trace_i4s4(_, _, _, _, _, _, _, _, _) -> erlang:nif_error(nif_not_loaded). --spec user_trace_n(n_probe_label(), iolist(), +-spec user_trace_n(n_probe_label(), binary() | undefined, integer_maybe(), integer_maybe(), integer_maybe(), integer_maybe(), iolist_maybe(), iolist_maybe(), @@ -125,6 +146,60 @@ user_trace_i4s4(_, _, _, _, _, _, _, _, _) -> user_trace_n(_, _, _, _, _, _, _, _, _, _) -> erlang:nif_error(nif_not_loaded). +trace(_TraceTag, _TracerState, _Tracee, _TraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_procs(_TraceTag, _TracerState, _Tracee, _TraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_ports(_TraceTag, _TracerState, _Tracee, _TraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_running_procs(_TraceTag, _TracerState, _Tracee, _TraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_running_ports(_TraceTag, _TracerState, _Tracee, _TraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_call(_TraceTag, _TracerState, _Tracee, _TraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_send(_TraceTag, _TracerState, _Tracee, _TraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_receive(_TraceTag, _TracerState, _Tracee, _TraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_garbage_collection(_TraceTag, _TracerState, _Tracee, _TraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +enabled(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_procs(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_ports(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_running_procs(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_running_ports(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_call(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_send(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_receive(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_garbage_collection(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + %%% %%% Erlang support functions %%% diff --git a/lib/runtime_tools/src/erts_alloc_config.erl b/lib/runtime_tools/src/erts_alloc_config.erl index 284e88d4a7..514530332c 100644 --- a/lib/runtime_tools/src/erts_alloc_config.erl +++ b/lib/runtime_tools/src/erts_alloc_config.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% The Initial Developer of the Original Code is Ericsson AB. %% @@ -39,6 +40,8 @@ need_config_change, alloc_util, instances, + strategy, + acul, low_mbc_blocks_size, high_mbc_blocks_size, sbct, @@ -54,8 +57,6 @@ -define(SERVER, '__erts_alloc_config__'). --define(MAX_ALLOCATOR_INSTANCES, 16). - -define(KB, 1024). -define(MB, 1048576). @@ -99,23 +100,11 @@ {ets_alloc, 131072}, {fix_alloc, 131072}, {eheap_alloc, 524288}, - {ll_alloc, 2097152}, + {ll_alloc, 131072}, {sl_alloc, 131072}, {temp_alloc, 131072}, {driver_alloc, 131072}]). --define(MMMBC_DEFAULTS, - [{binary_alloc, 10}, - {std_alloc, 10}, - {ets_alloc, 10}, - {fix_alloc, 10}, - {eheap_alloc, 10}, - {ll_alloc, 0}, - {sl_alloc, 10}, - {temp_alloc, 10}, - {driver_alloc, 10}]). - - %%% %%% Exported interface %%% @@ -139,7 +128,7 @@ make_config(FileName) when is_list(FileName) -> case file:open(FileName, [write]) of {ok, IODev} -> Res = req({make_config, IODev}), - file:close(IODev), + ok = file:close(IODev), Res; Error -> Error @@ -211,9 +200,11 @@ server_loop(State) -> Conf = #conf{segments = ?MBC_MSEG_LIMIT, format_to = IODev}, Res = mk_config(Conf, State#state.alloc), - From ! {response, Ref, Res}; + From ! {response, Ref, Res}, + ok; _ -> - From ! {response, Ref, no_scenario_saved} + From ! {response, Ref, no_scenario_saved}, + ok end, State; {request, From, Ref, stop} -> @@ -230,20 +221,72 @@ server_loop(State) -> end, server_loop(NewState). -allocator_instances(temp_alloc) -> - erlang:system_info(schedulers) + 1; -allocator_instances(ll_alloc) -> +carrier_migration_support(aoff) -> + true; +carrier_migration_support(aoffcbf) -> + true; +carrier_migration_support(aoffcaobf) -> + true; +carrier_migration_support(_) -> + false. + +allocator_instances(ll_alloc, Strategy) -> + case carrier_migration_support(Strategy) of + true -> erlang:system_info(schedulers); + false -> 1 + end; +allocator_instances(_A, undefined) -> 1; -allocator_instances(_Allocator) -> - case erlang:system_info(schedulers) of - Schdlrs when Schdlrs =< ?MAX_ALLOCATOR_INSTANCES -> Schdlrs; - _Schdlrs -> ?MAX_ALLOCATOR_INSTANCES +allocator_instances(_A, _Strategy) -> + erlang:system_info(schedulers). + +strategy(temp_alloc, _AI) -> + af; +strategy(A, AI) -> + try + {A, OptList} = lists:keyfind(A, 1, AI), + {as, S} = lists:keyfind(as, 1, OptList), + S + catch + _ : _ -> + undefined end. - + +strategy_str(af) -> + "A fit"; +strategy_str(gf) -> + "Good fit"; +strategy_str(bf) -> + "Best fit"; +strategy_str(aobf) -> + "Address order best fit"; +strategy_str(aoff) -> + "Address order first fit"; +strategy_str(aoffcbf) -> + "Address order first fit carrier best fit"; +strategy_str(aoffcaobf) -> + "Address order first fit carrier adress order best fit". + +default_acul(A, S) -> + case carrier_migration_support(S) of + false -> + 0; + true -> + case A of + ll_alloc -> 85; + eheap_alloc -> 45; + _ -> 60 + end + end. + make_state() -> + {_, _, _, AI} = erlang:system_info(allocator), #state{alloc = lists:map(fun (A) -> + S = strategy(A, AI), #alloc{name = A, - instances = allocator_instances(A)} + strategy = S, + acul = default_acul(A, S), + instances = allocator_instances(A, S)} end, ?ALLOCATORS)}. @@ -345,7 +388,7 @@ do_save_scenario(AlcList) -> conf_size(Bytes) when is_integer(Bytes), Bytes < 0 -> exit({bad_value, Bytes}); conf_size(Bytes) when is_integer(Bytes), Bytes < 1*?MB -> - ?ROUNDUP(?B2KB(Bytes), 128); + ?ROUNDUP(?B2KB(Bytes), 256); conf_size(Bytes) when is_integer(Bytes), Bytes < 10*?MB -> ?ROUNDUP(?B2KB(Bytes), ?B2KB(1*?MB)); conf_size(Bytes) when is_integer(Bytes), Bytes < 100*?MB -> @@ -376,28 +419,25 @@ mmbcs(#conf{format_to = FTO}, temp_alloc -> BlocksSize; _ -> BlocksSize div Insts end, - case BS > default_mmbcs(A, Insts) of - true -> + DefMMBCS = default_mmbcs(A, Insts), + case {Insts, BS > DefMMBCS} of + {1, true} -> MMBCS = conf_size(BS), fc(FTO, "Main mbc size of ~p kilobytes.", [MMBCS]), format(FTO, " +M~cmmbcs ~p~n", [alloc_char(A), MMBCS]); - false -> + _ -> + MMBCS = ?B2KB(DefMMBCS), + fc(FTO, "Main mbc size of ~p kilobytes.", [MMBCS]), + format(FTO, " +M~cmmbcs ~p~n", [alloc_char(A), MMBCS]), ok end. -smbcs_lmbcs_mmmbc(#conf{format_to = FTO}, - #alloc{name = A, instances = Insts, segments = Segments}) -> - MMMBC = case {A, Insts} of - {_, 1} -> Segments#segment.number; - {temp_alloc, _} -> Segments#segment.number; - _ -> (Segments#segment.number div Insts) + 1 - end, +smbcs_lmbcs(#conf{format_to = FTO}, + #alloc{name = A, segments = Segments}) -> MBCS = Segments#segment.size, AC = alloc_char(A), fc(FTO, "Mseg mbc size of ~p kilobytes.", [MBCS]), format(FTO, " +M~csmbcs ~p +M~clmbcs ~p~n", [AC, MBCS, AC, MBCS]), - fc(FTO, "Max ~p mseg mbcs.", [MMMBC]), - format(FTO, " +M~cmmmbc ~p~n", [AC, MMMBC]), ok. alloc_char(binary_alloc) -> $B; @@ -462,6 +502,8 @@ au_conf_alloc(#conf{format_to = FTO} = Conf, #alloc{name = A, alloc_util = true, instances = Insts, + acul = Acul, + strategy = Strategy, low_mbc_blocks_size = Low, high_mbc_blocks_size = High} = Alc) -> fcp(FTO, "Usage of mbcs: ~p - ~p kilobytes", [?B2KB(Low), ?B2KB(High)]), @@ -470,31 +512,49 @@ au_conf_alloc(#conf{format_to = FTO} = Conf, fc(FTO, "One instance used."), format(FTO, " +M~ct false~n", [alloc_char(A)]); _ -> - fc(FTO, "~p instances used.", + fc(FTO, "~p + 1 instances used.", [Insts]), - format(FTO, " +M~ct true~n", [alloc_char(A)]) - end, + format(FTO, " +M~ct true~n", [alloc_char(A)]), + case Strategy of + undefined -> + ok; + _ -> + fc(FTO, "Allocation strategy: ~s.", + [strategy_str(Strategy)]), + format(FTO, " +M~cas ~s~n", [alloc_char(A), + atom_to_list(Strategy)]) + end, + case carrier_migration_support(Strategy) of + false -> + ok; + true -> + fc(FTO, "Abandon carrier utilization limit of ~p%.", [Acul]), + format(FTO, " +M~cacul ~p~n", [alloc_char(A), Acul]) + end + end, mmbcs(Conf, Alc), - smbcs_lmbcs_mmmbc(Conf, Alc), + smbcs_lmbcs(Conf, Alc), sbct(Conf, Alc). -large_growth(Low, High) -> - High - Low >= ?LARGE_GROWTH_ABS_LIMIT. - calc_seg_size(Growth, Segs) -> conf_size(round(Growth*?FRAG_FACT*?GROWTH_SEG_FACT) div Segs). calc_growth_segments(Conf, AlcList0) -> - CalcSmall = fun (#alloc{name = ll_alloc} = Alc, Acc) -> - {Alc#alloc{segments = #segment{size = 0, + CalcSmall = fun (#alloc{name = ll_alloc, instances = 1} = Alc, Acc) -> + {Alc#alloc{segments = #segment{size = conf_size(0), number = 0}}, Acc}; (#alloc{alloc_util = true, - low_mbc_blocks_size = Low, + instances = Insts, + low_mbc_blocks_size = LowMBC, high_mbc_blocks_size = High} = Alc, {SL, AL}) -> + Low = case Insts of + 1 -> LowMBC; + _ -> 0 + end, Growth = High - Low, - case large_growth(Low, High) of + case Growth >= ?LARGE_GROWTH_ABS_LIMIT of true -> {Alc, {SL, AL+1}}; false -> @@ -522,8 +582,13 @@ calc_growth_segments(Conf, AlcList0) -> end, CalcLarge = fun (#alloc{alloc_util = true, segments = undefined, - low_mbc_blocks_size = Low, + instances = Insts, + low_mbc_blocks_size = LowMBC, high_mbc_blocks_size = High} = Alc) -> + Low = case Insts of + 1 -> LowMBC; + _ -> 0 + end, Growth = High - Low, SegSize = calc_seg_size(Growth, SegsPerAlloc), @@ -560,15 +625,10 @@ format_header(FTO) -> case erlang:system_info(schedulers) of 1 -> ok; Schdlrs -> - MinSchdlrs = case Schdlrs > ?MAX_ALLOCATOR_INSTANCES of - true -> ?MAX_ALLOCATOR_INSTANCES; - false -> Schdlrs - end, fcp(FTO, "NOTE: This configuration was made for ~p schedulers. " - "It is very important that at least ~p schedulers " - "are used.", - [Schdlrs, MinSchdlrs]) + "It is very important that ~p schedulers are used.", + [Schdlrs, Schdlrs]) end, fcp(FTO, "This configuration is intended as a suggestion and " diff --git a/lib/runtime_tools/src/inviso_as_lib.erl b/lib/runtime_tools/src/inviso_as_lib.erl deleted file mode 100644 index 75f3d9d004..0000000000 --- a/lib/runtime_tools/src/inviso_as_lib.erl +++ /dev/null @@ -1,155 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2006-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 : inviso_as_lib.erl -%%% Author : Lennart �hman <[email protected]> -%%% Description : -%% The purpose of the inviso autostart library is to provide useful functions -%% for anyone wanting to customize the autostart mechanism in the inviso -%% tracer. It is intended to work well with the example 'inviso_autostart_server'. -%%% -%%% Created : 15 Dec 2005 by Lennart �hman -%% ----------------------------------------------------------------------------- - --module(inviso_as_lib). - --export([setup_autostart/7,setup_autostart/8,setup_autostart/9, - inhibit_autostart/1, - set_repeat/2,set_repeat_2/2]). -%% ----------------------------------------------------------------------------- - -%% setup_autostart(Node,Repeat,Options,TracerData,CmdFiles,Bindings) = ok|{error,Reason}. -%% Repeat=integer(), where 0 means no (more) autostarts. -%% Options=List of options as taken by the runtime component at start-up. -%% TracerData= Tracerdata as given to inviso_rt:init_tracing. -%% CmdFiles=[FileName,...] list of string(), files that will be executed -%% by the subprocess started during autostart. -%% Bindings=[{VarName,Value},...] Variable bindings for CmdFiles. -%% VarName=atom(), -%% -%% This function creates the inviso_autostart.config file on Erlang node Node. -%% This is useful when you wish to prepare for an autostarted trace. -setup_autostart(Node,Repeat,Options,TracerData,CmdFiles,Bindings,Translations) -> - setup_autostart(Node,Repeat,Options,TracerData,CmdFiles, - Bindings,Translations,inviso_std_ref,off). -setup_autostart(Node,Repeat,Options,TracerData,CmdFiles,Bindings,Translations,RTtag) -> - setup_autostart(Node,Repeat,Options,TracerData,CmdFiles, - Bindings,Translations,RTtag,off). -setup_autostart(Node,Repeat,Options,TracerData,CmdFiles,Bindings,Translations,RTtag,Dbg) -> - case rpc:call(Node,inviso_autostart,which_config_file,[]) of - FileName when is_list(FileName) -> % Write to this file then. - {String,Args}=format_config_file(Repeat,TracerData,Options,CmdFiles, - Bindings,Translations,RTtag,Dbg), - Bytes=list_to_binary(io_lib:format(String,Args)), - case rpc:call(Node,file,write_file,[FileName,Bytes]) of - ok -> - ok; - {error,Reason} -> - {error,{write_file,Reason}}; - {badrpc,Reason} -> - {error,{badrpc,{write_file,Reason}}} - end; - {error,Reason} -> - {error,{which_config_file,Reason}}; - {badrpc,Reason} -> - {error,{badrpc,{which_config_file,Reason}}} - end. -%% ----------------------------------------------------------------------------- - -%% inhibit_autostart(Node) = ok|{error,Reason} -%% -%% Inhibits autostart by simply making the repeat parameter zero in the -%% configuration file at node Node. All other parameters are left untouched. -inhibit_autostart(Node) -> - set_repeat(Node,0). -%% ----------------------------------------------------------------------------- - -%% set_repeat(Node,N)=ok | {error,Reason} -%% N=integer(), the number of time autostart shall be allowed. -set_repeat(Node,N) -> - case examine_config_file(Node) of - {ok,FileName,Terms} -> - NewTerms=[{repeat,N}|lists:keydelete(repeat,1,Terms)], - case rpc:call(Node,?MODULE,set_repeat_2,[FileName,NewTerms]) of - {badrpc,Reason} -> - {error,{badrpc,{open,Reason}}}; - Result -> - Result - end; - {error,Reason} -> - {error,Reason} - end. - -%% Must be a sepparate function to do rpc on. The entire function must be done -%% in one rpc call. Otherwise the FD will die since it is linked to the opening -%% process. -set_repeat_2(FileName,NewTerms) -> - case file:open(FileName,[write]) of - {ok,FD} -> - String=lists:flatten(lists:map(fun(_)->"~w.~n" end,NewTerms)), - case catch io:format(FD,String,NewTerms) of - ok -> - file:close(FD), - ok; - {'EXIT',Reason} -> - file:close(FD), - {error,{format,Reason}} - end; - {error,Reason} -> - {error,Reason} - end. -%% ----------------------------------------------------------------------------- - -examine_config_file(Node) -> - case rpc:call(Node,inviso_autostart,which_config_file,[]) of - FileName when is_list(FileName) -> % Read this file, and then modify it. - case rpc:call(Node,file,consult,[FileName]) of - {ok,Terms} -> - {ok,FileName,Terms}; - {error,Reason} -> - {error,{consult,Reason}}; - {badrpc,Reason} -> - {error,{badrpc,{consult,Reason}}} - end; - {error,Reason} -> - {error,{which_config_file,Reason}}; - {badrpc,Reason} -> - {error,{badrpc,{which_config_file,Reason}}} - end. -%% ----------------------------------------------------------------------------- - -format_config_file(Repeat,TracerData,Options,CmdFiles,Bindings,Translations,RTtag,Dbg) -> - String="~w.~n~w.~n~w.~n~w.~n", - Args=[{repeat,Repeat}, - {mfa,{inviso_autostart_server,init,[[{tracerdata,TracerData}, - {cmdfiles,CmdFiles}, - {bindings,Bindings}, - {translations,Translations}, - {debug,Dbg}]]}}, - {options,Options}, - {tag,RTtag}], - {String,Args}. -%% ----------------------------------------------------------------------------- - - - - - - - diff --git a/lib/runtime_tools/src/inviso_autostart.erl b/lib/runtime_tools/src/inviso_autostart.erl deleted file mode 100644 index 787292e244..0000000000 --- a/lib/runtime_tools/src/inviso_autostart.erl +++ /dev/null @@ -1,201 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2006-2010. 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% -%% -%% Author: Lennart �hman, [email protected] --module(inviso_autostart). - --export([autostart/1,which_config_file/0]). - -%% This module implements the default autostart module for the inviso runtime -%% component. -%% It will: -%% (1) Open the autostart configuration file (either the default or the one -%% pointed out by the runtime_tools application parameter inviso_autostart_config). -%% (2) Check that the incarnation counter has not reached 0. If so, we do not -%% allow (yet) one autostart. -%% (3) Rewrite the configuration file if there was an incarnation counter. -%% (With the counter decreased). -%% (4) Inspect the content of the configuration file and pass paramters in the -%% return value (which is interpreted by the runtime component). -%% -%% CONTENT OF A CONFIGURATION FILE: -%% A plain text file containing erlang tuple terms, each ended with a period(.). -%% The following parameters are recognized: -%% {repeat,N} N=interger(), -%% The number of remaining allowed autostart incarnations of inviso. -%% {options,Options} Options=list() -%% The options which controls the runtime component, such as overload and -%% dependency. -%% {mfa,{Mod,Func,Args}} Args=list() -%% Controls how a spy process initiating tracing, patterns and flags shall -%% be started. -%% {tag,Tag} -%% The tag identifying the runtime component to control components. -%% ============================================================================= - -%% This function is run in the runtime component's context during autostart -%% to determine whether to continue and if, then how. -autostart(_AutoModArgs) -> - ConfigFile= - case application:get_env(inviso_autostart_conf) of - {ok,FileName} when is_list(FileName) -> % Use this filename then. - FileName; - {ok,{load,FileNames,{M,F}}} -> % First load the module, then... - case try_load_module(FileNames) of - ok -> - autostart_apply(M,F); - - false -> % No such module available - "inviso_autostart.config" - end; - {ok,{M,F}} -> % Use M:F(node()) - autostart_apply(M,F); - {ok,no_autostart} -> - false; - _ -> % Use a default name, in CWD! - "inviso_autostart.config" - end, - if - is_list(ConfigFile) -> - case file:consult(ConfigFile) of - {ok,Terms} -> % There is a configuration. - case handle_repeat(ConfigFile,Terms) of - ok -> % Handled or not, we shall continue. - {get_mfa(Terms),get_options(Terms),get_tag(Terms)}; - stop -> % We are out of allowed starts. - true % Then no autostart. - end; - {error,_} -> % There is no config file - true % Then no autostart! - end; - true -> % Skip it then. - true - end. - -autostart_apply(M,F) -> - case catch M:F(node()) of - FileName when is_list(FileName) -> - FileName; - no_autostart -> % No autostart after all. - false; - _ -> - "inviso_autostart.config" - end. - -%% This function is necessary since it is not always the case that all code-paths -%% are set at the time of an autostart. -try_load_module([AbsFileName|Rest]) when is_list(AbsFileName) -> - case catch code:load_abs(AbsFileName) of % May not be a proper filename. - {module,_Mod} -> - try_load_module(Rest); - _ -> - false - end; -try_load_module([]) -> % Load all beam files successfully. - ok; -try_load_module(AbsFileName) when is_list(AbsFileName) -> - try_load_module([AbsFileName]). -%% ----------------------------------------------------------------------------- - -%% Function returning the filename probably used as autostart config file. -%% Note that this function must be executed at the node in question. -which_config_file() -> - case application:get_env(runtime_tools,inviso_autostart_conf) of - {ok,FileName} when is_list(FileName) -> % Use this filename then. - FileName; - {ok,{M,F}} -> % Use M:F(node()) - case catch M:F(node()) of - FileName when is_list(FileName) -> - FileName; - _ -> - {ok,CWD}=file:get_cwd(), - filename:join(CWD,"inviso_autostart.config") - end; - _ -> % Use a default name, in CWD! - {ok,CWD}=file:get_cwd(), - filename:join(CWD,"inviso_autostart.config") - end. -%% ----------------------------------------------------------------------------- - - -%% Help function which finds out if there is a limit on the number of times -%% we shall autostart. If there is a repeat parameter and it is greater than -%% zero, the file must be rewritten with the parameter decreased with one. -%% Returns 'ok' or 'stop'. -handle_repeat(FileName,Terms) -> - case lists:keysearch(repeat,1,Terms) of - {value,{_,N}} when N>0 -> % Controlls how many time more. - handle_repeat_rewritefile(FileName,Terms,N-1), - ok; % Indicate that we shall continue. - {value,_} -> % No we have reached the limit. - stop; - false -> % There is no repeat parameter. - ok % No restrictions then! - end. - -%% Help function which writes the configuration file again, but with the -%% repeat parameter set to NewN. -%% Returns nothing significant. -handle_repeat_rewritefile(FileName,Term,NewN) -> - case file:open(FileName,[write]) of - {ok,FD} -> - NewTerm=lists:keyreplace(repeat,1,Term,{repeat,NewN}), - handle_repeat_rewritefile_2(FD,NewTerm), - file:close(FD); - {error,_Reason} -> % Not much we can do then?! - error - end. - -handle_repeat_rewritefile_2(FD,[Tuple|Rest]) -> - io:format(FD,"~w.~n",[Tuple]), - handle_repeat_rewritefile_2(FD,Rest); -handle_repeat_rewritefile_2(_,[]) -> - true. -%% ----------------------------------------------------------------------------- - -%% Three help functions finding the parameters possible to give to the runtime -%% component. Note that some of them have default values, should the parameter -%% not exist. -get_mfa(Terms) -> - case lists:keysearch(mfa,1,Terms) of - {value,{_,MFA}} -> - MFA; - false -> - false - end. - -get_options(Terms) -> - case lists:keysearch(options,1,Terms) of - {value,{_,Options}} -> - Options; - false -> - [] - end. - -get_tag(Terms) -> - case lists:keysearch(tag,1,Terms) of - {value,{_,Tag}} -> - Tag; - false -> - default_tag - end. -%% ----------------------------------------------------------------------------- - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - diff --git a/lib/runtime_tools/src/inviso_autostart_server.erl b/lib/runtime_tools/src/inviso_autostart_server.erl deleted file mode 100644 index 1e352822f4..0000000000 --- a/lib/runtime_tools/src/inviso_autostart_server.erl +++ /dev/null @@ -1,311 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2006-2010. 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% -%% -%% Author: Lennart �hman, [email protected] -%% --module(inviso_autostart_server). --export([init/1]). - -%% ----------------------------------------------------------------------------- -%% Internal exports -%% ----------------------------------------------------------------------------- --export([cmd_file_interpreter_init/4]). -%% ----------------------------------------------------------------------------- - - -%% This module provides a (well working) example of how to program an -%% autostart server responsible for initializing trace, setting patterns -%% and flags. -%% -%% The general idea is that this code spawns interpreter processes in order to -%% execute commands concurrently. Each of the interpreter processes opens one or -%% several files (in sequence) containing erlang function calls which are evaluated -%% in the interpreter process context. -%% The argument provided to init shall be a list of options controlling -%% how to initialize tracing, which file(s) to open and variable bindings. -%% -%% This autostart_server interpreters understands standard inviso trace case files. -%% -%% The runtime component provides an API very similar to the API provided -%% by the control component. It is therefore easy to translate inviso calls to -%% inviso_rt calls. -%% -%% This process may be killed by the inviso_rt process if stop_tracing is called. -%% The reason is that there is no time limit to the interpreter processes. Hence -%% they should be killed if tracing is not possible anylonger. -%% ============================================================================= - - -%% ----------------------------------------------------------------------------- - -%% The independent autostart process spawned by the runtime component to carry -%% out initializations is spawened on this function (if using the example -%% autostart which comes with inviso). -%% ArgsFromConfig is as can be heard from the name comming from a paramater in -%% the autostart configuration file. Here it is supposed to be: -%% ArgsFromConfig=[ServerParam,...] -%% ServerParam={tracerdata,TracerData}|{cmdfiles,Files}|{bindings,Bindings}| -%% {translations,Translations}|{debug,DbgLevel} -%% TracerData=tracerdata given to inviso_rt:init_tracing/1 function. -%% Files=[FileNameSpecs,...] where each FileNameSpecs will be executed in -%% a separate process. Making each FileNameSpec parallel. -%% FileNameSpecs=[FileNameSpec,...] -%% FileNameSpec=FileName | {FileName,Bindings} -%% Bindings=[{Var,Value},...] variable environment understood by -%% erl_eval:exprs/2. -%% Translations=[Translation,...] -%% A translation file is a text-file with following tuples -%% Translation={{Mod,Func,Arity,{Mod2,Func2,ParamMF}}}| -%% {{Func,Arity,{Mod2,Func2,ParamMF}}} -%% ParamMF={M,F} | any() -%% Translates Mod:Func/Arity to Mod2:Func2 with the arguments to -%% Mod:Func translated using M:F/1. Note that ParamMF is not -%% necessarily an MF. If no translation shall be done, ParamMF -%% shall be anything else but an MF. -%% Also note that Mod is optional in a Translation. That means that -%% function calls without a module in the trace case file will -%% be translated according to that translation. -init(ArgsFromConfig) -> - case get_tracerdata_opts(ArgsFromConfig) of - {ok,TracerData} -> % Otherwise we can not start a trace! - case inviso_rt:init_tracing(TracerData) of - {ok,_Response} -> % Ok, tracing has been initiated. - case get_cmdfiles_opts(ArgsFromConfig) of - {ok,CmdFiles} -> % List of cmd-files. - Bindings=get_initialbindings_opts(ArgsFromConfig), - Translations=get_translations_opts(ArgsFromConfig), - Dbg=get_dbg_opts(ArgsFromConfig), - Procs=start_cmd_file_interpreters(CmdFiles, - Bindings, - Translations, - Dbg), - loop(Procs,Dbg); % Wait for procs to be done. - false -> % Then we can terminate normally. - true - end; - {error,Reason} -> % This is fault, lets terminate abnormally. - exit({inviso,{error,Reason}}) - end; - false -> % Then there is not much use then. - true % Just terminate normally. - end. -%% ----------------------------------------------------------------------------- - -%% Help function which starts a process for each item found in the FileNames -%% list. The idea is that each item will be processed concurrently. The items -%% them selves may be a sequence of filenames. -%% Returns a list of spawned interpret processes. -start_cmd_file_interpreters([FileNames|Rest],Bindings,Translations,Dbg) -> - P=spawn_link(?MODULE,cmd_file_interpreter_init,[FileNames,Bindings,Translations,Dbg]), - MRef=erlang:monitor(process,P), % Can't trap exits in this process. - [{P,MRef}|start_cmd_file_interpreters(Rest,Bindings,Translations,Dbg)]; -start_cmd_file_interpreters([],_,_,_) -> - []. -%% ----------------------------------------------------------------------------- - - -%% The loop where this process simply waits for all of the interpreters to be -%% done. Note that that may take som time. An interpreter may take as long time -%% necessary to do its task. -loop(Procs,Dbg) -> - receive - {'DOWN',MRef,process,Pid,_Reason} -> - case lists:keysearch(MRef,1,Procs) of - {value,{Pid,_}} -> % It was an interpreter that terminated. - case lists:keydelete(MRef,1,Procs) of - [] -> % No more interpreters. - true; % Then terminate. - NewProcs -> - loop(NewProcs,Dbg) - end; - false -> - loop(Procs,Dbg) - end; - _ -> - loop(Procs,Dbg) - end. - - -%% ----------------------------------------------------------------------------- -%% The interpret process. -%% -%% An interpreter process executes trace case files. Several interpreter processes -%% may be running in parallel. It is not within the scoop of this implementation -%% of an autostart server to solve conflicts. (You may implement your own autostart -%% server!). -%% An interpret process may run for as long as necessary. Hence the function called -%% within the trace case file can contain wait functions, waiting for a certain -%% system state to occure before continuing. -%% Note that this process also mixes global and local bindings. GlobalBindings -%% is a binding() structure, where LocalBindings is a list of {Var,Value}. -%% Further it is possible to let FileName be a {inviso,Func,Args} tuple instead. -%% ----------------------------------------------------------------------------- - -%% Init function for an interpreter process instance. -cmd_file_interpreter_init(FileNames,GlobalBindings,Translations,Dbg) -> - interpret_cmd_files(FileNames,GlobalBindings,Translations,Dbg). - -interpret_cmd_files([{FileName,LocalBindings}|Rest],GlobalBindings,Translations,Dbg) -> - Bindings=join_local_and_global_vars(LocalBindings,GlobalBindings), - interpret_cmd_files_1(FileName,Bindings,Translations,Dbg), - interpret_cmd_files(Rest,GlobalBindings,Translations,Dbg); -interpret_cmd_files([],_,_,_) -> % Done, return nothing significant! - true; -interpret_cmd_files(FileName,GlobalBindings,Translations,Dbg) -> - interpret_cmd_files_1(FileName,GlobalBindings,Translations,Dbg). -% interpret_cmd_files(Rest,GlobalBindings,Translations,Dbg). - -%% This is "inline" inviso calls. -interpret_cmd_files_1({inviso,F,Args},Bindings,Translations,Dbg) -> - {ok,Tokens1,_}=erl_scan:string("inviso:"++atom_to_list(F)++"("), - Tokens2=tokenize_args(Args), - {ok,Tokens3,_}=erl_scan:string(")."), - case erl_parse:parse_exprs(Tokens1++Tokens2++Tokens3) of - {ok,Exprs} -> - interpret_cmd_files_3(Bindings,Exprs,Translations,Dbg); - {error,_Reason} -> - error - end; -interpret_cmd_files_1({Mod,Func,Args},_Bindings,_Translations,_Dbg) -> - catch apply(Mod,Func,Args); -%% This is the case when it actually is a trace case file. -interpret_cmd_files_1(FileName,Bindings,Translations,Dbg) -> - case file:open(FileName,[read]) of - {ok,FD} -> - interpret_cmd_files_2(FD,Bindings,io:parse_erl_exprs(FD,""),Translations,Dbg), - file:close(FD); - {error,Reason} -> % Something wrong with the file. - inviso_rt_lib:debug(Dbg,interpret_cmd_files,[FileName,{error,Reason}]) - end. - -%% Help function which handles Exprs returned from io:parse_erl_exprs and -%% tries to eval them. It is the side-effects we are interested in, like -%% setting flags and patterns. Note that we will get a failure should there -%% be a variable conflict. -%% Also note that there is logic to translate control component API calls to -%% corresponding runtime component calls. -%% Returns nothing significant. -interpret_cmd_files_2(FD,Bindings,{ok,Exprs,_},Translations,Dbg) -> - {next,NewBindings}=interpret_cmd_files_3(Bindings,Exprs,Translations,Dbg), - interpret_cmd_files_2(FD,NewBindings,io:parse_erl_exprs(FD,""),Translations,Dbg); -interpret_cmd_files_2(FD,Bindings,{error,ErrorInfo,Line},Translations,Dbg) -> - inviso_rt_lib:debug(Dbg,parse_erl_exprs,[ErrorInfo,Line]), - interpret_cmd_files_2(FD,Bindings,io:parse_erl_exprs(FD,""),Translations,Dbg); -interpret_cmd_files_2(_,_,{eof,_},_,_) -> % End of file. - true. - -interpret_cmd_files_3(Bindings,Exprs,Translations,Dbg) -> - case catch inviso_rt_lib:transform(Exprs,Translations) of - NewExprs when is_list(NewExprs) -> % We may have translated the API. - case catch erl_eval:exprs(NewExprs,Bindings) of - {'EXIT',Reason} -> - inviso_rt_lib:debug(Dbg,exprs,[Exprs,Bindings,{'EXIT',Reason}]), - {next,Bindings}; - {value,_Val,NewBindings} -> % Only interested in the side effects! - {next,NewBindings} - end; - {'EXIT',Reason} -> - inviso_rt_lib:debug(Dbg,translate2runtime_funcs,[Exprs,Reason]), - {next,Bindings} - end. - -%% Help function adding variables to a bindings structure. If the variable already -%% is assigned in the structure, it will be overridden. Returns a new -%% bindings structure. -join_local_and_global_vars([{Var,Val}|Rest],Bindings) when is_atom(Var) -> - join_local_and_global_vars(Rest,erl_eval:add_binding(Var,Val,Bindings)); -join_local_and_global_vars([_|Rest],Bindings) -> - join_local_and_global_vars(Rest,Bindings); -join_local_and_global_vars([],Bindings) -> - Bindings. - -%% Help function returning a string of tokens, including "," separation -%% between the arguments. -tokenize_args(Args=[Arg|Rest]) when length(Args)>1 -> - AbsTerm=erl_parse:abstract(Arg), - Tokens=erl_parse:tokens(AbsTerm), - {ok,Token,_}=erl_scan:string(","), - Tokens++Token++tokenize_args(Rest); -tokenize_args([Arg]) -> - AbsTerm=erl_parse:abstract(Arg), - erl_parse:tokens(AbsTerm); -tokenize_args([]) -> - "". -%% ----------------------------------------------------------------------------- - - -%% ----------------------------------------------------------------------------- -%% Help functions working on the options given as argument to init during spawn. -%% ----------------------------------------------------------------------------- - -get_tracerdata_opts(ArgsFromConfig) -> - case lists:keysearch(tracerdata,1,ArgsFromConfig) of - {value,{_,{mfa,{M,F,CompleteTDGargs}}}} -> % Dynamic tracerdata. - case catch apply(M,F,CompleteTDGargs) of - {'EXIT',_Reason} -> - false; - TracerData -> - {ok,TracerData} - end; - {value,{_,TracerData}} -> % Interpret this as static tracerdata. - {ok,TracerData}; - false -> - false - end. -%% ----------------------------------------------------------------------------- - -get_cmdfiles_opts(ArgsFromConfig) -> - case lists:keysearch(cmdfiles,1,ArgsFromConfig) of - {value,{_,CmdFiles}} -> - {ok,CmdFiles}; - false -> - false - end. -%% ----------------------------------------------------------------------------- - -get_initialbindings_opts(ArgsFromConfig) -> - case lists:keysearch(bindings,1,ArgsFromConfig) of - {value,{_,Bindings}} -> - Bindings; - false -> % Then we use empty bindings. - erl_eval:new_bindings() - end. -%% ----------------------------------------------------------------------------- - -get_translations_opts(ArgsFromConfig) -> - case lists:keysearch(translations,1,ArgsFromConfig) of - {value,{_,Translations}} -> - Translations; - false -> % This becomes nearly point less. - [] - end. -%% ----------------------------------------------------------------------------- - -get_dbg_opts(ArgsFromConfig) -> - case lists:keysearch(debug,1,ArgsFromConfig) of - {value,{_,DbgLevel}} -> - DbgLevel; - false -> - off - end. -%% ----------------------------------------------------------------------------- - -%% EOF - - - diff --git a/lib/runtime_tools/src/inviso_rt.erl b/lib/runtime_tools/src/inviso_rt.erl deleted file mode 100644 index b162f5b045..0000000000 --- a/lib/runtime_tools/src/inviso_rt.erl +++ /dev/null @@ -1,2885 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2011. 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% -%% -%% Description: -%% The runtime component of the trace tool Inviso. -%% -%% Authors: -%% Ann-Marie L�f, [email protected] -%% Lennart �hman, [email protected] -%% ----------------------------------------------------------------------------- - --module(inviso_rt). - - -%% ----------------------------------------------------------------------------- -%% interface for supervisor -%% ----------------------------------------------------------------------------- --export([start_link_man/3,start_link_auto/1]). - -%% API for controll component. --export([start/4,stop/1, - init_tracing/2,stop_tracing_parallel/1, - try_to_adopt/3,confirm_connection/2,get_node_info/1, - suspend/2,call_suspend/2,cancel_suspension/1,change_options/2, - clear/2,clear_all_tp/1, - flush/1, - trace_patterns_parallel/3, - trace_flags_parallel/3,trace_flags_parallel/2,trace_flags_parallel/1, - meta_tracer_call_parallel/2, - get_status/1,get_tracerdata/1,list_logs/1,list_logs/2,fetch_log/2,fetch_log/3, - delete_log/1,delete_log/2, - state/1]). -%% ----------------------------------------------------------------------------- - -%% API mostly for autostart scripts, instead of corresponding control component -%% apis not available doing local function calls. --export([init_tracing/1,tp/4,tp/5,tp/1,tpg/4,tpg/5,tpg/1, - tpl/4,tpl/5,tpl/1, - ctp/1,ctp/3,ctpg/1,ctpg/3,ctpl/1,ctpl/3, - init_tpm/4,init_tpm/7, - tpm/4,tpm/5,tpm/8,tpm_tracer/4,tpm_tracer/5,tpm_tracer/8, - tpm_ms/5,tpm_ms_tracer/5, - ctpm_ms/4, - local_register/0,global_register/0, - ctpm/3,remove_local_register/0,remove_global_register/0, - tf/2,tf/1,ctf/2,ctf/1]). -%% ----------------------------------------------------------------------------- - -%% Internal exports. --export([init/4,auto_init/2,fetch_init/4]). -%% ----------------------------------------------------------------------------- - -%% ----------------------------------------------------------------------------- -%% Constants. -%% ----------------------------------------------------------------------------- - --define(DEFAULT_OVERLOAD_FUNC,default_overload_func). --define(NO_LOADCHECK,no_loadcheck). - --define(RT_SUP,runtime_tools_sup). % Refers to the registered name. --define(CTRL,inviso_c). % Refers to the registered name. -%% ----------------------------------------------------------------------------- - -%% ----------------------------------------------------------------------------- -%% Record definition. -%% ----------------------------------------------------------------------------- - -%% #rt -%% All record fields must be bound to listed values when leaving init or -%% auto_init. -%% dependency: Timeout accepting being without control component. -%% overload : Controlls which module to call, if any, when time for a check. -%% timer_ref: Used when timing delayed shutdown due to lost control component. --record(rt,{state = new, % new | idle | tracing - status = running, % running | {suspended, Reason} - next_loadcheck = now(), % now | "No Loadcheck" - parent, % pid() - tracerdata, % undefined|{fun(),term()}|{file,Param}|{ip,Param} - tracer_port, % port() | undefined - handler, % {fun(), term()} | undefined - auto_starter, % pid() | undefined; proc starting interpreters. - meta_tracer, % undefined | pid() - fetchers=[], % [pid(),...] processes transfering logfiles. -% spies = [], - dependency={infinity,node()}, % {TOut,Node} | TOut; TOut=int()|infinity - overload=no_loadcheck, % ?NO_LOADCHECK|{LoadMF,Interval,InitMFA,RemoveMFA} - overload_data=void, % Datastructure given to LoadMF and RemoveMFA. - timer_ref, % undefined | reference() - ctrl, % undefined | pid() - ctrl_ref, % undefined | reference() - vsn, % list() - tag % term() - }). -%% ----------------------------------------------------------------------------- - - -%% ============================================================================== -%% Start API -%% ============================================================================== - -%% Note that the runtime component may be started in many different ways. -%% It can be autostarted by the runtime_tools_sup during initial start-up of the -%% system. It is actually most likely that it will be started that way. However -%% if there are no autostart trace-cases to run, the inviso_rt runtime component -%% will terminate. It will then however remain as a child of the runtime_tools_sup -%% supervisor. This means that if the runtime component is started again, manually, -%% by the control component, some actions must be taken. -%% For instance is it very likely that the child already exists. But since it -%% must be started with different arguments when started manually, the child-spec -%% must be changed. -%% -%% The runtime component is not a proper gen_server, to allow full control of -%% what happens. It however mimcs gen_server behaviour to be managed by the -%% runtime_tools_sup supervisor. - - -%% start_link_auto(AutoModArgs)={ok,Pid} -%% -%% This function is entered into the child-spec when planning on doing autostart -%% of the runtime component. The autostart is controlled by the so called -%% inviso_autostart_mod. It is an application environment parameter of the -%% runtime_tools application. If it exists, it shall point out a module name. -%% If it does not exist, the default 'inviso_autostart' module will be tried. -%% Note that these start_link functions do not implement proper otp-behaviour. -%% For instance they return {ok,Pid} immediately making the init-phase of the -%% runtime component process empty. -%% -%% The inviso_autostart_mod shall export one function: -%% autostart(AutoModArgs) -> {MFA,Options,Tag}, where -%% AutoModArgs=term(), comes from the application start parameters in the -%% runtime_tools application resource file. -%% MFA={Mod,Func,Args} | term(). -%% If it is MFA it will cause a trace initiator process to start spawning -%% on spawn_link(Mod,Func,Args). The trace initiator may for instance -%% initiate the wanted tracing. -start_link_auto(AutoModArgs) -> - {ok,spawn_link(?MODULE,auto_init,[AutoModArgs,self()])}. -%% ------------------------------------------------------------------------------ - -%% This function is entered into the child-specification of the runtime_tools_sup -%% if the runtime component shall be started manually via the control component. -start_link_man(Ctrl,Options,Tag) -> - {ok,spawn_link(?MODULE,init,[Ctrl,Options,Tag,self()])}. -%% ------------------------------------------------------------------------------ - -%% start(Node,Options,Tag,Condition)=tbd -%% Node=The node where the runtime component shall be started. -%% Options=[Opt]; List of options to the runtime component. -%% Opt={dependency,Val}|{dependency,{Val,Node}} -%% Val=int()|infinity -%% If the runtime component may run on its own or not. Val=0 means a runtime -%% component which will terminate immediately without its control component. -%% Note that if the runtime component is started manually, the Node part -%% is never used. The runtime is supposed to be dependent of the Ctrl mentioned -%% in the start_link_man parameters. -%% Opt={overload,OverLoad} | overload -%% The latter means no loadcheck. Necessary if changing the options. -%% Overload=Iterval (int() in milliseconds) | -%% {LoadMF,Interval}|{LoadMF,Interval,InitMFA,RemoveMFA} -%% LoadMF={Mod,Func}|function() -%% InitMFA,RemoveMFA={Mod,Func,ArgList} where -%% apply(InitM,InitF,InitArgs) -> {ok,DataStruct}|'void'. -%% apply(RemoveM,RemoveF,[DataStruct|Args]) -> don't care -%% LoadMF is called each time loadcheck is performed. -%% Mod:Func(DataStruct)->ok|{suspend,Reason} -%% If just Interval is used, it means using a default overload check. -%% Tag=term(), used to identify an incarnation of a runtime component so that -%% a control component reconnecting will know if it was its own incarnation -%% still alive, or some elses. -%% Condition='if_ref'|term(). Controls if we want to adopt the runtime component. -%% If 'if_ref' is stated it means that we only want to adopt a runtime component -%% with the suggested Tag. -%% -%% This is the API used by the control component when tries to start a runtime -%% component. Note that it will try to adopt an already running, if possible. -%% Adoptions are only possible if the runtime component at hand is running -%% without control component. -start(Node, Options, Tag, Condition) when Node == node() -> - ChildSpec = {?MODULE, {?MODULE, start_link_man, [self(), Options, Tag]}, - temporary, 5000, worker, [?MODULE]}, - case catch supervisor:start_child(?RT_SUP, ChildSpec) of - {ok, Pid} when is_pid(Pid) -> - {node_info, _Node, Pid, VSN, State, Status, _Tag} = - get_node_info(Pid), - {node_info, Node, Pid, VSN, State, Status, new}; - {error, already_present} -> - supervisor:delete_child(?RT_SUP, ?MODULE), - start(Node, Options, Tag, Condition); - {error, {already_started, Pid}} -> - try_to_adopt(Pid, Tag, Condition); - {error,Reason} -> - {error,Reason}; - {'EXIT',Reason} -> - {error,Reason} - end; -start(Node, Options, Tag, Condition) -> - case rt_version(Node) of - {error,Error} -> - {error,Error}; - _VSN -> - ChildSpec = {?MODULE, {?MODULE, start_link_man, - [self(), Options, Tag]}, - temporary, 5000, worker, [?MODULE]}, - case catch rpc:call(Node, supervisor, start_child, - [?RT_SUP, ChildSpec]) of - {ok, Pid} when is_pid(Pid) -> - {node_info, _Node, Pid, - VSN, State, Status, _Tag} = get_node_info(Pid), - {node_info, Node, Pid, VSN, State, Status, new}; - {error, already_present} -> - rpc:call(Node, supervisor, delete_child, - [?RT_SUP, ?MODULE]), - start(Node, Options, Tag, Condition); - {error, {already_started, Pid}} -> - try_to_adopt(Pid, Tag, Condition); - {error,Reason} -> % Could not start child. - {error,Reason}; - {badrpc,nodedown} -> - {error,nodedown}; - {badrpc,Reason} -> - {error,{badrpc,Reason}}; - {'EXIT',Reason} -> - {error,Reason} - end - end. - -rt_version(Node) -> - case catch rpc:call(Node,application,loaded_applications,[]) of - List when is_list(List) -> - case lists:keysearch(runtime_tools,1,List) of - {value,{_,_,VSN}} -> - VSN; - false -> - {error,not_loaded} - end; - {badrpc,nodedown} -> - {error,nodedown}; - {'EXIT',Reason} -> - {error,Reason} - end. -%% ------------------------------------------------------------------------------ - -%% stop(Node)=ok|{error,Reason} -%% Stops the runtim component on node Node. Note that this is mearly calling the -%% supervisor API to shutdown the inviso_rt child belonging to the runtime_tools_sup. -stop(Node) when Node==node() -> - supervisor:terminate_child(?RT_SUP,?MODULE), - supervisor:delete_child(?RT_SUP,?MODULE), - ok; -stop(Node) -> - case catch rpc:call(Node,supervisor,terminate_child,[?RT_SUP,?MODULE]) of - ok -> - stop_delete_child(Node); - {error,_} -> % No child running. - stop_delete_child(Node); % Make sure we remove it also. - {badrpc,Reason} -> - {error,{badrpc,Reason}}; - {'EXIT',Reason} -> - {error,Reason} - end. - -stop_delete_child(Node) -> - case catch rpc:call(Node,supervisor,delete_child,[?RT_SUP,?MODULE]) of - ok -> - ok; - {error,_} -> % No child running. - ok; - {badrpc,Reason} -> - {error,{badrpc,Reason}}; - {'EXIT',Reason} -> - {error,Reason} - end. -%% ------------------------------------------------------------------------------ - - -%% ============================================================================== -%% API for the control component. -%% ============================================================================== - -%% init_tracing(TracerData) -> -%% TracerData = LogTD | [{trace,LogTD},{ti,TiTD}] -%% LogTD = {HandlerFun, Data} | collector | -%% {relayer, pid()} | {ip, IPPortParameters} | -%% {file, FilePortParameters} -%% TiTD = {file,FileName} | {file,FileName,{InitPublLD,RemovePublLD,CleanPublLD}} -%% | {relay,Node} | {relay,Node,{InitPublLD,RemovePublLD,CleanPublLD}} -%% HandlerFun=fun(TraceMsg,Data)->NewData -%% IPPortParameters = Portno | {Portno, Qsiz} -%% Qsiz = -%% FilePortParameters = {Filename, wrap, Tail, {time, WrapTime}, WrapCnt} | -%% {FileName, wrap, Tail, WrapSize, WrapCnt} | -%% {FileName, wrap, Tail, WrapSize} | -%% {FileName, wrap, Tail} | FileName -%% Defines a tracer: -%% {HandlerFun, Data} - will be used as handler inside the runtime component for -%% every incomming trace message. -%% relayer - the runtime component will relay all comming trace messages to -%% the runtime component Pid. -%% collector - the runtime component is used as tracer or collector of relayed -%% trace messages using the default handler writing them to io. -%% ip | file - will start a tracer port using PortParameters -init_tracing(Pid,TracerData) -> - call(Pid,{init_tracing,TracerData}). -%% ------------------------------------------------------------------------------ - -%% stop_tracing(RTpids)=[{Node,NodeResult},...] -%% RTpids=[RTinfo,...] -%% RTinfo={RTpid,Node} | {{error,Reason},Node} -%% NodeResult={ok,State} | {error,Reason} -%% Sends a request to stop tracing to all nodes in RTpids, in parallel. Stop -%% tracing means that all trace flags are removed and the nodes go to idle -%% state. -stop_tracing_parallel(RTpids) -> - call_parallel(lists:map(fun({Pid,Node})->{Pid,Node,stop_tracing}; - (Error)->Error - end, - RTpids)). -%% ------------------------------------------------------------------------------ - -%% try_to_adopt(Pid,NewTag,Condition)= -%% {node_info,node(),self(),VSN,State,Status,{tag,PreviousTag}}|{error,Reason} -%% NewTag=term(), the identification tag we want the runtime component to use -%% from now on if adoption was successful. -%% Condition='if_ref', only adopt if current tag is NewTag. -%% PreviousTag= the tag the runtime component had before it accepted the -%% adoption. -%% This function shall only be used by a control component wishing to adopt this -%% runtime component. -try_to_adopt(Pid, Tag, Condition) -> - call(Pid,{try_to_adopt,Tag,Condition}). -%% ------------------------------------------------------------------------------ - -%% confirm_connection(Pid,Tag)= {node_info,node(),self(),VSN,State,Status,Tag}| -%% {error,refused}. -%% Must only be used by a control component having been contacted by the runtime -%% component Pid. It confirms to the runtime component that the control component -%% has accepted the connect request. -confirm_connection(Pid,Tag) -> - call(Pid,{confirm_connection,Tag}). -%% ------------------------------------------------------------------------------ - -%% get_node_info(Pid)={node_info,Node,Pid,VSN,State,Status,Tag}. -get_node_info(Pid) -> - call(Pid,get_node_info). -%% ------------------------------------------------------------------------------ - -%% suspend(NodeOrPid,Reason)=ok -%% call_suspend(NodeOrPid,Reason)=ok -%% Makes the runtime component and all of its helpers suspend. suspend/2 is -%% assynchronous. -suspend(NodeOrPid,Reason) -> - cast(NodeOrPid,{suspend,Reason}). - -call_suspend(NodeOrPid,Reason) -> - call(NodeOrPid,{suspend,Reason}). -%% ------------------------------------------------------------------------------ - -%% cancel_suspension(Pid)=ok -%% Function moving the runtime component to status running. Regardless of its -%% current status. -cancel_suspension(Pid) -> - call(Pid,cancel_suspension). -%% ------------------------------------------------------------------------------ - -%% change_options(Pid,Options)=ok -%% Options=list(); see the start_link_XXX functions. -%% Changes options according to Options list. -%% Changing the control component we shall be depending on has no effect. The -%% dependency value in self can however be changed, and takes effect immediately. -change_options(Pid,Options) -> - call(Pid,{change_options,Options}). -%% ------------------------------------------------------------------------------ - -%% clear_all_tp(Pid)=ok -%% Function removing all, both local and global trace-patterns from the node. -clear_all_tp(Pid) -> - call(Pid,clear_all_tp). -%% ------------------------------------------------------------------------------ - -%% clear(Pid,Options)={ok,{new,Status}} -%% Options=[Opt,...] -%% Opt=keep_trace_patterns | keep_log_files -%% Resets the runtime component to state 'new' by stopping all ongoing tracing, -%% closing and removing all associated logfiles. The Options can be used to -%% prevent the runtime component from being totally erased. -clear(Pid,Options) -> - call(Pid,{clear,Options}). -%% ------------------------------------------------------------------------------ - -%% flush(Pid)=ok | {error,Reason} -%% Sends the flush command to the trace-port, if we are using a trace-port and -%% are tracing. -flush(Pid) -> - call(Pid,flush). -%% ------------------------------------------------------------------------------ - -%% trace_patterns_parallel(RTpids,Args,Flags)=[{Node,Answer},...] -%% RTpids=[{RTpid,Node},...] or [{Error,Node},...] -%% Args=[Arg,...] -%% Arg={Mod,Func,Arity,MS}|{Mod,Func,Arity,MS,Opts} -%% Mod=atom()|reg_exp()|{Dir,reg_exp()} -%% Dir=reg_exp() -%% Answer=[Answer,...] -%% Answer=int()|{error,Reason} -%% API function for the control component sending trace-patterns to a list of -%% runtime components. Returns a [{Node,Answer},...] list in the same order. -trace_patterns_parallel(RTpids,Args,Flags) -> % Same args and flags for all. - call_parallel(lists:map(fun({Pid,Node})when is_pid(Pid)->{Pid,Node,{tp,Args,Flags}}; - (Error)-> Error - end, - RTpids)). -%% ------------------------------------------------------------------------------ - -%% trace_flags_parallel(RTpids,Args,How)= -%% trace_flags_parallel(RTpidsArgs,How)= -%% trace_flags_parallel(RTpidsArgsHow)=[{Node,Reply},...] -%% RTpids=[RTpidEntry,...] -%% RTpidEntry={RTpid,Node}|{Error,Node} -%% Error=term(), any term you wish to have as reply in Answer assoc. to Node. -%% Args=[{Process,Flags},...] -%% Process=pid()|registeredname()|'all'|'new'|'existing' -%% Flags=List of the allowed process trace flags. -%% RTpidsArgs=[RTpidArgEntry,...] -%% RTpidArgEntry={RTpid,Node,Args}|{Error,Node} -%% RTpidsArgsHow=[RTpidArgsHowEntry,...] -%% RTpidArgsHowEntry={RTpid,Node,Args,How}|{Error,Node} -%% How=true|false -%% Reply={ok,Answers} -%% Answers=[Answer,...], one for each Args and in the same order. -%% Answer=int()|{error,Reason} -%% API function used by the control component to send flags to a list of runtime -%% components. Returns a list of [{Node,Answer},... ] in the same order. -trace_flags_parallel(RTpids,Args,How) -> % Same args for every node! - call_parallel(lists:map(fun({Pid,Node})when is_pid(Pid)->{Pid,Node,{tf,Args,How}}; - (Error)-> Error - end, - RTpids)). - -trace_flags_parallel(RTpidArgs,How) -> % Different args but same how. - call_parallel(lists:map(fun({Pid,Node,Args})when is_pid(Pid)-> - {Pid,Node,{tf,Args,How}}; - (Error)-> - Error - end, - RTpidArgs)). - -trace_flags_parallel(RTpidArgsHow) -> % Both different args and hows. - call_parallel(lists:map(fun({Pid,Node,Args,How})when is_pid(Pid)-> - {Pid,Node,{tf,Args,How}}; - (Error)-> - Error - end, - RTpidArgsHow)). -%% ------------------------------------------------------------------------------ - -%% meta_pattern(RTpids,Args)=[{Node,Answer},...] -%% RTpids=[{RTpid,Node},...] or [{Error,Node},...] -%% Args={FunctionName,ArgList} -%% FunctionName=atom() -%% ArgList=list(), list of the arguments to FunctionName. -%% Answer=[Answer,...] -%% Answer=int()|{error,Reason} -%% Makes a call to the meta-tracer through its runtime component. Returns a list -%% a answers in the same order as RTpids. Note that if "someone" has discovered -%% that there is an error with a particular node, the error answer can be placed -%% in the RTpids list from the start. -meta_tracer_call_parallel(RTpids,Args) -> % Same args for all nodes. - call_parallel(lists:map(fun({Pid,Node})when is_pid(Pid)-> - {Pid,Node,{meta_tracer_call,Args}}; - (Error)-> - Error - end, - RTpids)). -%% ------------------------------------------------------------------------------ - -%% get_status(Pid)={ok,{State,Status}} -%% State=new|tracing|idle -%% Status=running|{suspended,Reason} -get_status(Pid) -> - call(Pid,get_status). -%% ------------------------------------------------------------------------------ - -%% get_tracerdata(Pid)={ok,TracerData} | {ok,no_tracerdata} | {error,Reason} -%% TracerData=see init_tracing -%% Fetches the current tracerdata from the runtime component. -get_tracerdata(Pid) -> - call(Pid,get_tracerdata). -%% ------------------------------------------------------------------------------ - -%% list_log(Pid)={ok,no_log}|{ok,LogCollection}|{error,Reason} -%% list_log(Pid,TracerData)= -%% LogCollection=[LogTypes,...] -%% LogTypes={trace_log,Dir,Files}|{ti_log,Dir,Files} -%% Dir=string() -%% Files=[FileNameWithoutDir,...] -%% Lists all files associated with the current tracerdata. Or finds out which -%% files there are stored in this node given a tracerdata. -list_logs(Pid) -> - call(Pid,list_logs). -list_logs(Pid,TD) -> - call(Pid,{list_logs,TD}). -%% ------------------------------------------------------------------------------ - -%% fetch_log(Pid,CollectPid)={ok,FetcherPid}|{complete,no_log}|{error,Reason} -%% fetch_log(Pid,CollectPid,Spec)= -%% CollectPid=pid(), the process which will be given the transfered logs. -%% Spec=TracerData|LogCollection -%% Transferes a number of files using ditributed Erlang to CollectPid. This -%% function is supposed to be used internally by a control component. It returns -%% when the transfer is initiated and does not mean it is done or successful. -fetch_log(Pid,CollectPid) -> - call(Pid,{fetch_log,CollectPid}). -fetch_log(Pid,CollectPid,Spec) -> - call(Pid,{fetch_log,CollectPid,Spec}). -%% ------------------------------------------------------------------------------ - -%% delete_log(Pid,TracerDataOrLogList)={ok,Results}|{error,Reason} -%% TracerDataOrLogList=[FileNameWithPath,...]|LogCollection|TracerData -%% Results=[LogType,...] -%% LogType={trace_log,FileSpecs}|{ti_log,FilesSpecs} -%% FilesSpecs=[FileSpec,...] -%% FileSpec={ok,FileName}|{error,{Posix,FileName}} -%% Filename=string(), the filename without dir-path. -delete_log(Pid) -> - call(Pid,delete_logs). -delete_log(Pid,TracerDataOrLogList) -> - call(Pid,{delete_logs,TracerDataOrLogList}). -%% ------------------------------------------------------------------------------ - -%% state(NodeOrPid)=LoopData -%% Returns the loopdata of the runtime component. Only meant for debugging. -state(NodeOrPid) -> - call(NodeOrPid,state). -%% ------------------------------------------------------------------------------ - - -%% ============================================================================== -%% API for local calls made from the same node. E.g autostart. -%% ============================================================================== - -%% init_tracing(TracerData)= -%% See init_tracing/2. -init_tracing(TracerData) -> - call_regname(?MODULE,{init_tracing,TracerData}). -%% ------------------------------------------------------------------------------ - - -%% Meaning that these function does most often not have to be called by a -%% control component because there are more efficient ones above. - -%% tp(Module,Function,Arity,MatchSpec) -> -%% tp(Module,Function,Arity,MatchSpec,Opts) -> -%% tp(PatternList) -> -%% Module = '_'|atom()|ModRegExp|{DirRegExp,ModRegExp} -%% Function == atom() | '_' -%% Arity = integer() | '_' -%% MatchSpec = true | false | [] | matchspec() see ERTS User's guide for a -%% description of match specifications. -%% Opts=list(); 'only_loaded' -%% PatternList = [Pattern], -%% Pattern = {Module,Function,Arity,MatchSpec,Opts}, -%% Set trace pattern (global). -tp(Module,Function,Arity,MatchSpec) -> - tp(Module,Function,Arity,MatchSpec,[]). -tp(Module,Function,Arity,MatchSpec,Opts) -> - call_regname(?MODULE,{tp,[{Module,Function,Arity,MatchSpec,Opts}],[global]}). -tp(PatternList) -> - call_regname(?MODULE,{tp,PatternList,[global]}). -%% ------------------------------------------------------------------------------ - -tpg(Mod,Func,Arity,MatchSpec) -> - tp(Mod,Func,Arity,MatchSpec). -tpg(Mod,Func,Arity,MatchSpec,Opts) -> - tp(Mod,Func,Arity,MatchSpec,Opts). -tpg(PatternList) -> - tp(PatternList). -%% ------------------------------------------------------------------------------ - -%% tpl(Module,Function,Arity,MatchSpec) -> -%% tpl(Module,Function,Arity,MatchSpec,Opts) -> -%% tpl(PatternList) -> -%% Module = Function == atom() | '_' | RegExpMod | {RegExpDir,RegExpMod} -%% Arity = integer() | '_' -%% MatchSpec = true | false | [] | matchspec() see ERTS User's guide for a -%% Opts=list(); 'only_loaded' -%% description of match specifications. -%% PatternList = [Pattern], -%% Pattern = {Module, Function, Arity, MatchSpec}, -%% Set trace pattern (local). -tpl(Module,Function,Arity,MatchSpec) -> - call_regname(?MODULE,{tp,[{Module,Function,Arity,MatchSpec,[]}],[local]}). -tpl(Module,Function,Arity,MatchSpec,Opts) -> - call_regname(?MODULE,{tp,[{Module,Function,Arity,MatchSpec,Opts}],[local]}). -tpl(PatternList) -> - call_regname(?MODULE,{tp,PatternList,[local]}). -%% ------------------------------------------------------------------------------ - -%% ctp(Module,Function,Arity) -> -%% ctp(PatternList)= -%% Module = atom()|'_'|RegExpMod|{RegExpDir,RegExpMod} -%% Function == atom() | '_' -%% Arity = integer() | '_' -%% PatternList=[{Mod,Func,Arity},...] -%% Clear trace pattern (global). -%% Note that it is possible to clear patterns using regexps. But we can for -%% natural reasons only clear patterns for loaded modules. Further more there -%% seems to be a fault in the emulator (<=R10B) crashing if we remove patterns -%% for deleted modules. Therefore we use the only_loaded option. -ctp(Module,Function,Arity) -> - call_regname(?MODULE,{tp,[{Module,Function,Arity,false,[only_loaded]}],[global]}). -ctp(PatternList) -> - call_regname(?MODULE, - {tp, - lists:map(fun({M,F,A})->{M,F,A,false,[only_loaded]} end,PatternList), - [global]}). -%% ------------------------------------------------------------------------------ - -ctpg(Mod,Func,Arity) -> - ctp(Mod,Func,Arity). -ctpg(PatternList) -> - ctp(PatternList). -%% ------------------------------------------------------------------------------ - -%% ctpl(Module,Function,Arity) -> -%% Module = atom()|'_'|RegExpMod|{RegExpDir,RegExpMod} -%% Function == atom() | '_' -%% Arity = integer() | '_' -%% PatternList=[{Mod,Func,Arity},...] -%% Clear trace pattern (local). -ctpl(Module,Function,Arity) -> - call_regname(?MODULE,{tp,[{Module,Function,Arity,false,[only_loaded]}],[local]}). -ctpl(PatternList) -> - call_regname(?MODULE, - {tp, - lists:map(fun({M,F,A})->{M,F,A,false,[only_loaded]} end,PatternList), - [local]}). -%% ------------------------------------------------------------------------------ - -init_tpm(Mod,Func,Arity,CallFunc) -> - call_regname(?MODULE,{meta_tracer_call,{init_tpm,[Mod,Func,Arity,CallFunc]}}). - -init_tpm(Mod,Func,Arity,InitFunc,CallFunc,ReturnFunc,RemoveFunc) -> - call_regname(?MODULE, - {meta_tracer_call, - {init_tpm, - [Mod,Func,Arity,InitFunc,CallFunc,ReturnFunc,RemoveFunc]}}). -%% ------------------------------------------------------------------------------ - -tpm(Mod,Func,Arity,MS) -> - call_regname(?MODULE,{meta_tracer_call,{tpm,[Mod,Func,Arity,MS]}}). -tpm(Mod,Func,Arity,MS,CallFunc) -> - call_regname(?MODULE,{meta_tracer_call,{tpm,[Mod,Func,Arity,MS,CallFunc]}}). -tpm(Mod,Func,Arity,MS,InitFunc,CallFunc,ReturnFunc,RemoveFunc) -> - call_regname(?MODULE, - {meta_tracer_call, - {tpm, - [Mod,Func,Arity,MS,InitFunc,CallFunc,ReturnFunc,RemoveFunc]}}). -%% ------------------------------------------------------------------------------ - -tpm_tracer(Mod,Func,Arity,MS) -> - call_regname(?MODULE,{meta_tracer_call,{tpm_tracer,[Mod,Func,Arity,MS]}}). -tpm_tracer(Mod,Func,Arity,MS,CallFunc) -> - call_regname(?MODULE,{meta_tracer_call,{tpm_tracer,[Mod,Func,Arity,MS,CallFunc]}}). -tpm_tracer(Mod,Func,Arity,MS,InitFunc,CallFunc,ReturnFunc,RemoveFunc) -> - call_regname(?MODULE, - {meta_tracer_call, - {tpm_tracer, - [Mod,Func,Arity,MS,InitFunc,CallFunc,ReturnFunc,RemoveFunc]}}). -%% ------------------------------------------------------------------------------ - -tpm_ms(Mod,Func,Arity,MSname,MS) -> - call_regname(?MODULE,{meta_tracer_call,{tpm_ms,[Mod,Func,Arity,MSname,MS]}}). -%% ------------------------------------------------------------------------------ - -tpm_ms_tracer(Mod,Func,Arity,MSname,MS) -> - call_regname(?MODULE,{meta_tracer_call,{tpm_ms_tracer,[Mod,Func,Arity,MSname,MS]}}). -%% ------------------------------------------------------------------------------ - -ctpm_ms(Mod,Func,Arity,MSname) -> - call_regname(?MODULE,{meta_tracer_call,{ctpm_ms,[Mod,Func,Arity,MSname]}}). -%% ------------------------------------------------------------------------------ - -local_register() -> - call_regname(?MODULE,{meta_tracer_call,{local_register,[]}}). -%% ------------------------------------------------------------------------------ - -global_register() -> - call_regname(?MODULE,{meta_tracer_call,{global_register,[]}}). -%% ------------------------------------------------------------------------------ - -ctpm(Mod,Func,Arity) -> - call_regname(?MODULE,{meta_tracer_call,{ctpm,[Mod,Func,Arity]}}). -%% ------------------------------------------------------------------------------ - -remove_local_register() -> - call_regname(?MODULE,{meta_tracer_call,{remove_local_register,[]}}). -%% ------------------------------------------------------------------------------ - -remove_global_register() -> - call_regname(?MODULE,{meta_tracer_call,{remove_global_register,[]}}). -%% ------------------------------------------------------------------------------ - -%% tf(PidSpec, FlagList) -> -%% tf(TraceConfList) -> -%% TraceConfList = [{PidSpec, FlagList}], -%% FlagList = [Flags], -%% PidSpec = all | new | existing | pid() | registeredname() -%% Flags = all | send | 'receive' | procs | call | silent | return_to | -%% running | garbage_collection | timestamp | cpu_timestamp | arity | -%% set_on_spawn | set_on_first_spawn | set_on_link | set_on_first_link -%% Set trace flags. -tf(PidSpec, FlagList) -> - call_regname(?MODULE,{tf,[{PidSpec,FlagList}],true}). - -tf(TraceConfList) -> - call_regname(?MODULE,{tf,TraceConfList,true}). -%% ------------------------------------------------------------------------------ - -%% ctf(PidSpec, FlagList) -> -%% ctf(TraceConfList) -> -%% TraceConfList = [{PidSpec, FlagList}], -%% FlagList = [Flags], -%% PidSpec = all | new | existing | pid() | registeredname() -%% Flags = all | send | 'receive' | procs | call | silent | return_to | -%% running | garbage_collection | timestamp | cpu_timestamp | arity | -%% set_on_spawn | set_on_first_spawn | set_on_link | set_on_first_link -%% Clear trace flags. -ctf(PidSpec, FlagList) -> - call_regname(?MODULE,{tf,[{PidSpec,FlagList}],false}). - -ctf(TraceConfList) -> - call_regname(?MODULE,{tf_as,TraceConfList,false}). -%% ------------------------------------------------------------------------------ - - -%% ------------------------------------------------------------------------------ -%% Client side functions. -%% ------------------------------------------------------------------------------ - -%% Call function managing the client to server communication. This function may -%% be run by a client on a different node. -%% Note that we must use two different functions for calling a named process and -%% calling the runtime component at a specified node. -call(Pid,Request) when is_pid(Pid) -> - call_2(Pid,Request); -call(Node,Request) when Node==node() -> % To our node! - call_2(?MODULE,Request); -call(Node,Request) when is_atom(Node) -> - call_2({?MODULE,Node},Request); -call(To,_Request) -> - {error,{badarg,To}}. - -call_regname(Name,Request) when is_atom(Name) -> % To a registered name. - call_2(Name,Request). - -call_2(To,Request) -> - MRef=erlang:monitor(process,To), % Use a monitor to avoid waiting for ever. - Ref=make_ref(), - case catch To ! {Request,self(),Ref} of % Can be a remote pid. - {'EXIT',_} -> % If we use registered name. - erlang:demonitor(MRef), % Maybe not necessary!? - receive - {'DOWN',MRef,_Type,_Obj,_Info} -> - true - after - 0 -> - true - end, - {error,not_started}; - _ -> % At least no obvious error. - receive - {Msg,Ref} -> - erlang:demonitor(MRef), - Msg; - {'DOWN',MRef,_Type,_Obj,Info} -> % The runtime component disapeared. - {error,{no_response,Info}} - end - end. -%% ----------------------------------------------------------------------------- - -%% Multicall function taking a list of [{Pid,Node,Request},...] and sends -%% a request to every Pid. This function then also allows you to send multiple -%% requests to the same Pid since it will sit and wait for all replies. -%% Note that RTspec may also be an [{{error,Reason},Node},...]. That tuple will -%% then be used as reply in the reply list. -%% Returns [{Node,Reply},...] for every element in RTspec, in the same order. -call_parallel(RTspec) -> - Ref=make_ref(), - {Nr,Pending}=call_parallel_2(RTspec,Ref,0,[]), - Replies=call_parallel_3(Ref,Pending,Nr,[],[]), - call_parallel_build_reply(RTspec,1,Replies). - -call_parallel_2([{Pid,Node,Request}|Rest],Ref,Nr,Pending) when is_pid(Pid) -> - Pid ! {Request,self(),{Ref,Nr+1}}, - MRef=erlang:monitor(process,Pid), % So we won't wait for ever for it. - call_parallel_2(Rest,Ref,Nr+1,[{Nr+1,Node,MRef}|Pending]); -call_parallel_2([{{error,_Reason},_Node}|Rest],Ref,Nr,Pending) -> - call_parallel_2(Rest,Ref,Nr,Pending); % Just skip it. This is no process. -call_parallel_2([_Faulty|Rest],Ref,Nr,Pending) -> % Should not happend. - call_parallel_2(Rest,Ref,Nr,Pending); % But we choose to skip it instead of crash. -call_parallel_2([],_,Nr,Pending) -> - {Nr,Pending}. - -%% Help function collecting reply-messages sent from the runtime components. We -%% count down until we got a reply for every pending request. Or if we get a DOWN -%% message indicating that the runtime component is no longer present. Note that -%% we can by accident read away DOWN messages not belonging to this procedure. -%% They are collected to be reissued after we are done. -call_parallel_3(_Ref,_Pending,0,Replies,DownMsgs) -> % All expected received. - lists:foreach(fun({MRef,Pid,Info}) -> self() ! {'DOWN',MRef,process,Pid,Info} end, - DownMsgs), % Reissue the down messages! - Replies; -call_parallel_3(Ref,Pending,NrOfPending,Replies,DownMsgs) -> - receive - {Reply,{Ref,Nr}} -> - case lists:keysearch(Nr,1,Pending) of - {value,{_Nr,Node,MRef}} -> - erlang:demonitor(MRef), - call_parallel_3(Ref,Pending,NrOfPending-1, - [{Nr,Node,Reply}|Replies],DownMsgs); - false -> % Really strange! - call_parallel_3(Ref,Pending,NrOfPending,Replies,DownMsgs) - end; - {'DOWN',MRef,process,Pid,Info} -> % Probably process we monitor terminated. - case lists:keysearch(MRef,3,Pending) of - {value,{Nr,Node,_}} -> % Yes it was one of our processes. - call_parallel_3(Ref,Pending,NrOfPending-1, - [{Nr,Node,{error,no_reponse}}|Replies],DownMsgs); - false -> % We picked up a DOWN msg by misstake. - call_parallel_3(Ref,Pending,NrOfPending,Replies, - [{MRef,Pid,Info}|DownMsgs]) - end - end. - -%% Help function which build up the [{Node,Reply},...] list in the same order as RTspec. -call_parallel_build_reply([],_,_) -> - []; -call_parallel_build_reply([{Pid,Node,_Request}|Rest],Nr,Replies) when is_pid(Pid) -> - {value,{_Nr,_Node,Reply}}=lists:keysearch(Nr,1,Replies), - [{Node,Reply}|call_parallel_build_reply(Rest,Nr+1,Replies)]; -call_parallel_build_reply([{{error,Reason},Node}|Rest],Nr,Replies) -> - [{Node,{error,Reason}}|call_parallel_build_reply(Rest,Nr,Replies)]; -call_parallel_build_reply([_Faulty|Rest],Nr,Replies) -> - call_parallel_build_reply(Rest,Nr,Replies). -%% ------------------------------------------------------------------------------ - -cast(Pid,Request) when is_pid(Pid) -> - cast2(Pid,Request); -cast(Node,Request) when Node==node() -> - catch cast2(?MODULE,Request), - ok; -cast(Node,Request) when is_atom(Node) -> - catch cast2({?MODULE,Node},Request), - ok; -cast(BadAddress,_Request) -> - {error,{badarg,BadAddress}}. - -cast2(To,Request) -> - To ! {Request,void,void}. % Mimics the call protocol. -%% ------------------------------------------------------------------------------ - - -%% ============================================================================== -%% Implementation of the runtime component (server side). -%% ============================================================================== - -%% Since the runtime component is not implemented using gen_sever we are "free" -%% to use what ever functionnames we like. - -%% Initial function on which the runtime component is spawned on if started by -%% a controlcomponent. -init(Ctrl, Options, Tag, Parent) when is_list(Options) -> - %% started from controller - process_flag(trap_exit,true), - register(?MODULE,self()), % Will crash if rt is already running - do_clear_trace_patterns(), % Remove potential old patterns left. - LD1=read_option_list(Options, - #rt{state=new, - parent=Parent, - ctrl=Ctrl, - vsn=get_application_vsn(), - tag=Tag}), - OverloadData=initialize_overload(LD1), - CtrlRef=erlang:monitor(process,Ctrl), % Monitor our control component. - loop1(LD1#rt{ctrl_ref=CtrlRef,overload_data=OverloadData}). -%% ---------------------------------------------------------------------------- - -%% Initial function on which the runtime component is spawned on if started -%% by the runtime_tools supervisor. It is here it is determined if we shall -%% autostart. -auto_init(AutoModArgs,Parent) -> - %% autostart - process_flag(trap_exit, true), - register(?MODULE, self()), % Will crash if a rt is already running - AutoMod=get_autostart_module(), % Determine which module to use! - case catch AutoMod:autostart(AutoModArgs) of - {MFA,Options,Tag} -> - do_clear_trace_patterns(), % Remove previously left patterns. - LD1=read_option_list(Options,#rt{state=new, - parent=Parent, - vsn=get_application_vsn(), - tag=Tag}), - case auto_init_connect_control(LD1) of - {ok,LD2} -> % Either connected or running_alone. - OverloadData=initialize_overload(LD2), - case auto_init_check_mfa(MFA) of - {ok,{M,F,A}} -> % We shall start somekind of tracing! - P=spawn_link(M,F,A), % It lives its own life, only link! - loop1(LD2#rt{auto_starter=P,overload_data=OverloadData}); - false -> - loop1(LD2#rt{overload_data=OverloadData}) - end; - stop -> % Not allowed to run alone! - true % Simply terminate. - end; - _ -> % Non existent or faulty autostart mod! - true % Terminate normally. - end. - -auto_init_connect_control(LD1) -> - case auto_init_connect_find_pid(LD1#rt.dependency) of - Pid when is_pid(Pid) -> % There is a control component. - CtrlRef=erlang:monitor(process,Pid), - Pid ! {connect,node(),self(),LD1#rt.vsn,LD1#rt.tag}, - {ok,LD1#rt{ctrl_ref=CtrlRef,ctrl=Pid}}; - _ -> % There is no control component. - do_down_message(LD1) % Will return 'stop' or a LoopData. - end. - -%% Help function which finds the pid of the control component. -auto_init_connect_find_pid({_TimeOut,Node}) when Node==node() -> - whereis(?CTRL); -auto_init_connect_find_pid({_TimeOut,Node}) when is_atom(Node) -> - rpc:call(Node,erlang,whereis,[?CTRL]); -auto_init_connect_find_pid(_) -> % Node is not a proper node. - undefined. % Act as could not find control comp. - -%% Help function checking that the parameter is reasonable to be used as -%% spawn_link argument. -auto_init_check_mfa({M,F,A}) when is_atom(M),is_atom(F),is_list(A) -> - {ok,{M,F,A}}; -auto_init_check_mfa(_) -> - false. - -%% Help function to init_auto which finds out which module to call for -%% guidance on how to proceed. Returns an atom. -get_autostart_module() -> - case application:get_env(inviso_autostart_mod) of - {ok,Mod} when is_atom(Mod) -> - Mod; - _ -> - inviso_autostart % The default autostart module. - end. -%% ---------------------------------------------------------------------------- - - -%% This is the preloop function which performs loadcheck if necessary. Note -%% that it calculates the timeout used in the after in the real loop. There is -%% further no use doing overload checks if we are not tracing or already -%% suspended. There is yet one more situation, we do not want to perform -%% overload checks if the interval is set to infinity. This can be the case if -%% we are using an external source pushing overload information instead. -loop1(LD=#rt{overload=Overload}) -> - if - Overload/=?NO_LOADCHECK,element(2,Overload)/=infinity -> - Now=now(), - if - LD#rt.status==running, - LD#rt.state==tracing, - Now>LD#rt.next_loadcheck -> % Do loadcheck only then! - {NewLD,TimeOut}=do_check_overload(LD,{timeout,LD#rt.overload_data}), - loop(NewLD,TimeOut); - LD#rt.status==running,LD#rt.state==tracing -> - Timeout=calc_diff_to_now(Now,LD#rt.next_loadcheck), - loop(LD,Timeout); - true -> % Do not spend CPU on this! :-) - loop(LD,infinity) - end; - true -> % Either no check or infinity. - loop(LD,infinity) - end. - -loop(LoopData,Timeout) -> - receive - Msg when element(1,Msg)==trace_ts; - element(1,Msg)==trace; - element(1,Msg)==drop; - element(1,Msg)==seq_trace -> - case LoopData#rt.handler of - {HandlerFun,Data} -> - NewData=HandlerFun(Msg,Data), - loop1(LoopData#rt{handler={HandlerFun,NewData}}); - _ -> - loop1(LoopData) - end; - {{tp,Args,Flags},From,Ref} -> - if - LoopData#rt.status==running -> % Not when suspended. - Reply=do_set_trace_patterns(Args,Flags), - if - LoopData#rt.state==new -> % No longer new when tp set. - reply_and_loop({ok,Reply},From,Ref,LoopData#rt{state=idle}); - true -> - reply_and_loop({ok,Reply},From,Ref,LoopData) - end; - true -> % We are suspended! - reply_and_loop({error,suspended},From,Ref,LoopData) - end; - {{tf,Args,How},From,MRef} -> - Reply= - case How of - true -> - if - LoopData#rt.status==running -> - case {LoopData#rt.tracer_port,LoopData#rt.handler} of - {Port,_} when is_port(Port) -> - do_set_trace_flags(Port,Args,How); - {_,{Handler,_D}} when is_function(Handler) -> - do_set_trace_flags(self(),Args,How); - _ -> - {error,no_tracer} - end; - true -> % Can't turn *on* flags if suspended. - {error, suspended} - end; - false -> % No tracer needed when turning off. - do_set_trace_flags(void,Args,How) - end, - reply_and_loop(Reply,From,MRef,LoopData); - {{meta_tracer_call,Args},From,MRef} -> - if - LoopData#rt.status==running -> - case LoopData#rt.meta_tracer of - MPid when is_pid(MPid) -> - Reply=do_meta_pattern(MPid,Args), - reply_and_loop(Reply,From,MRef,LoopData); - _ -> - reply_and_loop({error,no_metatracer},From,MRef,LoopData) - end; - true -> - reply_and_loop({error,suspended},From,MRef,LoopData) - end; - {clear_all_tp,From,MRef} -> - do_clear_trace_patterns(), - reply_and_loop(ok,From,MRef,LoopData); - {{init_tracing,TracerData},From,MRef} -> - {NewLoopData,Reply}= - if - LoopData#rt.status==running -> - if - LoopData#rt.state==tracing -> - {LoopData,{error,already_initiated}}; - true -> % Otherwise, try to init-tracing! - case translate_td(TracerData) of - {ok,LogTD,MetaTD} -> - do_init_tracing(LoopData,TracerData,LogTD,MetaTD); - Error -> - {LoopData,Error} - end - end; - true -> % Can't init tracing if not running. - {LoopData,{error,suspended}} - end, - reply_and_loop(Reply,From,MRef,NewLoopData); - {stop_tracing,From,MRef} -> - case LoopData#rt.state of - tracing -> % Only case we need to do anything. - reply_and_loop({ok,idle},From,MRef,do_stop_tracing(LoopData)); - idle -> % Already idle! - reply_and_loop({ok,idle},From,MRef,LoopData); - new -> % Have actually never traced! - reply_and_loop({ok,new},From,MRef,LoopData) - end; - {{suspend,Reason},From,MRef} -> - if - LoopData#rt.status==running -> - NewLD=do_suspend(LoopData,Reason), - reply_and_loop(ok,From,MRef,NewLD); - true -> % No need suspend if not running! - reply_and_loop(ok,From,MRef,LoopData) - end; - {cancel_suspension,From,MRef} -> - NewLoopData=LoopData#rt{status=running,next_loadcheck=now()}, - send_event(state_change,NewLoopData), - reply_and_loop(ok,From,MRef,NewLoopData); - {{clear,Options},From,MRef} -> - NewLoopData=do_clear(LoopData,Options), - reply_and_loop({ok,{new,NewLoopData#rt.status}},From,MRef,NewLoopData); - {flush,From,MRef} -> - case LoopData#rt.state of - tracing -> % Can only flush if we are tracing. - if - is_port(LoopData#rt.tracer_port) -> - trace_port_control(LoopData#rt.tracer_port,flush), - reply_and_loop(ok,From,MRef,LoopData); - true -> % Not necessary but lets pretend. - reply_and_loop(ok,From,MRef,LoopData) - end; - State -> - reply_and_loop({error,{not_tracing,State}},From,MRef,LoopData) - end; - {list_logs,From,MRef} -> - TracerData=LoopData#rt.tracerdata, % Current tracerdata. - if - TracerData/=undefined -> % There is tracerdata! - reply_and_loop(do_list_logs(TracerData),From,MRef,LoopData); - true -> % Have no current tracerdata! - reply_and_loop({error,no_tracerdata},From,MRef,LoopData) - end; - {{list_logs,TracerData},From,MRef} -> - reply_and_loop(do_list_logs(TracerData),From,MRef,LoopData); - {{fetch_log,CollectPid},From,MRef} -> % Fetch according to current tracerdata. - TracerData=LoopData#rt.tracerdata, % Current tracerdata. - if - TracerData/=undefined -> % There is tracerdata! - {Reply,NewLD}=do_fetch_log(LoopData,CollectPid,TracerData), - reply_and_loop(Reply,From,MRef,NewLD); - true -> % No tracerdata! - reply_and_loop({error,no_tracerdata},From,MRef,LoopData) - end; - {{fetch_log,CollectPid,Spec},From,MRef} -> % Either list of files or tracerdata. - {Reply,NewLD}=do_fetch_log(LoopData,CollectPid,Spec), - reply_and_loop(Reply,From,MRef,NewLD); - {delete_logs,From,MRef} -> - if - LoopData#rt.state==tracing -> % Can't remove then! - reply_and_loop({error,tracing},From,MRef,LoopData); - true -> - TracerData=LoopData#rt.tracerdata, - reply_and_loop(do_delete_logs(TracerData),From,MRef,LoopData) - end; - {{delete_logs,TracerDataOrLogList},From,MRef} -> - if - LoopData#rt.state==tracing -> % Can't remove then! - reply_and_loop({error,tracing},From,MRef,LoopData); - true -> - reply_and_loop(do_delete_logs(TracerDataOrLogList),From,MRef,LoopData) - end; - {get_node_info,From,MRef} -> - Reply=collect_node_info(LoopData), - reply_and_loop(Reply,From,MRef,LoopData); - {{try_to_adopt,Tag,Condition},From,MRef} -> - if - LoopData#rt.ctrl_ref==undefined -> % We have no control component. - {Reply,NewLoopData}=do_try_to_adopt(Tag,Condition,LoopData,From), - reply_and_loop(Reply,From,MRef,NewLoopData); - true -> % We already have a control component. - reply_and_loop({error,refused},From,MRef,LoopData) - end; - {{confirm_connection,_Tag},From,MRef} -> - if - LoopData#rt.ctrl==From -> % It must be from this process! - Reply=collect_node_info(LoopData), - reply_and_loop(Reply,From,MRef,LoopData); - true -> % Strange, some one is joking? - reply_and_loop({error,refused},From,MRef,LoopData) - end; - {{change_options,Options},From,MRef} -> - case do_change_options(Options,LoopData) of - stop -> % Can't run alone with these options! - terminate_overload(LoopData), - From ! {ok,MRef}; % Don't care if From not a proper pid! - NewLoopData when is_record(NewLoopData,rt) -> - reply_and_loop(ok,From,MRef,NewLoopData) - end; - {get_status,From,MRef} -> - Reply={ok,{LoopData#rt.state,LoopData#rt.status}}, - reply_and_loop(Reply,From,MRef,LoopData); - {get_tracerdata,From,MRef} -> - case LoopData#rt.tracerdata of - undefined -> - reply_and_loop({ok,no_tracerdata},From,MRef,LoopData); - TracerData -> - reply_and_loop({ok,TracerData},From,MRef,LoopData) - end; - {state,From,MRef} -> % For debugging purposes. - reply_and_loop(LoopData,From,MRef,LoopData); - - {'DOWN',CtrlRef,process,_,_} when CtrlRef==LoopData#rt.ctrl_ref -> - case do_down_message(LoopData) of - stop -> % inviso_c gone and we must stop! - terminate_overload(LoopData), - exit(running_alone); - {ok,NewLoopData} -> - loop1(NewLoopData) - end; - {'EXIT',Pid,Reason} -> - case act_on_exit(Pid,Reason,LoopData) of - exit -> - terminate_overload(LoopData), - exit(Reason); - NewLoopData when is_record(NewLoopData,rt) -> - loop1(NewLoopData); - {NewLoopData,NewTimeOut} when is_record(NewLoopData,rt) -> - loop(NewLoopData,NewTimeOut) - end; - Other -> % Check if it concerns overload. - if - LoopData#rt.overload/=?NO_LOADCHECK, - LoopData#rt.status==running, - LoopData#rt.state==tracing -> - {NewLD,NewTimeOut}= - do_check_overload(LoopData, - {msg,{Other,LoopData#rt.overload_data}}), - loop(NewLD,NewTimeOut); - true -> - NewTimeOut=calc_diff_to_now(now(),LoopData#rt.next_loadcheck), - loop(LoopData,NewTimeOut) - end - after - Timeout -> - loop1(LoopData) - end. - -reply_and_loop(Reply,To,MRef,LoopData) when is_pid(To) -> - To ! {Reply,MRef}, - loop1(LoopData); -reply_and_loop(_,_,_,LoopData) -> % Used together with incoming casts. - loop1(LoopData). -%% ----------------------------------------------------------------------------- - - -%% ============================================================================= -%% File transfer process implementation. -%% ============================================================================= - -%% Files that are to to be transfered from the runtime component to the control -%% component are done so by reading them as binaries and sending them with -%% normal message passing (over distributed Erlang). -%% Reading the files are done in a process separate to the runtime component, -%% to both make the code more simple. But also to free up the runtime component. -%% -%% This help process must be capable of recognizing the fact that the runtime -%% component has been suspended, and then of course also discontinue any file -%% transfere. -fetch_init(Parent,Files,CollectPid,ChunkSize) -> - process_flag(trap_exit,true), % We must clean-up. - process_flag(priority,low), % Lets be careful. - case fetch_open_file(Files,CollectPid) of - {ok,FileName,FD,RestFiles} -> - MRef=erlang:monitor(process,CollectPid), - fetch_loop(Parent,RestFiles,CollectPid,ChunkSize,FileName,FD,MRef); - done -> - fetch_end(CollectPid); - error -> - fetch_incomplete(CollectPid) - end. - -fetch_loop(Parent,Files,CollectPid,ChunkSize,FName,FD,MRef) -> - receive - {suspend,Parent} -> % The runtime component is suspended. - file:close(FD), % We must clean-up. - fetch_incomplete(CollectPid); - {'DOWN',MRef,process,_,_} -> % The CollectPid terminated! - file:close(FD); % Close file and terminate. - {'EXIT',Parent,_Reason} -> % The runtime component terminated. - file:close(FD), - fetch_incomplete(CollectPid); - _ -> - fetch_loop(Parent,Files,CollectPid,ChunkSize,FName,FD,MRef) - after - 0 -> % If non of the above, get to work! - case file:read(FD,ChunkSize) of - {ok,Bin} -> - fetch_send_chunk(CollectPid,Bin), - case fetch_wait_for_chunk_ack(CollectPid,MRef) of - ok -> % Collector ready to receive next chunk. - fetch_loop(Parent,Files,CollectPid,ChunkSize,FName,FD,MRef); - cancel -> % Send no more files! - file:close(FD), % Close file, send incomplete, terminate! - fetch_incomplete(CollectPid); - 'DOWN' -> % Collector has terminate, stop! - file:close(FD) % Close file and terminate. - end; - eof -> % Ok, go on with the next file. - file:close(FD), - fetch_send_eof(CollectPid), - case fetch_open_file(Files,CollectPid) of - {ok,NewFName,NewFD,RestFiles} -> - fetch_loop(Parent,RestFiles,CollectPid, - ChunkSize,NewFName,NewFD,MRef); - done -> - fetch_end(CollectPid); - error -> - fetch_incomplete(CollectPid) - end; - {error,Reason} -> % Do not continue. - file:close(FD), - fetch_send_readerror(CollectPid,FName,Reason), - fetch_incomplete(CollectPid) - end - end. -%% ----------------------------------------------------------------------------- - -%% Help function which opens the next file to be transferred. It also communicates -%% the opening of the file to the collector process. -%% We know here that it will be a list of three-tuples. But there is no guarantee -%% that Dir or FileName are proper strings. -%% Returns {ok,FileName,FileDescriptor,RemainingFiles} or 'done'. -fetch_open_file([{FType,Dir,FileName}|RestFiles],CollectPid) -> - case catch file:open(filename:join(Dir,FileName),[read,raw,binary]) of - {ok,FD} -> - CollectPid ! {node(),open,{FType,FileName}}, - {ok,FileName,FD,RestFiles}; - {error,_Reason} -> - CollectPid ! {node(),open_failure,{FType,FileName}}, - error; - {'EXIT',_Reason} -> % Faulty Dir or FileName. - CollectPid ! {node(),open_failure,{FType,FileName}}, - error - end; -fetch_open_file([],_CollectPid) -> - done. -%% ----------------------------------------------------------------------------- - -%% A group of help functions sending information to the collector process. -%% Returns nothing significant. -fetch_send_chunk(CollectPid,Bin) -> - CollectPid ! {node(),payload,Bin,self()}. -%% ----------------------------------------------------------------------------- - -fetch_send_eof(CollectPid) -> - CollectPid ! {node(),end_of_file}. -%% ----------------------------------------------------------------------------- - -fetch_end(CollectPid) -> - CollectPid ! {node(),end_of_transmission}. -%% ----------------------------------------------------------------------------- - -fetch_send_readerror(CollectPid,FName,Reason) -> - CollectPid ! {node(),{error,{file_read,{Reason,FName}}}}. -%% ----------------------------------------------------------------------------- - -fetch_incomplete(CollectPid) -> - CollectPid ! {node(),incomplete}. -%% ----------------------------------------------------------------------------- - -%% Help function waiting for the collector to respond that it is ready to receive -%% the next chunk. This is in order to exercise flow control protecting the -%% collector to get swamped if the node where the collector runs is busy. -fetch_wait_for_chunk_ack(CollectPid,MRef) -> - receive - {CollectPid,chunk_ack} -> - ok; - {CollectPid,cancel_transmission} -> % Some problem at collector side. - cancel; - {'DOWN',MRef,process,_,_} -> % The collector terminated. - 'DOWN' - end. -%% ----------------------------------------------------------------------------- - - -%% ============================================================================= -%% First level do-functions, called from the main server loop on incomming -%% requests. -%% ============================================================================= - -%% Function performing the overload check. Returns {NewLoopData,TimeOut}. -%% Note that this function may also cause a suspend to be carried out if the -%% loadcheck turns out negative. -do_check_overload(LD,Data) -> - case do_check_overload_2(LD#rt.overload,Data) of - ignore -> % Load check not performed. - {LD,calc_diff_to_now(now(),LD#rt.next_loadcheck)}; - {ok,Interval} -> % No problem, continue. - NextLoadCheck=add_to_now(now(),Interval), - {LD#rt{next_loadcheck=NextLoadCheck},Interval}; - {suspend,Reason} -> % Emergency! suspend, suspend! - NewLD=do_suspend(LD,Reason), - {NewLD,infinity}; % No need to do load-checks now! - {new,NewData,Interval} -> % The overload was restarted or something. - NextLoadCheck=add_to_now(now(),Interval), - {LD#rt{overload_data=NewData,next_loadcheck=NextLoadCheck},Interval}; - error -> % Inhibit overload check then. - {LD#rt{overload=?NO_LOADCHECK},infinity} - end. - -%% Help function performing an overload check. Returns {ok,Interval}, -%% {suspend,Reason}, 'error' ir 'ignore'. -do_check_overload_2({{Mod,Func},Interval,_,_},Data) -> - do_check_overload_3(Interval,catch Mod:Func(Data)); -do_check_overload_2({Fun,Interval,_,_},Data) when is_function(Fun) -> - do_check_overload_3(Interval,catch Fun(Data)); -do_check_overload_2(_,_) -> % Bad loadcheck configuration. - error. % Stop using load checks then. - -do_check_overload_3(Interval,ok) -> - {ok,Interval}; -do_check_overload_3(Interval,{new,NewData}) -> - {new,NewData,Interval}; -do_check_overload_3(_Interval,{suspend,Reason}) -> - {suspend,Reason}; -do_check_overload_3(_Interval,ignore) -> % Loadcheck not triggered. - ignore; -do_check_overload_3(_Interval,_) -> % Failure or other return value. - error. % Stop doing loadchecks from now on. -%% ------------------------------------------------------------------------------ - -%% Function setting the trace-pattern according to Args and Flags. Note that -%% Args can contain regexps which must be expanded here. -%% Returns a list: [Result], where Result can be: int()|{error,Reason}. -%% Sometimes an error tuple will represent an entire pattern, sometimes the -%% pattern will expand to a number of error-tuples. -do_set_trace_patterns(Args,Flags) -> - Replies=do_set_trace_patterns_2(Args,Flags,[]), - lists:reverse(Replies). - -do_set_trace_patterns_2([{M,F,Arity,MS}|Rest],Flags,Replies) -> % Option-less. - do_set_trace_patterns_2([{M,F,Arity,MS,[]}|Rest],Flags,Replies); -do_set_trace_patterns_2(Mlist = [{M,F,Arity,MS,Opts}|Rest],Flags,Replies) when is_atom(M) -> - case length(Mlist) rem 10 of - 0 -> - timer:sleep(100); - _ -> - ok - end, - %% sleep 100 ms for every 10:th element in the list to let other - %% processes run since this is a potentially - %% heavy operation that might result in an unresponsive Erlang VM for - %% several seconds otherwise - case load_module_on_option(M,Opts) of - true -> % Already present, loaded or no option! - case catch erlang:trace_pattern({M,F,Arity},MS,Flags) of - No when is_integer(No) -> - do_set_trace_patterns_2(Rest,Flags,[No|Replies]); - {'EXIT',Reason} -> - do_set_trace_patterns_2(Rest, - Flags, - [{error,{bad_trace_args,[{M,F,Arity,MS},Reason]}}| - Replies]) - end; - false -> % Module not present, or not found! - do_set_trace_patterns_2(Rest,Flags,[0|Replies]) - end; -do_set_trace_patterns_2([{M,F,Arity,MS,Opts}|Rest],Flags,Replies) when is_list(M) -> - do_set_trace_patterns_2([{{void,M},F,Arity,MS,Opts}|Rest],Flags,Replies); -do_set_trace_patterns_2([{{Dir,M},F,Arity,MS,Opts}|Rest],Flags,Replies) - when is_list(Dir),is_list(M) -> - case check_pattern_parameters('_',F,Arity,MS) of % We don't want to repeat bad params. - true -> - case inviso_rt_lib:expand_regexp(Dir,M,Opts) of % Get a list of real modulnames. - Mods when is_list(Mods) -> - MoreReplies= - do_set_trace_patterns_2(lists:map(fun(Mod)-> - {Mod,F,Arity,MS,Opts} - end, - Mods), - Flags, - Replies), - do_set_trace_patterns_2(Rest,Flags,MoreReplies); - {error,Reason} -> - do_set_trace_patterns_2(Rest,Flags,[{error,Reason}|Replies]) - end; - false -> % Bad pattern parameters. - do_set_trace_patterns_2(Rest, - Flags, - [{error,{bad_trace_args,{M,F,Arity,MS}}}|Replies]) - end; -do_set_trace_patterns_2([Arg|Rest],Flags,Replies) -> - do_set_trace_patterns_2(Rest,Flags,[{error,{bad_trace_args,Arg}}|Replies]); -do_set_trace_patterns_2([],_Flags,Replies) -> - Replies. -%% ----------------------------------------------------------------------------- - -%% Help function which sets the trace flags for all processes specifed in Args. -%% Args shall be a list of {ProcessSpecification,ProcessTraceFlags}. -%% Returns {ok,Answers} where Answers is a list of integer and error descriptions. -%% Note that a process specification may be a particular pid or a {global,Name}. -%% In the case the process does not exist we will fake a zero instead of an -%% error. -do_set_trace_flags(Tracer,Args,How) -> - Fun=fun({Proc,Flags}) -> - case check_traceflag_pidspec(Proc) of - {ok,Proc2} -> % Reg-names converted. - case check_flags(Flags) of - Flags2 when is_list(Flags2) -> % No error! - case (catch - case How of - true -> - erlang:trace(Proc2, - true, - [{tracer,Tracer}|Flags2]); - false -> % No tracer of turning off. - erlang:trace(Proc2, - false, - Flags2) - end) of - N when is_integer(N) -> - N; - {'EXIT',Reason} -> - if - is_pid(Proc2) -> - 0; % Proc2 not alive or not at this node! - true -> % Otherwise, just error! - {error, - {bad_trace_args, - [Reason,Proc2,How,Flags2,Tracer]}} - end - end; - FlagError -> - FlagError - end; - false -> % Skip it. - 0; % Indicate that zero processes matched. - {error,Reason} -> % Bad process specification. - {error,{bad_process,[Reason,Proc]}} - end; - (Faulty) -> - {error,{bad_process,Faulty}} - end, - {ok,lists:map(Fun,Args)}. -%% ------------------------------------------------------------------------------ - -%% Function calling API:s in the trace information server. Note that we have -%% given the responsibility to form a correct functionsname and argument list -%% to the caller. -%% Returns whatever the called function returns. -do_meta_pattern(MPid,{FuncName,ArgList}) -> - case catch apply(inviso_rt_meta,FuncName,[MPid|ArgList]) of - {'EXIT',_Reason} -> - {error,{badarg,{FuncName,ArgList}}}; - Result -> - Result - end; -do_meta_pattern(_MPid,BadArgs) -> - {error,{bad_args,BadArgs}}. -%% ------------------------------------------------------------------------------ - -%% Function removing *all* patterns. Beaware that the one for local patterns -%% causes a walkthrough of all loaded modules. -do_clear_trace_patterns() -> - erlang:trace_pattern({'_','_','_'},false,[local]), %% inc. meta, call_count - erlang:trace_pattern({'_','_','_'},false,[global]). -%% ------------------------------------------------------------------------------ - -%% Function that takes TracerData and initializes the tracing. That can be -%% opening appropriate logfiles, starting meta-tracer. There must be one -%% clause here for every "type" of logging we want to be able to do. -%% Returns the Reply to be forwarded to the caller. -do_init_tracing(LoopData,TD,{HandlerFun,Data},TiTD) when is_function(HandlerFun) -> - {NewLoopData,Reply}= - case do_init_metatracing(TiTD,self()) of - {ok,MetaPid} -> - {LoopData#rt{handler={HandlerFun,Data}, - tracerdata=TD, - meta_tracer=MetaPid, - state=tracing}, - {ok,[{trace_log,ok},{ti_log,ok}]}}; - false -> % No meta tracing requested. - {LoopData#rt{handler={HandlerFun,Data}, - tracerdata=TD, - state=tracing}, - {ok,[{trace_log,ok}]}}; - {error,Reason} -> % Problems starting meta tracing. - {LoopData#rt{handler={HandlerFun,Data}, - tracerdata=TD, - state=tracing}, - {ok,[{trace_log,ok},{ti_log,{error,Reason}}]}} - end, - send_event(state_change,NewLoopData), % Send to subscribing processes. - {NewLoopData,Reply}; -do_init_tracing(LoopData,TD,{Type,Parameters},TiTD) when Type==ip;Type==file -> - case check_traceport_parameters(Type,Parameters) of - ok -> - case catch trace_port(Type,Parameters) of - Fun when is_function(Fun) -> - case catch Fun() of - Port when is_port(Port) -> % Ok, our trace-port is open. - {NewLoopData,Reply}= - case do_init_metatracing(TiTD,Port) of - {ok,MetaPid} -> - {LoopData#rt{tracer_port=Port, - tracerdata=TD, - meta_tracer=MetaPid, - state=tracing}, - {ok,[{trace_log,ok},{ti_log,ok}]}}; - false -> % No meta tracing requested. - {LoopData#rt{tracer_port=Port, - tracerdata=TD, - state=tracing}, - {ok,[{trace_log,ok}]}}; - {error,Reason} -> % Problems starting meta tracing. - {LoopData#rt{tracer_port=Port, - tracerdata=TD, - state=tracing}, - {ok,[{trace_log,ok},{ti_log,{error,Reason}}]}} - end, - send_event(state_change,NewLoopData), - {NewLoopData,Reply}; - {'EXIT',Reason} -> - {LoopData,{error,{bad_port_fun,[Parameters,Reason]}}} - end; - {'EXIT',Reason} -> - {LoopData,{error,{bad_port_args,[Parameters,Reason]}}} - end; - {error,Reason} -> % Bad traceport parameters. - {LoopData,{error,Reason}} - end. - -%% Help function that starts the meta-tracing. Note that the runtime component -%% will becom linked to it. -%% Currently the meta tracer handles two types, 'file' and 'relay'. -%% Note that Tracer tells the meta tracer where regular trace messages shall be -%% sent. This is because the meta tracer is capable of appending a {tracer,Tracer} -%% action term to meta match specs. -do_init_metatracing(LogSpec={_Type,_Arg},Tracer) -> - case inviso_rt_meta:start(LogSpec,Tracer) of - {ok,MetaPid} -> - {ok,MetaPid}; - {error,Reason} -> - {error,Reason} - end; -do_init_metatracing({Type,Arg,{InitPublLDmfa,RemovePublLDmf,CleanPublLDmf}},Tracer)-> - case inviso_rt_meta:start({Type,Arg},Tracer,InitPublLDmfa,RemovePublLDmf,CleanPublLDmf) of - {ok,MetaPid} -> - {ok,MetaPid}; - {error,Reason} -> - {error,Reason} - end; -do_init_metatracing(void,_) -> % Means no meta tracer. - false. -%% ----------------------------------------------------------------------------- - -%% Function that stops all tracing and closes all open files. This function -%% can't fail :-) It tries as hard as it can. -%% This function also kills the autostarter process if one exists. Otherwise it -%% will not be possible from a control component to end an ongoing autostarted -%% tracing. -%% Returns a new loopdata structure since stopping tracing involves updating it. -do_stop_tracing(LoopData) -> - do_stop_tracing_kill_autostarter(LoopData#rt.auto_starter), - do_clear_trace_flags(), % Do not generate any more traces. - NewLoopData1=do_stop_tracing_tracelog(LoopData), - NewLoopData2=do_stop_tracing_metatracing(NewLoopData1), - NewLoopData3=NewLoopData2#rt{state=idle,auto_starter=undefined}, - send_event(state_change,NewLoopData3), - NewLoopData3. - -do_stop_tracing_tracelog(LoopData=#rt{tracer_port=Port}) when is_port(Port) -> - trace_port_control(Port,flush), % Write buffered trace messages. - catch port_close(Port), - LoopData#rt{tracer_port=undefined}; -do_stop_tracing_tracelog(LoopData) -> - LoopData#rt{handler=undefined}. - -do_stop_tracing_metatracing(LoopData=#rt{meta_tracer=MPid}) when is_pid(MPid) -> - inviso_rt_meta:stop(MPid), - LoopData#rt{meta_tracer=undefined}; -do_stop_tracing_metatracing(LoopData) -> % No meta tracer running! - LoopData. - -%% Help function killing the autostarter, if one is active. -do_stop_tracing_kill_autostarter(P) when is_pid(P) -> - exit(P,stop_tracing); -do_stop_tracing_kill_autostarter(_) -> % No autostarter, do nothing. - true. -%% ----------------------------------------------------------------------------- - -%% Help function implementing suspending the runtime component. -%% Returns a new loopdata structure. -do_suspend(LD,Reason) -> - do_clear_trace_flags(), % If no process flags, no output! - do_suspend_metatracer(LD#rt.meta_tracer), - do_suspend_fetchers(LD#rt.fetchers), - do_stop_tracing_kill_autostarter(LD#rt.auto_starter), - NewLD=LD#rt{fetchers=[],status={suspended,Reason},auto_starter=undefined}, - send_event(state_change,NewLD), % Notify subscribers. - NewLD. - -do_suspend_metatracer(MetaTracer) when is_pid(MetaTracer) -> - inviso_rt_meta:suspend(MetaTracer); % This makes it suspended. -do_suspend_metatracer(_) -> - true. - -do_suspend_fetchers([FetcherPid|Rest]) -> - FetcherPid ! {suspend,self()}, % This makes it terminate. - do_suspend_fetchers(Rest); -do_suspend_fetchers([]) -> - true. -%% ------------------------------------------------------------------------------ - -%% Function that stops all tracing, removes all trace-patterns and removes all -%% logfiles. The idea is to return the runtime component to the 'new' state. -do_clear(LoopData,Opts) when is_list(Opts) -> - NewLoopData=do_stop_tracing(LoopData), % First stop tracing, if tracing. - case lists:member(keep_trace_patterns,Opts) of - false -> - do_clear_trace_patterns(); - _ -> - true - end, - case lists:member(keep_log_files,Opts) of - false -> - if - NewLoopData#rt.tracerdata/=undefined -> - do_delete_logs(NewLoopData#rt.tracerdata); - true -> % If no tracerdata, nothing to remove! - true % Do nothing then. - end; - _ -> - true - end, - NewLoopData#rt{state=new,tracerdata=undefined}; -do_clear(LoopData,_Opts) -> % Faulty Opts. - do_clear(LoopData,[]). % Then just ignore the options. -%% ----------------------------------------------------------------------------- - -%% Function which takes a tracerdata, either our own or a "suggested" -%% and tries to find the corresponding files. Note that the return value only -%% contains "types" of logs that the tracerdata is pointing out. Hence -%% is there no ti-log, no one will be mentioned in the return value. -do_list_logs(TracerData) -> % Handles both list and tuple. - case translate_td(TracerData) of - {ok,LogTD,TiTD} -> - {TraceDir,TraceLogs}=list_logs_tracelog(LogTD), - {TiDir,TiLogs}=list_logs_tilog(TiTD), - case {TraceLogs,TiLogs} of - {no_log,no_log} -> % Tracerdata not generating logs! - {ok,no_log}; - {_,no_log} -> % No ti logs. - {ok,[{trace_log,TraceDir,TraceLogs}]}; - {no_log,_} -> % Only ti-logs, unusual! - {ok,[{ti_log,TiDir,TiLogs}]}; - _ -> % Both trace and ti logs. - {ok,[{trace_log,TraceDir,TraceLogs},{ti_log,TiDir,TiLogs}]} - end; - {error,Reason} -> - {error,Reason} - end. -%% ----------------------------------------------------------------------------- - -%% Help function implementing fetching logfiles using distributed Erlang. -%% This function works for both situations, a list of specific files are -%% requested, or a tracerdata is specified. -%% Returns {Reply,NewLoopData}. -do_fetch_log(LD,CollectPid,What) -> - if - LD#rt.state/=tracing -> - case is_list_of_files_or_tracerdata(What) of - files -> - FetcherPid=do_fetch_log_listoffiles(CollectPid,What), - {{ok,FetcherPid},add_fetcher_ld(FetcherPid,LD)}; - tracerdata -> - case do_fetch_log_tracerdata(CollectPid,What) of - {Reply,FetcherPid} when is_pid(FetcherPid) -> - {Reply,add_fetcher_ld(FetcherPid,LD)}; - {Reply,_} -> % No fetch process was started. - {Reply,LD} - end; - false -> % It is an empty list! - {{complete,no_log},LD}; - error -> % Incorrect parameter. - {{error,badarg},LD} - end; - true -> % No transfere during tracing. - {{error,tracing},LD} - end. - -%% Function taking tracerdata to find out what files to send over to the RemotePid. -%% Note that we will not go back to the loop function from here but rather call -%% the fetch_loop instead, prepresenting the fetch-log state. Unless we encounter -%% a problem. -do_fetch_log_tracerdata(CollectPid,TracerData) -> - case do_list_logs(TracerData) of - {ok,no_log} -> - {{complete,no_log},void}; - {ok,Logs} -> % Ok, some trace_log and ti_log. - FetcherPid=do_fetch_log_listoffiles(CollectPid,Logs), - {{ok,FetcherPid},FetcherPid}; - {error,Reason} -> % Problem with tracerdata! - {{error,Reason},void} - end. - -do_fetch_log_listoffiles(CollectPid,FileSpec) -> - ExpandedFileSpec=do_fetch_log_expand_filespec(FileSpec), -%% !!! try out different ChunkSizes -% ChunkSize = 60, -% ChunkSize = 7*1024, - ChunkSize=1024, - _Fetcher=spawn_link(?MODULE, - fetch_init, - [self(),ExpandedFileSpec,CollectPid,ChunkSize]). - -%% Help function which expands the list of logs to have tags in front of every -%% file, as required by the fetch_loop. -do_fetch_log_expand_filespec(Logs) -> - TraceLogs= - case lists:keysearch(trace_log,1,Logs) of - {value,{_,Dir1,Logs1}} -> % There is a list of trace-logs. - lists:map(fun(File)->{trace_log,Dir1,File} end,Logs1); - false -> % No trace-logs! - [] - end, - TiLogs= - case lists:keysearch(ti_log,1,Logs) of - {value,{_,Dir2,Logs2}} -> - lists:map(fun(File)->{ti_log,Dir2,File} end,Logs2); - false -> - [] - end, - TiLogs++TraceLogs. - -%% ------------------------------------------------------------------------------ - -%% Function that removes all logfiles associated with a certain tracerdata. -do_delete_logs(TracerDataOrLogList) -> - case is_list_of_files_or_tracerdata(TracerDataOrLogList) of - tracerdata -> - case translate_td(TracerDataOrLogList) of - {ok,LogTD,TiTD} -> - case {list_logs_tracelog(LogTD),list_logs_tilog(TiTD)} of - {{_,no_log},{_,no_log}} -> % No logs nowhere! - {ok,no_log}; - {{LogDir,LogFiles},{_,no_log}} -> % No ti. - {ok,[{trace_log,delete_files(LogDir,LogFiles)}]}; - {{_,no_log},{TiDir,TiFiles}} -> - {ok,[{ti_log,delete_files(TiDir,TiFiles)}]}; - {{LogDir,LogFiles},{TiDir,TiFiles}} -> - {ok,[{trace_log,delete_files(LogDir,LogFiles)}, - {ti_log,delete_files(TiDir,TiFiles)}]} - end; - {error,Reason} -> - {error,Reason} - end; - files -> % It is [{trace_log,Dir,Files},.. - if - is_list(hd(TracerDataOrLogList)) -> % Just a list of files. - {ok,delete_files(".",TracerDataOrLogList)}; - is_tuple(hd(TracerDataOrLogList)) -> % A "modern" logspec. - case {lists:keysearch(trace_log,1,TracerDataOrLogList), - lists:keysearch(ti_log,1,TracerDataOrLogList)} of - {false,false} -> % Hmm, no logs specified! - {ok,[]}; % Easy response! - {{value,{_,LogDir,LogFiles}},false} -> - {ok,[{trace_log,delete_files(LogDir,LogFiles)}]}; - {false,{value,{_,TiDir,TiFiles}}} -> - {ok,[{ti_log,delete_files(TiDir,TiFiles)}]}; - {{value,{_,LogDir,LogFiles}},{value,{_,TiDir,TiFiles}}} -> - {ok,[{trace_log,delete_files(LogDir,LogFiles)}, - {ti_log,delete_files(TiDir,TiFiles)}]} - end - end; - false -> % Can't tell which! - {ok,[]}; - error -> - {error,{badarg,TracerDataOrLogList}} - end. -%% ----------------------------------------------------------------------------- - -%% Function handling the request when a control component wishing to take -%% control over this already existing control component. It does not matter -%% what state it is in. It can very well already be tracing. -%% Returns {Reply,NewLoopData}. -%% Where the Reply tells the control component wether it took control of it -%% or not. {node_info,node(),self(),Vsn,State,Status,{tag,Tag}} means that we -%% can be adopted (and more precisely considers ourselves being adopted now). -do_try_to_adopt(Tag,if_ref,LoopData=#rt{tag=Tag},_Ctrl) -> - {{error,{wrong_reference,LoopData#rt.tag}},LoopData}; -do_try_to_adopt(NewTag,_Condition,LoopData,CtrlPid) -> - case LoopData#rt.timer_ref of % Do we have a running-alone timer? - undefined -> % No we don't. - true; - TimerRef -> - timer:cancel(TimerRef) - end, - CtrlRef=erlang:monitor(process,CtrlPid), % Lets monitor our new "master"! - {DepVal,_}=LoopData#rt.dependency, - {node_info,Node,Pid,VSN,State,Status,Tag}=collect_node_info(LoopData), - NewLoopData= - LoopData#rt{dependency={DepVal,node(CtrlPid)}, - ctrl=CtrlPid, - ctrl_ref=CtrlRef, % Monitoring our new master. - tag=NewTag, % Use this tag from now on. - timer_ref=undefined}, - {{node_info,Node,Pid,VSN,State,Status,{tag,Tag}},NewLoopData}. -%% ----------------------------------------------------------------------------- - -%% Function changing parameters accoring to a new options list. Note that we -%% can not change control component if the one we have is still working. -%% We can however of course change how this runtime component will react to -%% a running alone scenario. -%% Returns 'stop' or NewLoopData. -do_change_options(Options,LoopData) -> - NewLoopData=read_option_list(Options,LoopData), - if - NewLoopData/=LoopData -> % Some options changed. - case do_change_options_ctrl(LoopData,NewLoopData) of - stop -> - stop; - {ok,NewLoopData2} -> - NewLoopData3=do_change_options_overload(LoopData,NewLoopData2), - NewLoopData3#rt{next_loadcheck=now()} % Force a load check next. - end; - true -> - LoopData - end. - -%% Help function which sets up the new dependencies. Note that we only do that -%% if do not have a working control component. -%% Returns {ok,NewLoopData} or 'stop'. -do_change_options_ctrl(OldLD,NewLD) -> - if - OldLD#rt.timer_ref/=undefined -> % No control and waiting to terminate. - timer:cancel(OldLD#rt.timer_ref), - do_down_message(NewLD#rt{timer_ref=undefined}); - OldLD#rt.ctrl==undefiend -> % No control component. - do_down_message(NewLD); - true -> % We have a working control component! - {ok,NewLD} - end. - -do_change_options_overload(OldLD,NewLD) -> - if - OldLD#rt.overload/=NewLD#rt.overload -> - terminate_overload(OldLD), - NewOverloadData=initialize_overload(NewLD), - NewLD#rt{overload_data=NewOverloadData}; - true -> % No changes done. - NewLD - end. -%% ----------------------------------------------------------------------------- - -%% Help function handling an incoming DOWN message from our control component. -%% If the runtime component is not allowed to run without a control component, it -%% simply terminates which closes the trace-port and process trace flags are -%% therefore automatically removed. -%% Returns 'stop' or a {ok,NewLoopData} structure. -do_down_message(LoopData) -> - case LoopData#rt.dependency of - {0,_} -> % Not allowed to run without controller. - stop; - {infinity,_} -> % Don't care. Just remove the controller. - {ok,LoopData#rt{ctrl=undefined,ctrl_ref=undefined}}; - {TimeOut,_} -> % Allowed to run TimeOut ms alone. - {ok,TimerRef}=timer:exit_after(TimeOut,self(),running_alone), - {ok,LoopData#rt{timer_ref=TimerRef,ctrl=undefined,ctrl_ref=undefined}} - end. -%% ----------------------------------------------------------------------------- - -%% Function handling incomming exit signals. We can expect exit signals from the -%% following: Our parent supervisor (runtime_tools_sup), a meta-tracer process, -%% a logfile fetcher process, or the auto_starter. -%% A trace-port may also generate an exit signal. -%% In addition it is possible that an overload mechanism generates exit-signals. -%% We can also get the running_alone exit signal from our self. This is the -%% situation if our control component has terminated and this runtime component -%% is not allowed to exist on its own for ever. -%% Also note that after we have stopped tracing, for any reason, it is not -%% impossible that we receive the EXIT signals from still working parts that -%% we are now shuting down. This is no problem, the code will mearly update -%% the loopdata structure once again. -%% Returns 'exit' indicating that the runtime component shall terminate now, -%% {NewLoopData,NewTimeOut} if the exit-signal resulted in an overload check, or -%% a new loopdata structure shall we ignore the exit, or it simply resulted in -%% a state-change. -act_on_exit(Parent,_Reason,#rt{parent=Parent}) -> - exit; -act_on_exit(_Pid,running_alone,_LoopData) -> - exit; -act_on_exit(MetaTracer,_Reason,LoopData=#rt{meta_tracer=MetaTracer}) -> - LoopData#rt{meta_tracer=undefined}; % It does not exit anylonger. -act_on_exit(Port,Reason,LoopData=#rt{tracer_port=Port}) -> - send_event({port_down,node(),Reason},LoopData), - _NewLoopData=do_stop_tracing(LoopData); -act_on_exit(AutoStarter,_Reason,LoopData=#rt{auto_starter=AutoStarter}) -> - LoopData#rt{auto_starter=undefined}; % The autostarter has terminated. -act_on_exit(Pid,Reason,LoopData) -> - case remove_fetcher_ld(Pid,LoopData) of - {true,NewLoopData} -> % Yes it really was a fetcher. - NewLoopData; - false -> % No it was not a fetcher. - act_on_exit_overload(Pid,Reason,LoopData) - end. - -%% Help function checking if this exit has anything to do with an overload -%% mechanism. Note that here we run the overload mechanism regardless of -%% if we are tracing or not. This because an exit signal from the overload -%% must most likely always be handled. -act_on_exit_overload(Pid,Reason,LoopData) -> - if - LoopData#rt.overload/=?NO_LOADCHECK -> - {_NewLD,_NewTimeOut}= - do_check_overload(LoopData, - {'EXIT',{Pid,Reason,LoopData#rt.overload_data}}); - true -> % Overload not in use. - LoopData - end. -%% ----------------------------------------------------------------------------- - - - - - - - - - - - - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - -%% ============================================================================== -%% Various help functions. -%% ============================================================================== - -%% Help function which calculates a new now-tuple by adding Interval milliseconds -%% to the first argument. Note that Interval may be 'infinity' too. -%% Returns a new now-tuple or "bigvalue" which is greater than any now-tuple. -add_to_now({MegSec,Sec,MicroSec},Interval) when is_integer(Interval) -> - NewSec=Sec+(Interval div 1000), - if - NewSec>=1000000 -> - {MegSec+1,NewSec-1000000,MicroSec}; - true -> - {MegSec,NewSec,MicroSec} - end; -add_to_now(_,infinity) -> - "bigvalue". -%% ------------------------------------------------------------------------------ - -%% Help function calculating the difference in milliseconds between its first -%% and second argument. This is useful when calculating an after timeout value -%% from current now() and next_loadcheck value. -calc_diff_to_now(T1={_,_,_},T2={_,_,_}) -> - TimeOut1=timer:now_diff(T2,T1), % The difference in microseconds. - if - TimeOut1<0 -> - 0; - true -> % Make milliseconds out of it. - TimeOut1 div 1000 - end; -calc_diff_to_now(_T1,_) -> % Next loadcheck is not activated. - infinity. % The the after timeout is infinity. -%% ------------------------------------------------------------------------------ - - -%% Help function returning information about this runtime component. -collect_node_info(#rt{vsn=VSN,state=State,status=Status,tag=Tag}) -> - {node_info,node(),self(),VSN,State,Status,Tag}. -%% ------------------------------------------------------------------------------ - -%% Help function sending information to the control component that state/status -%% change has occurred. Returns nothing significant. -send_event(state_change,LoopData=#rt{ctrl=CtrlPid}) when is_pid(CtrlPid) -> - Event={trace_event,{state_change,node(),{LoopData#rt.state,LoopData#rt.status}}}, - CtrlPid ! Event; -send_event(Event,#rt{ctrl=CtrlPid}) when is_pid(CtrlPid) -> - CtrlPid ! {event,Event}; -send_event(_,_) -> % We have no control to send to! - true. % Maybe tracing alone after autostart. -%% ------------------------------------------------------------------------------ - -%% Help function initializing the overload protection mechanism. This may be -%% necessary if it is a port program or similar. Returns {ok,Data} or 'void'. -%% The datastructure vill be given to LoadMF as argument whenever loadchecks -%% are done. -initialize_overload(#rt{overload={_MF,_Interval,{M,F,Args},_RemoveMFA}}) -> - case catch apply(M,F,Args) of - {ok,Data} -> - Data; - _ -> % 'EXIT' or other faulty returnvalue. - void - end; -initialize_overload(_) -> - void. -%% ------------------------------------------------------------------------------ - -%% Help function which terminates an overload protection mechanism. -%% Returns nothing significant. -terminate_overload(#rt{overload={_MF,_Interval,_InitMFA,{M,F,Args}}, - overload_data=Data}) -> - catch apply(M,F,[Data|Args]), % Interested in the side-effect. - true; -terminate_overload(_) -> - true. -%% ------------------------------------------------------------------------------ - - -%% Help function which checks that a process specified for trace flags is correct. -%% Either the built-in "aliases" for groups of processes, a pid, a locally registered -%% name. This function also works for globally registered names. It must then -%% first be established that the process is local for this node before setting any -%% process flags. -%% Returns {ok,PidSpec}, 'false' or {error,Reason}. -check_traceflag_pidspec(all) -> {ok,all}; -check_traceflag_pidspec(new) -> {ok,new}; -check_traceflag_pidspec(existing) -> {ok,existing}; -check_traceflag_pidspec(Name) when is_atom(Name) -> - check_traceflag_pidspec({local,Name}); -check_traceflag_pidspec({local,A}) when is_atom(A) -> - case whereis(A) of - undefined -> % Then it is considered faulty. - {error,{nonexistent_name,A}}; - Pid when is_pid(Pid) -> - {ok,Pid} - end; -check_traceflag_pidspec({global,Name}) when is_atom(Name) -> - case global:whereis_name(Name) of - undefined -> % Then the name does not exist at all. - {error,{nonexistent_name,{global,Name}}}; - Pid when is_pid(Pid) -> % Ok, but must check that it is here. - if - node()==node(Pid) -> - {ok,Pid}; - true -> % Pid is not at this node. - false % Not an error but cant be used. - end - end; -check_traceflag_pidspec(Pid) when is_pid(Pid) -> - {ok,Pid}; -check_traceflag_pidspec(Proc) -> - {error,{faulty,Proc}}. -%% ------------------------------------------------------------------------------ - -%% Help function removing all trace flags from all processes. Useful in connection -%% with suspend. Returns nothing significant. -do_clear_trace_flags() -> - erlang:trace(all, false, [all]). -%% ------------------------------------------------------------------------------ - -%% Help function which checks that only valid process trace flags are mentioned. -%% In order to create better fault reports. -%% Returns a list of the approved flags, or {error,Reason}. -check_flags(Flags) -> - check_flags_2(Flags,Flags). - -check_flags_2([send|Rest],Flags) -> check_flags_2(Rest,Flags); -check_flags_2(['receive'|Rest],Flags) -> check_flags_2(Rest,Flags); -check_flags_2([call|Rest],Flags) -> check_flags_2(Rest,Flags); -check_flags_2([return_to|Rest],Flags) -> check_flags_2(Rest,Flags); -check_flags_2([procs|Rest],Flags) -> check_flags_2(Rest,Flags); -check_flags_2([garbage_collection|Rest],Flags) -> check_flags_2(Rest,Flags); -check_flags_2([running|Rest],Flags) -> check_flags_2(Rest,Flags); -check_flags_2([set_on_spawn|Rest],Flags) -> check_flags_2(Rest,Flags); -check_flags_2([set_on_first_spawn|Rest],Flags) -> check_flags_2(Rest,Flags); -check_flags_2([set_on_link|Rest],Flags) -> check_flags_2(Rest,Flags); -check_flags_2([timestamp|Rest],Flags) -> check_flags_2(Rest,Flags); -check_flags_2([arity|Rest],Flags) -> check_flags_2(Rest,Flags); -check_flags_2([silent|Rest],Flags) -> check_flags_2(Rest,Flags); -check_flags_2([],Flags) -> Flags; -check_flags_2([Faulty|_],_Flags) -> {error,{bad_flag,Faulty}}. -%% ------------------------------------------------------------------------------ - -%% Help function which checks parameters to erlang:trace_pattern. The purpose of -%% the function is to avoid to get multiple error return values in the return -%% list for a pattern used together with a regexp expanded module name. -check_pattern_parameters(Mod,Func,Arity,MS) -> - MSresult = check_MS(MS), - MFAresult = check_MFA(Mod,Func,Arity), - MFAresult and MSresult. - -check_MS(MS) when is_list(MS) -> true; -check_MS(true) -> true; -check_MS(false) -> true. - -check_MFA('_','_','_') -> true; -check_MFA(Mod,'_','_') when is_atom(Mod) -> true; -check_MFA(Mod,'_',A) when is_atom(Mod), is_integer(A) -> false; -check_MFA(Mod,F,'_') when is_atom(Mod), is_atom(F) -> true; -check_MFA(Mod,F,A) when is_atom(Mod), is_atom(F), is_integer(A) -> true. - -%% ----------------------------------------------------------------------------- - -%% Help function finding out if Mod is loaded, and if not, if it can successfully -%% be loaded. The Opts list can prevent modules from being loaded. -%% Returns 'true' or 'false'. -load_module_on_option(Mod,Opts) when is_list(Opts) -> - case lists:member(no_loadcheck,Opts) of - true -> % Then just skip this, return true. - true; - false -> - case erlang:module_loaded(Mod) of - true -> - true; % It is loaded, do no more. - false -> - case lists:member(only_loaded,Opts) of - true -> % Then, make no attempts to load. - false; - false -> % Try to load! - case code:ensure_loaded(Mod) of - {module,_Mod} -> % Successfully loaded! - true; - {error,_Reason} -> - false - end - end - end - end; -load_module_on_option(Mod,_Opts) -> % Most likely Opts not a list! - load_module_on_option(Mod,[]). % Call without options. -%% ----------------------------------------------------------------------------- - -%% Help function taking a tuplelist of options turning them into a loopdata -%% structure. Returns the loopdata structure with the new values changed. -read_option_list([],LD) -> % Done, return loopdata. - LD; -read_option_list([{dependency,{Value,Node}}|Rest],LD) -> - read_option_list(Rest,LD#rt{dependency={Value,Node}}); -read_option_list([{dependency,Value}|Rest],LD) when is_integer(Value);Value==infinity -> - read_option_list(Rest,LD#rt{dependency={Value,node()}}); -read_option_list([overload|Rest],LD) -> % So that we can remove loadcheck. - read_option_list(Rest,LD#rt{overload=?NO_LOADCHECK}); -read_option_list([{overload,{MF,Interval}}|Rest],LD) - when is_integer(Interval);Interval==infinity -> - read_option_list(Rest,LD#rt{overload={MF,Interval,void,void}}); -read_option_list([{overload,{MF,Interval,InitMFA,RemoveMFA}}|Rest],LD) - when is_integer(Interval);Interval==infinity -> - read_option_list(Rest,LD#rt{overload={MF,Interval,InitMFA,RemoveMFA}}); -read_option_list([{overload,Interval}|Rest],LD) - when is_integer(Interval);Interval==infinity -> - read_option_list(Rest,LD#rt{overload={fun ?DEFAULT_OVERLOAD_FUNC/1, - Interval, - void, - void}}); -read_option_list([_|Rest],LD) -> % Unknown option. - read_option_list(Rest,LD). -%% ----------------------------------------------------------------------------- - -%% Help function which returns the version number for the runtime_tools -%% application. Since it is called from within the runtime_tools application -%% we can be "sure" that it really exists. -get_application_vsn() -> - {value,{_,_,VSN}}=lists:keysearch(runtime_tools,1,application:loaded_applications()), - VSN. -%% ----------------------------------------------------------------------------- - -%% Help function that examines an argument to determine if it is a list of files -%% or tracerdata. This since they are both complex structures, looking alike. -%% Returns 'tracerdata', 'files', 'false' or 'error'. Error is returned if it -%% can not be decided which it is. -is_list_of_files_or_tracerdata(What) -> - case inviso_rt_lib:is_tracerdata(What) of - true -> - tracerdata; - false -> - if - What==[] -> - false; - is_list(What),is_list(hd(What)) -> - files; - is_list(What) -> - case lists:keysearch(trace_log,1,What) of - {value,_} -> - files; - false -> - case lists:keysearch(ti_log,1,What) of - {value,_} -> - files; - false -> - error % Neither tracerdata nor list of files. - end - end; - true -> - error - end - end. -%% ------------------------------------------------------------------------------ - -%% Help function which removes all files in the ListOfFiles, assuming they -%% are located in Dir. -%% Returns a list of [{ok,FileName},...{error,Reason},...] -delete_files(Dir,ListOfFiles) -> - delete_files_2(Dir,ListOfFiles, []). - -delete_files_2(Dir,[File|Tail],Reply) when is_list(Dir),is_list(File) -> - case catch file:delete(filename:join(Dir,File)) of - ok -> - delete_files_2(Dir,Tail,[{ok,File}|Reply]); - {error,Posix} -> - delete_files_2(Dir,Tail,[{error,{Posix,File}}|Reply]); - {'EXIT',_Reason} -> % Probably not proper string. - delete_files_2(Dir,Tail,[{error,{badarg,[Dir,File]}}|Reply]) - end; -delete_files_2(Dir,[Faulty|Tail],Reply) -> - delete_files_2(Dir,Tail,[{error,{badarg,[Dir,Faulty]}}|Reply]); -delete_files_2(_,[],Reply) -> - Reply. -%% ----------------------------------------------------------------------------- - -%% Help function which lists all trace logs belonging to this tracerdata. -%% Note that this function operates on internal LogTD structures. -list_logs_tracelog({file,FileName}) when is_list(FileName) -> - case file:read_file_info(FileName) of - {ok,_} -> % The file exists. - {filename:dirname(FileName),[filename:basename(FileName)]}; - _ -> % The file does not exist - {filename:dirname(FileName),[]} - end; -list_logs_tracelog({file,Wrap}) when is_tuple(Wrap),element(2,Wrap)==wrap -> - case {element(1,Wrap),element(3,Wrap)} of - {FileName,Tail} when is_list(FileName),is_list(Tail) -> - case catch {filename:dirname(FileName),list_wrapset(FileName,Tail)} of - {'EXIT',_Reason} -> % Garbage in either lists. - {"",no_log}; % Interpret as no log for tracerdata. - Tuple -> - Tuple - end; - _ -> - {"",no_log} - end; -list_logs_tracelog(void) -> % Trace log not used. - {"",no_log}; -list_logs_tracelog(_) -> % Some fun or similar. - {"",no_log}. % Then there are no files to report. -%% ----------------------------------------------------------------------------- - -%% Help function which lists all ti-files belonging to this tracerdata. -%% Note that this function operates on the internal TiTD structure. -list_logs_tilog(TiTD) - when tuple_size(TiTD)>=2,element(1,TiTD)==file,is_list(element(2,TiTD)) -> - FileName=element(2,TiTD), - case file:read_file_info(FileName) of - {ok,_} -> % Yes the file exists. - {filename:dirname(FileName),[filename:basename(FileName)]}; - _ -> - {filename:dirname(FileName),[]} - end; -list_logs_tilog(void) -> % Internal representation for - {"",no_log}; % ti-file not in use. -list_logs_tilog(_) -> - {"",no_log}. -%% ----------------------------------------------------------------------------- - -%% Help function which lists all files belonging to the wrap-set specified by -%% Prefix and Suffix. Note that there can be a directory in Prefix as well. -%% Will fail if either of Prefix or Suffix are not proper strings. -%% Returns a list of files, without dirname. -list_wrapset(Prefix,Suffix) -> - Name=filename:basename(Prefix), - Dirname=filename:dirname(Prefix), - case file:list_dir(Dirname) of - {ok,Files} -> - RegExp="^"++list_wrapset_escapes(Name)++"[0-9]+"++ - list_wrapset_escapes(Suffix)++"$", - list_wrapset_2(Files,RegExp); - {error,_Reason} -> % Translate this to no files! - [] - end. - -list_wrapset_2([File|Rest],RegExp) -> - Length=length(File), - case re:run(File,RegExp) of - {match,[{0,Length}]} -> % This is a member of the set. - [File|list_wrapset_2(Rest,RegExp)]; - _ -> - list_wrapset_2(Rest,RegExp) - end; -list_wrapset_2([],_) -> - []. - -%% Help function which inserts escape characters infront of characters which -%% will otherwise be missinterpreted by the regexp function as meta rather than -%% just the character itself. -list_wrapset_escapes([$.|Rest]) -> - [$\\,$.|list_wrapset_escapes(Rest)]; -list_wrapset_escapes([Char|Rest]) -> - [Char|list_wrapset_escapes(Rest)]; -list_wrapset_escapes([]) -> - []. -%% ----------------------------------------------------------------------------- - - - - - - -%% ============================================================================== -%% Handler functions for implementing simple trace-message handlers. -%% ============================================================================== -%% -%% A handler must be a function taking two arguments. The first is the trace- -%% message. The second is datastructure used by the handler. The handler shall -%% returns (possibly) new datastructure. - -%% ------------------------------------------------------------------------------ -%% Function implementing a relayer. This function is used to creat a fun handler -%% if the relay option is used in tracer-data. -%% ------------------------------------------------------------------------------ -relay_handler(Msg,Tracer) -> - Tracer ! Msg, - Tracer. - -%% ------------------------------------------------------------------------------ -%% Function implementing a default terminal io handler. -%% ------------------------------------------------------------------------------ - -dhandler(end_of_trace, Out) -> - Out; -dhandler(Trace, Out) when element(1, Trace) == trace, - tuple_size(Trace) >= 3 -> - dhandler1(Trace, tuple_size(Trace), Out); -dhandler(Trace, Out) when element(1, Trace) == trace_ts, - tuple_size(Trace) >= 4 -> - dhandler1(Trace, tuple_size(Trace)-1, Out); -dhandler(Trace, Out) when element(1, Trace) == drop, - tuple_size(Trace) == 2 -> - io:format(Out, "*** Dropped ~p messages.~n", [element(2,Trace)]), - Out; -dhandler(Trace, Out) when element(1, Trace) == seq_trace, - tuple_size(Trace) >= 3 -> - SeqTraceInfo = case Trace of - {seq_trace, Lbl, STI, TS} -> - io:format(Out, "SeqTrace ~p [~p]: ", - [TS, Lbl]), - STI; - {seq_trace, Lbl, STI} -> - io:format(Out, "SeqTrace [~p]: ", - [Lbl]), - STI - end, - case SeqTraceInfo of - {send, Ser, Fr, To, Mes} -> - io:format(Out, "(~p) ~p ! ~p [Serial: ~p]~n", - [Fr, To, Mes, Ser]); - {'receive', Ser, Fr, To, Mes} -> - io:format(Out, "(~p) << ~p [Serial: ~p, From: ~p]~n", - [To, Mes, Ser, Fr]); - {print, Ser, Fr, _, Info} -> - io:format(Out, "-> ~p [Serial: ~p, From: ~p]~n", - [Info, Ser, Fr]); - Else -> - io:format(Out, "~p~n", [Else]) - end, - Out; -dhandler(_Trace, Out) -> - Out. - -dhandler1(Trace, Size, Out) -> -%%%! Self = self(), - From = element(2, Trace), - case element(3, Trace) of - 'receive' -> - case element(4, Trace) of - {dbg,ok} -> ok; - Message -> io:format(Out, "(~p) << ~p~n", [From,Message]) - end; - 'send' -> - Message = element(4, Trace), - case element(5, Trace) of -%%%! This causes messages to disappear when used by ttb (observer). Tests -%%%! so far show that there is no difference in results with dbg even if I -%%%! comment it out, so I hope this is only some old code which isn't -%%%! needed anymore... /siri -%%%! Self -> ok; - To -> io:format(Out, "(~p) ~p ! ~p~n", [From,To,Message]) - end; - call -> - case element(4, Trace) of - MFA when Size == 5 -> - Message = element(5, Trace), - io:format(Out, "(~p) call ~s (~p)~n", - [From,ffunc(MFA),Message]); - MFA -> - io:format(Out, "(~p) call ~s~n", [From,ffunc(MFA)]) - end; - return -> %% To be deleted... - case element(4, Trace) of - MFA when Size == 5 -> - Ret = element(5, Trace), - io:format(Out, "(~p) old_ret ~s -> ~p~n", - [From,ffunc(MFA),Ret]); - MFA -> - io:format(Out, "(~p) old_ret ~s~n", [From,ffunc(MFA)]) - end; - return_from -> - MFA = element(4, Trace), - Ret = element(5, Trace), - io:format(Out, "(~p) returned from ~s -> ~p~n", - [From,ffunc(MFA),Ret]); - return_to -> - MFA = element(4, Trace), - io:format(Out, "(~p) returning to ~s~n", [From,ffunc(MFA)]); - spawn when Size == 5 -> - Pid = element(4, Trace), - MFA = element(5, Trace), - io:format(Out, "(~p) spawn ~p as ~s~n", [From,Pid,ffunc(MFA)]); - Op -> - io:format(Out, "(~p) ~p ~s~n", [From,Op,ftup(Trace,4,Size)]) - end, - Out. - - -%%% These f* functions returns non-flat strings - -%% {M,F,[A1, A2, ..., AN]} -> "M:F(A1, A2, ..., AN)" -%% {M,F,A} -> "M:F/A" -ffunc({M,F,Argl}) when is_list(Argl) -> - io_lib:format("~p:~p(~s)", [M, F, fargs(Argl)]); -ffunc({M,F,Arity}) -> - io_lib:format("~p:~p/~p", [M,F,Arity]); -ffunc(X) -> io_lib:format("~p", [X]). - -%% Integer -> "Integer" -%% [A1, A2, ..., AN] -> "A1, A2, ..., AN" -fargs(Arity) when is_integer(Arity) -> integer_to_list(Arity); -fargs([]) -> []; -fargs([A]) -> io_lib:format("~p", [A]); %% last arg -fargs([A|Args]) -> [io_lib:format("~p,", [A]) | fargs(Args)]; -fargs(A) -> io_lib:format("~p", [A]). % last or only arg - -%% {A_1, A_2, ..., A_N} -> "A_Index A_Index+1 ... A_Size" -ftup(Trace, Index, Index) -> - io_lib:format("~p", [element(Index, Trace)]); -ftup(Trace, Index, Size) -> - [io_lib:format("~p ", [element(Index, Trace)]) - | ftup(Trace, Index+1, Size)]. -%% ------------------------------------------------------------------------------ - -%% ============================================================================== -%% Functions handling the trace-port. Copied from dbg.erl -%% ============================================================================== - -trace_port_control(Port, flush) -> - case trace_port_control(Port, $f, "") of - {ok, [0]} -> ok; - {ok, _} -> {error, not_supported_by_trace_driver}; - Other -> Other - end. - -trace_port_control(Port, Command, Arg) when is_port(Port)-> - case catch port_control(Port, Command, Arg) of - {'EXIT', _} -> {error, {no_trace_driver, node()}}; - Result -> Result - end. - - -trace_port(file, {Filename, wrap, Tail}) -> - trace_port(file, {Filename, wrap, Tail, 128*1024}); -trace_port(file, {Filename, wrap, Tail, WrapSize}) -> - trace_port(file, {Filename, wrap, Tail, WrapSize, 8}); -trace_port(file, {Filename, wrap, Tail, WrapSize, WrapCnt}) - when is_list(Tail), - is_integer(WrapSize), WrapSize >= 0, WrapSize < (1 bsl 32), - is_integer(WrapCnt), WrapCnt >= 1, WrapCnt < (1 bsl 32) -> - trace_port1(file, Filename, {wrap, Tail, WrapSize, WrapCnt, 0}); -trace_port(file, {Filename, wrap, Tail, {time, WrapTime}, WrapCnt}) - when is_list(Tail), - is_integer(WrapTime), WrapTime >= 1, WrapTime < (1 bsl 32), - is_integer(WrapCnt), WrapCnt >= 1, WrapCnt < (1 bsl 32) -> - trace_port1(file, Filename, {wrap, Tail, 0, WrapCnt, WrapTime}); -trace_port(file, Filename) when is_list(Filename) -> - trace_port1(file, Filename, nowrap); - -trace_port(ip, Portno) when is_integer(Portno) -> - trace_port(ip,{Portno,50}); - -trace_port(ip, {Portno, Qsiz}) when is_integer(Portno), is_integer(Qsiz) -> - fun() -> - Driver = "trace_ip_drv", - Dir1 = filename:join(code:priv_dir(runtime_tools), "lib"), - case catch erl_ddll:load_driver(Dir1, Driver) of - ok -> - ok; - _ -> - Dir2 = filename:join( - Dir1, - erlang:system_info(system_architecture)), - catch erl_ddll:load_driver(Dir2, Driver) - end, - L = lists:flatten( - io_lib:format("~s ~p ~p 2", - [Driver, Portno, Qsiz])), - open_port({spawn, L}, [eof]) - end. - -trace_port1(file, Filename, Options) -> - Driver = "trace_file_drv", - fun() -> - Name = filename:absname(Filename), - %% Absname is needed since the driver uses - %% the supplied name without further investigations, - %% and if the name is relative the resulting path - %% might be too long which can cause a bus error - %% on vxworks instead of a nice error code return. - %% Also, the absname must be found inside the fun, - %% in case the actual node where the port shall be - %% started is on another node (or even another host) - {Wrap, Tail} = - case Options of - {wrap, T, WrapSize, WrapCnt, WrapTime} -> - {lists:flatten( - io_lib:format("w ~p ~p ~p ~p ", - [WrapSize, WrapCnt, WrapTime, - length(Name)])), - T}; - nowrap -> - {"", ""} - end, - Command = Driver ++ " " ++ Wrap ++ "n " ++ Name ++ Tail, - Dir1 = filename:join(code:priv_dir(runtime_tools), "lib"), - case catch erl_ddll:load_driver(Dir1, Driver) of - ok -> - ok; - _ -> - Dir2 = filename:join( - Dir1, - erlang:system_info(system_architecture)), - catch erl_ddll:load_driver(Dir2, Driver) - end, - if element(1, Options) == wrap -> - %% Delete all files from any previous wrap log - Files = wrap_postsort(wrap_presort(Name, Tail)), - lists:foreach( - fun(N) -> file:delete(N) end, - Files); - true -> ok - end, - open_port({spawn, Command}, [eof]) - end. - -%% Find all possible wrap log files. -%% Returns: a list of sort converted filenames. -%% -%% The sort conversion is done by extracting the wrap sequence counter -%% from the filename, and calling wrap_encode/2. -wrap_presort(Filename, Tail) -> - Name = filename:basename(Filename), - Dirname = filename:dirname(Filename), - case file:list_dir(Dirname) of - {ok, Files} -> - lists:zf( - fun(N) -> - case match_front(N, Name) of - false -> - false; - X -> - case match_rear(X, Tail) of - false -> - false; - C -> % Counter - case match_0_9(C) of - true -> - {true, -% filename:join(Dirname, N)} - wrap_encode( - filename:join(Dirname, N), - C)}; - false -> - false - end - end - end - end, - Files); - _ -> - [] - end. - -%% Extract the filenames from a list of sort converted ones. -wrap_postsort(Files) -> - lists:map(fun wrap_name/1, Files). - -wrap_encode(N, C) -> - {list_to_integer(C), N}. - -wrap_name({_C, N}) -> - N. - -%% Returns what is left of ListA when removing all matching -%% elements from ListB, or false if some element did not match, -%% or if ListA runs out of elements before ListB. -match_front(ListA, []) when is_list(ListA) -> - ListA; -match_front([], ListB) when is_list(ListB) -> - false; -match_front([Hd|TlA], [Hd|TlB]) -> - match_front(TlA,TlB); -match_front([_HdA|_], [_HdB|_]) -> - false. - -%% Reversed version of match_front/2 -match_rear(ListA, ListB) when is_list(ListA), is_list(ListB) -> - case match_front(lists:reverse(ListA), lists:reverse(ListB)) of - false -> - false; - List -> - lists:reverse(List) - end. - -%% Returns true if the non-empty list arguments contains all -%% characters $0 .. $9. -match_0_9([]) -> - false; -match_0_9([H]) when is_integer(H), $0 =< H, H =< $9 -> - true; -match_0_9([H|T]) when is_integer(H), $0 =< H, H =< $9 -> - match_0_9(T); -match_0_9(L) when is_list(L) -> - false. -%% ----------------------------------------------------------------------------- - - -%% ----------------------------------------------------------------------------- -%% Functions working on the tracerdata structure. -%% ----------------------------------------------------------------------------- - -%% Tracerdata is the structure which specifies to where tracing is logged at this -%% runtime component. It may now (and in the future specify) several things. -%% Currently it can consist of: -%% LogTD: specifying how trace-log data shall be handled. -%% TiTD : trace information, specifying how trace information shall be handled. -%% -%% Tracerdata may also contain quick or standard forms of LogTD and/or TiTD. -%% For instance if a standard handler-fun shall be used. The handler fun is not -%% part of the tracerdata but rather specified by a constant. - - -%% Help function that translates an input-tracerdata to useful internal formats. -%% This since the tracerdata may consist of specifications which shall be -%% translated into funs or similar. -%% Returns {ok,LogTD,TiTD} or {error,Reason}. -%% Note that TiTD may be 'void' since TiTD is not mandatory. -translate_td(TracerData) when is_list(TracerData) -> % Both log and ti. - case translate_td_logtd(get_trace_log_tracerdata(TracerData)) of - {ok,LogTD} -> - case translate_td_titd(get_ti_log_tracerdata(TracerData)) of - {ok,TiTD} -> - {ok,LogTD,TiTD}; - {error,Reason} -> - {error,Reason} - end; - {error,Reason} -> - {error,Reason} - end; -translate_td(TracerData) -> % The it is just LogTD!? - case translate_td_logtd(TracerData) of - {ok,LogTD} -> - {ok,LogTD,void}; - {error,Reason} -> - {error,Reason} - end. -%% ----------------------------------------------------------------------------- - -%% Help function translating trace-log tracerdata. -translate_td_logtd(collector) -> % This rt will act as receiver. - {ok,{fun dhandler/2,user}}; % Simple terminal io. -translate_td_logtd({relayer,Tracer}) when is_pid(Tracer) -> - {ok,{fun relay_handler/2,Tracer}}; % Relay trace-msg to Tracer-pid. -translate_td_logtd({HandlerFun,Data}) when is_function(HandlerFun) -> - {ok,{HandlerFun,Data}}; % Own invented fun. -translate_td_logtd({Type,Parameters}) when Type==ip;Type==file -> - {ok,{Type,Parameters}}; % Built in trace-port -translate_td_logtd(false) -> % Unusual but no trace log. - {ok,void}; -translate_td_logtd(Arg) -> - {error,{bad_log_td,Arg}}. -%% ----------------------------------------------------------------------------- - -%% Help function translating ti-log tracerdata. -translate_td_titd(TiTD={file,FileName}) when is_list(FileName) -> - {ok,TiTD}; -translate_td_titd({file,FileName, - {InitPublLDmfa={M1,F1,L1}, - RemovePublLDmf={M2,F2}, - CleanPublLDmf={M3,F3}}}) - when is_list(FileName),is_atom(M1),is_atom(F1),is_atom(M2),is_atom(F2),is_list(L1),is_atom(M3),is_atom(F3) -> - {ok,{file,FileName,{InitPublLDmfa,RemovePublLDmf,CleanPublLDmf}}}; -translate_td_titd({file,FileName, - {InitPublLDmfa={M1,F1,L1}, - void, - CleanPublLDmf={M3,F3}}}) - when is_list(FileName),is_atom(M1),is_atom(F1),is_list(L1),is_atom(M3),is_atom(F3) -> - {ok,{file,FileName,{InitPublLDmfa,void,CleanPublLDmf}}}; -translate_td_titd(false) -> % Means no ti-tracerdata. - {ok,void}; -translate_td_titd(TiTD) -> - {error,{bad_ti_td,TiTD}}. -%% ----------------------------------------------------------------------------- - -%% This function retrieves the trace-log part of a TracerData list structure. -%% Returns TraceLogTD or 'false'. -get_trace_log_tracerdata(TracerData) -> - case lists:keysearch(trace,1,TracerData) of - {value,{_,LogTD}} -> - LogTD; - false -> - false - end. -%% ----------------------------------------------------------------------------- - -%% This function retrieves the ti-log part of a TracerData list structure. -%% Returns TiLogTD or 'false'. -get_ti_log_tracerdata(TracerData) -> - case lists:keysearch(ti,1,TracerData) of - {value,{_,TiTD}} -> - TiTD; - false -> - false - end. -%% ----------------------------------------------------------------------------- - -%% Help function which checks that parameters to the built in trace-port are -%% sane. -check_traceport_parameters(Type,Args) -> - case {Type,Args} of - {file,{FileName,wrap,Tail}} when is_list(FileName),is_list(Tail) -> - ok; - {file,{FileName,wrap,Tail,WrapSize}} - when is_list(FileName), - is_list(Tail), - is_integer(WrapSize),WrapSize>=0,WrapSize< (1 bsl 32) -> - ok; - {file,{FileName,wrap,Tail,WrapSize,WrapCnt}} - when is_list(FileName),is_list(Tail), - is_integer(WrapSize), WrapSize >= 0, WrapSize < (1 bsl 32), - is_integer(WrapCnt), WrapCnt >= 1, WrapCnt < (1 bsl 32) -> - ok; - {file,{FileName,wrap,Tail,{time,WrapTime},WrapCnt}} - when is_list(FileName),is_list(Tail), - is_integer(WrapTime), WrapTime >= 1, WrapTime < (1 bsl 32), - is_integer(WrapCnt), WrapCnt >= 1, WrapCnt < (1 bsl 32) -> - ok; - {file,FileName} when is_list(FileName) -> - ok; - {ip,Portno} when is_integer(Portno),Portno=<16#FFFF -> - ok; - {ip,{Portno,Qsiz}} when is_integer(Portno),Portno=<16#FFFF,is_integer(Qsiz) -> - ok; - _ -> - {error,{trace_port_args,[Type,Args]}} - end. -%% ----------------------------------------------------------------------------- - - -%% ----------------------------------------------------------------------------- -%% Default overload functionality. -%% ----------------------------------------------------------------------------- - -%% A default overload protection function. An overload function must take -%% one argument and return 'ok' or {suspend,SuspendReason}. -default_overload_func(_) -> - case process_info(self(),message_queue_len) of - {message_queue_len,N} when N > 1000 -> - {suspend,rt_max_queue_len}; - _ -> - ok - end. -%% ----------------------------------------------------------------------------- - -%% ============================================================================= -%% Functions working on the internal loopdata structure. -%% ============================================================================= - -%% Help function simply adding Fetcher as a fetcher process to the loopdata. -%% Returns a new loopdata structure. -add_fetcher_ld(Fetcher,LD) -> - LD#rt{fetchers=[Fetcher|LD#rt.fetchers]}. -%% ----------------------------------------------------------------------------- - -%% Help function investigating if the first argument is a known fetcher process -%% or not. If it is, it also removed it from the fetchers list in the loopdata -%% structure. -%% Returns {true,NewLoopData} or 'false'. -remove_fetcher_ld(Fetcher,LD) -> - NewFetchers=lists:delete(Fetcher,LD#rt.fetchers), - if - NewFetchers/=LD#rt.fetchers -> - {true,LD#rt{fetchers=NewFetchers}}; - true -> % No it was not a fetcher process. - false - end. -%% ----------------------------------------------------------------------------- - -%%% end of file - diff --git a/lib/runtime_tools/src/inviso_rt_lib.erl b/lib/runtime_tools/src/inviso_rt_lib.erl deleted file mode 100644 index 5dfe14068a..0000000000 --- a/lib/runtime_tools/src/inviso_rt_lib.erl +++ /dev/null @@ -1,474 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2011. 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 : inviso_rt_lib.erl -%% Author : Lennart �hman <[email protected]> -%% Description : -%% -%% Created : 27 Sep 2005 by Lennart �hman <[email protected]> -%% ------------------------------------------------------------------------------ --module(inviso_rt_lib). - --export([expand_regexp/2,expand_regexp/3,expand_regexp/4]). --export([is_tracerdata/1]). --export([transform/2]). - --export([rpc/4,rpc/5,match_modules/2,match_modules/3]). --export([debug/3]). - -%% ------------------------------------------------------------------------------ - -%% ============================================================================== -%% Exported API functions. -%% ============================================================================== - -%% ------------------------------------------------------------------------------ -%% expand_regexp(Nodes,RegExpDir,RegExpMod,Opts) = [{Node,Answer},...] | {error,Reason} -%% expand_regexp(Nodes,RegExpMod,Opts) = [{Node,Answer},...] | {error,Reason} -%% expand_regexp(RegExpDir,RegExpMod,Opts) = ListOfModules | {error,Reason} -%% expand_regexp(RegExpMod,Opts) = ListOfModules | {error,Reason} -%% Nodes=List of all nodes (atoms) where to expand. -%% RegExpDir=Reg.exp (string) specifying directories. -%% RegExpMod=Reg.exp (string) specifying module names. -%% Node=node name (atom). -%% Opts=[Opt,...] -%% Opt=only_loaded -%% Answer=List of modules (atoms) | 'badrpc' -%% -%% Expands, concurrently, the regular expression on Nodes and returns a list -%% of what modules it expanded to on the different nodes. Note that it may -%% differ between Erlang nodes depending on whether the modules are the same -%% or not. Also note that all modules becomes loaded as a result. -%% RegExpDir can further limit the modules. It introduces the requirement that -%% a module must be loaded from a directory with a path satisfying the RegExpDir. -%% All regular expression are according to the standard lib regexp module. -expand_regexp(RegExpMod,Opts) when is_list(RegExpMod),is_list(Opts) -> - match_modules(RegExpMod,Opts); -expand_regexp(RegExpMod,Opts) -> - {error,{badarg,[RegExpMod,Opts]}}. -expand_regexp(NodesOrRegExpDir,RegExpMod,Opts) - when is_list(NodesOrRegExpDir),is_list(RegExpMod),is_list(Opts) -> - case is_list_of_atoms(NodesOrRegExpDir) of - true -> % Interpret as list of nodes. - lists:foreach(fun(N)->spawn(?MODULE,rpc,[self(),N,RegExpMod,Opts]) end, - NodesOrRegExpDir), - expand_regexp_answers(NodesOrRegExpDir,[]); - false -> % Interpret as a string. - match_modules(NodesOrRegExpDir,RegExpMod,Opts) - end; -expand_regexp(NodesOrRegExpDir,RegExpMod,Opts) -> - {error,{badarg,[NodesOrRegExpDir,RegExpMod,Opts]}}. -expand_regexp(Nodes,RegExpDir,RegExpMod,Opts) - when is_list(Nodes),is_list(RegExpDir),is_list(RegExpMod),is_list(Opts) -> - lists:foreach(fun(N)-> - spawn(?MODULE,rpc,[self(),N,RegExpDir,RegExpMod,Opts]) - end, - Nodes), - expand_regexp_answers(Nodes,[]); -expand_regexp(Nodes,RegExpDir,RegExpMod,Opts) -> - {error,{badarg,[Nodes,RegExpDir,RegExpMod,Opts]}}. - -expand_regexp_answers([],Answers) -> Answers; % List of [{Node,Answer},...]. -expand_regexp_answers(Nodes,Answers) -> - receive - {?MODULE,Node,Answer} -> - expand_regexp_answers(lists:delete(Node,Nodes),[{Node,Answer}|Answers]) - end. -%% ------------------------------------------------------------------------------ - -%% is_tracerdata(TracerData)=true|false -%% Answers the question if TracerData is proper tracerdata. Note that true can be -%% returned if it resembles tracerdata very closely. -is_tracerdata({Fun,_Data}) when is_function(Fun) -> true; -is_tracerdata({relayer,To}) when is_pid(To);is_atom(To) -> true; -is_tracerdata(collector) -> true; -is_tracerdata({file,Param}) when is_tuple(Param);is_list(Param) -> true; -is_tracerdata({ip,_Param}) -> true; -is_tracerdata([{trace,LogTD}|Rest]) -> - case is_tracerdata(LogTD) of - true -> - is_tracerdata(Rest); - false -> - false - end; -is_tracerdata([{ti,TiData}|Rest]) -> - case is_tidata(TiData) of - true -> - is_tracerdata(Rest); - false -> - false - end; -is_tracerdata([]) -> - true; -is_tracerdata(_) -> - false. - -is_tidata({file,FileName}) when is_list(FileName) -> true; -is_tidata({file,FileName,{M,F,Args}}) when is_list(FileName),is_atom(M),is_atom(F),is_list(Args) -> - true; -is_tidata(_) -> false. -%% ------------------------------------------------------------------------------ - - -%% ============================================================================== -%% Help functions. -%% ============================================================================== - -%% Help function intended to be run in its own process. Will report with -%% a message when done. -%% This function will be spawned on. -rpc(Parent,Node,RegExpMod,Opts) -> - case rpc:call(Node,?MODULE,match_modules,[RegExpMod,Opts]) of - {badrpc,_Reason} -> % The node is probably not healthy. - Parent ! {?MODULE,Node,badrpc}; - Modules -> - Parent ! {?MODULE,Node,Modules} - end. - -rpc(Parent,Node,RegExpDir,RegExpMod,Opts) -> - case rpc:call(Node,?MODULE,match_modules,[RegExpDir,RegExpMod,Opts]) of - {badrpc,_Reason} -> % The node is probably not healthy. - Parent ! {?MODULE,Node,badrpc}; - Modules -> - Parent ! {?MODULE,Node,Modules} - end. -%% ------------------------------------------------------------------------------ - - -%% ============================================================================== -%% Exported function which actually shall be in code.erl. -%% ============================================================================== - -%% match_modules(RegExpMod,Actions) = [Module,...] | {error,Reason} -%% match_modules(RegExpDir,RegExpMod,Actions)=[Module,...] | {error,Reason} -%% RegExpMod=Erlang regular expression describing module names (string). -%% RegExpDir=Erlang regular expression describing directory paths(string) | -%% void -%% Actions=List of;'only_loaded'. -%% -%% Function which matches a regular expresion against module names. The function -%% can also match the directory from where the module is loaded or will be loaded -%% against a regular expresion for directory paths. -%% The function uses the same strategy as code-loading if the same module is -%% discovered in several places. -%% (1) An already loaded module shadows all other occurancies. -%% (2) .beams found in by a path shadows .beams found by paths later in the -%% code paths. -%% -%% Description of actions: -%% only_loaded: Only consider modules which are loaded. -match_modules(RegExpMod,Actions) -> - match_modules(void,RegExpMod,Actions). -match_modules(RegExpDir,RegExpMod,Actions) -> - AllLoaded=code:all_loaded(), - Mods1=handle_expand_regexp_2(AllLoaded,RegExpDir,RegExpMod,[]), - case lists:member(only_loaded,Actions) of % Shall we do not loaded too? - false -> % Ok, search all paths too then. - Paths=code:get_path(), - handle_expand_regexp_3(Paths,RegExpDir,RegExpMod,AllLoaded,Mods1); - true -> % Only loaded modules then. - Mods1 - end. - - -%% Help function which traverses all loaded modules and determines -%% which shall be returned. First we check that the module satisfies the -%% module-regexp. Then we, if a dir reg-exp is given, checks that the -%% module is loaded from an approved path. Note that if it can not be -%% determined from where it was loaded (like preloaded or cover-compiled -%% etc), but dir reg-exps are used. That module will be excluded. -%% Returns a list of modules. -handle_expand_regexp_2([{Mod,Path}|Rest],RegExpDir,RegExpMod,Result) -> - ModStr=atom_to_list(Mod), - ModLen=length(ModStr), - case re:run(ModStr,RegExpMod) of - {match,[{0,ModLen}]} -> % Ok, The regexp matches the module. - if - is_list(RegExpDir),is_atom(Path) -> % Preloaded or covercompiled... - handle_expand_regexp_2(Rest,RegExpDir,RegExpMod,Result); - is_list(RegExpDir),is_list(Path) -> % Dir reg-exp is used! - PathOnly=filename:dirname(Path), % Must remove beam-file name. - case re:run(PathOnly,RegExpDir,[{capture,none}]) of - match -> % Did find a match, that is enough! - handle_expand_regexp_2(Rest,RegExpDir,RegExpMod,[Mod|Result]); - _ -> % Either error or nomatch. - handle_expand_regexp_2(Rest,RegExpDir,RegExpMod,Result) - end; - true -> % Otherwise already done! - handle_expand_regexp_2(Rest,RegExpDir,RegExpMod,[Mod|Result]) - end; - _ -> % Then Mod is not part of the set. - handle_expand_regexp_2(Rest,RegExpDir,RegExpMod,Result) - end; -handle_expand_regexp_2([],_,_,Result) -> Result. - -%% Help function which traverses all paths and looks for modules satisfying -%% the module reg.exp. -%% Returns a list of unique module names. -handle_expand_regexp_3([Path|Rest],RegExpDir,RegExpMod,AllLoaded,Result) -> - if - is_list(RegExpDir) -> % We must consider the directory name. - AbsPath= - case filename:pathtype(Path) of - absolute -> % Is already abs. - Path; - relative -> % Then it must be made absolute. - filename:absname(Path); - volumerelative -> % Only on Windows!? - filename:absname(Path) - end, - case re:run(AbsPath,RegExpDir,[{capture,none}]) of - match -> % Ok, the directory is allowed. - NewResult=handle_expand_regexp_3_1(Path,RegExpMod,AllLoaded,Result), - handle_expand_regexp_3(Rest,RegExpDir,RegExpMod,AllLoaded,NewResult); - _ -> % This directory does not qualify. - handle_expand_regexp_3(Rest,RegExpDir,RegExpMod,AllLoaded,Result) - end; - true -> % RegExpDir is not used! - NewResult=handle_expand_regexp_3_1(Path,RegExpMod,AllLoaded,Result), - handle_expand_regexp_3(Rest,RegExpDir,RegExpMod,AllLoaded,NewResult) - end; -handle_expand_regexp_3([],_,_,_,Result) -> Result. - -handle_expand_regexp_3_1(Path,RegExpMod,AllLoaded,Result) -> - case file:list_dir(Path) of - {ok,FileNames} -> - handle_expand_regexp_3_2(FileNames,RegExpMod,AllLoaded,Result); - {error,_Reason} -> % Bad path!? Skip it. - Result - end. - -handle_expand_regexp_3_2([File|Rest],RegExpMod,AllLoaded,Result) -> - case filename:extension(File) of - ".beam" -> % It is a beam-file. Consider it! - ModStr=filename:basename(File,".beam"), - Mod=list_to_atom(ModStr), - case {lists:keysearch(Mod,1,AllLoaded),lists:member(Mod,Result)} of - {false,false} -> % This module is not tried before. - ModLen=length(ModStr), - case re:run(ModStr,RegExpMod) of - {match,[{0,ModLen}]} -> % This module satisfies the regexp. - handle_expand_regexp_3_2(Rest,RegExpMod,AllLoaded,[Mod|Result]); - _ -> % Error or not perfect match. - handle_expand_regexp_3_2(Rest,RegExpMod,AllLoaded,Result) - end; - {_,_} -> % This module is already tested. - handle_expand_regexp_3_2(Rest,RegExpMod,AllLoaded,Result) - end; - _ -> % Not a beam-file, skip it. - handle_expand_regexp_3_2(Rest,RegExpMod,AllLoaded,Result) - end; -handle_expand_regexp_3_2([],_,_,Result) -> Result. -%% ------------------------------------------------------------------------------ - -%% Help function which finds out if its argument is a list of zero or more -%% atoms. -%% Returns 'true' or 'false'. -is_list_of_atoms([A|Rest]) when is_atom(A) -> - is_list_of_atoms(Rest); -is_list_of_atoms([_|_]) -> - false; -is_list_of_atoms([]) -> - true. -%% ------------------------------------------------------------------------------ - - -%% ============================================================================= -%% Functions transforming function calls in trace-case file. -%% ============================================================================= - -%% transform(Exprs,Translations)=NewExprs -%% Exprs=list(); List of abstract format erlang terms, as returned by -%% io:parse_erl_exprs/2. -%% Translations=list(); List of translations from function calls to other -%% function calls. [{Mod,Func,Arity,{NewMod,NewFunc,ParamTransformMF}},...] -%% Mod can actually be omitted, ParamTransformMF shall be {M,F} where F is -%% a function taking one argument (the parameter list), and returning the -%% new parameter list. It can also be anything else should no transformation -%% of the parameters be the case. -%% -%% Function that transforms function calls in a trace-case file. The transform/2 -%% can only transform shallow function calls. I.e where both module and function -%% name are specified as atoms. Any binding-environment is not examined. -transform([Expr|Rest],Translations) -> - [transform_2(Expr,Translations)|transform(Rest,Translations)]; -transform([],_) -> - []. - -%% Help function handling a single expr. -transform_2({call,L1,{remote,L2,ModExpr,FuncExpr},Params},Translations) -> - case transform_2(ModExpr,Translations) of - {atom,L3,M} -> - case transform_2(FuncExpr,Translations) of - {atom,L4,F} -> % Now we have a M:F/Arity! - case do_call_translation(M,F,Params,Translations) of - {ok,NewM,NewF,NewP} -> - NewParams=transform(NewP,Translations), - {call,L1,{remote,L2,{atom,L3,NewM},{atom,L4,NewF}},NewParams}; - false -> % No translation or faulty. - NewParams=transform(Params,Translations), - {call,L1,{remote,L2,ModExpr,FuncExpr},NewParams} - end; - NewFuncExpr -> % Not translated to a shallow term. - NewParams=transform(Params,Translations), - {call,L1,{remote,L2,ModExpr,NewFuncExpr},NewParams} - end; - NewModExpr -> % Not translated to a shallow term. - NewFuncExpr=transform_2(FuncExpr,Translations), - NewParams=transform(Params,Translations), - {call,L1,{remote,L2,NewModExpr,NewFuncExpr},NewParams} - end; -transform_2({call,L1,FuncExpr,Params},Translations) -> - case transform_2(FuncExpr,Translations) of - {atom,L3,F} -> % Now we have a M:F/Arity! - case do_call_translation(F,Params,Translations) of - {ok,NewM,NewF,NewP} -> % It is turned into a global call. - NewParams=transform(NewP,Translations), - {call,L1,{remote,L1,{atom,L3,NewM},{atom,L3,NewF}},NewParams}; - false -> % No translation or faulty. - NewParams=transform(Params,Translations), - {call,L1,FuncExpr,NewParams} - end; - NewFuncExpr -> % Not translated to a shallow term. - NewParams=transform(Params,Translations), - {call,L1,NewFuncExpr,NewParams} - end; -transform_2({match,L,P,E},Translations) -> - NewPattern=transform_2(P,Translations), - NewExpr=transform_2(E,Translations), - {match,L,NewPattern,NewExpr}; -transform_2({op,L,Op,Arg1,Arg2},Translations) -> - NewArg1=transform_2(Arg1,Translations), - NewArg2=transform_2(Arg2,Translations), - {op,L,Op,NewArg1,NewArg2}; -transform_2({op,L,Op,Arg},Translations) -> - NewArg=transform_2(Arg,Translations), - {op,L,Op,NewArg}; -transform_2({block,L,Body},Translations) -> - NewBody=transform(Body,Translations), - {block,L,NewBody}; -transform_2({'if',L,Clauses},Translations) -> - NewClauses=transform_clauses(Clauses,Translations), - {'if',L,NewClauses}; -transform_2({'case',L,Func,Clauses},Translations) -> - NewFunc=transform_2(Func,Translations), - NewClauses=transform_clauses(Clauses,Translations), - {'case',L,NewFunc,NewClauses}; -transform_2({'fun',L,{clauses,Clauses}},Translations) -> - NewClauses=transform_clauses(Clauses,Translations), - {'fun',L,NewClauses}; -transform_2({lc,L,Items,GeneratorsFilters},Translations) -> - NewItem=transform_2(Items,Translations), - NewGensAndFilters=transform_gensandfilters(GeneratorsFilters,Translations), - {lc,L,NewItem,NewGensAndFilters}; -transform_2({'catch',L,Expr},Translations) -> - NewExpr=transform_2(Expr,Translations), - {'catch',L,NewExpr}; -transform_2({tuple,L,Elements},Translations) -> - NewElements=transform(Elements,Translations), - {tuple,L,NewElements}; -transform_2({cons,L,Element,Tail},Translations) -> - NewElement=transform_2(Element,Translations), - NewTail=transform_2(Tail,Translations), - {cons,L,NewElement,NewTail}; -transform_2({nil,L},_) -> - {nil,L}; -transform_2({bin,L,Elements},Translations) -> - NewElements=transform_binary(Elements,Translations), - {bin,L,NewElements}; -transform_2(Expr,_) -> % Can be a var for instance. - Expr. - -transform_binary([{bin_element,L,Val,Size,TSL}|Rest],Translations) -> - NewVal=transform_2(Val,Translations), - NewSize=transform_2(Size,Translations), - [{bin_element,L,NewVal,NewSize,TSL}|transform_binary(Rest,Translations)]; -transform_binary([],_) -> - []. - -transform_clauses([{clause,L,Pattern,Guards,Body}|Rest],Translations) -> - NewPattern=transform(Pattern,Translations), - NewBody=transform(Body,Translations), - [{clause,L,NewPattern,Guards,NewBody}|transform_clauses(Rest,Translations)]; -transform_clauses([],_Translations) -> - []. - -transform_gensandfilters([{generator,L,Pattern,Exprs}|Rest],Translations) -> - NewExprs=transform(Exprs,Translations), - [{generator,L,Pattern,NewExprs}|transform_gensandfilters(Rest,Translations)]; -transform_gensandfilters([Expr|Rest],Translations) -> - [transform_2(Expr,Translations)|transform_gensandfilters(Rest,Translations)]; -transform_gensandfilters([],_) -> - []. -%% ------------------------------------------------------------------------------ - -%% This is the heart of the translation functionality. Here we actually try to -%% replace calls to certain functions with other calls. This can include removing -%% arguments. -do_call_translation(M,F,Params,Translations) -> - case lists:keysearch({M,F,length(Params)},1,Translations) of - {value,{_,{NewM,NewF,ArgFun}}} -> % Lets transform the function. - do_call_translation_2(Params,NewM,NewF,ArgFun); - _ -> - false % No translations at all. - end. -do_call_translation(F,Params,Translations) -> - case lists:keysearch({F,length(Params)},1,Translations) of - {value,{_,{NewM,NewF,ArgFun}}} -> % Lets transform the function. - do_call_translation_2(Params,NewM,NewF,ArgFun); - _ -> - false % No translations at all. - end. - -do_call_translation_2(Params,NewM,NewF,ArgFun) -> - case ArgFun of - {M,F} when is_atom(M),is_atom(F) -> - case catch M:F(Params) of - {'EXIT',_Reason} -> - false; % If it does not work, skipp it. - MungedParams when is_list(MungedParams) -> - {ok,NewM,NewF,MungedParams}; - _ -> - false - end; - _ -> % No munging of parameters. - {ok,NewM,NewF,Params} - end. -%% ------------------------------------------------------------------------------ - - -%% ============================================================================= -%% Functions for the runtime component internal debugging system. -%% ============================================================================= - -%% The debug system is meant to provide tracing of ttb at different levels. -%% -%% debug(What,Level,Description) -> nothing significant. -%% What : controls what kind of event. This can both be certain parts of ttb -%% as well as certain levels (info to catastrophy). -%% Level: Determines if What shall be printed or not. -%% Description: this is what happend. -debug(off,_What,_Description) -> - true; % Debug is off, no action. -debug(On,What,Description) -> - debug_2(On,What,Description). - -debug_2(_,What,Description) -> - io:format("INVISO DEBUG:~w, ~p~n",[What,Description]). -%% ----------------------------------------------------------------------------- diff --git a/lib/runtime_tools/src/inviso_rt_meta.erl b/lib/runtime_tools/src/inviso_rt_meta.erl deleted file mode 100644 index 6865dc2242..0000000000 --- a/lib/runtime_tools/src/inviso_rt_meta.erl +++ /dev/null @@ -1,1207 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2006-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% -%% -%% Author: Lennart �hman, [email protected] -%% -%% This module implements the meta tracer process belonging to the -%% runtime component. Its main purpose is to write the ti-file (traceinformation). -%% The ti-file contains translations between process id:s and what ever "you" -%% want to read in the merged and formatted logfile. -%% This process interacts with the runtime component process. -%% -%% Currently it handles the following types of ti-files: -%% Plain raw, binary log. -%% Relay to other inviso_rt_meta process on another node. -%% -%% The TI file will be on binary format and each entry is: -%% <<LengthIndicator:32, {Pid,Alias,Op,NowStamp} >> -%% Pid=pid(), or if OP==unalias pid()|any_other_than_pid() -%% Op=alias|unalias -%% ----------------------------------------------------------------------------- --module(inviso_rt_meta). - -%% ----------------------------------------------------------------------------- -%% API exports. -%% ----------------------------------------------------------------------------- - --export([start/2,start/5]). --export([stop/1,suspend/1]). --export([init_tpm/5,init_tpm/8]). --export([tpm/5,tpm/6,tpm/9,tpm_tracer/5,tpm_tracer/6,tpm_tracer/9]). --export([tpm_ms/6,tpm_ms_tracer/6,ctpm_ms/5,ctpm/4]). --export([local_register/1,global_register/1]). --export([remove_local_register/1,remove_global_register/1]). - --export([write_ti/1]). - --export([get_tracer/0,tpm_ms/5,tpm_ms_tracer/5,list_tpm_ms/3,ctpm_ms/4]). - --export([metacast_call/5,metacast_return_from/6]). --export([get_state/1]). -%% ----------------------------------------------------------------------------- - -%% ----------------------------------------------------------------------------- -%% Internal exports. -%% ----------------------------------------------------------------------------- - --export([init/6]). --export([init_std_publld/2,clean_std_publld/1]). -%% ----------------------------------------------------------------------------- - -%% ----------------------------------------------------------------------------- -%% Constants. -%% ----------------------------------------------------------------------------- - --define(NAMED_MS_TAB,inviso_rt_meta_named_ms). - -%% ----------------------------------------------------------------------------- - - -%% ============================================================================= -%% Exported API (Meant to be used by a runtime component). -%% ============================================================================= - -%% start(TiData,Tracer)={ok,Pid} | {error,Reason} -%% start(TiData,Tracer,InitPublLDmfa,RemovePublLDmfa,CleanPublLDmf)= -%% {ok,Pid} | {error,Reason} -%% TiData={file,FileName}|{relay,Node} -%% Tracer=pid()|port() -%% FileName=string() -%% InitPublLDmfa={Mod,Func,ArgList} -%% RemovePublLDmf={Mod,Func} | void -%% RemovePublLDmf(PublLD)->nothing significant. -%% These functions are called to create and destroy the public loopdata -%% structure available to the meta-trace CallFunc and ReturnFunc. -%% CleanPublLDmf={Mod,Func} -%% This function will periodically be called to clean the public LD from -%% pending meta-trace messages waiting for a corresponding return_from -%% message. -%% -%% Starts a meta-tracer process, opening the ti-file specified in TiData. PublLD -%% is used to communicate data, typically between a call and return_from. -%% If no special initialization function is specified a standard one is used. -%% Note that the meta tracer function must know "who" is the regular tracer -%% (process or port). This because it must be possible to append {tracer,Tracer} -%% in meta match specs. -start(TiData,Tracer) -> - Pid=spawn_link(?MODULE, - init, - [self(), - TiData, - Tracer, - {?MODULE,init_std_publld,[2,[]]}, - void, - {?MODULE,clean_std_publld}]), - wait_for_reply(Pid). -start(TiData,Tracer,InitPublLDmfa,RemovePublLDmf,CleanPublLDmf) -> - Pid=spawn_link(?MODULE, - init, - [self(),TiData,Tracer,InitPublLDmfa,RemovePublLDmf,CleanPublLDmf]), - wait_for_reply(Pid). - -wait_for_reply(Pid) -> - receive - {Pid,ok} -> - {ok,Pid}; - {Pid,{error,Reason}} -> - {error,Reason} - after - 10000 -> % After very long time. - exit(Pid,kill), % It must be hanging. - {error,time_out} - end. -%% ----------------------------------------------------------------------------- - -%% stop(Pid)=ok -%% Pid=Adders to the meta tracer, pid(). -%% Shutsdown the metatracer. -stop(Pid) -> - Pid ! {stop,self()}, - ok. -%% ----------------------------------------------------------------------------- - -%% suspend(Pid)=ok -%% Pid=Adders to the meta tracer, pid(). -%% Suspends the meta tracer by removing all meta trace patterns. -suspend(Pid) -> - Pid ! {suspend,self()}, - ok. -%% ----------------------------------------------------------------------------- - -%% init_tpm(Pid,Mod,Func,Arity,CallFunc)= -%% init_tpm(Pid,Mod,Func,Arity,InitFunc,CallFunc,ReturnFunc,RemoveFunc)=ok|{error,Reason}. -%% Pid=Address to meta tracer process, pid(). -%% Mod,Func=Pointing out the function which shall be meta traced, atom(). -%% Arity=As above, integer(). -%% InitFunc,RemoveFunc={Module,Function}|fun(), functions being called when -%% to initialize the public loopdata structure, and to reset it. -%% InitFunc(Mod,Func,Arity,PublLD)->{ok,NewPublLD,Output} -%% Supposed to initialize whatever needs to be done before -%% handling any incoming meta-trace message for the Mod:Func/Arity. -%% RemoveFunc(Mod,Func,Arity,PublLD)->{ok,NewPublLD} -%% Called when meta tracing of Mod:Func/Arity is stopped. It is supposed -%% to clear datastructures away from the PublLD. -%% Initializes the public loopdata for this function. Note that we can not use wildcards -%% here (even if it is perfectly legal in Erlang). It also sets the CallFunc and -%% ReturnFunc for the meta traced function. The function is hence ready to be -%% meta traced with either tpm/5 or tpm_ms/5. -%% This function is synchronous, waiting for a reply from the meta server. -init_tpm(Pid,Mod,Func,Arity,CallFunc) -> - init_tpm(Pid,Mod,Func,Arity,void,CallFunc,void,void). -init_tpm(Pid,Mod,Func,Arity,InitFunc,CallFunc,ReturnFunc,RemoveFunc) -> - send_wait(Pid, - {init_tpm,{Mod,Func,Arity},InitFunc,CallFunc,ReturnFunc,RemoveFunc}). -%% ----------------------------------------------------------------------------- - -%% tpm(Pid,Mod,Func,Arity,MatchSpec)={ok,N}|{error,Reason} -%% tpm(Pid,Mod,Func,Arity,MatchSpec,CallFunc)={ok,N}|{error,Reason} -%% tpm(Pid,Mod,Func,Arity,MatchSpec,InitFunc,CallFunc,ReturnFunc,RemoveFunc)= -%% Pid=Address to meta tracer process, pid(). -%% Mod,Func=Pointing out the function which shall be meta traced, atom(). -%% Arity=As above, integer(). -%% MatchSpec=List of match specification, possibly empty. Remember {return_trace} -%% if expecting return_from messages. -%% InitFunc,CallFunc,ReturnFunc,RemoveFunc={Module,Function}|fun(), -%% functions being called when these functions are called by the meta trace -%% server at certain events. -%% CallFunc(CallingPid,ActualArgList,PublLD)->{ok,NewPrivLD,Output} -%% ReturnFunc(CallingPid,ReturnValue,PublLD)->{ok,NewPrivLD,Output} -%% When a call respectively return_from trace message arrives for the meta -%% traced function, the corresponding function is called. -%% The ReturnFunc must handle the fact that a return_from message arrives -%% for a call which was never noticed. This because the message queue of the -%% meta tracer may have been emptied. -%% Reason=badarg | -%% Output=Characters to be written to the ti-file, bin() | 'void' -%% The tpm/5 function simply starts meta tracing for the function. It must -%% previously have been initialized. -%% tpm/6 & /9 initializes the function and starts meta tracing. -tpm(Pid,Mod,Func,Arity,MatchSpec) - when is_atom(Mod),is_atom(Func),is_integer(Arity),is_list(MatchSpec),Mod/='_',Func/='_'-> - send_wait(Pid,{tpm,{Mod,Func,Arity,MatchSpec}}); -tpm(_,_,_,_,_) -> - {error,badarg}. - -tpm(Pid,Mod,Func,Arity,MatchSpec,CallFunc) -> - tpm(Pid,Mod,Func,Arity,MatchSpec,void,CallFunc,void,void). - -tpm(Pid,Mod,Func,Arity,MatchSpec,InitFunc,CallFunc,ReturnFunc,RemoveFunc) - when is_atom(Mod),is_atom(Func),is_integer(Arity),is_list(MatchSpec),Mod/='_',Func/='_' -> - send_wait(Pid,{tpm,{Mod,Func,Arity,MatchSpec},InitFunc,CallFunc,ReturnFunc,RemoveFunc}); -tpm(_,_,_,_,_,_,_,_,_) -> - {error,badarg}. -%% ----------------------------------------------------------------------------- - -%% Same as tpm/X but the meta tracer will automatically append {tracer,Tracer} -%% to the enable list in a {trace,Disable,Enable} match spec action term. -tpm_tracer(Pid,Mod,Func,Arity,MatchSpec) - when is_atom(Mod),is_atom(Func),is_integer(Arity),is_list(MatchSpec),Mod/='_',Func/='_'-> - send_wait(Pid,{tpm_tracer,{Mod,Func,Arity,MatchSpec}}); -tpm_tracer(_,_,_,_,_) -> - {error,badarg}. - -tpm_tracer(Pid,Mod,Func,Arity,MatchSpec,CallFunc) -> - tpm_tracer(Pid,Mod,Func,Arity,MatchSpec,void,CallFunc,void,void). - -tpm_tracer(Pid,Mod,Func,Arity,MatchSpec,InitFunc,CallFunc,ReturnFunc,RemoveFunc) - when is_atom(Mod),is_atom(Func),is_integer(Arity),is_list(MatchSpec),Mod/='_',Func/='_' -> - send_wait(Pid,{tpm_tracer, - {Mod,Func,Arity,MatchSpec}, - InitFunc,CallFunc,ReturnFunc,RemoveFunc}); -tpm_tracer(_,_,_,_,_,_,_,_,_) -> - {error,badarg}. -%% ----------------------------------------------------------------------------- - -%% tpm_ms(Pid,Mod,Func,Arity,MSname,MS)={ok,N}|{error,Reason} -%% Pid=Address to meta tracer process, pid(). -%% Mod,Func=Pointing out the function to which we shall add a match-spec., atom(). -%% Arity=As above, integer(). -%% MSname=A name to be used if this MS shall be removed later. term(). -%% MatchSpec=List of match specification, Remember {return_trace} -%% if expecting return_from messages. -%% This function adds a list of match-specs to the already existing ones. It -%% uses an internal database to keep track of existing match-specs. If the -%% match-spec does not result in any meta traced functions (for whatever reason), -%% the MS is not saved in the database. The previously known match-specs are -%% not removed. -tpm_ms(Pid,Mod,Func,Arity,MSname,MS) -> - send_wait(Pid,{tpm_ms,{Mod,Func,Arity},MSname,MS}). -%% ----------------------------------------------------------------------------- - -%% Same as tpm_ms/6 but the meta tracer will automatically append {tracer,Tracer} -%% to the enable list in a {trace,Disable,Enable} match spec action term. -tpm_ms_tracer(Pid,Mod,Func,Arity,MSname,MS) -> - send_wait(Pid,{tpm_ms_tracer,{Mod,Func,Arity},MSname,MS}). -%% ----------------------------------------------------------------------------- - -%% ctpm_ms(Pid,Mod,Func,Arity)=ok -%% -%% Removes a names match-spec from the meta traced function. Note that is never -%% a fault to remove an MS. Not even from a function which is non existant. -ctpm_ms(Pid,Mod,Func,Arity,MSname) -> - send_wait(Pid,{ctpm_ms,{Mod,Func,Arity},MSname}). -%% ----------------------------------------------------------------------------- - -%% Quick versions for erlang:register/2 which also uses a default CallFunc -%% and a default ReturnFunc. -local_register(Pid) -> - Res1=tpm(Pid, - erlang,register,2,[{'_',[],[{exception_trace}]}], - fun metafunc_init/4,fun local_register_call/3, - fun local_register_return/3,void), - Res2=tpm(Pid, - erlang,unregister,1,[], - void,fun local_unregister_call/3,void,void), - {Res1,Res2}. -%% ----------------------------------------------------------------------------- - -%% Quick version for global:register_name/2, /3. -global_register(Pid) -> - Res1=tpm(Pid,global,handle_call,3,[{[{register,'_','_','_'},'_','_'],[],[]}], - void,fun global_register_call/3,void,void), - Res2=tpm(Pid,global,delete_global_name,2,[], - void,fun global_unregister_call/3,void,void), - {Res1,Res2}. -%% ----------------------------------------------------------------------------- - -%% ctpm(Pid,Mod,Func,Arity)=ok|{error,bad_mfa} -%% -%% Removes the meta trace pattern for the function, means stops generating output -%% for this function. The public LD may be cleared by the previously entered -%% RemoveFunc. -ctpm(Pid,Mod,Func,Arity) -> - send_wait(Pid,{ctpm,{Mod,Func,Arity}}). -%% ----------------------------------------------------------------------------- - -%% remove_local_register(Pid)={Res1,Res2} -%% Res1,Res2=ok|{error,Reason} -remove_local_register(Pid) -> - Res1=ctpm(Pid,erlang,register,2), - Res2=ctpm(Pid,erlang,unregister,1), - {Res1,Res2}. -%% ----------------------------------------------------------------------------- - -%% remove_global_register(Pid)={Res1,Res2} -%% Res1,Res2=ok|{error,Reason} -remove_global_register(Pid) -> - Res1=ctpm(Pid,global,handle_call,3), - Res2=ctpm(Pid,global,delete_global_name,2), - {Res1,Res2}. -%% ----------------------------------------------------------------------------- - -%% Exported help functions which may be used in programming CallFunc and/or -%% ReturnFunc. Useful if the call is done on one node but must trigger the -%% start of something at other nodes. -metacast_call(Nodes,OrigPid,M,F,Args) -> - multicast(Nodes,{trace_ts,OrigPid,call,{M,F,Args},void}), - ok. - -metacast_return_from(Nodes,OrigPid,M,F,Arity,Value) -> - multicast(Nodes,{trace_ts,OrigPid,return_from,{M,F,Arity},Value,void}), - ok. - -multicast([Node|Rest],Msg) -> - {?MODULE,Node} ! Msg, - multicast(Rest,Msg); -multicast([],_) -> - true. -%% ----------------------------------------------------------------------------- - -%% get_states(Pid)={ok,LD,PubLD}. -get_state(Pid) -> - send_wait(Pid,get_state). -%% ----------------------------------------------------------------------------- - - -send_wait(To,Msg) -> - Ref=make_ref(), - MRef=erlang:monitor(process,To), - To ! {Msg,Ref,self()}, - receive - {inviso_rt_meta_reply,Ref,Reply} -> - erlang:demonitor(MRef), - Reply; - {'DOWN',MRef,_,_To,_Reason} -> - {error,no_metatracer} - end. - -reply(To,Ref,Reply) -> - To ! {inviso_rt_meta_reply,Ref,Reply}. -%% ----------------------------------------------------------------------------- - -%% ============================================================================= -%% Special API. -%% ============================================================================= - -%% write_ti(OutPut)= -%% OutPut=binary() -%% Makes an extra entry into the trace information file (ti-file). This is useful -%% if a pid-alias association is learned in another way than through a meta traced -%% function call. Note that this API can only be used locally at the node in -%% question. -write_ti(OutPut) -> - catch ?MODULE ! {write_ti,OutPut}. -%% ----------------------------------------------------------------------------- - - -%% ============================================================================= -%% API intended to be used on CallFuncs and RemoveFuncs. -%% ============================================================================= - -%% The reason there must be a special API for CallFuncs and RemoveFuncs are is -%% that those functions are executed inside *this* process context. Hence they -%% can not make function calls requiering this process to receive messages. - -%% Returns the tracer used for regular tracing. The reason this is implemented -%% in this way is that this function is intended to be used in meta trace call- -%% back functions. And there we can not have message passing API:s to the meta -%% trace(!). -get_tracer() -> - get(tracer). -%% ----------------------------------------------------------------------------- - -%% Function equivalent to inviso_rt:tpm_ms/6. This function can *only* be used -%% inside a CallFunc or a RemoveFunc. -tpm_ms(Mod,Func,Arity,MSname,MS) -> - case check_mfarity_exists(Mod,Func,Arity) of - yes -> % Ok, and args must be ok then also. - {ok,h_tpm_ms(Mod,Func,Arity,MSname,MS)}; - no -> - {error,not_initiated} - end. -%% ----------------------------------------------------------------------------- - -tpm_ms_tracer(Mod,Func,Arity,MSname,MS) -> - case check_mfarity_exists(Mod,Func,Arity) of - yes -> % Ok, and args must be ok then also. - NewMS=add_tracer(MS,get_tracer()), - {ok,h_tpm_ms(Mod,Func,Arity,MSname,NewMS)}; - no -> - {error,not_initiated} - end. -%% ----------------------------------------------------------------------------- - -%% Function that returns all MSname in use for Mod:Func/Arity -list_tpm_ms(Mod,Func,Arity) -> - {ok,h_list_tpm_ms(Mod,Func,Arity)}. -%% ----------------------------------------------------------------------------- - -%% Function equivalent to inviso_rt:ctpm_ms/5. This function can *only* be used -%% inside a CallFunc or a RemoveFunc. -ctpm_ms(Mod,Func,Arity,MSname) -> - h_ctpm_ms(Mod,Func,Arity,MSname), - ok. -%% ----------------------------------------------------------------------------- - - -%% ============================================================================= -%% The server implemenation. -%% ============================================================================= - -init(Parent,TiData,Tracer,InitPublLDmfa,RemovePublLDmf,CleanPublLDmf) -> - process_flag(priority,high), % Since we may receive from many procs. - register(?MODULE,self()), % So we can act as relay receiver. - case open_traceinfo_file(TiData) of - {ok,TI} -> % The ti.-file. - TId=ets:new(?NAMED_MS_TAB,[named_table,set,protected]), - PublLD=do_init_publ_ld(InitPublLDmfa), - Parent ! {self(),ok}, - put(tracer,Tracer), % Uggly quick fix! - loop(Parent, - Tracer, - TI, - mk_new_ld(InitPublLDmfa,RemovePublLDmf,CleanPublLDmf,TId), - PublLD, - now()); - {error,Reason} -> - Parent ! {self(),{error,Reason}} - end. -%% ----------------------------------------------------------------------------- - -loop(Parent,Tracer,TI,LD,PrevPublLD,PrevCleanTime) -> - {PublLD,CleanTime}=throw_old_failed(get_cleanpublldmf_ld(LD),PrevPublLD,PrevCleanTime), - receive - {{init_tpm,{Mod,Func,Arity},InitFunc,CallFunc,ReturnFunc,RemoveFunc},Ref,Parent} -> - case check_mfarity_exists(Mod,Func,Arity) of - no -> % Good then we can add it! - case check_tpm_args(Mod,Func,Arity) of - true -> % Args are ok. - {NewLD,NewPublLD}= - h_init_tpm(Mod,Func,Arity, - InitFunc,CallFunc,ReturnFunc,RemoveFunc, - TI,LD,PublLD), - reply(Parent,Ref,ok), - loop(Parent,Tracer,TI,NewLD,NewPublLD,CleanTime); - false -> % Faulty arguments, - reply(Parent,Ref,{error,bad_mfa}), - loop(Parent,Tracer,TI,LD,PublLD,CleanTime) - end; - yes -> % If it already exists, cant init again. - reply(Parent,Ref,{error,already_initiated}), - loop(Parent,Tracer,TI,LD,PublLD,CleanTime) - end; - {{tpm,{Mod,Func,Arity,MS},InitFunc,CallFunc,ReturnFunc,RemoveFunc},Ref,Parent} -> - case check_mfarity_exists(Mod,Func,Arity) of - no -> % Good then we can add it! - case check_tpm_args(Mod,Func,Arity) of - true -> % Args are ok. - {NewLD,NewPublLD,N}= - h_tpm(Mod,Func,Arity,MS, - InitFunc,CallFunc,ReturnFunc,RemoveFunc, - TI,LD,PublLD), - reply(Parent,Ref,{ok,N}), - loop(Parent,Tracer,TI,NewLD,NewPublLD,CleanTime); - false -> - reply(Parent,Ref,{error,bad_mfa}), - loop(Parent,Tracer,TI,LD,PublLD,CleanTime) - end; - yes -> - reply(Parent,Ref,{error,already_initiated}), - loop(Parent,Tracer,TI,LD,PublLD,CleanTime) - end; - {{tpm,{Mod,Func,Arity,MS}},Ref,Parent} -> - case check_mfarity_exists(Mod,Func,Arity) of - yes -> % Ok, and args must be ok then also. - {NewLD,N}=h_tpm(Mod,Func,Arity,MS,LD), - reply(Parent,Ref,{ok,N}), - loop(Parent,Tracer,TI,NewLD,PublLD,CleanTime); - no -> % Must be initiated before. - reply(Parent,Ref,{error,not_initiated}), - loop(Parent,Tracer,TI,LD,PublLD,CleanTime) - end; - {{tpm_tracer,{Mod,Func,Arity,MS},InitFunc,CallFunc,ReturnFunc,RemoveFunc},Ref,Parent} -> - case check_mfarity_exists(Mod,Func,Arity) of - no -> % Good then we can add it! - case check_tpm_args(Mod,Func,Arity) of - true -> % Args are ok. - NewMS=add_tracer(MS,Tracer), - {NewLD,NewPublLD,N}= - h_tpm(Mod,Func,Arity,NewMS, - InitFunc,CallFunc,ReturnFunc,RemoveFunc, - TI,LD,PublLD), - reply(Parent,Ref,{ok,N}), - loop(Parent,Tracer,TI,NewLD,NewPublLD,CleanTime); - false -> - reply(Parent,Ref,{error,bad_mfa}), - loop(Parent,Tracer,TI,LD,PublLD,CleanTime) - end; - yes -> - reply(Parent,Ref,{error,already_initiated}), - loop(Parent,Tracer,TI,LD,PublLD,CleanTime) - end; - {{tpm_tracer,{Mod,Func,Arity,MS}},Ref,Parent} -> - case check_mfarity_exists(Mod,Func,Arity) of - yes -> % Ok, and args must be ok then also. - NewMS=add_tracer(MS,Tracer), - {NewLD,N}=h_tpm(Mod,Func,Arity,NewMS,LD), - reply(Parent,Ref,{ok,N}), - loop(Parent,Tracer,TI,NewLD,PublLD,CleanTime); - no -> % Must be initiated before. - reply(Parent,Ref,{error,not_initiated}), - loop(Parent,Tracer,TI,LD,PublLD,CleanTime) - end; - {{tpm_ms,{Mod,Func,Arity},MSname,MS},Ref,Parent} -> - case check_mfarity_exists(Mod,Func,Arity) of - yes -> % Ok, and args must be ok then also. - reply(Parent,Ref,{ok,h_tpm_ms(Mod,Func,Arity,MSname,MS)}), - loop(Parent,Tracer,TI,LD,PublLD,CleanTime); - no -> - reply(Parent,Ref,{error,not_initiated}), - loop(Parent,Tracer,TI,LD,PublLD,CleanTime) - end; - {{tpm_ms_tracer,{Mod,Func,Arity},MSname,MS},Ref,Parent} -> - case check_mfarity_exists(Mod,Func,Arity) of - yes -> % Ok, and args must be ok then also. - NewMS=add_tracer(MS,Tracer), - reply(Parent,Ref,{ok,h_tpm_ms(Mod,Func,Arity,MSname,NewMS)}), - loop(Parent,Tracer,TI,LD,PublLD,CleanTime); - no -> - reply(Parent,Ref,{error,not_initiated}), - loop(Parent,Tracer,TI,LD,PublLD,CleanTime) - end; - {{ctpm_ms,{Mod,Func,Arity},MSname},Ref,Parent} -> - reply(Parent,Ref,ok), - h_ctpm_ms(Mod,Func,Arity,MSname), - loop(Parent,Tracer,TI,LD,PublLD,CleanTime); - {{ctpm,{Mod,Func,Arity}},Ref,Parent} -> - case get_remove_func_ld(Mod,Func,Arity,LD) of - false -> % Incorrect Mod:Func/Arity! - reply(Parent,Ref,{error,bad_mfa}), - loop(Parent,Tracer,TI,LD,PublLD,CleanTime); % Do nothing! - MF -> % {M,F}, Func or 'void'. - catch erlang:trace_pattern({Mod,Func,Arity},false,[meta]), - NewPublLD=do_removefunc(MF,Mod,Func,Arity,PublLD), - NewLD=ctpm_ld(Mod,Func,Arity,LD), - reply(Parent,Ref,ok), - loop(Parent,Tracer,TI,NewLD,NewPublLD,CleanTime) - end; - {suspend,Parent} -> % Removes all meta trace patterns. - stop_all_meta_tracing(get_all_meta_funcs_ld(LD),PublLD,LD), - do_remove_publ_ld(get_removepublldmf_ld(LD),PublLD), - NewPublLD=do_init_publ_ld(get_initpublldmfa_ld(LD)), - loop(Parent,Tracer,TI,reset_ld(LD),NewPublLD,CleanTime); - {stop,Parent} -> % Make a controlled shutdown. - stop_all_meta_tracing(get_all_meta_funcs_ld(LD),PublLD,LD), - do_remove_publ_ld(get_removepublldmf_ld(LD),PublLD), - close_traceinfo_file(TI); % And then simply terminate. - {trace_ts,Pid,call,{M,F,Args},TS} -> - case handle_meta(get_call_func_ld(M,F,length(Args),LD),Pid,{call,Args,TS},PublLD) of - {ok,NewPublLD,Output} when is_binary(Output);is_list(Output) -> - write_output(TI,Output), - loop(Parent,Tracer,TI,LD,NewPublLD,CleanTime); - {ok,NewPublLD,_} -> % No output to the ti-file this time. - loop(Parent,Tracer,TI,LD,NewPublLD,CleanTime); - _ -> % Not handled correct, not much to do. - loop(Parent,Tracer,TI,LD,PublLD,CleanTime) - end; - {trace_ts,Pid,TypeTag,{M,F,Arity},Value,TS} - when TypeTag==return_from;TypeTag==exception_from -> - case handle_meta(get_return_func_ld(M,F,Arity,LD),Pid,{TypeTag,Value,TS},PublLD) of - {ok,NewPublLD,Output} when is_binary(Output);is_list(Output) -> - write_output(TI,Output), - loop(Parent,Tracer,TI,LD,NewPublLD,CleanTime); - {ok,NewPublLD,_} -> % No output to the ti-file this time. - loop(Parent,Tracer,TI,LD,NewPublLD,CleanTime); - _ -> % Not handled correct, not much to do. - loop(Parent,Tracer,TI,LD,PublLD,CleanTime) - end; - {relayed_meta,Bin} -> - write_output(TI,Bin), - loop(Parent,Tracer,TI,LD,PublLD,CleanTime); - {write_ti,OutPut} -> - write_output(TI,OutPut), - loop(Parent,Tracer,TI,LD,PublLD,CleanTime); - {get_state,Ref,From} -> % Debug function. - reply(From,Ref,{ok,LD,PublLD}), - loop(Parent,Tracer,TI,LD,PublLD,CleanTime); - _Other -> - loop(Parent,Tracer,TI,LD,PublLD,CleanTime) - end. - - -%% ============================================================================= -%% First level help functions. -%% ============================================================================= - -%% Function which opens the trace-information file(s). It must understand -%% the tidata specification which is part of the tracerdata given to the -%% runtime component during init_tracing. -%% It must return an internal notation of the time of file open and a -%% useful descriptor the write_output function can use. -%% Returns {ok,TiDescriptor} or {error,Reason}. -open_traceinfo_file({file,FileName}) -> % A plain raw binary file. - case file:open(FileName,[write,raw,binary]) of - {ok,FD} -> - {ok,{file,FD}}; - {error,Reason} -> - {error,{open,[FileName,Reason]}} - end; -open_traceinfo_file({relay,ToNode}) -> % Use distributed Erlang. - {ok,{relay,ToNode}}; -open_traceinfo_file(IncorrectTI) -> - {error,{badarg,IncorrectTI}}. -%% ----------------------------------------------------------------------------- - -close_traceinfo_file({file,FD}) -> - file:close(FD); -close_traceinfo_file(_) -> - ok. -%% ----------------------------------------------------------------------------- - -%% Help function handling initializing meta tracing of a function. -%% Returns {NewLD,NewPublLD}. -h_init_tpm(Mod,Func,Arity,InitFunc,CallFunc,ReturnFunc,RemoveFunc,TI,LD,PublLD) -> - case do_initfunc(InitFunc,Mod,Func,Arity,PublLD) of - {NewPublLD,Output} -> - write_output(TI,Output), - NewLD=init_tpm_ld(Mod,Func,Arity,CallFunc,ReturnFunc,RemoveFunc,LD), - {NewLD,NewPublLD}; - false -> % The initfunc did not do anything. - NewLD=init_tpm_ld(Mod,Func,Arity,CallFunc,ReturnFunc,RemoveFunc,LD), - {NewLD,PublLD} - end. -%% ----------------------------------------------------------------------------- - -%% Help function handling initializing meta tracing of a function and also -%% set the meta trace pattern as specified. -%% Returns {NewLD,NewPublLD,N}. -h_tpm(Mod,Func,Arity,MS,InitFunc,CallFunc,ReturnFunc,RemoveFunc,TI,LD,PublLD) -> - {NewLD,NewPublLD}= - h_init_tpm(Mod,Func,Arity,InitFunc,CallFunc,ReturnFunc,RemoveFunc,TI,LD,PublLD), - case set_meta_tracing(Mod,Func,Arity,MS) of - true -> % Ok, set one pattern. - {NewLD,NewPublLD,1}; - false -> - {NewLD,NewPublLD,0} - end. -%% ----------------------------------------------------------------------------- - -%% Help function handling setting meta trace patter for a function which has -%% already been intialized. Note that we must remove all potentially stored -%% match-specs, if this function has been given match-specs before with -%% tpm_ms. -%% Returns a {NewLD,N}. -h_tpm(Mod,Func,Arity,MS,LD) -> - case set_meta_tracing(Mod,Func,Arity,MS) of - true -> - {remove_ms_ld(Mod,Func,Arity,LD),1}; - false -> - {LD,0} - end. -%% ----------------------------------------------------------------------------- - -%% Help function that adds a match-spec to Mod:Func/Arity. It is not defined -%% in which order the match-specs will be given to the BIF. -%% Note that if an MS with the same name as an exiting is inserted, the previous -%% match-spec will be removed. -%% Very important to realise is that the empty meta match spec [] imposes no -%% restrictions what so ever on the generating of meta trace call messages. -%% Uncontrolled sending of such messages may quickly drain power from the system. -%% Since an empty match-spec will "disappear" when added to other match specs, -%% the empty match is transformed to what it actually is: [{'_',[],[]}]. -%% Returns 0 or 1 indicating failure or success. -h_tpm_ms(Mod,Func,Arity,MSname,MS) -> - MSsNames=get_ms_ld(Mod,Func,Arity), % Fetch all previous match-specs. - TransformedMS=h_tpm_ms_convert_null_ms(MS), - MSsNames1=lists:keydelete(MSname,1,MSsNames), % If it already existed, it is gone! - NewMSs=lists:flatten([TransformedMS,lists:map(fun({_Name,MSx})->MSx end,MSsNames1)]), - case set_meta_tracing(Mod,Func,Arity,NewMSs) of - true -> % We only save the MS if it was good. - put_ms_ld(Mod,Func,Arity,MSname,TransformedMS,MSsNames1), - 1; - false -> - 0 - end. - -%% Help function converting the null match spec into, still a null match spec, -%% on a proper match spec format. This because it will otherwise be difficult -%% to see the difference between no active tpm_ms and all a set of null ms. -h_tpm_ms_convert_null_ms([]) -> - [{'_',[],[]}]; -h_tpm_ms_convert_null_ms(MS) -> - MS. -%% ----------------------------------------------------------------------------- - -%% Help function returning a list of all names used for match-functions for -%% the Mod:Func/Arity in question. -h_list_tpm_ms(Mod,Func,Arity) -> - MSsNames=get_ms_ld(Mod,Func,Arity), % A list of {MSname,MS}. - lists:map(fun({MSname,_})->MSname end,MSsNames). -%% ----------------------------------------------------------------------------- - -%% Function that removes a named match-spec. Returns nothing significant. -%% Note that if we end up with no match-specs, we must remove the meta trace -%% patten all together. That is bringing the function back to just initiated. -h_ctpm_ms(Mod,Func,Arity,MSname) -> - case get_ms_ld(Mod,Func,Arity) of - [] -> % The name does certainly not exist! - true; % We don't have to do anything. - MSsNames -> - case lists:keysearch(MSname,1,MSsNames) of - {value,{_,_MS}} -> % Ok, we must do something! - NewMSsNames=lists:keydelete(MSname,1,MSsNames), - case lists:flatten(lists:map(fun({_Name,MS})->MS end,NewMSsNames)) of - [] -> % This means stop meta tracing. - set_meta_tracing(Mod,Func,Arity,false); - NewMSs -> - set_meta_tracing(Mod,Func,Arity,NewMSs) - end, - set_ms_ld(Mod,Func,Arity,NewMSsNames); - false -> % But this name does not exist. - true % So we do not have to do anything. - end - end. -%% ----------------------------------------------------------------------------- - -%% Function that checks the arguments to the meta trace pattern. The reason we -%% must do this is that we can only allow meta tracing on specific functions and -%% not using wildpatterns. Otherwise the meta trace server will not understand -%% which callfunc for instance to call when a meta-trace message is generated -%% for a function. -%% Returns 'true' or 'false'. -check_tpm_args(Mod,Func,Arity) - when is_atom(Mod),is_atom(Func),is_integer(Arity),Mod/='_',Func/='_' -> - true; -check_tpm_args(_,_,_) -> - false. -%% ----------------------------------------------------------------------------- - -%% Help function which calls the actual BIF setting meta-trace-patterns. -%% Returns 'true' or 'false'. -set_meta_tracing(Mod,Func,Arity,MS) when is_atom(Mod) -> - case erlang:module_loaded(Mod) of - true -> - set_meta_tracing_2(Mod,Func,Arity,MS); - false -> % The module is not loaded. - case code:ensure_loaded(Mod) of - {module,_Mod} -> - set_meta_tracing_2(Mod,Func,Arity,MS); - {error,_Reason} -> % Could not load the module. - false % No use try to trace. - end - end; -set_meta_tracing(_,_,_,_) -> - false. - -set_meta_tracing_2(Mod,Func,Arity,MS) -> - case catch erlang:trace_pattern({Mod,Func,Arity},MS,[meta]) of - 0 -> % Hmm, nothing happend :-) - false; - N when is_integer(N) -> % The normal case, some functions were hit. - true; - {'EXIT',_Reason} -> - false - end. -%% ----------------------------------------------------------------------------- - -%% Help function which removes all meta trace pattern for the functions mentioned -%% in the list being first argument. It also executes the remove funcs for each -%% and every no longer meta traced function. This done since some of the remove -%% functions may do side-effects (like deleteing ETS tables). -%% Returns nothing significant. -stop_all_meta_tracing([{M,F,Arity}|Rest],PublLD,LD) -> - catch erlang:trace_pattern({M,F,Arity},false,[meta]), - NewPublLD=do_removefunc(get_remove_func_ld(M,F,Arity,LD),M,F,Arity,PublLD), - stop_all_meta_tracing(Rest,NewPublLD,LD); -stop_all_meta_tracing([],_,_) -> - true. -%% ----------------------------------------------------------------------------- - -%% This function calls the function registered to be handler for a certain -%% meta-traced function. Such a function or fun must take three arguments -%% and return {ok,NewPrivLD,OutPutBinary} or 'false'. OutPutBinary may be -%% something else, and is then ignored. -handle_meta({M,F},Pid,Arg1,PrivLD) -> - (catch M:F(Pid,Arg1,PrivLD)); -handle_meta(Fun,Pid,Arg1,PrivLD) when is_function(Fun) -> - (catch Fun(Pid,Arg1,PrivLD)); -handle_meta(_,_,_,_) -> % Don't know how to do this. - false. -%% ----------------------------------------------------------------------------- - -%% Help function writing output from a callback function to the ti-file. -%% Output can be a binary or a list of binaries. -write_output(TI,[OutPut|Rest]) -> - write_output(TI,OutPut), - write_output(TI,Rest); -write_output({file,FD},Bin) when is_binary(Bin) -> % Plain direct-binary file - Size=byte_size(Bin), - file:write(FD,list_to_binary([<<0,Size:32>>,Bin])); -write_output({relay,ToNode},Bin) when is_atom(ToNode),is_binary(Bin) -> - {inviso_rt_meta,ToNode} ! {relayed_meta,Bin}; -write_output(_,_) -> % Don't understand, just skip. - true. -%% ----------------------------------------------------------------------------- - - -%% ============================================================================= -%% Various help functions. -%% ============================================================================= - -%% Help function initializing the public loopdata structure. Note that if the -%% supplied InitPublLDmfa is faulty we let the structure become the error. -%% The error will most likely turn up in an error report somewhere, eventually. -do_init_publ_ld({M,F,Args}) when is_atom(M),is_atom(F),is_list(Args) -> - case catch apply(M,F,Args) of - {'EXIT',_Reason} -> - {error,init_publ_ld_func}; % Let the struct be this error! - InitialPublLD -> - InitialPublLD - end; -do_init_publ_ld(_) -> - {error,init_publ_ld_func}. -%% ----------------------------------------------------------------------------- - -%% Help function which removes the public loopdata structure. The function does -%% not necessarily have to exist. Returns nothing significant. -do_remove_publ_ld({M,F},PublLD) when is_atom(M),is_atom(F) -> - catch M:F(PublLD); -do_remove_publ_ld(_,_) -> - true. -%% ----------------------------------------------------------------------------- - -%% Hlp function initializing a particular meta traced function into the public -%% loopdata. Note that the function is not mandatory. -%% Returns {NewPublLD,Output} or 'false'. -do_initfunc({M,F},Mod,Func,Arity,PublLD) when is_atom(M),is_atom(F) -> - case catch M:F(Mod,Func,Arity,PublLD) of - {ok,NewPublLD,Output} -> - {NewPublLD,Output}; - _ -> % Everything else is an error. - false % Act as no initialization function. - end; -do_initfunc(Fun,Mod,Func,Arity,PublLD) when is_function(Fun) -> - case catch Fun(Mod,Func,Arity,PublLD) of - {ok,NewPublLD,Output} -> - {NewPublLD,Output}; - _ -> % Everything else is an error. - false % Act as no initialization function. - end; -do_initfunc(_,_,_,_,_) -> % Perhaps too generous, should be 'void' only. - false. -%% ----------------------------------------------------------------------------- - -%% Help function removing a particular meta traced function from the public -%% loopdata. Note that we do not make much noice should the call back function -%% be faulty. -do_removefunc({M,F},Mod,Func,Arity,PublLD) when is_atom(M),is_atom(F) -> - case catch M:F(Mod,Func,Arity,PublLD) of - {ok,NewPublLD} -> - NewPublLD; - _ -> % Everything else is an error. - PublLD % Act as no initialization function. - end; -do_removefunc(Fun,Mod,Func,Arity,PublLD) when is_function(Fun) -> - case catch Fun(Mod,Func,Arity,PublLD) of - {ok,NewPublLD} -> - NewPublLD; - _ -> % Everything else is an error. - PublLD % Act as no initialization function. - end; -do_removefunc(_,_,_,_,PublLD) -> - PublLD. -%% ----------------------------------------------------------------------------- - -%% Function that, if the time has come, goes through the priv-ld structure and -%% cleans away entryn left behind. The usual cause is that the function call -%% caused an exception and there were therefore no matching return_from. -%% Returns {NewPrivLD,now()}. -throw_old_failed({M,F},PrivLD,PrevClean) -> - case difference_in_now(PrevClean,now(),60) of % We clean once every minute. - true -> - case catch apply(M,F,[PrivLD]) of - {'EXIT',_Reason} -> % Something went wrong, ignore it. - {PrivLD,now()}; % Just keep the old priv-ld. - NewPrivLD -> % The function must return a priv-ld. - {NewPrivLD,now()} - end; - false -> % Not time yet! - {PrivLD,PrevClean} - end. -%% ----------------------------------------------------------------------------- - -%% Help function comparing two now timestamps. Returns true or false depending -%% on if S2 is more than DiffS seconds after S1. Only works for differences -%% less than 1 million seconds. -difference_in_now({MegaS1,S1,_},{MegaS2,S2,_},DiffS) -> - if - MegaS1+1<MegaS2 -> % More than 1 Mega sec. difference. - true; - MegaS1==MegaS2,S1+DiffS<S2 -> - true; - MegaS1+1==MegaS2,S1+DiffS<S2+1000000 -> - true; - true -> - false - end. -%% ----------------------------------------------------------------------------- - -%% This help function adds a {tracer,Tracer} to the enable-list in a 'trace' -%% match spec action. The reason for this is that the author of the a meta -%% match spec meant to turn tracing on for the process executing the match spec -%% can not know the tracer. This since the match spec is most likely authored -%% at the control component's node, and not here. -%% Note the double tuple necessary to make it just precise a tuple! -%% Returns a new match spec. -add_tracer([MS1|Rest],Tracer) -> - [add_tracer_2(MS1,Tracer)|add_tracer(Rest,Tracer)]; -add_tracer([],_) -> - []; -add_tracer(NotList,_Tracer) -> % Can be 'false', but also an error. - NotList. - -add_tracer_2({Head,Cond,Body},Tracer) -> - {Head,Cond,add_tracer_3(Body,Tracer)}; -add_tracer_2(Faulty,_Tracer) -> - Faulty. - -add_tracer_3([{trace,Disable,Enable}|Rest],Tracer) when is_list(Enable) -> - [{trace,Disable,Enable++[{{tracer,Tracer}}]}|Rest]; -add_tracer_3([ActionTerm|Rest],Tracer) -> - [ActionTerm|add_tracer_3(Rest,Tracer)]; -add_tracer_3([],_Tracer) -> - []; -add_tracer_3(FaultyBody,_Tracer) -> - FaultyBody. -%% ----------------------------------------------------------------------------- - -%% ----------------------------------------------------------------------------- -%% Help functions handling internal loopdata. -%% ----------------------------------------------------------------------------- - --record(ld,{init_publ_ld_mfa, % {M,F,Args} - remove_publ_ld_mf, % {M,F} | void - clean_publ_ld_mf, % {Mod,Func} - ms_mfarities=notable, % ETS holding names match functions. - call_mfarities=[], % [{{M,F,Arity},2-TupleOrFun},...] - return_mfarities=[], % [{{M,F,Arity},2-TupleOrFun},...] - remove_mfarities=[] - }). - -mk_new_ld(InitPublLDmfa,RemovePublLDmf,CleanPublLDmf,TId) -> - #ld{ - init_publ_ld_mfa=InitPublLDmfa, - remove_publ_ld_mf=RemovePublLDmf, - clean_publ_ld_mf=CleanPublLDmf, - ms_mfarities=TId - }. -%% ----------------------------------------------------------------------------- - -%% Function which restores the internal loop data to somekind of initial state. -%% This is useful when tracing has been suspended. -reset_ld(#ld{init_publ_ld_mfa=InitPublLDmfa, - remove_publ_ld_mf=RemovePublLDmf, - clean_publ_ld_mf=CleanPublLDmf, - ms_mfarities=TId}) -> - ets:match_delete(TId,{'_','_'}), % Empty the table. - #ld{init_publ_ld_mfa=InitPublLDmfa, - remove_publ_ld_mf=RemovePublLDmf, - clean_publ_ld_mf=CleanPublLDmf, - ms_mfarities=TId}. -%% ----------------------------------------------------------------------------- - -get_initpublldmfa_ld(#ld{init_publ_ld_mfa=InitPublLDmfa}) -> - InitPublLDmfa. -%% ----------------------------------------------------------------------------- - -get_removepublldmf_ld(#ld{remove_publ_ld_mf=RemovePublLDmf}) -> - RemovePublLDmf. -%% ----------------------------------------------------------------------------- - -get_cleanpublldmf_ld(#ld{clean_publ_ld_mf=CleanPublLDmf}) -> - CleanPublLDmf. -%% ----------------------------------------------------------------------------- - -%% Help function adding data associated with a meta traced function to the -%% internal loopdata. Called when meta tracing is activated for M:F/Arity. -init_tpm_ld(M,F,Arity,CallFunc,ReturnFunc,RemoveFunc,LD) -> - ets:insert(LD#ld.ms_mfarities,{{M,F,Arity},[]}), - CallFuncs=LD#ld.call_mfarities, - ReturnFuncs=LD#ld.return_mfarities, - RemoveFuncs=LD#ld.remove_mfarities, - LD#ld{call_mfarities=[{{M,F,Arity},CallFunc}|CallFuncs], - return_mfarities=[{{M,F,Arity},ReturnFunc}|ReturnFuncs], - remove_mfarities=[{{M,F,Arity},RemoveFunc}|RemoveFuncs]}. -%% ----------------------------------------------------------------------------- - -%% Help function which answers the question if we have already initiated the -%% function. It is done by looking in the ETS-table with named match-functions. -%% If there is an entry in the set-type table for M:F/Arity, the function is -%% initiated. -%% Returns 'yes' or 'no'. -check_mfarity_exists(M,F,Arity) -> - case ets:lookup(?NAMED_MS_TAB,{M,F,Arity}) of - [] -> - no; - [_] -> - yes - end. -%% ----------------------------------------------------------------------------- - -%% Help function adding an entry with [{MSname,MSlist}|MSsNames] for M:F/Arity. -%% Note that any already existing entry is removed. -%% Returns nothing significant. -put_ms_ld(M,F,Arity,MSname,MS,MSsNames) -> - ets:insert(?NAMED_MS_TAB,{{M,F,Arity},[{MSname,MS}|MSsNames]}). -%% ----------------------------------------------------------------------------- - -%% Help function taking a list of {MSname,MSs} and storing them in the -%% internal loop data structure. The storage is actually implemented as an ETS -%% table. Any previous list of {MSname,MSs} associated with this {M,F,Arity} will -%% be lost. Returns nothing significant. -set_ms_ld(M,F,Arity,MSsNames) -> - ets:insert(?NAMED_MS_TAB,{{M,F,Arity},MSsNames}). -%% ----------------------------------------------------------------------------- - -%% Help function fetching a list of {MSname,MatchSpecs} for a M:F/Arity. The -%% match-functions are stored in an ETS table searchable on {M,F,Arity}. -get_ms_ld(M,F,Arity) -> - case ets:lookup(?NAMED_MS_TAB,{M,F,Arity}) of - [{_MFArity,MSsNames}] -> - MSsNames; - [] -> - [] - end. -%% ----------------------------------------------------------------------------- - -%% Help function removing all saved match-specs for a certain M:F/Arity. -%% Returns a new loopdata structure. -remove_ms_ld(M,F,Arity,LD) -> - ets:delete(LD#ld.ms_mfarities,{M,F,Arity}), - LD. -%% ----------------------------------------------------------------------------- - -%% Help function which removes all information about a meta traced function from -%% the internal loopdata. Returns a new loopdata structure. -ctpm_ld(M,F,Arity,LD) -> - ets:delete(LD#ld.ms_mfarities,{M,F,Arity}), - NewCallFuncs=lists:keydelete({M,F,Arity},1,LD#ld.call_mfarities), - NewReturnFuncs=lists:keydelete({M,F,Arity},1,LD#ld.return_mfarities), - NewRemoveFuncs=lists:keydelete({M,F,Arity},1,LD#ld.remove_mfarities), - LD#ld{call_mfarities=NewCallFuncs, - return_mfarities=NewReturnFuncs, - remove_mfarities=NewRemoveFuncs}. -%% ----------------------------------------------------------------------------- - -get_call_func_ld(M,F,Arity,#ld{call_mfarities=CallFuncs}) -> - case lists:keysearch({M,F,Arity},1,CallFuncs) of - {value,{_,MF}} -> - MF; - false -> - false - end. -%% ----------------------------------------------------------------------------- - -get_return_func_ld(M,F,Arity,#ld{return_mfarities=CallFuncs}) -> - case lists:keysearch({M,F,Arity},1,CallFuncs) of - {value,{_,MF}} -> - MF; - false -> - false - end. -%% ----------------------------------------------------------------------------- - -get_remove_func_ld(M,F,Arity,#ld{remove_mfarities=RemoveFuncs}) -> - case lists:keysearch({M,F,Arity},1,RemoveFuncs) of - {value,{_,MF}} -> - MF; - false -> - false - end. -%% ----------------------------------------------------------------------------- - -%% Function returning a list of all {Mod,Func,Arity} which are currently meta -%% traced. It does do by listifying the call_mfarities field in the internal -%% loopdata. -get_all_meta_funcs_ld(#ld{call_mfarities=CallFuncs}) -> - lists:map(fun({MFArity,_})->MFArity end,CallFuncs). -%% ----------------------------------------------------------------------------- - - -%% ============================================================================= -%% Functions for the standard PublLD structure. -%% -%% It is tuple {Part1,GlobalData} where Part1 is of length at least 2. -%% Where each field is a list of tuples. The last item in each tuple shall be -%% a now tuple, making it possible to clean it away should it be too old to be -%% relevant (there was no return_from message due to a failure). -%% Other fields can be used for other functions. -%% The GlobalData is not cleaned but instead meant to store data must be passed -%% to each CallFunc when a meta trace message arrives. -%% ============================================================================= - -%% Function returning our standard priv-loopdata structure. -init_std_publld(Size,GlobalData) -> - {list_to_tuple(lists:duplicate(Size,[])),GlobalData}. -%% ----------------------------------------------------------------------------- - -%% Function capable of cleaning out a standard publ-ld. The last element of each -%% tuple must be the now item. -%% Returns a new publ-ld structure. -clean_std_publld({Part1,GlobalData}) -> - {clean_std_publld_2(Part1,now(),tuple_size(Part1),[]),GlobalData}. - -clean_std_publld_2(_,_,0,Accum) -> - list_to_tuple(Accum); -clean_std_publld_2(PublLD,Now,Index,Accum) -> - NewTupleList=clean_std_publld_3(element(Index,PublLD),Now), - clean_std_publld_2(PublLD,Now,Index-1,[NewTupleList|Accum]). - -clean_std_publld_3([Tuple|Rest],Now) -> - PrevNow=element(tuple_size(Tuple),Tuple), % Last item shall be the now item. - case difference_in_now(PrevNow,Now,30) of - true -> % Remove it then! - clean_std_publld_3(Rest,Now); - false -> % Keep it! - [Tuple|clean_std_publld_3(Rest,Now)] - end; -clean_std_publld_3([],_) -> - []. -%% ----------------------------------------------------------------------------- - -%% ============================================================================= -%% Functions used as handling functions (as funs) for registered process names. -%% (Given that we use the standard priv-ld, otherwise you must do your own!). -%% ============================================================================= - -%% Call-back for initializing the meta traced functions there are quick functions -%% for. Returns a new public loop data structure. -metafunc_init(erlang,register,2,{Part1,GlobalData}) -> - {setelement(1,Part1,[]),GlobalData}. -%% ----------------------------------------------------------------------------- - -%% Call-function for erlang:register/2. -%% This function adds the call to register/2 to a standard priv-ld structure. -%% Note that we *must* search for previous entries from the same process. If such -%% still in structure it means a failed register/2 call. It must first be removed -%% so it can not be mixed up with this one. Since meta-trace message will arrive -%% in order, there was no return_from message for that call if we are here now. -local_register_call(CallingPid,{call,[Alias,Pid],TS},{Part1,GlobalData}) -> - TupleList=element(1,Part1), % The register/2 entry in a std. priv-ld. - NewTupleList=lists:keydelete(CallingPid,1,TupleList), % If present, remove previous call. - {ok, - {setelement(1,Part1,[{CallingPid,{Alias,Pid},TS}|NewTupleList]),GlobalData}, - void}. - -%% Return-function for the erlang:register/2 BIF. -%% This function formulates the output and removes the corresponding call entry -%% from the standard priv-ld structure. -local_register_return(CallingPid,{return_from,_Val,_TS},PublLD={Part1,GlobalData}) -> - TupleList=element(1,Part1), % The register/2 entry in a std. priv-ld. - case lists:keysearch(CallingPid,1,TupleList) of - {value,{_,{Alias,Pid},NowTS}} -> - NewTupleList=lists:keydelete(CallingPid,1,TupleList), - {ok, - {setelement(1,Part1,NewTupleList),GlobalData}, - term_to_binary({Pid,Alias,alias,NowTS})}; - false -> % Strange, then don't know what to do. - {ok,PublLD,void} % Do nothing seems safe. - end; -local_register_return(CallingPid,{exception_from,_Val,_TS},{Part1,GlobalData}) -> - TupleList=element(1,Part1), % The register/2 entry in a std. priv-ld. - NewTupleList=lists:keydelete(CallingPid,1,TupleList), - {ok,{setelement(1,Part1,NewTupleList),GlobalData},void}; % No association then. -local_register_return(_,_,PublLD) -> % Don't understand this. - {ok,PublLD,void}. - -%% When unregister/1 us called we simply want a unalias entry in the ti-file. -%% We can unfortunately not connect it with a certain pid. -local_unregister_call(_CallingPid,{_TypeTag,[Alias],TS},PublLD) -> - {ok,PublLD,term_to_binary({undefined,Alias,unalias,TS})}. -%% ----------------------------------------------------------------------------- - -%% Call-function for global:register_name/2,/3. -%% This function is actually the call function for the handle_call/3 in the -%% global server. Note that we must check that we only do this on the node -%% where Pid actually resides. -global_register_call(_CallingPid,{call,[{register,Alias,P,_},_,_],TS},PublLD) - when node(P)==node()-> - {ok,PublLD,term_to_binary({P,{global,Alias},alias,TS})}; -global_register_call(_CallingPid,_,PublLD) -> - {ok,PublLD,void}. - -%% Call-function for global:unregister_name. It acutally checks on the use of -%% global:delete_global_name/2 which is called when ever a global name is removed. -global_unregister_call(_CallingPid,{call,[Alias,P],TS},PublLD) when node(P)==node()-> - {ok,PublLD,term_to_binary({P,{global,Alias},unalias,TS})}; -global_unregister_call(_CallingPid,_,PublLD) -> - {ok,PublLD,void}. -%% ----------------------------------------------------------------------------- - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - diff --git a/lib/runtime_tools/src/msacc.erl b/lib/runtime_tools/src/msacc.erl new file mode 100644 index 0000000000..0d9b2690e5 --- /dev/null +++ b/lib/runtime_tools/src/msacc.erl @@ -0,0 +1,355 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% @doc Microstate accounting utility function +%% +%% This module provides a user interface for analysing +%% erlang:statistics(microstate_accounting) data. +%% + +-module(msacc). +-export([available/0, start/0, start/1, stop/0, reset/0, to_file/1, + from_file/1, stats/0, stats/2, print/0, print/1, print/2, + print/3]). + +-type msacc_data() :: [msacc_data_thread()]. + +-type msacc_data_thread() :: #{ '$type' := msacc_data, + type := msacc_type(), id := msacc_id(), + counters := msacc_data_counters() }. +-type msacc_data_counters() :: #{ msacc_state() => non_neg_integer()}. + +-type msacc_stats() :: [msacc_stats_thread()]. +-type msacc_stats_thread() :: #{ '$type' := msacc_stats, + type := msacc_type(), id := msacc_id(), + system := float(), + counters := msacc_stats_counters()}. +-type msacc_stats_counters() :: #{ msacc_state() => #{ thread := float(), + system := float()}}. + + +-type msacc_type() :: scheduler | aux | async. +-type msacc_id() :: non_neg_integer(). +-type msacc_state() :: alloc | aux | bif | busy_wait | check_io | + emulator | ets | gc | gc_fullsweep | nif | + other | port | send | sleep | timers. + +-type msacc_print_options() :: #{ system => boolean() }. + +-spec available() -> boolean(). +available() -> + try + [_|_] = erlang:statistics(microstate_accounting), + true + catch _:_ -> + false + end. + +-spec start() -> boolean(). +start() -> + erlang:system_flag(microstate_accounting, true). + +-spec stop() -> boolean(). +stop() -> + erlang:system_flag(microstate_accounting, false). + +-spec reset() -> boolean(). +reset() -> + erlang:system_flag(microstate_accounting, reset). + +-spec start(Time) -> true when + Time :: timeout(). +start(Tmo) -> + stop(), reset(), start(), + timer:sleep(Tmo), + stop(). + +-spec to_file(Filename) -> ok | {error, file:posix()} when + Filename :: file:name_all(). +to_file(Filename) -> + file:write_file(Filename, io_lib:format("~p.~n",[stats()])). + +-spec from_file(Filename) -> msacc_data() when + Filename :: file:name_all(). +from_file(Filename) -> + {ok, [Stats]} = file:consult(Filename), + Stats. + +-spec print() -> ok. +print() -> + print(stats()). + +-spec print(DataOrStats) -> ok when + DataOrStats :: msacc_data() | msacc_stats(). +print(Stats) -> + print(Stats, #{}). + +-spec print(DataOrStats, Options) -> ok when + DataOrStats :: msacc_data() | msacc_stats(), + Options :: msacc_print_options(). +print(Stats, Options) -> + print(group_leader(), Stats, Options). + +-spec print(FileOrDevice, DataOrStats, Options) -> ok when + FileOrDevice :: file:filename() | io:device(), + DataOrStats :: msacc_data() | msacc_stats(), + Options :: msacc_print_options(). +print(Filename, Stats, Options) when is_list(Filename) -> + case file:open(Filename,[write]) of + {ok, D} -> print(D, Stats, Options),file:close(D); + Error -> Error + end; +print(Device, Stats, Options) -> + DefaultOpts = #{ system => false }, + print_int(Device, Stats, maps:merge(DefaultOpts, Options)). +print_int(Device, [#{ '$type' := msacc_data, id := _Id }|_] = Stats, Options) -> + TypeStats = stats(type, Stats), + io:format(Device, "~s", [print_stats_overview(Stats, Options)]), + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_threads( + stats(realtime, Stats), Options)]), + io:format(Device, "~s", [print_stats_type( + stats(realtime, TypeStats), Options)]); +print_int(Device, [#{ '$type' := msacc_data }|_] = Stats, Options) -> + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_type( + stats(realtime, Stats), Options)]); +print_int(Device, [#{ '$type' := msacc_stats, id := _Id }|_] = Stats,Options) -> + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_threads(Stats, Options)]), + io:format(Device, "~s", [print_stats_type( + msacc:stats(type, Stats), Options)]); +print_int(Device, [#{ '$type' := msacc_stats }|_] = Stats, Options) -> + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_type(Stats, Options)]). + + +-spec stats() -> msacc_data(). +stats() -> + Fun = fun F(K,{PerfCount,StateCount}) -> + %% Need to handle ERTS_MSACC_STATE_COUNTERS + {F(K,PerfCount),StateCount}; + F(_K,PerfCount) -> + erlang:convert_time_unit(PerfCount, perf_counter, 1000000) + end, + UsStats = lists:map( + fun(#{ counters := Cnt } = M) -> + UsCnt = maps:map(Fun,Cnt), + M#{ '$type' => msacc_data, counters := UsCnt } + end, erlang:statistics(microstate_accounting)), + statssort(UsStats). + +-spec stats(Analysis, Stats) -> non_neg_integer() when + Analysis :: system_realtime | system_runtime, + Stats :: msacc_data(); + (Analysis, Stats) -> msacc_stats() when + Analysis :: realtime | runtime, + Stats :: msacc_data(); + (Analysis, StatsOrData) -> msacc_data() | msacc_stats() when + Analysis :: type, + StatsOrData :: msacc_data() | msacc_stats(). +stats(system_realtime, Stats) -> + lists:foldl(fun(#{ counters := Cnt }, Acc) -> + get_total(Cnt, Acc) + end, 0, Stats); +stats(system_runtime, Stats) -> + lists:foldl(fun(#{ counters := Cnt }, Acc) -> + get_total(maps:remove(sleep, Cnt), Acc) + end, 0, Stats); +stats(realtime, Stats) -> + RealTime = stats(system_realtime, Stats), + statssort([get_thread_perc(Thread, RealTime) || Thread <- Stats]); +stats(runtime, Stats) -> + RunTime = stats(system_runtime, Stats), + statssort([get_thread_perc(T#{ counters := maps:remove(sleep,Cnt)}, RunTime) + || T = #{ counters := Cnt } <- Stats]); +stats(type, Stats) -> + statssort(merge_threads(Stats, [])). + +print_stats_overview(Stats, _Options) -> + RunTime = stats(system_runtime, Stats), + RealTime = stats(system_realtime, Stats) div length(Stats), + SchedStats = [S || #{ type := scheduler } = S <- Stats], + AvgSchedRunTime = stats(system_runtime, SchedStats) div length(SchedStats), + NumSize = if + RealTime > RunTime -> length(integer_to_list(RealTime)); + true -> length(integer_to_list(RunTime)) + end, + [io_lib:format("Average thread real-time : ~*B us~n", + [NumSize, RealTime]), + io_lib:format("Accumulated system run-time : ~*B us~n", + [NumSize, RunTime]), + io_lib:format("Average scheduler run-time : ~*B us~n", + [NumSize, AvgSchedRunTime]), + io_lib:format("~n",[])]. + +print_stats_threads(Stats, Options) -> + [io_lib:format("~nStats per thread:~n", []), + [print_thread_info(Thread, Options) || Thread <- Stats]]. + +print_stats_type(Stats, Options) -> + [io_lib:format("~nStats per type:~n", []), + [print_thread_info(Thread, Options) || Thread <- Stats]]. + + +print_stats_header([#{ counters := Cnt }|_], #{ system := PrintSys }) -> + [io_lib:format("~14s", ["Thread"]), + map(fun(Counter, _) when PrintSys-> + io_lib:format("~9s ", [atom_to_list(Counter)]); + (Counter, _) -> + io_lib:format("~9s", [atom_to_list(Counter)]) + end, Cnt), + io_lib:format("~n",[])]. + +print_thread_info(#{ '$type' := msacc_stats, + counters := Cnt } = Thread, #{ system := PrintSys }) -> + [case maps:find(id, Thread) of + error -> + io_lib:format("~14s", [atom_to_list(maps:get(type, Thread))]); + {ok, Id} -> + io_lib:format("~10s(~2B)", [atom_to_list(maps:get(type,Thread)),Id]) + end, + map(fun(_Key, #{ thread := ThreadPerc, system := SystemPerc }) when PrintSys -> + io_lib:format("~6.2f%(~4.1f%)", [ThreadPerc, SystemPerc]); + (_Key, #{ thread := ThreadPerc }) -> + io_lib:format("~8.2f%", [ThreadPerc]) + end, Cnt), + io_lib:format("~n",[])]. + +get_total(Cnt, Base) -> + maps:fold(fun(_, {Val,_}, Time) -> + %% Have to handle ERTS_MSACC_STATE_COUNTERS + Time + Val; + (_, Val, Time) -> Time + Val + end, Base, Cnt). + +get_thread_perc(#{ '$type' := msacc_data, counters := Cnt } = Thread, + SystemTime) -> + ThreadTime = get_total(Cnt, 0), + Thread#{ '$type' := msacc_stats, + system => percentage(ThreadTime,SystemTime), + counters => get_thread_perc(Cnt, ThreadTime, SystemTime)}. +get_thread_perc(Cnt, ThreadTime, SystemTime) -> + maps:map(fun F(Key, {Val, C}) -> + M = F(Key, Val), + M#{ cnt => C }; + F(_Key, Val) -> + #{ thread => percentage(Val, ThreadTime), + system => percentage(Val, SystemTime) } + end, Cnt). + +%% This code is a little bit messy as it has to be able to deal with +%% both [msacc_data()] and [msacc_stats()]. +merge_threads([#{ '$type' := msacc_stats, + type := Type, + counters := Cnt } = M0|R], Acc) -> + case keyfind(type, Type, Acc) of + false -> + merge_threads(R, [maps:remove(id,M0#{ threads => 1 })|Acc]); + #{ '$type' := msacc_stats, counters := Cnt0, + threads := Threads, system := System } = M -> + NewMap = M#{ counters := add_counters(Cnt, Cnt0), + system := System + maps:get(system, M0), + threads := Threads + 1}, + NewAcc = keyreplace(type, Type, NewMap, Acc), + merge_threads(R, NewAcc) + end; +merge_threads([], [#{ '$type' := msacc_stats, + system := System, + threads := Threads, + counters := Cnt} = M0|R]) -> + Counters = maps:map(fun(_,#{ thread := Thr } = Map) -> + Map#{ thread := Thr / Threads } + end, Cnt), + M = maps:remove(threads, M0), + [M#{ system := System, counters := Counters} | merge_threads([],R)]; +merge_threads([], []) -> + []; +%% The clauses below deal with msacc_data() +merge_threads([#{ '$type' := msacc_data, + type := Type, + counters := Cnt } = M0|R], Acc) -> + case keyfind(type, Type, Acc) of + false -> + merge_threads(R, [maps:remove(id,M0)|Acc]); + #{ '$type' := msacc_data, counters := Cnt0 } = M -> + NewMap = M#{ counters := add_counters(Cnt, Cnt0) }, + NewAcc = keyreplace(type, Type, NewMap, Acc), + merge_threads(R, NewAcc) + end; +merge_threads([], Acc) -> + Acc. + +add_counters(M1, M2) -> + maps:map( + fun(Key, #{ thread := Thr1, system := Sys1, cnt := Cnt1}) -> + %% Have to handle ERTS_MSACC_STATE_COUNTERS + #{ thread := Thr2, system := Sys2, cnt := Cnt2} = maps:get(Key, M2), + #{ thread => Thr1 + Thr2, system => Sys1 + Sys2, + cnt => Cnt1 + Cnt2 }; + (Key, #{ thread := Thr1, system := Sys1}) -> + #{ thread := Thr2, system := Sys2} = maps:get(Key, M2), + #{ thread => Thr1 + Thr2, system => Sys1 + Sys2}; + (Key, {V1,C1}) -> + %% Have to handle ERTS_MSACC_STATE_COUNTERS + {V2,C2} = maps:get(Key, M2),{V1+V2,C1+C2}; + (Key, V1) -> maps:get(Key, M2) + V1 + end, M1). + +percentage(Divident, Divisor) -> + if Divisor == 0 andalso Divident /= 0 -> + 100.0; + Divisor == 0 -> + 0.0; + true -> + Divident / Divisor * 100 + end. + +keyfind(Key, Value, [H|T]) -> + case maps:find(Key, H) of + {ok, Value} -> + H; + _ -> + keyfind(Key, Value, T) + end; +keyfind(_, _, []) -> + false. + +keyreplace(Key, Value, NewMap, [H|T]) -> + case maps:find(Key, H) of + {ok, Value} -> + [NewMap|T]; + _ -> + [H|keyreplace(Key, Value, NewMap, T)] + end; +keyreplace(_, _, _, []) -> + []. + +statssort(Stats) -> + lists:sort(fun(#{ type := Type1, id := Id1}, + #{ type := Type2, id := Id2}) -> + {Type1, Id1} < {Type2, Id2}; + (#{ type := Type1}, #{ type := Type2}) -> + Type1 < Type2 + end, Stats). + +map(Fun,Map) -> + [ Fun(K,V) || {K,V} <- maps:to_list(Map) ]. diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index 01e99f3f5e..b27bc63d15 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2012. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -22,7 +23,8 @@ -export([vsn/0]). %% observer stuff --export([sys_info/0, get_table/3, get_table_list/2, fetch_stats/2]). +-export([sys_info/0, get_port_list/0, + get_table/3, get_table_list/2, fetch_stats/2]). %% etop stuff -export([etop_collect/1]). @@ -49,6 +51,17 @@ vsn() -> %% observer backend %% sys_info() -> + MemInfo = try erlang:memory() of + Mem -> Mem + catch _:_ -> [] + end, + + SchedulersOnline = erlang:system_info(schedulers_online), + SchedulersAvailable = case erlang:system_info(multi_scheduling) of + enabled -> SchedulersOnline; + _ -> 1 + end, + {{_,Input},{_,Output}} = erlang:statistics(io), [{process_count, erlang:system_info(process_count)}, {process_limit, erlang:system_info(process_limit)}, @@ -56,9 +69,13 @@ sys_info() -> {run_queue, erlang:statistics(run_queue)}, {io_input, Input}, {io_output, Output}, + {logical_processors, erlang:system_info(logical_processors)}, - {logical_processors_available, erlang:system_info(logical_processors_available)}, {logical_processors_online, erlang:system_info(logical_processors_online)}, + {logical_processors_available, erlang:system_info(logical_processors_available)}, + {schedulers, erlang:system_info(schedulers)}, + {schedulers_online, SchedulersOnline}, + {schedulers_available, SchedulersAvailable}, {otp_release, erlang:system_info(otp_release)}, {version, erlang:system_info(version)}, @@ -68,9 +85,16 @@ sys_info() -> {threads, erlang:system_info(threads)}, {thread_pool_size, erlang:system_info(thread_pool_size)}, {wordsize_internal, erlang:system_info({wordsize, internal})}, - {wordsize_external, erlang:system_info({wordsize, external})} | - erlang:memory() - ]. + {wordsize_external, erlang:system_info({wordsize, external})}, + {alloc_info, alloc_info()} + | MemInfo]. + +alloc_info() -> + AlcuAllocs = erlang:system_info(alloc_util_allocators), + try erlang:system_info({allocator_sizes, AlcuAllocs}) of + Allocators -> Allocators + catch _:_ -> [] + end. get_table(Parent, Table, Module) -> spawn(fun() -> @@ -83,7 +107,7 @@ get_table2(Parent, Table, Type) -> ets -> ets:info(Table, size); mnesia -> mnesia:table_info(Table, size) end, - case Size > 0 of + case Size =/= undefined andalso Size > 0 of false -> Parent ! {self(), '$end_of_table'}, normal; @@ -116,6 +140,60 @@ get_mnesia_loop(Parent, {Match, Cont}) -> Parent ! {self(), Match}, get_mnesia_loop(Parent, mnesia:select(Cont)). +get_port_list() -> + ExtraItems = [monitors,monitored_by,parallelism,locking,queue_size,memory], + [begin + [{port_id,P}|erlang:port_info(P)] ++ + port_info(P,ExtraItems) ++ + inet_port_extra(erlang:port_info(P, name), P) + end || P <- erlang:ports()]. + +port_info(P,[Item|Items]) -> + case erlang:port_info(P,Item) of + undefined -> port_info(P,Items); + Value -> [Value|port_info(P,Items)] + end; +port_info(_,[]) -> + []. + +inet_port_extra({_,Type},Port) when Type =:= "udp_inet"; + Type =:= "tcp_inet"; + Type =:= "sctp_inet" -> + Data = + case inet:getstat(Port) of + {ok, Stats} -> [{statistics, Stats}]; + _ -> [] + end ++ + case inet:peername(Port) of + {ok, {RAddr,RPort}} when is_tuple(RAddr), is_integer(RPort) -> + [{remote_address,RAddr},{remote_port,RPort}]; + {ok, RAddr} -> + [{remote_address,RAddr}]; + {error, _} -> [] + end ++ + case inet:sockname(Port) of + {ok, {LAddr,LPort}} when is_tuple(LAddr), is_integer(LPort) -> + [{local_address,LAddr},{local_port,LPort}]; + {ok, LAddr} -> + [{local_address,LAddr}]; + {error, _} -> [] + end ++ + case inet:getopts(Port, + [active, broadcast, buffer, delay_send, + deliver, dontroute, exit_on_close, + header, high_msgq_watermark, high_watermark, + ipv6_v6only, keepalive, linger, low_msgq_watermark, + low_watermark, mode, netns, nodelay, packet, + packet_size, priority, read_packets, recbuf, + reuseaddr, send_timeout, send_timeout_close, + show_econnreset, sndbuf, tos, tclass]) of + {ok, Opts} -> [{options, Opts}]; + {error, _} -> [] + end, + [{inet,Data}]; +inet_port_extra(_,_) -> + []. + get_table_list(ets, Opts) -> HideUnread = proplists:get_value(unread_hidden, Opts, true), HideSys = proplists:get_value(sys_hidden, Opts, true), @@ -199,34 +277,57 @@ get_table_list(mnesia, Opts) -> lists:foldl(Info, [], mnesia:system_info(tables)). fetch_stats(Parent, Time) -> - erlang:system_flag(scheduler_wall_time, true), process_flag(trap_exit, true), - fetch_stats_loop(Parent, Time), - erlang:system_flag(scheduler_wall_time, false). + fetch_stats_loop(Parent, Time). fetch_stats_loop(Parent, Time) -> + erlang:system_flag(scheduler_wall_time, true), receive - _Msg -> normal + _Msg -> + %% erlang:system_flag(scheduler_wall_time, false) + ok after Time -> _M = Parent ! {stats, 1, erlang:statistics(scheduler_wall_time), erlang:statistics(io), - erlang:memory()}, - fetch_stats(Parent, Time) + try erlang:memory() catch _:_ -> [] end}, + fetch_stats_loop(Parent, Time) end. %% %% etop backend %% etop_collect(Collector) -> + %% If this is the first time and the scheduler_wall_time flag is + %% false, SchedulerWallTime will be 'undefined' (and show 0 cpu + %% utilization in etop). Next time the flag will be true and then + %% there will be a measurement. + SchedulerWallTime = erlang:statistics(scheduler_wall_time), ProcInfo = etop_collect(processes(), []), - Collector ! {self(),#etop_info{now = now(), + + Collector ! {self(),#etop_info{now = erlang:timestamp(), n_procs = length(ProcInfo), run_queue = erlang:statistics(run_queue), - wall_clock = erlang:statistics(wall_clock), - runtime = erlang:statistics(runtime), + runtime = SchedulerWallTime, memi = etop_memi(), procinfo = ProcInfo - }}. + }}, + + case SchedulerWallTime of + undefined -> + erlang:system_flag(scheduler_wall_time,true), + spawn(fun() -> flag_holder_proc(Collector) end), + ok; + _ -> + ok + end. + +flag_holder_proc(Collector) -> + Ref = erlang:monitor(process,Collector), + receive + {'DOWN',Ref,_,_,_} -> + %% erlang:system_flag(scheduler_wall_time,false) + ok + end. etop_memi() -> try @@ -251,7 +352,7 @@ etop_collect([P|Ps], Acc) -> [{registered_name,Reg},{initial_call,Initial},{memory,Mem}, {reductions,Reds},{current_function,Current},{message_queue_len,Qlen}] -> Name = case Reg of - [] -> Initial; + [] -> initial_call(Initial, P); _ -> Reg end, Info = #etop_proc_info{pid=P,mem=Mem,reds=Reds,name=Name, @@ -260,6 +361,11 @@ etop_collect([P|Ps], Acc) -> end; etop_collect([], Acc) -> Acc. +initial_call({proc_lib, init_p, _}, Pid) -> + proc_lib:translate_initial_call(Pid); +initial_call(Initial, _Pid) -> + Initial. + %% %% ttb backend %% @@ -283,8 +389,8 @@ ttb_init_node(MetaFile_0,PI,Traci) -> MetaPid ! {metadata,Traci}, case PI of true -> - Proci = pnames(), - MetaPid ! {metadata,Proci}; + MetaPid ! {metadata,pnames()}, + ok; false -> ok end, @@ -303,7 +409,8 @@ ttb_meta_tracer(MetaFile,PI,Parent,SessionData) -> erlang:trace_pattern({erlang,spawn_link,3},ReturnMS,[meta]), erlang:trace_pattern({erlang,spawn_opt,1},ReturnMS,[meta]), erlang:trace_pattern({erlang,register,2},[],[meta]), - erlang:trace_pattern({global,register_name,2},[],[meta]); + erlang:trace_pattern({global,register_name,2},[],[meta]), + ok; false -> ok end, @@ -311,7 +418,8 @@ ttb_meta_tracer(MetaFile,PI,Parent,SessionData) -> case proplists:get_value(overload_check, SessionData) of {Ms, M, F} -> catch M:F(init), - erlang:send_after(Ms, self(), overload_check); + erlang:send_after(Ms, self(), overload_check), + ok; _ -> ok end, @@ -320,10 +428,10 @@ ttb_meta_tracer(MetaFile,PI,Parent,SessionData) -> ttb_meta_tracer_loop(MetaFile,PI,Acc,State) -> receive {trace_ts,_,call,{erlang,register,[Name,Pid]},_} -> - ttb_store_meta({pid,{Pid,Name}},MetaFile), + ok = ttb_store_meta({pid,{Pid,Name}},MetaFile), ttb_meta_tracer_loop(MetaFile,PI,Acc,State); {trace_ts,_,call,{global,register_name,[Name,Pid]},_} -> - ttb_store_meta({pid,{Pid,{global,Name}}},MetaFile), + ok = ttb_store_meta({pid,{Pid,{global,Name}}},MetaFile), ttb_meta_tracer_loop(MetaFile,PI,Acc,State); {trace_ts,CallingPid,call,{erlang,spawn_opt,[{M,F,Args,_}]},_} -> MFA = {M,F,length(Args)}, @@ -339,7 +447,7 @@ ttb_meta_tracer_loop(MetaFile,PI,Acc,State) -> NewAcc = dict:update(CallingPid, fun([H|T]) -> - ttb_store_meta({pid,{NewPid,H}},MetaFile), + ok = ttb_store_meta({pid,{NewPid,H}},MetaFile), T end, Acc), @@ -357,22 +465,22 @@ ttb_meta_tracer_loop(MetaFile,PI,Acc,State) -> NewAcc = dict:update(CallingPid, fun([H|T]) -> - ttb_store_meta({pid,{NewPid,H}},MetaFile), + ok = ttb_store_meta({pid,{NewPid,H}},MetaFile), T end, Acc), ttb_meta_tracer_loop(MetaFile,PI,NewAcc,State); {metadata,Data} when is_list(Data) -> - ttb_store_meta(Data,MetaFile), + ok = ttb_store_meta(Data,MetaFile), ttb_meta_tracer_loop(MetaFile,PI,Acc,State); {metadata,Key,Fun} when is_function(Fun) -> - ttb_store_meta([{Key,Fun()}],MetaFile), + ok = ttb_store_meta([{Key,Fun()}],MetaFile), ttb_meta_tracer_loop(MetaFile,PI,Acc,State); {metadata,Key,What} -> - ttb_store_meta([{Key,What}],MetaFile), + ok = ttb_store_meta([{Key,What}],MetaFile), ttb_meta_tracer_loop(MetaFile,PI,Acc,State); overload_check -> {Ms, M, F} = proplists:get_value(overload_check, State), @@ -388,7 +496,7 @@ ttb_meta_tracer_loop(MetaFile,PI,Acc,State) -> ttb_meta_tracer_loop(MetaFile,PI,Acc, State) end; {'DOWN', _, _, _, _} -> - stop_seq_trace(), + _ = stop_seq_trace(), self() ! stop, ttb_meta_tracer_loop(MetaFile,PI,Acc, State); stop when PI=:=true -> @@ -477,7 +585,7 @@ ttb_store_meta(Data,MetaFile) -> ttb_store_meta([Data],MetaFile). ttb_write_binary(Fd,[H|T]) -> - file:write(Fd,ttb_make_binary(H)), + ok = file:write(Fd,ttb_make_binary(H)), ttb_write_binary(Fd,T); ttb_write_binary(_Fd,[]) -> ok. @@ -534,9 +642,9 @@ ttb_fetch(MetaFile,{Port,Host}) -> send_files({Sock,Host},[File|Files]) -> {ok,Fd} = file:open(File,[raw,read,binary]), - gen_tcp:send(Sock,<<1,(list_to_binary(filename:basename(File)))/binary>>), + ok = gen_tcp:send(Sock,<<1,(list_to_binary(filename:basename(File)))/binary>>), send_chunks(Sock,Fd), - file:delete(File), + ok = file:delete(File), send_files({Sock,Host},Files); send_files({_Sock,_Host},[]) -> done. diff --git a/lib/runtime_tools/src/percept_profile.erl b/lib/runtime_tools/src/percept_profile.erl index cdc7a0fca1..1e8e913b80 100644 --- a/lib/runtime_tools/src/percept_profile.erl +++ b/lib/runtime_tools/src/percept_profile.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -86,7 +87,7 @@ start(Filename, Options) -> start(Filename, {Module, Function, Args}, Options) -> case whereis(percept_port) of undefined -> - profile_to_file(Filename, Options), + {ok, _} = profile_to_file(Filename, Options), erlang:apply(Module, Function, Args), stop(); Port -> @@ -112,14 +113,14 @@ deliver_all_trace() -> -spec stop() -> 'ok' | {'error', 'not_started'}. stop() -> - erlang:system_profile(undefined, [runnable_ports, runnable_procs]), + _ = erlang:system_profile(undefined, [runnable_ports, runnable_procs]), erlang:trace(all, false, [procs, ports, timestamp]), deliver_all_trace(), case whereis(percept_port) of undefined -> {error, not_started}; Port -> - erlang:port_command(Port, erlang:term_to_binary({profile_stop, erlang:now()})), + erlang:port_command(Port, erlang:term_to_binary({profile_stop, erlang:timestamp()})), %% trace delivered? erlang:port_close(Port), ok @@ -139,7 +140,7 @@ profile_to_file(Filename, Opts) -> erlang:system_flag(multi_scheduling, block), Port = (dbg:trace_port(file, Filename))(), % Send start time - erlang:port_command(Port, erlang:term_to_binary({profile_start, erlang:now()})), + erlang:port_command(Port, erlang:term_to_binary({profile_start, erlang:timestamp()})), erlang:system_flag(multi_scheduling, unblock), %% Register Port @@ -157,7 +158,8 @@ set_tracer(Port, Opts) -> {TOpts, POpts} = parse_profile_options(Opts), % Setup profiling and tracing erlang:trace(all, true, [{tracer, Port}, timestamp | TOpts]), - erlang:system_profile(Port, POpts). + _ = erlang:system_profile(Port, POpts), + ok. %% parse_profile_options diff --git a/lib/runtime_tools/src/runtime_tools.app.src b/lib/runtime_tools/src/runtime_tools.app.src index 1152f7259d..690c61a4c3 100644 --- a/lib/runtime_tools/src/runtime_tools.app.src +++ b/lib/runtime_tools/src/runtime_tools.app.src @@ -1,33 +1,34 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% {application, runtime_tools, - [{description, "RUNTIME_TOOLS version 1"}, + [{description, "RUNTIME_TOOLS"}, {vsn, "%VSN%"}, - {modules, [dbg,observer_backend,percept_profile, - inviso_rt,inviso_rt_lib,inviso_rt_meta, - inviso_as_lib,inviso_autostart,inviso_autostart_server, + {modules, [appmon_info, dbg,observer_backend,percept_profile, runtime_tools,runtime_tools_sup,erts_alloc_config, - ttb_autostart,dyntrace]}, - {registered, [runtime_tools_sup,inviso_rt,inviso_rt_meta]}, + ttb_autostart,dyntrace,system_information, + msacc]}, + {registered, [runtime_tools_sup]}, {applications, [kernel, stdlib]}, -% {env, [{inviso_autostart_mod,your_own_autostart_module}]}, {env, []}, - {mod, {runtime_tools, []}}]}. + {mod, {runtime_tools, []}}, + {runtime_dependencies, ["stdlib-3.0","mnesia-4.12","kernel-5.0", + "erts-8.0"]}]}. diff --git a/lib/runtime_tools/src/runtime_tools.appup.src b/lib/runtime_tools/src/runtime_tools.appup.src index 7a435e9b22..a42673c87e 100644 --- a/lib/runtime_tools/src/runtime_tools.appup.src +++ b/lib/runtime_tools/src/runtime_tools.appup.src @@ -1,19 +1,22 @@ -%% +%% -*- erlang -*- %% %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/. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% -%% -{"%VSN%",[],[]}. +{"%VSN%", + [{<<".*">>,[{restart_application, runtime_tools}]}], + [{<<".*">>,[{restart_application, runtime_tools}]}] +}. diff --git a/lib/runtime_tools/src/runtime_tools.erl b/lib/runtime_tools/src/runtime_tools.erl index 2181244610..52ae5cc0eb 100644 --- a/lib/runtime_tools/src/runtime_tools.erl +++ b/lib/runtime_tools/src/runtime_tools.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/runtime_tools/src/runtime_tools_sup.erl b/lib/runtime_tools/src/runtime_tools_sup.erl index 913719c449..efa37de42d 100644 --- a/lib/runtime_tools/src/runtime_tools_sup.erl +++ b/lib/runtime_tools/src/runtime_tools_sup.erl @@ -1,24 +1,25 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2011. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% %% ------------------------------------------------------------------------------ %% File : runtime_tools_sup.erl -%% Author : Lennart �hman <[email protected]> +%% Author : Lennart Öhman <[email protected]> -module(runtime_tools_sup). -behaviour(supervisor). @@ -31,15 +32,11 @@ %% ============================================================================= %% The runtime tools top most supervisor starts: -%% -The inviso runtime component. This is the only way to get the runtime component -%% started automatically (if for instance autostart is wanted). -%% Note that it is not impossible that the runtime component terminates it self -%% should it discover that no autostart is configured. -init(AutoModArgs) -> +%% -The ttb_autostart component. This is used for tracing at startup +%% using observer/ttb. +init(_AutoModArgs) -> Flags = {one_for_one, 0, 3600}, - Children = [{inviso_rt, {inviso_rt, start_link_auto, [AutoModArgs]}, - temporary, 3000, worker, [inviso_rt]}, - {ttb_autostart, {ttb_autostart, start_link, []}, + Children = [{ttb_autostart, {ttb_autostart, start_link, []}, temporary, 3000, worker, [ttb_autostart]}], {ok, {Flags, Children}}. %% ----------------------------------------------------------------------------- diff --git a/lib/runtime_tools/src/system_information.erl b/lib/runtime_tools/src/system_information.erl new file mode 100644 index 0000000000..df25297eb9 --- /dev/null +++ b/lib/runtime_tools/src/system_information.erl @@ -0,0 +1,834 @@ +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + + +%% The main purpose of system_information is to aggregate all information +%% deemed useful for investigation, i.e. system_information:report/0. + +%% The server and all other utilities surrounding this is for inspecting +%% reported values. Functions will be added to this as time goes by. + +-module(system_information). +-behaviour(gen_server). + +%% API +-export([report/0, + from_file/1, + to_file/1]). + +-export([start/0, stop/0, + load_report/0, load_report/2, + applications/0, applications/1, + application/1, application/2, + environment/0, environment/1, + module/1, module/2, + modules/1, + sanity_check/0]). + +%% gen_server callbacks +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). + +-define(SERVER, ?MODULE). + +%% change version if parsing of file changes +-define(REPORT_FILE_VSN, "1.0"). + +-record(state, { + report + }). + +%%=================================================================== +%% API +%%=================================================================== + +start() -> + gen_server:start({local, ?SERVER}, ?MODULE, [], []). + + +stop() -> + gen_server:call(?SERVER, stop, infinity). + +load_report() -> load_report(data, report()). + +load_report(file, File) -> load_report(data, from_file(File)); +load_report(data, Report) -> + ok = start_internal(), gen_server:call(?SERVER, {load_report, Report}, infinity). + +report() -> [ + {init_arguments, init:get_arguments()}, + {code_paths, code:get_path()}, + {code, code()}, + {system_info, erlang_system_info()}, + {erts_compile_info, erlang:system_info(compile_info)}, + {beam_dynamic_libraries, get_dynamic_libraries()}, + {environment_erts, os_getenv_erts_specific()}, + {environment, [split_env(Env) || Env <- os:getenv()]}, + {sanity_check, sanity_check()} + ]. + +-spec to_file(FileName) -> ok | {error, Reason} when + FileName :: file:name_all(), + Reason :: file:posix() | badarg | terminated | system_limit. + +to_file(File) -> + file:write_file(File, iolist_to_binary([ + io_lib:format("{system_information_version, ~p}.~n", [ + ?REPORT_FILE_VSN + ]), + io_lib:format("{system_information, ~p}.~n", [ + report() + ]) + ])). + +from_file(File) -> + case file:consult(File) of + {ok, Data} -> + case get_value([system_information_version], Data) of + ?REPORT_FILE_VSN -> + get_value([system_information], Data); + Vsn -> + erlang:error({unknown_version, Vsn}) + end; + _ -> + erlang:error(bad_report_file) + end. + +applications() -> applications([]). +applications(Opts) when is_list(Opts) -> + gen_server:call(?SERVER, {applications, Opts}, infinity). + +application(App) when is_atom(App) -> application(App, []). +application(App, Opts) when is_atom(App), is_list(Opts) -> + gen_server:call(?SERVER, {application, App, Opts}, infinity). + +environment() -> environment([]). +environment(Opts) when is_list(Opts) -> + gen_server:call(?SERVER, {environment, Opts}, infinity). + +module(M) when is_atom(M) -> module(M, []). +module(M, Opts) when is_atom(M), is_list(Opts) -> + gen_server:call(?SERVER, {module, M, Opts}, infinity). + +modules(Opt) when is_atom(Opt) -> + gen_server:call(?SERVER, {modules, Opt}, infinity). + + +-spec sanity_check() -> ok | {failed, Failures} when + Application :: atom(), + ApplicationVersion :: string(), + MissingRuntimeDependencies :: {missing_runtime_dependencies, + ApplicationVersion, + [ApplicationVersion]}, + InvalidApplicationVersion :: {invalid_application_version, + ApplicationVersion}, + InvalidAppFile :: {invalid_app_file, Application}, + Failure :: MissingRuntimeDependencies + | InvalidApplicationVersion + | InvalidAppFile, + Failures :: [Failure]. + +sanity_check() -> + case check_runtime_dependencies() of + [] -> ok; + Issues -> {failed, Issues} + end. + +%%=================================================================== +%% gen_server callbacks +%%=================================================================== + +init([]) -> + {ok, #state{}}. + +handle_call(stop, _From, S) -> + {stop, normal, ok, S}; + +handle_call({load_report, Report}, _From, S) -> + Version = get_value([system_info, system_version], Report), + io:format("Loaded report from system version: ~s~n", [Version]), + {reply, ok, S#state{ report = Report }}; + +handle_call(_Req, _From, #state{ report = undefined } = S) -> + {reply, {error, report_not_loaded}, S}; + +handle_call({applications, Opts}, _From, #state{ report = Report } = S) -> + ok = print_applications(get_value([code], Report), Opts), + {reply, ok, S}; + +handle_call({application, App, Opts}, _From, #state{ report = Report } = S) -> + Data = get_value([App], [AppInfo||{application, AppInfo}<-get_value([code], Report)]), + ok = print_application({App, Data}, Opts), + {reply, ok, S}; + + +handle_call({environment, Opts}, _From, #state{ report = Report } = S) -> + Choices = case proplists:get_bool(full, Opts) of + true -> [environment]; + false -> [environment_erts] + end, + ok = print_environments(get_value(Choices, Report), Opts), + {reply, ok, S}; + + +handle_call({module, M, Opts}, _From, #state{ report = Report } = S) -> + Mods = find_modules_from_code(M, get_value([code], Report)), + print_modules_from_code(M, Mods, Opts), + {reply, ok, S}; + +handle_call({modules, native}, _From, #state{ report = Report } = S) -> + Codes = get_native_modules_from_code(get_value([code],Report)), + io:format("~p~n", [Codes]), + {reply, ok, S}; + + +handle_call(_Request, _From, State) -> + {reply, ok, State}. + +handle_cast(_Msg, State) -> + {noreply, State}. + +handle_info(_Info, State) -> + {noreply, State}. + +terminate(_Reason, _State) -> + ok. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%=================================================================== +%% Internal functions +%%=================================================================== + +start_internal() -> + case start() of + {ok,_} -> ok; + {error, {already_started,_}} -> ok; + Error -> Error + end. + +%% handle report values + +get_value([], Data) -> Data; +get_value([K|Ks], Data) -> + get_value(Ks, proplists:get_value(K, Data, [])). + +find_modules_from_code(M, [{code, Info}|Codes]) -> + case find_modules(M, get_value([modules], Info)) of + [] -> find_modules_from_code(M, Codes); + Mods -> + Path = get_value([path], Info), + [{Path, Mods}|find_modules_from_code(M, Codes)] + end; +find_modules_from_code(M, [{application, {App, Info}}|Codes]) -> + case find_modules(M, get_value([modules], Info)) of + [] -> find_modules_from_code(M, Codes); + Mods -> + Path = get_value([path], Info), + Vsn = get_value([vsn], Info), + [{App, Vsn, Path, Mods}|find_modules_from_code(M, Codes)] + end; +find_modules_from_code(_, []) -> []. + +find_modules(M, [{M, _}=Info|Ms]) -> [Info|find_modules(M,Ms)]; +find_modules(M, [_|Ms]) -> find_modules(M, Ms); +find_modules(_, []) -> []. + +get_native_modules_from_code([{application, {App, Info}}|Cs]) -> + case get_native_modules(get_value([modules], Info)) of + [] -> get_native_modules_from_code(Cs); + Mods -> + Path = get_value([path], Info), + Vsn = get_value([vsn], Info), + [{App, Vsn, Path, Mods}|get_native_modules_from_code(Cs)] + end; +get_native_modules_from_code([{code, Info}|Cs]) -> + case get_native_modules(get_value([modules], Info)) of + [] -> get_native_modules_from_code(Cs); + Mods -> + Path = get_value([path], Info), + [{Path, Mods}|get_native_modules_from_code(Cs)] + end; +get_native_modules_from_code([]) -> []. + +get_native_modules([]) -> []; +get_native_modules([{Mod, Info}|Ms]) -> + case proplists:get_value(native, Info) of + false -> get_native_modules(Ms); + _ -> [Mod|get_native_modules(Ms)] + end. + + +%% print information + +print_applications([{application, App}|Apps], Opts) -> + print_application(App, Opts), + print_applications(Apps, Opts); +print_applications([{code,_}|Apps], Opts) -> + print_applications(Apps, Opts); +print_applications([], _) -> + ok. + +print_application({App, Info}, Opts) -> + Vsn = get_value([vsn], Info), + io:format(" * ~w-~s~n", [App, Vsn]), + case proplists:get_bool(full, Opts) of + true -> + _ = [ begin + print_module(Minfo) + end || Minfo <- get_value([modules], Info) ], + ok; + false -> + ok + end. + +print_environments([Env|Envs],Opts) -> + print_environment(Env,Opts), + print_environments(Envs,Opts); +print_environments([],_) -> + ok. + +print_environment({_Key, false},_) -> ok; +print_environment({Key, Value},_) -> + io:format(" - ~s = ~ts~n", [Key, Value]). + +print_modules_from_code(M, [Info|Ms], Opts) -> + print_module_from_code(M, Info), + case proplists:get_bool(full, Opts) of + true -> print_modules_from_code(M, Ms, Opts); + false -> ok + end; +print_modules_from_code(_, [], _) -> + ok. + +print_module_from_code(M, {Path, [{M,ModInfo}]}) -> + io:format(" from path \"~ts\" (no application):~n", [Path]), + io:format(" - compiler: ~s~n", [get_value([compiler], ModInfo)]), + io:format(" - md5: ~s~n", [get_value([md5], ModInfo)]), + io:format(" - native: ~w~n", [get_value([native], ModInfo)]), + io:format(" - loaded: ~w~n", [get_value([loaded], ModInfo)]), + ok; +print_module_from_code(M, {App,Vsn,Path,[{M,ModInfo}]}) -> + io:format(" from path \"~ts\" (~w-~s):~n", [Path,App,Vsn]), + io:format(" - compiler: ~s~n", [get_value([compiler], ModInfo)]), + io:format(" - md5: ~s~n", [get_value([md5], ModInfo)]), + io:format(" - native: ~w~n", [get_value([native], ModInfo)]), + io:format(" - loaded: ~w~n", [get_value([loaded], ModInfo)]), + ok. + +print_module({Mod, ModInfo}) -> + io:format(" - ~w:~n", [Mod]), + io:format(" - compiler: ~s~n", [get_value([compiler], ModInfo)]), + io:format(" - md5: ~s~n", [get_value([md5], ModInfo)]), + io:format(" - native: ~w~n", [get_value([native], ModInfo)]), + io:format(" - loaded: ~w~n", [get_value([loaded], ModInfo)]), + ok. + + + +%% get useful information from erlang:system_info/1 + +erlang_system_info() -> + erlang_system_info([ + allocator, + check_io, + otp_release, + port_limit, + process_limit, + % procs, % not needed + smp_support, + system_version, + system_architecture, + threads, + thread_pool_size, + {wordsize,internal}, + {wordsize,external}, + {cpu_topology, defined}, + {cpu_topology, detected}, + scheduler_bind_type, + scheduler_bindings, + compat_rel, + schedulers_state, + build_type, + logical_processors, + logical_processors_online, + logical_processors_available, + driver_version, + nif_version, + emu_args, + ethread_info, + beam_jump_table, + taints + ]). + +erlang_system_info([]) -> []; +erlang_system_info([Type|Types]) -> + [{Type, erlang:system_info(Type)}|erlang_system_info(Types)]. + + +%% get known useful erts environment + +os_getenv_erts_specific() -> + os_getenv_erts_specific([ + "BINDIR", + "DIALYZER_EMULATOR", + "CERL_DETACHED_PROG", + "EMU", + "ERL_CONSOLE_MODE", + "ERL_CRASH_DUMP", + "ERL_CRASH_DUMP_NICE", + "ERL_CRASH_DUMP_SECONDS", + "ERL_EPMD_PORT", + "ERL_EMULATOR_DLL", + "ERL_FULLSWEEP_AFTER", + "ERL_LIBS", + "ERL_MALLOC_LIB", + "ERL_MAX_PORTS", + "ERL_MAX_ETS_TABLES", + "ERL_NO_VFORK", + "ERL_NO_KERNEL_POLL", + "ERL_THREAD_POOL_SIZE", + "ERLC_EMULATOR", + "ESCRIPT_EMULATOR", + "HOME", + "HOMEDRIVE", + "HOMEPATH", + "LANG", + "LC_ALL", + "LC_CTYPE", + "PATH", + "PROGNAME", + "RELDIR", + "ROOTDIR", + "TERM", + %"VALGRIND_LOG_XML", + + %% heart + "COMSPEC", + "HEART_COMMAND", + + %% run_erl + "RUN_ERL_LOG_ALIVE_MINUTES", + "RUN_ERL_LOG_ACTIVITY_MINUTES", + "RUN_ERL_LOG_ALIVE_FORMAT", + "RUN_ERL_LOG_ALIVE_IN_UTC", + "RUN_ERL_LOG_GENERATIONS", + "RUN_ERL_LOG_MAXSIZE", + "RUN_ERL_DISABLE_FLOWCNTRL", + + %% driver getenv + "CALLER_DRV_USE_OUTPUTV", + "ERL_INET_GETHOST_DEBUG", + "ERL_EFILE_THREAD_SHORT_CIRCUIT", + "ERL_WINDOW_TITLE", + "ERL_ABORT_ON_FAILURE", + "TTYSL_DEBUG_LOG" + ]). + +os_getenv_erts_specific([]) -> []; +os_getenv_erts_specific([Key|Keys]) -> + [{Key, os:getenv(Key)}|os_getenv_erts_specific(Keys)]. + +split_env(Env) -> + split_env(Env, []). + +split_env([$=|Vs], Key) -> {lists:reverse(Key), Vs}; +split_env([I|Vs], Key) -> split_env(Vs, [I|Key]); +split_env([], KV) -> lists:reverse(KV). % should not happen. + +%% get applications + +code() -> + % order is important + get_code_from_paths(code:get_path()). + +get_code_from_paths([]) -> []; +get_code_from_paths([Path|Paths]) -> + case is_application_path(Path) of + true -> + [{application, get_application_from_path(Path)}|get_code_from_paths(Paths)]; + false -> + [{code, [ + {path, Path}, + {modules, get_modules_from_path(Path)} + ]}|get_code_from_paths(Paths)] + end. + +is_application_path(Path) -> + case filelib:wildcard(filename:join(Path, "*.app")) of + [] -> false; + _ -> true + end. + +get_application_from_path(Path) -> + [Appfile|_] = filelib:wildcard(filename:join(Path, "*.app")), + case file:consult(Appfile) of + {ok, [{application, App, Info}]} -> + {App, [ + {description, proplists:get_value(description, Info, [])}, + {vsn, proplists:get_value(vsn, Info, [])}, + {path, Path}, + {runtime_dependencies, + proplists:get_value(runtime_dependencies, Info, [])}, + {modules, get_modules_from_path(Path)} + ]} + end. + +get_modules_from_path(Path) -> + [ + begin + {ok,{Mod, Md5}} = beam_lib:md5(Beam), + Loaded = case code:is_loaded(Mod) of + false -> false; + _ -> true + end, + {Mod, [ + {loaded, Loaded}, + {native, beam_is_native_compiled(Beam)}, + {compiler, get_compiler_version(Beam)}, + {md5, hexstring(Md5)} + ]} + end || Beam <- filelib:wildcard(filename:join(Path, "*.beam")) + ]. + +hexstring(Bin) when is_binary(Bin) -> + lists:flatten([io_lib:format("~2.16.0b", [V]) || <<V>> <= Bin]). + +%% inspect beam files for information + +get_compiler_version(Beam) -> + case beam_lib:chunks(Beam, [compile_info]) of + {ok,{_,[{compile_info, Info}]}} -> + proplists:get_value(version, Info); + _ -> undefined + end. + +%% we don't know the specific chunk names of native code +%% we don't want to load the code to check it +beam_is_native_compiled(Beam) -> + Chunks = get_value([chunks], beam_lib:info(Beam)), + case check_known_hipe_chunks(Chunks) of + [] -> false; + [Arch] -> {true, Arch}; + Archs -> {true, Archs} + end. + + +check_known_hipe_chunks([{Tag,_,_}|Cs]) -> + case is_chunk_tag_hipe_arch(Tag) of + false -> check_known_hipe_chunks(Cs); + {true, Arch} -> [Arch|check_known_hipe_chunks(Cs)] + end; +check_known_hipe_chunks([]) -> []. + +%% these values are taken from hipe_unified_loader +%% perhaps these should be exported in that module? + +-define(HS8P_TAG,"HS8P"). +-define(HPPC_TAG,"HPPC"). +-define(HP64_TAG,"HP64"). +-define(HARM_TAG,"HARM"). +-define(HX86_TAG,"HX86"). +-define(HA64_TAG,"HA64"). + +is_chunk_tag_hipe_arch(Tag) -> + case Tag of + ?HA64_TAG -> {true, amd64}; %% HiPE, x86_64, (implicit: 64-bit, Unix) + ?HARM_TAG -> {true, arm}; %% HiPE, arm, v5 (implicit: 32-bit, Linux) + ?HPPC_TAG -> {true, powerpc}; %% HiPE, PowerPC (implicit: 32-bit, Linux) + ?HP64_TAG -> {true, ppc64}; %% HiPE, ppc64 (implicit: 64-bit, Linux) + ?HS8P_TAG -> {true, ultrasparc}; %% HiPE, SPARC, V8+ (implicit: 32-bit) + %% Future: HSV9 %% HiPE, SPARC, V9 (implicit: 64-bit) + %% HW32 %% HiPE, x86, Win32 + _ -> false + end. + + +get_dynamic_libraries() -> + Beam = filename:join([os:getenv("BINDIR"),get_beam_name()]), + case os:type() of + {unix, darwin} -> os:cmd("otool -L " ++ Beam); + _ -> os:cmd("ldd " ++ Beam) + end. + +get_beam_name() -> + Type = case erlang:system_info(build_type) of + opt -> ""; + TypeName -> "." ++ atom_to_list(TypeName) + end, + Flavor = case erlang:system_info(smp_support) of + false -> ""; + true -> ".smp" + end, + Beam = os:getenv("EMU", "beam"), + Beam ++ Type ++ Flavor. + +%% Check runtime dependencies... + +vsnstr2vsn(VsnStr) -> + list_to_tuple(lists:map(fun (Part) -> + list_to_integer(Part) + end, + string:tokens(VsnStr, "."))). + +rtdepstrs2rtdeps([]) -> + []; +rtdepstrs2rtdeps([RTDep | RTDeps]) -> + [AppStr, VsnStr] = string:tokens(RTDep, "-"), + [{list_to_atom(AppStr), vsnstr2vsn(VsnStr)} | rtdepstrs2rtdeps(RTDeps)]. + +build_app_table([], AppTab) -> + AppTab; +build_app_table([App | Apps], AppTab0) -> + AppTab1 = try + %% We may have multiple application versions installed + %% of the same application! It is therefore important + %% to look up the application version that actually will + %% be used via code server. + AppFile = code:where_is_file(atom_to_list(App) ++ ".app"), + {ok, [{application, App, Info}]} = file:consult(AppFile), + VsnStr = proplists:get_value(vsn, Info), + Vsn = vsnstr2vsn(VsnStr), + RTDepStrs = proplists:get_value(runtime_dependencies, + Info, []), + RTDeps = rtdepstrs2rtdeps(RTDepStrs), + gb_trees:insert(App, {Vsn, RTDeps}, AppTab0) + catch + _ : _ -> + AppTab0 + end, + build_app_table(Apps, AppTab1). + +meets_min_req(Vsn, Vsn) -> + true; +meets_min_req({X}, VsnReq) -> + meets_min_req({X, 0, 0}, VsnReq); +meets_min_req({X, Y}, VsnReq) -> + meets_min_req({X, Y, 0}, VsnReq); +meets_min_req(Vsn, {X}) -> + meets_min_req(Vsn, {X, 0, 0}); +meets_min_req(Vsn, {X, Y}) -> + meets_min_req(Vsn, {X, Y, 0}); +meets_min_req({X, _Y, _Z}, {XReq, _YReq, _ZReq}) when X > XReq -> + true; +meets_min_req({X, Y, _Z}, {X, YReq, _ZReq}) when Y > YReq -> + true; +meets_min_req({X, Y, Z}, {X, Y, ZReq}) when Z > ZReq -> + true; +meets_min_req({_X, _Y, _Z}, {_XReq, _YReq, _ZReq}) -> + false; +meets_min_req(Vsn, VsnReq) -> + gp_meets_min_req(mk_gp_vsn_list(Vsn), mk_gp_vsn_list(VsnReq)). + +gp_meets_min_req([X, Y, Z | _Vs], [X, Y, Z]) -> + true; +gp_meets_min_req([X, Y, Z | _Vs], [XReq, YReq, ZReq]) -> + meets_min_req({X, Y, Z}, {XReq, YReq, ZReq}); +gp_meets_min_req([X, Y, Z | Vs], [X, Y, Z | VReqs]) -> + gp_meets_min_req_tail(Vs, VReqs); +gp_meets_min_req(_Vsn, _VReq) -> + %% Versions on different version branches, i.e., the minimum + %% required functionality is not included in Vsn. + false. + +gp_meets_min_req_tail([V | Vs], [V | VReqs]) -> + gp_meets_min_req_tail(Vs, VReqs); +gp_meets_min_req_tail([], []) -> + true; +gp_meets_min_req_tail([_V | _Vs], []) -> + true; +gp_meets_min_req_tail([V | _Vs], [VReq]) when V > VReq -> + true; +gp_meets_min_req_tail(_Vs, _VReqs) -> + %% Versions on different version branches, i.e., the minimum + %% required functionality is not included in Vsn. + false. + +mk_gp_vsn_list(Vsn) -> + [X, Y, Z | Tail] = tuple_to_list(Vsn), + [X, Y, Z | remove_trailing_zeroes(Tail)]. + +remove_trailing_zeroes([]) -> + []; +remove_trailing_zeroes([0 | Vs]) -> + case remove_trailing_zeroes(Vs) of + [] -> []; + NewVs -> [0 | NewVs] + end; +remove_trailing_zeroes([V | Vs]) -> + [V | remove_trailing_zeroes(Vs)]. + +mk_app_vsn_str({App, Vsn}) -> + mk_app_vsn_str(App, Vsn). + +mk_app_vsn_str(App, Vsn) -> + VsnList = tuple_to_list(Vsn), + lists:flatten([atom_to_list(App), + $-, + integer_to_list(hd(VsnList)), + lists:map(fun (Part) -> + [$., integer_to_list(Part)] + end, tl(VsnList))]). + +otp_17_0_vsns_orddict() -> + [{asn1,{3,0}}, + {common_test,{1,8}}, + {compiler,{5,0}}, + {cosEvent,{2,1,15}}, + {cosEventDomain,{1,1,14}}, + {cosFileTransfer,{1,1,16}}, + {cosNotification,{1,1,21}}, + {cosProperty,{1,1,17}}, + {cosTime,{1,1,14}}, + {cosTransactions,{1,2,14}}, + {crypto,{3,3}}, + {debugger,{4,0}}, + {dialyzer,{2,7}}, + {diameter,{1,6}}, + {edoc,{0,7,13}}, + {eldap,{1,0,3}}, + {erl_docgen,{0,3,5}}, + {erl_interface,{3,7,16}}, + {erts,{6,0}}, + {et,{1,5}}, + {eunit,{2,2,7}}, + {gs,{1,5,16}}, + {hipe,{3,10,3}}, + {ic,{4,3,5}}, + {inets,{5,10}}, + {jinterface,{1,5,9}}, + {kernel,{3,0}}, + {megaco,{3,17,1}}, + {mnesia,{4,12}}, + {observer,{2,0}}, + {odbc,{2,10,20}}, + {orber,{3,6,27}}, + {os_mon,{2,2,15}}, + {ose,{1,0}}, + {otp_mibs,{1,0,9}}, + {parsetools,{2,0,11}}, + {percept,{0,8,9}}, + {public_key,{0,22}}, + {reltool,{0,6,5}}, + {runtime_tools,{1,8,14}}, + {sasl,{2,4}}, + {snmp,{4,25,1}}, + {ssh,{3,0,1}}, + {ssl,{5,3,4}}, + {stdlib,{2,0}}, + {syntax_tools,{1,6,14}}, + {test_server,{3,7}}, + {tools,{2,6,14}}, + {typer,{0,9,6}}, + {webtool,{0,8,10}}, + {wx,{1,2}}, + {xmerl,{1,3,7}}]. + +otp_17_0_vsns_tab() -> + gb_trees:from_orddict(otp_17_0_vsns_orddict()). + +check_runtime_dependency({App, DepVsn}, AppTab) -> + case gb_trees:lookup(App, AppTab) of + none -> + false; + {value, {Vsn, _}} -> + meets_min_req(Vsn, DepVsn) + end. + +check_runtime_dependencies(App, AppTab, OtpMinVsnTab) -> + case gb_trees:lookup(App, AppTab) of + none -> + [{invalid_app_file, App}]; + {value, {Vsn, RTDeps}} -> + RTD = case lists:foldl( + fun (RTDep, Acc) -> + case check_runtime_dependency(RTDep, AppTab) of + true -> + Acc; + false -> + [mk_app_vsn_str(RTDep) | Acc] + end + end, + [], + RTDeps) of + [] -> + []; + MissingDeps -> + [{missing_runtime_dependencies, + mk_app_vsn_str(App, Vsn), + MissingDeps}] + end, + case gb_trees:lookup(App, OtpMinVsnTab) of + none -> + RTD; + {value, MinVsn} -> + case meets_min_req(Vsn, MinVsn) of + true -> + RTD; + false -> + [{invalid_application_version, + mk_app_vsn_str(App, Vsn)} | RTD] + end + end + end. + +app_file_to_app(AF) -> + list_to_atom(filename:basename(AF, ".app")). + +get_apps() -> + get_apps(code:get_path(), []). + +get_apps([], Apps) -> + lists:usort(Apps); +get_apps([Path|Paths], Apps) -> + case filelib:wildcard(filename:join(Path, "*.app")) of + [] -> + %% Not app or invalid app + get_apps(Paths, Apps); + [AppFile] -> + get_apps(Paths, [app_file_to_app(AppFile) | Apps]); + [_AppFile| _] = AppFiles -> + %% Strange with multple .app files... Lets put them + %% all in the list and see what we get... + lists:map(fun (AF) -> + app_file_to_app(AF) + end, AppFiles) ++ Apps + end. + +check_runtime_dependencies() -> + OtpMinVsnTab = otp_17_0_vsns_tab(), + Apps = get_apps(), + AppTab = build_app_table(Apps, gb_trees:empty()), + lists:foldl(fun (App, Acc) -> + case check_runtime_dependencies(App, + AppTab, + OtpMinVsnTab) of + [] -> Acc; + Issues -> Issues ++ Acc + end + end, + [], + Apps). + +%% End of runtime dependency checks |