diff options
Diffstat (limited to 'lib/percept/src/percept.erl')
| -rw-r--r-- | lib/percept/src/percept.erl | 337 |
1 files changed, 337 insertions, 0 deletions
diff --git a/lib/percept/src/percept.erl b/lib/percept/src/percept.erl new file mode 100644 index 0000000000..af1a920efd --- /dev/null +++ b/lib/percept/src/percept.erl @@ -0,0 +1,337 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-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% +%% + +%% +%% @doc Percept - Erlang Concurrency Profiling Tool +%% +%% This module provides the user interface for the application. +%% + +-module(percept). +-behaviour(application). +-export([ + profile/1, + profile/2, + profile/3, + stop_profile/0, + start_webserver/0, + start_webserver/1, + stop_webserver/0, + stop_webserver/1, + analyze/1, + % Application behaviour + start/2, + stop/1]). + + +-include("percept.hrl"). + +%%========================================================================== +%% +%% Type definitions +%% +%%========================================================================== + +%% @type percept_option() = procs | ports | exclusive + +-type(percept_option() :: 'procs' | 'ports' | 'exclusive' | 'scheduler'). + +%%========================================================================== +%% +%% Application callback functions +%% +%%========================================================================== + +%% @spec start(Type, Args) -> {started, Hostname, Port} | {error, Reason} +%% @doc none +%% @hidden + +start(_Type, _Args) -> + %% start web browser service + start_webserver(0). + +%% @spec stop(State) -> ok +%% @doc none +%% @hidden + +stop(_State) -> + %% stop web browser service + stop_webserver(0). + +%%========================================================================== +%% +%% Interface functions +%% +%%========================================================================== + +%% @spec profile(Filename::string()) -> {ok, Port} | {already_started, Port} +%% @see percept_profile + +%% profiling + +-spec(profile/1 :: (Filename :: string()) -> + {'ok', port()} | {'already_started', port()}). + +profile(Filename) -> + percept_profile:start(Filename, [procs]). + +%% @spec profile(Filename::string(), [percept_option()]) -> {ok, Port} | {already_started, Port} +%% @see percept_profile + +-spec(profile/2 :: ( + Filename :: string(), + Options :: [percept_option()]) -> + {'ok', port()} | {'already_started', port()}). + +profile(Filename, Options) -> + percept_profile:start(Filename, Options). + +%% @spec profile(Filename::string(), MFA::mfa(), [percept_option()]) -> ok | {already_started, Port} | {error, not_started} +%% @see percept_profile + +-spec(profile/3 :: ( + Filename :: string(), + Entry :: {atom(), atom(), list()}, + Options :: [percept_option()]) -> + 'ok' | {'already_started', port()} | {'error', 'not_started'}). + +profile(Filename, MFA, Options) -> + percept_profile:start(Filename, MFA, Options). + +-spec(stop_profile/0 :: () -> 'ok' | {'error', 'not_started'}). + +%% @spec stop_profile() -> ok | {'error', 'not_started'} +%% @see percept_profile + +stop_profile() -> + percept_profile:stop(). + +%% @spec analyze(string()) -> ok | {error, Reason} +%% @doc Analyze file. + +-spec(analyze/1 :: (Filename :: string()) -> + 'ok' | {'error', any()}). + +analyze(Filename) -> + case percept_db:start() of + {started, DB} -> + parse_and_insert(Filename,DB); + {restarted, DB} -> + parse_and_insert(Filename,DB) + end. + +%% @spec start_webserver() -> {started, Hostname, Port} | {error, Reason} +%% Hostname = string() +%% Port = integer() +%% Reason = term() +%% @doc Starts webserver. + +-spec(start_webserver/0 :: () -> + {'started', string(), pos_integer()} | + {'error', any()}). + +start_webserver() -> + start_webserver(0). + +%% @spec start_webserver(integer()) -> {started, Hostname, AssignedPort} | {error, Reason} +%% Hostname = string() +%% AssignedPort = integer() +%% Reason = term() +%% @doc Starts webserver. If port number is 0, an available port number will +%% be assigned by inets. + +-spec(start_webserver/1 :: (Port :: non_neg_integer()) -> + {'started', string(), pos_integer()} | + {'error', any()}). + +start_webserver(Port) when is_integer(Port) -> + application:load(percept), + case whereis(percept_httpd) of + undefined -> + {ok, Config} = get_webserver_config("percept", Port), + inets:start(), + case inets:start(httpd, Config) of + {ok, Pid} -> + AssignedPort = find_service_port_from_pid(inets:services_info(), Pid), + {ok, Host} = inet:gethostname(), + %% workaround until inets can get me a service from a name. + Mem = spawn(fun() -> service_memory({Pid,AssignedPort,Host}) end), + register(percept_httpd, Mem), + {started, Host, AssignedPort}; + {error, Reason} -> + {error, {inets, Reason}} + end; + _ -> + {error, already_started} + end. + +%% @spec stop_webserver() -> ok | {error, not_started} +%% @doc Stops webserver. + +stop_webserver() -> + case whereis(percept_httpd) of + undefined -> + {error, not_started}; + Pid -> + Pid ! {self(), get_port}, + receive Port -> ok end, + Pid ! quit, + stop_webserver(Port) + end. + +%% @spec stop_webserver(integer()) -> ok | {error, not_started} +%% @doc Stops webserver of the given port. +%% @hidden + +stop_webserver(Port) -> + case find_service_pid_from_port(inets:services_info(), Port) of + undefined -> + {error, not_started}; + Pid -> + inets:stop(httpd, Pid) + end. + +%%========================================================================== +%% +%% Auxiliary functions +%% +%%========================================================================== + +%% parse_and_insert + +parse_and_insert(Filename, DB) -> + io:format("Parsing: ~p ~n", [Filename]), + T0 = erlang:now(), + Pid = dbg:trace_client(file, Filename, mk_trace_parser(self())), + Ref = erlang:monitor(process, Pid), + parse_and_insert_loop(Filename, Pid, Ref, DB, T0). + +parse_and_insert_loop(Filename, Pid, Ref, DB, T0) -> + receive + {'DOWN',Ref,process, Pid, noproc} -> + io:format("Incorrect file or malformed trace file: ~p~n", [Filename]), + {error, file}; + {parse_complete, {Pid, Count}} -> + receive {'DOWN', Ref, process, Pid, normal} -> ok after 0 -> ok end, + DB ! {action, consolidate}, + T1 = erlang:now(), + io:format("Parsed ~p entries in ~p s.~n", [Count, ?seconds(T1, T0)]), + io:format(" ~p created processes.~n", [length(percept_db:select({information, procs}))]), + io:format(" ~p opened ports.~n", [length(percept_db:select({information, ports}))]), + ok; + {'DOWN',Ref, process, Pid, normal} -> parse_and_insert_loop(Filename, Pid, Ref, DB, T0); + {'DOWN',Ref, process, Pid, Reason} -> {error, Reason} + end. + +mk_trace_parser(Pid) -> + {fun trace_parser/2, {0, Pid}}. + +trace_parser(end_of_trace, {Count, Pid}) -> + Pid ! {parse_complete, {self(),Count}}, + receive + {ack, Pid} -> + ok + end; +trace_parser(Trace, {Count, Pid}) -> + percept_db:insert(Trace), + {Count + 1, Pid}. + +find_service_pid_from_port([], _) -> + undefined; +find_service_pid_from_port([{_, Pid, Options} | Services], Port) -> + case lists:keysearch(port, 1, Options) of + false -> + find_service_pid_from_port(Services, Port); + {value, {port, Port}} -> + Pid + end. + +find_service_port_from_pid([], _) -> + undefined; +find_service_port_from_pid([{_, Pid, Options} | _], Pid) -> + case lists:keysearch(port, 1, Options) of + false -> + undefined; + {value, {port, Port}} -> + Port + end; +find_service_port_from_pid([{_, _, _} | Services], Pid) -> + find_service_port_from_pid(Services, Pid). + +%% service memory + +service_memory({Pid, Port, Host}) -> + receive + quit -> + ok; + {Reply, get_port} -> + Reply ! Port, + service_memory({Pid, Port, Host}); + {Reply, get_host} -> + Reply ! Host, + service_memory({Pid, Port, Host}); + {Reply, get_pid} -> + Reply ! Pid, + service_memory({Pid, Port, Host}) + end. + +% Create config data for the webserver + +get_webserver_config(Servername, Port) when is_list(Servername), is_integer(Port) -> + Path = code:priv_dir(percept), + Root = filename:join([Path, "server_root"]), + MimeTypesFile = filename:join([Root,"conf","mime.types"]), + {ok, MimeTypes} = httpd_conf:load_mime_types(MimeTypesFile), + Config = [ + % Roots + {server_root, Root}, + {document_root,filename:join([Root, "htdocs"])}, + + % Aliases + {eval_script_alias,{"/eval",[io]}}, + {erl_script_alias,{"/cgi-bin",[percept_graph,percept_html,io]}}, + {script_alias,{"/cgi-bin/", filename:join([Root, "cgi-bin"])}}, + {alias,{"/javascript/",filename:join([Root, "scripts"]) ++ "/"}}, + {alias,{"/images/", filename:join([Root, "images"]) ++ "/"}}, + {alias,{"/css/", filename:join([Root, "css"]) ++ "/"}}, + + % Logs + %{transfer_log, filename:join([Path, "logs", "transfer.log"])}, + %{error_log, filename:join([Path, "logs", "error.log"])}, + + % Configs + {default_type,"text/plain"}, + {directory_index,["index.html"]}, + {mime_types, MimeTypes}, + {modules,[mod_alias, + mod_esi, + mod_actions, + mod_cgi, + mod_include, + mod_dir, + mod_get, + mod_head + % mod_log, + % mod_disk_log + ]}, + {com_type,ip_comm}, + {server_name, Servername}, + {bind_address, any}, + {port, Port}], + {ok, Config}. |