diff options
Diffstat (limited to 'lib/pman/src/pman_shell.erl')
| -rw-r--r-- | lib/pman/src/pman_shell.erl | 827 |
1 files changed, 0 insertions, 827 deletions
diff --git a/lib/pman/src/pman_shell.erl b/lib/pman/src/pman_shell.erl deleted file mode 100644 index 2d2b8ce000..0000000000 --- a/lib/pman/src/pman_shell.erl +++ /dev/null @@ -1,827 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2012. 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% -%% -%% -%% --------------------------------------------------------------- -%% Purpose: Create a trace window with process -%% information or a help window with information -%% about pman. -%% -%% --------------------------------------------------------------- - --module(pman_shell). --compile([{nowarn_deprecated_function,{gs,config,2}}, - {nowarn_deprecated_function,{gs,destroy,1}}, - {nowarn_deprecated_function,{gs,start,0}}, - {nowarn_deprecated_function,{gs,start,1}}]). - -%% --------------------------------------------------------------- -%% 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", []) - end. - - - - - - -%% --------------------------------------------------------------- -%% Take care of the command executed by the user. - -execute_cmd(Cmd,Shell_data) -> - Window = Shell_data#pman_shell.win, - Editor = Shell_data#pman_shell.editor, - Shell = Shell_data#pman_shell.pid, - Buffer = Shell_data#pman_shell.buffer, - TraceOptions = Shell_data#pman_shell.trace_options, - - case Cmd of - 'Close' -> - db_delete_key (Shell_data#pman_shell.db, Shell_data#pman_shell.pid), - clean_up(Window, Buffer, Shell), - exit(quit); - 'Destroy' -> - db_delete_key (Shell_data#pman_shell.db, Shell_data#pman_shell.pid), - exit(Buffer#buffer.buffer,topquit), - safe_unlink(Shell), - exit(Buffer#buffer.converter,topquit), - exit(Buffer#buffer.buffer,topquit), - exit(quit); - - 'Clear' when is_pid(Shell) -> - New_buffer = pman_buf:clear(Buffer,pman_win:display(Shell), - TraceOptions#trace_options.file), - Shell_data#pman_shell{buffer = New_buffer}; - 'Save buffer' -> - DefaultFile = "Pman_buffer." ++ default_file_name(Shell), - Result = tool_utils:file_dialog([{type,save}, - {file,DefaultFile}]), - case Result of - {ok, UserFile, _State} -> - Buffer#buffer.buffer!{save_buffer,UserFile}; - {error,_Reason} -> - true - end, - Shell_data; - 'Help' -> - HelpFile = filename:join([code:lib_dir(pman), "doc", "html", "index.html"]), - tool_utils:open_help(gs:start([{kernel, true}]), HelpFile), - Shell_data; - 'Kill' when is_pid(Shell) -> - exit(Buffer#buffer.converter,killed), - exit(Buffer#buffer.buffer,killed), - lists:foreach(fun(X) -> gse:disable(X) end, - ['TraceMenu', - 'Clear']), - catch exit(Shell, kill), - Shell_data#pman_shell{pid = undefined}; - 'All Links' when is_pid(Shell) -> - LIPid = pman_process:pinfo(Shell, links), - ?ALWAYS_ASSERT("Just a brutal test"), - start_list(LIPid, - Shell_data#pman_shell.father, - Shell_data#pman_shell.trace_options), - Shell_data; - 'Module' when is_pid(Shell) -> - {ModuleName,_,_} = pman_process:function_info(Shell), - pman_module_info:start(ModuleName), - Shell_data; - 'Options' when is_pid(Shell) -> - case pman_options:dialog(Window, - "Trace Options for Process", - TraceOptions) of - {error, _Reason} -> - Shell_data; - Options -> - perform_option_changes(Shell, Options, Buffer), - Shell_data#pman_shell{trace_options=Options} - end; - - {trac,Choice,Bool} when is_pid(Shell) -> - pman_relay:trac(Shell, Bool, [Choice]), - Shell_data; - - - {configure,{X,Y}} -> - configure (Editor, X, Y), - Shell_data; - - Pid when is_pid(Pid) -> - pman_shell:start({Pid, Shell_data#pman_shell.father}, - Shell_data#pman_shell.trace_options), - Shell_data; - _Other -> - ?ALWAYS_ASSERT("Received unexpected event"), - Shell_data - end. - - -default_file_name(Shell) when is_pid(Shell) -> - [A,B,C] = string:tokens(pid_to_list(Shell),[$.,$<,$>]), - "pman_trace." ++ A ++ "_" ++ B ++ "_" ++ C; -default_file_name(_OTHER) -> - "shell". - - - - - -%% Key accellerators - -key(e) -> 'Clear'; -key(s) -> 'Save buffer'; -key(c) -> 'Close'; -key(a) -> 'All'; -key(r) -> 'Reset'; -key(m) -> 'Module'; -key(l) -> 'All Links'; -key(k) -> 'Kill'; -key(h) -> 'Help'; -key(z) -> 'Close'; -key(O) -> O. - - - -%% --------------------------------------------------------------- -%% The main loop takes care of data coming in from the traces, as -%% well as exit signals from proceses we are monitoring. Events -%% caused by the user or window manager are also handled here. -%% --------------------------------------------------------------- - - -monitor_loop(Shell_data) -> - receive - - %% WM destroy - {gs,_Window,destroy,[],[]} -> %%Avoid links menus - execute_cmd('Destroy', Shell_data); - - - %% Handle EXIT signal from parent process - {'EXIT', _Pid, topquit} -> - clean_up(Shell_data#pman_shell.win, - Shell_data#pman_shell.buffer, - Shell_data#pman_shell.pid), - exit(topquit); - - %% (???) Ignore "stray" EXIT signal from converter - {'EXIT', _Pid, win_killed} -> - monitor_loop(Shell_data); - - - %% Handle EXIT signal from safely linked Pid - %% This is received when a traced process dies. - {'SAFE_EXIT', Pid, Reason} -> - New_Shell_data = exit_cmd(Pid, Reason,Shell_data ), - monitor_loop(New_Shell_data); - - - %% Handle EXIT signal from processes where we expect - %% some EXIT signals, such as the file_dialog opened, and possibly - %% others. - - {'EXIT', _Pid, _Reason} -> - monitor_loop(Shell_data); - - %% Handle incoming trace messages - Message when is_tuple(Message) , element(1,Message) == trace-> - {L, Suspended} = collect_tracs([Message]), - Buffer = Shell_data#pman_shell.buffer, - Buffer#buffer.converter!{raw,L}, - lists:foreach(fun(P) -> erlang:resume_process(P) end, Suspended), - monitor_loop(Shell_data); - - - %% All other messages on the form {...,...,...} - Message when is_tuple(Message) -> - do_link_stuff(Shell_data), - - New_Shell_data = process_gs_event(Message,Shell_data), - monitor_loop(New_Shell_data); - - %% Catch all for unexpected messages - _Anything -> - ?ALWAYS_ASSERT("Received unexpected event"), - monitor_loop(Shell_data) - - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% process_event/1 - Error handling wrapper for gs_cmd - -process_gs_event(Message, Shell_data) -> - case catch gs_cmd(Message,Shell_data) of - - %% - %% Error exits from gs_cmd - - {'EXIT', badrpc} -> - Text = "\nERROR: Could not access node", - pman_win:msg_win(Text), - Shell_data; - {'EXIT', dead} -> - Text = "\nERROR: The process is dead", - pman_win:msg_win(Text), - Shell_data; - - %% A controlled application initiated termination - {'EXIT', quit} -> - db_delete_key (Shell_data#pman_shell.db, Shell_data#pman_shell.pid), - exit(quit); - - - {'EXIT',Reason} -> - db_delete_key (Shell_data#pman_shell.db, Shell_data#pman_shell.pid), - io:format("Debug info, Reason: ~p~n",[Reason]), - ?ALWAYS_ASSERT("Unexpected EXIT reason"), - exit({unexpected_EXIT_reason,Reason}); - - %% - %% "Proper" exits from gs_cmd - - New_Shell_data -> - New_Shell_data - end. - - - -gs_cmd(Cmd, Shell_data) -> - case Cmd of - - %%User Command - {gs, Command, click, _Data, _Args} -> - execute_cmd(Command,Shell_data); - - %%Key accellerator - {gs,_Window,keypress,_D,[Key,_,0,1]} -> - execute_cmd(key(Key),Shell_data); - - %%Window Resize - {gs,_Window,configure,_,[X,Y|_]} -> - execute_cmd({configure,{X,Y}},Shell_data); - - - {gs, _Object, _Event, _Data, _Args} -> - ?ALWAYS_ASSERT("Unhandled gs event"), - Shell_data - - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% (???) do_link_stuff/1 - I have no clue. -%% - -do_link_stuff(Shell_data) -> - - %% This appears to be code to execute for adding - %% dynamic links menus. - - case Shell_data#pman_shell.pid of - undefined -> - ok; - Pid -> - case pman_process:pinfo(Pid, links) of - Links when is_list(Links) -> - pman_win:links_menus(Links); - undefined -> - ok - end - end. - - -%% (???) Process dictionary used to safe Pid-Pid pairs. -%% -%% safe_link/1 - Spawns a process, that links to the Pid, and sends -%% a message to the caller when the linked process dies. -%% -%% Since we (think we) need to link to the traced process, we want -%% to do it in a way that has the smallest possible risk. The process -%% that links to the Pid is small and simple, which is safer than if -%% the calling process would link directly to the Pid. - -safe_link(Pid) when is_pid(Pid) -> - Self = self(), - PidSafe = spawn_link(fun() -> safe_init(Self, Pid) end), - put(Pid, PidSafe). - - -%% safe_unlink/1 - Removes a safe link -%% - -safe_unlink(Pid) when is_pid(Pid) -> - PidSafe = get(Pid), - PidSafe ! {unlink, self(), Pid}, - erase(Pid); - -safe_unlink(_Anything)-> - true. - -%% safe_init/2 - Initialize a simple receive loop that controls safe linking -%% to application processes. -%% -safe_init(Caller, Pid) -> - - process_flag(trap_exit, true), - link(Pid), - - safe_loop(Caller, Pid). - - -%% safe_loop/2 - Simply waits for an exit signal from the linked Pid, -%% all other messages are disregarded. -%% - - -safe_loop(Caller, Pid) -> - receive - %% Linked process dies - {'EXIT' , Pid, Reason} -> - Caller ! {'SAFE_EXIT', Pid, Reason}; - - %% Caller dies - {'EXIT', Caller, _Reason} -> - unlink(Pid); - - - %% Unlink request - {unlink, Caller, Pid} -> - unlink(Pid); - - %% Ignore everything else - _Anything -> - safe_loop(Caller, Pid) - end. - - - -configure (Editor, W, H) -> - gs:config (Editor, [{width, W - 3}, - {height, H - 40}]). - - - - -%%% The DB is used to avoid multiple trace windows -%%% of the same process. - -%%% db_start /0 -%%% - -db_start() -> - case ets:info(?PMAN_DB) of - undefined -> ets:new(?PMAN_DB, [public, named_table]); - _ -> ?PMAN_DB - end. - - - -%%% db_insert_key /2 -%%% - -db_insert_key (Db, Pid) -> - case ets:lookup (Db, Pid) of - [] -> - case catch ets:insert (Db, {Pid}) of - true -> - true; - - _Error -> - error_insert_db - end; - - _already_exists -> - false - end. - - - -%%% db_delete_key /2 -%%% - -db_delete_key (Db, Pid) -> - ets:delete (Db, Pid). - - -%% Function to collect all trace messages in the receive queue. -%% Returns: {Messages,SuspendedProcesses} - -collect_tracs(Ack) -> collect_tracs(Ack, ordsets:new()). - -collect_tracs(Ack, Procs) -> - receive - Trac when is_tuple(Trac), element(1, Trac) == trace -> - P = suspend(Trac, Procs), - collect_tracs([Trac | Ack], P) - after 0 -> - {lists:reverse(Ack), ordsets:to_list(Procs)} - end. - -suspend({trace,From,call,_Func}, Suspended) when node(From) == node() -> - case ordsets:is_element(From, Suspended) of - true -> Suspended; - false -> - case (catch erlang:suspend_process(From)) of - true -> - ordsets:add_element(From, Suspended); - _ -> - Suspended - end - end; -suspend(_Other, Suspended) -> Suspended. |