Create redbug escript

Makefile

@@ -1,14 +1,17 @@
 REBAR = rebar3
 
-.PHONY: all compile test clean
+.PHONY: all compile escriptize test clean
 .PHONY: test eunit xref dialyze
 .PHONY: release release_minor release_major release_patch
 
-all: compile
+all: compile escriptize
 
 compile:
 	@$(REBAR) compile
 
+escriptize:
+	@$(REBAR) escriptize
+
 clean:
 	@find . -name "*~" -exec rm {} \;
 	@$(REBAR) clean

README.md

@@ -23,6 +23,10 @@ help
 
     redbug:help() -> ok
 
+run from command line (portable escript archive)
+
+    ./_build/default/bin/redbug [-Opt Value [...]] TargetNode Trc [Trc...]
+
 DESCRIPTION
 
 redbug is a tool to interact with the Erlang trace facility. It will instruct
@@ -188,3 +192,84 @@ EXAMPLES
     {timeout,[{call,{{ets,tab2list,[inet_db]},<<>>},
                     {<0.540.0>,{erlang,apply,2}},
                     {15,50,43,776041}}]}
+
+Examples using the escript
+
+First start a node that we're going to trace:
+
+    erl -sname foo
+
+We'll need to type some commands into the shell for some of the
+following traces to trigger.
+
+Start tracing, giving the node name as the first argument. (If the
+node name doesn't contain a host name, redbug will create a short
+node name by adding the host name.)
+
+    $ redbug foo erlang:demonitor
+
+    % 14:19:29 <5270.91.0>(dead)
+    % erlang:demonitor(#Ref<5270.0.4.122>, [flush])
+
+    % 14:19:29 <5270.40.0>({erlang,apply,2})
+    % erlang:demonitor(#Ref<5270.0.4.130>, [flush])
+
+    % 14:19:29 <5270.40.0>({erlang,apply,2})
+    % erlang:demonitor(#Ref<5270.0.4.131>, [flush])
+
+    % 14:19:29 <5270.40.0>({erlang,apply,2})
+    % erlang:demonitor(#Ref<5270.0.4.132>, [flush])
+    redbug done, timeout - 4
+
+    %% Limit message count
+    $ redbug foo erlang:demonitor -msgs 1
+
+    % 14:22:09 <5276.103.0>(dead)
+    % erlang:demonitor(#Ref<5276.0.4.144>, [flush])
+    redbug done, msg_count - 1
+
+    %% Print return value. The return value is a separate message.
+    $ redbug foo 'erlang:demonitor -> return' -msgs 2
+
+    % 14:23:47 <5276.115.0>(dead)
+    % erlang:demonitor(#Ref<5276.0.4.166>, [flush])
+
+    % 14:23:47 <5276.115.0>(dead)
+    % erlang:demonitor/2 -> true
+    redbug done, msg_count - 1
+
+    %% Also print call stack.
+    $ redbug foo 'erlang:demonitor -> return;stack' -msgs 2
+
+    % 14:24:43 <5276.121.0>(dead)
+    % erlang:demonitor(#Ref<5276.0.4.177>, [flush])
+      shell:'-get_command/5-fun-0-'/1
+
+    % 14:24:43 <5276.121.0>(dead)
+    % erlang:demonitor/2 -> true
+    redbug done, msg_count - 1
+
+    %% Trace on messages that the 'user_drv' process receives.
+    $ redbug foo receive -procs user_drv -msgs 1
+
+    % 14:27:10 <6071.31.0>(user_drv)
+    % <<< {#Port<6071.375>,{data,"a"}}
+    redbug done, msg_count - 1
+
+    %% As above, but also trace on sends. The two trace patterns
+    %% are given as separate arguments.
+    $ redbug foo receive send -procs user_drv -msgs 2
+
+    % 17:43:28 <6071.31.0>(user_drv)
+    % <<< {#Port<6071.375>,{data,"a"}}
+
+    % 17:43:28 <6071.31.0>(user_drv)
+    % <6071.33.0>({group,server,3}) <<< {<6071.31.0>,{data,"a"}}
+    redbug done, msg_count - 2
+
+    %% Call trace with a function head match.
+    $ redbug foo 'ets:tab2list(inet_db)' -msgs 2
+
+    % 17:45:48 <5276.40.0>({erlang,apply,2})
+    % ets:tab2list(inet_db)
+    redbug done, timeout - 1

rebar.config

@@ -4,3 +4,5 @@
 {xref_checks,         [undefined_function_calls]}.
 {cover_enabled,       true}.
 {cover_print_enabled, true}.
+
+{escript_emu_args,    "%%! -hidden\n"}.

src/redbug.erl

@@ -8,6 +8,8 @@
 %%%-------------------------------------------------------------------
 -module(redbug).
 
+-export([main/1]).
+
 -export([help/0]).
 -export([start/1,start/2,start/3,start/4,start/5]).
 -export([stop/0]).
@@ -16,6 +18,15 @@
                  [process_info(self(),current_function),
                   {line,?LINE}|T])).
 
+%% erlang:get_stacktrace/0 was made obsolete in OTP21
+-ifdef('OTP_RELEASE'). %% implies >= OTP21
+-define(try_with_stack(F),
+        try {ok,F} catch __C:__R:__S -> {__C,__R,__S} end).
+-else.
+-define(try_with_stack(F),
+        try {ok,F} catch __C:__R -> {__C,__R,erlang:get_stacktrace()} end).
+-endif.
+
 %% the redbug server data structure
 %% most can be set in the input proplist
 -record(cnf,{
@@ -54,14 +65,177 @@
          }).
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% 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.
+  Cnf0 = #cnf{target = undefined, print_fun = mk_outer(#cnf{})},
+  Cnf1 =
+    try handle_args(Args, Cnf0)
+    catch throw:Error ->
+        io:fwrite("Error: ~s~n~n", [Error]),
+        help(escript),
+        halt_and_flush(1)
+    end,
+  Cnf = maybe_new_target(Cnf1),
+  start_distribution(Cnf),
+  case ?try_with_stack(init(Cnf)) of
+    {ok, _} ->
+      halt_and_flush(0);
+    {C,R,S} ->
+      io:fwrite("~p~n",[{C,R,S}]),
+      halt_and_flush(1)
+  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 = #{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_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 = to_atom(Node)});
+handle_args([Trc | Rest], Config = #cnf{trc = Trcs}) ->
+  %% Any following non-option arguments are trace patterns.
+  NewTrc =
+    case Trc of
+      "send" -> send;
+      "receive" -> 'receive';
+      _ -> Trc
+    end,
+  NewTrcs = Trcs ++ [NewTrc],
+  handle_args(Rest, Config#cnf{trc = NewTrcs}).
+
+start_distribution(Cnf = #cnf{target = Target}) ->
+  %% Check if the target node has a "long" or "short" name,
+  %% since we need to match that.
+  TargetS = atom_to_list(Target),
+  NameType =
+    case lists:dropwhile(fun(C) -> C =/= $@ end, TargetS) of
+      "@" ++ HostPart ->
+        case lists:member($., HostPart) of
+          true ->
+            longnames;
+          false ->
+            shortnames
+        end;
+      _ ->
+        %% No host part?  maybe_new_target/1 is going to turn it
+        %% into a short name.
+        shortnames
+    end,
+  NodeName = random_node_name(),
+  %% We want to start as a hidden node, but we can't affect that from
+  %% here.  rebar.config contains an entry to pass the "-hidden"
+  %% argument to escript.
+  {ok, _} = net_kernel:start([list_to_atom(NodeName), NameType]),
+  assert_cookie(Cnf).
+
+-ifdef(USE_NOW).
+random_node_name() ->
+  {A, B, C} = now(),
+  lists:concat(["redbug-", A, "-", B, "-", C]).
+-else.
+%% now/0 was deprecated in Erlang/OTP 18.0, which is the same release
+%% that added the rand module, so let's use that.
+random_node_name() ->
+  "redbug-" ++ integer_to_list(rand:uniform(1000000000)).
+-endif.
+
+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.
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 help() ->
+  help(shell).
+
+help(Where) ->
   Text =
     ["redbug - the (sensibly) Restrictive Debugger"
-     ,""
-     ,"  redbug:start(Trc) -> start(Trc, [])."
-     ,"  redbug:start(Trc, Opts)."
-     ,""
+     ,""] ++
+    case Where of
+      shell ->
+        ["  redbug:start(Trc) -> start(Trc, [])."
+        ,"  redbug:start(Trc, Opts)."];
+      escript ->
+        ["  " ++ escript:script_name() ++ " [-Opt Value [...]] TargetNode Trc [Trc...]"
+        ,"  (you may need to quote trace patterns containing spaces etc)"]
+    end ++
+     [""
      ,"  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"
@@ -206,15 +380,6 @@ findex(Tag,[])       -> throw({no_such_option,Tag});
 findex(Tag,[Tag|_])  -> 1;
 findex(Tag,[_|Tags]) -> findex(Tag,Tags)+1.
 
-%% erlang:get_stacktrace/0 was made obsolete in OTP21
--ifdef('OTP_RELEASE'). %% implies >= OTP21
--define(try_with_stack(F),
-        try {ok,F} catch __C:__R:__S -> {__C,__R,__S} end).
--else.
--define(try_with_stack(F),
-        try {ok,F} catch __C:__R -> {__C,__R,erlang:get_stacktrace()} end).
--endif.
-
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%% the main redbug process
 %%% a state machine. init, starting, running, stopping, wait_for_trc.