1% Licensed under the Apache License, Version 2.0 (the "License"); you may not
2% use this file except in compliance with the License. You may obtain a copy of
3% the License at
4%
5%   http://www.apache.org/licenses/LICENSE-2.0
6%
7% Unless required by applicable law or agreed to in writing, software
8% distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
9% WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
10% License for the specific language governing permissions and limitations under
11% the License.
12
13-module(couch_debug).
14
15-export([
16    help/0,
17    help/1
18]).
19
20-export([
21    opened_files/0,
22    opened_files_by_regexp/1,
23    opened_files_contains/1
24]).
25
26-export([
27    process_name/1,
28    link_tree/1,
29    link_tree/2,
30    mapfold_tree/3,
31    map_tree/2,
32    fold_tree/3,
33    linked_processes_info/2,
34    print_linked_processes/1
35]).
36
37help() ->
38    [
39        opened_files,
40        opened_files_by_regexp,
41        opened_files_contains,
42        process_name,
43        link_tree,
44        mapfold,
45        map,
46        fold,
47        linked_processes_info,
48        print_linked_processes
49    ].
50
51-spec help(Function :: atom()) -> ok.
52help(opened_files) ->
53    io:format("
54    opened_files()
55    --------------
56
57    Returns list of currently opened files
58    It iterates through `erlang:ports` and filters out all ports which are not efile.
59    It uses `process_info(Pid, dictionary)` to get info about couch_file properties.
60    ---
61    ", []);
62help(opened_files_by_regexp) ->
63    io:format("
64    opened_files_by_regexp(FileRegExp)
65    ----------------------------------
66
67    Returns list of currently opened files which name match the provided regular expression.
68    It iterates through `erlang:ports()` and filter out all ports which are not efile.
69    It uses `process_info(Pid, dictionary)` to get info about couch_file properties.
70    ---
71    ", []);
72help(opened_files_contains) ->
73    io:format("
74    opened_files_contains(SubString)
75    --------------------------------
76
77    Returns list of currently opened files whose names contain the provided SubString.
78    It iterates through `erlang:ports()` and filters out all ports which are not efile.
79    It uses `process_info(Pid, dictionary)` to get info about couch_file properties.
80    ---
81    ", []);
82help(process_name) ->
83    io:format("
84    process_name(Pid)
85    -----------------
86
87    Uses heuristics to figure out the process name.
88    The heuristic is based on the following information about the process:
89    - process_info(Pid, registered_name)
90    - '$initial_call' key in process dictionary
91    - process_info(Pid, initial_call)
92
93    ---
94    ", []);
95help(link_tree) ->
96    io:format("
97    link_tree(Pid)
98    --------------
99
100    Returns a tree which represents a cluster of linked processes.
101    This function receives the initial Pid to start from.
102    The function doesn't recurse to pids older than initial one.
103    The Pids which are lesser than initial Pid are still shown in the output.
104    This is analogue of `link_tree(RootPid, []).`
105
106    link_tree(Pid, Info)
107    --------------------
108
109    Returns a tree which represents a cluster of linked processes.
110    This function receives the initial Pid to start from.
111    The function doesn't recurse to pids older than initial one.
112    The Pids which are lesser than initial Pid are still shown in the output.
113    The info argument is a list of process_info_item() as documented in
114    erlang:process_info/2. We don't do any attempts to prevent dangerous items.
115    Be warn that passing some of them such as `messages` for example
116    can be dangerous in a very busy system.
117    ---
118    ", []);
119help(mapfold_tree) ->
120    io:format("
121    mapfold_tree(Tree, Acc, Fun)
122    -----------------------
123
124    Traverses all nodes of the tree. It is a combination of a map and fold.
125    It calls a user provided callback for every node of the tree.
126    `Fun(Key, Value, Pos, Acc) -> {NewValue, NewAcc}`.
127    Where:
128      - Key of the node (usualy Pid of a process)
129      - Value of the node (usualy information collected by link_tree)
130      - Pos - depth from the root of the tree
131      - Acc - user's accumulator
132
133    ---
134    ", []);
135help(map_tree) ->
136    io:format("
137    map_tree(Tree, Fun)
138    -----------------------
139
140    Traverses all nodes of the tree in order to modify them.
141    It calls a user provided callback
142    `Fun(Key, Value, Pos) -> NewValue`
143    Where:
144      - Key of the node (usualy Pid of a process)
145      - Value of the node (usualy information collected by link_tree)
146      - Pos - depth from the root of the tree
147
148    ---
149    ", []);
150help(fold_tree) ->
151    io:format("
152    fold_tree(Tree, Fun)
153    Traverses all nodes of the tree in order to collect some aggregated information
154    about the tree. It calls a user provided callback
155    `Fun(Key, Value, Pos) -> NewValue`
156    Where:
157      - Key of the node (usualy Pid of a process)
158      - Value of the node (usualy information collected by link_tree)
159      - Pos - depth from the root of the tree
160
161    ---
162    ", []);
163help(linked_processes_info) ->
164    io:format("
165        linked_processes_info(Pid, Info)
166        --------------------------------
167
168        Convenience function which reduces the amount of typing compared to direct
169        use of link_tree.
170          - Pid: initial Pid to start from
171          - Info: a list of process_info_item() as documented
172            in erlang:process_info/2.
173
174        ---
175    ", []);
176help(print_linked_processes) ->
177    io:format("
178        - print_linked_processes(Pid)
179        - print_linked_processes(RegisteredName)
180        - print_linked_processes(couch_index_server)
181
182        ---------------------------
183
184        Print cluster of linked processes. This function receives the
185        initial Pid to start from. The function doesn't recurse to pids
186        older than initial one. The output would look like similar to:
187        ```
188couch_debug:print_linked_processes(whereis(couch_index_server)).
189name                                         | reductions | message_queue_len |  memory
190couch_index_server[<0.288.0>]                |   478240   |         0         |  109696
191  couch_index:init/1[<0.3520.22>]            |    4899    |         0         |  109456
192    couch_file:init/1[<0.886.22>]            |   11973    |         0         |  67984
193      couch_index:init/1[<0.3520.22>]        |    4899    |         0         |  109456
194        ```
195
196        ---
197    ", []);
198help(Unknown) ->
199    io:format("Unknown function: `~p`. Please try one of the following:~n", [Unknown]),
200    [io:format("    - ~s~n", [Function]) || Function <- help()],
201    io:format("    ---~n", []),
202    ok.
203
204-spec opened_files() ->
205    [{port(), CouchFilePid :: pid(), Fd :: pid() | tuple(), FilePath :: string()}].
206
207opened_files() ->
208    Info = [couch_file_port_info(Port)
209        || Port <- erlang:ports(),
210            {name, "efile"} =:= erlang:port_info(Port, name)],
211    [I || I <- Info, is_tuple(I)].
212
213couch_file_port_info(Port) ->
214    {connected, Pid} = erlang:port_info(Port, connected),
215    case couch_file:process_info(Pid) of
216        {Fd, FilePath} ->
217            {Port, Pid, Fd, FilePath};
218        undefined ->
219            undefined
220    end.
221
222-spec opened_files_by_regexp(FileRegExp :: iodata()) ->
223    [{port(), CouchFilePid :: pid(), Fd :: pid() | tuple(), FilePath :: string()}].
224opened_files_by_regexp(FileRegExp) ->
225    {ok, RegExp} = re:compile(FileRegExp),
226    lists:filter(fun({_Port, _Pid, _Fd, Path}) ->
227        re:run(Path, RegExp) =/= nomatch
228    end, couch_debug:opened_files()).
229
230-spec opened_files_contains(FileNameFragment :: iodata()) ->
231    [{port(), CouchFilePid :: pid(), Fd :: pid() | tuple(), FilePath :: string()}].
232opened_files_contains(FileNameFragment) ->
233    lists:filter(fun({_Port, _Pid, _Fd, Path}) ->
234        string:str(Path, FileNameFragment) > 0
235    end, couch_debug:opened_files()).
236
237
238process_name(Pid) when is_pid(Pid) ->
239    Info = process_info(Pid, [registered_name, dictionary, initial_call]),
240    case Info of
241        undefined ->
242            iolist_to_list(io_lib:format("[~p]", [Pid]));
243        [{registered_name, Name} | _] when Name =/= [] ->
244            iolist_to_list(io_lib:format("~s[~p]", [Name, Pid]));
245        [_, {dictionary, Dict}, {initial_call, MFA}] ->
246            {M, F, A} = proplists:get_value('$initial_call', Dict, MFA),
247            iolist_to_list(io_lib:format("~p:~p/~p[~p]", [M, F, A, Pid]))
248    end;
249process_name(Else) ->
250    iolist_to_list(io_lib:format("~p", [Else])).
251
252iolist_to_list(List) ->
253    binary_to_list(iolist_to_binary(List)).
254
255link_tree(RootPid) ->
256    link_tree(RootPid, []).
257
258link_tree(RootPid, Info) ->
259    link_tree(RootPid, Info, fun(_, Props) -> Props end).
260
261link_tree(RootPid, Info, Fun) ->
262    {_, Result} = link_tree(
263        RootPid, [links | Info], gb_trees:empty(), 0, [RootPid], Fun),
264    Result.
265
266link_tree(RootPid, Info, Visited0, Pos, [Pid | Rest], Fun) ->
267    case gb_trees:lookup(Pid, Visited0) of
268        {value, Props} ->
269            {Visited0, [{Pos, {Pid, Fun(Pid, Props), []}}]};
270        none when RootPid =< Pid ->
271            Props = info(Pid, Info),
272            Visited1 = gb_trees:insert(Pid, Props, Visited0),
273            {links, Children} = lists:keyfind(links, 1, Props),
274            {Visited2, NewTree} = link_tree(
275                RootPid, Info, Visited1, Pos + 1, Children, Fun),
276            {Visited3, Result} = link_tree(
277                RootPid, Info, Visited2, Pos, Rest, Fun),
278            {Visited3, [{Pos, {Pid, Fun(Pid, Props), NewTree}}]  ++ Result};
279        none ->
280            Props = info(Pid, Info),
281            Visited1 = gb_trees:insert(Pid, Props, Visited0),
282            {Visited2, Result} = link_tree(
283                RootPid, Info, Visited1, Pos, Rest, Fun),
284            {Visited2, [{Pos, {Pid, Fun(Pid, Props), []}}] ++ Result}
285    end;
286link_tree(_RootPid, _Info, Visited, _Pos, [], _Fun) ->
287    {Visited, []}.
288
289
290info(Pid, Info) when is_pid(Pid) ->
291    ValidProps = [
292        backtrace,
293        binary,
294        catchlevel,
295        current_function,
296        current_location,
297        current_stacktrace,
298        dictionary,
299        error_handler,
300        garbage_collection,
301        garbage_collection_info,
302        group_leader,
303        heap_size,
304        initial_call,
305        links,
306        last_calls,
307        memory,
308        message_queue_len,
309        messages,
310        min_heap_size,
311        min_bin_vheap_size,
312        monitored_by,
313        monitors,
314        message_queue_data,
315        priority,
316        reductions,
317        registered_name,
318        sequential_trace_token,
319        stack_size,
320        status,
321        suspending,
322        total_heap_size,
323        trace,
324        trap_exit
325    ],
326    Validated = lists:filter(fun(P) -> lists:member(P, ValidProps) end, Info),
327    process_info(Pid, lists:usort(Validated));
328info(Port, Info) when is_port(Port) ->
329    ValidProps = [
330        registered_name,
331        id,
332        connected,
333        links,
334        name,
335        input,
336        output,
337        os_pid
338    ],
339    Validated = lists:filter(fun(P) -> lists:member(P, ValidProps) end, Info),
340    port_info(Port, lists:usort(Validated)).
341
342port_info(Port, Items) ->
343    lists:foldl(fun(Item, Acc) ->
344        case (catch erlang:port_info(Port, Item)) of
345            {Item, _Value} = Info -> [Info | Acc];
346            _Else -> Acc
347        end
348    end, [], Items).
349
350mapfold_tree([], Acc, _Fun) ->
351    {[], Acc};
352mapfold_tree([{Pos, {Key, Value0, SubTree0}} | Rest0], Acc0, Fun) ->
353    {Value1, Acc1} = Fun(Key, Value0, Pos, Acc0),
354    {SubTree1, Acc2} = mapfold_tree(SubTree0, Acc1, Fun),
355    {Rest1, Acc3} = mapfold_tree(Rest0, Acc2, Fun),
356    {[{Pos, {Key, Value1, SubTree1}} | Rest1], Acc3}.
357
358map_tree(Tree, Fun) ->
359    {Result, _} = mapfold_tree(Tree, nil, fun(Key, Value, Pos, Acc) ->
360        {Fun(Key, Value, Pos), Acc}
361    end),
362    Result.
363
364fold_tree(Tree, Acc, Fun) ->
365    {_, Result} = mapfold_tree(Tree, Acc, fun(Key, Value, Pos, AccIn) ->
366        {Value, Fun(Key, Value, Pos, AccIn)}
367    end),
368    Result.
369
370linked_processes_info(Pid, Info) ->
371    link_tree(Pid, Info, fun(P, Props) -> {process_name(P), Props} end).
372
373print_linked_processes(couch_index_server) ->
374    print_couch_index_server_processes();
375print_linked_processes(Name) when is_atom(Name) ->
376    case whereis(Name) of
377        undefined -> {error, {unknown, Name}};
378        Pid -> print_linked_processes(Pid)
379    end;
380print_linked_processes(Pid) when is_pid(Pid) ->
381    Info = [reductions, message_queue_len, memory],
382    TableSpec = [
383        {50, left, name}, {12, centre, reductions},
384        {19, centre, message_queue_len}, {10, centre, memory}
385    ],
386    Tree = linked_processes_info(Pid, Info),
387    print_tree(Tree, TableSpec).
388
389id("couch_file:init" ++ _, Pid, _Props) ->
390    case couch_file:process_info(Pid) of
391        {{file_descriptor, prim_file, {Port, Fd}}, FilePath} ->
392            term2str([
393                term2str(Fd), ":",
394                term2str(Port), ":",
395                shorten_path(FilePath)]);
396        undefined ->
397            ""
398    end;
399id(_IdStr, _Pid, _Props) ->
400    "".
401
402print_couch_index_server_processes() ->
403    Info = [reductions, message_queue_len, memory],
404    TableSpec = [
405        {50, left, name}, {12, centre, reductions},
406        {19, centre, message_queue_len}, {14, centre, memory}, {id}
407    ],
408
409    Tree = link_tree(whereis(couch_index_server), Info, fun(P, Props) ->
410        IdStr = process_name(P),
411        {IdStr, [{id, id(IdStr, P, Props)} | Props]}
412    end),
413    print_tree(Tree, TableSpec).
414
415shorten_path(Path) ->
416    ViewDir = list_to_binary(config:get("couchdb", "view_index_dir")),
417    DatabaseDir = list_to_binary(config:get("couchdb", "database_dir")),
418    File = list_to_binary(Path),
419    Len = max(
420        binary:longest_common_prefix([File, DatabaseDir]),
421        binary:longest_common_prefix([File, ViewDir])
422    ),
423    <<_:Len/binary, Rest/binary>> = File,
424    binary_to_list(Rest).
425
426%% Pretty print functions
427
428%% Limmitations:
429%%   - The first column has to be specified as {Width, left, Something}
430%% The TableSpec is a list of either:
431%%   - {Value}
432%%   - {Width, Align, Value}
433%% Align is one of the following:
434%%  - left
435%%  - centre
436%%  - right
437print_tree(Tree, TableSpec) ->
438    io:format("~s~n", [format(TableSpec)]),
439    map_tree(Tree, fun(_, {Id, Props}, Pos) ->
440        io:format("~s~n", [table_row(Id, Pos * 2, Props, TableSpec)])
441    end),
442    ok.
443
444format(Spec) ->
445    Fields = [format_value(Format) || Format <- Spec],
446    string:join(Fields, "|").
447
448format_value({Value}) -> term2str(Value);
449format_value({Width, Align, Value}) -> string:Align(term2str(Value), Width).
450
451bind_value({K}, Props) when is_list(Props) ->
452    {element(2, lists:keyfind(K, 1, Props))};
453bind_value({Width, Align, K}, Props) when is_list(Props) ->
454    {Width, Align, element(2, lists:keyfind(K, 1, Props))}.
455
456term2str(Atom) when is_atom(Atom) -> atom_to_list(Atom);
457term2str(Binary) when is_binary(Binary) -> binary_to_list(Binary);
458term2str(Integer) when is_integer(Integer) -> integer_to_list(Integer);
459term2str(Float) when is_float(Float) -> float_to_list(Float);
460term2str(String) when is_list(String) -> lists:flatten(String);
461term2str(Term) -> iolist_to_list(io_lib:format("~p", [Term])).
462
463table_row(Key, Indent, Props, [{KeyWidth, Align, _} | Spec]) ->
464    Values = [bind_value(Format, Props) || Format <- Spec],
465    KeyStr = string:Align(term2str(Key), KeyWidth - Indent),
466    [string:copies(" ", Indent), KeyStr, "|" | format(Values)].
467
468-ifdef(TEST).
469-include_lib("couch/include/couch_eunit.hrl").
470
471random_processes(Depth) ->
472    random_processes([], Depth).
473
474random_processes(Pids, 0) ->
475    lists:usort(Pids);
476random_processes(Acc, Depth) ->
477    Caller = self(),
478    Ref = make_ref(),
479    Pid = case oneof([spawn_link, open_port]) of
480        spawn_monitor ->
481            {P, _} = spawn_monitor(fun() ->
482                Caller ! {Ref, random_processes(Depth - 1)},
483                receive looper -> ok end
484            end),
485            P;
486        spawn ->
487            spawn(fun() ->
488                Caller ! {Ref, random_processes(Depth - 1)},
489                receive looper -> ok end
490            end);
491        spawn_link ->
492            spawn_link(fun() ->
493                Caller ! {Ref, random_processes(Depth - 1)},
494                receive looper -> ok end
495            end);
496        open_port ->
497            spawn_link(fun() ->
498                Port = erlang:open_port({spawn, "sleep 10"}, []),
499                true = erlang:link(Port),
500                Caller ! {Ref, random_processes(Depth - 1)},
501                receive looper -> ok end
502            end)
503    end,
504    receive
505        {Ref, Pids} -> random_processes([Pid | Pids] ++ Acc, Depth - 1)
506    end.
507
508oneof(Options) ->
509    lists:nth(couch_rand:uniform(length(Options)), Options).
510
511
512tree() ->
513    [InitialPid | _] = Processes = random_processes(5),
514    {InitialPid, Processes, link_tree(InitialPid)}.
515
516setup() ->
517    tree().
518
519teardown({_InitialPid, Processes, _Tree}) ->
520    [exit(Pid, normal) || Pid <- Processes].
521
522link_tree_test_() ->
523    {
524        "link_tree tests",
525        {
526            foreach,
527            fun setup/0, fun teardown/1,
528            [
529                fun should_have_same_shape/1,
530                fun should_include_extra_info/1
531            ]
532        }
533    }.
534
535should_have_same_shape({InitialPid, _Processes, Tree}) ->
536    ?_test(begin
537         InfoTree = linked_processes_info(InitialPid, []),
538         ?assert(is_equal(InfoTree, Tree)),
539         ok
540    end).
541
542should_include_extra_info({InitialPid, _Processes, _Tree}) ->
543    Info = [reductions, message_queue_len, memory],
544    ?_test(begin
545         InfoTree = linked_processes_info(InitialPid, Info),
546         map_tree(InfoTree, fun(Key, {_Id, Props}, _Pos) ->
547            case Key of
548                Pid when is_pid(Pid) ->
549                    ?assert(lists:keymember(reductions, 1, Props)),
550                    ?assert(lists:keymember(message_queue_len, 1, Props)),
551                    ?assert(lists:keymember(memory, 1, Props));
552                _Port ->
553                    ok
554            end,
555            Props
556         end),
557         ok
558    end).
559
560is_equal([], []) -> true;
561is_equal([{Pos, {Pid, _, A}} | RestA], [{Pos, {Pid, _, B}} | RestB]) ->
562    case is_equal(RestA, RestB) of
563        false -> false;
564        true -> is_equal(A, B)
565    end.
566
567-endif.
568