Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

654 lines (557 sloc) 18.558 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,format/3,
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) ->
format(get(gc), F, A).
format(GC, F, A) ->
case ?gc_has_debug(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
undefined -> 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.