diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl index 1792ffe2fb25..dd92bd6ee2d3 100644 --- a/lib/kernel/src/group.erl +++ b/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. diff --git a/lib/kernel/src/standard_error.erl b/lib/kernel/src/standard_error.erl index 4aa490719411..c3180e2432b1 100644 --- a/lib/kernel/src/standard_error.erl +++ b/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), diff --git a/lib/kernel/test/standard_error_SUITE.erl b/lib/kernel/test/standard_error_SUITE.erl index 792d086847a6..a6cd886a2084 100644 --- a/lib/kernel/test/standard_error_SUITE.erl +++ b/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. \ No newline at end of file diff --git a/lib/stdlib/doc/src/io.xml b/lib/stdlib/doc/src/io.xml index c2215c821ed1..5972029c89fb 100644 --- a/lib/stdlib/doc/src/io.xml +++ b/lib/stdlib/doc/src/io.xml @@ -1266,6 +1266,29 @@ fun("") -> {yes, "quit", []};

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:

+ + + #{ 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.

+ + +

The I/O servers in Erlang/OTP will set the logger domain + to [otp, kernel, io, input | output]. By default logger + will not print this domain, so you need to enable it. This can be done by adding a new filter like this:

+ + + 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 diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl index 1519ff89c62e..0abdc4f7c986 100644 --- a/lib/stdlib/test/io_proto_SUITE.erl +++ b/lib/stdlib/test/io_proto_SUITE.erl @@ -23,7 +23,7 @@ init_per_group/2,end_per_group/2]). -export([setopts_getopts/1,unicode_options/1,unicode_options_gen/1, - binary_options/1, read_modes_gl/1, + binary_options/1, read_modes_gl/1, logging_gl/1, read_modes_ogl/1, broken_unicode/1,eof_on_pipe/1, unicode_prompt/1, shell_slogan/1, raw_stdout/1, raw_stdout_isatty/1, file_read_stdin_binary_mode/1, file_read_stdin_list_mode/1, @@ -62,7 +62,7 @@ suite() -> all() -> [setopts_getopts, unicode_options, unicode_options_gen, - binary_options, read_modes_gl, read_modes_ogl, + binary_options, read_modes_gl, read_modes_ogl, logging_gl, broken_unicode, eof_on_pipe, unicode_prompt, shell_slogan, raw_stdout, raw_stdout_isatty, file_read_stdin_binary_mode, @@ -1335,6 +1335,70 @@ read_modes_gl_1(_Config,Machine) -> end, ok. +logging_gl(Config) when is_list(Config) -> + + AssertString = fun(Match) -> + fun F() -> + ?MODULE ! {get, self()}, + receive + {put_chars, _, M} -> + case string:find(M, Match) of + nomatch -> io:format("~p~n",[M]), F(); + _ -> ok + end + after 500 -> timeout end + end + end, + + rtnode:run( + [{putline,""}, + {putline, "2."}, + {expect, "[\n ]2"}, + {eval, fun() -> + Device = spawn( + fun F() -> + receive + {get, Parent} -> + receive {io_request, From, ReplyAs, M} -> + Parent ! M, + From ! {io_reply, ReplyAs, ok} + after 500 -> + Parent ! timeout + end, + F() + end + end), + register(?MODULE, Device), + ok = logger:add_handler(default, logger_std_h, #{ filter_default => stop, config => #{ type => {device, Device} }}), + ok = io:setopts(user, [{log,true}]) + end}, + {putline, "io:format(user,\"abc\n\",[])."}, + {expect, "abc\r\nok"}, + {eval, fun() -> ?MODULE ! {get, self()}, receive timeout -> ok; M -> {unexpected_message, M} end end}, + {eval, fun() -> ok = logger:add_handler_filter(default, stderr, {fun logger_filters:domain/2, {log, sub, [otp, kernel, io]}}) end}, + {putline, "io:format(user,\"abc\n\",[])."}, + {expect, "abc\r\nok"}, + {eval, AssertString("put_chars,unicode,\"abc\\n\"")}, + + {putline, "io:setopts([{log,true}])."}, + {expect, "\r\nok"}, + {eval, AssertString("get_until")}, + {putline, "io:get_line(\"prompt: \")."}, + {expect, "prompt: "}, + {eval, AssertString("get_line")}, + {putline, "def"}, + {expect, "\\Q\"def\\n\"\\E"}, + + {eval, fun() -> ok = logger:set_primary_config(level, info) end} + ],[],"", + ["-pz",filename:dirname(code:which(?MODULE)), + "-oldshell", + "-connect_all","false", + "-kernel","logger_level","all", + "-kernel","logger","[{handler, default, undefined}]", + "-kernel","shell_history","disabled", + "-kernel","prevent_overlapping_partitions","false"]), + ok. %% Test behaviour when reading broken Unicode files broken_unicode(Config) when is_list(Config) ->