1%%%----------------------------------------------------------------------
2%%% File    : yaws_debug.erl
3%%% Author  : Claes Wikstrom <klacke@hyber.org>
4%%% Purpose :
5%%% Created :  7 Feb 2002 by Claes Wikstrom <klacke@hyber.org>
6%%%----------------------------------------------------------------------
7
8-module(yaws_debug).
9-author('klacke@hyber.org').
10
11-include("../include/yaws.hrl").
12-include("../include/yaws_api.hrl").
13-include("yaws_debug.hrl").
14-export([typecheck/3,
15         format_record/3,
16         assert/4,
17         format/2,format/3,
18         derror/2,
19         dinfo/2,
20         mktags/0,
21         xref/1,
22         pids/0,
23         eprof/0,
24         check_headers/1, nobin/1,
25         do_debug_dump/1
26        ]).
27
28
29
30typecheck([{record, Rec, X} | Tail], File, Line) when is_atom(X),
31                                                      element(1, Rec) == X ->
32    typecheck(Tail, File, Line);
33typecheck([{int, Int} |Tail], File, Line) when is_integer(Int) ->
34    typecheck(Tail, File, Line);
35typecheck([Err|_], File, Line) ->
36    debug_format(user, "TC ERROR ~s:~w:~n~p",
37              [File, Line, Err]),
38    erlang:error(tcerr);
39typecheck([], _,_) ->
40    ok.
41
42
43%% returns {record, RecName, [Field1, Val1} .....]
44format_record(Record, Name, Fields) ->
45    case tuple_to_list(Record) of
46        [Name | Rest] ->
47            io_lib:format("record ~w\n~s", [Name,
48                                            format_record(Rest, Fields)]);
49        _X ->
50            ?Debug("Bad record ~p is not ~p~n", [_X, Name]),
51            "badrecord"
52    end.
53
54format_record([], []) ->
55    [];
56format_record([Val|Vals], [F|Fs]) when is_integer(Val);
57                                       Val == [];
58                                       is_atom(Val);
59                                       is_float(Val)->
60    [io_lib:format("     ~w = ~w\n", [F,Val]),
61     format_record(Vals, Fs)];
62format_record([Val|Vals], [F|Fs]) ->
63    case is_string(Val) of
64        true ->
65            [io_lib:format("     ~w = \"~s\"\n", [F,Val]),
66             format_record(Vals, Fs)];
67        false ->
68            [io_lib:format("     ~w = ~p~n", [F, nobin(Val)]),
69             format_record(Vals, Fs)]
70    end.
71
72is_string(L) when is_list(L) ->
73    lists:filter(fun(X) when is_integer(X),
74                             $A < X, X < $z ->
75                         false;
76                    (_) ->
77                         true
78                 end,L) == [];
79is_string(_) ->
80    false.
81
82
83
84assert(equal,X,Y,_) when X==Y ->
85    ok;
86assert(neq,X,Y,_) when X/=Y ->
87    ok;
88assert(integer,X,_,_) when is_integer(X) ->
89    ok;
90assert(list,X,_,_) when is_list(X) ->
91    ok;
92assert({list,length,equal},X,Y,_) when is_list(X), length(X)==Y ->
93    ok;
94assert(greater,X,Y,_) when is_integer(X), is_integer(Y), X>Y ->
95    ok;
96assert(min,X,Y,_) when is_integer(X), is_integer(Y), X>=Y ->
97    ok;
98assert(lesser,X,Y,_) when is_integer(X), is_integer(Y), X<Y ->
99    ok;
100assert(max,X,Y,_) when is_integer(X), is_integer(Y), X=<Y ->
101    ok;
102assert(interval,X,{Min,Max},_) when is_integer(X), is_integer(Min),
103                                    is_integer(Max),
104                                    X>=Min, Max>=X ->
105    ok;
106assert('fun', Fun, _, Failure) ->
107    case catch Fun() of
108        true -> ok;
109        _Other -> fail(Failure)
110    end;
111
112assert(in,X,L,Failure) when is_list(L) ->
113    case lists:member(X,L) of
114        true -> ok;
115        _ -> fail(Failure)
116    end;
117
118assert(_,_,_,Failure) ->
119    fail(Failure).
120
121fail({assert,File,Line,Message}) ->
122    debug_format(user, "Assertion FAILED ~p:~p, pid ~w exiting: ~p~n",
123              [File, Line, self(), Message]),
124    erlang:error(assertion_failed);
125fail({alert,File,Line,Message}) ->
126    debug_format(user, "Assert WARNING ~p:~p, pid ~w: ~p~n",
127              [File, Line, self(), Message]),
128    ok;
129fail({{debug,Fstr}, File,Line,Fmt, Args}) ->
130    Str = lists:flatten(
131            io_lib:format("~s <~p> ~s:~p, pid ~w: ~n",
132                          [Fstr, node(), filename:basename(File),
133                           Line, self()])),
134
135    case (catch debug_format(user, Str ++ Fmt ++ "~n", Args)) of
136        ok -> ok;
137        _ -> debug_format(user, "ERROR ~p:~p: Pid ~w: (bad format)~n~p,~p~n",
138                       [File, Line, self(), Fmt, Args]),
139
140             ok
141    end;
142
143fail({format, File,Line,Fmt,Args}) ->
144    case (catch debug_format(user, Fmt,Args)) of
145        ok -> ok;
146        _ ->
147            debug_format(user, "ERROR ~p:~p: Pid ~w: (bad format)~n~p,~p~n",
148                      [File, Line, self(), Fmt, Args]),
149
150            ok
151    end.
152
153debug_format(_, F, D) ->
154    debug_format(F, D).
155
156debug_format(F, A) ->
157    Str = case catch io_lib:format("yaws debug: " ++ F, A) of
158        {'EXIT', Reason} ->
159            io_lib:format("yaws debug: F=~s A=~p (failed to format: ~p)",
160                [F, A, Reason]);
161        Ok -> Ok
162    end,
163    error_logger:info_msg(Str),
164    catch io:format(F, A),
165    ok.
166
167format(F, A) ->
168    format(get(gc), F, A).
169format(GC, F, A) ->
170    case ?gc_has_debug(GC) of
171        true ->
172            error_logger:info_msg("yaws debug:" ++ F, A);
173        false ->
174            ok
175    end.
176
177derror(F, A) ->
178    case ?gc_has_debug((get(gc))) of
179        true ->
180            error_logger:error_msg("yaws:" ++ F, A);
181        false ->
182            ok
183    end.
184
185dinfo(F, A) ->
186    case ?gc_has_debug((get(gc))) of
187        true ->
188            error_logger:info_msg("yaws:" ++ F, A);
189        false ->
190            ok
191    end.
192
193
194mktags() ->
195    tags:dirs(["."]),
196    init:stop().
197
198
199
200xref([Dir]) ->
201    debug_format("~p~n", [xref:d(Dir)]),
202    init:stop().
203
204
205pids() ->
206    lists:zf(
207      fun(P) ->
208              case process_info(P) of
209                  L when is_list(L) ->
210                      {value, {_, {M1, _,_}}} =
211                          lists:keysearch(current_function, 1, L),
212                      {value, {_, {M2, _,_}}} =
213                          lists:keysearch(initial_call, 1, L),
214                      S1= atom_to_list(M1),
215                      S2 = atom_to_list(M2),
216                      case {S1, S2} of
217                          {"yaws" ++ _, _} ->
218                              {true, P};
219                          {_, "yaws"++_} ->
220                              {true, P};
221                          _ ->
222                              false
223                      end;
224                  _ ->
225                      false
226              end
227      end,
228      processes()).
229
230
231
232eprof() ->
233    eprof:start(),
234    eprof:profile(pids()),
235    debug_format("Ok run some traffic \n", []).
236
237
238
239-define(h_check(H, Field),
240        f_check(H#outh.Field, Field)).
241
242f_check(undefined, _Field) ->
243    ok;
244f_check(Str, Field) ->
245    case lists:reverse(lists:flatten(Str)) of
246        [$\n, $\r , H | _Tail] ->
247            case lists:member(H, [$\n, $\r]) of
248                true ->
249                    error_logger:format("Bad <~p> header:~n"
250                                        "  ~p~nToo many newlines",
251                                        [Field, Str]),
252                    exit(normal);
253                false ->
254                    ok
255            end;
256        _Other ->
257            error_logger:format("Bad <~p> header:~n"
258                                "~p~nNot ending with CRNL~n",
259                                [Field, Str]),
260            exit(normal)
261    end.
262
263check_headers(H) ->
264    ?h_check(H, connection),
265    ?h_check(H, server),
266    ?h_check(H, location),
267    ?h_check(H, cache_control),
268    ?h_check(H, date),
269    ?h_check(H, allow),
270    ?h_check(H, last_modified),
271    ?h_check(H, etag),
272    ?h_check(H, content_range),
273    ?h_check(H, content_length),
274    ?h_check(H, content_encoding),
275    ?h_check(H, set_cookie),
276    ?h_check(H, transfer_encoding),
277    ?h_check(H, www_authenticate),
278    check_other(H#outh.other).
279
280
281check_other(undefined) ->
282    ok;
283check_other(L0) ->
284    L = lists:flatten(L0),
285    case lists:dropwhile(fun(X) -> not lists:member(X, ["\r\n"]) end, L) of
286        [] ->
287            ok;
288        [$\r, $\n, H | _Tail] ->
289            case lists:member(H, [$\n, $\r]) of
290                true ->
291                    bad_other(L);
292                false ->
293                    ok
294            end;
295        _Other ->
296            bad_other(L)
297    end.
298
299
300bad_other(L) ->
301    Bad = lists:takewhile(
302            fun(X) -> not lists:member(X, ["\r\n"]) end, L),
303    error_logger:format("Bad header:~p~n"
304                        "Too many newlines",
305                        [Bad]),
306    exit(normal).
307
308
309
310
311nobin(X) ->
312    case catch xnobin(X) of
313        {'EXIT', Reason} ->
314            error_logger:format("~p~n~p~n", [X, Reason]),
315            erlang:error(Reason);
316        Res ->
317            Res
318    end.
319
320
321xnobin(B) when is_binary(B) ->
322    lists:flatten(io_lib:format("#Bin(~w)", [size(B)]));
323xnobin(L) when is_list(L) ->
324    lists:map(fun(X) -> xnobin(X) end, L);
325xnobin(T) when is_tuple(T) ->
326    list_to_tuple(xnobin(tuple_to_list(T)));
327xnobin(X) ->
328    X.
329
330
331
332%%%%%%%%%%%%%%% debug dump %%%%%%%%%%%%%%%%%%%%%%%
333
334
335do_debug_dump(Socket) ->
336    gen_version(Socket),
337    gen_sep(Socket),
338    %% keep proc status last, to report on hangs for the others
339    CollectOS = gen_os(Socket),
340    Collect = lists:foldl(fun({F, Str}, Acc) ->
341                                  Ret = collect(F, Socket, Str),
342                                  gen_sep(Socket),
343                                  [Ret|Acc]
344                          end,
345                          CollectOS,
346                          [{fun send_status/1, "Yaws status"},
347                           {fun send_inet/1,   "Inet status"},
348                           {proc_status_fun(), "process status"}]),
349    lists:foreach(fun(ok) ->
350                          ok;
351                     ({pid, Pid}) ->
352                          exit(Pid, shutdown)
353                  end, Collect),
354    ok.
355
356
357gen_version(Socket) ->
358    sock_format(Socket, "Yawsvsn: ~p~n", [yaws_generated:version()]).
359
360gen_os(Socket) ->
361    OSType = os:type(),
362    [gen_oscmd(Socket, "uname -a"),
363     gen_oscmd(Socket, "ifconfig -a"),
364     gen_oscmd(Socket, top_cmd(OSType)),
365     gen_oscmd(Socket, netstat_cmd(OSType))].
366
367gen_oscmd(Socket, Cmd) ->
368    F = fun(Sock) ->
369                sock_format(Sock, "~s:~n~s~n", [Cmd, os:cmd(Cmd)])
370        end,
371    Ret = collect(F, Socket, Cmd),
372    gen_sep(Socket),
373    Ret.
374
375%% FIXME The 'top -b -n 1' invocation is actually for version 3.2.x
376%% typically(?) found on Linux, while the 'top -b' is for (e.g.) version
377%% 3.5.x typically(?) found on *BSD. For the latter, '-b' itself means
378%% "run only once", '-n' is an alias for '-b', and '1' means show only
379%% one process. Obviously there is a problem if 3.2.x or equivalent ends
380%% up getting invoked w/o '-n 1', since it will loop forever...
381top_cmd({unix, linux}) -> "top -b -n 1";
382top_cmd({unix, sunos}) -> "top -b -d 2 -s 1 || /usr/ucb/ps -auxww";
383top_cmd({unix, qnx})   -> "pidin times; pidin pmem";
384top_cmd({unix, darwin}) -> "top -o cpu -l 1";
385top_cmd(_)             -> "top -b".
386
387netstat_cmd({unix, linux})   -> "netstat -ant";
388netstat_cmd({unix, freebsd}) -> "netstat -an -p tcp";
389netstat_cmd({unix, sunos})   -> "netstat -an -P tcp";
390netstat_cmd(_)               -> "netstat -an".
391
392gen_sep(Socket) ->
393    sock_format(Socket,"~n~s~n", [lists:duplicate(40, $*)]).
394
395
396proc_status_fun() ->
397    fun(Fd) ->
398            sock_format(Fd, "Process status:~n", []),
399            i1(Fd, processes())
400    end.
401
402i1(Fd, Ps) ->
403    Alive = lists:filter(fun palive/1, Ps),
404    i2(Fd, Alive),
405    case lists:filter(fun pzombie/1, Ps) of
406        [] ->
407            ok;
408        Zombies ->
409            %% Zombies is not the same as Ps-Alive, since the remote
410            %% process that fetched Ps is included among Alive, but has
411            %% exited (for ni/0).
412            sock_format(Fd, "\nDead processes:\n", []),
413            i2(Fd, Zombies)
414    end.
415
416i2(Fd, Ps) ->
417    iformat(Fd, "Pid", "Initial Call", "Current Function", "Reds", "Msgs",
418            "Heap", "Stack"),
419    {Reds,Msgs,Heap,Stack,Susp1,Susp2,MemSusp,_} =
420        lists:foldl(fun display_info/2, {0,0,0,0,[],[],[],Fd}, Ps),
421    iformat(Fd, "Total", "", "", io_lib:write(Reds), io_lib:write(Msgs),
422            io_lib:write(Heap), io_lib:write(Stack)),
423    lists:foreach(fun(Susp) -> display_susp1(Fd, Susp) end, Susp1),
424    lists:foreach(fun(Susp) -> display_susp2(Fd, Susp) end, Susp2),
425    lists:foreach(fun(Susp) -> display_susp3(Fd, Susp) end, MemSusp).
426
427
428palive(Pid) ->
429    case process_info(Pid, status) of
430        undefined         -> false;
431        {status, exiting} -> false;
432        _                 -> true
433    end.
434
435pzombie(Pid) ->
436    case process_info(Pid, status) of
437        undefined         -> false;
438        {status, exiting} -> true;
439        _                 -> false
440    end.
441
442
443-define(MEM_LARGE, 40000).
444
445display_info(Pid, {R,M,H,St,S1,S2,S3,Fd}) ->
446    case process_info(Pid) of
447        undefined ->
448            {R, M};
449        Info ->
450            Call = initial_call(Info),
451            Curr = fetch(current_function, Info),
452            Reds = fetch(reductions, Info),
453            LM = fetch(message_queue_len, Info),
454            Heap = fetch(heap_size, Info),
455            Stack = fetch(stack_size, Info),
456            Mem = case process_info(Pid, memory) of
457                      undefined -> 0;
458                      {memory, Int} -> Int
459                  end,
460            iformat(Fd,
461                    io_lib:write(Pid),
462                    mfa_string(Call),
463                    mfa_string(Curr),
464                    io_lib:write(Reds),
465                    io_lib:write(LM),
466                    io_lib:write(Heap),
467                    io_lib:write(Stack)),
468            %% if it got msgs, it's suspicios
469            NS1 = if LM > 0 -> [{Pid, Reds, LM} | S1];
470                     true -> S1
471                  end,
472            %% if it's in gen:wait_resp* it's suspicios
473            NS2 = case Curr of
474                      {gen, wait_resp, _} -> [{Pid, Reds} | S2];
475                      {gen, wait_resp_mon, _} -> [{Pid, Reds} | S2];
476                      _ -> S2
477                  end,
478            %% If it is large .. it is suspicios
479            NS3 = if Mem > ?MEM_LARGE ->
480                          [{Pid, Mem} | S3];
481                     true ->
482                          S3
483                  end,
484            {R+Reds, M+LM, H+Heap,St+Stack, NS1, NS2, NS3, Fd}
485    end.
486
487display_susp1(Fd, {Pid, Reds0, LM0}) ->
488    case process_info(Pid) of
489        undefined ->
490            ok;
491        Info ->
492            Reds1 = fetch(reductions, Info),
493            LM1 = fetch(message_queue_len, Info),
494            Msgs = fetch(messages, Info),
495            Bt = case process_info(Pid, backtrace) of
496                     {backtrace, Bin} ->
497                         binary_to_list(Bin);
498                     _ ->
499                         []
500                 end,
501            if LM1 > 0 ->
502                    %% still suspicious
503                    sock_format(Fd,
504                                "*** Suspicious *** : ~-12w, Qlen = ~4w/~-4w, "
505                                "Reds = ~12w/~-12w\n",
506                                [Pid, LM0, LM1, Reds0, Reds1]),
507                    lists:foreach(
508                      fun(Msg) -> sock_format(Fd, "  ~p\n",[Msg]) end,
509                      Msgs),
510                    gen_sep(Fd),
511                    sock_format(Fd, "\n\n\n\n*** Backtrace *** for ~w\n~s\n",
512                                [Pid,Bt]);
513               true ->
514                    ok
515            end
516    end.
517
518display_susp2(Fd, {Pid, Reds0}) ->
519    case process_info(Pid, reductions) of
520        undefined ->
521            ok;
522        {reductions, Reds0} ->
523            %% it hasn't done any work... print bt
524            case process_info(Pid, backtrace) of
525                {backtrace, Bin} ->
526                    gen_sep(Fd),
527                    sock_format(Fd, "\n\n\n\n*** Backtrace (gen_wait) "
528                                "*** for ~w\n~s\n",
529                                [Pid, binary_to_list(Bin)]);
530                _ ->
531                    ok
532            end;
533        _ ->
534            ok
535    end.
536
537display_susp3(Fd, {Pid, _Mem}) ->
538    case {process_info(Pid, memory), process_info(Pid, current_function)} of
539        {undefined, _} ->
540            ok;
541        {_, {current_function,{yaws_debug,display_susp3,2}}} ->
542            ok;
543        {{memory, Mem2}, _} when Mem2 > ?MEM_LARGE ->
544            %% it's still too big
545            case process_info(Pid, backtrace) of
546                {backtrace, Bin} ->
547                    gen_sep(Fd),
548                    sock_format(Fd,
549                                "\n\n\n\n*** Backtrace (mem=~p) "
550                                "*** for ~w\n~p~n~s\n",
551                                [Mem2, Pid, process_info(Pid),
552                                 binary_to_list(Bin)]);
553                _ ->
554                    ok
555            end;
556        _ ->
557            ok
558    end.
559
560
561
562initial_call(Info)  ->
563    case fetch(initial_call, Info) of
564        {proc_lib, init_p, 5} ->
565            proc_lib:translate_initial_call(Info);
566        ICall ->
567            ICall
568    end.
569
570mfa_string({M, F, A}) ->
571    io_lib:format("~w:~w/~w", [M, F, A]);
572mfa_string(X) ->
573    io_lib:write(X).
574
575fetch(Key, Info) ->
576    case lists:keysearch(Key, 1, Info) of
577        {value, {_, Val}} -> Val;
578        false -> 0
579    end.
580
581iformat(Fd, A1, A2, A3, A4, A5, A6, A7) ->
582    sock_format(Fd, "~-12s ~-23s ~-23s ~12s ~4s ~12s ~10s\n",
583                [A1,A2,A3,A4,A5,A6,A7]).
584
585sock_format(Sock, Fmt, Args) ->
586    gen_tcp:send(Sock, io_lib:format(Fmt, Args)).
587
588-define(COLLECT_TIMEOUT, 10000).
589
590
591%% purpose of this collect function is to not hang, remember a probable
592%% reason for running debug-dump is that the system is in a
593%% corrupt state.
594
595collect(F, Sock, User) ->
596    SELF = self(),
597    Pid = spawn(fun() ->
598                        F(Sock),
599                        SELF ! {self(), ok},
600                        timer:sleep(infinity)
601                end),
602    Ref = erlang:monitor(process, Pid),
603    receive
604        {Pid, ok} ->
605            erlang:demonitor(Ref),
606            exit(Pid, shutdown),
607            ok;
608        Down = {'DOWN', Ref, _,_,_} ->
609            sock_format(Sock, "*** Failed to collect ~s: ~p~n", [User, Down]),
610            ok
611    after ?COLLECT_TIMEOUT ->
612            erlang:demonitor(Ref),
613            sock_format(Sock, "*** Failed to collect ~s: timeout~n", [User]),
614            {pid, Pid}  % Let it hang for proc status, exit after
615    end.
616
617send_status(Sock) ->
618    {InitStatus, _} = init:get_status(),
619    sock_format(Sock, "vsn: ~s\n", [yaws_generated:version()]),
620    sock_format(Sock, "status: ~p\n", [InitStatus]),
621    ok.
622
623send_inet(Sock) ->
624    Chars = capture_io(fun() -> inet:i() end),
625    sock_format(Sock, "inet:i() output ~n~s~n", [Chars]),
626    ok.
627
628
629%% This function runs a Fun that is producing IO through
630%% io:format() and collects the IO and retuns the IO as a char list
631%% Returns io_list() | {timeout, io_list()}
632%%
633capture_io(Fun) ->
634    do_capture_io(Fun).
635
636%% capture_io(Fun, MilliSecTimeout) ->
637%%    {ok, Tref} = timer:send_after(MilliSecTimeout, capio_timeout),
638%%    Chars = do_capture_io(Fun),
639%%    timer:cancel(Tref),
640%%    Chars.
641
642do_capture_io(Fun) ->
643    Pid = spawn(fun() ->
644                        receive run -> ok end,
645                        Fun()
646                end),
647    Mref = erlang:monitor(process,Pid),
648    group_leader(self(), Pid),
649    Pid ! run,
650    collect_io(Pid, Mref, []).
651
652collect_io(Pid, Mref, Ack) ->
653    receive
654        {'DOWN', Mref, _,_,_} ->
655            Ack;
656        {io_request, From, Me, {put_chars, M, F, A}} ->
657            From ! {io_reply, Me, ok},
658            collect_io(Pid, Mref, [Ack, apply(M,F, A)]);
659        {io_request, From, Me, {put_chars, unicode, M, F, A}} ->
660            From ! {io_reply, Me, ok},
661            collect_io(Pid, Mref, [Ack, apply(M,F, A)]);
662        capio_timeout ->
663            {timeout, Ack}
664    end.
665
666
667
668
669
670
671