%%%------------------------------------------------------------------- %%% File : redbg.erl %%% Author : Mats Cronqvist %%% Description : %%% %%% Created : 24 Jan 2007 by Mats Cronqvist %%%------------------------------------------------------------------- -module(redbug). %% for the escript -export([main/1]). %% for the erlang shell -export([help/0]). -export([start/1, start/2]). -export([stop/0, stop/1]). -export([dtop/0, dtop/1]). -export([redbug_name/1]). -define(log(T), error_logger:info_report([{function, {?MODULE, ?FUNCTION_NAME}}, {line, ?LINE}|T])). %% erlang:get_stacktrace/0 was made obsolete in OTP21 -ifdef(OTP_RELEASE). %% this implies 21 or higher -define(EXCEPTION(Class, Reason, StackToken), Class:Reason:StackToken). -define(GET_STACK(StackToken), StackToken). -else. -define(EXCEPTION(Class, Reason, _), Class:Reason). -define(GET_STACK(_), erlang:get_stacktrace()). -endif. %% the redbug server data structure %% most can be set in the input proplist -record(cnf, { %% general time = 15000, % stop trace after this time [ms] msgs = 10, % stop trace after this # msgs [unit] target = node(), % target node cookie = '', % target node cookie blocking = false, % run blocking; return a list of msgs procs = all, % list of procs (or 'all') max_queue = 5000, % max # of msgs before suicide max_msg_size = 50000, % max message size before suicide debug = false, % big error messages trace_child = false, % children gets traced (set_on_spawn) arity = false, % arity instead of args discard = false, % discard messages (when counting) %% print-related buffered = false, % output buffering records = [], % list of module names to get records from print_calls = true, % print calls print_file = "", % file to print to (standard_io) print_msec = false, % same as print_time_unit => millisecond print_time_unit = second, % Time unit to use in the timestamps print_depth = 999999, % Limit for "~P" formatting depth print_re = "", % regexp that must match to print print_return = true, % print return value print_fun = '', % custom print handler %% trc file-related file = "", % file to write trace msgs to file_size = 1, % file size (per file [Mb]) file_count = 8, % number of files in wrap log %% internal trc = [], % cannot be set by user shell_pid = [], % cannot be set by user print_pid = [], % cannot be set by user trc_pid = [] % cannot be set by user }). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Called as an escript %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% main(Args) -> %% In the record definition, the default target node is node(), %% but that doesn't make sense for our escript, so make it %% 'undefined' and fail if it isn't filled in. pipe(#cnf{target = undefined, print_fun = mk_outer(#cnf{})}, [mk_handle_args(Args), fun maybe_new_target/1, fun start_distribution/1, fun run/1, fun(_) -> halt_and_flush(0) end]). run(Cnf) -> try init(Cnf) catch ?EXCEPTION(C, R, S) -> io:fwrite("~p~n", [{C, R, S}]), halt_and_flush(66) end. mk_handle_args(Args) -> fun(Cnf) -> safe_handle_args(Args, Cnf) end. safe_handle_args(Args, Cnf) -> try handle_args(Args, Cnf) catch _:_ -> help(), halt_and_flush(65) end. halt_and_flush(Status) -> %% As far as I can tell, this is the best (but still not perfect) %% way to try to ensure that all output has been written before we %% exit. See: %% http://erlang.org/pipermail/erlang-questions/2011-April/057479.html init:stop(Status), timer:sleep(infinity). handle_args([], #cnf{target = undefined}) -> throw("TargetNode not specified"); handle_args([], #cnf{trc = []}) -> throw("No trace patterns specified"); handle_args([], Config = #cnf{}) -> Config; handle_args(["-setcookie" | Rest], Config) -> %% "-setcookie" is a synonym for "-cookie" handle_args(["-cookie" | Rest], Config); handle_args(["-" ++ Option | Rest], Config) -> %% Everything else maps to fields in the cnf record Options = #{%% general time => integer, msgs => integer, target => atom, cookie => atom, procs => term, max_queue => integer, max_msg_size => integer, debug => boolean, trace_child => boolean, arity => boolean, discard => boolean, %% print-related buffered => boolean, print_calls => boolean, print_file => string, print_msec => boolean, print_time_unit => string, print_depth => integer, print_re => string, print_return => boolean, %% trc file-related file => string, file_size => integer, file_count => integer}, OptionAtom = list_to_atom(Option), case maps:get(OptionAtom, Options, undefined) of undefined -> throw("Invalid option -" ++ Option); Type -> try to_option_value(Type, hd(Rest)) of Parsed -> Index = findex(OptionAtom, record_info(fields, cnf)) + 1, NewCnf = setelement(Index, Config, Parsed), handle_args(tl(Rest), NewCnf) catch error:badarg -> throw("Invalid value for -" ++ Option ++ "; expected " ++ atom_to_list(Type)) end end; handle_args([Node | Rest], Config = #cnf{target = undefined}) -> %% The first non-option argument is the target node handle_args(Rest, Config#cnf{target = list_to_atom(Node)}); handle_args([Trc | Rest], Config = #cnf{trc = Trcs}) -> %% Any following non-option arguments are trace patterns. handle_args(Rest, Config#cnf{trc = Trcs++[trc(Trc)]}). start_distribution(Cnf) -> DistOptions = #{name => random_node_name(), name_domain => name_domain(Cnf), hidden => true}, {ok, _} = net_kernel:start(DistOptions), assert_cookie(Cnf). random_node_name() -> list_to_atom("redbug-" ++ integer_to_list(rand:uniform(1000000000))). %% Check if the target node has a "long" or "short" name, %% since we need to match that. name_domain(#cnf{target = Target}) -> case re:split(atom_to_list(Target), "[@.]") of [_] -> shortnames; [_, _] -> shortnames; [_, _, _|_] -> longnames end. trc("send") -> send; trc("receive") -> 'receive'; trc(Trc) -> Trc. to_option_value(integer, String) -> list_to_integer(String); to_option_value(atom, String) -> list_to_atom(String); to_option_value(term, String) -> to_term(String); to_option_value(boolean, String) -> case String of "true" -> true; "false" -> false; _ -> error(badarg) end; to_option_value(string, String) -> String. to_term(Str) -> {done, {ok, Toks, 1}, []} = erl_scan:tokens([], "["++Str++"]. ", 1), case erl_parse:parse_term(Toks) of {ok, [Term]} -> Term; {ok, L} when is_list(L) -> L end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% @doc Prints help. help() -> lists:foreach(fun(S) -> io:fwrite(standard_io, "~s~n", [S]) end, help_text()). help_text() -> ["redbug - the (sensibly) Restrictive Debugger" , "" , help_script() , "" , "redbug is a tool to interact with the Erlang trace facility." , "It will instruct the Erlang VM to generate so called " , "'trace messages' when certain events (such as a particular" , "function being called) occur." , "The trace messages are either printed (i.e. human readable)" , "to a file or to the screen; or written to a trc file." , "Using a trc file puts less stress on the system, but" , "there is no way to count the messages (so the msgs opt" , "is ignored), and the files can only be read by special tools" , "(such as 'bread'). Printing and trc files cannot be combined." , "By default (i.e. if the 'file' opt is not given), messages" , "are printed." , "" , "Trc: list('send'|'receive'|string(RTP))" , "RTP: restricted trace pattern" , " the RTP has the form: \" when -> \"" , " where can be;" , " \"mod\", \"mod:fun\", \"mod:fun/3\" or \"mod:fun('_', atom, X)\"" , " is something like;" , " \"X==1\" or \"is_atom(A)\"" , " and is;" , " \"return\" and/or \"stack\" (separated by \";\")" , "" , " E.g." , " ets:lookup(T, hostname) when is_integer(T) -> stack" , "" , "Opts: list({Opt, Val})" , "" , " general opts:" , "time (15000) stop trace after this many ms" , "msgs (10) stop trace after this many msgs" , "target (node()) node to trace on" , "cookie (host cookie) target node cookie" , "blocking (false) block start/2, return a list of messages" , "arity (false) print arity instead of arg list" , "trace_child (false) children gets traced (set_on_spawn)" , "records ([]) list of module names to get records from" , "buffered (false) buffer messages till end of trace" , "discard (false) discard messages (when counting)" , "max_queue (5000) fail if internal queue gets this long" , "max_msg_size (50000) fail if seeing a msg this big" , "procs (all) (list of) Erlang process(es)" , " all | pid() | atom(RegName) | {pid, I2, I3}" , " print-related opts" , "print_calls (true) print calls" , "print_file (standard_io) print to this file" , "print_msec (false) same as print_time_unit => millisecond" , "print_time_unit (second) print second, millisecond or microsecond on timestamps" , "print_depth (999999) formatting depth for \"~P\"" , "print_re (\"\") print only strings that match this RE" , "print_return (true) print the return value" , "print_fun () custom print handler, fun/1 or fun/2;" , " fun(TrcMsg) -> " , " fun(TrcMsg, AccOld) -> AccNew" , " trc file related opts" , "file (none) use a trc file based on this name" , "file_size (1) size of each trc file" , "file_count (8) number of trc files" , ""]. help_script() -> case catch escript:script_name() of {'EXIT', _} -> flat("~s~n~s", ["redbug:start(Trc) -> start(Trc, []).", "redbug:start(Trc, Opts)."]); Escript -> flat("~s ~s~n~s", [Escript, "[-Opt Value [...]] TargetNode Trc [Trc...]", "(you may need to quote trace patterns containing spaces etc)"]) end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% dtop facade %% @equiv dtop(#{}) dtop() -> dtop(#{}). dtop(Cfg) -> try redbug_dtop:start(), dtop_cfg(Cfg) catch exit:already_started -> case maps:size(Cfg) of 0 -> redbug_dtop:stop(); _ -> dtop_cfg(Cfg) end end. dtop_cfg(Cfg) -> [redbug_dtop:sort(S) || (S = maps:get(sort, Cfg, "")) =/= ""], [redbug_dtop:max_prcs(M) || (M = maps:get(max_procs, Cfg, "")) =/= ""]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% API from erlang shell %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% @doc %% Stops a trace. %% @end stop() -> stop(erlang:node()). stop(Target) -> case whereis(redbug_name(Target)) of undefined -> not_started; Pid -> Pid ! stop, stopped end. %% @equiv start(RTPs, []) start(RTPs) -> start(RTPs, []). -spec start(RTPs::list(), Opts::map()) -> {Procs::integer(), Functions::integer()}. start('send', Props) -> start([send], Props); start('receive', Props) -> start(['receive'], Props); start(Trc, Props) when is_map(Props) -> start(Trc, maps:to_list(Props)); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% the real start function! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% start(Trc, Props) when is_list(Props) -> RedbugName = redbug_name(Props), case whereis(RedbugName) of undefined -> try Cnf = assert_print_fun(make_cnf(Trc, [{shell_pid, self()}|Props])), assert_cookie(Cnf), register(RedbugName, spawn(fun() -> init(Cnf) end)), maybe_block(Cnf, block_a_little(RedbugName)) catch R -> R; C:R -> {oops, {C, R}} end; _ -> redbug_already_started end. assert_print_fun(Cnf) -> case is_function(Cnf#cnf.print_fun) of true -> Cnf; false -> Cnf#cnf{print_fun=mk_print_fun(Cnf)} end. mk_print_fun(Cnf) -> case Cnf#cnf.blocking of false -> mk_outer(Cnf); true -> mk_blocker() end. assert_cookie(#cnf{cookie=''}) -> ok; assert_cookie(Cnf) -> erlang:set_cookie(Cnf#cnf.target, Cnf#cnf.cookie). block_a_little(ProcessName) -> Ref = erlang:monitor(process, ProcessName), receive {running, NoP, NoF} -> erlang:demonitor(Ref), {ProcessName, NoP, NoF}; {'DOWN', Ref, _, _, R} -> R end. maybe_block(#cnf{blocking=true}, {ProcessName, I, _}) when is_integer(I) -> block(ProcessName); maybe_block(_, R) -> R. block(ProcessName) -> Ref = erlang:monitor(process, ProcessName), receive {'DOWN', Ref, _, _, R} -> R end. %% turn the proplist inta a #cnf{} make_cnf(Trc, Props) -> make_cnf(proplists:unfold(Props), #cnf{trc=Trc}, record_info(fields, cnf)). make_cnf([], Cnf, _) -> Cnf; make_cnf([{Tag, Val}|Props], Cnf, Tags) -> make_cnf(Props, setelement(findex(Tag, Tags)+1, Cnf, Val), Tags). findex(Tag, []) -> throw({no_such_option, Tag}); findex(Tag, [Tag|_]) -> 1; findex(Tag, [_|Tags]) -> findex(Tag, Tags)+1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% the main redbug process %%% a state machine. init, starting, running, stopping, wait_for_trc. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% init(Cnf) -> process_flag(trap_exit, true), try starting(do_start(Cnf)) catch throw:R -> exit({argument_error, R}); ?EXCEPTION(C, R, S) when Cnf#cnf.debug andalso not Cnf#cnf.blocking -> ?log([{C, R}, {stack, ?GET_STACK(S)}]); _:R -> exit(R) end. starting(Cnf = #cnf{trc_pid=TrcPid}) -> receive {{starting, TrcPid, P, F}} -> running(run(Cnf, P, F)); {'EXIT', TrcPid, R} -> throw(R) end. running(Cnf = #cnf{trc_pid=TrcPid, print_pid=PrintPid}) -> receive stop -> TrcPid ! stop, wait_for_trc(Cnf), PrintPid ! stop, done(Cnf, {stopped, wait_for_printer(Cnf)}); {'EXIT', TrcPid, R} -> PrintPid ! stop, done(Cnf, {R, wait_for_printer(Cnf)}); {'EXIT', PrintPid, R} -> TrcPid ! stop, wait_for_trc(Cnf), done(Cnf, {printer_crash, R}); X -> ?log([{unknown_message, X}]) end. wait_for_trc(#cnf{trc_pid=TrcPid}) -> receive {'EXIT', TrcPid, stop} -> ok; {'EXIT', TrcPid, R} -> ?log([{trace_control_died, R}]) end. wait_for_printer(#cnf{print_pid=PrintPid}) -> receive {'EXIT', PrintPid, R} -> R end. done(#cnf{blocking=false}, {Reason, Answer}) -> io:fwrite("~s", [done_string(Reason)]), io:fwrite("redbug done, ~p - ~p~n", [Reason, Answer]); done(#cnf{blocking=true}, Answer) -> exit(Answer). done_string(Reason) -> case is_tuple(Reason) andalso element(1, Reason) of msg_queue -> "you might want to set the max_queue option (see redbug:help/0)\n"; stack_size -> "you might want to set the max_msg_size option (see redbug:help/0)\n"; arg_length -> "you might want to set the max_msg_size option (see redbug:help/0)\n"; arg_size -> "you might want to set the max_msg_size option (see redbug:help/0)\n"; _ -> "" end. run(Cnf, P, F) -> [Cnf#cnf.shell_pid ! {running, P, F} || is_pid(Cnf#cnf.shell_pid)], Cnf. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% do_start(OCnf) -> Cnf = spawn_printer(wrap_print_fun(OCnf), maybe_new_target(OCnf)), Cnf#cnf{trc_pid=redbug_targ:start(Cnf#cnf.target, pack(Cnf))}. maybe_new_target(Cnf = #cnf{target=Target}) -> case lists:member($@, Str=atom_to_list(Target)) of true -> Cnf; false-> Cnf#cnf{target=list_to_atom(Str++"@"++element(2, inet:gethostname()))} end. wrap_print_fun(#cnf{print_fun=PF}) -> case erlang:fun_info(PF, arity) of {arity, 1} -> fun(M, N) -> PF(M), maybe_update_count(M, N) end; {arity, 2} -> PF end. maybe_update_count(M, N) -> case element(1, M) of call -> N+1; send -> N+1; recv -> N+1; _ -> N end. spawn_printer(PrintFun, Cnf) -> Cnf#cnf{print_pid=spawn_link(fun() -> print_init(PrintFun) end)}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% the default print fun for blocking mode (i.e. return a term). %% the printer proc will execute this (or a user-provided fun) for %% each message from the target. %% we throw away call_time, call_count, and meta messages. mk_blocker() -> fun({call_time, {_, false}, _, _}, A) -> A; ({call_time, {_, []}, _, _}, A) -> A; ({call_count, {_, false}, _, _}, A) -> A; ({call_count, {_, 0}, _, _}, A) -> A; ({meta, {recs, Recs}, _, _}, A) -> put_recs(Recs), A; ({meta, stop, _, _}, 0) -> []; ({meta, stop, _, _}, A) -> lists:reverse(A); (X, 0) -> [expand(X)]; (X, A) -> [expand(X)|A] end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% the default print fun in non-blocking mode (i.e. to the shell). %% the printer proc will execute this (or a user-provided fun) for %% each message from the target. mk_outer(#cnf{file=[_|_]}) -> fun(_) -> ok end; mk_outer(#cnf{print_msec=true, print_time_unit=second} = Cnf) -> mk_outer(Cnf#cnf{print_time_unit=millisecond}); mk_outer(#cnf{print_depth=Depth, print_time_unit=TU, print_return=Ret, print_calls=Calls} = Cnf) -> OutFun = mk_out(Cnf), fun({Tag, Data, PI, TS}) -> outer(Tag, Data, PI, TS, Depth, TU, Ret, Calls, OutFun) end. outer(Tag, Data, PI, TS, Depth, TU, Ret, Calls, OutFun) -> MTS = fix_ts(TU, TS), case {Tag, Data} of {'meta', {recs, Recs}} -> put_recs(Recs); {'meta', _} -> ok; {'call_time', {_, false}} -> ok; {'call_time', {{M, F, A}, PerProcCT}} -> {Count, Time} = lists:foldl(fun per_proc/2, {0, 0}, PerProcCT), [OutFun("% ~6s : ~6s : ~6s : ~w:~w/~w", [human(Count), human(Time), human(Time/Count), M, F, A]) || 0 < Count]; {'call_count', {_, false}} -> ok; {'call_count', {{M, F, A}, Count}} -> [OutFun("~n% ~6s : ~w:~w/~w", [human(Count), M, F, A]) || 0 < Count]; {'call', {{M, F, A}, Bin}} -> case Calls of true -> case is_integer(A) of true -> OutFun("~n% ~s ~s~n% ~w:~w/~w", [MTS, to_str(PI), M, F, A]); false-> Args = [flat("~tP", [expand(A0), Depth]) || A0 <- A], AL = string:join(Args, ", "), OutFun("~n% ~s ~s~n% ~w:~w(~s)", [MTS, to_str(PI), M, F, AL]) end, lists:foreach(fun(L) -> OutFun("% ~s", [L]) end, stak(Bin)); false-> ok end; {'retn', {{M, F, A}, Val0}} -> Val = case Ret of true -> expand(Val0); false -> '...' end, OutFun("~n% ~s ~s~n% ~p:~p/~p -> ~tP", [MTS, to_str(PI), M, F, A, Val, Depth]); {'send', {MSG, ToPI}} -> OutFun("~n% ~s ~s~n% ~s <<< ~tP", [MTS, to_str(PI), to_str(ToPI), expand(MSG), Depth]); {'recv', MSG} -> OutFun("~n% ~s ~s~n% <<< ~tP", [MTS, to_str(PI), expand(MSG), Depth]) end. per_proc({_, Count, Sec, Usec}, {AC, AT}) -> {Count+AC, Sec*1000000+Usec+AT}. to_str({Pid, Reg}) -> flat("~w(~p)", [Pid, Reg]); to_str(RegisteredName) -> flat("~p", [RegisteredName]). %% expand records, if any expand(T) when is_list(T) -> improper_map(fun expand/1, T); expand(T) when is_map(T) -> maps:map(fun(_K, V) -> expand(V) end, T); expand(T) when is_tuple(T) andalso 0 < size(T) -> case get({element(1, T), size(T)-1}) of undefined -> list_to_tuple(expand(tuple_to_list(T))); Fields -> maps:from_list(lists:zip(['_RECORD'|Fields], expand(tuple_to_list(T)))) end; expand(T) -> T. %% handle improper lists improper_map(_, []) -> []; improper_map(F, [E]) -> [F(E)]; improper_map(F, [A|B]) when not is_list(B) -> [F(A)|F(B)]; improper_map(F, [A|B]) -> [F(A)|improper_map(F, B)]. %% we assert that the file can be created here (in the redbug proc), %% but we don't actually open the file until we run the fun (in the %% printer proc). mk_out(#cnf{print_re=RE, print_file=File}) -> assert_dir(File), fun(F, A) -> Str=flat(F, A), case RE =:= "" orelse re:run(Str, RE) =/= nomatch of true -> io:fwrite(get_fd(File), "~s~n", [Str]); false -> ok end end. -include_lib("kernel/include/file.hrl"). -define(FILEINFO(T, A), #file_info{type = T, access = A}). assert_dir([]) -> ok; assert_dir(File) -> case filelib:ensure_dir(File) of ok -> case file:read_file_info(filename:dirname(File)) of {ok, ?FILEINFO(directory, read_write)} -> ok; {ok, ?FILEINFO(directory, write)} -> ok; {ok, ?FILEINFO(T, A)} -> throw({file_error, {File, {T, A}}}); {error, R} -> throw({file_error, {File, R}}) end; {error, R} -> throw({file_error, {File, R}}) end. fix_ts(TU, TS) -> case TU of microsecond -> ts_us(TS); millisecond -> ts_ms(TS); _-> ts_s(TS) end. ts_s({H, M, S, _Us}) -> flat("~2.2.0w:~2.2.0w:~2.2.0w", [H, M, S]). ts_ms({H, M, S, Us}) -> flat("~2.2.0w:~2.2.0w:~2.2.0w.~3.3.0w", [H, M, S, Us div 1000]). ts_us({H, M, S, Us}) -> flat("~2.2.0w:~2.2.0w:~2.2.0w.~6.6.0w", [H, M, S, Us]). %%% call stack handler stak(Bin) -> L = string:tokens(binary_to_list(Bin), "\n"), lists:reverse(lists:foldl(fun munge/2, [], L)). munge(I, Out) -> case lists:reverse(I) of "..."++_ -> [truncated|Out]; _ -> case string:str(I, "Return addr") of 0 -> case string:str(I, "cp = ") of 0 -> Out; _ -> [mfaf(I)|Out] end; _ -> case string:str(I, "erminate process normal") of 0 -> [mfaf(I)|Out]; _ -> Out end end end. mfaf(I) -> [_, C|_] = string:tokens(I, "()+"), C. put_recs(Recs) -> [put({Name, length(Fields)}, Fields) || {Name, Fields} <- Recs]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% pack data into a proplist for target consumption %%% Proplist = list({Tag, Val}) %%% Tag = time | flags | asts | procs | where %%% Where = {buffer, Pid, Count, MaxQueue, MaxSize} | %%% {stream, Pid, Count, MaxQueue, MaxSize} | %%% {discard, Pid, Count, MaxQueue, MaxSize} | %%% {file, File, Size, Count} | %%% {ip, Port, Queue} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pack(Cnf) -> Flags0 = [call, timestamp], {Flags, ASTs} = lists:foldl(fun chk_trc/2, {Flags0, []}, slist(Cnf#cnf.trc)), [{time, chk_time(Cnf#cnf.time)}, {flags, maybe_arity(Cnf, maybe_trace_child(Cnf, Flags))}, {asts, ASTs}, {procs, [chk_proc(P) || P <- mk_list(Cnf#cnf.procs)]}, {records, chk_records(Cnf#cnf.records)}, {where, where(Cnf)}]. mk_list([]) -> throw(no_procs); mk_list([_|_] = L) -> L; mk_list(E) -> [E]. where(Cnf) -> case Cnf#cnf.file of "" -> conf_term(Cnf); _ -> conf_file(Cnf) end. conf_file(Cnf) -> {file, Cnf#cnf.file, Cnf#cnf.file_size, Cnf#cnf.file_count}. conf_term(Cnf) -> {chk_buffered(Cnf#cnf.buffered, Cnf#cnf.discard), Cnf#cnf.print_pid, chk_msgs(Cnf#cnf.msgs), Cnf#cnf.max_queue, Cnf#cnf.max_msg_size}. maybe_arity(#cnf{arity=true}, Flags) -> [arity|Flags]; maybe_arity(_, Flags) -> Flags. maybe_trace_child(#cnf{trace_child=true}, Flags) -> [set_on_spawn|Flags]; maybe_trace_child(_, Flags) -> Flags. chk_time(Time) when is_integer(Time) -> Time; chk_time(X) -> throw({bad_time, X}). chk_buffered(_, true) -> discard; chk_buffered(true, _) -> buffer; chk_buffered(false, _) -> stream. chk_proc(Pid) when is_pid(Pid) -> Pid; chk_proc(Atom) when is_atom(Atom) -> Atom; chk_proc({pid, I1, I2}) when is_integer(I1), is_integer(I2) -> {pid, I1, I2}; chk_proc(X) -> throw({bad_proc, X}). chk_records([]) -> []; chk_records(Mod) when is_atom(Mod) -> [Mod]; chk_records([Mod|Mods]) when is_atom(Mod) -> [Mod|chk_records(Mods)]; chk_records(What) -> throw({bad_module_name, What}). chk_msgs(Msgs) when is_integer(Msgs) -> Msgs; chk_msgs(X) -> throw({bad_msgs, X}). chk_trc('send', {Flags, Trc}) -> {['send'|Flags], Trc}; chk_trc('receive', {Flags, Trc}) -> {['receive'|Flags], Trc}; chk_trc(Trc, {Flags, ASTs}) -> {Flags, [mk_ast(Trc)|ASTs]}. mk_ast(Str) -> redbug_compiler:parse(Str). -define(is_string(Str), (Str=="" orelse (9= [S]; slist(L) when is_list(L) -> lists:usort(L); slist(X) -> [X]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% the print_loop process %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% print_init(PrintFun) -> print_loop(PrintFun, 0, running). print_loop(PrintFun, Acc, State) -> maybe_exit(State, PrintFun, Acc), receive Ms = [_|_] -> print_loop(PrintFun, lists:foldl(PrintFun, Acc, Ms), State); stop -> print_loop(PrintFun, Acc, stopping) end. maybe_exit(State, PrintFun, Acc) -> case State == stopping andalso process_info(self(), message_queue_len) of {_, 0} -> exit(PrintFun({meta, stop, dummy, {0, 0, 0, 0}}, Acc)); _ -> ok end. %% this is called from the default PrintFun get_fd("") -> standard_io; get_fd(FN) -> case get(redbug_fd) of undefined -> case file:open(FN, [write]) of {ok, FD} -> put(redbug_fd, FD), FD; _ -> throw({cannot_open, FN}) end; FD -> FD end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%make ints human readable human(X) when not is_number(X) -> X; human(I) when I < 0 -> "-"++human(-I); human(I) when 0 < I -> case math:log10(I) of M when 15= human(M-15, "P"); M when 12= human(M-12, "T"); M when 9= human(M-9, "G"); M when 6= human(M-6, "M"); M when 3= human(M-3, "k"); _ -> flat("~w", [I]) end; human(_) -> "0". human(E, M) -> flat("~.1f~s", [math:pow(10, E), M]). flat(Format, Args) -> lists:flatten(io_lib:fwrite(Format, Args)). redbug_name(Opts) when is_list(Opts) -> Node = proplists:get_value(target, Opts, erlang:node()), redbug_name(Node); redbug_name(Node) when is_atom(Node) -> list_to_atom("redbug_" ++ atom_to_list(Node)). pipe(Term, Funcs) -> lists:foldl(fun(F, T) -> F(T) end, Term, Funcs).