kernel: Add logging support to group and standard_error

Logging of stdio/stderr is useful when you want to capture anything
written to stdout into a log file, but cannot change the source of
the io:format in the original source code to a logger call.

lib/kernel/src/group.erl

@@ -32,6 +32,9 @@
 
 -export([server_loop/3]).
 
+%% Logger report format fun
+-export([format_io_request_log/1]).
+
 start(Drv, Shell) ->
     start(Drv, Shell, []).
 
@@ -57,6 +60,8 @@ server(Ancestors, Drv, Shell, Options) ->
     put(dumb, Dumb),
     put(expand_below, proplists:get_value(expand_below, Options, true)),
 
+    put(log, false),
+
     server_loop(Drv, start_shell(Shell), []).
 
 whereis_shell() ->
@@ -158,8 +163,8 @@ server_loop(Drv, Shell, Buf0) ->
 
 exit_shell(Reason) ->
     case get(shell) of
-	undefined -> true;
-	Pid -> exit(Pid, Reason)
+	undefined -> ok;
+	Pid -> exit(Pid, Reason), ok
     end.
 
 get_tty_geometry(Drv) ->
@@ -201,6 +206,10 @@ get_terminal_state(Drv) ->
     end.
 
 io_request(Req, From, ReplyAs, Drv, Shell, Buf0) ->
+    [?LOG_INFO(#{ request => {io_request, From, ReplyAs, Req}, server => self(),
+                  server_name => server_name() },
+               #{ report_cb => fun format_io_request_log/1,
+                  domain => [otp, kernel, io, output]}) || get(log)],
     case io_request(Req, Drv, Shell, {From,ReplyAs}, Buf0) of
 	{ok,Reply,Buf} ->
 	    io_reply(From, ReplyAs, Reply),
@@ -402,6 +411,8 @@ check_valid_opts([{encoding,Valid}|T]) when Valid =:= unicode;
     check_valid_opts(T);
 check_valid_opts([{echo,Flag}|T]) when is_boolean(Flag) ->
     check_valid_opts(T);
+check_valid_opts([{log,Flag}|T]) when is_boolean(Flag) ->
+    check_valid_opts(T);
 check_valid_opts([{expand_fun,Fun}|T]) when is_function(Fun, 1);
                                             is_function(Fun, 2) ->
     check_valid_opts(T);
@@ -411,6 +422,7 @@ check_valid_opts(_) ->
 do_setopts(Opts, Drv, Buf) ->
     put(expand_fun, normalize_expand_fun(Opts, get(expand_fun))),
     put(echo, proplists:get_value(echo, Opts, get(echo))),
+    put(log, proplists:get_value(log, Opts, get(log))),
     case proplists:get_value(encoding, Opts) of
 	Valid when Valid =:= unicode; Valid =:= utf8 ->
            set_unicode_state(Drv,true);
@@ -419,6 +431,7 @@ do_setopts(Opts, Drv, Buf) ->
 	undefined ->
 	    ok
     end,
+
     case proplists:get_value(binary, Opts, case get(read_mode) of
 					      binary -> true;
 					      _ -> false
@@ -450,6 +463,12 @@ getopts(Drv,Buf) ->
 		     _ ->
 			 false
 		  end},
+    Log = {log, case get(log) of
+		     LogBool when LogBool =:= true; LogBool =:= false ->
+                        LogBool;
+		     _ ->
+			 false
+		  end},
     Bin = {binary, case get(read_mode) of
 		       binary ->
 			   true;
@@ -461,7 +480,7 @@ getopts(Drv,Buf) ->
 			_ -> latin1
 		     end},
     Tty = {terminal, get_terminal_state(Drv)},
-    {ok,[Exp,Echo,Bin,Uni,Tty],Buf}.
+    {ok,[Exp,Echo,Bin,Uni,Tty,Log],Buf}.
 
 %% get_chars_*(Prompt, Module, Function, XtraArgument, Drv, Buffer)
 %%  Gets characters from the input Drv until as the applied function
@@ -1125,3 +1144,50 @@ is_latin1([]) ->
     true;
 is_latin1(_) ->
     false.
+
+server_name() ->
+    case erlang:process_info(self(), registered_name) of
+        [] ->
+            undefined;
+        {registered_name, Name} ->
+            Name
+    end.
+
+format_io_request_log(#{ request := {io_request, From, ReplyAs, Request},
+                         server := Server,
+                         server_name := Name }) ->
+    {"Request: ~p\n"
+     "  From: ~p\n"
+     "  ReplyAs: ~p\n"
+     "Server: ~p\n"
+     "Name: ~p\n"
+     ,[normalize_request(Request), From, ReplyAs, Server, Name]}.
+
+normalize_request({put_chars, Chars}) ->
+    normalize_request({put_chars, latin1, Chars});
+normalize_request({put_chars, Mod, Func, Args}) ->
+    normalize_request({put_chars, latin1, Mod, Func, Args});
+normalize_request({put_chars, Enc, Mod, Func, Args} = Req) ->
+    case catch apply(Mod, Func, Args) of
+        Data when is_list(Data); is_binary(Data) ->
+            {put_chars, Enc, unicode:characters_to_list(Data, Enc)};
+        _ -> Req
+    end;
+normalize_request({requests, Reqs}) ->
+    case lists:foldr(
+           fun(Req, []) ->
+                   [normalize_request(Req)];
+              (Req, [{put_chars, Enc, Data} | Acc] = NormReqs) ->
+                   case normalize_request(Req) of
+                       {put_chars, Enc, NewData} ->
+                           [{put_chars, Enc, unicode:characters_to_list([NewData, Data], Enc)} | Acc];
+                       NormReq ->
+                           [NormReq | NormReqs]
+                   end;
+              (Req, Acc) ->
+                   [normalize_request(Req) | Acc]
+           end, [], Reqs) of
+        [Req] -> Req;
+        NormReqs -> {requests, NormReqs}
+    end;
+normalize_request(Req) -> Req.

lib/kernel/src/standard_error.erl

@@ -20,6 +20,8 @@
 -module(standard_error).
 -behaviour(supervisor_bridge).
 
+-include_lib("kernel/include/logger.hrl").
+
 %% Basic standard i/o server for user interface port.
 -export([start_link/0, init/1, terminate/2]).
 
@@ -67,19 +69,35 @@ server(PortName,PortSettings) ->
 run(P) ->
     put(encoding, latin1),
     put(onlcr, false),
+    put(log, false),
     server_loop(P).
 
 server_loop(Port) ->
     receive
-	{io_request,From,ReplyAs,Request} when is_pid(From) ->
-	    _ = do_io_request(Request, From, ReplyAs, Port),
-	    server_loop(Port);
-	{'EXIT',Port,badsig} ->			% Ignore badsig errors
-	    server_loop(Port);
-	{'EXIT',Port,What} ->			% Port has exited
-	    exit(What);
-	_Other ->				% Ignore other messages
-	    server_loop(Port)
+        {io_request,From,ReplyAs,Request} = IoReq when is_pid(From) ->
+            _ = [?LOG_INFO(#{ request => IoReq, server => self(), server_name => ?MODULE},
+                           #{ report_cb => fun group:format_io_request_log/1,
+                              domain => [otp, kernel, io, type(Request)]}) || get(log)],
+            _ = do_io_request(Request, From, ReplyAs, Port),
+            server_loop(Port);
+        {'EXIT',Port,badsig} ->         % Ignore badsig errors
+            server_loop(Port);
+        {'EXIT',Port,What} ->           % Port has exited
+            exit(What);
+        _Other ->               % Ignore other messages
+            server_loop(Port)
+    end.
+
+type(Req) ->
+    ReqType = element(1, Req),
+    case {lists:member(ReqType, [put_chars, requests]),
+            lists:member(ReqType, [get_chars, get_line, get_until, get_password])} of
+        {true, false} ->
+            output;
+        {false, true} ->
+            input;
+        {false, false} ->
+            ctrl
     end.
 
 get_fd_geometry(Port) ->
@@ -212,7 +230,9 @@ do_setopts(Opts0) ->
               fun({encoding, Enc}) ->
                       put(encoding, Enc);
                  ({onlcr, Bool}) ->
-                      put(onlcr, Bool)
+                      put(onlcr, Bool);
+                 ({log, Bool}) ->
+                      put(log, Bool)
               end, Opts),
             {ok, ok};
         false ->
@@ -226,6 +246,8 @@ check_valid_opts([{encoding,Valid}|T]) when Valid =:= unicode; Valid =:= utf8;
     check_valid_opts(T);
 check_valid_opts([{onlcr,Bool}|T]) when is_boolean(Bool) ->
     check_valid_opts(T);
+check_valid_opts([{log,Bool}|T]) when is_boolean(Bool) ->
+    check_valid_opts(T);
 check_valid_opts(_) ->
     false.
 
@@ -245,7 +267,8 @@ expand_encoding([H|T]) ->
 getopts() ->
     Uni = {encoding,get(encoding)},
     Onlcr = {onlcr, get(onlcr)},
-    {ok,[Uni, Onlcr]}.
+    Log = {log, get(log)},
+    {ok,[Uni, Onlcr, Log]}.
 
 wrap_characters_to_binary(Chars,From,To) ->
     TrNl = get(onlcr),

lib/kernel/test/standard_error_SUITE.erl

@@ -20,14 +20,16 @@
 
 -module(standard_error_SUITE).
 
+-include_lib("stdlib/include/assert.hrl").
+
 -export([all/0,suite/0]).
--export([badarg/1,getopts/1,output/1]).
+-export([badarg/1,getopts/1,output/1,logging/1]).
 
 suite() ->
     [{ct_hooks,[ts_install_cth]}].
 
-all() -> 
-    [badarg,getopts,output].
+all() ->
+    [badarg,getopts,output,logging].
 
 badarg(Config) when is_list(Config) ->
     {'EXIT',{badarg,_}} = (catch io:put_chars(standard_error, [oops])),
@@ -66,3 +68,51 @@ output(Config) when is_list(Config) ->
         500 ->
             ok
     end.
+
+logging(Config) when is_list(Config) ->
+
+    #{ level := Level } = logger:get_primary_config(),
+
+    try
+        Parent = self(),
+
+        Device = spawn(fun F() ->
+                               receive
+                                   {io_request, From, ReplyAs, M} ->
+                                       From ! {io_reply, ReplyAs, ok},
+                                       Parent ! M,
+                                       F()
+                               end
+                       end),
+
+        logger:add_handler(stderr, logger_std_h, #{ filter_default => stop,
+                                                    config => #{ type => {device, Device} } } ),
+
+        io:setopts(standard_error, [{log, true}]),
+
+        logger:set_primary_config(level, all),
+
+        io:put_chars(standard_error, "hello"),
+
+        receive
+            M1 -> ct:fail({unexpected, M1})
+        after 5000 -> ok
+        end,
+
+        logger:add_handler_filter(stderr,domain,{fun logger_filters:domain/2, {log, sub, [otp, kernel, io, output]}}),
+
+        io:put_chars(standard_error, "world"),
+
+        receive
+            {put_chars,unicode, Msg} ->
+                true = string:find(Msg, "world") =/= nomatch;
+            M2 ->
+                ct:fail({unexpected, M2})
+        after 5000 -> ct:fail(timeout)
+        end
+
+    after
+        logger:set_primary_config(level, Level),
+        logger:remove_handler(stderr),
+        io:setopts(standard_error, [{log, false}])
+    end.

lib/stdlib/doc/src/io.xml

@@ -1266,6 +1266,29 @@ fun("") -> {yes, "quit", []};
             <p>This option is only supported by the standard shell
               (<c>group.erl</c>).</p>
           </item>
+          <tag><c>{log, true | false}</c></tag>
+          <item>
+            <p>Tells the I/O server that it should log each I/O request. Requests will
+              be logged at <c>info</c> level with the following report:</p>
+
+            <code type="erl">
+            #{ request := IoRequest, server := pid(), server_name => term() }.
+            </code>
+
+            <p>Not all I/O servers support this option. Use <seemfa marker="#getopts/1">io:getopts/1</seemfa>
+              to check if it is available.</p>
+
+            <note>
+              <p>The I/O servers in Erlang/OTP will set the <seemfa marker="kernel:logger_filters#domain/2">logger domain</seemfa>
+                to <c>[otp, kernel, io, input | output]</c>. By default <seeerl marker="kernel:logger">logger</seeerl>
+                will not print this domain, so you need to enable it. This can be done by adding a new filter like this:</p>
+
+              <code type="erl">
+              logger:add_handler_filter(default, io_domain,
+                {fun logger_filters:domain/2, {log,sub,[otp,kernel,io]}}).
+              </code>
+            </note>
+          </item>
           <tag><c>{encoding, latin1 | unicode}</c></tag>
           <item>
             <p>Specifies how characters are input or output from or to the I/O