Capture writes to standard_error from evaluated code

chaser/src/chaser_render.erl

@@ -7,7 +7,7 @@
 %% green "=> " prefix; errors a red "!! " summary with the trace indented.
 -module(chaser_render).
 
--export([new/1, out/2, value/2, err/3, note/2, banner/2, doc/2, prompt/2]).
+-export([new/1, out/2, stderr/2, value/2, err/3, note/2, banner/2, doc/2, prompt/2]).
 
 -record(r, {color :: boolean(),
             bol = true :: boolean()}).  %% at beginning of line?
@@ -26,6 +26,11 @@ new(#{color := Color}) ->
 out(Chunk, R) ->
     {Chunk, track(Chunk, R)}.
 
+%% @doc Streamed error output (stderr), printed as the program wrote it,
+%% in red when colors are on.
+stderr(Chunk, R) ->
+    {style(?RED, Chunk, R), track(Chunk, R)}.
+
 %% @doc An eval result: `=> Value', with continuation lines indented to
 %% align under the value.
 value(Value, R) ->

chaser/src/chaser_shell.erl

@@ -188,10 +188,13 @@ render_msg(Msg, #sh{render = R0} = State) ->
              #{<<"value">> := Value} -> print(chaser_render:value(Value, R1));
              _ -> R1
          end,
+    %% err on its own is the code's stderr, streamed like out; with an ex
+    %% it's the account of a failed eval.
     R3 = case Msg of
+             #{<<"ex">> := Ex} ->
+                 print(chaser_render:err(Ex, maps:get(<<"err">>, Msg, <<>>), R2));
              #{<<"err">> := Err} ->
-                 Summary = maps:get(<<"ex">>, Msg, <<"error">>),
-                 print(chaser_render:err(Summary, Err, R2));
+                 print(chaser_render:stderr(Err, R2));
              _ ->
                  R2
          end,

chaser/test/chaser_render_tests.erl

@@ -37,6 +37,13 @@ error_summary_and_indented_detail_test() ->
                    "   exception error: bad\n"
                    "     in div/2\n">>, Rendered).
 
+stderr_streams_as_written_test() ->
+    R0 = plain(),
+    {A, R1} = chaser_render:stderr(<<"a">>, R0),
+    {B, R2} = chaser_render:stderr(<<"b">>, R1),
+    {Val, _} = chaser_render:value(<<"ok">>, R2),
+    ?assertEqual(<<"ab\n=> ok\n">>, unicode:characters_to_binary([A, B, Val])).
+
 error_without_detail_test() ->
     ?assertEqual(<<"!! interrupted\n">>,
                  render(fun(R) -> chaser_render:err(<<"interrupted">>, <<>>, R) end)).

dialtone/README.md

@@ -51,6 +51,13 @@ The `dialtone` application starts no listener on its own, so it's safe
 to include in a release. To start servers from configuration, set the
 `listen` app env to a list of option maps.
 
+`bin/dialtone` sends what evaluated code writes to `standard_error` to
+the client, as `err`. An embedded server doesn't do that by default,
+because `standard_error` is a single device for the whole node. Call
+`dialtone:capture_stderr()` (or set the `capture_stderr` app env to
+`true`) if you want it anyway. Writes from the rest of your application
+still go to the console.
+
 ## Supported operations
 
 `describe`, `clone`, `close`, `ls-sessions`, `eval`, `load-file`,
@@ -86,9 +93,8 @@ construction. See `dialtone_backend_erlang` and repartee's
 
 ## Known limitations
 
-- Writes to the global `standard_error` device and `logger` output go
-  to the server's console, not the client. Eval errors themselves are
-  reported to the client with full stack traces.
+- `logger` output goes to the server's console, not the client. Eval
+  errors themselves are reported to the client with full stack traces.
 - Values are rendered with `~tp` and truncated beyond 8 MB.
 
 ## Development

dialtone/src/dialtone.erl

@@ -1,7 +1,7 @@
 %% @doc Public API for the dialtone nREPL server.
 -module(dialtone).
 
--export([start_server/1, stop_server/1, port/1, version/0]).
+-export([start_server/1, stop_server/1, port/1, version/0, capture_stderr/0]).
 
 -type server_opts() :: #{port => inet:port_number(),
                          bind => inet:ip_address(),
@@ -27,6 +27,33 @@ stop_server(Pid) ->
 port(Pid) ->
     dialtone_listener:port(Pid).
 
+%% @doc Send what evaluated code writes to standard_error to the client, as
+%% "err", instead of the node's console. standard_error is a single device
+%% for the whole node, so this takes over its registered name (writes from
+%% everything else still reach the console). That's why it's off by
+%% default; the standalone servers turn it on, and so does setting the
+%% `capture_stderr' app env. Calling it again is harmless.
+-spec capture_stderr() -> ok | {error, term()}.
+capture_stderr() ->
+    try supervisor:start_child(dialtone_sup, dialtone_stderr:child_spec()) of
+        Result -> started(Result)
+    catch
+        exit:{noproc, _} -> {error, not_started}
+    end.
+
+started(Result) ->
+    case Result of
+        {ok, _} -> ok;
+        {error, {already_started, _}} -> ok;
+        {error, already_present} ->
+            case supervisor:restart_child(dialtone_sup, dialtone_stderr) of
+                {ok, _} -> ok;
+                {error, running} -> ok;
+                Error -> Error
+            end;
+        Error -> Error
+    end.
+
 -spec version() -> binary().
 version() ->
     {ok, Vsn} = application:get_key(dialtone, vsn),

dialtone/src/dialtone_cli.erl

@@ -8,6 +8,9 @@
 main() ->
     Opts = parse_args(init:get_plain_arguments(), #{port => 0}),
     {ok, _} = application:ensure_all_started(dialtone),
+    %% A standalone server owns the node, so it can safely take over
+    %% standard_error and send evaluated code's writes to the client.
+    ok = dialtone:capture_stderr(),
     case dialtone:start_server(Opts) of
         {ok, _Server} ->
             timer:sleep(infinity);

dialtone/src/dialtone_io_server.erl

@@ -8,6 +8,9 @@
 %% before the eval's value/done, structurally). Output arriving while no
 %% request is running (stragglers spawned by past evals) is dropped.
 %%
+%% Writes to standard_error from evaluated code arrive via dialtone_stderr
+%% (when stderr capture is on) and go out the same way, as "err".
+%%
 %% Input (get_until/get_line/get_chars) is served from a type-ahead buffer;
 %% when it runs dry the request is parked, the client is told "need-input",
 %% and a later stdin op resumes the parked read. An empty stdin payload
@@ -16,9 +19,11 @@
 
 -behaviour(gen_server).
 
--export([start_link/0, set_sink/3, reset/1, stdin/2]).
+-export([start_link/0, set_sink/3, reset/1, stdin/2, is_io_server/1]).
 -export([init/1, handle_call/3, handle_cast/2, handle_info/2]).
 
+-define(MARKER, '$dialtone_io_server').
+
 -record(io, {sink :: undefined | {pid(), map()},
              %% reads parked waiting for input: {From, ReplyAs, Spec}
              pending = queue:new() :: queue:queue(),
@@ -40,11 +45,24 @@ set_sink(Io, Conn, Req) ->
 reset(Io) ->
     gen_server:call(Io, reset, infinity).
 
+%% @doc Whether Pid is a session IO server on this node.
+-spec is_io_server(pid()) -> boolean().
+is_io_server(Pid) when node(Pid) =:= node() ->
+    case erlang:process_info(Pid, dictionary) of
+        {dictionary, Dict} -> proplists:get_value(?MARKER, Dict) =:= true;
+        undefined -> false
+    end;
+is_io_server(_Pid) ->
+    false.
+
 %% @doc Feed input from a stdin op. An empty payload signals EOF.
 stdin(Io, Data) ->
     gen_server:call(Io, {stdin, Data}, infinity).
 
 init([]) ->
+    %% Lets dialtone_stderr tell session IO servers from other group
+    %% leaders without asking the process anything.
+    put(?MARKER, true),
     {ok, #io{}}.
 
 handle_call({set_sink, Conn, Req}, _From, State) ->
@@ -64,19 +82,29 @@ handle_cast(_Msg, State) ->
 
 handle_info({io_request, From, ReplyAs, Request}, State) ->
     {noreply, io_request(From, ReplyAs, Request, State)};
+%% A write to standard_error relayed by dialtone_stderr. The reply goes back
+%% to the relay, which passes it on to the writer. With no request running
+%% there's no client to send it to, so it's handed back to go to the
+%% console as usual.
+handle_info({stderr_request, Relay, Tag, _Request}, #io{sink = undefined} = State) ->
+    Relay ! {stderr_unclaimed, Tag},
+    {noreply, State};
+handle_info({stderr_request, Relay, Tag, Request}, #io{sink = Sink} = State) ->
+    Relay ! {io_reply, Tag, stderr_write(Request, Sink)},
+    {noreply, State};
 handle_info(_Info, State) ->
     {noreply, State}.
 
 %%% Requests
 
 io_request(From, ReplyAs, {put_chars, Encoding, Chars}, State) ->
-    io_reply(From, ReplyAs, do_put_chars(Encoding, Chars, State)),
+    io_reply(From, ReplyAs, do_put_chars(Encoding, Chars, <<"out">>, State#io.sink)),
     State;
 io_request(From, ReplyAs, {put_chars, Encoding, M, F, A}, State) ->
     Chars = try apply(M, F, A) catch _:_ -> {error, format} end,
     case Chars of
         {error, _} = Error -> io_reply(From, ReplyAs, Error);
-        _ -> io_reply(From, ReplyAs, do_put_chars(Encoding, Chars, State))
+        _ -> io_reply(From, ReplyAs, do_put_chars(Encoding, Chars, <<"out">>, State#io.sink))
     end,
     State;
 %% Pre-R15 forms without encoding still occur in the wild.
@@ -123,13 +151,7 @@ io_request(From, ReplyAs, {requests, Requests}, State) ->
     %% The composite's reply is the last request's reply; put_chars replies
     %% are computed inline, so only output requests are legal here (which is
     %% how the io module uses it).
-    Reply = lists:foldl(
-              fun({put_chars, E, C}, _) -> do_put_chars(E, C, State);
-                 ({put_chars, E, M, F, A}, _) ->
-                      do_put_chars(E, try apply(M, F, A) catch _:_ -> <<>> end, State);
-                 (_, Acc) -> Acc
-              end, ok, Requests),
-    io_reply(From, ReplyAs, Reply),
+    io_reply(From, ReplyAs, put_requests(Requests, <<"out">>, State#io.sink)),
     State;
 io_request(From, ReplyAs, _Unknown, State) ->
     io_reply(From, ReplyAs, {error, request}),
@@ -141,23 +163,48 @@ io_reply(From, ReplyAs, Reply) ->
 
 %%% Output
 
-do_put_chars(Encoding, Chars, #io{sink = Sink}) ->
+put_requests(Requests, Stream, Sink) ->
+    lists:foldl(
+      fun({put_chars, E, C}, _) -> do_put_chars(E, C, Stream, Sink);
+         ({put_chars, E, M, F, A}, _) ->
+              do_put_chars(E, try apply(M, F, A) catch _:_ -> <<>> end, Stream, Sink);
+         (_, Acc) -> Acc
+      end, ok, Requests).
+
+%% The output requests dialtone_stderr relays; anything else stays with the
+%% real device.
+stderr_write({put_chars, Encoding, Chars}, Sink) ->
+    do_put_chars(Encoding, Chars, <<"err">>, Sink);
+stderr_write({put_chars, Encoding, M, F, A}, Sink) ->
+    case try apply(M, F, A) catch _:_ -> {error, format} end of
+        {error, _} = Error -> Error;
+        Chars -> do_put_chars(Encoding, Chars, <<"err">>, Sink)
+    end;
+stderr_write({put_chars, Chars}, Sink) ->
+    stderr_write({put_chars, latin1, Chars}, Sink);
+stderr_write({put_chars, M, F, A}, Sink) ->
+    stderr_write({put_chars, latin1, M, F, A}, Sink);
+stderr_write({requests, Requests}, Sink) ->
+    put_requests(Requests, <<"err">>, Sink).
+
+do_put_chars(Encoding, Chars, Stream, Sink) ->
     case unicode:characters_to_binary(Chars, Encoding, utf8) of
         Bin when is_binary(Bin) ->
-            emit_out(Bin, Sink);
+            emit(Stream, Bin, Sink);
         _ ->
             {error, {no_translation, Encoding, utf8}}
     end.
 
-emit_value(_Bin, undefined) ->
-    ok;
-emit_value(Bin, {Conn, Req}) ->
-    dialtone_msg:reply(Conn, Req, #{<<"value">> => Bin}).
+emit_value(Bin, Sink) ->
+    emit(<<"value">>, Bin, Sink).
+
+emit_out(Bin, Sink) ->
+    emit(<<"out">>, Bin, Sink).
 
-emit_out(_Bin, undefined) ->
+emit(_Stream, _Bin, undefined) ->
     ok;
-emit_out(Bin, {Conn, Req}) ->
-    dialtone_msg:reply(Conn, Req, #{<<"out">> => Bin}).
+emit(Stream, Bin, {Conn, Req}) ->
+    dialtone_msg:reply(Conn, Req, #{Stream => Bin}).
 
 %%% Input