pman_shell.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 823 行 · 第 1/2 页

%% ``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 via the world wide web 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.
%% 
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%% 
%%     $Id$
%%
%%
%% ---------------------------------------------------------------
%% Purpose: Create a trace window with process 
%%          information or a help window with information 
%%          about pman.
%%
%% ---------------------------------------------------------------

-module(pman_shell).

%% ---------------------------------------------------------------
%% The user interface exports 
%% ---------------------------------------------------------------

-export([start_list/3,
	 start/2,
	 start/1,
	 find_shell/0]).

%% ---------------------------------------------------------------
%% Includes
%% ---------------------------------------------------------------
-include("assert.hrl").
-include("pman_options.hrl").
-include("pman_buf.hrl").


%% ---------------------------------------------------------------
%% Internal record declarations
%% ---------------------------------------------------------------
-record(pman_shell,{win,
		    editor,
		    pid,
		    buffer,
		    father,
		    shell_flag,			% boolean, true for shell
		    trace_options,		% Keeps trace options
		    db}).                       % DB for trace windows


%%
%% Constants
%%

-define (PMAN_DB, pman_db).  % The pman db for trace windows



%% ---------------------------------------------------------------
%% start/1, start/2
%%
%% Starts a new trace shell process.
%%
%% start(Pid, DefaultOptions)
%% Pid			The Pid of the process to trace
%% DefaultOptions	The default trace options passed along from
%%			the calling process.
%%
%%
%% start(Pid)
%% Pid                   The Pid of the process to trace
%%
%% start(Pid) starts without using any default options except for those
%% hardwired into the application. (See pman_options.hrl).
%%
%%
%% Return: Both functions return a process id
%% ---------------------------------------------------------------

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% start_list/3 - Starts a trace window for each of the processes
%%    in the list

start_list(LIPid, Father, Options) ->
    StartFun = fun(Pid) ->
		       start({Pid,Father}, Options)
	       end,
    lists:foreach(StartFun, LIPid).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% start/1  - Starts a trace window for the specified Pid.
%%

start(Pid) ->
    start(Pid, #trace_options{}).

%%
%% start/2
%%

start(Pid,DefaultOptions) when is_pid(Pid) ->
    start({Pid,self()}, DefaultOptions);

start(Var,DefaultOptions) ->
    Db = db_start(),
    spawn_link(fun() -> internal(Var, DefaultOptions, Db) end).
    
%% ---------------------------------------------------------------
%% Initialize the enviroment for tracing/viewing Object
%%
%% Object can either be {shell,Shell} or a Pid.
%% The main loop is then called, which handles trace and event 
%% requests. The window dies whenever Supervisor dies, while
%% message windows die whenever their parent dies.
%% ---------------------------------------------------------------

internal({Object,Supervisor}, DefaultOptions, Db) ->

    %% (???) This call will cause minor problems when the window has been
    %% invoked with proc/1 from for instance the shell.  The shell
    %% does not handle the exit-signals, so it will exit
    %% when the window is exited.
    

    %% First check that no other process is tracing the process we want
    %% to trace. There is no well defined way of doing this, so the 
    %% code below is used instead. (???)

    pman_relay:start(Object),				%(???) Uses proc. dict.

    Pid = pman_process:get_pid(Object),

    case pman_relay:ok_to_trace(Pid) of

	%% Tracing cannot be performed on the specified process

	false ->
	    T = lists:flatten(io_lib:format("ERROR: Process ~p is already being~ntraced by some other process.~nOr there may be a problem communicating with it.",[Pid])),
	    tool_utils:notify(gs:start(),T),
	    exit(quit);

	%% Tracing can be performed, go ahead!

	true ->
	    
	    case db_insert_key (Db, Pid) of
		true ->
	    
		    link(Supervisor),
		    process_flag(trap_exit, true),

		    case catch pman_win:window(Object) of
			{'EXIT', badrpc} ->
			    T = "ERROR: Could not access node",
			    pman_win:dialog_window(gs:start(),T);
			{'EXIT', dead} ->
			    T = "ERROR: The process is dead",
			    pman_win:dialog_window(gs:start(),T);
			{'EXIT',_W} ->  
			    T = "ERROR: Untracable process \n(unexpected EXIT reason)",
			    pman_win:dialog_window(gs:start(),T);
			{Win, Ed} ->
			    init_monitor_loop(Win,
					      Ed,
					      Object,
					      Supervisor,
					      DefaultOptions,
					      Db)
		    end;
		
		false ->
		    T = lists:flatten(io_lib:format("ERROR: Process ~p is already being~ntraced by some other process.",[Pid])),
		    tool_utils:notify(gs:start(),T),
		    exit(quit);

		Error ->
		    Error
	    end
	    
	end.



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% init_monitor_loop/5 

init_monitor_loop(Win,Ed,Object,Supervisor, DefaultOptions, Db) ->

    process_flag(priority, max),
    
    %% Most default options come from the main window. Now we must set
    %% the default file name to something that is shows what process
    %% is being traced.

    %% Find out an appropriate file name to write the trace output
    %% to if the output should go to a file.

    FileName = case pman_process:is_pid_or_shell(Object) of
		   true ->
		       default_file_name(pman_process:get_pid(Object));
		   false ->
		       "NoName"
	       end,

    Buff = pman_buf:start(Ed, FileName),      

    case pman_process:is_running(Object) of

	%% We are tracing a shell process.
	{true,{shell,Pid}} ->
	    safe_link(Pid),
	    NewDefaultOptions =
		DefaultOptions#trace_options{file=FileName},
	    perform_option_changes(Pid, NewDefaultOptions, Buff),
	    monitor_loop(#pman_shell{win=Win, editor=Ed, pid=Pid, buffer=Buff,
				     father = Supervisor,
				     shell_flag = true,
				     trace_options = NewDefaultOptions,
				     db = Db});

	%% We are tracing an ordinary process.
	{true,Pid} ->
 	    safe_link(Pid),
	    NewDefaultOptions =
		DefaultOptions#trace_options{file=FileName},
	    perform_option_changes(Pid, NewDefaultOptions, Buff),
	    monitor_loop(#pman_shell{win=Win, editor=Ed, pid=Pid, buffer=Buff,
				     father = Supervisor,
				     shell_flag = false,
				     trace_options = NewDefaultOptions,
				     db = Db});

	%% The process being traced is dead.
	false ->
	    monitor_loop(#pman_shell{win=Win, editor=Ed, pid=nopid,
				     buffer=Buff,
				     father = Supervisor,
				     shell_flag = false,
				     trace_options= DefaultOptions,
				     db = Db})
    end.

%% ----------------------------------------------------------------
%% What is the Pid of the shell on our node?
%%  ----------------------------------------------------------------

find_shell() ->
    case shell:whereis_evaluator() of
	undefined ->				% noshell
	    noshell;
	Pid ->
	    Pid
    end.

%% ---------------------------------------------------------------
%% Functions called in case of an exit message 
%% ---------------------------------------------------------------

clean_up(Win, Buff,Pid) ->

    %% (???) Unlinks the traced process, but since we are using a safe link
    %% it is probably unnecessary.

    safe_unlink(Pid), 

    %% Kill helper processes

    exit(Buff#buffer.converter, topquit),
    exit(Buff#buffer.buffer, topquit),

    gs:destroy(Win).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% exit_cmd/3 - Takes care of the necessary details when
%%    a linked process terminates.


exit_cmd(Pid,_Reason, State) ->
    case State#pman_shell.shell_flag of

	%% This clause handles the case when a shell process dies.
	%% Since it is restarted and the intention is to continue tracing
	%% the restarted shell process, we need to handle it separately by
	%% finding the new shell process.
	true ->
	    
	    NewShell = find_shell(),
	    safe_link(NewShell),
	    pman_relay:start(NewShell),

	    %% Update the window title with the new PID
	    Title = pman_win:title({shell, NewShell}),
	    Win = State#pman_shell.win,
	    gse:config(Win,[{title,Title}]),

	    pman_relay:trac(NewShell, true, flags()),

	    B = State#pman_shell.buffer,
	    B#buffer.converter!{raw,[{shell_died, Pid, NewShell}]},



	    State#pman_shell{pid=NewShell};

	%% This clause handles the case when a traced process that is
	%% not a shell process dies.
	false ->

	    B = State#pman_shell.buffer,
	    B#buffer.converter!{raw,[{died, Pid}]},

	    lists:foreach(fun(X) -> gse:disable(X) end,
			  ['Options',
			   'Kill',
			   'LinksMenu']),
	    State#pman_shell{pid=undefined}
    end.

flags() ->
    [send, 'receive', call, procs,
     set_on_spawn, set_on_first_spawn, set_on_link, set_on_first_link].

options_to_flaglists(Options) ->
    AssocList =
	[{Options#trace_options.send, send},
	 {Options#trace_options.treceive, 'receive'},
	 {Options#trace_options.inherit_on_1st_spawn, set_on_first_spawn},
	 {Options#trace_options.inherit_on_all_spawn, set_on_spawn},
	 {Options#trace_options.inherit_on_1st_link, set_on_first_link},
	 {Options#trace_options.inherit_on_all_link, set_on_link},
	 {Options#trace_options.events, procs},
	 {Options#trace_options.functions,call}],

    TrueFun = fun ({Option,Flag}) ->
		      case Option of
			  true -> Flag;
			  _Otherwise -> false
		      end
	      end,
    TrueFlags = mapfilter(TrueFun, AssocList),

    FalseFun = fun ({Option,Flag}) ->
		       case Option of
			   false -> Flag;
			   _Otherwise -> false
		       end
	       end,
    FalseFlags = mapfilter(FalseFun, AssocList),
    {TrueFlags,FalseFlags}.
    


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% mapfilter/2 - Combines the functionality of lists:map and
%%   lists:filter. mapfilter applies the function argument to
%%   each element in the list. All returned values that are 
%%   not false will occur in the resulting list.
%%
%% Arguments:
%%   Fun	A fun that takes one argument
%%   List	A list. Each element will become an argument to Fun.
%%
%% Returns:
%%  A list of all results from the map operation that are not false.
%%

mapfilter(Fun,[E|Es]) ->
    case apply(Fun,[E]) of
	false ->
	    mapfilter(Fun,Es);
	Value -> [Value | mapfilter(Fun,Es)]
    end;
mapfilter(_Fun, []) -> [].
 

		      
perform_option_changes(Pid,Options,Buffer) ->

    %% Notify the trace output functionality
    %% if the destination is supposed to go to a file...

    case Options#trace_options.to_file of
	true -> 
	    FName = Options#trace_options.file,
	    Buffer#buffer.converter!{file,FName};
	false ->
	    done
    end,

    %%...then set the trace flags of the traced process

    {OnFlags, OffFlags} = options_to_flaglists(Options),
    case catch begin
		   
		   %% (???) Note that the following calls cannot actually fail
		   %% This may be a problem. And the catch appears unnecessary
		   %% However, it may become necessary to let the 
		   %% pman_relay:trac/3 function retrun appropriate values.
		   pman_relay:trac(Pid,true, OnFlags),
		   pman_relay:trac(Pid,false, OffFlags)
	       end of
	true ->
	     ok;
	_ -> pman_win:format("** Illegal trace request ** \n", [])