Merge branch 'lukas/kernel/tty-logging' into lukas/kernel/27/tty-logging

* lukas/kernel/tty-logging:
  kernel: Add logging support to group and standard_error

lib/kernel/src/group.erl

@@ -33,6 +33,9 @@
 
 -export([server_loop/3]).
 
+%% Logger report format fun
+-export([format_io_request_log/1]).
+
 start(Drv, Shell) ->
     start(Drv, Shell, []).
 
@@ -75,6 +78,8 @@ server(Ancestors, Drv, Shell, Options) ->
 
     put(line_buffer, proplists:get_value(line_buffer, Options, DefaultGroupHistory)),
 
+    put(log, false),
+
     server_loop(Drv, start_shell(Shell), []).
 
 whereis_shell() ->
@@ -176,8 +181,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) ->
@@ -219,6 +224,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),
@@ -420,6 +429,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);
@@ -429,6 +440,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);
@@ -437,6 +449,7 @@ do_setopts(Opts, Drv, Buf) ->
 	undefined ->
 	    ok
     end,
+
     case proplists:get_value(binary, Opts, case get(read_mode) of
 					      binary -> true;
 					      _ -> false
@@ -468,6 +481,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;
@@ -478,9 +497,10 @@ getopts(Drv,Buf) ->
 			true -> unicode;
 			_ -> latin1
 		     end},
+
     Terminal = get_terminal_state(Drv),
     Tty = {terminal, maps:get(stdout, Terminal)},
-    {ok,[Exp,Echo,Bin,Uni,Tty|maps:to_list(Terminal)],Buf}.
+    {ok,[Exp,Echo,Bin,Uni,Log,Tty|maps:to_list(Terminal)],Buf}.
 
 %% get_chars_*(Prompt, Module, Function, XtraArgument, Drv, Buffer)
 %%  Gets characters from the input Drv until as the applied function
@@ -1239,3 +1259,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

@@ -21,6 +21,8 @@
 -moduledoc false.
 -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]).
 
@@ -68,19 +70,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) ->
@@ -213,7 +231,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 ->
@@ -227,6 +247,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.
 
@@ -246,7 +268,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/src/io.erl

@@ -524,6 +524,26 @@ The options and values supported by the OTP I/O devices are as follows:
 
   This option is only supported by the standard shell (`group.erl`).
 
+- **`{log, true | false}`** - Tells the I/O server that it should log each I/O request.
+  Requests will be logged at `info` level with the following report:
+
+  ```erl
+  #{ request := IoRequest, server := pid(), server_name => term() }.
+  ```
+
+  Not all I/O servers support this option. Use `io:getopts/1` to check if it is available.
+
+  > #### Note {: .info }
+  >
+  > The I/O servers in Erlang/OTP will set the [logger domain](`logger_filters:domain/2`)
+  > to `[otp, kernel, io, input | output]`. By default `m:logger` will not print this domain,
+  > so you need to enable it. This can be done by adding a new filter like this:
+  >
+  > ```erl
+  > logger:add_handler_filter(default, io_domain,
+  >    {fun logger_filters:domain/2, {log,sub,[otp,kernel,io]}}).
+  > ```
+
 - **`{encoding, latin1 | unicode}`** - Specifies how characters are input or
   output from or to the I/O device, implying that, for example, a terminal is
   set to handle Unicode input and output or a file is set to handle UTF-8 data