Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

652 lines (555 sloc) 18.539 kb
%%%----------------------------------------------------------------------
%%% File : yaws_debug.erl
%%% Author : Claes Wikstrom <klacke@hyber.org>
%%% Purpose :
%%% Created : 7 Feb 2002 by Claes Wikstrom <klacke@hyber.org>
%%%----------------------------------------------------------------------
-module(yaws_debug).
-author('klacke@hyber.org').
-include("../include/yaws.hrl").
-include("../include/yaws_api.hrl").
-include("yaws_debug.hrl").
-export([typecheck/3,
format_record/3,
assert/4,
format/2,
derror/2,
dinfo/2,
mktags/0,
xref/1,
pids/0,
eprof/0,
check_headers/1, nobin/1,
do_debug_dump/1
]).
typecheck([{record, Rec, X} | Tail], File, Line) when is_atom(X),
element(1, Rec) == X ->
typecheck(Tail, File, Line);
typecheck([{int, Int} |Tail], File, Line) when is_integer(Int) ->
typecheck(Tail, File, Line);
typecheck([Err|_], File, Line) ->
io:format(user, "TC ERROR ~s:~w:~n~p",
[File, Line, Err]),
erlang:error(tcerr);
typecheck([], _,_) ->
ok.
%% returns {record, RecName, [Field1, Val1} .....]
format_record(Record, Name, Fields) ->
case tuple_to_list(Record) of
[Name | Rest] ->
io_lib:format("record ~w\n~s", [Name,
format_record(Rest, Fields)]);
_X ->
?Debug("Bad record ~p is not ~p~n", [_X, Name]),
"badrecord"
end.
format_record([], []) ->
[];
format_record([Val|Vals], [F|Fs]) when is_integer(Val);
Val == [];
is_atom(Val);
is_float(Val)->
[io_lib:format(" ~w = ~w\n", [F,Val]),
format_record(Vals, Fs)];
format_record([Val|Vals], [F|Fs]) ->
case is_string(Val) of
true ->
[io_lib:format(" ~w = \"~s\"\n", [F,Val]),
format_record(Vals, Fs)];
false ->
[io_lib:format(" ~w = ~p~n", [F, nobin(Val)]),
format_record(Vals, Fs)]
end.
is_string(L) when is_list(L) ->
lists:filter(fun(X) when is_integer(X),
$A < X, X < $z ->
false;
(_) ->
true
end,L) == [];
is_string(_) ->
false.
assert(equal,X,Y,_) when X==Y ->
ok;
assert(neq,X,Y,_) when X/=Y ->
ok;
assert(integer,X,_,_) when is_integer(X) ->
ok;
assert(list,X,_,_) when is_list(X) ->
ok;
assert({list,length,equal},X,Y,_) when is_list(X), length(X)==Y ->
ok;
assert(greater,X,Y,_) when is_integer(X), is_integer(Y), X>Y ->
ok;
assert(min,X,Y,_) when is_integer(X), is_integer(Y), X>=Y ->
ok;
assert(lesser,X,Y,_) when is_integer(X), is_integer(Y), X<Y ->
ok;
assert(max,X,Y,_) when is_integer(X), is_integer(Y), X=<Y ->
ok;
assert(interval,X,{Min,Max},_) when is_integer(X), is_integer(Min),
is_integer(Max),
X>=Min, Max>=X ->
ok;
assert('fun', Fun, _, Failure) ->
case catch Fun() of
true -> ok;
_Other -> fail(Failure)
end;
assert(in,X,L,Failure) when is_list(L) ->
case lists:member(X,L) of
true -> ok;
_ -> fail(Failure)
end;
assert(_,_,_,Failure) ->
fail(Failure).
fail({assert,File,Line,Message}) ->
io:format(user, "Assertion FAILED ~p:~p, pid ~w exiting: ~p~n",
[File, Line, self(), Message]),
erlang:error(assertion_failed);
fail({alert,File,Line,Message}) ->
io:format(user, "Assert WARNING ~p:~p, pid ~w: ~p~n",
[File, Line, self(), Message]),
ok;
fail({{debug,Fstr}, File,Line,Fmt, Args}) ->
Str = lists:flatten(
io_lib:format("~s <~p> ~s:~p, pid ~w: ~n",
[Fstr, node(), filename:basename(File),
Line, self()])),
case (catch io:format(user, Str ++ Fmt ++ "~n", Args)) of
ok -> ok;
_ -> io:format(user, "ERROR ~p:~p: Pid ~w: (bad format)~n~p,~p~n",
[File, Line, self(), Fmt, Args]),
ok
end;
fail({format, File,Line,Fmt,Args}) ->
case (catch io:format(user, Fmt,Args)) of
ok -> ok;
_ ->
io:format(user, "ERROR ~p:~p: Pid ~w: (bad format)~n~p,~p~n",
[File, Line, self(), Fmt, Args]),
ok
end.
format(F, A) ->
case ?gc_has_debug((get(gc))) of
true ->
io:format("yaws:" ++ F, A);
false ->
ok
end.
derror(F, A) ->
case ?gc_has_debug((get(gc))) of
true ->
error_logger:error_msg("yaws:" ++ F, A);
false ->
ok
end.
dinfo(F, A) ->
case ?gc_has_debug((get(gc))) of
true ->
error_logger:info_msg("yaws:" ++ F, A);
false ->
ok
end.
mktags() ->
tags:dirs(["."]),
init:stop().
xref([Dir]) ->
io:format("~p~n", [xref:d(Dir)]),
init:stop().
pids() ->
lists:zf(
fun(P) ->
case process_info(P) of
L when is_list(L) ->
{value, {_, {M1, _,_}}} =
lists:keysearch(current_function, 1, L),
{value, {_, {M2, _,_}}} =
lists:keysearch(initial_call, 1, L),
S1= atom_to_list(M1),
S2 = atom_to_list(M2),
case {S1, S2} of
{"yaws" ++ _, _} ->
{true, P};
{_, "yaws"++_} ->
{true, P};
_ ->
false
end;
_ ->
false
end
end,
processes()).
eprof() ->
eprof:start(),
eprof:profile(pids()),
io:format("Ok run some traffic \n", []).
-define(h_check(H, Field),
f_check(H#outh.Field, Field)).
f_check(undefined, _Field) ->
ok;
f_check(Str, Field) ->
case lists:reverse(lists:flatten(Str)) of
[$\n, $\r , H | _Tail] ->
case lists:member(H, [$\n, $\r]) of
true ->
error_logger:format("Bad <~p> header:~n"
" ~p~nToo many newlines",
[Field, Str]),
exit(normal);
false ->
ok
end;
_Other ->
error_logger:format("Bad <~p> header:~n"
"~p~nNot ending with CRNL~n",
[Field, Str]),
exit(normal)
end.
check_headers(H) ->
?h_check(H, connection),
?h_check(H, server),
?h_check(H, location),
?h_check(H, cache_control),
?h_check(H, date),
?h_check(H, allow),
?h_check(H, last_modified),
?h_check(H, etag),
?h_check(H, content_range),
?h_check(H, content_length),
?h_check(H, content_encoding),
?h_check(H, set_cookie),
?h_check(H, transfer_encoding),
?h_check(H, www_authenticate),
check_other(H#outh.other).
check_other(undefined) ->
ok;
check_other(L0) ->
L = lists:flatten(L0),
case lists:dropwhile(fun(X) -> not lists:member(X, ["\r\n"]) end, L) of
[] ->
ok;
[$\r, $\n, H | _Tail] ->
case lists:member(H, [$\n, $\r]) of
true ->
bad_other(L);
false ->
ok
end;
_Other ->
bad_other(L)
end.
bad_other(L) ->
Bad = lists:takewhile(
fun(X) -> not lists:member(X, ["\r\n"]) end, L),
error_logger:format("Bad header:~p~n"
"Too many newlines",
[Bad]),
exit(normal).
nobin(X) ->
case catch xnobin(X) of
{'EXIT', Reason} ->
error_logger:format("~p~n~p~n", [X, Reason]),
erlang:error(Reason);
Res ->
Res
end.
xnobin(B) when is_binary(B) ->
lists:flatten(io_lib:format("#Bin(~w)", [size(B)]));
xnobin(L) when is_list(L) ->
lists:map(fun(X) -> xnobin(X) end, L);
xnobin(T) when is_tuple(T) ->
list_to_tuple(xnobin(tuple_to_list(T)));
xnobin(X) ->
X.
%%%%%%%%%%%%%%% debug dump %%%%%%%%%%%%%%%%%%%%%%%
do_debug_dump(Socket) ->
gen_version(Socket),
gen_sep(Socket),
%% keep proc status last, to report on hangs for the others
CollectOS = gen_os(Socket),
Collect = lists:foldl(fun({F, Str}, Acc) ->
Ret = collect(F, Socket, Str),
gen_sep(Socket),
[Ret|Acc]
end,
CollectOS,
[{fun send_status/1, "Yaws status"},
{fun send_inet/1, "Inet status"},
{proc_status_fun(), "process status"}]),
lists:foreach(fun(ok) ->
ok;
({pid, Pid}) ->
exit(Pid, shutdown)
end, Collect),
ok.
gen_version(Socket) ->
sock_format(Socket, "Yawsvsn: ~p~n", [yaws_generated:version()]).
gen_os(Socket) ->
OSType = os:type(),
[gen_oscmd(Socket, "uname -a"),
gen_oscmd(Socket, "ifconfig -a"),
gen_oscmd(Socket, top_cmd(OSType)),
gen_oscmd(Socket, netstat_cmd(OSType))].
gen_oscmd(Socket, Cmd) ->
F = fun(Sock) ->
sock_format(Sock, "~s:~n~s~n", [Cmd, os:cmd(Cmd)])
end,
Ret = collect(F, Socket, Cmd),
gen_sep(Socket),
Ret.
%% FIXME The 'top -b -n 1' invocation is actually for version 3.2.x
%% typically(?) found on Linux, while the 'top -b' is for (e.g.) version
%% 3.5.x typically(?) found on *BSD. For the latter, '-b' itself means
%% "run only once", '-n' is an alias for '-b', and '1' means show only
%% one process. Obviously there is a problem if 3.2.x or equivalent ends
%% up getting invoked w/o '-n 1', since it will loop forever...
top_cmd({unix, linux}) -> "top -b -n 1";
top_cmd({unix, sunos}) -> "top -b -d 2 -s 1 || /usr/ucb/ps -auxww";
top_cmd({unix, qnx}) -> "pidin times; pidin pmem";
top_cmd({unix, darwin}) -> "top -o cpu -l 1";
top_cmd(_) -> "top -b".
netstat_cmd({unix, linux}) -> "netstat -ant";
netstat_cmd({unix, freebsd}) -> "netstat -an -p tcp";
netstat_cmd({unix, sunos}) -> "netstat -an -P tcp";
netstat_cmd(_) -> "netstat -an".
gen_sep(Socket) ->
sock_format(Socket,"~n~s~n", [lists:duplicate(40, $*)]).
proc_status_fun() ->
fun(Fd) ->
sock_format(Fd, "Process status:~n", []),
i1(Fd, processes())
end.
i1(Fd, Ps) ->
Alive = lists:filter(fun palive/1, Ps),
i2(Fd, Alive),
case lists:filter(fun pzombie/1, Ps) of
[] ->
ok;
Zombies ->
%% Zombies is not the same as Ps-Alive, since the remote
%% process that fetched Ps is included among Alive, but has
%% exited (for ni/0).
sock_format(Fd, "\nDead processes:\n", []),
i2(Fd, Zombies)
end.
i2(Fd, Ps) ->
iformat(Fd, "Pid", "Initial Call", "Current Function", "Reds", "Msgs",
"Heap", "Stack"),
{Reds,Msgs,Heap,Stack,Susp1,Susp2,MemSusp,_} =
lists:foldl(fun display_info/2, {0,0,0,0,[],[],[],Fd}, Ps),
iformat(Fd, "Total", "", "", io_lib:write(Reds), io_lib:write(Msgs),
io_lib:write(Heap), io_lib:write(Stack)),
lists:foreach(fun(Susp) -> display_susp1(Fd, Susp) end, Susp1),
lists:foreach(fun(Susp) -> display_susp2(Fd, Susp) end, Susp2),
lists:foreach(fun(Susp) -> display_susp3(Fd, Susp) end, MemSusp).
palive(Pid) ->
case process_info(Pid, status) of
undefined -> false;
{status, exiting} -> false;
_ -> true
end.
pzombie(Pid) ->
case process_info(Pid, status) of
undefined -> false;
{status, exiting} -> true;
_ -> false
end.
-define(MEM_LARGE, 40000).
display_info(Pid, {R,M,H,St,S1,S2,S3,Fd}) ->
case process_info(Pid) of
undefined ->
{R, M};
Info ->
Call = initial_call(Info),
Curr = fetch(current_function, Info),
Reds = fetch(reductions, Info),
LM = fetch(message_queue_len, Info),
Heap = fetch(heap_size, Info),
Stack = fetch(stack_size, Info),
Mem = case process_info(Pid, memory) of
false -> 0;
{memory, Int} -> Int
end,
iformat(Fd,
io_lib:write(Pid),
mfa_string(Call),
mfa_string(Curr),
io_lib:write(Reds),
io_lib:write(LM),
io_lib:write(Heap),
io_lib:write(Stack)),
%% if it got msgs, it's suspicios
NS1 = if LM > 0 -> [{Pid, Reds, LM} | S1];
true -> S1
end,
%% if it's in gen:wait_resp* it's suspicios
NS2 = case Curr of
{gen, wait_resp, _} -> [{Pid, Reds} | S2];
{gen, wait_resp_mon, _} -> [{Pid, Reds} | S2];
_ -> S2
end,
%% If it is large .. it is suspicios
NS3 = if Mem > ?MEM_LARGE ->
[{Pid, Mem} | S3];
true ->
S3
end,
{R+Reds, M+LM, H+Heap,St+Stack, NS1, NS2, NS3, Fd}
end.
display_susp1(Fd, {Pid, Reds0, LM0}) ->
case process_info(Pid) of
undefined ->
ok;
Info ->
Reds1 = fetch(reductions, Info),
LM1 = fetch(message_queue_len, Info),
Msgs = fetch(messages, Info),
Bt = case process_info(Pid, backtrace) of
{backtrace, Bin} ->
binary_to_list(Bin);
_ ->
[]
end,
if LM1 > 0 ->
%% still suspicious
sock_format(Fd,
"*** Suspicious *** : ~-12w, Qlen = ~4w/~-4w, "
"Reds = ~12w/~-12w\n",
[Pid, LM0, LM1, Reds0, Reds1]),
lists:foreach(
fun(Msg) -> sock_format(Fd, " ~p\n",[Msg]) end,
Msgs),
gen_sep(Fd),
sock_format(Fd, "\n\n\n\n*** Backtrace *** for ~w\n~s\n",
[Pid,Bt]);
true ->
ok
end
end.
display_susp2(Fd, {Pid, Reds0}) ->
case process_info(Pid, reductions) of
undefined ->
ok;
{reductions, Reds0} ->
%% it hasn't done any work... print bt
case process_info(Pid, backtrace) of
{backtrace, Bin} ->
gen_sep(Fd),
sock_format(Fd, "\n\n\n\n*** Backtrace (gen_wait) "
"*** for ~w\n~s\n",
[Pid, binary_to_list(Bin)]);
_ ->
ok
end;
_ ->
ok
end.
display_susp3(Fd, {Pid, _Mem}) ->
case {process_info(Pid, memory), process_info(Pid, current_function)} of
{undefined, _} ->
ok;
{_, {current_function,{yaws_debug,display_susp3,2}}} ->
ok;
{memory, Mem2} when Mem2 > ?MEM_LARGE ->
%% it's still too big
case process_info(Pid, backtrace) of
{backtrace, Bin} ->
gen_sep(Fd),
sock_format(Fd,
"\n\n\n\n*** Backtrace (mem=~p) "
"*** for ~w\n~p~n~s\n",
[Mem2, Pid, process_info(Pid),
binary_to_list(Bin)]);
_ ->
ok
end;
_ ->
ok
end.
initial_call(Info) ->
case fetch(initial_call, Info) of
{proc_lib, init_p, 5} ->
proc_lib:translate_initial_call(Info);
ICall ->
ICall
end.
mfa_string({M, F, A}) ->
io_lib:format("~w:~w/~w", [M, F, A]);
mfa_string(X) ->
io_lib:write(X).
fetch(Key, Info) ->
case lists:keysearch(Key, 1, Info) of
{value, {_, Val}} -> Val;
false -> 0
end.
iformat(Fd, A1, A2, A3, A4, A5, A6, A7) ->
sock_format(Fd, "~-12s ~-23s ~-23s ~12s ~4s ~12s ~10s\n",
[A1,A2,A3,A4,A5,A6,A7]).
sock_format(Sock, Fmt, Args) ->
gen_tcp:send(Sock, io_lib:format(Fmt, Args)).
-define(COLLECT_TIMEOUT, 10000).
%% purpose of this collect function is to not hang, remember a probable
%% reason for running debug-dump is that the system is in a
%% corrupt state.
collect(F, Sock, User) ->
SELF = self(),
Pid = spawn(fun() ->
F(Sock),
SELF ! {self(), ok},
timer:sleep(infinity)
end),
Ref = erlang:monitor(process, Pid),
receive
{Pid, ok} ->
erlang:demonitor(Ref),
exit(Pid, shutdown),
ok;
Down = {'DOWN', Ref, _,_,_} ->
sock_format(Sock, "*** Failed to collect ~s: ~p~n", [User, Down]),
ok
after ?COLLECT_TIMEOUT ->
erlang:demonitor(Ref),
sock_format(Sock, "*** Failed to collect ~s: timeout~n", [User]),
{pid, Pid} % Let it hang for proc status, exit after
end.
send_status(Sock) ->
{InitStatus, _} = init:get_status(),
sock_format(Sock, ["vsn: ", yaws_generated:version(), "\n"], []),
sock_format(Sock, "status: ~p\n", [InitStatus]),
ok.
send_inet(Sock) ->
Chars = capture_io(fun() -> inet:i() end),
sock_format(Sock, "inet:i() output ~n~s~n", [Chars]),
ok.
%% This function runs a Fun that is producing IO through
%% io:format() and collects the IO and retuns the IO as a char list
%% Returns io_list() | {timeout, io_list()}
%%
capture_io(Fun) ->
do_capture_io(Fun).
capture_io(Fun, MilliSecTimeout) ->
{ok, Tref} = timer:send_after(MilliSecTimeout, capio_timeout),
Chars = do_capture_io(Fun),
timer:cancel(Tref),
Chars.
do_capture_io(Fun) ->
Pid = spawn(fun() ->
receive run -> ok end,
Fun()
end),
Mref = erlang:monitor(process,Pid),
group_leader(self(), Pid),
Pid ! run,
collect_io(Pid, Mref, []).
collect_io(Pid, Mref, Ack) ->
receive
{'DOWN', Mref, _,_,_} ->
Ack;
{io_request, From, Me, {put_chars, M, F, A}} ->
From ! {io_reply, Me, ok},
collect_io(Pid, Mref, [Ack, apply(M,F, A)]);
capio_timeout ->
{timeout, Ack}
end.
Jump to Line
Something went wrong with that request. Please try again.