diff options
Diffstat (limited to 'lib')
101 files changed, 2624 insertions, 805 deletions
diff --git a/lib/common_test/doc/src/ct_ssh.xml b/lib/common_test/doc/src/ct_ssh.xml index 137e4c3f1d..63627d8840 100644 --- a/lib/common_test/doc/src/ct_ssh.xml +++ b/lib/common_test/doc/src/ct_ssh.xml @@ -1034,6 +1034,33 @@ ChannelId, 0, Data, End, Timeout)</c></seealso>.</p> </func> <func> + <name>shell(SSH, ChannelId) -> ok | {error, Reason}</name> + <fsummary>Equivalent to shell(SSH, ChannelId, DefaultTimeout).</fsummary> + <desc><marker id="shell-2"/> + <p>Equivalent to + <seealso marker="#shell-3"><c>ct_ssh:shell(SSH, ChannelId, + DefaultTimeout)</c></seealso>.</p> + </desc> + </func> + + <func> + <name>shell(SSH, ChannelId, Timeout) -> ok | {error, Reason}</name> + <fsummary>Requests that the user default shell is executed at the + server end.</fsummary> + <type> + <v>SSH = connection()</v> + <v>ChannelId = integer()</v> + <v>Timeout = integer()</v> + <v>Reason = term()</v> + </type> + <desc><marker id="shell-3"/> + <p>Requests that the user default shell (typically defined in + <c>/etc/passwd</c> in Unix systems) is executed at the + server end.</p> + </desc> + </func> + + <func> <name>subsystem(SSH, ChannelId, Subsystem) -> Status | {error, Reason}</name> <fsummary>Equivalent to subsystem(SSH, ChannelId, Subsystem, DefaultTimeout).</fsummary> diff --git a/lib/common_test/src/ct_ssh.erl b/lib/common_test/src/ct_ssh.erl index 6ab3bf036c..5ac91f396b 100644 --- a/lib/common_test/src/ct_ssh.erl +++ b/lib/common_test/src/ct_ssh.erl @@ -68,7 +68,8 @@ send_and_receive/3, send_and_receive/4, send_and_receive/5, send_and_receive/6, exec/2, exec/3, exec/4, - subsystem/3, subsystem/4]). + subsystem/3, subsystem/4, + shell/2, shell/3]). %% STFP Functions -export([sftp_connect/1, @@ -94,6 +95,7 @@ -record(state, {ssh_ref, conn_type, target}). +-type handle() :: pid(). %%%----------------------------------------------------------------- %%%------------------------ SSH COMMANDS --------------------------- @@ -490,6 +492,22 @@ subsystem(SSH, ChannelId, Subsystem, Timeout) -> call(SSH, {subsystem,ChannelId,Subsystem,Timeout}). +-spec shell(SSH, ChannelId) -> Result when + SSH :: handle() | ct:target_name(), + ChannelId :: ssh:ssh_channel_id(), + Result :: ok | {error,term()}. +shell(SSH, ChannelId) -> + shell(SSH, ChannelId, ?DEFAULT_TIMEOUT). + +-spec shell(SSH, ChannelId, Timeout) -> Result when + SSH :: handle() | ct:target_name(), + ChannelId :: ssh:ssh_channel_id(), + Timeout :: timeout(), + Result :: ok | {error,term()}. +shell(SSH, ChannelId, Timeout) -> + call(SSH, {shell,ChannelId,Timeout}). + + %%%----------------------------------------------------------------- %%%------------------------ SFTP COMMANDS -------------------------- @@ -1067,6 +1085,14 @@ handle_msg({subsystem,Chn,Subsystem,TO}, State) -> Result = ssh_connection:subsystem(SSHRef, Chn, Subsystem, TO), {Result,State}; +handle_msg({shell,Chn,TO}, State) -> + #state{ssh_ref=SSHRef, target=Target} = State, + try_log(heading(shell,Target), + "SSH Ref: ~p, Chn: ~p, Timeout: ~p", + [SSHRef,Chn,TO]), + Result = ssh_connection:shell(SSHRef, Chn), + {Result,State}; + %% --- SFTP Commands --- handle_msg({read_file,Srv,File}=Cmd, S=#state{ssh_ref=SSHRef}) -> diff --git a/lib/common_test/test/ct_keep_logs_SUITE.erl b/lib/common_test/test/ct_keep_logs_SUITE.erl index f0c85a88a2..6b7aaa57ac 100644 --- a/lib/common_test/test/ct_keep_logs_SUITE.erl +++ b/lib/common_test/test/ct_keep_logs_SUITE.erl @@ -70,8 +70,7 @@ keep_logs(Config) -> Opts = [{suite,Suite},{label,keep_logs} | Opts0], LogDir=?config(logdir,Opts), - KeepLogsDir = filename:join(LogDir,unique_name("keep_logs-")), - ok = file:make_dir(KeepLogsDir), + KeepLogsDir = create_dir(filename:join(LogDir,"keep_logs-")), Opts1 = lists:keyreplace(logdir,1,Opts,{logdir,KeepLogsDir}), ct:log("New LogDir = ~s", [KeepLogsDir]), @@ -121,7 +120,11 @@ keep_logs(Config) -> 9 = length(L10), 0 = ct_test_support:run_ct_script_start([{keep_logs,10}|Opts1], Config), L11 = filelib:wildcard(WC), - 10 = length(L11). + 10 = length(L11), + + {ok,Content} = file:list_dir(KeepLogsDir), + ct:log("Deleting dir: ~p~nContent: ~p~n",[KeepLogsDir,Content]), + ct_test_support:rm_dir(KeepLogsDir). %% Test the keep_logs option togwther with the refresh_logs option refresh_logs(Config) -> @@ -129,8 +132,7 @@ refresh_logs(Config) -> Suite = filename:join(DataDir, "keep_logs_SUITE"), Opts0 = ct_test_support:get_opts(Config), LogDir=?config(logdir,Opts0), - KeepLogsDir = filename:join(LogDir,unique_name("refresh_logs-")), - ok = file:make_dir(KeepLogsDir), + KeepLogsDir = create_dir(filename:join(LogDir,"refresh_logs-")), Opts1 = lists:keyreplace(logdir,1,Opts0,{logdir,KeepLogsDir}), ct:log("New LogDir = ~s", [KeepLogsDir]), @@ -178,9 +180,20 @@ refresh_logs(Config) -> L10 = filelib:wildcard(WC), 4 = length(L10), - ok. + {ok,Content} = file:list_dir(KeepLogsDir), + ct:log("Deleting dir: ~p~nContent: ~p~n",[KeepLogsDir,Content]), + ct_test_support:rm_dir(KeepLogsDir). + %%%----------------------------------------------------------------- %%% Internal -unique_name(Prefix) -> +create_dir(Prefix) -> I = erlang:unique_integer([positive]), - Prefix ++ integer_to_list(I). + Dir = Prefix ++ integer_to_list(I), + case filelib:is_dir(Dir) of + true -> + %% Try again + create_dir(Prefix); + false -> + ok = file:make_dir(Dir), + Dir + end. diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index 935d032667..ba7aadfeec 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -45,6 +45,8 @@ -export([unique_timestamp/0]). +-export([rm_dir/1]). + -include_lib("kernel/include/file.hrl"). %%%----------------------------------------------------------------- diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index fed68037c1..10164890f2 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -629,6 +629,14 @@ module.beam: module.erl \ <p>Turns off warnings for unused record types. Default is to emit warnings for unused locally defined record types.</p> </item> + + <tag><c>nowarn_get_stacktrace</c></tag> + <item> + <p>Turns off warnings for using <c>get_stacktrace/0</c> in a context + where it will probably not work in a future release. For example, + by default there will be a warning if <c>get_stacktrace/0</c> is + used following a <c>catch</c> expression.</p> + </item> </taglist> <p>Another class of warnings is generated by the compiler diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index b3c8c42af7..c6e61d543e 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -467,8 +467,10 @@ mpf(Ms) -> passes(Type, Opts) -> {Ext,Passes0} = passes_1(Opts), Passes1 = case Type of - file -> Passes0; - forms -> tl(Passes0) + file -> + Passes0; + forms -> + fix_first_pass(Passes0) end, Passes = select_passes(Passes1, Opts), @@ -505,6 +507,22 @@ pass(from_beam) -> {".beam",[?pass(read_beam_file)|binary_passes()]}; pass(_) -> none. +%% For compilation from forms, replace the first pass with a pass +%% that retrieves the module name. The module name is needed for +%% proper diagnostics and for compilation to native code. + +fix_first_pass([{parse_core,_}|Passes]) -> + [?pass(get_module_name_from_core)|Passes]; +fix_first_pass([{beam_consult_asm,_}|Passes]) -> + [?pass(get_module_name_from_asm)|Passes]; +fix_first_pass([{read_beam_file,_}|Passes]) -> + [?pass(get_module_name_from_beam)|Passes]; +fix_first_pass([_|Passes]) -> + %% When compiling from abstract code, the module name + %% will be set after running the v3_core pass. + Passes. + + %% select_passes([Command], Opts) -> [{Name,Function}] %% Interpret the lists of commands to return a pure list of passes. %% @@ -836,6 +854,12 @@ beam_consult_asm(_Code, St) -> {error,St#compile{errors=St#compile.errors ++ Es}} end. +get_module_name_from_asm({Mod,_,_,_,_}=Asm, St) -> + {ok,Asm,St#compile{module=Mod}}; +get_module_name_from_asm(Asm, St) -> + %% Invalid Beam assembly code. Let it crash in a later pass. + {ok,Asm,St}. + read_beam_file(_Code, St) -> case file:read_file(St#compile.ifile) of {ok,Beam} -> @@ -853,6 +877,16 @@ read_beam_file(_Code, St) -> {error,St#compile{errors=St#compile.errors ++ Es}} end. +get_module_name_from_beam(Beam, St) -> + case beam_lib:info(Beam) of + {error,beam_lib,Error} -> + Es = [{"((forms))",[{none,beam_lib,Error}]}], + {error,St#compile{errors=St#compile.errors ++ Es}}; + Info -> + {module,Mod} = keyfind(module, 1, Info), + {ok,Beam,St#compile{module=Mod}} + end. + no_native_compilation(BeamFile, #compile{options=Opts0}) -> case beam_lib:chunks(BeamFile, ["CInf"]) of {ok,{_,[{"CInf",Term0}]}} -> @@ -940,6 +974,16 @@ parse_core(_Code, St) -> {error,St#compile{errors=St#compile.errors ++ Es}} end. +get_module_name_from_core(Core, St) -> + try + Mod = cerl:concrete(cerl:module_name(Core)), + {ok,Core,St#compile{module=Mod}} + catch + _:_ -> + %% Invalid Core Erlang code. Let it crash in a later pass. + {ok,Core,St} + end. + compile_options([{attribute,_L,compile,C}|Fs]) when is_list(C) -> C ++ compile_options(Fs); compile_options([{attribute,_L,compile,C}|Fs]) -> diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 5e0c2b3ebf..9efb9ad6f8 100755 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -538,6 +538,8 @@ BEAM_FORMAT_NUMBER=0 157: has_map_fields/3 158: get_map_elements/3 +# OTP 20 + ## @spec is_tagged_tuple Lbl Reg N Atom ## @doc Test the type of Reg and jumps to Lbl if it is not a tuple. ## Test the arity of Reg and jumps to Lbl if it is not N. diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index ca85eef688..75bfbf68cc 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -446,7 +446,7 @@ do_bin_opt(Mod, Asm) -> do_bin_opt(Transform, Mod, Asm0) -> Asm = Transform(Asm0), case compile:forms(Asm, [from_asm,no_postopt,return]) of - {ok,[],Code,_Warnings} when is_binary(Code) -> + {ok,Mod,Code,_Warnings} when is_binary(Code) -> ok; {error,Errors0,_} -> %% beam_validator must return errors, not simply crash, diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index f9bcb044ac..4e2753ba5f 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -32,7 +32,7 @@ binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1, other_output/1, kernel_listing/1, encrypted_abstr/1, strict_record/1, utf8_atoms/1, utf8_functions/1, extra_chunks/1, - cover/1, env/1, core/1, + cover/1, env/1, core_pp/1, core_roundtrip/1, asm/1, optimized_guards/1, sys_pre_attributes/1, dialyzer/1, warnings/1, pre_load_check/1, env_compiler_options/1, @@ -51,7 +51,7 @@ all() -> binary, makedep, cond_and_ifdef, listings, listings_big, other_output, kernel_listing, encrypted_abstr, strict_record, utf8_atoms, utf8_functions, extra_chunks, - cover, env, core, core_roundtrip, asm, optimized_guards, + cover, env, core_pp, core_roundtrip, asm, optimized_guards, sys_pre_attributes, dialyzer, warnings, pre_load_check, env_compiler_options, custom_debug_info, bc_options]. @@ -163,6 +163,24 @@ forms_2(Config) when is_list(Config) -> ok end, + {ok,simple,Core} = compile:forms(SimpleCode, [to_core0,binary]), + forms_compile_and_load(Core, [from_core]), + forms_compile_and_load(Core, [from_core,native]), + + {ok,simple,Asm} = compile:forms(SimpleCode, [to_asm,binary]), + forms_compile_and_load(Asm, [from_asm]), + forms_compile_and_load(Asm, [from_asm,native]), + + {ok,simple,Beam} = compile:forms(SimpleCode, []), + forms_compile_and_load(Beam, [from_beam]), + forms_compile_and_load(Beam, [from_beam,native]), + + %% Cover the error handling code. + error = compile:forms(bad_core, [from_core,report]), + error = compile:forms(bad_asm, [from_asm,report]), + error = compile:forms(<<"bad_beam">>, [from_beam,report]), + error = compile:forms(<<"bad_beam">>, [from_beam,native,report]), + ok. @@ -180,6 +198,14 @@ forms_load_code(Mod, Src, Bin) -> SourceOption. +forms_compile_and_load(Code, Opts) -> + Mod = simple, + {ok,Mod,Bin} = compile:forms(Code, Opts), + {module,Mod} = code:load_binary(Mod, "ignore", Bin), + _ = Mod:module_info(), + true = code:delete(simple), + false = code:purge(simple), + ok. module_mismatch(Config) when is_list(Config) -> DataDir = proplists:get_value(data_dir, Config), @@ -795,9 +821,9 @@ env_1(Simple, Target) -> %% Test pretty-printing in Core Erlang format and then try to %% compile the generated Core Erlang files. -core(Config) when is_list(Config) -> +core_pp(Config) when is_list(Config) -> PrivDir = proplists:get_value(priv_dir, Config), - Outdir = filename:join(PrivDir, "core"), + Outdir = filename:join(PrivDir, atom_to_list(?FUNCTION_NAME)), ok = file:make_dir(Outdir), TestBeams = get_unique_beam_files(), @@ -805,11 +831,11 @@ core(Config) when is_list(Config) -> {raw_abstract_v1,Abstr}}]}} = beam_lib:chunks(Beam, [abstract_code]), {Mod,Abstr} end || Beam <- TestBeams], - test_lib:p_run(fun(F) -> do_core(F, Outdir) end, Abstr). + test_lib:p_run(fun(F) -> do_core_pp(F, Outdir) end, Abstr). -do_core({M,A}, Outdir) -> +do_core_pp({M,A}, Outdir) -> try - do_core_1(M, A, Outdir) + do_core_pp_1(M, A, Outdir) catch throw:{error,Error} -> io:format("*** compilation failure '~p' for module ~s\n", @@ -821,7 +847,7 @@ do_core({M,A}, Outdir) -> error end. -do_core_1(M, A, Outdir) -> +do_core_pp_1(M, A, Outdir) -> {ok,M,Core0} = compile:forms(A, [to_core]), CoreFile = filename:join(Outdir, atom_to_list(M)++".core"), CorePP = core_pp:format(Core0), @@ -835,7 +861,7 @@ do_core_1(M, A, Outdir) -> ok = file:delete(CoreFile), %% Compile as usual (including optimizations). - compile_forms(Core, [clint,from_core,binary]), + compile_forms(M, Core, [clint,from_core,binary]), %% Don't optimize to test that we are not dependent %% on the Core Erlang optmimization passes. @@ -844,13 +870,13 @@ do_core_1(M, A, Outdir) -> %% records; if sys_core_fold was run it would fix %% that; if sys_core_fold was not run v3_kernel would %% crash.) - compile_forms(Core, [clint,from_core,no_copt,binary]), + compile_forms(M, Core, [clint,from_core,no_copt,binary]), ok. -compile_forms(Forms, Opts) -> +compile_forms(Mod, Forms, Opts) -> case compile:forms(Forms, [report_errors|Opts]) of - {ok,[],_} -> ok; + {ok,Mod,_} -> ok; Other -> throw({error,Other}) end. diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index d08893b307..4ae7edd8b2 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -1089,9 +1089,6 @@ static void init_algorithms_types(ErlNifEnv* env) #ifndef OPENSSL_NO_RC4 algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"rc4"); #endif -#if defined(HAVE_GCM) - algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_gcm"); -#endif #if defined(HAVE_CHACHA20_POLY1305) algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"chacha20_poly1305"); #endif diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl index 8a1a70448e..d863c056e9 100644 --- a/lib/erl_docgen/priv/xsl/db_html.xsl +++ b/lib/erl_docgen/priv/xsl/db_html.xsl @@ -95,7 +95,7 @@ <xsl:value-of select="$elem/@name"/> </xsl:when> <xsl:otherwise> - <xsl:value-of select="$elem"/> + <xsl:value-of select="substring-before($elem, '(')"/> </xsl:otherwise> </xsl:choose> </xsl:otherwise> diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index ea8cc1677d..4cfa80f153 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -5171,9 +5171,9 @@ cache_put(Key, Type, DeltaL, #cache{types = Types} = Cache) -> NewTypes = maps:put(Key, {Type, DeltaL}, Types), Cache#cache{types = NewTypes}. --spec t_var_names([erl_type()]) -> [atom()]. +-spec t_var_names([parse_form()]) -> [atom()]. -t_var_names([{var, _, Name}|L]) when L =/= '_' -> +t_var_names([{var, _, Name}|L]) when Name =/= '_' -> [Name|t_var_names(L)]; t_var_names([]) -> []. diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 4217b3c4fb..46484977c9 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -344,7 +344,7 @@ <tag><c><![CDATA[ssl]]></c></tag> <item> <p>This is the <c>SSL/TLS</c> connectin configuration option.</p> - <p>Defaults to <c>[]</c>. See <seealso marker="ssl:ssl">ssl:connect/[2, 3,4]</seealso> for availble options.</p> + <p>Defaults to <c>[]</c>. See <seealso marker="ssl:ssl">ssl:connect/[2,3,4]</seealso> for available options.</p> </item> <tag><c><![CDATA[autoredirect]]></c></tag> diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index c99200777b..89c17a8679 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1224,7 +1224,7 @@ close_socket(#session{socket = Socket, socket_type = SocketType}) -> http_transport:close(SocketType, Socket). activate_request_timeout( - #state{request = #request{timer = undefined} = Request} = State) -> + #state{request = #request{timer = OldRef} = Request} = State) -> Timeout = (Request#request.settings)#http_options.timeout, case Timeout of infinity -> @@ -1232,17 +1232,21 @@ activate_request_timeout( _ -> ReqId = Request#request.id, Msg = {timeout, ReqId}, + case OldRef of + undefined -> + ok; + _ -> + %% Timer is already running! This is the case for a redirect or retry + %% We need to restart the timer because the handler pid has changed + cancel_timer(OldRef, Msg) + end, Ref = erlang:send_after(Timeout, self(), Msg), Request2 = Request#request{timer = Ref}, ReqTimers = [{Request#request.id, Ref} | (State#state.timers)#timers.request_timers], Timers = #timers{request_timers = ReqTimers}, State#state{request = Request2, timers = Timers} - end; - -%% Timer is already running! This is the case for a redirect or retry -activate_request_timeout(State) -> - State. + end. activate_queue_timeout(infinity, State) -> State; diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index fc7f01245b..e6dcd2285f 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -108,6 +108,7 @@ only_simulated() -> tolerate_missing_CR, userinfo, bad_response, + timeout_redirect, internal_server_error, invalid_http, invalid_chunk_size, @@ -785,6 +786,14 @@ bad_response(Config) when is_list(Config) -> ct:print("Wrong Statusline: ~p~n", [Reason]). %%------------------------------------------------------------------------- +timeout_redirect() -> + [{doc, "Test that timeout works for redirects, check ERL-420."}]. +timeout_redirect(Config) when is_list(Config) -> + URL = url(group_name(Config), "/redirect_to_missing_crlf.html", Config), + {error, timeout} = httpc:request(get, {URL, []}, [{timeout, 400}], []). + +%%------------------------------------------------------------------------- + internal_server_error(doc) -> ["Test 50X codes"]; internal_server_error(Config) when is_list(Config) -> @@ -1915,6 +1924,16 @@ handle_uri(_,"/missing_crlf.html",_,_,_,_) -> "Content-Length:32\r\n" ++ "<HTML><BODY>foobar</BODY></HTML>"; +handle_uri(_,"/redirect_to_missing_crlf.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/missing_crlf.html", + Body = "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>", + "HTTP/1.1 303 See Other \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:" ++ integer_to_list(length(Body)) + ++ "\r\n\r\n" ++ Body; + handle_uri(_,"/wrong_statusline.html",_,_,_,_) -> "ok 200 HTTP/1.1\r\n\r\n" ++ "Content-Length:32\r\n\r\n" ++ diff --git a/lib/kernel/doc/src/disk_log.xml b/lib/kernel/doc/src/disk_log.xml index aebeacee28..570d3ef9bd 100644 --- a/lib/kernel/doc/src/disk_log.xml +++ b/lib/kernel/doc/src/disk_log.xml @@ -968,6 +968,12 @@ <c>read_write</c>. </p> </item> + <tag><c>{quiet, Boolean}</c></tag> + <item> + <p>Specifies if messages will be sent to + <c>error_logger</c> on recoverable errors with + the log files. Defaults to <c>true</c>.</p> + </item> </taglist> <p><c>open/1</c> returns <c>{ok, <anno>Log</anno>}</c> if the log file is successfully opened. If the file is diff --git a/lib/kernel/doc/src/error_logger.xml b/lib/kernel/doc/src/error_logger.xml index 814e8eac46..27db00819f 100644 --- a/lib/kernel/doc/src/error_logger.xml +++ b/lib/kernel/doc/src/error_logger.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2016</year> + <year>1996</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -163,6 +163,19 @@ ok</pre> </desc> </func> <func> + <name name="get_format_depth" arity="0"/> + <fsummary>Get the value of the Kernel application variable + <c>error_logger_format_depth</c>.</fsummary> + <desc> + <p>Returns <c>max(10, Depth)</c>, where <c>Depth</c> is the + value of + <seealso marker="kernel:kernel_app#error_logger_format_depth"> + error_logger_format_depth</seealso> + in the Kernel application, if Depth is an integer. Otherwise, + <c>unlimited</c> is returned.</p> + </desc> + </func> + <func> <name name="info_msg" arity="1"/> <name name="info_msg" arity="2"/> <fsummary>Send a standard information event to the error logger.</fsummary> diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index b7c904ff45..b71e8a1e5d 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -75,8 +75,8 @@ Address ip_address() ------- ------------ ::1 {0,0,0,0,0,0,0,1} ::192.168.42.2 {0,0,0,0,0,0,(192 bsl 8) bor 168,(42 bsl 8) bor 2} -FFFF::192.168.42.2 - {16#FFFF,0,0,0,0,0,(192 bsl 8) bor 168,(42 bsl 8) bor 2} +::FFFF:192.168.42.2 + {0,0,0,0,0,16#FFFF,(192 bsl 8) bor 168,(42 bsl 8) bor 2} 3ffe:b80:1f8d:2:204:acff:fe17:bf38 {16#3ffe,16#b80,16#1f8d,16#2,16#204,16#acff,16#fe17,16#bf38} fe80::204:acff:fe17:bf38 @@ -87,8 +87,8 @@ fe80::204:acff:fe17:bf38 <pre> 1> <input>inet:parse_address("192.168.42.2").</input> {ok,{192,168,42,2}} -2> <input>inet:parse_address("FFFF::192.168.42.2").</input> -{ok,{65535,0,0,0,0,0,49320,10754}}</pre> +2> <input>inet:parse_address("::FFFF:192.168.42.2").</input> +{ok,{0,0,0,0,0,65535,49320,10754}}</pre> </description> <datatypes> diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml index 28af155493..75e1e18d86 100644 --- a/lib/kernel/doc/src/kernel_app.xml +++ b/lib/kernel/doc/src/kernel_app.xml @@ -58,6 +58,7 @@ </section> <section> + <marker id="erl_signal_server"/> <title>OS Signal Event Handler</title> <p>Asynchronous OS signals may be subscribed to via the Kernel applications event manager (see <seealso marker="doc/design_principles:des_princ">OTP Design Principles</seealso> and @@ -419,6 +420,29 @@ MaxT = TickTime + TickTime / 4</code> using this service.</p> <p>Defaults to <c>false</c>.</p> </item> + <tag><c>shell_history = enabled | disabled </c></tag> + <item> + <p>Specifies whether shell history should be logged to disk + between usages of <c>erl</c>.</p> + </item> + <tag><c>shell_history_drop = [string()]</c></tag> + <item> + <p>Specific log lines that should not be persisted. For + example <c>["q().", "init:stop()."]</c> will allow to + ignore commands that shut the node down. Defaults to + <c>[]</c>.</p> + </item> + <tag><c>shell_history_file_bytes = integer()</c></tag> + <item> + <p>how many bytes the shell should remember. By default, the + value is set to 512kb, and the minimal value is 50kb.</p> + </item> + <tag><c>shell_history_path = string()</c></tag> + <item> + <p>Specifies where the shell history files will be stored. + defaults to the user's cache directory as returned by + <c>filename:basedir(user_cache, "erlang-history")</c>.</p> + </item> <tag><c>shutdown_func = {Mod, Func}</c></tag> <item> <p>Where:</p> diff --git a/lib/kernel/doc/src/net_kernel.xml b/lib/kernel/doc/src/net_kernel.xml index 4e2b0c69db..7ddb849824 100644 --- a/lib/kernel/doc/src/net_kernel.xml +++ b/lib/kernel/doc/src/net_kernel.xml @@ -64,6 +64,19 @@ $ <input>erl -sname foobar</input></pre> by the magic cookie system, see section <seealso marker="doc/reference_manual:distributed">Distributed Erlang</seealso> in the Erlang Reference Manual.</p> + <warning> + <p> + Starting a distributed node without also specifying + <seealso marker="erts:erl#proto_dist"><c>-proto_dist inet_tls</c></seealso> + will expose the node to attacks that may give the attacker + complete access to the node and in extension the cluster. + When using un-secure distributed nodes, make sure that the + network is configured to keep potential attackers out. + See the <seealso marker="ssl:ssl_distribution"> + Using SSL for Erlang Distribution</seealso> User's Guide + for details on how to setup a secure distributed node. + </p> + </warning> </description> <funcs> diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml index 64c5cbe571..0e9add4161 100644 --- a/lib/kernel/doc/src/os.xml +++ b/lib/kernel/doc/src/os.xml @@ -174,8 +174,9 @@ DirOut = os:cmd("dir"), % on Win32 platform</code> <tag><c>handle</c></tag> <item> - This signal will notify <c>erl_signal_server</c> when it is received by - the Erlang runtime system. + This signal will notify + <seealso marker="kernel_app#erl_signal_server"><c>erl_signal_server</c></seealso> + when it is received by the Erlang runtime system. </item> </taglist> </desc> diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 2a89faaf13..78aa6192a9 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -85,6 +85,7 @@ MODULES = \ global_group \ global_search \ group \ + group_history \ heart \ hipe_unified_loader \ inet \ diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl index 50a20c918c..70cbf1c87c 100644 --- a/lib/kernel/src/disk_log.erl +++ b/lib/kernel/src/disk_log.erl @@ -638,6 +638,8 @@ check_arg([{mode, read_only}|Tail], Res) -> check_arg(Tail, Res#arg{mode = read_only}); check_arg([{mode, read_write}|Tail], Res) -> check_arg(Tail, Res#arg{mode = read_write}); +check_arg([{quiet, Boolean}|Tail], Res) when is_boolean(Boolean) -> + check_arg(Tail, Res#arg{quiet = Boolean}); check_arg(Arg, _) -> {error, {badarg, Arg}}. @@ -1276,7 +1278,8 @@ compare_arg(_Attr, _Val, _A) -> do_open(A) -> #arg{type = Type, format = Format, name = Name, head = Head0, file = FName, repair = Repair, size = Size, mode = Mode, - version = V} = A, + quiet = Quiet, version = V} = A, + disk_log_1:set_quiet(Quiet), Head = mk_head(Head0, Format), case do_open2(Type, Format, Name, FName, Repair, Size, Mode, Head, V) of {ok, Ret, Extra, FormatType, NoItems} -> diff --git a/lib/kernel/src/disk_log.hrl b/lib/kernel/src/disk_log.hrl index c9fda8bef5..a362881f40 100644 --- a/lib/kernel/src/disk_log.hrl +++ b/lib/kernel/src/disk_log.hrl @@ -69,13 +69,14 @@ | {file, FileName :: file:filename()} | {linkto, LinkTo :: none | pid()} | {repair, Repair :: true | false | truncate} - | {type, Type :: dlog_type} + | {type, Type :: dlog_type()} | {format, Format :: dlog_format()} | {size, Size :: dlog_size()} | {distributed, Nodes :: [node()]} | {notify, boolean()} | {head, Head :: dlog_head_opt()} | {head_func, MFA :: {atom(), atom(), list()}} + | {quiet, boolean()} | {mode, Mode :: dlog_mode()}. -type dlog_options() :: [dlog_option()]. -type dlog_repair() :: 'truncate' | boolean(). @@ -102,6 +103,7 @@ head = none, mode = read_write :: dlog_mode(), notify = false :: boolean(), + quiet = false :: boolean(), options = [] :: dlog_options()}). -record(cache, %% Cache for logged terms (per file descriptor). diff --git a/lib/kernel/src/disk_log_1.erl b/lib/kernel/src/disk_log_1.erl index d83c30f35f..10c22e1ad6 100644 --- a/lib/kernel/src/disk_log_1.erl +++ b/lib/kernel/src/disk_log_1.erl @@ -37,6 +37,7 @@ -export([get_wrap_size/1]). -export([is_head/1]). -export([position/3, truncate_at/3, fwrite/4, fclose/2]). +-export([set_quiet/1, is_quiet/0]). -compile({inline,[{scan_f2,7}]}). @@ -500,7 +501,10 @@ lh(H, _F) -> % cannot happen repair(In, File) -> FSz = file_size(File), - error_logger:info_msg("disk_log: repairing ~tp ...\n", [File]), + case is_quiet() of + true -> ok; + _ -> error_logger:info_msg("disk_log: repairing ~tp ...\n", [File]) + end, Tmp = add_ext(File, "TMP"), {ok, {_Alloc, Out, {0, _}, _FileSize}} = new_int_file(Tmp, none), scan_f_read(<<>>, In, Out, File, FSz, Tmp, ?MAX_CHUNK_SIZE, 0, 0). @@ -769,8 +773,11 @@ mf_int_chunk(Handle, {FileNo, Pos}, Bin, N) -> NFileNo = inc(FileNo, Handle#handle.maxF), case catch int_open(FName, true, read_only, any) of {error, _Reason} -> - error_logger:info_msg("disk_log: chunk error. File ~tp missing.\n\n", - [FName]), + case is_quiet() of + true -> ok; + _ -> error_logger:info_msg("disk_log: chunk error. File ~tp missing.\n\n", + [FName]) + end, mf_int_chunk(Handle, {NFileNo, 0}, [], N); {ok, {_Alloc, FdC, _HeadSize, _FileSize}} -> case chunk(FdC, FName, Pos, Bin, N) of @@ -797,9 +804,12 @@ mf_int_chunk_read_only(Handle, {FileNo, Pos}, Bin, N) -> NFileNo = inc(FileNo, Handle#handle.maxF), case catch int_open(FName, true, read_only, any) of {error, _Reason} -> - error_logger:info_msg("disk_log: chunk error. File ~tp missing.\n\n", - [FName]), - mf_int_chunk_read_only(Handle, {NFileNo, 0}, [], N); + case is_quiet() of + true -> ok; + _ -> error_logger:info_msg("disk_log: chunk error. File ~tp missing.\n\n", + [FName]) + end, + mf_int_chunk_read_only(Handle, {NFileNo, 0}, [], N); {ok, {_Alloc, FdC, _HeadSize, _FileSize}} -> case do_chunk_read_only(FdC, FName, Pos, Bin, N) of {NewFdC, eof} -> @@ -1549,6 +1559,12 @@ fclose(#cache{fd = Fd, c = C}, FileName) -> _ = write_cache_close(Fd, FileName, C), file:close(Fd). +set_quiet(Bool) -> + put(quiet, Bool). + +is_quiet() -> + get(quiet) =:= true. + %% -> {Reply, #cache{}}; Reply = ok | Error write_cache(Fd, _FileName, []) -> {ok, #cache{fd = Fd}}; diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl index 1c326afca8..b3507e5d13 100644 --- a/lib/kernel/src/dist_util.erl +++ b/lib/kernel/src/dist_util.erl @@ -572,12 +572,25 @@ recv_name(#hs_data{socket = Socket, f_recv = Recv}) -> ?shutdown(no_node) end. -get_name([$n,VersionA, VersionB, Flag1, Flag2, Flag3, Flag4 | OtherNode]) -> - {?u32(Flag1, Flag2, Flag3, Flag4), list_to_atom(OtherNode), - ?u16(VersionA,VersionB)}; +get_name([$n,VersionA, VersionB, Flag1, Flag2, Flag3, Flag4 | OtherNode] = Data) -> + case is_valid_name(OtherNode) of + true -> + {?u32(Flag1, Flag2, Flag3, Flag4), list_to_atom(OtherNode), + ?u16(VersionA,VersionB)}; + false -> + ?shutdown(Data) + end; get_name(Data) -> ?shutdown(Data). +is_valid_name(OtherNodeName) -> + case string:lexemes(OtherNodeName,"@") of + [_OtherNodeName,_OtherNodeHost] -> + true; + _else -> + false + end. + publish_type(Flags) -> case Flags band ?DFLAG_PUBLISHED of 0 -> diff --git a/lib/kernel/src/error_logger.erl b/lib/kernel/src/error_logger.erl index 81f1bf8d97..9bf8547745 100644 --- a/lib/kernel/src/error_logger.erl +++ b/lib/kernel/src/error_logger.erl @@ -31,6 +31,8 @@ handle_event/2, handle_call/2, handle_info/2, terminate/2]). +-export([get_format_depth/0, limit_term/1]). + -define(buffer_size, 10). %%----------------------------------------------------------------- @@ -518,3 +520,21 @@ string_p1([H|T]) when is_list(H) -> end; string_p1([]) -> true; string_p1(_) -> false. + +-spec limit_term(term()) -> term(). + +limit_term(Term) -> + case get_format_depth() of + unlimited -> Term; + D -> io_lib:limit_term(Term, D) + end. + +-spec get_format_depth() -> 'unlimited' | pos_integer(). + +get_format_depth() -> + case application:get_env(kernel, error_logger_format_depth) of + {ok, Depth} when is_integer(Depth) -> + max(10, Depth); + undefined -> + unlimited + end. diff --git a/lib/kernel/src/global.erl b/lib/kernel/src/global.erl index 3d6415036c..a9e92b28b8 100644 --- a/lib/kernel/src/global.erl +++ b/lib/kernel/src/global.erl @@ -447,7 +447,8 @@ info() -> init([]) -> process_flag(trap_exit, true), _ = ets:new(global_locks, [set, named_table, protected]), - _ = ets:new(global_names, [set, named_table, protected]), + _ = ets:new(global_names, [set, named_table, protected, + {read_concurrency, true}]), _ = ets:new(global_names_ext, [set, named_table, protected]), _ = ets:new(global_pid_names, [bag, named_table, protected]), diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl index b5e73117dd..0eeaaad8d2 100644 --- a/lib/kernel/src/group.erl +++ b/lib/kernel/src/group.erl @@ -33,7 +33,7 @@ start(Drv, Shell, Options) -> server(Drv, Shell, Options) -> process_flag(trap_exit, true), edlin:init(), - put(line_buffer, proplists:get_value(line_buffer, Options, [])), + put(line_buffer, proplists:get_value(line_buffer, Options, group_history:load())), put(read_mode, list), put(user_drv, Drv), put(expand_fun, @@ -783,6 +783,7 @@ save_line_buffer("\n", Lines) -> save_line_buffer(Line, [Line|_Lines]=Lines) -> save_line_buffer(Lines); save_line_buffer(Line, Lines) -> + group_history:add(Line), save_line_buffer([Line|Lines]). save_line_buffer(Lines) -> diff --git a/lib/kernel/src/group_history.erl b/lib/kernel/src/group_history.erl new file mode 100644 index 0000000000..5ca5e2d1dd --- /dev/null +++ b/lib/kernel/src/group_history.erl @@ -0,0 +1,341 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(group_history). +-export([load/0, add/1]). + +%% Make a minimal size that should encompass set of lines and then make +%% a file rotation for N files of this size. +-define(DEFAULT_HISTORY_FILE, "erlang-shell-log"). +-define(MAX_HISTORY_FILES, 10). +-define(DEFAULT_SIZE, 1024*512). % 512 kb total default +-define(DEFAULT_STATUS, disabled). +-define(MIN_HISTORY_SIZE, (50*1024)). % 50 kb, in bytes +-define(DEFAULT_DROP, []). +-define(DISK_LOG_FORMAT, internal). % since we want repairs +-define(LOG_NAME, '$#group_history'). +-define(VSN, {0,1,0}). + +%%%%%%%%%%%%%% +%%% PUBLIC %%% +%%%%%%%%%%%%%% + +%% @doc Loads the shell history from memory. This function should only be +%% called from group:server/3 to inject itself in the previous commands +%% stack. +-spec load() -> [string()]. +load() -> + wait_for_kernel_safe_sup(), + case history_status() of + enabled -> + case open_log() of + {ok, ?LOG_NAME} -> + read_full_log(?LOG_NAME); + {repaired, ?LOG_NAME, {recovered, Good}, {badbytes, Bad}} -> + report_repairs(?LOG_NAME, Good, Bad), + read_full_log(?LOG_NAME); + {error, {need_repair, _FileName}} -> + repair_log(?LOG_NAME); + {error, {arg_mismatch, repair, true, false}} -> + repair_log(?LOG_NAME); + {error, {name_already_open, _}} -> + show_rename_warning(), + read_full_log(?LOG_NAME); + {error, {size_mismatch, Current, New}} -> + show_size_warning(Current, New), + resize_log(?LOG_NAME, Current, New), + load(); + {error, {invalid_header, {vsn, Version}}} -> + upgrade_version(?LOG_NAME, Version), + load(); + {error, Reason} -> + handle_open_error(Reason), + disable_history(), + [] + end; + _ -> + [] + end. + +%% @doc adds a log line to the erlang history log, if configured to do so. +-spec add(iodata()) -> ok. +add(Line) -> add(Line, history_status()). + +add(Line, enabled) -> + case lists:member(Line, to_drop()) of + false -> + case disk_log:log(?LOG_NAME, Line) of + ok -> + ok; + {error, no_such_log} -> + _ = open_log(), % a wild attempt we hope works! + disk_log:log(?LOG_NAME, Line); + {error, _Other} -> + % just ignore, we're too late + ok + end; + true -> + ok + end; +add(_Line, disabled) -> + ok. + +%%%%%%%%%%%%%%% +%%% PRIVATE %%% +%%%%%%%%%%%%%%% + +%% Because loading the shell happens really damn early, processes we depend on +%% might not be there yet. Luckily, the load function is called from the shell +%% after a new process has been spawned, so we can block in here +wait_for_kernel_safe_sup() -> + case whereis(kernel_safe_sup) of + undefined -> + timer:sleep(50), + wait_for_kernel_safe_sup(); + _ -> + ok + end. + +%% Repair the log out of band +repair_log(Name) -> + Opts = lists:keydelete(size, 1, log_options()), + case disk_log:open(Opts) of + {repaired, ?LOG_NAME, {recovered, Good}, {badbytes, Bad}} -> + report_repairs(?LOG_NAME, Good, Bad); + _ -> + ok + end, + _ = disk_log:close(Name), + load(). + +%% Return whether the shell history is enabled or not +-spec history_status() -> enabled | disabled. +history_status() -> + case is_user() orelse application:get_env(kernel, shell_history) of + true -> disabled; % don't run for user proc + {ok, enabled} -> enabled; + undefined -> ?DEFAULT_STATUS; + _ -> disabled + end. + +%% Return whether the user process is running this +-spec is_user() -> boolean(). +is_user() -> + case process_info(self(), registered_name) of + {registered_name, user} -> true; + _ -> false + end. + +%% Open a disk_log file while ensuring the required path is there. +open_log() -> + Opts = log_options(), + _ = ensure_path(Opts), + disk_log:open(Opts). + +%% Return logger options +log_options() -> + Path = find_path(), + File = filename:join([Path, ?DEFAULT_HISTORY_FILE]), + Size = find_wrap_values(), + [{name, ?LOG_NAME}, + {file, File}, + {repair, true}, + {format, internal}, + {type, wrap}, + {size, Size}, + {distributed, []}, + {notify, false}, + {head, {vsn, ?VSN}}, + {quiet, true}, + {mode, read_write}]. + +-spec ensure_path([{file, string()} | {atom(), _}, ...]) -> ok | {error, term()}. +ensure_path(Opts) -> + {file, Path} = lists:keyfind(file, 1, Opts), + filelib:ensure_dir(Path). + +%% @private read the logs from an already open file. Treat closed files +%% as wrong and returns an empty list to avoid crash loops in the shell. +-spec read_full_log(term()) -> [string()]. +read_full_log(Name) -> + case disk_log:chunk(Name, start) of + {error, no_such_log} -> + show_unexpected_close_warning(), + []; + eof -> + []; + {Cont, Logs} -> + lists:reverse(maybe_drop_header(Logs) ++ read_full_log(Name, Cont)) + end. + +read_full_log(Name, Cont) -> + case disk_log:chunk(Name, Cont) of + {error, no_such_log} -> + show_unexpected_close_warning(), + []; + eof -> + []; + {NextCont, Logs} -> + maybe_drop_header(Logs) ++ read_full_log(Name, NextCont) + end. + +maybe_drop_header([{vsn, _} | Rest]) -> Rest; +maybe_drop_header(Logs) -> Logs. + +-spec handle_open_error(_) -> ok. +handle_open_error({arg_mismatch, OptName, CurrentVal, NewVal}) -> + show('$#erlang-history-arg-mismatch', + "Log file argument ~p changed value from ~p to ~p " + "and cannot be automatically updated. Please clear the " + "history files and try again.~n", + [OptName, CurrentVal, NewVal]); +handle_open_error({not_a_log_file, FileName}) -> + show_invalid_file_warning(FileName); +handle_open_error({invalid_index_file, FileName}) -> + show_invalid_file_warning(FileName); +handle_open_error({invalid_header, Term}) -> + show('$#erlang-history-invalid-header', + "Shell history expects to be able to use the log files " + "which currently have unknown headers (~p) and may belong to " + "another mechanism. History logging will be " + "disabled.~n", + [Term]); +handle_open_error({file_error, FileName, Reason}) -> + show('$#erlang-history-file-error', + "Error handling File ~s. Reason: ~p~n" + "History logging will be disabled.~n", + [FileName, Reason]); +handle_open_error(Err) -> + show_unexpected_warning({disk_log, open, 1}, Err). + +find_wrap_values() -> + ConfSize = case application:get_env(kernel, shell_history_file_bytes) of + undefined -> ?DEFAULT_SIZE; + {ok, S} -> S + end, + SizePerFile = max(?MIN_HISTORY_SIZE, ConfSize div ?MAX_HISTORY_FILES), + FileCount = if SizePerFile > ?MIN_HISTORY_SIZE -> + ?MAX_HISTORY_FILES + ; SizePerFile =< ?MIN_HISTORY_SIZE -> + max(1, ConfSize div SizePerFile) + end, + {SizePerFile, FileCount}. + +report_repairs(_, _, 0) -> + %% just a regular close repair + ok; +report_repairs(_, Good, Bad) -> + show('$#erlang-history-report-repairs', + "The shell history log file was corrupted and was repaired. " + "~p bytes were recovered and ~p were lost.~n", [Good, Bad]). + +resize_log(Name, _OldSize, NewSize) -> + show('$#erlang-history-resize-attempt', + "Attempting to resize the log history file to ~p...", [NewSize]), + Opts = lists:keydelete(size, 1, log_options()), + _ = case disk_log:open(Opts) of + {error, {need_repair, _}} -> + _ = repair_log(Name), + disk_log:open(Opts); + _ -> + ok + end, + case disk_log:change_size(Name, NewSize) of + ok -> + show('$#erlang-history-resize-result', + "ok~n", []); + {error, {new_size_too_small, _}} -> + show('$#erlang-history-resize-result', + "failed (new size is too small)~n", []), + disable_history(); + {error, Reason} -> + show('$#erlang-history-resize-result', + "failed (~p)~n", [Reason]), + disable_history() + end. + +upgrade_version(_Name, Unsupported) -> + %% We only know of one version and can't support a newer one + show('$#erlang-history-upgrade', + "The version for the shell logs found on disk (~p) is " + "not supported by the current version (~p)~n", + [Unsupported, ?VSN]), + disable_history(). + +disable_history() -> + show('$#erlang-history-disable', "Disabling shell history logging.~n", []), + application:set_env(kernel, shell_history, force_disabled). + +find_path() -> + case application:get_env(kernel, shell_history_path) of + undefined -> filename:basedir(user_cache, "erlang-history"); + {ok, Path} -> Path + end. + +to_drop() -> + case application:get_env(kernel, shell_history_drop) of + undefined -> + application:set_env(kernel, shell_history_drop, ?DEFAULT_DROP), + ?DEFAULT_DROP; + {ok, V} when is_list(V) -> [Ln++"\n" || Ln <- V]; + {ok, _} -> ?DEFAULT_DROP + end. + +%%%%%%%%%%%%%%%%%%%%%%%% +%%% Output functions %%% +%%%%%%%%%%%%%%%%%%%%%%%% +show_rename_warning() -> + show('$#erlang-history-rename-warn', + "A history file with a different path has already " + "been started for the shell of this node. The old " + "name will keep being used for this session.~n", + []). + +show_invalid_file_warning(FileName) -> + show('$#erlang-history-invalid-file', + "Shell history expects to be able to use the file ~s " + "which currently exists and is not a file usable for " + "history logging purposes. History logging will be " + "disabled.~n", [FileName]). + +show_unexpected_warning({M,F,A}, Term) -> + show('$#erlang-history-unexpected-return', + "unexpected return value from ~p:~p/~p: ~p~n" + "shell history will be disabled for this session.~n", + [M,F,A,Term]). + +show_unexpected_close_warning() -> + show('$#erlang-history-unexpected-close', + "The shell log file has mysteriousy closed. Ignoring " + "currently unread history.~n", []). + +show_size_warning(_Current, _New) -> + show('$#erlang-history-size', + "The configured log history file size is different from " + "the size of the log file on disk.~n", []). + +show(Key, Format, Args) -> + case get(Key) of + undefined -> + io:format(standard_error, Format, Args), + put(Key, true), + ok; + true -> + ok + end. diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index 25e4ddd95c..1128ee3ec5 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -44,6 +44,7 @@ global_group, global_search, group, + group_history, heart, hipe_unified_loader, inet6_tcp, diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 7831777726..6f8e949aac 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -107,14 +107,19 @@ init_per_testcase(big_boot_embedded, Config) -> _Else -> {skip, "Needs crypto!"} end; -init_per_testcase(on_load_embedded, Config) -> +init_per_testcase(on_load_embedded, Config0) -> LibRoot = code:lib_dir(), LinkName = filename:join(LibRoot, "on_load_app-1.0"), - [{link_name,LinkName}|Config]; + Config = [{link_name,LinkName}|Config0], + init_per_testcase(Config); init_per_testcase(_Func, Config) -> + init_per_testcase(Config). + +init_per_testcase(Config) -> P = code:get_path(), [{code_path, P}|Config]. + end_per_testcase(module_status, Config) -> code:purge(?TESTMOD), code:delete(?TESTMOD), @@ -1786,6 +1791,19 @@ do_normalized_paths([]) -> %% Test that module_status/1 behaves as expected module_status(_Config) -> + case test_server:is_cover() of + true -> + module_status(); + false -> + %% Make sure that we terminate the cover server. + try + module_status() + after + cover:stop() + end + end. + +module_status() -> %% basics not_loaded = code:module_status(fubar), % nonexisting {file, preloaded} = code:is_loaded(erlang), diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl index 069df5a11d..2b11a0381f 100644 --- a/lib/kernel/test/disk_log_SUITE.erl +++ b/lib/kernel/test/disk_log_SUITE.erl @@ -2493,6 +2493,7 @@ error_repair(Conf) when is_list(Conf) -> del(File, No), ok = file:del_dir(Dir), + error_logger:add_report_handler(?MODULE, self()), %% repair a file P1 = pps(), {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, @@ -2509,6 +2510,8 @@ error_repair(Conf) when is_list(Conf) -> ok = disk_log:close(n), true = (P1 == pps()), del(File, No), + receive {info_msg, _, "disk_log: repairing" ++ _, _} -> ok + after 1000 -> ct:fail(failed) end, %% yet another repair P2 = pps(), @@ -2525,6 +2528,8 @@ error_repair(Conf) when is_list(Conf) -> ok = disk_log:close(n), true = (P2 == pps()), del(File, No), + receive {info_msg, _, "disk_log: repairing" ++ _, _} -> ok + after 1000 -> ct:fail(failed) end, %% Repair, large term Big = term_to_binary(lists:duplicate(66000,$a)), @@ -2540,6 +2545,8 @@ error_repair(Conf) when is_list(Conf) -> ok = disk_log:close(n), Got = Big, del(File, No), + receive {info_msg, _, "disk_log: repairing" ++ _, _} -> ok + after 1000 -> ct:fail(failed) end, %% A term a little smaller than a chunk, then big terms. BigSmall = mk_bytes(1024*64-8-12), @@ -2560,6 +2567,8 @@ error_repair(Conf) when is_list(Conf) -> {type, halt}, {format, internal}]), ok = disk_log:close(n), file:delete(File), + receive {info_msg, _, "disk_log: repairing" ++ _, _} -> ok + after 1000 -> ct:fail(failed) end, %% The header is recovered. {ok,n} = @@ -2573,12 +2582,13 @@ error_repair(Conf) when is_list(Conf) -> crash(File, 30), {repaired,n,{recovered,3},{badbytes,15}} = disk_log:open([{name, n}, {file, File}, {type, halt}, - {format, internal},{repair,true}, + {format, internal},{repair,true}, {quiet, true}, {head_func, {?MODULE, head_fun, [{ok,"head"}]}}]), ["head",'of',terms] = get_all_terms(n), ok = disk_log:close(n), - + error_logger:delete_report_handler(?MODULE), file:delete(File), + {messages, []} = process_info(self(), messages), ok. @@ -5007,6 +5017,9 @@ init(Tester) -> handle_event({error_report, _GL, {Pid, crash_report, Report}}, Tester) -> Tester ! {crash_report, Pid, Report}, {ok, Tester}; +handle_event({info_msg, _GL, {Pid, F,A}}, Tester) -> + Tester ! {info_msg, Pid, F, A}, + {ok, Tester}; handle_event(_Event, State) -> {ok, State}. diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl index d7a9ac39a3..bbfaa9d147 100644 --- a/lib/kernel/test/erl_distribution_SUITE.erl +++ b/lib/kernel/test/erl_distribution_SUITE.erl @@ -230,7 +230,7 @@ legal(Name) -> end. illegal(Name) -> - case test_node(Name) of + case test_node(Name, true) of not_started -> ok; started -> @@ -238,12 +238,20 @@ illegal(Name) -> end. test_node(Name) -> + test_node(Name, false). +test_node(Name, Illigal) -> ProgName = atom_to_list(lib:progname()), Command = ProgName ++ " -noinput " ++ long_or_short() ++ Name ++ - " -eval \"net_adm:ping('" ++ atom_to_list(node()) ++ "')\"", + " -eval \"net_adm:ping('" ++ atom_to_list(node()) ++ "')\"" ++ + case Illigal of + true -> + " -eval \"timer:sleep(10000),init:stop().\""; + false -> + "" + end, net_kernel:monitor_nodes(true), BinCommand = unicode:characters_to_binary(Command, utf8), - open_port({spawn, BinCommand}, [stream]), + Prt = open_port({spawn, BinCommand}, [stream]), Node = list_to_atom(Name), receive {nodeup, Node} -> diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl index 92a74465b7..3f11e25b93 100644 --- a/lib/kernel/test/gen_tcp_api_SUITE.erl +++ b/lib/kernel/test/gen_tcp_api_SUITE.erl @@ -302,9 +302,9 @@ t_implicit_inet6(Config) when is_list(Config) -> end. t_implicit_inet6(Host, Addr) -> - case gen_tcp:listen(0, [inet6]) of + Loopback = {0,0,0,0,0,0,0,1}, + case gen_tcp:listen(0, [inet6, {ip,Loopback}]) of {ok,S1} -> - Loopback = {0,0,0,0,0,0,0,1}, io:format("~s ~p~n", ["::1",Loopback]), implicit_inet6(S1, Loopback), ok = gen_tcp:close(S1), @@ -524,10 +524,10 @@ local_handshake(S, SAddr, C, CAddr) -> t_accept_inet6_tclass(Config) when is_list(Config) -> TClassOpt = {tclass,8#56 bsl 2}, % Expedited forwarding - case gen_tcp:listen(0, [inet6,TClassOpt]) of + Loopback = {0,0,0,0,0,0,0,1}, + case gen_tcp:listen(0, [inet6, {ip, Loopback}, TClassOpt]) of {ok,L} -> LPort = ok(inet:port(L)), - Loopback = {0,0,0,0,0,0,0,1}, Sa = ok(gen_tcp:connect(Loopback, LPort, [])), Sb = ok(gen_tcp:accept(L)), [TClassOpt] = ok(inet:getopts(Sb, [tclass])), diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl index 1029d7ef0a..836e0c5a05 100644 --- a/lib/kernel/test/gen_udp_SUITE.erl +++ b/lib/kernel/test/gen_udp_SUITE.erl @@ -717,9 +717,9 @@ implicit_inet6(Config) when is_list(Config) -> implicit_inet6(Host, Addr) -> Active = {active,false}, - case gen_udp:open(0, [inet6,Active]) of + Loopback = {0,0,0,0,0,0,0,1}, + case gen_udp:open(0, [inet6,Active,{ip, Loopback}]) of {ok,S1} -> - Loopback = {0,0,0,0,0,0,0,1}, io:format("~s ~p~n", ["::1",Loopback]), implicit_inet6(S1, Active, Loopback), ok = gen_udp:close(S1), diff --git a/lib/kernel/test/inet_sockopt_SUITE.erl b/lib/kernel/test/inet_sockopt_SUITE.erl index 322b9f30fe..9413cbd976 100644 --- a/lib/kernel/test/inet_sockopt_SUITE.erl +++ b/lib/kernel/test/inet_sockopt_SUITE.erl @@ -620,7 +620,7 @@ ipv6_v6only_close(Module, Socket) -> %% Test using socket option ipv6_v6only for UDP. use_ipv6_v6only_udp(Config) when is_list(Config) -> - case gen_udp:open(0, [inet6,{ipv6_v6only,true}]) of + case gen_udp:open(0, [inet6,{ip,{0,0,0,0,0,0,0,1}}, {ipv6_v6only,true}]) of {ok,S6} -> case inet:getopts(S6, [ipv6_v6only]) of {ok,[{ipv6_v6only,true}]} -> diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl index dece995d39..3b771e8c5b 100644 --- a/lib/mnesia/src/mnesia.erl +++ b/lib/mnesia/src/mnesia.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -166,7 +166,7 @@ -type select_continuation() :: term(). -type snmp_struct() :: [{atom(), snmp_type() | tuple_of(snmp_type())}]. -type snmp_type() :: 'fix_string' | 'string' | 'integer'. --type tuple_of(_) :: tuple(). +-type tuple_of(_T) :: tuple(). -define(DEFAULT_ACCESS, ?MODULE). diff --git a/lib/observer/src/etop.erl b/lib/observer/src/etop.erl index 925f4456bb..2093e6a0d7 100644 --- a/lib/observer/src/etop.erl +++ b/lib/observer/src/etop.erl @@ -180,10 +180,16 @@ stop(Opts) -> end, unregister(etop_server). -update(#opts{store=Store,node=Node,tracing=Tracing}=Opts) -> +update(#opts{store=Store,node=Node,tracing=Tracing,intv=Interval}=Opts) -> Pid = spawn_link(Node,observer_backend,etop_collect,[self()]), Info = receive {Pid,I} -> I - after 1000 -> exit(connection_lost) + after Interval -> + %% Took more than the update interval to fetch + %% data. Either the connection is lost or the + %% fetching took too long... + io:format("Timeout when waiting for process info from " + "node ~p; exiting~n", [Node]), + exit(timeout) end, #etop_info{procinfo=ProcInfo} = Info, ProcInfo1 = diff --git a/lib/observer/src/observer_alloc_wx.erl b/lib/observer/src/observer_alloc_wx.erl index 9506a2b380..ef425f0874 100644 --- a/lib/observer/src/observer_alloc_wx.erl +++ b/lib/observer/src/observer_alloc_wx.erl @@ -194,14 +194,17 @@ code_change(_, _, State) -> %%%%%%%%%% restart_fetcher(Node, #state{panel=Panel, wins=Wins0, time=Ti} = State) -> - SysInfo = observer_wx:try_rpc(Node, observer_backend, sys_info, []), - Info = alloc_info(SysInfo), - Max = lists:foldl(fun calc_max/2, #{}, Info), - {Wins, Samples} = add_data(Info, {0, queue:new()}, Wins0, Ti, true), - erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, 0}), - wxWindow:refresh(Panel), - precalc(State#state{active=true, appmon=Node, time=Ti#ti{tick=0}, - wins=Wins, samples=Samples, max=Max}). + case rpc:call(Node, observer_backend, sys_info, []) of + {badrpc, _} -> State; + SysInfo -> + Info = alloc_info(SysInfo), + Max = lists:foldl(fun calc_max/2, #{}, Info), + {Wins, Samples} = add_data(Info, {0, queue:new()}, Wins0, Ti, true), + erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, 0}), + wxWindow:refresh(Panel), + precalc(State#state{active=true, appmon=Node, time=Ti#ti{tick=0}, + wins=Wins, samples=Samples, max=Max}) + end. precalc(#state{samples=Data0, paint=Paint, time=Ti, wins=Wins0}=State) -> Wins = [precalc(Ti, Data0, Paint, Win) || Win <- Wins0], diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 4145a8d961..7352af936c 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -173,13 +173,13 @@ fill_info([{Str,Attrib,Key}|Rest], Data) when is_atom(Key); is_function(Key) -> Value -> [{Str,Attrib,Value} | fill_info(Rest, Data)] end; fill_info([{Str, {Format, Key}}|Rest], Data) - when is_atom(Key); is_function(Key), is_atom(Format) -> + when is_atom(Key); is_function(Key) -> case get_value(Key, Data) of undefined -> [undefined | fill_info(Rest, Data)]; Value -> [{Str, {Format, Value}} | fill_info(Rest, Data)] end; fill_info([{Str, Attrib, {Format, Key}}|Rest], Data) - when is_atom(Key); is_function(Key), is_atom(Format) -> + when is_atom(Key); is_function(Key) -> case get_value(Key, Data) of undefined -> [undefined | fill_info(Rest, Data)]; Value -> [{Str, Attrib, {Format, Value}} | fill_info(Rest, Data)] @@ -252,6 +252,8 @@ to_str({bytes, B}) -> KB > 0 -> integer_to_list(KB) ++ " kB"; true -> integer_to_list(B) ++ " B" end; +to_str({{words,WSz}, Sz}) -> + to_str({bytes, WSz*Sz}); to_str({time_ms, MS}) -> S = MS div 1000, Min = S div 60, diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl index ffa6f6d3b4..3083297f31 100644 --- a/lib/observer/src/observer_pro_wx.erl +++ b/lib/observer/src/observer_pro_wx.erl @@ -67,12 +67,14 @@ -record(holder, {parent, info, - etop, + next=[], sort=#sort{}, accum=[], + next_accum=[], attrs, node, - backend_pid + backend_pid, + old_backend=false }). -record(state, {parent, @@ -226,7 +228,7 @@ handle_info({holder_updated, Count}, State0=#state{grid=Grid}) -> wxListCtrl:setItemCount(Grid, Count), Count > 0 andalso wxListCtrl:refreshItems(Grid, 0, Count-1), - + observer_wx:set_status(io_lib:format("Number of Processes: ~w", [Count])), {noreply, State}; handle_info(refresh_interval, #state{holder=Holder}=State) -> @@ -459,13 +461,13 @@ rm_selected(_, [], [], AccIds, AccPids) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%TABLE HOLDER%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% init_table_holder(Parent, Accum0, Attrs) -> - Backend = spawn_link(node(), observer_backend,etop_collect,[self()]), + process_flag(trap_exit, true), + Backend = spawn_link(node(), observer_backend, procs_info, [self()]), Accum = case Accum0 of true -> true; false -> [] end, table_holder(#holder{parent=Parent, - etop=#etop_info{}, info=array:new(), node=node(), backend_pid=Backend, @@ -474,7 +476,7 @@ init_table_holder(Parent, Accum0, Attrs) -> }). table_holder(#holder{info=Info, attrs=Attrs, - node=Node, backend_pid=Backend}=S0) -> + node=Node, backend_pid=Backend, old_backend=Old}=S0) -> receive {get_row, From, Row, Col} -> get_row(From, Row, Col, Info), @@ -482,14 +484,25 @@ table_holder(#holder{info=Info, attrs=Attrs, {get_attr, From, Row} -> get_attr(From, Row, Attrs), table_holder(S0); + {procs_info, Backend, Procs} -> + State = handle_update(Procs, S0), + table_holder(State); + {'EXIT', Backend, normal} when Old =:= false -> + S1 = update_complete(S0), + table_holder(S1#holder{backend_pid=undefined}); {Backend, EtopInfo=#etop_info{}} -> - State = handle_update(EtopInfo, S0), + State = handle_update_old(EtopInfo, S0), table_holder(State#holder{backend_pid=undefined}); refresh when is_pid(Backend)-> table_holder(S0); %% Already updating refresh -> - Pid = spawn_link(Node,observer_backend,etop_collect,[self()]), - table_holder(S0#holder{backend_pid=Pid}); + Pid = case Old of + true -> + spawn_link(Node, observer_backend, etop_collect, [self()]); + false -> + spawn_link(Node, observer_backend, procs_info, [self()]) + end, + table_holder(S0#holder{backend_pid=Pid}); {change_sort, Col} -> State = change_sort(Col, S0), table_holder(State); @@ -502,7 +515,6 @@ table_holder(#holder{info=Info, attrs=Attrs, {get_name_or_pid, From, Indices} -> get_name_or_pid(From, Indices, Info), table_holder(S0); - {get_node, From} -> From ! {self(), Node}, table_holder(S0); @@ -511,36 +523,50 @@ table_holder(#holder{info=Info, attrs=Attrs, true -> table_holder(S0); false -> - self() ! refresh, - table_holder(S0#holder{node=NewNode}) - end; + _ = rpc:call(NewNode, code, ensure_loaded, [observer_backend]), + case rpc:call(NewNode, erlang, function_exported, + [observer_backend,procs_info, 1]) of + true -> + self() ! refresh, + table_holder(S0#holder{node=NewNode, old_backend=false}); + false -> + self() ! refresh, + table_holder(S0#holder{node=NewNode, old_backend=true}); + _ -> + table_holder(S0) + end + end; {accum, Bool} -> table_holder(change_accum(Bool,S0)); {get_accum, From} -> From ! {self(), S0#holder.accum == true}, table_holder(S0); {dump, Fd} -> - EtopInfo = (S0#holder.etop)#etop_info{procinfo=array:to_list(Info)}, - %% The empty #etop_info{} below is a dummy previous info - %% value. It is used by etop to calculate the scheduler - %% utilization since last update. When dumping to file, - %% there is no previous measurement to use, so we just add - %% a dummy here, and the value shown will be since the - %% tool was started. - etop_txt:do_update(Fd, EtopInfo, #etop_info{}, #opts{node=Node}), - file:close(Fd), - table_holder(S0); + Collector = spawn_link(Node, observer_backend, etop_collect,[self()]), + receive + {Collector, EtopInfo=#etop_info{}} -> + etop_txt:do_update(Fd, EtopInfo, #etop_info{}, #opts{node=Node}), + file:close(Fd), + table_holder(S0); + {'EXIT', Collector, _} -> + table_holder(S0) + end; stop -> ok; - What -> - io:format("Table holder got ~p~n",[What]), + {'EXIT', Backend, normal} -> + table_holder(S0); + {'EXIT', Backend, _Reason} -> + %% Node crashed will be noticed soon.. + table_holder(S0#holder{backend_pid=undefined}); + _What -> + %% io:format("~p: Table holder got ~p~n",[?MODULE, _What]), table_holder(S0) end. change_sort(Col, S0=#holder{parent=Parent, info=Data, sort=Sort0}) -> {Sort, ProcInfo}=sort(Col, Sort0, Data), Parent ! {holder_updated, array:size(Data)}, - S0#holder{info=ProcInfo, sort=Sort}. + S0#holder{info=array:from_list(ProcInfo), sort=Sort}. change_accum(true, S0) -> S0#holder{accum=true}; @@ -548,23 +574,45 @@ change_accum(false, S0=#holder{info=Info}) -> self() ! refresh, S0#holder{accum=lists:sort(array:to_list(Info))}. -handle_update(EI=#etop_info{procinfo=ProcInfo0}, - S0=#holder{parent=Parent, sort=Sort=#sort{sort_key=KeyField}}) -> - {ProcInfo1, S1} = accum(ProcInfo0, S0), +handle_update_old(#etop_info{procinfo=ProcInfo0}, + S0=#holder{parent=Parent, sort=Sort=#sort{sort_key=KeyField}}) -> + {ProcInfo1, Accum} = accum(ProcInfo0, S0), {_SO, ProcInfo} = sort(KeyField, Sort#sort{sort_key=undefined}, ProcInfo1), - Parent ! {holder_updated, array:size(ProcInfo)}, - S1#holder{info=ProcInfo, etop=EI#etop_info{procinfo=[]}}. + Info = array:from_list(ProcInfo), + Parent ! {holder_updated, array:size(Info)}, + S0#holder{info=Info, accum=Accum}. + +handle_update(ProcInfo0, S0=#holder{next=Next, sort=#sort{sort_key=KeyField}}) -> + {ProcInfo1, Accum} = accum(ProcInfo0, S0), + Sort = sort_fun(KeyField, true), + Merge = merge_fun(KeyField), + Merged = Merge(Sort(ProcInfo1), Next), + case Accum of + true -> S0#holder{next=Merged}; + _List -> S0#holder{next=Merged, next_accum=Accum} + end. -accum(ProcInfo, State=#holder{accum=true}) -> - {ProcInfo, State}; -accum(ProcInfo0, State=#holder{accum=Previous}) -> +update_complete(#holder{parent=Parent, sort=#sort{sort_incr=Incr}, + next=ProcInfo, accum=Accum, next_accum=NextAccum}=S0) -> + Info = case Incr of + true -> array:from_list(ProcInfo); + false -> array:from_list(lists:reverse(ProcInfo)) + end, + Parent ! {holder_updated, array:size(Info)}, + S0#holder{info=Info, accum= Accum =:= true orelse NextAccum, + next=[], next_accum=[]}. + +accum(ProcInfo, #holder{accum=true}) -> + {ProcInfo, true}; +accum(ProcInfo0, #holder{accum=Previous, next_accum=Next}) -> + Accum = [{Pid, Reds} || #etop_proc_info{pid=Pid, reds=Reds} <- ProcInfo0], ProcInfo = lists:sort(ProcInfo0), - {accum2(ProcInfo,Previous,[]), State#holder{accum=ProcInfo}}. + {accum2(ProcInfo,Previous,[]), lists:merge(lists:sort(Accum), Next)}. -accum2([PI=#etop_proc_info{pid=Pid, reds=Reds, runtime=RT}|PIs], - [#etop_proc_info{pid=Pid, reds=OldReds, runtime=OldRT}|Old], Acc) -> - accum2(PIs, Old, [PI#etop_proc_info{reds=Reds-OldReds, runtime=RT-OldRT}|Acc]); -accum2(PIs=[#etop_proc_info{pid=Pid}|_], [#etop_proc_info{pid=OldPid}|Old], Acc) +accum2([PI=#etop_proc_info{pid=Pid, reds=Reds}|PIs], + [{Pid, OldReds}|Old], Acc) -> + accum2(PIs, Old, [PI#etop_proc_info{reds=Reds-OldReds}|Acc]); +accum2(PIs=[#etop_proc_info{pid=Pid}|_], [{OldPid,_}|Old], Acc) when Pid > OldPid -> accum2(PIs, Old, Acc); accum2([PI|PIs], Old, Acc) -> @@ -575,14 +623,52 @@ sort(Col, Opt, Table) when not is_list(Table) -> sort(Col,Opt,array:to_list(Table)); sort(Col, Opt=#sort{sort_key=Col, sort_incr=Bool}, Table) -> - {Opt#sort{sort_incr=not Bool}, - array:from_list(lists:reverse(Table))}; -sort(Col, S=#sort{sort_incr=true}, Table) -> - {S#sort{sort_key=Col}, - array:from_list(lists:keysort(col_to_element(Col), Table))}; -sort(Col, S=#sort{sort_incr=false}, Table) -> - {S#sort{sort_key=Col}, - array:from_list(lists:reverse(lists:keysort(col_to_element(Col), Table)))}. + {Opt#sort{sort_incr=not Bool},lists:reverse(Table)}; +sort(Col, S=#sort{sort_incr=Incr}, Table) -> + Sort = sort_fun(Col, Incr), + {S#sort{sort_key=Col}, Sort(Table)}. + +sort_fun(?COL_NAME, true) -> + fun(Table) -> lists:sort(fun sort_name/2, Table) end; +sort_fun(?COL_NAME, false) -> + fun(Table) -> lists:sort(fun sort_name_rev/2, Table) end; +sort_fun(Col, true) -> + N = col_to_element(Col), + fun(Table) -> lists:keysort(N, Table) end; +sort_fun(Col, false) -> + N = col_to_element(Col), + fun(Table) -> lists:reverse(lists:keysort(N, Table)) end. + +merge_fun(?COL_NAME) -> + fun(A,B) -> lists:merge(fun sort_name/2, A, B) end; +merge_fun(Col) -> + KeyField = col_to_element(Col), + fun(A,B) -> lists:keymerge(KeyField, A, B) end. + + +sort_name(#etop_proc_info{name={_,_,_}=A}, #etop_proc_info{name={_,_,_}=B}) -> + A =< B; +sort_name(#etop_proc_info{name=A}, #etop_proc_info{name=B}) + when is_atom(A), is_atom(B) -> + A =< B; +sort_name(#etop_proc_info{name=Reg}, #etop_proc_info{name={M,_F,_A}}) + when is_atom(Reg) -> + Reg < M; +sort_name(#etop_proc_info{name={M,_,_}}, #etop_proc_info{name=Reg}) + when is_atom(Reg) -> + M < Reg. + +sort_name_rev(#etop_proc_info{name={_,_,_}=A}, #etop_proc_info{name={_,_,_}=B}) -> + A >= B; +sort_name_rev(#etop_proc_info{name=A}, #etop_proc_info{name=B}) + when is_atom(A), is_atom(B) -> + A >= B; +sort_name_rev(#etop_proc_info{name=Reg}, #etop_proc_info{name={M,_F,_A}}) + when is_atom(Reg) -> + Reg >= M; +sort_name_rev(#etop_proc_info{name={M,_,_}}, #etop_proc_info{name=Reg}) + when is_atom(Reg) -> + M >= Reg. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 8d19d77488..10decd8b62 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -198,10 +198,11 @@ code_change(_, _, State) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% init_process_page(Panel, Pid) -> - Fields0 = process_info_fields(Pid), + WSz = observer_wx:try_rpc(node(Pid), erlang, system_info,[wordsize]), + Fields0 = process_info_fields(Pid, WSz), {FPanel, _, UpFields} = observer_lib:display_info(Panel, Fields0), {FPanel, fun() -> - Fields = process_info_fields(Pid), + Fields = process_info_fields(Pid, WSz), observer_lib:update_info(UpFields, Fields) end}. @@ -359,7 +360,7 @@ create_menus(MenuBar) -> {"View", [#create_menu{id=?REFRESH, text="Refresh\tCtrl-R"}]}], observer_lib:create_menus(Menus, MenuBar, new_window). -process_info_fields(Pid) -> +process_info_fields(Pid, WSz) -> Struct = [{"Overview", [{"Initial Call", initial_call}, {"Current Function", current_function}, @@ -383,10 +384,10 @@ process_info_fields(Pid) -> {"Monitored by", {click, monitored_by}}]}, {"Memory and Garbage Collection", right, [{"Memory", {bytes, memory}}, - {"Stack and Heaps", {bytes, total_heap_size}}, - {"Heap Size", {bytes, heap_size}}, - {"Stack Size", {bytes, stack_size}}, - {"GC Min Heap Size", {bytes, get_gc_info(min_heap_size)}}, + {"Stack and Heaps", {{words,WSz}, total_heap_size}}, + {"Heap Size", {{words,WSz}, heap_size}}, + {"Stack Size", {{words,WSz}, stack_size}}, + {"GC Min Heap Size", {{words,WSz}, get_gc_info(min_heap_size)}}, {"GC FullSweep After", get_gc_info(fullsweep_after)} ]}], case observer_wx:try_rpc(node(Pid), erlang, process_info, [Pid, item_list()]) of diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl index 739761e7fd..9b9e80f479 100644 --- a/lib/observer/src/observer_wx.erl +++ b/lib/observer/src/observer_wx.erl @@ -143,7 +143,8 @@ setup(#state{frame = Frame} = State) -> wxFrame:setTitle(Frame, atom_to_list(node())), wxStatusBar:setStatusText(StatusBar, atom_to_list(node())), - wxNotebook:connect(Notebook, command_notebook_page_changed, [{skip, true}]), + wxNotebook:connect(Notebook, command_notebook_page_changed, + [{skip, true}, {id, ?ID_NOTEBOOK}]), wxFrame:connect(Frame, close_window, []), wxMenu:connect(Frame, command_menu_selected), wxFrame:show(Frame), @@ -230,12 +231,13 @@ setup(#state{frame = Frame} = State) -> %%Callbacks handle_event(#wx{event=#wxNotebook{type=command_notebook_page_changed, nSel=Next}}, - #state{active_tab=Previous, node=Node, panels=Panels} = State) -> + #state{active_tab=Previous, node=Node, panels=Panels, status_bar=SB} = State) -> {_, Obj, _} = lists:nth(Next+1, Panels), case wx_object:get_pid(Obj) of Previous -> {noreply, State}; Pid -> + wxStatusBar:setStatusText(SB, ""), Previous ! not_active, Pid ! {active, Node}, {noreply, State#state{active_tab=Pid}} diff --git a/lib/orber/test/multi_ORB_SUITE.erl b/lib/orber/test/multi_ORB_SUITE.erl index d739e47cc1..8becc11d6a 100644 --- a/lib/orber/test/multi_ORB_SUITE.erl +++ b/lib/orber/test/multi_ORB_SUITE.erl @@ -135,13 +135,12 @@ cases() -> setup_multi_connection_timeout_api, setup_multi_connection_timeout_attempts_api, setup_multi_connection_timeout_random_api, - ssl_1_multi_orber_api, ssl_1_multi_orber_generation_3_api, - ssl_2_multi_orber_api, ssl_2_multi_orber_generation_3_api, - ssl_reconfigure_api, ssl_reconfigure_generation_3_api]. +% ssl_1_multi_orber_api,ssl_2_multi_orber_api,ssl_reconfigure_api, + %%----------------------------------------------------------------- %% Init and cleanup functions. %%----------------------------------------------------------------- diff --git a/lib/orber/test/orber_test_lib.erl b/lib/orber/test/orber_test_lib.erl index 95ab26cd30..4a247ce492 100644 --- a/lib/orber/test/orber_test_lib.erl +++ b/lib/orber/test/orber_test_lib.erl @@ -356,11 +356,17 @@ get_options(ssl, Role, Level) -> get_options(ssl, Role, 2, Options) -> Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]), - [{depth, 2}, - {verify, 2}, - {keyfile, filename:join([Dir, Role, "key.pem"])}, - {cacertfile, filename:join([Dir, Role, "cacerts.pem"])}, - {certfile, filename:join([Dir, Role, "cert.pem"])} |Options]; + Options1 = [{depth, 2}, + {verify, 2}, + {keyfile, filename:join([Dir, Role, "key.pem"])}, + {cacertfile, filename:join([Dir, Role, "cacerts.pem"])}, + {certfile, filename:join([Dir, Role, "cert.pem"])} |Options], + case Role of + client -> + [{server_name_indication, disable} |Options1]; + server -> + Options1 + end; get_options(iiop_ssl, _Role, 2, Options) -> Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]), [{ssl_server_options, [{depth, 2}, @@ -369,10 +375,11 @@ get_options(iiop_ssl, _Role, 2, Options) -> {cacertfile, filename:join([Dir, "server", "cacerts.pem"])}, {keyfile, filename:join([Dir, "server", "key.pem"])}]}, {ssl_client_options, [{depth, 2}, - {verify, 2}, - {certfile, filename:join([Dir, "client", "cert.pem"])}, - {cacertfile, filename:join([Dir, "client", "cacerts.pem"])}, - {keyfile, filename:join([Dir, "client", "key.pem"])}]}, + {verify, 2}, + {server_name_indication, disable}, + {certfile, filename:join([Dir, "client", "cert.pem"])}, + {cacertfile, filename:join([Dir, "client", "cacerts.pem"])}, + {keyfile, filename:join([Dir, "client", "key.pem"])}]}, {secure, ssl} |Options]; get_options(iiop_ssl, _Role, 1, Options) -> Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]), @@ -382,10 +389,11 @@ get_options(iiop_ssl, _Role, 1, Options) -> {cacertfile, filename:join([Dir, "server", "cacerts.pem"])}, {keyfile, filename:join([Dir, "server", "key.pem"])}]}, {ssl_client_options, [{depth, 1}, - {verify, 0}, - {certfile, filename:join([Dir, "client", "cert.pem"])}, - {cacertfile, filename:join([Dir, "client", "cacerts.pem"])}, - {keyfile, filename:join([Dir, "client", "key.pem"])}]}, + {verify, 0}, + {server_name_indication, disable}, + {certfile, filename:join([Dir, "client", "cert.pem"])}, + {cacertfile, filename:join([Dir, "client", "cacerts.pem"])}, + {keyfile, filename:join([Dir, "client", "key.pem"])}]}, {secure, ssl} |Options]. create_paths() -> diff --git a/lib/public_key/src/pubkey_ssh.erl b/lib/public_key/src/pubkey_ssh.erl index 6974afa992..9bda76d670 100644 --- a/lib/public_key/src/pubkey_ssh.erl +++ b/lib/public_key/src/pubkey_ssh.erl @@ -408,10 +408,11 @@ comma_list_encode([Option | Rest], Acc) -> comma_list_encode(Rest, Acc ++ "," ++ Option). -%% An experimental fix adding the signature algorithm name as the last element in a tuple... - ssh2_pubkey_encode(#'RSAPublicKey'{modulus = N, publicExponent = E}) -> ssh2_pubkey_encode({#'RSAPublicKey'{modulus = N, publicExponent = E}, 'ssh-rsa'}); + +ssh2_pubkey_encode({Key, 'rsa-sha2-256'}) -> ssh2_pubkey_encode({Key, 'ssh-rsa'}); +ssh2_pubkey_encode({Key, 'rsa-sha2-512'}) -> ssh2_pubkey_encode({Key, 'ssh-rsa'}); ssh2_pubkey_encode({#'RSAPublicKey'{modulus = N, publicExponent = E}, SignAlg}) -> SignAlgName = list_to_binary(atom_to_list(SignAlg)), StrLen = size(SignAlgName), @@ -448,16 +449,12 @@ ssh2_pubkey_encode(Key={#'ECPoint'{point = Q}, {namedCurve,OID}}) -> ssh2_pubkey_decode(Bin = <<?UINT32(Len), Type:Len/binary, _/binary>>) -> ssh2_pubkey_decode(Type, Bin). -%% An experimental fix with the Signature Algorithm Name -ssh2_pubkey_decode(SignAlgName, +ssh2_pubkey_decode(<<"rsa-sha2-256">>, Bin) -> ssh2_pubkey_decode(<<"ssh-rsa">>, Bin); +ssh2_pubkey_decode(<<"rsa-sha2-512">>, Bin) -> ssh2_pubkey_decode(<<"ssh-rsa">>, Bin); +ssh2_pubkey_decode(<<"ssh-rsa">>, <<?UINT32(Len), _:Len/binary, ?UINT32(SizeE), E:SizeE/binary, - ?UINT32(SizeN), N:SizeN/binary>>) - when SignAlgName == <<"ssh-rsa">> ; - SignAlgName == <<"rsa-sha2-256">> ; - SignAlgName == <<"rsa-sha2-384">> ; - SignAlgName == <<"rsa-sha2-512">> - -> + ?UINT32(SizeN), N:SizeN/binary>>) -> #'RSAPublicKey'{modulus = erlint(SizeN, N), publicExponent = erlint(SizeE, E)}; @@ -471,6 +468,7 @@ ssh2_pubkey_decode(<<"ssh-dss">>, #'Dss-Parms'{p = erlint(SizeP, P), q = erlint(SizeQ, Q), g = erlint(SizeG, G)}}; + ssh2_pubkey_decode(<<"ecdsa-sha2-",Id/binary>>, <<?UINT32(Len), ECDSA_SHA2_etc:Len/binary, ?UINT32(SizeId), Id:SizeId/binary, diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index 1e0d2d642e..d36af257ce 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -23,7 +23,7 @@ -export([vsn/0]). %% observer stuff --export([sys_info/0, get_port_list/0, +-export([sys_info/0, get_port_list/0, procs_info/1, get_table/3, get_table_list/2, fetch_stats/2]). %% etop stuff @@ -293,6 +293,23 @@ fetch_stats_loop(Parent, Time) -> try erlang:memory() catch _:_ -> [] end}, fetch_stats_loop(Parent, Time) end. + +%% +%% Chunk sending process info to etop/observer +%% +procs_info(Collector) -> + All = processes(), + Send = fun Send (Pids) -> + try lists:split(10000, Pids) of + {First, Rest} -> + Collector ! {procs_info, self(), etop_collect(First, [])}, + Send(Rest) + catch _:_ -> + Collector ! {procs_info, self(), etop_collect(Pids, [])} + end + end, + Send(All). + %% %% etop backend %% diff --git a/lib/sasl/src/sasl_report.erl b/lib/sasl/src/sasl_report.erl index 14702b0ad2..eb454155d5 100644 --- a/lib/sasl/src/sasl_report.erl +++ b/lib/sasl/src/sasl_report.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -68,12 +68,12 @@ write_report2(IO, Fd, Head, progress, Report) -> Format = format_key_val(Report), write_report_action(IO, Fd, Head, "~s", [Format]); write_report2(IO, Fd, Head, crash_report, Report) -> - Depth = get_depth(), + Depth = error_logger:get_format_depth(), Format = proc_lib:format(Report, latin1, Depth), write_report_action(IO, Fd, Head, "~s", [Format]). supervisor_format(Args0) -> - case get_depth() of + case error_logger:get_format_depth() of unlimited -> {" Supervisor: ~p~n" " Context: ~p~n" @@ -102,14 +102,6 @@ format_key_val([{Tag,Data}|Rep]) -> format_key_val(_) -> []. -get_depth() -> - case application:get_env(kernel, error_logger_format_depth) of - {ok, Depth} when is_integer(Depth) -> - max(10, Depth); - undefined -> - unlimited - end. - sup_get(Tag, Report) -> case lists:keysearch(Tag, 1, Report) of {value, {_, Value}} -> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 84b7cdd7a1..5c9ce3d5fb 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -246,10 +246,12 @@ <tag><c><![CDATA[{pref_public_key_algs, list()}]]></c></tag> <item> <p>List of user (client) public key algorithms to try to use.</p> - <p>The default value is - <c><![CDATA[['ssh-rsa','ssh-dss','ecdsa-sha2-nistp256','ecdsa-sha2-nistp384','ecdsa-sha2-nistp521'] ]]></c> + <p>The default value is the <c>public_key</c> entry in + <seealso marker="#default_algorithms/0">ssh:default_algorithms/0</seealso>. + </p> + <p>If there is no public key of a specified type available, the corresponding entry is ignored. + Note that the available set is dependent on the underlying cryptolib and current user's public keys. </p> - <p>If there is no public key of a specified type available, the corresponding entry is ignored.</p> </item> <tag><c><![CDATA[{preferred_algorithms, algs_list()}]]></c></tag> @@ -293,6 +295,15 @@ connection. For <c>gen_tcp</c> the time is in milli-seconds and the default value is <c>infinity</c>.</p> </item> + + <tag><c><![CDATA[{auth_methods, string()}]]></c></tag> + <item> + <p>Comma-separated string that determines which + authentication methods that the client shall support and + in which order they are tried. Defaults to + <c><![CDATA["publickey,keyboard-interactive,password"]]></c></p> + </item> + <tag><c><![CDATA[{user, string()}]]></c></tag> <item> <p>Provides a username. If this option is not given, <c>ssh</c> @@ -300,6 +311,7 @@ <c><![CDATA[USER]]></c> on UNIX, <c><![CDATA[USERNAME]]></c> on Windows).</p> </item> + <tag><c><![CDATA[{password, string()}]]></c></tag> <item> <p>Provides a password for password authentication. @@ -307,6 +319,7 @@ password, if the password authentication method is attempted.</p> </item> + <tag><c><![CDATA[{key_cb, key_cb()}]]></c></tag> <item> <p>Module implementing the behaviour <seealso @@ -316,6 +329,7 @@ module via the options passed to it under the key 'key_cb_private'. </p> </item> + <tag><c><![CDATA[{quiet_mode, atom() = boolean()}]]></c></tag> <item> <p>If <c>true</c>, the client does not print anything on authorization.</p> @@ -466,6 +480,7 @@ authentication methods that the server is to support and in what order they are tried. Defaults to <c><![CDATA["publickey,keyboard-interactive,password"]]></c></p> + <p>Note that the client is free to use any order and to exclude methods.</p> </item> <tag><c><![CDATA[{auth_method_kb_interactive_data, PromptTexts}]]></c> diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 342583306b..f1ce337947 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -346,7 +346,7 @@ renegotiate_data(ConnectionHandler) -> | undefined, last_size_rekey = 0 :: non_neg_integer(), event_queue = [] :: list(), - opts :: ssh_options:options(), +% opts :: ssh_options:options(), inet_initial_recbuf_size :: pos_integer() | undefined }). @@ -398,8 +398,7 @@ init([Role,Socket,Opts]) -> transport_protocol = Protocol, transport_cb = Callback, transport_close_tag = CloseTag, - ssh_params = init_ssh_record(Role, Socket, PeerAddr, Opts), - opts = Opts + ssh_params = init_ssh_record(Role, Socket, PeerAddr, Opts) }, D = case Role of client -> @@ -434,11 +433,7 @@ init_ssh_record(Role, Socket, Opts) -> init_ssh_record(Role, _Socket, PeerAddr, Opts) -> KeyCb = ?GET_OPT(key_cb, Opts), - AuthMethods = - case Role of - server -> ?GET_OPT(auth_methods, Opts); - client -> undefined - end, + AuthMethods = ?GET_OPT(auth_methods, Opts), S0 = #ssh{role = Role, key_cb = KeyCb, opts = Opts, @@ -1016,7 +1011,7 @@ handle_event(cast, renegotiate, _, _) -> handle_event(cast, data_size, {connected,Role}, D) -> {ok, [{send_oct,Sent0}]} = inet:getstat(D#data.socket, [send_oct]), Sent = Sent0 - D#data.last_size_rekey, - MaxSent = ?GET_OPT(rekey_limit, D#data.opts), + MaxSent = ?GET_OPT(rekey_limit, (D#data.ssh_params)#ssh.opts), timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), case Sent >= MaxSent of true -> @@ -1705,15 +1700,23 @@ handle_ssh_msg_ext_info(#ssh_msg_ext_info{data=Data}, D0) -> lists:foldl(fun ext_info/2, D0, Data). -ext_info({"server-sig-algs",SigAlgs}, D0 = #data{ssh_params=#ssh{role=client}=Ssh0}) -> +ext_info({"server-sig-algs",SigAlgs}, D0 = #data{ssh_params=#ssh{role=client, + userauth_pubkeys=ClientSigAlgs}=Ssh0}) -> %% Make strings to eliminate risk of beeing bombed with odd strings that fills the atom table: SupportedAlgs = lists:map(fun erlang:atom_to_list/1, ssh_transport:supported_algorithms(public_key)), - Ssh = Ssh0#ssh{userauth_pubkeys = - [list_to_atom(SigAlg) || SigAlg <- string:tokens(SigAlgs,","), - %% length of SigAlg is implicitly checked by member: - lists:member(SigAlg, SupportedAlgs) - ]}, - D0#data{ssh_params = Ssh}; + ServerSigAlgs = [list_to_atom(SigAlg) || SigAlg <- string:tokens(SigAlgs,","), + %% length of SigAlg is implicitly checked by the comparison + %% in member/2: + lists:member(SigAlg, SupportedAlgs) + ], + CommonAlgs = [Alg || Alg <- ServerSigAlgs, + lists:member(Alg, ClientSigAlgs)], + SelectedAlgs = + case CommonAlgs of + [] -> ClientSigAlgs; % server-sig-algs value is just an advice + _ -> CommonAlgs + end, + D0#data{ssh_params = Ssh0#ssh{userauth_pubkeys = SelectedAlgs} }; ext_info(_, D0) -> %% Not implemented @@ -1863,7 +1866,7 @@ get_repl(X, Acc) -> exit({get_repl,X,Acc}). %%%---------------------------------------------------------------- --define(CALL_FUN(Key,D), catch (?GET_OPT(Key, D#data.opts)) ). +-define(CALL_FUN(Key,D), catch (?GET_OPT(Key, (D#data.ssh_params)#ssh.opts)) ). disconnect_fun({disconnect,Msg}, D) -> ?CALL_FUN(disconnectfun,D)(Msg); disconnect_fun(Reason, D) -> ?CALL_FUN(disconnectfun,D)(Reason). @@ -1913,7 +1916,7 @@ retry_fun(User, Reason, #data{ssh_params = #ssh{opts = Opts, %%% channels open for a while. cache_init_idle_timer(D) -> - case ?GET_OPT(idle_time, D#data.opts) of + case ?GET_OPT(idle_time, (D#data.ssh_params)#ssh.opts) of infinity -> D#data{idle_timer_value = infinity, idle_timer_ref = infinity % A flag used later... diff --git a/lib/ssh/src/ssh_dbg.erl b/lib/ssh/src/ssh_dbg.erl index 7dfbfc3b4b..003b3856e6 100644 --- a/lib/ssh/src/ssh_dbg.erl +++ b/lib/ssh/src/ssh_dbg.erl @@ -22,9 +22,10 @@ -module(ssh_dbg). --export([messages/0, - messages/1, - messages/2, +-export([messages/0, messages/1, messages/2, + ct_messages/0, + auth/0, auth/1, auth/2, + ct_auth/0, stop/0 ]). @@ -43,75 +44,167 @@ messages() -> messages(fun(String,_D) -> io:format(String) end). +ct_messages() -> + messages(fun(String,_D) -> ct:log(String,[]) end). + messages(Write) when is_function(Write,2) -> messages(Write, fun(X) -> X end). messages(Write, MangleArg) when is_function(Write,2), is_function(MangleArg,1) -> - catch dbg:start(), - setup_tracer(Write, MangleArg), - dbg:p(new,[c,timestamp]), - dbg_ssh_messages(). + cond_start(msg, Write, MangleArg), + dbg_ssh_messages(), + dbg_ssh_auth(). + + +auth() -> + auth(fun(String,_D) -> io:format(String) end). + +ct_auth() -> + auth(fun(String,_D) -> ct:log(String,[]) end). + +auth(Write) when is_function(Write,2) -> + auth(Write, fun(X) -> X end). + +auth(Write, MangleArg) when is_function(Write,2), + is_function(MangleArg,1) -> + cond_start(auth, Write, MangleArg), + dbg_ssh_auth(). + dbg_ssh_messages() -> dbg:tp(ssh_message,encode,1, x), dbg:tp(ssh_message,decode,1, x), dbg:tpl(ssh_transport,select_algorithm,4, x), dbg:tp(ssh_transport,hello_version_msg,1, x), - dbg:tp(ssh_transport,handle_hello_version,1, x). + dbg:tp(ssh_transport,handle_hello_version,1, x), + dbg:tpl(ssh_connection_handler,ext_info,2, x). + +dbg_ssh_auth() -> + dbg:tp(ssh_transport,hello_version_msg,1, x), + dbg:tp(ssh_transport,handle_hello_version,1, x), + dbg:tp(ssh_message,encode,1, x), + dbg:tpl(ssh_transport,select_algorithm,4, x), + dbg:tpl(ssh_connection_handler,ext_info,2, x), + lists:foreach(fun(F) -> dbg:tp(ssh_auth, F, x) end, + [publickey_msg, password_msg, keyboard_interactive_msg]). %%%---------------------------------------------------------------- stop() -> dbg:stop(). %%%================================================================ -msg_formater({trace_ts,Pid,call,{ssh_message,encode,[Msg]},TS}, D) -> +cond_start(Type, Write, MangleArg) -> + try + dbg:start(), + setup_tracer(Type, Write, MangleArg), + dbg:p(new,[c,timestamp]) + catch + _:_ -> ok + end. + + +msg_formater(msg, {trace_ts,Pid,call,{ssh_message,encode,[Msg]},TS}, D) -> fmt("~n~s SEND ~p ~s~n", [ts(TS),Pid,wr_record(shrink_bin(Msg))], D); -msg_formater({trace_ts,_Pid,return_from,{ssh_message,encode,1},_Res,_TS}, D) -> +msg_formater(msg, {trace_ts,_Pid,return_from,{ssh_message,encode,1},_Res,_TS}, D) -> D; -msg_formater({trace_ts,_Pid,call,{ssh_message,decode,_},_TS}, D) -> +msg_formater(msg, {trace_ts,_Pid,call,{ssh_message,decode,_},_TS}, D) -> D; -msg_formater({trace_ts,Pid,return_from,{ssh_message,decode,1},Msg,TS}, D) -> +msg_formater(msg, {trace_ts,Pid,return_from,{ssh_message,decode,1},Msg,TS}, D) -> fmt("~n~s ~p RECV ~s~n", [ts(TS),Pid,wr_record(shrink_bin(Msg))], D); + +msg_formater(auth, {trace_ts,Pid,return_from,{ssh_message,decode,1},#ssh_msg_userauth_failure{authentications=As},TS}, D) -> + fmt("~n~s ~p Client login FAILURE. Try ~s~n", [ts(TS),Pid,As], D); + +msg_formater(auth, {trace_ts,Pid,return_from,{ssh_message,decode,1},#ssh_msg_userauth_success{},TS}, D) -> + fmt("~n~s ~p Client login SUCCESS~n", [ts(TS),Pid], D); + -msg_formater({trace_ts,_Pid,call,{ssh_transport,select_algorithm,_},_TS}, D) -> +msg_formater(_, {trace_ts,_Pid,call,{ssh_transport,select_algorithm,_},_TS}, D) -> D; -msg_formater({trace_ts,Pid,return_from,{ssh_transport,select_algorithm,_},{ok,Alg},TS}, D) -> +msg_formater(_, {trace_ts,Pid,return_from,{ssh_transport,select_algorithm,_},{ok,Alg},TS}, D) -> fmt("~n~s ~p ALGORITHMS~n~s~n", [ts(TS),Pid, wr_record(Alg)], D); -msg_formater({trace_ts,_Pid,call,{ssh_transport,hello_version_msg,_},_TS}, D) -> +msg_formater(_, {trace_ts,_Pid,call,{ssh_transport,hello_version_msg,_},_TS}, D) -> D; -msg_formater({trace_ts,Pid,return_from,{ssh_transport,hello_version_msg,1},Hello,TS}, D) -> +msg_formater(_, {trace_ts,Pid,return_from,{ssh_transport,hello_version_msg,1},Hello,TS}, D) -> fmt("~n~s ~p TCP SEND HELLO~n ~p~n", [ts(TS),Pid,lists:flatten(Hello)], D); -msg_formater({trace_ts,Pid,call,{ssh_transport,handle_hello_version,[Hello]},TS}, D) -> +msg_formater(_, {trace_ts,Pid,call,{ssh_transport,handle_hello_version,[Hello]},TS}, D) -> fmt("~n~s ~p RECV HELLO~n ~p~n", [ts(TS),Pid,lists:flatten(Hello)], D); -msg_formater({trace_ts,_Pid,return_from,{ssh_transport,handle_hello_version,1},_,_TS}, D) -> +msg_formater(_, {trace_ts,_Pid,return_from,{ssh_transport,handle_hello_version,1},_,_TS}, D) -> D; -msg_formater({trace_ts,Pid,send,{tcp,Sock,Bytes},Pid,TS}, D) -> +msg_formater(_, {trace_ts,Pid,call,{ssh_connection_handler,ext_info,[{"server-sig-algs",_SigAlgs},State]},TS}, D) -> + try lists:keyfind(ssh, 1, tuple_to_list(State)) of + false -> + D; + #ssh{userauth_pubkeys = PKs} -> + fmt("~n~s ~p Client got suggestion to use user public key sig-algs~n ~p~n", [ts(TS),Pid,PKs], D) + catch + _:_ -> + D + end; + +msg_formater(_, {trace_ts,Pid,return_from,{ssh_connection_handler,ext_info,2},State,TS}, D) -> + try lists:keyfind(ssh, 1, tuple_to_list(State)) of + false -> + D; + #ssh{userauth_pubkeys = PKs} -> + fmt("~n~s ~p Client will try user public key sig-algs~n ~p~n", [ts(TS),Pid,PKs], D) + catch + _:_ -> + D + end; + +msg_formater(_, {trace_ts,Pid,call,{ssh_auth,publickey_msg,[[SigAlg,#ssh{user=User}]]},TS}, D) -> + fmt("~n~s ~p Client will try to login user ~p with public key algorithm ~p~n", [ts(TS),Pid,User,SigAlg], D); +msg_formater(_, {trace_ts,Pid,return_from,{ssh_auth,publickey_msg,1},{not_ok,#ssh{user=User}},TS}, D) -> + fmt("~s ~p User ~p can't login with that kind of public key~n", [ts(TS),Pid,User], D); + +msg_formater(_, {trace_ts,Pid,call,{ssh_auth,password_msg,[[#ssh{user=User}]]},TS}, D) -> + fmt("~n~s ~p Client will try to login user ~p with password~n", [ts(TS),Pid,User], D); +msg_formater(_, {trace_ts,Pid,return_from,{ssh_auth,password_msg,1},{not_ok,#ssh{user=User}},TS}, D) -> + fmt("~s ~p User ~p can't login with password~n", [ts(TS),Pid,User], D); + +msg_formater(_, {trace_ts,Pid,call,{ssh_auth,keyboard_interactive_msg,[[#ssh{user=User}]]},TS}, D) -> + fmt("~n~s ~p Client will try to login user ~p with password~n", [ts(TS),Pid,User], D); +msg_formater(_, {trace_ts,Pid,return_from,{ssh_auth,keyboard_interactive_msg,1},{not_ok,#ssh{user=User}},TS}, D) -> + fmt("~s ~p User ~p can't login with keyboard_interactive password~n", [ts(TS),Pid,User], D); + +msg_formater(msg, {trace_ts,Pid,send,{tcp,Sock,Bytes},Pid,TS}, D) -> fmt("~n~s ~p TCP SEND on ~p~n ~p~n", [ts(TS),Pid,Sock, shrink_bin(Bytes)], D); -msg_formater({trace_ts,Pid,send,{tcp,Sock,Bytes},Dest,TS}, D) -> +msg_formater(msg, {trace_ts,Pid,send,{tcp,Sock,Bytes},Dest,TS}, D) -> fmt("~n~s ~p TCP SEND from ~p TO ~p~n ~p~n", [ts(TS),Pid,Sock,Dest, shrink_bin(Bytes)], D); -msg_formater({trace_ts,Pid,send,ErlangMsg,Dest,TS}, D) -> +msg_formater(msg, {trace_ts,Pid,send,ErlangMsg,Dest,TS}, D) -> fmt("~n~s ~p ERL MSG SEND TO ~p~n ~p~n", [ts(TS),Pid,Dest, shrink_bin(ErlangMsg)], D); -msg_formater({trace_ts,Pid,'receive',{tcp,Sock,Bytes},TS}, D) -> +msg_formater(msg, {trace_ts,Pid,'receive',{tcp,Sock,Bytes},TS}, D) -> fmt("~n~s ~p TCP RECEIVE on ~p~n ~p~n", [ts(TS),Pid,Sock,shrink_bin(Bytes)], D); -msg_formater({trace_ts,Pid,'receive',ErlangMsg,TS}, D) -> +msg_formater(msg, {trace_ts,Pid,'receive',ErlangMsg,TS}, D) -> fmt("~n~s ~p ERL MSG RECEIVE~n ~p~n", [ts(TS),Pid,shrink_bin(ErlangMsg)], D); -msg_formater(M, D) -> - fmt("~nDBG ~n~p~n", [shrink_bin(M)], D). +%% msg_formater(_, {trace_ts,_Pid,return_from,MFA,_Ret,_TS}=M, D) -> +%% case lists:member(MFA, [{ssh_auth,keyboard_interactive_msg,1}, +%% {ssh_auth,password_msg,1}, +%% {ssh_auth,publickey_msg,1}]) of +%% true -> +%% D; +%% false -> +%% fmt("~nDBG ~n~p~n", [shrink_bin(M)], D) +%% end; + +%% msg_formater(_, M, D) -> +%% fmt("~nDBG ~n~p~n", [shrink_bin(M)], D). -%% msg_formater(_, D) -> -%% D. +msg_formater(_, _, D) -> + D. fmt(Fmt, Args, D=#data{writer=Write,acc=Acc}) -> @@ -123,9 +216,9 @@ ts({_,_,Usec}=Now) -> ts(_) -> "-". %%%---------------------------------------------------------------- -setup_tracer(Write, MangleArg) -> +setup_tracer(Type, Write, MangleArg) -> Handler = fun(Arg, D) -> - msg_formater(MangleArg(Arg), D) + msg_formater(Type, MangleArg(Arg), D) end, InitialData = #data{writer = Write}, {ok,_} = dbg:tracer(process, {Handler, InitialData}), diff --git a/lib/ssh/src/ssh_file.erl b/lib/ssh/src/ssh_file.erl index 6692432fcf..33792da38f 100644 --- a/lib/ssh/src/ssh_file.erl +++ b/lib/ssh/src/ssh_file.erl @@ -75,10 +75,7 @@ host_key(Algorithm, Opts) -> Password = proplists:get_value(identity_pass_phrase(Algorithm), Opts, ignore), case decode(File, Password) of {ok,Key} -> - case ssh_transport:valid_key_sha_alg(Key,Algorithm) of - true -> {ok,Key}; - false -> {error,bad_keytype_in_file} - end; + check_key_type(Key, Algorithm); {error,DecodeError} -> {error,DecodeError} end. @@ -104,10 +101,20 @@ is_host_key(Key, PeerName, Algorithm, Opts) -> user_key(Algorithm, Opts) -> File = file_name(user, identity_key_filename(Algorithm), Opts), Password = proplists:get_value(identity_pass_phrase(Algorithm), Opts, ignore), - decode(File, Password). + case decode(File, Password) of + {ok, Key} -> + check_key_type(Key, Algorithm); + Error -> + Error + end. %% Internal functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +check_key_type(Key, Algorithm) -> + case ssh_transport:valid_key_sha_alg(Key,Algorithm) of + true -> {ok,Key}; + false -> {error,bad_keytype_in_file} + end. file_base_name('ssh-rsa' ) -> "ssh_host_rsa_key"; file_base_name('rsa-sha2-256' ) -> "ssh_host_rsa_key"; diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index 609040826f..b1fc05ae33 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -598,8 +598,8 @@ decode_kex_init(<<?DEC_BIN(Data,__0), Rest/binary>>, Acc, N) -> %%% Signature decode/encode %%% -decode_signature(<<?DEC_BIN(_Alg,__0), ?UINT32(_), Signature/binary>>) -> - Signature. +decode_signature(<<?DEC_BIN(Alg,__0), ?UINT32(_), Signature/binary>>) -> + {binary_to_list(Alg), Signature}. encode_signature({#'RSAPublicKey'{},Sign}, Signature) -> @@ -611,13 +611,3 @@ encode_signature({{#'ECPoint'{}, {namedCurve,OID}},_}, Signature) -> CurveName = public_key:oid2ssh_curvename(OID), <<?Ebinary(<<"ecdsa-sha2-",CurveName/binary>>), ?Ebinary(Signature)>>. -%% encode_signature(#'RSAPublicKey'{}, Signature) -> -%% SignName = <<"ssh-rsa">>, -%% <<?Ebinary(SignName), ?Ebinary(Signature)>>; -%% encode_signature({_, #'Dss-Parms'{}}, Signature) -> -%% <<?Ebinary(<<"ssh-dss">>), ?Ebinary(Signature)>>; -%% encode_signature({#'ECPoint'{}, {namedCurve,OID}}, Signature) -> -%% CurveName = public_key:oid2ssh_curvename(OID), -%% <<?Ebinary(<<"ecdsa-sha2-",CurveName/binary>>), ?Ebinary(Signature)>>. - - diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl index 0886d5b34d..aebb5a7062 100644 --- a/lib/ssh/src/ssh_options.erl +++ b/lib/ssh/src/ssh_options.erl @@ -293,12 +293,6 @@ default(server) -> class => user_options }, - {auth_methods, def} => - #{default => ?SUPPORTED_AUTH_METHODS, - chk => fun check_string/1, - class => user_options - }, - {auth_method_kb_interactive_data, def} => #{default => undefined, % Default value can be constructed when User is known chk => fun({S1,S2,S3,B}) -> @@ -436,12 +430,9 @@ default(client) -> }, {pref_public_key_algs, def} => - #{default => - ssh_transport:supported_algorithms(public_key), - chk => - fun check_pref_public_key_algs/1, - class => - ssh + #{default => ssh_transport:default_algorithms(public_key), + chk => fun check_pref_public_key_algs/1, + class => user_options }, {dh_gex_limits, def} => @@ -582,6 +573,21 @@ default(common) -> class => user_options }, + {auth_methods, def} => + #{default => ?SUPPORTED_AUTH_METHODS, + chk => fun(As) -> + try + Sup = string:tokens(?SUPPORTED_AUTH_METHODS, ","), + New = string:tokens(As, ","), + [] == [X || X <- New, + not lists:member(X,Sup)] + catch + _:_ -> false + end + end, + class => user_options + }, + %%%%% Undocumented {transport, def} => #{default => ?DEFAULT_TRANSPORT, @@ -808,16 +814,23 @@ valid_hash(X, _) -> error_in_check(X, "Expect atom or list in fingerprint spec" %%%---------------------------------------------------------------- check_preferred_algorithms(Algs) -> + [error_in_check(K,"Bad preferred_algorithms key") + || {K,_} <- Algs, + not lists:keymember(K,1,ssh:default_algorithms())], + try alg_duplicates(Algs, [], []) of [] -> {true, - [try ssh_transport:supported_algorithms(Key) - of - DefAlgs -> handle_pref_alg(Key,Vals,DefAlgs) - catch - _:_ -> error_in_check(Key,"Bad preferred_algorithms key") - end || {Key,Vals} <- Algs] + [case proplists:get_value(Key, Algs) of + undefined -> + {Key,DefAlgs}; + Vals -> + handle_pref_alg(Key,Vals,SupAlgs) + end + || {{Key,DefAlgs}, {Key,SupAlgs}} <- lists:zip(ssh:default_algorithms(), + ssh_transport:supported_algorithms()) + ] }; Dups -> diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 25c64a4f25..412f5de9de 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -92,10 +92,7 @@ default_algorithms(cipher) -> default_algorithms(mac) -> supported_algorithms(mac, same(['AEAD_AES_128_GCM', 'AEAD_AES_256_GCM'])); -default_algorithms(public_key) -> - supported_algorithms(public_key, ['rsa-sha2-256', - 'rsa-sha2-384', - 'rsa-sha2-512']); + default_algorithms(Alg) -> supported_algorithms(Alg, []). @@ -122,10 +119,9 @@ supported_algorithms(public_key) -> {'ecdsa-sha2-nistp384', [{public_keys,ecdsa}, {hashs,sha384}, {ec_curve,secp384r1}]}, {'ecdsa-sha2-nistp521', [{public_keys,ecdsa}, {hashs,sha512}, {ec_curve,secp521r1}]}, {'ecdsa-sha2-nistp256', [{public_keys,ecdsa}, {hashs,sha256}, {ec_curve,secp256r1}]}, + {'ssh-rsa', [{public_keys,rsa}, {hashs,sha} ]}, {'rsa-sha2-256', [{public_keys,rsa}, {hashs,sha256} ]}, - {'rsa-sha2-384', [{public_keys,rsa}, {hashs,sha384} ]}, {'rsa-sha2-512', [{public_keys,rsa}, {hashs,sha512} ]}, - {'ssh-rsa', [{public_keys,rsa}, {hashs,sha} ]}, {'ssh-dss', [{public_keys,dss}, {hashs,sha} ]} % Gone in OpenSSH 7.3.p1 ]); @@ -724,14 +720,28 @@ kex_ext_info(Role, Opts) -> end. ext_info_message(#ssh{role=client, - send_ext_info=true} = Ssh0) -> - %% FIXME: no extensions implemented - {ok, "", Ssh0}; + send_ext_info=true, + opts=Opts} = Ssh0) -> + %% Since no extension sent by the client is implemented, we add a fake one + %% to be able to test the framework. + %% Remove this when there is one and update ssh_protocol_SUITE whare it is used. + case proplists:get_value(ext_info_client, ?GET_OPT(tstflg,Opts)) of + true -> + Msg = #ssh_msg_ext_info{nr_extensions = 1, + data = [{"[email protected]", "Testing,PleaseIgnore"}] + }, + {SshPacket, Ssh} = ssh_packet(Msg, Ssh0), + {ok, SshPacket, Ssh}; + _ -> + {ok, "", Ssh0} + end; ext_info_message(#ssh{role=server, - send_ext_info=true} = Ssh0) -> + send_ext_info=true, + opts = Opts} = Ssh0) -> AlgsList = lists:map(fun erlang:atom_to_list/1, - ssh_transport:default_algorithms(public_key)), + proplists:get_value(public_key, + ?GET_OPT(preferred_algorithms, Opts))), Msg = #ssh_msg_ext_info{nr_extensions = 1, data = [{"server-sig-algs", string:join(AlgsList,",")}] }, @@ -766,16 +776,20 @@ extract_public_key(#'ECPrivateKey'{parameters = {namedCurve,OID}, {#'ECPoint'{point=Q}, {namedCurve,OID}}. -verify_host_key(#ssh{algorithms=Alg}=SSH, PublicKey, Digest, Signature) -> - case verify(Digest, sha(Alg#alg.hkey), Signature, PublicKey) of - false -> - {error, bad_signature}; - true -> - known_host_key(SSH, PublicKey, public_algo(PublicKey)) +verify_host_key(#ssh{algorithms=Alg}=SSH, PublicKey, Digest, {AlgStr,Signature}) -> + case atom_to_list(Alg#alg.hkey) of + AlgStr -> + case verify(Digest, sha(Alg#alg.hkey), Signature, PublicKey) of + false -> + {error, bad_signature}; + true -> + known_host_key(SSH, PublicKey, public_algo(PublicKey)) + end; + _ -> + {error, bad_signature_name} end. - accepted_host(Ssh, PeerName, Public, Opts) -> case ?GET_OPT(silently_accept_hosts, Opts) of diff --git a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl index 410a9ea983..165274241c 100644 --- a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl +++ b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl @@ -280,12 +280,22 @@ msg_code(Num) -> Name -include_lib("ssh/src/ssh_transport.hrl"). %%% Encoding and decodeing is asymetric so out=binary in=string. Sometimes. :( +-define(fix_asym_Xdh_reply(S), + fix_asym(#S{public_host_key = Key, h_sig = {Alg,Sig}} = M) -> + M#S{public_host_key = {Key, list_to_atom(Alg)}, h_sig = Sig} +). + + fix_asym(#ssh_msg_global_request{name=N} = M) -> M#ssh_msg_global_request{name = binary_to_list(N)}; fix_asym(#ssh_msg_debug{message=D,language=L} = M) -> M#ssh_msg_debug{message = binary_to_list(D), language = binary_to_list(L)}; fix_asym(#ssh_msg_kexinit{cookie=C} = M) -> M#ssh_msg_kexinit{cookie = <<C:128>>}; +?fix_asym_Xdh_reply(ssh_msg_kexdh_reply); +?fix_asym_Xdh_reply(ssh_msg_kex_dh_gex_reply); +?fix_asym_Xdh_reply(ssh_msg_kex_ecdh_reply); fix_asym(M) -> M. + %%% Message codes 30 and 31 are overloaded depending on kex family so arrange the decoder %%% input as the test object does decode_state(<<30,_/binary>>=Msg, KexFam) -> <<KexFam/binary, Msg/binary>>; diff --git a/lib/ssh/test/ssh.spec b/lib/ssh/test/ssh.spec index 68268cb20d..b4e3d36072 100644 --- a/lib/ssh/test/ssh.spec +++ b/lib/ssh/test/ssh.spec @@ -1,6 +1,7 @@ {suites,"../ssh_test",all}. -{skip_suites, "../ssh_test", [ssh_bench_SUITE +{skip_suites, "../ssh_test", [ssh_bench_SUITE, + ssh_upgrade_SUITE ], "Benchmarks run separately"}. diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index 6e6269d3e0..0f69910e40 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -68,7 +68,7 @@ groups() -> TagGroupSet ++ AlgoTcSet. -tags() -> [kex,cipher,mac,compression]. +tags() -> [kex,cipher,mac,compression,public_key]. two_way_tags() -> [cipher,mac,compression]. %%-------------------------------------------------------------------- @@ -123,20 +123,35 @@ init_per_group(Group, Config) -> Tag = proplists:get_value(name, hd(proplists:get_value(tc_group_path, Config))), Alg = Group, - PA = - case split(Alg) of - [_] -> - [Alg]; - [A1,A2] -> - [{client2server,[A1]}, - {server2client,[A2]}] - end, - ct:log("Init tests for tag=~p alg=~p",[Tag,PA]), - PrefAlgs = {preferred_algorithms,[{Tag,PA}]}, - start_std_daemon([PrefAlgs], - [{pref_algs,PrefAlgs} | Config]) + init_per_group(Tag, Alg, Config) end. + +init_per_group(public_key=Tag, Alg, Config) -> + ct:log("Init tests for public_key ~p",[Alg]), + PrefAlgs = {preferred_algorithms,[{Tag,[Alg]}]}, + %% Daemon started later in init_per_testcase + [{pref_algs,PrefAlgs}, + {tag_alg,{Tag,Alg}} + | Config]; + +init_per_group(Tag, Alg, Config) -> + PA = + case split(Alg) of + [_] -> + [Alg]; + [A1,A2] -> + [{client2server,[A1]}, + {server2client,[A2]}] + end, + ct:log("Init tests for tag=~p alg=~p",[Tag,PA]), + PrefAlgs = {preferred_algorithms,[{Tag,PA}]}, + start_std_daemon([PrefAlgs], + [{pref_algs,PrefAlgs}, + {tag_alg,{Tag,Alg}} + | Config]). + + end_per_group(_Alg, Config) -> case proplists:get_value(srvr_pid,Config) of Pid when is_pid(Pid) -> @@ -148,23 +163,51 @@ end_per_group(_Alg, Config) -> -init_per_testcase(sshc_simple_exec_os_cmd, Config) -> - start_pubkey_daemon([proplists:get_value(pref_algs,Config)], Config); -init_per_testcase(_TC, Config) -> - Config. +init_per_testcase(TC, Config) -> + init_per_testcase(TC, proplists:get_value(tag_alg,Config), Config). -end_per_testcase(sshc_simple_exec_os_cmd, Config) -> - case proplists:get_value(srvr_pid,Config) of - Pid when is_pid(Pid) -> - ssh:stop_daemon(Pid), - ct:log("stopped ~p",[proplists:get_value(srvr_addr,Config)]); - _ -> - ok +init_per_testcase(_, {public_key,Alg}, Config) -> + Opts = pubkey_opts(Config), + case {ssh_file:user_key(Alg,Opts), ssh_file:host_key(Alg,Opts)} of + {{ok,_}, {ok,_}} -> + ssh_dbg:ct_auth(), + start_pubkey_daemon([proplists:get_value(pref_algs,Config)], + [{extra_daemon,true}|Config]); + {{ok,_}, _} -> + {skip, "No host key"}; + + {_, {ok,_}} -> + {skip, "No user key"}; + + _ -> + {skip, "Neither host nor user key"} end; -end_per_testcase(_TC, Config) -> + +init_per_testcase(sshc_simple_exec_os_cmd, _, Config) -> + start_pubkey_daemon([proplists:get_value(pref_algs,Config)], + [{extra_daemon,true}|Config]); + +init_per_testcase(_, _, Config) -> Config. + +end_per_testcase(_TC, Config) -> + catch ssh_dbg:stop(), + case proplists:get_value(extra_daemon, Config, false) of + true -> + case proplists:get_value(srvr_pid,Config) of + Pid when is_pid(Pid) -> + ssh:stop_daemon(Pid), + ct:log("stopped ~p",[proplists:get_value(srvr_addr,Config)]), + Config; + _ -> + Config + end; + _ -> + Config + end. + %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- @@ -260,8 +303,9 @@ sshc_simple_exec_os_cmd(Config) -> %%-------------------------------------------------------------------- %% Connect to the ssh server of the OS -sshd_simple_exec(_Config) -> +sshd_simple_exec(Config) -> ConnectionRef = ssh_test_lib:connect(22, [{silently_accept_hosts, true}, + proplists:get_value(pref_algs,Config), {user_interaction, false}]), {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), success = ssh_connection:exec(ConnectionRef, ChannelId0, @@ -318,29 +362,32 @@ concat(A1, A2) -> list_to_atom(lists:concat([A1," + ",A2])). split(Alg) -> ssh_test_lib:to_atoms(string:tokens(atom_to_list(Alg), " + ")). specific_test_cases(Tag, Alg, SshcAlgos, SshdAlgos, TypeSSH) -> - [simple_exec, simple_sftp] ++ - case supports(Tag, Alg, SshcAlgos) of - true when TypeSSH == openSSH -> - [sshc_simple_exec_os_cmd]; - _ -> - [] - end ++ - case supports(Tag, Alg, SshdAlgos) of - true -> - [sshd_simple_exec]; - _ -> - [] - end ++ - case {Tag,Alg} of - {kex,_} when Alg == 'diffie-hellman-group-exchange-sha1' ; - Alg == 'diffie-hellman-group-exchange-sha256' -> - [simple_exec_groups, - simple_exec_groups_no_match_too_large, - simple_exec_groups_no_match_too_small - ]; - _ -> - [] - end. + case Tag of + public_key -> []; + _ -> [simple_exec, simple_sftp] + end + ++ case supports(Tag, Alg, SshcAlgos) of + true when TypeSSH == openSSH -> + [sshc_simple_exec_os_cmd]; + _ -> + [] + end ++ + case supports(Tag, Alg, SshdAlgos) of + true -> + [sshd_simple_exec]; + _ -> + [] + end ++ + case {Tag,Alg} of + {kex,_} when Alg == 'diffie-hellman-group-exchange-sha1' ; + Alg == 'diffie-hellman-group-exchange-sha256' -> + [simple_exec_groups, + simple_exec_groups_no_match_too_large, + simple_exec_groups_no_match_too_small + ]; + _ -> + [] + end. supports(Tag, Alg, Algos) -> lists:all(fun(A) -> @@ -370,19 +417,30 @@ start_std_daemon(Opts, Config) -> ct:log("started ~p:~p ~p",[Host,Port,Opts]), [{srvr_pid,Pid},{srvr_addr,{Host,Port}} | Config]. + start_pubkey_daemon(Opts0, Config) -> - Opts = [{auth_methods,"publickey"}|Opts0], - {Pid, Host, Port} = ssh_test_lib:std_daemon1(Config, Opts), - ct:log("started pubkey_daemon ~p:~p ~p",[Host,Port,Opts]), + ct:log("starting pubkey_daemon",[]), + Opts = pubkey_opts(Config) ++ Opts0, + {Pid, Host, Port} = ssh_test_lib:daemon([{failfun, fun ssh_test_lib:failfun/2} + | Opts]), + ct:log("started ~p:~p ~p",[Host,Port,Opts]), [{srvr_pid,Pid},{srvr_addr,{Host,Port}} | Config]. +pubkey_opts(Config) -> + SystemDir = filename:join(proplists:get_value(priv_dir,Config), "system"), + [{auth_methods,"publickey"}, + {system_dir, SystemDir}]. + + setup_pubkey(Config) -> DataDir = proplists:get_value(data_dir, Config), UserDir = proplists:get_value(priv_dir, Config), - ssh_test_lib:setup_dsa(DataDir, UserDir), - ssh_test_lib:setup_rsa(DataDir, UserDir), - ssh_test_lib:setup_ecdsa("256", DataDir, UserDir), + Keys = + [ssh_test_lib:setup_dsa(DataDir, UserDir), + ssh_test_lib:setup_rsa(DataDir, UserDir), + ssh_test_lib:setup_ecdsa("256", DataDir, UserDir)], + ssh_test_lib:write_auth_keys(Keys, UserDir), % 'authorized_keys' shall contain ALL pub keys Config. diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index b80c3ed5e2..62e2a585e4 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -612,7 +612,7 @@ exec_key_differs(Config, UserPKAlgs) -> {_Pid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_dir, SystemUserDir}, {preferred_algorithms, - [{public_key,['ssh-rsa']}]}]), + [{public_key,['ssh-rsa'|UserPKAlgs]}]}]), ct:sleep(500), IO = ssh_test_lib:start_io_server(), @@ -1173,13 +1173,10 @@ login_bad_pwd_no_retry3(Config) -> login_bad_pwd_no_retry(Config, "password,publickey,keyboard-interactive"). login_bad_pwd_no_retry4(Config) -> - login_bad_pwd_no_retry(Config, "password,other,keyboard-interactive"). + login_bad_pwd_no_retry(Config, "password,keyboard-interactive"). login_bad_pwd_no_retry5(Config) -> - login_bad_pwd_no_retry(Config, "password,other,keyboard-interactive,password,password"). - - - + login_bad_pwd_no_retry(Config, "password,keyboard-interactive,password,password"). login_bad_pwd_no_retry(Config, AuthMethods) -> diff --git a/lib/ssh/test/ssh_property_test_SUITE.erl b/lib/ssh/test/ssh_property_test_SUITE.erl index 9b2a84d8e4..5ea60d8a8f 100644 --- a/lib/ssh/test/ssh_property_test_SUITE.erl +++ b/lib/ssh/test/ssh_property_test_SUITE.erl @@ -55,6 +55,9 @@ groups() -> init_per_suite(Config) -> ct_property_test:init_per_suite(Config). +end_per_suite(Config) -> + Config. + %%% One group in this suite happens to support only QuickCheck, so skip it %%% if we run proper. init_per_group(client_server, Config) -> diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index 5a6e0638a7..0385e30ad1 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -59,7 +59,8 @@ all() -> {group,service_requests}, {group,authentication}, {group,packet_size_error}, - {group,field_size_error} + {group,field_size_error}, + {group,ext_info} ]. groups() -> @@ -90,7 +91,12 @@ groups() -> bad_service_name_then_correct ]}, {authentication, [], [client_handles_keyboard_interactive_0_pwds - ]} + ]}, + {ext_info, [], [no_ext_info_s1, + no_ext_info_s2, + ext_info_s, + ext_info_c + ]} ]. @@ -644,7 +650,113 @@ client_info_line(_Config) -> ok end. +%%%-------------------------------------------------------------------- +%%% The server does not send the extension because +%%% the client does not tell the server to send it +no_ext_info_s1(Config) -> + %% Start the dameon + Server = {Pid,_,_} = ssh_test_lib:daemon([{send_ext_info,true}, + {system_dir, system_dir(Config)}]), + {ok,AfterKexState} = connect_and_kex([{server,Server}|Config]), + {ok,_} = + ssh_trpt_test_lib:exec( + [{send, #ssh_msg_service_request{name = "ssh-userauth"}}, + {match, #ssh_msg_service_accept{name = "ssh-userauth"}, receive_msg} + ], AfterKexState), + ssh:stop_daemon(Pid). + +%%%-------------------------------------------------------------------- +%%% The server does not send the extension because +%%% the server is not configured to send it +no_ext_info_s2(Config) -> + %% Start the dameon + Server = {Pid,_,_} = ssh_test_lib:daemon([{send_ext_info,false}, + {system_dir, system_dir(Config)}]), + {ok,AfterKexState} = connect_and_kex([{extra_options,[{recv_ext_info,true}]}, + {server,Server} + | Config]), + {ok,_} = + ssh_trpt_test_lib:exec( + [{send, #ssh_msg_service_request{name = "ssh-userauth"}}, + {match, #ssh_msg_service_accept{name = "ssh-userauth"}, receive_msg} + ], AfterKexState), + ssh:stop_daemon(Pid). + +%%%-------------------------------------------------------------------- +%%% The server sends the extension +ext_info_s(Config) -> + %% Start the dameon + Server = {Pid,_,_} = ssh_test_lib:daemon([{send_ext_info,true}, + {system_dir, system_dir(Config)}]), + {ok,AfterKexState} = connect_and_kex([{extra_options,[{recv_ext_info,true}]}, + {server,Server} + | Config]), + {ok,_} = + ssh_trpt_test_lib:exec( + [{match, #ssh_msg_ext_info{_='_'}, receive_msg} + ], + AfterKexState), + ssh:stop_daemon(Pid). + +%%%-------------------------------------------------------------------- +%%% The client sends the extension +ext_info_c(Config) -> + {User,_Pwd} = server_user_password(Config), + + %% Create a listening socket as server socket: + {ok,InitialState} = ssh_trpt_test_lib:exec(listen), + HostPort = ssh_trpt_test_lib:server_host_port(InitialState), + + Parent = self(), + %% Start a process handling one connection on the server side: + Pid = + spawn_link( + fun() -> + Result = + ssh_trpt_test_lib:exec( + [{set_options, [print_ops, print_messages]}, + {accept, [{system_dir, system_dir(Config)}, + {user_dir, user_dir(Config)}, + {recv_ext_info, true} + ]}, + receive_hello, + {send, hello}, + + {send, ssh_msg_kexinit}, + {match, #ssh_msg_kexinit{_='_'}, receive_msg}, + + {match, #ssh_msg_kexdh_init{_='_'}, receive_msg}, + {send, ssh_msg_kexdh_reply}, + + {send, #ssh_msg_newkeys{}}, + {match, #ssh_msg_newkeys{_='_'}, receive_msg}, + + {match, #ssh_msg_ext_info{_='_'}, receive_msg}, + + close_socket, + print_state + ], + InitialState), + Parent ! {result,self(),Result} + end), + + %% connect to it with a regular Erlang SSH client + %% (expect error due to the close_socket in daemon): + {error,_} = std_connect(HostPort, Config, + [{preferred_algorithms,[{kex,[?DEFAULT_KEX]}, + {cipher,?DEFAULT_CIPHERS} + ]}, + {tstflg, [{ext_info_client,true}]}, + {send_ext_info, true} + ] + ), + %% Check that the daemon got expected result: + receive + {result, Pid, {ok,_}} -> ok; + {result, Pid, Error} -> ct:fail("Error: ~p",[Error]) + end. + %%%================================================================ %%%==== Internal functions ======================================== %%%================================================================ @@ -751,10 +863,12 @@ connect_and_kex(Config, InitialState) -> [{preferred_algorithms,[{kex,[?DEFAULT_KEX]}, {cipher,?DEFAULT_CIPHERS} ]}, - {silently_accept_hosts, true}, + {silently_accept_hosts, true}, {recv_ext_info, false}, {user_dir, user_dir(Config)}, - {user_interaction, false}]}, + {user_interaction, false} + | proplists:get_value(extra_options,Config,[]) + ]}, receive_hello, {send, hello}, {send, ssh_msg_kexinit}, diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 36ae2525da..7b273fecef 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -500,8 +500,12 @@ setup_ecdsa_auth_keys(_Size, Dir, UserDir) -> setup_auth_keys(Keys, Dir) -> AuthKeys = public_key:ssh_encode(Keys, auth_keys), AuthKeysFile = filename:join(Dir, "authorized_keys"), - file:write_file(AuthKeysFile, AuthKeys). + ok = file:write_file(AuthKeysFile, AuthKeys), + AuthKeys. +write_auth_keys(Keys, Dir) -> + AuthKeysFile = filename:join(Dir, "authorized_keys"), + file:write_file(AuthKeysFile, Keys). del_dirs(Dir) -> case file:list_dir(Dir) of diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index a3d596a1c9..4d6aa93d4e 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -107,6 +107,9 @@ init_per_testcase(erlang_server_openssh_client_public_key_rsa, Config) -> chk_key(sshc, 'ssh-rsa', ".ssh/id_rsa", Config); init_per_testcase(erlang_client_openssh_server_publickey_dsa, Config) -> chk_key(sshd, 'ssh-dss', ".ssh/id_dsa", Config); +init_per_testcase(erlang_client_openssh_server_publickey_rsa, Config) -> + chk_key(sshd, 'ssh-rsa', ".ssh/id_rsa", Config); + init_per_testcase(erlang_server_openssh_client_renegotiate, Config) -> case os:type() of {unix,_} -> ssh:start(), Config; @@ -322,65 +325,44 @@ erlang_client_openssh_server_setenv(Config) when is_list(Config) -> %% setenv not meaningfull on erlang ssh daemon! %%-------------------------------------------------------------------- -erlang_client_openssh_server_publickey_rsa() -> - [{doc, "Validate using rsa publickey."}]. -erlang_client_openssh_server_publickey_rsa(Config) when is_list(Config) -> - {ok,[[Home]]} = init:get_argument(home), - KeyFile = filename:join(Home, ".ssh/id_rsa"), - case file:read_file(KeyFile) of - {ok, Pem} -> - case public_key:pem_decode(Pem) of - [{_,_, not_encrypted}] -> - ConnectionRef = - ssh_test_lib:connect(?SSH_DEFAULT_PORT, - [{pref_public_key_algs, ['ssh-rsa','ssh-dss']}, - {user_interaction, false}, - silently_accept_hosts]), - {ok, Channel} = - ssh_connection:session_channel(ConnectionRef, infinity), - ok = ssh_connection:close(ConnectionRef, Channel), - ok = ssh:close(ConnectionRef); - _ -> - {skip, {error, "Has pass phrase can not be used by automated test case"}} - end; - _ -> - {skip, "no ~/.ssh/id_rsa"} - end. - +erlang_client_openssh_server_publickey_rsa(Config) -> + erlang_client_openssh_server_publickey_X(Config, 'ssh-rsa'). + +erlang_client_openssh_server_publickey_dsa(Config) -> + erlang_client_openssh_server_publickey_X(Config, 'ssh-dss'). -%%-------------------------------------------------------------------- -erlang_client_openssh_server_publickey_dsa() -> - [{doc, "Validate using dsa publickey."}]. -erlang_client_openssh_server_publickey_dsa(Config) when is_list(Config) -> + +erlang_client_openssh_server_publickey_X(Config, Alg) -> ConnectionRef = - ssh_test_lib:connect(?SSH_DEFAULT_PORT, - [{pref_public_key_algs, ['ssh-dss','ssh-rsa']}, - {user_interaction, false}, - silently_accept_hosts]), + ssh_test_lib:connect(?SSH_DEFAULT_PORT, + [{pref_public_key_algs, [Alg]}, + {user_interaction, false}, + {auth_methods, "publickey"}, + silently_accept_hosts]), {ok, Channel} = - ssh_connection:session_channel(ConnectionRef, infinity), + ssh_connection:session_channel(ConnectionRef, infinity), ok = ssh_connection:close(ConnectionRef, Channel), ok = ssh:close(ConnectionRef). %%-------------------------------------------------------------------- erlang_server_openssh_client_public_key_dsa() -> - [{timetrap, {seconds,(?TIMEOUT div 1000)+10}}, - {doc, "Validate using dsa publickey."}]. + [{timetrap, {seconds,(?TIMEOUT div 1000)+10}}]. erlang_server_openssh_client_public_key_dsa(Config) when is_list(Config) -> - erlang_server_openssh_client_public_key_X(Config, ssh_dsa). + erlang_server_openssh_client_public_key_X(Config, 'ssh-dss'). -erlang_server_openssh_client_public_key_rsa() -> - [{timetrap, {seconds,(?TIMEOUT div 1000)+10}}, - {doc, "Validate using rsa publickey."}]. +erlang_server_openssh_client_public_key_rsa() -> + [{timetrap, {seconds,(?TIMEOUT div 1000)+10}}]. erlang_server_openssh_client_public_key_rsa(Config) when is_list(Config) -> - erlang_server_openssh_client_public_key_X(Config, ssh_rsa). + erlang_server_openssh_client_public_key_X(Config, 'ssh-rsa'). -erlang_server_openssh_client_public_key_X(Config, _PubKeyAlg) -> +erlang_server_openssh_client_public_key_X(Config, Alg) -> SystemDir = proplists:get_value(data_dir, Config), PrivDir = proplists:get_value(priv_dir, Config), KnownHosts = filename:join(PrivDir, "known_hosts"), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {preferred_algorithms,[{public_key, [Alg]}]}, + {auth_methods, "publickey"}, {failfun, fun ssh_test_lib:failfun/2}]), ct:sleep(500), @@ -401,7 +383,7 @@ erlang_server_openssh_client_renegotiate(Config) -> KnownHosts = filename:join(PrivDir, "known_hosts"), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {failfun, fun ssh_test_lib:failfun/2}]), + {failfun, fun ssh_test_lib:failfun/2}]), ct:sleep(500), RenegLimitK = 3, diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 9937373e6e..2de947d8b4 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -53,7 +53,7 @@ %% Data handling -export([encode_data/3, passive_receive/2, next_record_if_active/1, handle_common_event/4, - send/3, socket/5]). + send/3, socket/5, setopts/3, getopts/3]). %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states @@ -203,6 +203,11 @@ select_sni_extension(_) -> socket(Pid, Transport, Socket, Connection, _) -> dtls_socket:socket(Pid, Transport, Socket, Connection). +setopts(Transport, Socket, Other) -> + dtls_socket:setopts(Transport, Socket, Other). +getopts(Transport, Socket, Tag) -> + dtls_socket:getopts(Transport, Socket, Tag). + %%==================================================================== %% tls_connection_sup API %%==================================================================== @@ -688,16 +693,18 @@ next_record(#state{unprocessed_handshake_events = N} = State) when N > 0 -> {no_record, State#state{unprocessed_handshake_events = N-1}}; next_record(#state{protocol_buffers = - #protocol_buffers{dtls_cipher_texts = [CT | Rest]} + #protocol_buffers{dtls_cipher_texts = [#ssl_tls{epoch = Epoch} = CT | Rest]} = Buffers, - connection_states = ConnStates0} = State) -> - case dtls_record:decode_cipher_text(CT, ConnStates0) of - {Plain, ConnStates} -> - {Plain, State#state{protocol_buffers = - Buffers#protocol_buffers{dtls_cipher_texts = Rest}, - connection_states = ConnStates}}; - #alert{} = Alert -> - {Alert, State} + connection_states = ConnectionStates} = State) -> + CurrentRead = dtls_record:get_connection_state_by_epoch(Epoch, ConnectionStates, read), + case dtls_record:replay_detect(CT, CurrentRead) of + false -> + decode_cipher_text(State#state{connection_states = ConnectionStates}) ; + true -> + %% Ignore replayed record + next_record(State#state{protocol_buffers = + Buffers#protocol_buffers{dtls_cipher_texts = Rest}, + connection_states = ConnectionStates}) end; next_record(#state{role = server, socket = {Listener, {Client, _}}, @@ -743,31 +750,69 @@ next_event(connection = StateName, no_record, {#ssl_tls{epoch = Epoch, type = ?HANDSHAKE, version = _Version}, State1} = _Record when Epoch == CurrentEpoch-1 -> - {State, MoreActions} = send_handshake_flight(State1, Epoch), + {State, MoreActions} = send_handshake_flight(State1, CurrentEpoch), + {next_state, StateName, State, Actions ++ MoreActions}; + %% From FLIGHT perspective CHANGE_CIPHER_SPEC is treated as a handshake + {#ssl_tls{epoch = Epoch, + type = ?CHANGE_CIPHER_SPEC, + version = _Version}, State1} = _Record when Epoch == CurrentEpoch-1 -> + {State, MoreActions} = send_handshake_flight(State1, CurrentEpoch), {next_state, StateName, State, Actions ++ MoreActions}; {#ssl_tls{epoch = _Epoch, - version = _Version}, State} -> + version = _Version}, State1} -> %% TODO maybe buffer later epoch - {next_state, StateName, State, Actions}; + {Record, State} = next_record(State1), + next_event(StateName, Record, State, Actions); {#alert{} = Alert, State} -> {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} end; +next_event(connection = StateName, Record, + #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) -> + case Record of + #ssl_tls{epoch = CurrentEpoch} -> + {next_state, StateName, State0, [{next_event, internal, {protocol_record, Record}} | Actions]}; + #ssl_tls{epoch = Epoch, + type = ?HANDSHAKE, + version = _Version} when Epoch == CurrentEpoch-1 -> + {State, MoreActions} = send_handshake_flight(State0, CurrentEpoch), + {next_state, StateName, State, Actions ++ MoreActions}; + %% From FLIGHT perspective CHANGE_CIPHER_SPEC is treated as a handshake + #ssl_tls{epoch = Epoch, + type = ?CHANGE_CIPHER_SPEC, + version = _Version} when Epoch == CurrentEpoch-1 -> + {State, MoreActions} = send_handshake_flight(State0, CurrentEpoch), + {next_state, StateName, State, Actions ++ MoreActions}; + _ -> + next_event(StateName, no_record, State0, Actions) + end; next_event(StateName, Record, - #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State, Actions) -> + #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) -> case Record of no_record -> - {next_state, StateName, State, Actions}; + {next_state, StateName, State0, Actions}; #ssl_tls{epoch = CurrentEpoch, version = Version} = Record -> {next_state, StateName, - dtls_version(StateName, Version, State), + dtls_version(StateName, Version, State0), [{next_event, internal, {protocol_record, Record}} | Actions]}; #ssl_tls{epoch = _Epoch, version = _Version} = _Record -> %% TODO maybe buffer later epoch - {next_state, StateName, State, Actions}; + {Record, State} = next_record(State0), + next_event(StateName, Record, State, Actions); #alert{} = Alert -> - {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} + {next_state, StateName, State0, [{next_event, internal, Alert} | Actions]} + end. + +decode_cipher_text(#state{protocol_buffers = #protocol_buffers{dtls_cipher_texts = [ CT | Rest]} = Buffers, + connection_states = ConnStates0} = State) -> + case dtls_record:decode_cipher_text(CT, ConnStates0) of + {Plain, ConnStates} -> + {Plain, State#state{protocol_buffers = + Buffers#protocol_buffers{dtls_cipher_texts = Rest}, + connection_states = ConnStates}}; + #alert{} = Alert -> + {Alert, State} end. dtls_version(hello, Version, #state{role = server} = State) -> diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index 6a418c6fb1..8a7f8c1d0a 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -46,7 +46,7 @@ is_higher/2, supported_protocol_versions/0, is_acceptable_version/2, hello_version/2]). --export([save_current_connection_state/2, next_epoch/2]). +-export([save_current_connection_state/2, next_epoch/2, get_connection_state_by_epoch/3, replay_detect/2]). -export([init_connection_state_seq/2, current_connection_state_epoch/2]). @@ -55,6 +55,8 @@ -type dtls_version() :: ssl_record:ssl_version(). -type dtls_atom_version() :: dtlsv1 | 'dtlsv1.2'. +-define(REPLAY_WINDOW_SIZE, 64). + -compile(inline). %%==================================================================== @@ -73,7 +75,7 @@ init_connection_states(Role, BeastMitigation) -> Initial = initial_connection_state(ConnectionEnd, BeastMitigation), Current = Initial#{epoch := 0}, InitialPending = ssl_record:empty_connection_state(ConnectionEnd, BeastMitigation), - Pending = InitialPending#{epoch => undefined}, + Pending = InitialPending#{epoch => undefined, replay_window => init_replay_window(?REPLAY_WINDOW_SIZE)}, #{saved_read => Current, current_read => Current, pending_read => Pending, @@ -96,11 +98,13 @@ save_current_connection_state(#{current_write := Current} = States, write) -> next_epoch(#{pending_read := Pending, current_read := #{epoch := Epoch}} = States, read) -> - States#{pending_read := Pending#{epoch := Epoch + 1}}; + States#{pending_read := Pending#{epoch := Epoch + 1, + replay_window := init_replay_window(?REPLAY_WINDOW_SIZE)}}; next_epoch(#{pending_write := Pending, current_write := #{epoch := Epoch}} = States, write) -> - States#{pending_write := Pending#{epoch := Epoch + 1}}. + States#{pending_write := Pending#{epoch := Epoch + 1, + replay_window := init_replay_window(?REPLAY_WINDOW_SIZE)}}. get_connection_state_by_epoch(Epoch, #{current_write := #{epoch := Epoch} = Current}, write) -> @@ -411,6 +415,7 @@ hello_version(Version, Versions) -> lowest_protocol_version(Versions) end. + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -419,6 +424,7 @@ initial_connection_state(ConnectionEnd, BeastMitigation) -> ssl_record:initial_security_params(ConnectionEnd), epoch => undefined, sequence_number => 0, + replay_window => init_replay_window(?REPLAY_WINDOW_SIZE), beast_mitigation => BeastMitigation, compression_state => undefined, cipher_state => undefined, @@ -499,8 +505,9 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, {PlainFragment, CipherState} -> {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, PlainFragment, CompressionS0), - ReadState = ReadState0#{compression_state => CompressionS1, + ReadState0 = ReadState0#{compression_state => CompressionS1, cipher_state => CipherState}, + ReadState = update_replay_window(Seq, ReadState0), ConnnectionStates = set_connection_state_by_epoch(ReadState, Epoch, ConnnectionStates0, read), {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; #alert{} = Alert -> @@ -523,7 +530,8 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, PlainFragment, CompressionS0), - ReadState = ReadState1#{compression_state => CompressionS1}, + ReadState2 = ReadState1#{compression_state => CompressionS1}, + ReadState = update_replay_window(Seq, ReadState2), ConnnectionStates = set_connection_state_by_epoch(ReadState, Epoch, ConnnectionStates0, read), {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; false -> @@ -555,3 +563,38 @@ mac_hash({Major, Minor}, MacAlg, MacSecret, Epoch, SeqNo, Type, Length, Fragment calc_aad(Type, {MajVer, MinVer}, Epoch, SeqNo) -> <<?UINT16(Epoch), ?UINT48(SeqNo), ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>. + +init_replay_window(Size) -> + #{size => Size, + top => Size, + bottom => 0, + mask => 0 bsl 64 + }. + +replay_detect(#ssl_tls{sequence_number = SequenceNumber}, #{replay_window := Window}) -> + is_replay(SequenceNumber, Window). + + +is_replay(SequenceNumber, #{bottom := Bottom}) when SequenceNumber < Bottom -> + true; +is_replay(SequenceNumber, #{size := Size, + top := Top, + bottom := Bottom, + mask := Mask}) when (SequenceNumber >= Bottom) andalso (SequenceNumber =< Top) -> + Index = (SequenceNumber rem Size), + (Index band Mask) == 1; + +is_replay(_, _) -> + false. + +update_replay_window(SequenceNumber, #{replay_window := #{size := Size, + top := Top, + bottom := Bottom, + mask := Mask0} = Window0} = ConnectionStates) -> + NoNewBits = SequenceNumber - Top, + Index = SequenceNumber rem Size, + Mask = (Mask0 bsl NoNewBits) bor Index, + Window = Window0#{top => SequenceNumber, + bottom => Bottom + NoNewBits, + mask => Mask}, + ConnectionStates#{replay_window := Window}. diff --git a/lib/ssl/src/dtls_udp_listener.erl b/lib/ssl/src/dtls_udp_listener.erl index f0ace2d887..29380e3008 100644 --- a/lib/ssl/src/dtls_udp_listener.erl +++ b/lib/ssl/src/dtls_udp_listener.erl @@ -121,6 +121,18 @@ handle_info({udp, Socket, IP, InPortNo, _} = Msg, #state{listner = Socket} = Sta next_datagram(Socket), {noreply, State}; +%% UDP socket does not have a connection and should not receive an econnreset +%% This does however happens on on some windows versions. Just ignoring it +%% appears to make things work as expected! +handle_info({udp_error, Socket, econnreset = Error}, #state{listner = Socket} = State) -> + Report = io_lib:format("Ignore SSL UDP Listener: Socket error: ~p ~n", [Error]), + error_logger:info_report(Report), + {noreply, State}; +handle_info({udp_error, Socket, Error}, #state{listner = Socket} = State) -> + Report = io_lib:format("SSL UDP Listener shutdown: Socket error: ~p ~n", [Error]), + error_logger:info_report(Report), + {noreply, State#state{close=true}}; + handle_info({'DOWN', _, process, Pid, _}, #state{clients = Clients, dtls_processes = Processes0, close = ListenClosed} = State) -> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index d9e47c43ad..5421bdef99 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -455,7 +455,16 @@ setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> _:_ -> {error, {options, {not_a_proplist, Options0}}} end; - +setopts(#sslsocket{pid = {{udp, _}, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, Options) when is_list(Options) -> + try dtls_socket:setopts(Transport, ListenSocket, Options) of + ok -> + ok; + {error, InetError} -> + {error, {options, {socket_options, Options, InetError}}} + catch + _:Error -> + {error, {options, {socket_options, Options, Error}}} + end; setopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, Options) when is_list(Options) -> try tls_socket:setopts(Transport, ListenSocket, Options) of ok -> diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index e935e07b65..fb87662c7b 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -905,14 +905,14 @@ handle_call({new_user, User}, From, StateName, handle_call({get_opts, OptTags}, From, _, #state{socket = Socket, transport_cb = Transport, - socket_options = SockOpts}, _) -> - OptsReply = get_socket_opts(Transport, Socket, OptTags, SockOpts, []), + socket_options = SockOpts}, Connection) -> + OptsReply = get_socket_opts(Connection, Transport, Socket, OptTags, SockOpts, []), {keep_state_and_data, [{reply, From, OptsReply}]}; handle_call({set_opts, Opts0}, From, StateName, #state{socket_options = Opts1, socket = Socket, - transport_cb = Transport} = State0, _) -> - {Reply, Opts} = set_socket_opts(Transport, Socket, Opts0, Opts1, []), + transport_cb = Transport} = State0, Connection) -> + {Reply, Opts} = set_socket_opts(Connection, Transport, Socket, Opts0, Opts1, []), State = State0#state{socket_options = Opts}, handle_active_option(Opts#socket_options.active, StateName, From, Reply, State); @@ -1910,42 +1910,39 @@ call(FsmPid, Event) -> {error, closed} end. -get_socket_opts(_,_,[], _, Acc) -> +get_socket_opts(_, _,_,[], _, Acc) -> {ok, Acc}; -get_socket_opts(Transport, Socket, [mode | Tags], SockOpts, Acc) -> - get_socket_opts(Transport, Socket, Tags, SockOpts, +get_socket_opts(Connection, Transport, Socket, [mode | Tags], SockOpts, Acc) -> + get_socket_opts(Connection, Transport, Socket, Tags, SockOpts, [{mode, SockOpts#socket_options.mode} | Acc]); -get_socket_opts(Transport, Socket, [packet | Tags], SockOpts, Acc) -> +get_socket_opts(Connection, Transport, Socket, [packet | Tags], SockOpts, Acc) -> case SockOpts#socket_options.packet of {Type, headers} -> - get_socket_opts(Transport, Socket, Tags, SockOpts, [{packet, Type} | Acc]); + get_socket_opts(Connection, Transport, Socket, Tags, SockOpts, [{packet, Type} | Acc]); Type -> - get_socket_opts(Transport, Socket, Tags, SockOpts, [{packet, Type} | Acc]) + get_socket_opts(Connection, Transport, Socket, Tags, SockOpts, [{packet, Type} | Acc]) end; -get_socket_opts(Transport, Socket, [header | Tags], SockOpts, Acc) -> - get_socket_opts(Transport, Socket, Tags, SockOpts, +get_socket_opts(Connection, Transport, Socket, [header | Tags], SockOpts, Acc) -> + get_socket_opts(Connection, Transport, Socket, Tags, SockOpts, [{header, SockOpts#socket_options.header} | Acc]); -get_socket_opts(Transport, Socket, [active | Tags], SockOpts, Acc) -> - get_socket_opts(Transport, Socket, Tags, SockOpts, +get_socket_opts(Connection, Transport, Socket, [active | Tags], SockOpts, Acc) -> + get_socket_opts(Connection, Transport, Socket, Tags, SockOpts, [{active, SockOpts#socket_options.active} | Acc]); -get_socket_opts(Transport, Socket, [Tag | Tags], SockOpts, Acc) -> - try tls_socket:getopts(Transport, Socket, [Tag]) of - {ok, [Opt]} -> - get_socket_opts(Transport, Socket, Tags, SockOpts, [Opt | Acc]); - {error, Error} -> - {error, {options, {socket_options, Tag, Error}}} - catch - %% So that inet behavior does not crash our process - _:Error -> {error, {options, {socket_options, Tag, Error}}} +get_socket_opts(Connection, Transport, Socket, [Tag | Tags], SockOpts, Acc) -> + case Connection:getopts(Transport, Socket, [Tag]) of + {ok, [Opt]} -> + get_socket_opts(Connection, Transport, Socket, Tags, SockOpts, [Opt | Acc]); + {error, Reason} -> + {error, {options, {socket_options, Tag, Reason}}} end; -get_socket_opts(_, _,Opts, _,_) -> +get_socket_opts(_,_, _,Opts, _,_) -> {error, {options, {socket_options, Opts, function_clause}}}. -set_socket_opts(_,_, [], SockOpts, []) -> +set_socket_opts(_,_,_, [], SockOpts, []) -> {ok, SockOpts}; -set_socket_opts(Transport, Socket, [], SockOpts, Other) -> +set_socket_opts(ConnectionCb, Transport, Socket, [], SockOpts, Other) -> %% Set non emulated options - try tls_socket:setopts(Transport, Socket, Other) of + try ConnectionCb:setopts(Transport, Socket, Other) of ok -> {ok, SockOpts}; {error, InetError} -> @@ -1956,13 +1953,13 @@ set_socket_opts(Transport, Socket, [], SockOpts, Other) -> {{error, {options, {socket_options, Other, Error}}}, SockOpts} end; -set_socket_opts(Transport,Socket, [{mode, Mode}| Opts], SockOpts, Other) +set_socket_opts(ConnectionCb, Transport,Socket, [{mode, Mode}| Opts], SockOpts, Other) when Mode == list; Mode == binary -> - set_socket_opts(Transport, Socket, Opts, + set_socket_opts(ConnectionCb, Transport, Socket, Opts, SockOpts#socket_options{mode = Mode}, Other); -set_socket_opts(_, _, [{mode, _} = Opt| _], SockOpts, _) -> +set_socket_opts(_, _, _, [{mode, _} = Opt| _], SockOpts, _) -> {{error, {options, {socket_options, Opt}}}, SockOpts}; -set_socket_opts(Transport,Socket, [{packet, Packet}| Opts], SockOpts, Other) +set_socket_opts(ConnectionCb, Transport,Socket, [{packet, Packet}| Opts], SockOpts, Other) when Packet == raw; Packet == 0; Packet == 1; @@ -1978,26 +1975,26 @@ set_socket_opts(Transport,Socket, [{packet, Packet}| Opts], SockOpts, Other) Packet == httph; Packet == http_bin; Packet == httph_bin -> - set_socket_opts(Transport, Socket, Opts, + set_socket_opts(ConnectionCb, Transport, Socket, Opts, SockOpts#socket_options{packet = Packet}, Other); -set_socket_opts(_, _, [{packet, _} = Opt| _], SockOpts, _) -> +set_socket_opts(_, _, _, [{packet, _} = Opt| _], SockOpts, _) -> {{error, {options, {socket_options, Opt}}}, SockOpts}; -set_socket_opts(Transport, Socket, [{header, Header}| Opts], SockOpts, Other) +set_socket_opts(ConnectionCb, Transport, Socket, [{header, Header}| Opts], SockOpts, Other) when is_integer(Header) -> - set_socket_opts(Transport, Socket, Opts, + set_socket_opts(ConnectionCb, Transport, Socket, Opts, SockOpts#socket_options{header = Header}, Other); -set_socket_opts(_, _, [{header, _} = Opt| _], SockOpts, _) -> +set_socket_opts(_, _, _, [{header, _} = Opt| _], SockOpts, _) -> {{error,{options, {socket_options, Opt}}}, SockOpts}; -set_socket_opts(Transport, Socket, [{active, Active}| Opts], SockOpts, Other) +set_socket_opts(ConnectionCb, Transport, Socket, [{active, Active}| Opts], SockOpts, Other) when Active == once; Active == true; Active == false -> - set_socket_opts(Transport, Socket, Opts, + set_socket_opts(ConnectionCb, Transport, Socket, Opts, SockOpts#socket_options{active = Active}, Other); -set_socket_opts(_, _, [{active, _} = Opt| _], SockOpts, _) -> +set_socket_opts(_,_, _, [{active, _} = Opt| _], SockOpts, _) -> {{error, {options, {socket_options, Opt}} }, SockOpts}; -set_socket_opts(Transport, Socket, [Opt | Opts], SockOpts, Other) -> - set_socket_opts(Transport, Socket, Opts, SockOpts, [Opt | Other]). +set_socket_opts(ConnectionCb, Transport, Socket, [Opt | Opts], SockOpts, Other) -> + set_socket_opts(ConnectionCb, Transport, Socket, Opts, SockOpts, [Opt | Other]). start_or_recv_cancel_timer(infinity, _RecvFrom) -> undefined; diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 58db8449d6..3cf466e78f 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -2295,6 +2295,8 @@ is_acceptable_hash_sign({_, dsa} = Algos, dsa, _, srp_dss, SupportedHashSigns) - is_acceptable_hash_sign(Algos, SupportedHashSigns); is_acceptable_hash_sign({_, ecdsa} = Algos, ecdsa, _, dhe_ecdsa, SupportedHashSigns) -> is_acceptable_hash_sign(Algos, SupportedHashSigns); +is_acceptable_hash_sign({_, ecdsa} = Algos, ecdsa, ecdsa, ecdh_ecdsa, SupportedHashSigns) -> + is_acceptable_hash_sign(Algos, SupportedHashSigns); is_acceptable_hash_sign({_, ecdsa} = Algos, ecdsa, ecdsa, ecdhe_ecdsa, SupportedHashSigns) -> is_acceptable_hash_sign(Algos, SupportedHashSigns); is_acceptable_hash_sign(_, _, _, KeyExAlgo, _) when diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index a289ee0a65..96c3ab86e9 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -60,7 +60,7 @@ %% Data handling -export([passive_receive/2, next_record_if_active/1, handle_common_event/4, send/3, - socket/5]). + socket/5, setopts/3, getopts/3]). %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states @@ -195,6 +195,10 @@ callback_mode() -> socket(Pid, Transport, Socket, Connection, Tracker) -> tls_socket:socket(Pid, Transport, Socket, Connection, Tracker). +setopts(Transport, Socket, Other) -> + tls_socket:setopts(Transport, Socket, Other). +getopts(Transport, Socket, Tag) -> + tls_socket:getopts(Transport, Socket, Tag). %%-------------------------------------------------------------------- %% State functions diff --git a/lib/ssl/test/ssl_ECC_SUITE.erl b/lib/ssl/test/ssl_ECC_SUITE.erl index 1149513417..0fbb0bb79a 100644 --- a/lib/ssl/test/ssl_ECC_SUITE.erl +++ b/lib/ssl/test/ssl_ECC_SUITE.erl @@ -44,27 +44,74 @@ groups() -> {'tlsv1.2', [], all_versions_groups()}, {'tlsv1.1', [], all_versions_groups()}, {'tlsv1', [], all_versions_groups()}, - {'erlang_server', [], key_cert_combinations()}, - {'erlang_client', [], key_cert_combinations()}, + {'erlang_server', [], openssl_key_cert_combinations()}, + %%{'erlang_client', [], openssl_key_cert_combinations()}, {'erlang', [], key_cert_combinations() ++ misc() ++ ecc_negotiation()} ]. all_versions_groups ()-> [{group, 'erlang_server'}, - {group, 'erlang_client'}, + %%{group, 'erlang_client'}, {group, 'erlang'} ]. + +openssl_key_cert_combinations() -> + ECDH_RSA = case ssl_test_lib:openssl_filter("ECDH-RSA") of + [] -> + []; + _ -> + server_ecdh_rsa() + end, + + ECDHE_RSA = case ssl_test_lib:openssl_filter("ECDHE-RSA") of + [] -> + []; + _ -> + server_ecdhe_rsa() + end, + ECDH_ECDSA = case ssl_test_lib:openssl_filter("ECDH-ECDSA") of + [] -> + []; + _ -> + server_ecdhe_ecdsa() + end, + + ECDHE_ECDSA = case ssl_test_lib:openssl_filter("ECDHE-ECDSA") of + [] -> + []; + _ -> + server_ecdhe_ecdsa() + end, + ECDH_RSA ++ ECDHE_RSA ++ ECDH_ECDSA ++ ECDHE_ECDSA. + key_cert_combinations() -> + server_ecdh_rsa() ++ + server_ecdhe_rsa() ++ + server_ecdh_ecdsa() ++ + server_ecdhe_ecdsa(). + +server_ecdh_rsa() -> [client_ecdh_rsa_server_ecdh_rsa, - client_ecdhe_rsa_server_ecdh_rsa, - client_ecdh_rsa_server_ecdhe_rsa, + client_ecdhe_rsa_server_ecdh_rsa, + client_ecdhe_ecdsa_server_ecdh_rsa]. + +server_ecdhe_rsa() -> + [client_ecdh_rsa_server_ecdhe_rsa, client_ecdhe_rsa_server_ecdhe_rsa, - client_ecdhe_ecdsa_server_ecdhe_rsa, - client_ecdhe_ecdsa_server_ecdhe_ecdsa, - client_ecdh_rsa_server_ecdhe_ecdsa - ]. + client_ecdhe_ecdsa_server_ecdhe_rsa]. + +server_ecdh_ecdsa() -> + [client_ecdh_ecdsa_server_ecdh_ecdsa, + client_ecdhe_rsa_server_ecdh_ecdsa, + client_ecdhe_ecdsa_server_ecdh_ecdsa]. + +server_ecdhe_ecdsa() -> + [client_ecdh_rsa_server_ecdhe_ecdsa, + client_ecdh_ecdsa_server_ecdhe_ecdsa, + client_ecdhe_ecdsa_server_ecdhe_ecdsa]. + misc()-> [client_ecdsa_server_ecdsa_with_raw_key]. @@ -175,37 +222,63 @@ end_per_testcase(_TestCase, Config) -> %% ECDH_RSA client_ecdh_rsa_server_ecdh_rsa(Config) when is_list(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdh_rsa, ecdh_rsa, Config), - basic_test(COpts, SOpts, Config). - + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([], + ecdh_rsa, ecdh_rsa, Config), + basic_test(COpts, SOpts, [{check_keyex, ecdh_rsa} | proplists:delete(check_keyex, Config)]). client_ecdhe_rsa_server_ecdh_rsa(Config) when is_list(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdhe_rsa, ecdh_rsa, Config), - basic_test(COpts, SOpts, Config). - + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([], ecdhe_rsa, ecdh_rsa, Config), + basic_test(COpts, SOpts, [{check_keyex, ecdh_rsa} | proplists:delete(check_keyex, Config)]). +client_ecdhe_ecdsa_server_ecdh_rsa(Config) when is_list(Config) -> + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([],ecdhe_ecdsa, ecdh_rsa, Config), + basic_test(COpts, SOpts, [{check_keyex, ecdh_rsa} | proplists:delete(check_keyex, Config)]). + %% ECDHE_RSA client_ecdh_rsa_server_ecdhe_rsa(Config) when is_list(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdh_rsa, ecdhe_rsa, Config), - basic_test(COpts, SOpts, Config). - + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([], ecdh_rsa, ecdhe_rsa, Config), + basic_test(COpts, SOpts, [{check_keyex, ecdhe_rsa} | proplists:delete(check_keyex, Config)]). client_ecdhe_rsa_server_ecdhe_rsa(Config) when is_list(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdhe_rsa, ecdhe_rsa, Config), - basic_test(COpts, SOpts, Config). - + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([], ecdhe_rsa, ecdhe_rsa, Config), + basic_test(COpts, SOpts, [{check_keyex, ecdhe_rsa} | proplists:delete(check_keyex, Config)]). client_ecdhe_ecdsa_server_ecdhe_rsa(Config) when is_list(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdh_ecdsa, ecdhe_rsa, Config), - basic_test(COpts, SOpts, Config). + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([],ecdh_ecdsa, ecdhe_rsa, Config), + basic_test(COpts, SOpts, [{check_keyex, ecdhe_rsa} | proplists:delete(check_keyex, Config)]). -%% ECDHE_ECDSA -client_ecdhe_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdhe_ecdsa, ecdhe_ecdsa, Config), - basic_test(COpts, SOpts, Config). +%% ECDH_ECDSA +client_ecdh_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) -> + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_peer_opts, + [{extensions, [{key_usage, [keyEncipherment] + }]}]}], + ecdh_ecdsa, ecdh_ecdsa, Config), + basic_test(COpts, SOpts, + [{check_keyex, ecdh_ecdsa} | proplists:delete(check_keyex, Config)]). +client_ecdhe_rsa_server_ecdh_ecdsa(Config) when is_list(Config) -> + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_peer_opts, + [{extensions, [{key_usage, [keyEncipherment] + }]}]}], + ecdhe_rsa, ecdh_ecdsa, Config), + basic_test(COpts, SOpts, [{check_keyex, ecdh_ecdsa} | proplists:delete(check_keyex, Config)]). + +client_ecdhe_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) -> + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_peer_opts, + [{extensions, [{key_usage, [keyEncipherment] + }]}]}], + ecdhe_ecdsa, ecdh_ecdsa, Config), + basic_test(COpts, SOpts, + [{check_keyex, ecdh_ecdsa} | proplists:delete(check_keyex, Config)]). +%% ECDHE_ECDSA client_ecdh_rsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdh_rsa, ecdhe_ecdsa, Config), - basic_test(COpts, SOpts, Config). + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([], ecdh_rsa, ecdhe_ecdsa, Config), + basic_test(COpts, SOpts, [{check_keyex, ecdhe_ecdsa} | proplists:delete(check_keyex, Config)]). +client_ecdh_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([], ecdh_ecdsa, ecdhe_ecdsa, Config), + basic_test(COpts, SOpts, [{check_keyex, ecdhe_ecdsa} | proplists:delete(check_keyex, Config)]). +client_ecdhe_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([], ecdhe_ecdsa, ecdhe_ecdsa, Config), + basic_test(COpts, SOpts, [{check_keyex, ecdhe_ecdsa} | proplists:delete(check_keyex, Config)]). client_ecdsa_server_ecdsa_with_raw_key(Config) when is_list(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdhe_ecdsa, ecdhe_ecdsa, Config), + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([], ecdhe_ecdsa, ecdhe_ecdsa, Config), ServerKeyFile = proplists:get_value(keyfile, SOpts), {ok, PemBin} = file:read_file(ServerKeyFile), PemEntries = public_key:pem_decode(PemBin), @@ -221,7 +294,7 @@ client_ecdsa_server_ecdsa_with_raw_key(Config) when is_list(Config) -> close(Server, Client). ecc_default_order(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdhe_ecdsa, ecdhe_ecdsa, Config), + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([],ecdhe_ecdsa, ecdhe_ecdsa, Config), ECCOpts = [], case supported_eccs([{eccs, [sect571r1]}]) of true -> ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config); @@ -229,7 +302,7 @@ ecc_default_order(Config) -> end. ecc_default_order_custom_curves(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdhe_ecdsa, ecdhe_ecdsa, Config), + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([],ecdhe_ecdsa, ecdhe_ecdsa, Config), ECCOpts = [{eccs, [secp256r1, sect571r1]}], case supported_eccs(ECCOpts) of true -> ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config); @@ -237,7 +310,7 @@ ecc_default_order_custom_curves(Config) -> end. ecc_client_order(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdhe_ecdsa, ecdhe_ecdsa, Config), + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([],ecdhe_ecdsa, ecdhe_ecdsa, Config), ECCOpts = [{honor_ecc_order, false}], case supported_eccs([{eccs, [sect571r1]}]) of true -> ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config); @@ -245,7 +318,7 @@ ecc_client_order(Config) -> end. ecc_client_order_custom_curves(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdhe_ecdsa, ecdhe_ecdsa, Config), + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([],ecdhe_ecdsa, ecdhe_ecdsa, Config), ECCOpts = [{honor_ecc_order, false}, {eccs, [secp256r1, sect571r1]}], case supported_eccs(ECCOpts) of true -> ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config); @@ -253,12 +326,12 @@ ecc_client_order_custom_curves(Config) -> end. ecc_unknown_curve(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdhe_ecdsa, ecdhe_ecdsa, Config), + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([],ecdhe_ecdsa, ecdhe_ecdsa, Config), ECCOpts = [{eccs, ['123_fake_curve']}], ecc_test_error(COpts, SOpts, [], ECCOpts, Config). client_ecdh_rsa_server_ecdhe_ecdsa_server_custom(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdh_rsa, ecdhe_ecdsa, Config), + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([],ecdh_rsa, ecdhe_ecdsa, Config), ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], case supported_eccs(ECCOpts) of true -> ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config); @@ -266,7 +339,7 @@ client_ecdh_rsa_server_ecdhe_ecdsa_server_custom(Config) -> end. client_ecdh_rsa_server_ecdhe_rsa_server_custom(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdh_rsa, ecdhe_rsa, Config), + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([],ecdh_rsa, ecdhe_rsa, Config), ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], case supported_eccs(ECCOpts) of true -> ecc_test(undefined, COpts, SOpts, [], ECCOpts, Config); @@ -274,7 +347,7 @@ client_ecdh_rsa_server_ecdhe_rsa_server_custom(Config) -> end. client_ecdhe_rsa_server_ecdhe_ecdsa_server_custom(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdhe_rsa, ecdhe_ecdsa, Config), + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([],ecdhe_rsa, ecdhe_ecdsa, Config), ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], case supported_eccs(ECCOpts) of true -> ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config); @@ -282,14 +355,16 @@ client_ecdhe_rsa_server_ecdhe_ecdsa_server_custom(Config) -> end. client_ecdhe_rsa_server_ecdhe_rsa_server_custom(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdhe_rsa, ecdhe_rsa, Config), + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([], ecdhe_rsa, ecdhe_rsa, Config), ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], case supported_eccs(ECCOpts) of true -> ecc_test(undefined, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} end. client_ecdhe_rsa_server_ecdh_rsa_server_custom(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdhe_rsa, ecdh_rsa, Config), + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_peer_opts, + [{extensions, [{key_usage, [keyEncipherment] + }]}]}], ecdhe_rsa, ecdh_rsa, Config), ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], case supported_eccs(ECCOpts) of true -> ecc_test(undefined, COpts, SOpts, [], ECCOpts, Config); @@ -297,7 +372,7 @@ client_ecdhe_rsa_server_ecdh_rsa_server_custom(Config) -> end. client_ecdhe_ecdsa_server_ecdhe_ecdsa_server_custom(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdhe_ecdsa, ecdhe_ecdsa, Config), + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([], ecdhe_ecdsa, ecdhe_ecdsa, Config), ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], case supported_eccs(ECCOpts) of true -> ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config); @@ -305,7 +380,7 @@ client_ecdhe_ecdsa_server_ecdhe_ecdsa_server_custom(Config) -> end. client_ecdhe_ecdsa_server_ecdhe_rsa_server_custom(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdhe_ecdsa, ecdhe_rsa, Config), + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([],ecdhe_ecdsa, ecdhe_rsa, Config), ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], case supported_eccs(ECCOpts) of true -> ecc_test(undefined, COpts, SOpts, [], ECCOpts, Config); @@ -313,7 +388,7 @@ client_ecdhe_ecdsa_server_ecdhe_rsa_server_custom(Config) -> end. client_ecdhe_ecdsa_server_ecdhe_ecdsa_client_custom(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdhe_ecdsa, ecdhe_ecdsa, Config), + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([],ecdhe_ecdsa, ecdhe_ecdsa, Config), ECCOpts = [{eccs, [secp256r1, sect571r1]}], case supported_eccs(ECCOpts) of true -> ecc_test(secp256r1, COpts, SOpts, ECCOpts, [], Config); @@ -321,7 +396,7 @@ client_ecdhe_ecdsa_server_ecdhe_ecdsa_client_custom(Config) -> end. client_ecdhe_rsa_server_ecdhe_ecdsa_client_custom(Config) -> - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains(ecdhe_rsa, ecdhe_ecdsa, Config), + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([],ecdhe_rsa, ecdhe_ecdsa, Config), ECCOpts = [{eccs, [secp256r1, sect571r1]}], case supported_eccs(ECCOpts) of true -> ecc_test(secp256r1, COpts, SOpts, ECCOpts, [], Config); @@ -370,10 +445,11 @@ start_client(openssl, Port, ClientOpts, _Config) -> start_client(erlang, Port, ClientOpts, Config) -> {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), + KeyEx = proplists:get_value(check_keyex, Config, false), ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, - {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {mfa, {ssl_test_lib, check_key_exchange_send_active, [KeyEx]}}, {options, [{verify, verify_peer} | ClientOpts]}]). @@ -412,11 +488,12 @@ start_server(openssl, ServerOpts, _Config) -> {OpenSslPort, Port}; start_server(erlang, ServerOpts, Config) -> {_, ServerNode, _} = ssl_test_lib:run_where(Config), + KeyEx = proplists:get_value(check_keyex, Config, false), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, {mfa, {ssl_test_lib, - send_recv_result_active, - []}}, + check_key_exchange_send_active, + [KeyEx]}}, {options, [{verify, verify_peer} | ServerOpts]}]), {Server, ssl_test_lib:inet_port(Server)}. diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 68a99c28dd..77c21d9b57 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -498,12 +498,12 @@ make_rsa_cert_chains(ChainConf, Config, Suffix) -> [{reuseaddr, true}, {verify, verify_peer} | ServerConf] }. -make_ec_cert_chains(ClientChainType, ServerChainType, Config) -> +make_ec_cert_chains(ChainConf, ClientChainType, ServerChainType, Config) -> CryptoSupport = crypto:supports(), KeyGenSpec = key_gen_info(ClientChainType, ServerChainType), ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), atom_to_list(ClientChainType)]), ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), atom_to_list(ServerChainType)]), - GenCertData = x509_test:gen_test_certs([{digest, appropriate_sha(CryptoSupport)} | KeyGenSpec]), + GenCertData = x509_test:gen_test_certs([{digest, appropriate_sha(CryptoSupport)} | KeyGenSpec] ++ ChainConf), [{server_config, ServerConf}, {client_config, ClientConf}] = x509_test:gen_pem_config_files(GenCertData, ClientFileBase, ServerFileBase), @@ -1009,6 +1009,12 @@ openssl_ecdh_rsa_suites() -> lists:filter(fun(Str) -> string_regex_filter(Str, "ECDH-RSA") end, Ciphers). +openssl_filter(FilterStr) -> + Ciphers = string:tokens(os:cmd("openssl ciphers"), ":"), + lists:filter(fun(Str) -> string_regex_filter(Str, FilterStr) + end, Ciphers). + + string_regex_filter(Str, Search) when is_list(Str) -> case re:run(Str, Search, []) of nomatch -> @@ -1174,6 +1180,21 @@ sufficient_crypto_support(Group) when Group == ciphers_ec; %% From ssl_basic sufficient_crypto_support(_) -> true. +check_key_exchange_send_active(Socket, false) -> + send_recv_result_active(Socket); +check_key_exchange_send_active(Socket, KeyEx) -> + {ok, [{cipher_suite, Suite}]} = ssl:connection_information(Socket, [cipher_suite]), + true = check_key_exchange(Suite, KeyEx), + send_recv_result_active(Socket). + +check_key_exchange({KeyEx,_, _}, KeyEx) -> + true; +check_key_exchange({KeyEx,_,_,_}, KeyEx) -> + true; +check_key_exchange(KeyEx1, KeyEx2) -> + ct:pal("Negotiated ~p Expected ~p", [KeyEx1, KeyEx2]), + false. + send_recv_result_active(Socket) -> ssl:send(Socket, "Hello world"), receive diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index 1aac88c308..ad7f2f2e95 100644 --- a/lib/stdlib/doc/src/gen_statem.xml +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -346,7 +346,7 @@ ok <p> To compare styles, here follows the same example using <seealso marker="#type-callback_mode"><em>callback mode</em></seealso> - <c>state_functions</c>, or rather the code to replace + <c>handle_event_function</c>, or rather the code to replace after function <c>init/1</c> of the <c>pushbutton.erl</c> example file above: </p> diff --git a/lib/stdlib/doc/src/string.xml b/lib/stdlib/doc/src/string.xml index 343904a49a..9d5edd9ecf 100644 --- a/lib/stdlib/doc/src/string.xml +++ b/lib/stdlib/doc/src/string.xml @@ -311,7 +311,9 @@ true</pre> <desc> <p> Returns the first codepoint in <c><anno>String</anno></c> - and the rest of <c><anno>String</anno></c> in the tail. + and the rest of <c><anno>String</anno></c> in the tail. Returns + an empty list if <c><anno>String</anno></c> is empty or an + <c>{error, String}</c> tuple if the next byte is invalid. </p> <p><em>Example:</em></p> <pre> @@ -326,7 +328,9 @@ true</pre> <desc> <p> Returns the first grapheme cluster in <c><anno>String</anno></c> - and the rest of <c><anno>String</anno></c> in the tail. + and the rest of <c><anno>String</anno></c> in the tail. Returns + an empty list if <c><anno>String</anno></c> is empty or an + <c>{error, String}</c> tuple if the next byte is invalid. </p> <p><em>Example:</em></p> <pre> diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 7c40058dd8..d53a31db0d 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -92,6 +92,14 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> :: dict:dict(ta(), line()) }). + +%% Are we outside or inside a catch or try/catch? +-type catch_scope() :: 'none' + | 'after_old_catch' + | 'after_try' + | 'wrong_part_of_try' + | 'try_catch'. + %% Define the lint state record. %% 'called' and 'exports' contain {Line, {Function, Arity}}, %% the other function collections contain {Function, Arity}. @@ -135,7 +143,9 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> types = dict:new() %Type definitions :: dict:dict(ta(), #typeinfo{}), exp_types=gb_sets:empty() %Exported types - :: gb_sets:set(ta()) + :: gb_sets:set(ta()), + catch_scope = none %Inside/outside try or catch + :: catch_scope() }). -type lint_state() :: #lint{}. @@ -223,7 +233,15 @@ format_error({redefine_old_bif_import,{F,A}}) -> format_error({redefine_bif_import,{F,A}}) -> io_lib:format("import directive overrides auto-imported BIF ~w/~w~n" " - use \"-compile({no_auto_import,[~w/~w]}).\" to resolve name clash", [F,A,F,A]); - +format_error({get_stacktrace,wrong_part_of_try}) -> + "erlang:get_stacktrace/0 used in the wrong part of 'try' expression. " + "(Use it in the block between 'catch' and 'end'.)"; +format_error({get_stacktrace,after_old_catch}) -> + "erlang:get_stacktrace/0 used following an old-style 'catch' " + "may stop working in a future release. (Use it inside 'try'.)"; +format_error({get_stacktrace,after_try}) -> + "erlang:get_stacktrace/0 used following a 'try' expression " + "may stop working in a future release. (Use it inside 'try'.)"; format_error({deprecated, MFA, ReplacementMFA, Rel}) -> io_lib:format("~s is deprecated and will be removed in ~s; use ~s", [format_mfa(MFA), Rel, format_mfa(ReplacementMFA)]); @@ -568,7 +586,10 @@ start(File, Opts) -> false, Opts)}, {missing_spec_all, bool_option(warn_missing_spec_all, nowarn_missing_spec_all, - false, Opts)} + false, Opts)}, + {get_stacktrace, + bool_option(warn_get_stacktrace, nowarn_get_stacktrace, + true, Opts)} ], Enabled1 = [Category || {Category,true} <- Enabled0], Enabled = ordsets:from_list(Enabled1), @@ -1405,8 +1426,9 @@ call_function(Line, F, A, #lint{usage=Usage0,called=Cd,func=Func,file=File}=St) %% function(Line, Name, Arity, Clauses, State) -> State. function(Line, Name, Arity, Cs, St0) -> - St1 = define_function(Line, Name, Arity, St0#lint{func={Name,Arity}}), - clauses(Cs, St1). + St1 = St0#lint{func={Name,Arity},catch_scope=none}, + St2 = define_function(Line, Name, Arity, St1), + clauses(Cs, St2). -spec define_function(line(), atom(), arity(), lint_state()) -> lint_state(). @@ -2338,22 +2360,24 @@ expr({call,Line,F,As}, Vt, St0) -> expr({'try',Line,Es,Scs,Ccs,As}, Vt, St0) -> %% Currently, we don't allow any exports because later %% passes cannot handle exports in combination with 'after'. - {Evt0,St1} = exprs(Es, Vt, St0), + {Evt0,St1} = exprs(Es, Vt, St0#lint{catch_scope=wrong_part_of_try}), TryLine = {'try',Line}, Uvt = vtunsafe(TryLine, Evt0, Vt), Evt1 = vtupdate(Uvt, Evt0), - {Sccs,St2} = icrt_clauses(Scs++Ccs, TryLine, vtupdate(Evt1, Vt), St1), + {Sccs,St2} = try_clauses(Scs, Ccs, TryLine, + vtupdate(Evt1, Vt), St1), Rvt0 = Sccs, Rvt1 = vtupdate(vtunsafe(TryLine, Rvt0, Vt), Rvt0), Evt2 = vtmerge(Evt1, Rvt1), {Avt0,St} = exprs(As, vtupdate(Evt2, Vt), St2), Avt1 = vtupdate(vtunsafe(TryLine, Avt0, Vt), Avt0), Avt = vtmerge(Evt2, Avt1), - {Avt,St}; + {Avt,St#lint{catch_scope=after_try}}; expr({'catch',Line,E}, Vt, St0) -> %% No new variables added, flag new variables as unsafe. {Evt,St} = expr(E, Vt, St0), - {vtupdate(vtunsafe({'catch',Line}, Evt, Vt), Evt),St}; + {vtupdate(vtunsafe({'catch',Line}, Evt, Vt), Evt), + St#lint{catch_scope=after_old_catch}}; expr({match,_Line,P,E}, Vt, St0) -> {Evt,St1} = expr(E, Vt, St0), {Pvt,Bvt,St2} = pattern(P, vtupdate(Evt, Vt), St1), @@ -3173,6 +3197,17 @@ is_module_dialyzer_option(Option) -> error_handling,race_conditions,no_missing_calls, specdiffs,overspecs,underspecs,unknown]). +%% try_catch_clauses(Scs, Ccs, In, ImportVarTable, State) -> +%% {UpdVt,State}. + +try_clauses(Scs, Ccs, In, Vt, St0) -> + {Csvt0,St1} = icrt_clauses(Scs, Vt, St0), + St2 = St1#lint{catch_scope=try_catch}, + {Csvt1,St3} = icrt_clauses(Ccs, Vt, St2), + Csvt = Csvt0 ++ Csvt1, + UpdVt = icrt_export(Csvt, Vt, In, St3), + {UpdVt,St3}. + %% icrt_clauses(Clauses, In, ImportVarTable, State) -> %% {UpdVt,State}. @@ -3657,7 +3692,8 @@ has_wildcard_field([]) -> false. check_remote_function(Line, M, F, As, St0) -> St1 = deprecated_function(Line, M, F, As, St0), St2 = check_qlc_hrl(Line, M, F, As, St1), - format_function(Line, M, F, As, St2). + St3 = check_get_stacktrace(Line, M, F, As, St2), + format_function(Line, M, F, As, St3). %% check_qlc_hrl(Line, ModName, FuncName, [Arg], State) -> State %% Add warning if qlc:q/1,2 has been called but qlc.hrl has not @@ -3706,6 +3742,23 @@ deprecated_function(Line, M, F, As, St) -> St end. +check_get_stacktrace(Line, erlang, get_stacktrace, [], St) -> + case St of + #lint{catch_scope=none} -> + St; + #lint{catch_scope=try_catch} -> + St; + #lint{catch_scope=Scope} -> + case is_warn_enabled(get_stacktrace, St) of + false -> + St; + true -> + add_warning(Line, {get_stacktrace,Scope}, St) + end + end; +check_get_stacktrace(_, _, _, _, St) -> + St. + -dialyzer({no_match, deprecated_type/5}). deprecated_type(L, M, N, As, St) -> diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 2dcddeb8c2..733932e711 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -1052,6 +1052,9 @@ build_typed_attribute({atom,Aa,record}, build_typed_attribute({atom,Aa,Attr}, {type_def, {call,_,{atom,_,TypeName},Args}, Type}) when Attr =:= 'type' ; Attr =:= 'opaque' -> + lists:foreach(fun({var, A, '_'}) -> ret_err(A, "bad type variable"); + (_) -> ok + end, Args), case lists:all(fun({var, _, _}) -> true; (_) -> false end, Args) of diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl index 168ea4002c..76f0b38108 100644 --- a/lib/stdlib/src/erl_tar.erl +++ b/lib/stdlib/src/erl_tar.erl @@ -176,7 +176,7 @@ check_extract(Name, #read_opts{files=Files}) -> -type tar_entry() :: {filename(), typeflag(), non_neg_integer(), - calendar:datetime(), + tar_time(), mode(), uid(), gid()}. @@ -274,8 +274,13 @@ mode_to_string(Mode, [_|T], Acc) -> mode_to_string(_, [], Acc) -> Acc. -%% Converts a datetime tuple to a readable string -time_to_string({{Y, Mon, Day}, {H, Min, _}}) -> +%% Converts a tar_time() (POSIX time) to a readable string +time_to_string(Secs0) -> + Epoch = calendar:datetime_to_gregorian_seconds(?EPOCH), + Secs = Epoch + Secs0, + DateTime0 = calendar:gregorian_seconds_to_datetime(Secs), + DateTime = calendar:universal_time_to_local_time(DateTime0), + {{Y, Mon, Day}, {H, Min, _}} = DateTime, io_lib:format("~s ~2w ~s:~s ~w", [month(Mon), Day, two_d(H), two_d(Min), Y]). two_d(N) -> @@ -452,7 +457,8 @@ add(Reader, NameOrBin, NameInArchive, Options) do_add(#reader{access=write}=Reader, Name, NameInArchive, Options) when is_list(NameInArchive), is_list(Options) -> - Opts = #add_opts{read_info=fun(F) -> file:read_link_info(F) end}, + RF = fun(F) -> file:read_link_info(F, [{time, posix}]) end, + Opts = #add_opts{read_info=RF}, add1(Reader, Name, NameInArchive, add_opts(Options, Opts)); do_add(#reader{access=read},_,_,_) -> {error, eacces}; @@ -460,7 +466,8 @@ do_add(Reader,_,_,_) -> {error, {badarg, Reader}}. add_opts([dereference|T], Opts) -> - add_opts(T, Opts#add_opts{read_info=fun(F) -> file:read_file_info(F) end}); + RF = fun(F) -> file:read_file_info(F, [{time, posix}]) end, + add_opts(T, Opts#add_opts{read_info=RF}); add_opts([verbose|T], Opts) -> add_opts(T, Opts#add_opts{verbose=true}); add_opts([{chunks,N}|T], Opts) -> @@ -503,7 +510,7 @@ add1(#reader{}=Reader, Name, NameInArchive, #add_opts{read_info=ReadInfo}=Opts) end; add1(Reader, Bin, NameInArchive, Opts) when is_binary(Bin) -> add_verbose(Opts, "a ~ts~n", [NameInArchive]), - Now = calendar:now_to_local_time(erlang:timestamp()), + Now = os:system_time(seconds), Header = #tar_header{ name = NameInArchive, size = byte_size(Bin), @@ -612,7 +619,7 @@ build_header(#tar_header{}=Header, Opts) -> devmajor=Devmaj, devminor=Devmin } = Header, - Mtime = datetime_to_posix(Header#tar_header.mtime), + Mtime = Header#tar_header.mtime, Block0 = ?ZERO_BLOCK, {Block1, Pax0} = write_string(Block0, ?V7_NAME, ?V7_NAME_LEN, Name, ?PAX_PATH, #{}), @@ -770,14 +777,6 @@ join_split_ustar_path([Part|Rest], {ok, Name, nil}) -> join_split_ustar_path([Part|Rest], {ok, Name, Acc}) -> join_split_ustar_path(Rest, {ok, Name, <<Acc/binary,$/,Part/binary>>}). -datetime_to_posix(DateTime) -> - Epoch = calendar:datetime_to_gregorian_seconds(?EPOCH), - Secs = calendar:datetime_to_gregorian_seconds(DateTime), - case Secs - Epoch of - N when N < 0 -> 0; - N -> N - end. - write_octal(Block, Pos, Size, X) -> Octal = zero_pad(format_octal(X), Size-1), if byte_size(Octal) < Size -> @@ -984,7 +983,7 @@ do_get_format(#header_v7{}=V7, Bin) unpack_format(Format, #header_v7{}=V7, Bin, Reader) when is_binary(Bin), byte_size(Bin) =:= ?BLOCK_SIZE -> - Mtime = posix_to_erlang_time(parse_numeric(V7#header_v7.mtime)), + Mtime = parse_numeric(V7#header_v7.mtime), Header0 = #tar_header{ name=parse_string(V7#header_v7.name), mode=parse_numeric(V7#header_v7.mode), @@ -1051,9 +1050,9 @@ unpack_modern(Format, #header_v7{}=V7, Bin, #tar_header{}=Header0) Star = to_star(V7, Bin), Prefix0 = parse_string(Star#header_star.prefix), Atime0 = Star#header_star.atime, - Atime = posix_to_erlang_time(parse_numeric(Atime0)), + Atime = parse_numeric(Atime0), Ctime0 = Star#header_star.ctime, - Ctime = posix_to_erlang_time(parse_numeric(Ctime0)), + Ctime = parse_numeric(Ctime0), {Prefix0, H1#tar_header{ atime=Atime, ctime=Ctime @@ -1313,11 +1312,6 @@ is_header_only_type(?TYPE_LINK) -> true; is_header_only_type(?TYPE_DIR) -> true; is_header_only_type(_) -> false. -posix_to_erlang_time(Sec) -> - OneMillion = 1000000, - Time = calendar:now_to_datetime({Sec div OneMillion, Sec rem OneMillion, 0}), - erlang:universaltime_to_localtime(Time). - foldl_read(#reader{access=read}=Reader, Fun, Accu, #read_opts{}=Opts) when is_function(Fun,4) -> case foldl_read0(Reader, Fun, Accu, Opts) of @@ -1423,7 +1417,7 @@ do_merge_pax(Header, [_Ignore|Rest]) -> do_merge_pax(Header, Rest). %% Returns the time since UNIX epoch as a datetime --spec parse_pax_time(binary()) -> calendar:datetime(). +-spec parse_pax_time(binary()) -> tar_time(). parse_pax_time(Bin) when is_binary(Bin) -> TotalNano = case binary:split(Bin, [<<$.>>]) of [SecondsStr, NanoStr0] -> @@ -1450,8 +1444,7 @@ parse_pax_time(Bin) when is_binary(Bin) -> Micro = TotalNano div 1000, Mega = Micro div 1000000000000, Secs = Micro div 1000000 - (Mega*1000000), - Micro2 = Micro rem 1000000, - calendar:now_to_datetime({Mega, Secs, Micro2}). + Secs. %% Given a regular file reader, reads the whole file and %% parses all extended attributes it contains. @@ -1671,7 +1664,7 @@ set_extracted_file_info(Name, #tar_header{typeflag = ?TYPE_BLOCK}=Header) -> set_device_info(Name, Header); set_extracted_file_info(Name, #tar_header{mtime=Mtime,mode=Mode}) -> Info = #file_info{mode=Mode, mtime=Mtime}, - file:write_file_info(Name, Info). + file:write_file_info(Name, Info, [{time, posix}]). set_device_info(Name, #tar_header{}=Header) -> Mtime = Header#tar_header.mtime, diff --git a/lib/stdlib/src/erl_tar.hrl b/lib/stdlib/src/erl_tar.hrl index d646d02989..cff0c2f500 100644 --- a/lib/stdlib/src/erl_tar.hrl +++ b/lib/stdlib/src/erl_tar.hrl @@ -55,6 +55,8 @@ {string(), binary()} | {string(), file:filename()}]. +-type tar_time() :: non_neg_integer(). + %% The tar header, once fully parsed. -record(tar_header, { name = "" :: string(), %% name of header file entry @@ -62,15 +64,15 @@ uid = 0 :: non_neg_integer(), %% user id of owner gid = 0 :: non_neg_integer(), %% group id of owner size = 0 :: non_neg_integer(), %% length in bytes - mtime :: calendar:datetime(), %% modified time + mtime :: tar_time(), %% modified time typeflag :: char(), %% type of header entry linkname = "" :: string(), %% target name of link uname = "" :: string(), %% user name of owner gname = "" :: string(), %% group name of owner devmajor = 0 :: non_neg_integer(), %% major number of character or block device devminor = 0 :: non_neg_integer(), %% minor number of character or block device - atime :: calendar:datetime(), %% access time - ctime :: calendar:datetime() %% status change time + atime :: tar_time(), %% access time + ctime :: tar_time() %% status change time }). -type tar_header() :: #tar_header{}. diff --git a/lib/stdlib/src/error_logger_file_h.erl b/lib/stdlib/src/error_logger_file_h.erl index 0b262de3ab..76f89841b9 100644 --- a/lib/stdlib/src/error_logger_file_h.erl +++ b/lib/stdlib/src/error_logger_file_h.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -57,7 +57,7 @@ init(File, PrevHandler) -> process_flag(trap_exit, true), case file:open(File, [write]) of {ok,Fd} -> - Depth = get_depth(), + Depth = error_logger:get_format_depth(), State = #st{fd=Fd,filename=File,prev_handler=PrevHandler, depth=Depth}, {ok, State}; @@ -65,14 +65,6 @@ init(File, PrevHandler) -> Error end. -get_depth() -> - case application:get_env(kernel, error_logger_format_depth) of - {ok, Depth} when is_integer(Depth) -> - max(10, Depth); - undefined -> - unlimited - end. - handle_event({_Type, GL, _Msg}, State) when node(GL) =/= node() -> {ok, State}; handle_event(Event, State) -> diff --git a/lib/stdlib/src/error_logger_tty_h.erl b/lib/stdlib/src/error_logger_tty_h.erl index 2f2fd65252..8f0d7b0362 100644 --- a/lib/stdlib/src/error_logger_tty_h.erl +++ b/lib/stdlib/src/error_logger_tty_h.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -44,7 +44,7 @@ %% This one is used when we takeover from the simple error_logger. init({[], {error_logger, Buf}}) -> User = set_group_leader(), - Depth = get_depth(), + Depth = error_logger:get_format_depth(), State = #st{user=User,prev_handler=error_logger,depth=Depth}, write_events(State, Buf), {ok, State}; @@ -56,17 +56,9 @@ init({[], {error_logger_tty_h, PrevHandler}}) -> %% This one is used when we are started directly. init([]) -> User = set_group_leader(), - Depth = get_depth(), + Depth = error_logger:get_format_depth(), {ok, #st{user=User,prev_handler=[],depth=Depth}}. -get_depth() -> - case application:get_env(kernel, error_logger_format_depth) of - {ok, Depth} when is_integer(Depth) -> - max(10, Depth); - undefined -> - unlimited - end. - handle_event({_Type, GL, _Msg}, State) when node(GL) =/= node() -> {ok, State}; handle_event(Event, State) -> diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 6e8f780f7c..f2629a47c2 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -284,8 +284,9 @@ start(EscriptOptions) -> io:format("escript: ~s\n", [Str]), my_halt(127); _:Reason -> + Stk = erlang:get_stacktrace(), io:format("escript: Internal error: ~p\n", [Reason]), - io:format("~p\n", [erlang:get_stacktrace()]), + io:format("~p\n", [Stk]), my_halt(127) end. diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index ba0a7ae8e5..a3d53efd0d 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -107,7 +107,9 @@ %% Internal exports -export([init_it/6]). --import(error_logger, [format/2]). +-define( + STACKTRACE(), + try throw(ok) catch _ -> erlang:get_stacktrace() end). %%%========================================================================= %%% API @@ -326,15 +328,16 @@ init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, Parent, Name0, Mod, Args, Options) -> Name = gen:name(Name0), Debug = gen:debug_options(Name, Options), - HibernateAfterTimeout = gen:hibernate_after(Options), - case catch Mod:init(Args) of - {ok, State} -> + HibernateAfterTimeout = gen:hibernate_after(Options), + + case init_it(Mod, Args) of + {ok, {ok, State}} -> proc_lib:init_ack(Starter, {ok, self()}), loop(Parent, Name, State, Mod, infinity, HibernateAfterTimeout, Debug); - {ok, State, Timeout} -> + {ok, {ok, State, Timeout}} -> proc_lib:init_ack(Starter, {ok, self()}), loop(Parent, Name, State, Mod, Timeout, HibernateAfterTimeout, Debug); - {stop, Reason} -> + {ok, {stop, Reason}} -> %% For consistency, we must make sure that the %% registered name (if any) is unregistered before %% the parent process is notified about the failure. @@ -344,18 +347,25 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); - ignore -> + {ok, ignore} -> gen:unregister_name(Name0), proc_lib:init_ack(Starter, ignore), exit(normal); - {'EXIT', Reason} -> - gen:unregister_name(Name0), - proc_lib:init_ack(Starter, {error, Reason}), - exit(Reason); - Else -> + {ok, Else} -> Error = {bad_return_value, Else}, proc_lib:init_ack(Starter, {error, Error}), - exit(Error) + exit(Error); + {'EXIT', Class, Reason, Stacktrace} -> + gen:unregister_name(Name0), + proc_lib:init_ack(Starter, {error, terminate_reason(Class, Reason, Stacktrace)}), + erlang:raise(Class, Reason, Stacktrace) + end. +init_it(Mod, Args) -> + try + {ok, Mod:init(Args)} + catch + throw:R -> {ok, R}; + Class:R -> {'EXIT', Class, R, erlang:get_stacktrace()} end. %%%======================================================================== @@ -397,7 +407,7 @@ decode_msg(Msg, Parent, Name, State, Mod, Time, HibernateAfterTimeout, Debug, Hi sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug, [Name, State, Mod, Time, HibernateAfterTimeout], Hib); {'EXIT', Parent, Reason} -> - terminate(Reason, Name, undefined, Msg, Mod, State, Debug); + terminate(Reason, ?STACKTRACE(), Name, undefined, Msg, Mod, State, Debug); _Msg when Debug =:= [] -> handle_msg(Msg, Parent, Name, State, Mod, HibernateAfterTimeout); _Msg -> @@ -589,17 +599,11 @@ start_monitor(Node, Name) when is_atom(Node), is_atom(Name) -> %% --------------------------------------------------- %% Helper functions for try-catch of callbacks. %% Returns the return value of the callback, or -%% {'EXIT', ExitReason, ReportReason} (if an exception occurs) -%% -%% ExitReason is the reason that shall be used when the process -%% terminates. +%% {'EXIT', Class, Reason, Stack} (if an exception occurs) %% -%% ReportReason is the reason that shall be printed in the error -%% report. -%% -%% These functions are introduced in order to add the stack trace in -%% the error report produced when a callback is terminated with -%% erlang:exit/1 (OTP-12263). +%% The Class, Reason and Stack are given to erlang:raise/3 +%% to make sure proc_lib receives the proper reasons and +%% stacktraces. %% --------------------------------------------------- try_dispatch({'$gen_cast', Msg}, Mod, State) -> @@ -621,15 +625,10 @@ try_dispatch(Mod, Func, Msg, State) -> [Mod, Msg]), {ok, {noreply, State}}; true -> - Stacktrace = erlang:get_stacktrace(), - {'EXIT', {R, Stacktrace}, {R, Stacktrace}} + {'EXIT', error, R, erlang:get_stacktrace()} end; - error:R -> - Stacktrace = erlang:get_stacktrace(), - {'EXIT', {R, Stacktrace}, {R, Stacktrace}}; - exit:R -> - Stacktrace = erlang:get_stacktrace(), - {'EXIT', R, {R, Stacktrace}} + Class:R -> + {'EXIT', Class, R, erlang:get_stacktrace()} end. try_handle_call(Mod, Msg, From, State) -> @@ -638,12 +637,8 @@ try_handle_call(Mod, Msg, From, State) -> catch throw:R -> {ok, R}; - error:R -> - Stacktrace = erlang:get_stacktrace(), - {'EXIT', {R, Stacktrace}, {R, Stacktrace}}; - exit:R -> - Stacktrace = erlang:get_stacktrace(), - {'EXIT', R, {R, Stacktrace}} + Class:R -> + {'EXIT', Class, R, erlang:get_stacktrace()} end. try_terminate(Mod, Reason, State) -> @@ -654,12 +649,8 @@ try_terminate(Mod, Reason, State) -> catch throw:R -> {ok, R}; - error:R -> - Stacktrace = erlang:get_stacktrace(), - {'EXIT', {R, Stacktrace}, {R, Stacktrace}}; - exit:R -> - Stacktrace = erlang:get_stacktrace(), - {'EXIT', R, {R, Stacktrace}} + Class:R -> + {'EXIT', Class, R, erlang:get_stacktrace()} end; false -> {ok, ok} @@ -684,10 +675,11 @@ handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, HibernateAfterTim {ok, {noreply, NState, Time1}} -> loop(Parent, Name, NState, Mod, Time1, HibernateAfterTimeout, []); {ok, {stop, Reason, Reply, NState}} -> - {'EXIT', R} = - (catch terminate(Reason, Name, From, Msg, Mod, NState, [])), - reply(From, Reply), - exit(R); + try + terminate(Reason, ?STACKTRACE(), Name, From, Msg, Mod, NState, []) + after + reply(From, Reply) + end; Other -> handle_common_reply(Other, Parent, Name, From, Msg, Mod, HibernateAfterTimeout, State) end; handle_msg(Msg, Parent, Name, State, Mod, HibernateAfterTimeout) -> @@ -712,10 +704,11 @@ handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, HibernateAfterTim {noreply, NState}), loop(Parent, Name, NState, Mod, Time1, HibernateAfterTimeout, Debug1); {ok, {stop, Reason, Reply, NState}} -> - {'EXIT', R} = - (catch terminate(Reason, Name, From, Msg, Mod, NState, Debug)), - _ = reply(Name, From, Reply, NState, Debug), - exit(R); + try + terminate(Reason, ?STACKTRACE(), Name, From, Msg, Mod, NState, Debug) + after + _ = reply(Name, From, Reply, NState, Debug) + end; Other -> handle_common_reply(Other, Parent, Name, From, Msg, Mod, HibernateAfterTimeout, State, Debug) end; @@ -730,11 +723,11 @@ handle_common_reply(Reply, Parent, Name, From, Msg, Mod, HibernateAfterTimeout, {ok, {noreply, NState, Time1}} -> loop(Parent, Name, NState, Mod, Time1, HibernateAfterTimeout, []); {ok, {stop, Reason, NState}} -> - terminate(Reason, Name, From, Msg, Mod, NState, []); - {'EXIT', ExitReason, ReportReason} -> - terminate(ExitReason, ReportReason, Name, From, Msg, Mod, State, []); + terminate(Reason, ?STACKTRACE(), Name, From, Msg, Mod, NState, []); + {'EXIT', Class, Reason, Stacktrace} -> + terminate(Class, Reason, Stacktrace, Name, From, Msg, Mod, State, []); {ok, BadReply} -> - terminate({bad_return_value, BadReply}, Name, From, Msg, Mod, State, []) + terminate({bad_return_value, BadReply}, ?STACKTRACE(), Name, From, Msg, Mod, State, []) end. handle_common_reply(Reply, Parent, Name, From, Msg, Mod, HibernateAfterTimeout, State, Debug) -> @@ -748,11 +741,11 @@ handle_common_reply(Reply, Parent, Name, From, Msg, Mod, HibernateAfterTimeout, {noreply, NState}), loop(Parent, Name, NState, Mod, Time1, HibernateAfterTimeout, Debug1); {ok, {stop, Reason, NState}} -> - terminate(Reason, Name, From, Msg, Mod, NState, Debug); - {'EXIT', ExitReason, ReportReason} -> - terminate(ExitReason, ReportReason, Name, From, Msg, Mod, State, Debug); + terminate(Reason, ?STACKTRACE(), Name, From, Msg, Mod, NState, Debug); + {'EXIT', Class, Reason, Stacktrace} -> + terminate(Class, Reason, Stacktrace, Name, From, Msg, Mod, State, Debug); {ok, BadReply} -> - terminate({bad_return_value, BadReply}, Name, From, Msg, Mod, State, Debug) + terminate({bad_return_value, BadReply}, ?STACKTRACE(), Name, From, Msg, Mod, State, Debug) end. reply(Name, {To, Tag}, Reply, State, Debug) -> @@ -770,7 +763,7 @@ system_continue(Parent, Debug, [Name, State, Mod, Time, HibernateAfterTimeout]) -spec system_terminate(_, _, _, [_]) -> no_return(). system_terminate(Reason, _Parent, Debug, [Name, State, Mod, _Time, _HibernateAfterTimeout]) -> - terminate(Reason, Name, undefined, [], Mod, State, Debug). + terminate(Reason, ?STACKTRACE(), Name, undefined, [], Mod, State, Debug). system_code_change([Name, State, Mod, Time, HibernateAfterTimeout], _Module, OldVsn, Extra) -> case catch Mod:code_change(OldVsn, State, Extra) of @@ -811,35 +804,58 @@ print_event(Dev, Event, Name) -> %%% --------------------------------------------------- %%% Terminate the server. +%%% +%%% terminate/8 is triggered by {stop, Reason} or bad +%%% return values. The stacktrace is generated via the +%%% ?STACKTRACE() macro and the ReportReason must not +%%% be wrapped in tuples. +%%% +%%% terminate/9 is triggered in case of error/exit in +%%% the user callback. In this case the report reason +%%% always includes the user stacktrace. +%%% +%%% The reason received in the terminate/2 callbacks +%%% always includes the stacktrace for errors and never +%%% for exits. %%% --------------------------------------------------- - --spec terminate(_, _, _, _, _, _, _) -> no_return(). -terminate(Reason, Name, From, Msg, Mod, State, Debug) -> - terminate(Reason, Reason, Name, From, Msg, Mod, State, Debug). -spec terminate(_, _, _, _, _, _, _, _) -> no_return(). -terminate(ExitReason, ReportReason, Name, From, Msg, Mod, State, Debug) -> - Reply = try_terminate(Mod, ExitReason, State), +terminate(Reason, Stacktrace, Name, From, Msg, Mod, State, Debug) -> + terminate(exit, Reason, Stacktrace, Reason, Name, From, Msg, Mod, State, Debug). + +-spec terminate(_, _, _, _, _, _, _, _, _) -> no_return(). +terminate(Class, Reason, Stacktrace, Name, From, Msg, Mod, State, Debug) -> + ReportReason = {Reason, Stacktrace}, + terminate(Class, Reason, Stacktrace, ReportReason, Name, From, Msg, Mod, State, Debug). + +-spec terminate(_, _, _, _, _, _, _, _, _, _) -> no_return(). +terminate(Class, Reason, Stacktrace, ReportReason, Name, From, Msg, Mod, State, Debug) -> + Reply = try_terminate(Mod, terminate_reason(Class, Reason, Stacktrace), State), case Reply of - {'EXIT', ExitReason1, ReportReason1} -> + {'EXIT', C, R, S} -> FmtState = format_status(terminate, Mod, get(), State), - error_info(ReportReason1, Name, From, Msg, FmtState, Debug), - exit(ExitReason1); + error_info({R, S}, Name, From, Msg, FmtState, Debug), + erlang:raise(C, R, S); _ -> - case ExitReason of - normal -> - exit(normal); - shutdown -> - exit(shutdown); - {shutdown,_}=Shutdown -> - exit(Shutdown); + case {Class, Reason} of + {exit, normal} -> ok; + {exit, shutdown} -> ok; + {exit, {shutdown,_}} -> ok; _ -> FmtState = format_status(terminate, Mod, get(), State), - error_info(ReportReason, Name, From, Msg, FmtState, Debug), - exit(ExitReason) + error_info(ReportReason, Name, From, Msg, FmtState, Debug) end + end, + case Stacktrace of + [] -> + erlang:Class(Reason); + _ -> + erlang:raise(Class, Reason, Stacktrace) end. +terminate_reason(error, Reason, Stacktrace) -> {Reason, Stacktrace}; +terminate_reason(exit, Reason, _Stacktrace) -> Reason. + error_info(_Reason, application_controller, _From, _Msg, _State, _Debug) -> %% OTP-5811 Don't send an error report if it's the system process %% application_controller which is terminating - let init take care @@ -861,14 +877,15 @@ error_info(Reason, Name, From, Msg, State, Debug) -> end end; _ -> - Reason + error_logger:limit_term(Reason) end, {ClientFmt, ClientArgs} = client_stacktrace(From), - format("** Generic server ~p terminating \n" - "** Last message in was ~p~n" - "** When Server state == ~p~n" - "** Reason for termination == ~n** ~p~n" ++ ClientFmt, - [Name, Msg, State, Reason1] ++ ClientArgs), + LimitedState = error_logger:limit_term(State), + error_logger:format("** Generic server ~p terminating \n" + "** Last message in was ~p~n" + "** When Server state == ~p~n" + "** Reason for termination == ~n** ~p~n" ++ ClientFmt, + [Name, Msg, LimitedState, Reason1] ++ ClientArgs), sys:print_log(Debug), ok. client_stacktrace(undefined) -> diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 86109f04b4..b5e9da1e66 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -1722,6 +1722,8 @@ error_info( end; _ -> {Reason,Stacktrace} end, + [LimitedP, LimitedFmtData, LimitedFixedReason] = + [error_logger:limit_term(D) || D <- [P, FmtData, FixedReason]], CBMode = case StateEnter of true -> @@ -1755,8 +1757,8 @@ error_info( [] -> []; [Event|_] -> [Event] end] ++ - [FmtData, - Class,FixedReason, + [LimitedFmtData, + Class,LimitedFixedReason, CBMode] ++ case Q of [_|[_|_] = Events] -> [Events]; @@ -1764,7 +1766,7 @@ error_info( end ++ case P of [] -> []; - _ -> [P] + _ -> [LimitedP] end ++ case FixedStacktrace of [] -> []; diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index 5ed2f4d888..9d447418f8 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -84,6 +84,8 @@ -export([write_unicode_string/1, write_unicode_char/1, deep_unicode_char_list/1]). +-export([limit_term/2]). + -export_type([chars/0, latin1_string/0, continuation/0, fread_error/0, fread_item/0, format_spec/0]). @@ -911,3 +913,116 @@ binrev(L) -> binrev(L, T) -> list_to_binary(lists:reverse(L, T)). + +-spec limit_term(term(), non_neg_integer()) -> term(). + +%% The intention is to mimic the depth limitation of io_lib:write() +%% and io_lib_pretty:print(). The leaves ('...') should never be +%% seen when printed with the same depth. Bitstrings are never +%% truncated, which is OK as long as they are not sent to other nodes. +limit_term(Term, Depth) -> + try test_limit(Term, Depth) of + ok -> Term + catch + throw:limit -> + limit(Term, Depth) + end. + +limit(_, 0) -> '...'; +limit([H|T]=L, D) -> + if + D =:= 1 -> '...'; + true -> + case printable_list(L) of + true -> L; + false -> + [limit(H, D-1)|limit_tail(T, D-1)] + end + end; +limit(Term, D) when is_map(Term) -> + limit_map(Term, D); +limit({}=T, _D) -> T; +limit(T, D) when is_tuple(T) -> + if + D =:= 1 -> '...'; + true -> + list_to_tuple([limit(element(1, T), D-1)| + limit_tail(tl(tuple_to_list(T)), D-1)]) + end; +limit(<<_/bitstring>>=Term, D) -> limit_bitstring(Term, D); +limit(Term, _D) -> Term. + +limit_tail([], _D) -> []; +limit_tail(_, 1) -> ['...']; +limit_tail([H|T], D) -> + [limit(H, D-1)|limit_tail(T, D-1)]; +limit_tail(Other, D) -> + limit(Other, D-1). + +%% Cannot limit maps properly since there is no guarantee that +%% maps:from_list() creates a map with the same internal ordering of +%% the selected associations as in Map. +limit_map(Map, D) -> + maps:from_list(erts_internal:maps_to_list(Map, D)). +%% maps:from_list(limit_map_body(erts_internal:maps_to_list(Map, D), D)). + +%% limit_map_body(_, 0) -> [{'...', '...'}]; +%% limit_map_body([], _) -> []; +%% limit_map_body([{K,V}], D) -> [limit_map_assoc(K, V, D)]; +%% limit_map_body([{K,V}|KVs], D) -> +%% [limit_map_assoc(K, V, D) | limit_map_body(KVs, D-1)]. + +%% limit_map_assoc(K, V, D) -> +%% {limit(K, D-1), limit(V, D-1)}. + +limit_bitstring(B, _D) -> B. %% Keeps all printable binaries. + +test_limit(_, 0) -> throw(limit); +test_limit([H|T]=L, D) when is_integer(D) -> + if + D =:= 1 -> throw(limit); + true -> + case printable_list(L) of + true -> ok; + false -> + test_limit(H, D-1), + test_limit_tail(T, D-1) + end + end; +test_limit(Term, D) when is_map(Term) -> + test_limit_map(Term, D); +test_limit({}, _D) -> ok; +test_limit(T, D) when is_tuple(T) -> + test_limit_tuple(T, 1, tuple_size(T), D); +test_limit(<<_/bitstring>>=Term, D) -> test_limit_bitstring(Term, D); +test_limit(_Term, _D) -> ok. + +test_limit_tail([], _D) -> ok; +test_limit_tail(_, 1) -> throw(limit); +test_limit_tail([H|T], D) -> + test_limit(H, D-1), + test_limit_tail(T, D-1); +test_limit_tail(Other, D) -> + test_limit(Other, D-1). + +test_limit_tuple(_T, I, Sz, _D) when I > Sz -> ok; +test_limit_tuple(_, _, _, 1) -> throw(limit); +test_limit_tuple(T, I, Sz, D) -> + test_limit(element(I, T), D-1), + test_limit_tuple(T, I+1, Sz, D-1). + +test_limit_map(_Map, _D) -> ok. +%% test_limit_map_body(erts_internal:maps_to_list(Map, D), D). + +%% test_limit_map_body(_, 0) -> throw(limit); +%% test_limit_map_body([], _) -> ok; +%% test_limit_map_body([{K,V}], D) -> test_limit_map_assoc(K, V, D); +%% test_limit_map_body([{K,V}|KVs], D) -> +%% test_limit_map_assoc(K, V, D), +%% test_limit_map_body(KVs, D-1). + +%% test_limit_map_assoc(K, V, D) -> +%% test_limit(K, D-1), +%% test_limit(V, D-1). + +test_limit_bitstring(_, _) -> ok. diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index 363705b0f4..3fa54cd0d5 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -264,12 +264,12 @@ exit_p(Class, Reason, Stacktrace) -> case get('$initial_call') of {M,F,A} when is_atom(M), is_atom(F), is_integer(A) -> MFA = {M,F,make_dummy_args(A, [])}, - crash_report(Class, Reason, MFA), + crash_report(Class, Reason, MFA, Stacktrace), erlang:raise(exit, exit_reason(Class, Reason, Stacktrace), Stacktrace); _ -> %% The process dictionary has been cleared or %% possibly modified. - crash_report(Class, Reason, []), + crash_report(Class, Reason, [], Stacktrace), erlang:raise(exit, exit_reason(Class, Reason, Stacktrace), Stacktrace) end. @@ -499,26 +499,28 @@ trans_init(M, F, A) when is_atom(M), is_atom(F) -> %% Generate a crash report. %% ----------------------------------------------------- -crash_report(exit, normal, _) -> ok; -crash_report(exit, shutdown, _) -> ok; -crash_report(exit, {shutdown,_}, _) -> ok; -crash_report(Class, Reason, StartF) -> - OwnReport = my_info(Class, Reason, StartF), +crash_report(exit, normal, _, _) -> ok; +crash_report(exit, shutdown, _, _) -> ok; +crash_report(exit, {shutdown,_}, _, _) -> ok; +crash_report(Class, Reason, StartF, Stacktrace) -> + OwnReport = my_info(Class, Reason, StartF, Stacktrace), LinkReport = linked_info(self()), Rep = [OwnReport,LinkReport], error_logger:error_report(crash_report, Rep). -my_info(Class, Reason, []) -> - my_info_1(Class, Reason); -my_info(Class, Reason, StartF) -> - [{initial_call, StartF}|my_info_1(Class, Reason)]. +my_info(Class, Reason, [], Stacktrace) -> + my_info_1(Class, Reason, Stacktrace); +my_info(Class, Reason, StartF, Stacktrace) -> + [{initial_call, StartF}| + my_info_1(Class, Reason, Stacktrace)]. -my_info_1(Class, Reason) -> +my_info_1(Class, Reason, Stacktrace) -> [{pid, self()}, get_process_info(self(), registered_name), - {error_info, {Class,Reason,erlang:get_stacktrace()}}, + {error_info, {Class,Reason,Stacktrace}}, get_ancestors(self()), - get_process_info(self(), messages), + get_process_info(self(), message_queue_len), + get_messages(self()), get_process_info(self(), links), get_cleaned_dictionary(self()), get_process_info(self(), trap_exit), @@ -538,12 +540,49 @@ get_ancestors(Pid) -> {ancestors,[]} end. +%% The messages and the dictionary are possibly limited too much if +%% some error handles output the messages or the dictionary using ~P +%% or ~W with depth greater than the depth used here (the depth of +%% control characters P and W takes precedence over the depth set by +%% application variable error_logger_format_depth). However, it is +%% assumed that all report handlers call proc_lib:format(). +get_messages(Pid) -> + Messages = get_process_messages(Pid), + {messages, error_logger:limit_term(Messages)}. + +get_process_messages(Pid) -> + Depth = error_logger:get_format_depth(), + case Pid =/= self() orelse Depth =:= unlimited of + true -> + {messages, Messages} = get_process_info(Pid, messages), + Messages; + false -> + %% If there are more messages than Depth, garbage + %% collection can sometimes be avoided by collecting just + %% enough messages for the crash report. It is assumed the + %% process is about to die anyway. + receive_messages(Depth) + end. + +receive_messages(0) -> []; +receive_messages(N) -> + receive + M -> + [M|receive_messages(N - 1)] + after 0 -> + [] + end. + get_cleaned_dictionary(Pid) -> case get_process_info(Pid,dictionary) of - {dictionary,Dict} -> {dictionary,clean_dict(Dict)}; + {dictionary,Dict} -> {dictionary,cleaned_dict(Dict)}; _ -> {dictionary,[]} end. +cleaned_dict(Dict) -> + CleanDict = clean_dict(Dict), + error_logger:limit_term(CleanDict). + clean_dict([{'$ancestors',_}|Dict]) -> clean_dict(Dict); clean_dict([{'$initial_call',_}|Dict]) -> @@ -581,20 +620,24 @@ make_neighbour_reports1([P|Ps]) -> make_neighbour_reports1([]) -> []. +%% Do not include messages or process dictionary, even if +%% error_logger_format_depth is unlimited. make_neighbour_report(Pid) -> [{pid, Pid}, get_process_info(Pid, registered_name), get_initial_call(Pid), get_process_info(Pid, current_function), get_ancestors(Pid), - get_process_info(Pid, messages), + get_process_info(Pid, message_queue_len), + %% get_messages(Pid), get_process_info(Pid, links), - get_cleaned_dictionary(Pid), + %% get_cleaned_dictionary(Pid), get_process_info(Pid, trap_exit), get_process_info(Pid, status), get_process_info(Pid, heap_size), get_process_info(Pid, stack_size), - get_process_info(Pid, reductions) + get_process_info(Pid, reductions), + get_process_info(Pid, current_stacktrace) ]. get_initial_call(Pid) -> @@ -721,24 +764,37 @@ format(CrashReport, Encoding) -> format([OwnReport,LinkReport], Encoding, Depth) -> Extra = {Encoding,Depth}, - OwnFormat = format_report(OwnReport, Extra), - LinkFormat = format_report(LinkReport, Extra), + MyIndent = " ", + OwnFormat = format_report(OwnReport, MyIndent, Extra), + LinkFormat = format_link_report(LinkReport, MyIndent, Extra), Str = io_lib:format(" crasher:~n~ts neighbours:~n~ts", [OwnFormat, LinkFormat]), lists:flatten(Str). -format_report(Rep, Extra) when is_list(Rep) -> - format_rep(Rep, Extra); -format_report(Rep, {Enc,_}) -> - io_lib:format("~"++modifier(Enc)++"p~n", [Rep]). - -format_rep([{initial_call,InitialCall}|Rep], {_Enc,Depth}=Extra) -> - [format_mfa(InitialCall, Depth)|format_rep(Rep, Extra)]; -format_rep([{error_info,{Class,Reason,StackTrace}}|Rep], Extra) -> - [format_exception(Class, Reason, StackTrace, Extra)|format_rep(Rep, Extra)]; -format_rep([{Tag,Data}|Rep], Extra) -> - [format_tag(Tag, Data, Extra)|format_rep(Rep, Extra)]; -format_rep(_, _Extra) -> +format_link_report([Link|Reps], Indent, Extra) -> + Rep = case Link of + {neighbour,Rep0} -> Rep0; + _ -> Link + end, + LinkIndent = [" ",Indent], + [Indent,"neighbour:\n",format_report(Rep, LinkIndent, Extra)| + format_link_report(Reps, Indent, Extra)]; +format_link_report([], _, _) -> + []. + +format_report(Rep, Indent, Extra) when is_list(Rep) -> + format_rep(Rep, Indent, Extra); +format_report(Rep, Indent, {Enc,Depth}) -> + io_lib:format("~s~"++modifier(Enc)++"P~n", [Indent, Rep, Depth]). + +format_rep([{initial_call,InitialCall}|Rep], Indent, Extra) -> + [format_mfa(Indent, InitialCall, Extra)|format_rep(Rep, Indent, Extra)]; +format_rep([{error_info,{Class,Reason,StackTrace}}|Rep], Indent, Extra) -> + [format_exception(Class, Reason, StackTrace, Extra)| + format_rep(Rep, Indent, Extra)]; +format_rep([{Tag,Data}|Rep], Indent, Extra) -> + [format_tag(Indent, Tag, Data, Extra)|format_rep(Rep, Indent, Extra)]; +format_rep(_, _, _Extra) -> []. format_exception(Class, Reason, StackTrace, {Enc,_}=Extra) -> @@ -749,14 +805,14 @@ format_exception(Class, Reason, StackTrace, {Enc,_}=Extra) -> [EI, lib:format_exception(1+length(EI), Class, Reason, StackTrace, StackFun, PF, Enc), "\n"]. -format_mfa({M,F,Args}=StartF, Depth) -> +format_mfa(Indent, {M,F,Args}=StartF, Extra) -> try A = length(Args), - [" initial call: ",atom_to_list(M),$:,atom_to_list(F),$/, + [Indent,"initial call: ",atom_to_list(M),$:,atom_to_list(F),$/, integer_to_list(A),"\n"] catch error:_ -> - format_tag(initial_call, StartF, Depth) + format_tag(Indent, initial_call, StartF, Extra) end. pp_fun({Enc,Depth}) -> @@ -769,12 +825,12 @@ pp_fun({Enc,Depth}) -> io_lib:format("~." ++ integer_to_list(I) ++ P, [Term|Tl]) end. -format_tag(Tag, Data, {_Enc,Depth}) -> +format_tag(Indent, Tag, Data, {_Enc,Depth}) -> case Depth of unlimited -> - io_lib:format(" ~p: ~80.18p~n", [Tag, Data]); + io_lib:format("~s~p: ~80.18p~n", [Indent, Tag, Data]); _ -> - io_lib:format(" ~p: ~80.18P~n", [Tag, Data, Depth]) + io_lib:format("~s~p: ~80.18P~n", [Indent, Tag, Data, Depth]) end. modifier(latin1) -> ""; diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl index 17135dd64a..6f7009b5d9 100644 --- a/lib/stdlib/src/string.erl +++ b/lib/stdlib/src/string.erl @@ -486,12 +486,14 @@ find(String, SearchPattern, trailing) -> %% Fetch first codepoint and return rest in tail -spec next_grapheme(String::unicode:chardata()) -> - maybe_improper_list(grapheme_cluster(),unicode:chardata()). + maybe_improper_list(grapheme_cluster(),unicode:chardata()) | + {error,unicode:chardata()}. next_grapheme(CD) -> unicode_util:gc(CD). %% Fetch first grapheme cluster and return rest in tail -spec next_codepoint(String::unicode:chardata()) -> - maybe_improper_list(char(),unicode:chardata()). + maybe_improper_list(char(),unicode:chardata()) | + {error,unicode:chardata()}. next_codepoint(CD) -> unicode_util:cp(CD). %% Internals @@ -508,7 +510,7 @@ equal_1(A0,B0) -> case {unicode_util:cp(A0), unicode_util:cp(B0)} of {[CP|A],[CP|B]} -> equal_1(A,B); {[], []} -> true; - _ -> false + {L1,L2} when is_list(L1), is_list(L2) -> false end. equal_nocase(A, A) -> true; @@ -517,7 +519,7 @@ equal_nocase(A0, B0) -> unicode_util:cp(unicode_util:casefold(B0))} of {[CP|A],[CP|B]} -> equal_nocase(A,B); {[], []} -> true; - _ -> false + {L1,L2} when is_list(L1), is_list(L2) -> false end. equal_norm(A, A, _Norm) -> true; @@ -526,7 +528,7 @@ equal_norm(A0, B0, Norm) -> unicode_util:cp(unicode_util:Norm(B0))} of {[CP|A],[CP|B]} -> equal_norm(A,B, Norm); {[], []} -> true; - _ -> false + {L1,L2} when is_list(L1), is_list(L2) -> false end. equal_norm_nocase(A, A, _Norm) -> true; @@ -535,7 +537,7 @@ equal_norm_nocase(A0, B0, Norm) -> unicode_util:cp(unicode_util:casefold(unicode_util:Norm(B0)))} of {[CP|A],[CP|B]} -> equal_norm_nocase(A,B, Norm); {[], []} -> true; - _ -> false + {L1,L2} when is_list(L1), is_list(L2) -> false end. reverse_1(CD, Acc) -> diff --git a/lib/stdlib/src/unicode.erl b/lib/stdlib/src/unicode.erl index aa1da400ce..fbe8a94074 100644 --- a/lib/stdlib/src/unicode.erl +++ b/lib/stdlib/src/unicode.erl @@ -250,89 +250,110 @@ encoding_to_bom(latin1) -> -define(GC_N, 200). %% arbitrary number %% Canonical decompose string to list of chars --spec characters_to_nfd_list(chardata()) -> [char()]. +-spec characters_to_nfd_list(chardata()) -> [char()] | {error, [char()], chardata()}. characters_to_nfd_list(CD) -> + characters_to_nfd_list(CD, []). +characters_to_nfd_list(CD, Acc) -> case unicode_util:nfd(CD) of - [GC|Str] when is_list(GC) -> GC++characters_to_nfd_list(Str); - [CP|Str] -> [CP|characters_to_nfd_list(Str)]; - [] -> [] + [GC|Str] when is_list(GC) -> characters_to_nfd_list(Str, lists:reverse(GC, Acc)); + [CP|Str] -> characters_to_nfd_list(Str, [CP | Acc]); + [] -> lists:reverse(Acc); + {error,Error} -> {error, lists:reverse(Acc), Error} end. --spec characters_to_nfd_binary(chardata()) -> unicode_binary(). +-spec characters_to_nfd_binary(chardata()) -> unicode_binary() | {error, unicode_binary(), chardata()}. characters_to_nfd_binary(CD) -> - list_to_binary(characters_to_nfd_binary(CD, ?GC_N, [])). + characters_to_nfd_binary(CD, ?GC_N, [], []). -characters_to_nfd_binary(CD, N, Row) when N > 0 -> +characters_to_nfd_binary(CD, N, Row, Acc) when N > 0 -> case unicode_util:nfd(CD) of - [GC|Str] -> characters_to_nfd_binary(Str, N-1, [GC|Row]); - [] -> [characters_to_binary(lists:reverse(Row))] + [GC|Str] -> characters_to_nfd_binary(Str, N-1, [GC|Row], Acc); + [] -> acc_to_binary(prepend_row_to_acc(Row, Acc)); + {error, Error} -> {error, acc_to_binary(prepend_row_to_acc(Row, Acc)), Error} end; -characters_to_nfd_binary(CD, _, Row) -> - [characters_to_binary(lists:reverse(Row))|characters_to_nfd_binary(CD,?GC_N,[])]. +characters_to_nfd_binary(CD, _, Row, Acc) -> + characters_to_nfd_binary(CD, ?GC_N, [], prepend_row_to_acc(Row, Acc)). %% Compability Canonical decompose string to list of chars. --spec characters_to_nfkd_list(chardata()) -> [char()]. +-spec characters_to_nfkd_list(chardata()) -> [char()] | {error, [char()], chardata()}. characters_to_nfkd_list(CD) -> + characters_to_nfkd_list(CD, []). +characters_to_nfkd_list(CD, Acc) -> case unicode_util:nfkd(CD) of - [GC|Str] when is_list(GC) -> GC++characters_to_nfkd_list(Str); - [CP|Str] -> [CP|characters_to_nfkd_list(Str)]; - [] -> [] + [GC|Str] when is_list(GC) -> characters_to_nfkd_list(Str, lists:reverse(GC, Acc)); + [CP|Str] -> characters_to_nfkd_list(Str, [CP | Acc]); + [] -> lists:reverse(Acc); + {error,Error} -> {error, lists:reverse(Acc), Error} end. --spec characters_to_nfkd_binary(chardata()) -> unicode_binary(). +-spec characters_to_nfkd_binary(chardata()) -> unicode_binary() | {error, unicode_binary(), chardata()}. characters_to_nfkd_binary(CD) -> - list_to_binary(characters_to_nfkd_binary(CD, ?GC_N, [])). + characters_to_nfkd_binary(CD, ?GC_N, [], []). -characters_to_nfkd_binary(CD, N, Row) when N > 0 -> +characters_to_nfkd_binary(CD, N, Row, Acc) when N > 0 -> case unicode_util:nfkd(CD) of - [GC|Str] -> characters_to_nfkd_binary(Str, N-1, [GC|Row]); - [] -> [characters_to_binary(lists:reverse(Row))] + [GC|Str] -> characters_to_nfkd_binary(Str, N-1, [GC|Row], Acc); + [] -> acc_to_binary(prepend_row_to_acc(Row, Acc)); + {error, Error} -> {error, acc_to_binary(prepend_row_to_acc(Row, Acc)), Error} end; -characters_to_nfkd_binary(CD, _, Row) -> - [characters_to_binary(lists:reverse(Row))|characters_to_nfkd_binary(CD,?GC_N,[])]. +characters_to_nfkd_binary(CD, _, Row, Acc) -> + characters_to_nfkd_binary(CD, ?GC_N, [], prepend_row_to_acc(Row, Acc)). %% Canonical compose string to list of chars --spec characters_to_nfc_list(chardata()) -> [char()]. +-spec characters_to_nfc_list(chardata()) -> [char()] | {error, [char()], chardata()}. characters_to_nfc_list(CD) -> + characters_to_nfc_list(CD, []). +characters_to_nfc_list(CD, Acc) -> case unicode_util:nfc(CD) of - [CPs|Str] when is_list(CPs) -> CPs ++ characters_to_nfc_list(Str); - [CP|Str] -> [CP|characters_to_nfc_list(Str)]; - [] -> [] + [GC|Str] when is_list(GC) -> characters_to_nfc_list(Str, lists:reverse(GC, Acc)); + [CP|Str] -> characters_to_nfc_list(Str, [CP | Acc]); + [] -> lists:reverse(Acc); + {error,Error} -> {error, lists:reverse(Acc), Error} end. --spec characters_to_nfc_binary(chardata()) -> unicode_binary(). +-spec characters_to_nfc_binary(chardata()) -> unicode_binary() | {error, unicode_binary(), chardata()}. characters_to_nfc_binary(CD) -> - list_to_binary(characters_to_nfc_binary(CD, ?GC_N, [])). + characters_to_nfc_binary(CD, ?GC_N, [], []). -characters_to_nfc_binary(CD, N, Row) when N > 0 -> +characters_to_nfc_binary(CD, N, Row, Acc) when N > 0 -> case unicode_util:nfc(CD) of - [GC|Str] -> characters_to_nfc_binary(Str, N-1, [GC|Row]); - [] -> [characters_to_binary(lists:reverse(Row))] + [GC|Str] -> characters_to_nfc_binary(Str, N-1, [GC|Row], Acc); + [] -> acc_to_binary(prepend_row_to_acc(Row, Acc)); + {error, Error} -> {error, acc_to_binary(prepend_row_to_acc(Row, Acc)), Error} end; -characters_to_nfc_binary(CD, _, Row) -> - [characters_to_binary(lists:reverse(Row))|characters_to_nfc_binary(CD,?GC_N,[])]. +characters_to_nfc_binary(CD, _, Row, Acc) -> + characters_to_nfc_binary(CD, ?GC_N, [], prepend_row_to_acc(Row, Acc)). %% Compability Canonical compose string to list of chars --spec characters_to_nfkc_list(chardata()) -> [char()]. +-spec characters_to_nfkc_list(chardata()) -> [char()] | {error, [char()], chardata()}. characters_to_nfkc_list(CD) -> + characters_to_nfkc_list(CD, []). +characters_to_nfkc_list(CD, Acc) -> case unicode_util:nfkc(CD) of - [CPs|Str] when is_list(CPs) -> CPs ++ characters_to_nfkc_list(Str); - [CP|Str] -> [CP|characters_to_nfkc_list(Str)]; - [] -> [] + [GC|Str] when is_list(GC) -> characters_to_nfkc_list(Str, lists:reverse(GC, Acc)); + [CP|Str] -> characters_to_nfkc_list(Str, [CP | Acc]); + [] -> lists:reverse(Acc); + {error,Error} -> {error, lists:reverse(Acc), Error} end. --spec characters_to_nfkc_binary(chardata()) -> unicode_binary(). +-spec characters_to_nfkc_binary(chardata()) -> unicode_binary() | {error, unicode_binary(), chardata()}. characters_to_nfkc_binary(CD) -> - list_to_binary(characters_to_nfkc_binary(CD, ?GC_N, [])). + characters_to_nfkc_binary(CD, ?GC_N, [], []). -characters_to_nfkc_binary(CD, N, Row) when N > 0 -> +characters_to_nfkc_binary(CD, N, Row, Acc) when N > 0 -> case unicode_util:nfkc(CD) of - [GC|Str] -> characters_to_nfkc_binary(Str, N-1, [GC|Row]); - [] -> [characters_to_binary(lists:reverse(Row))] + [GC|Str] -> characters_to_nfkc_binary(Str, N-1, [GC|Row], Acc); + [] -> acc_to_binary(prepend_row_to_acc(Row, Acc)); + {error, Error} -> {error, acc_to_binary(prepend_row_to_acc(Row, Acc)), Error} end; -characters_to_nfkc_binary(CD, _, Row) -> - [characters_to_binary(lists:reverse(Row))|characters_to_nfkc_binary(CD,?GC_N,[])]. +characters_to_nfkc_binary(CD, _, Row, Acc) -> + characters_to_nfkc_binary(CD, ?GC_N, [], prepend_row_to_acc(Row, Acc)). + +acc_to_binary(Acc) -> + list_to_binary(lists:reverse(Acc)). +prepend_row_to_acc(Row, Acc) -> + [characters_to_binary(lists:reverse(Row))|Acc]. %% internals diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 03cad2c093..cc3d605840 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -65,7 +65,8 @@ maps/1,maps_type/1,maps_parallel_match/1, otp_11851/1,otp_11879/1,otp_13230/1, record_errors/1, otp_11879_cont/1, - non_latin1_module/1, otp_14323/1]). + non_latin1_module/1, otp_14323/1, + get_stacktrace/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -85,7 +86,8 @@ all() -> too_many_arguments, basic_errors, bin_syntax_errors, predef, maps, maps_type, maps_parallel_match, otp_11851, otp_11879, otp_13230, - record_errors, otp_11879_cont, non_latin1_module, otp_14323]. + record_errors, otp_11879_cont, non_latin1_module, otp_14323, + get_stacktrace]. groups() -> [{unused_vars_warn, [], @@ -3976,10 +3978,71 @@ otp_14323(Config) -> {13,erl_lint,{undefined_function,{a,1}}}, {14,erl_lint,{bad_dialyzer_attribute, {nowarn_function,{a,-1}}}}], - []}}], + []}}, + {otp_14323_2, + <<"-type t(_) :: atom().">>, + [], + {errors,[{1,erl_parse,"bad type variable"}],[]}}], [] = run(Config, Ts), ok. +get_stacktrace(Config) -> + Ts = [{old_catch, + <<"t1() -> + catch error(foo), + erlang:get_stacktrace(). + ">>, + [], + {warnings,[{3,erl_lint,{get_stacktrace,after_old_catch}}]}}, + {nowarn_get_stacktrace, + <<"t1() -> + catch error(foo), + erlang:get_stacktrace(). + ">>, + [nowarn_get_stacktrace], + []}, + {try_catch, + <<"t1(X) -> + try abs(X) of + _ -> + erlang:get_stacktrace() + catch + _:_ -> ok + end. + + t2() -> + try error(foo) + catch _:_ -> ok + end, + erlang:get_stacktrace(). + + t3() -> + try error(foo) + catch _:_ -> + try error(bar) + catch _:_ -> + ok + end, + erlang:get_stacktrace() + end. + + no_warning(X) -> + try + abs(X) + catch + _:_ -> + erlang:get_stacktrace() + end. + ">>, + [], + {warnings,[{4,erl_lint,{get_stacktrace,wrong_part_of_try}}, + {13,erl_lint,{get_stacktrace,after_try}}, + {22,erl_lint,{get_stacktrace,after_try}}]}}], + + run(Config, Ts), + ok. + + run(Config, Tests) -> F = fun({N,P,Ws,E}, BadL) -> case catch run_test(Config, P, Ws) of diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 7e3c71715e..2e9dc4d4fb 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -404,7 +404,7 @@ crash(Config) when is_list(Config) -> end, receive {error_report,_,{Pid4,crash_report,[List4|_]}} -> - {exit,crashed,_} = proplists:get_value(error_info, List4), + {exit,crashed,[{?MODULE, handle_call, 3, _}|_]} = proplists:get_value(error_info, List4), Pid4 = proplists:get_value(pid, List4); Other4 -> io:format("Unexpected: ~p", [Other4]), diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index ef3f0be5d7..e2c73371cd 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -31,7 +31,7 @@ otp_10836/1, io_lib_width_too_small/1, io_with_huge_message_queue/1, format_string/1, maps/1, coverage/1, otp_14178_unicode_atoms/1, otp_14175/1, - otp_14285/1]). + otp_14285/1, limit_term/1]). -export([pretty/2]). @@ -63,7 +63,7 @@ all() -> io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836, io_lib_width_too_small, io_with_huge_message_queue, format_string, maps, coverage, otp_14178_unicode_atoms, otp_14175, - otp_14285]. + otp_14285, limit_term]. %% Error cases for output. error_1(Config) when is_list(Config) -> @@ -2373,3 +2373,58 @@ otp_14285(_Config) -> latin1_fmt(Fmt, Args) -> L = fmt(Fmt, Args), true = lists:all(fun is_latin1/1, L). + +limit_term(_Config) -> + {_, 2} = limt([a,b,c], 2), + {_, 2} = limt([a,b,c], 3), + {_, 2} = limt([a,b|c], 2), + {_, 2} = limt([a,b|c], 3), + {_, 2} = limt({a,b,c,[d,e]}, 2), + {_, 2} = limt({a,b,c,[d,e]}, 3), + {_, 2} = limt({a,b,c,[d,e]}, 4), + {_, 1} = limt(<<"foo">>, 18), + ok = blimt(<<"123456789012345678901234567890">>), + {_, 1} = limt(<<7:3>>, 2), + {_, 1} = limt(<<7:21>>, 2), + {_, 1} = limt([], 2), + {_, 1} = limt({}, 2), + {_, 1} = limt(#{}, 2), + {_, 1} = limt(#{[] => {}}, 2), + {_, 1} = limt(#{[] => {}}, 3), + T = #{[] => {},[a] => [b]}, + {_, 1} = limt(T, 2), + {_, 1} = limt(T, 3), + {_, 1} = limt(T, 4), + ok. + +blimt(Binary) -> + blimt(Binary, byte_size(Binary)). + +blimt(_B, 1) -> ok; +blimt(B, D) -> + {_, 1} = limt(B, D), + blimt(B, D - 1). + +limt(Term, Depth) when is_integer(Depth) -> + T1 = io_lib:limit_term(Term, Depth), + S = form(Term, Depth), + S1 = form(T1, Depth), + OK1 = S1 =:= S, + + T2 = io_lib:limit_term(Term, Depth+1), + S2 = form(T2, Depth), + OK2 = S2 =:= S, + + T3 = io_lib:limit_term(Term, Depth-1), + S3 = form(T3, Depth), + OK3 = S3 =/= S, + + R = case {OK1, OK2, OK3} of + {true, true, true} -> 2; + {true, true, false} -> 1; + _ -> 0 + end, + {{S, S1, S2}, R}. + +form(Term, Depth) -> + lists:flatten(io_lib:format("~W", [Term, Depth])). diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl index 4320b735ac..90f980c0e5 100644 --- a/lib/stdlib/test/string_SUITE.erl +++ b/lib/stdlib/test/string_SUITE.erl @@ -582,6 +582,8 @@ cd_gc(_) -> [$e,778] = string:next_codepoint([$e,778]), [$e|<<204,138>>] = string:next_codepoint(<<$e,778/utf8>>), [778|_] = string:next_codepoint(tl(string:next_codepoint(<<$e,778/utf8>>))), + [0|<<128,1>>] = string:next_codepoint(<<0,128,1>>), + {error,<<128,1>>} = string:next_codepoint(<<128,1>>), [] = string:next_grapheme(""), [] = string:next_grapheme(<<>>), @@ -589,6 +591,8 @@ cd_gc(_) -> "abcd" = string:next_grapheme("abcd"), [[$e,778]] = string:next_grapheme([$e,778]), [[$e,778]] = string:next_grapheme(<<$e,778/utf8>>), + [0|<<128,1>>] = string:next_grapheme(<<0,128,1>>), + {error,<<128,1>>} = string:next_grapheme(<<128,1>>), ok. diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl index e9ab12e061..4061008812 100644 --- a/lib/stdlib/test/tar_SUITE.erl +++ b/lib/stdlib/test/tar_SUITE.erl @@ -27,7 +27,8 @@ extract_from_binary_compressed/1, extract_filtered/1, extract_from_open_file/1, symlinks/1, open_add_close/1, cooked_compressed/1, memory/1,unicode/1,read_other_implementations/1, - sparse/1, init/1, leading_slash/1, dotdot/1]). + sparse/1, init/1, leading_slash/1, dotdot/1, + roundtrip_metadata/1]). -include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). @@ -41,7 +42,7 @@ all() -> extract_filtered, symlinks, open_add_close, cooked_compressed, memory, unicode, read_other_implementations, - sparse,init,leading_slash,dotdot]. + sparse,init,leading_slash,dotdot,roundtrip_metadata]. groups() -> []. @@ -953,6 +954,42 @@ dotdot(Config) -> ok. +roundtrip_metadata(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + Dir = filename:join(PrivDir, ?FUNCTION_NAME), + ok = file:make_dir(Dir), + + do_roundtrip_metadata(Dir, "name-does-not-matter"), + ok. + +do_roundtrip_metadata(Dir, File) -> + Tar = filename:join(Dir, atom_to_list(?FUNCTION_NAME)++".tar"), + BeamFile = code:which(compile), + {ok,Fd} = erl_tar:open(Tar, [write]), + ok = erl_tar:add(Fd, BeamFile, File, []), + ok = erl_tar:close(Fd), + + ok = erl_tar:extract(Tar, [{cwd,Dir}]), + + %% Make sure that size and modification times are the same + %% on all platforms. + {ok,OrigInfo} = file:read_file_info(BeamFile), + ExtractedFile = filename:join(Dir, File), + {ok,ExtractedInfo} = file:read_file_info(ExtractedFile), + #file_info{size=Size,mtime=Mtime,type=regular} = OrigInfo, + #file_info{size=Size,mtime=Mtime,type=regular} = ExtractedInfo, + + %% On Unix platforms more fields are expected to be the same. + case os:type() of + {unix,_} -> + #file_info{access=Access,mode=Mode} = OrigInfo, + #file_info{access=Access,mode=Mode} = ExtractedInfo, + ok; + _ -> + ok + end. + + %% Delete the given list of files. delete_files([]) -> ok; delete_files([Item|Rest]) -> diff --git a/lib/stdlib/test/unicode_SUITE.erl b/lib/stdlib/test/unicode_SUITE.erl index 3d97ab93f1..e01ba3fbb0 100644 --- a/lib/stdlib/test/unicode_SUITE.erl +++ b/lib/stdlib/test/unicode_SUITE.erl @@ -998,6 +998,30 @@ normalize(_) -> true = unicode:characters_to_nfkc_list("ホンダ") =:= unicode:characters_to_nfkc_list("ﾎﾝﾀﾞ"), true = unicode:characters_to_nfkd_list("32") =:= unicode:characters_to_nfkd_list("３２"), + + {error, [0], <<128>>} = unicode:characters_to_nfc_list(<<0, 128>>), + {error, [0], <<128>>} = unicode:characters_to_nfkc_list(<<0, 128>>), + {error, [0], <<128>>} = unicode:characters_to_nfd_list(<<0, 128>>), + {error, [0], <<128>>} = unicode:characters_to_nfkd_list(<<0, 128>>), + + {error, <<0>>, <<128>>} = unicode:characters_to_nfc_binary(<<0, 128>>), + {error, <<0>>, <<128>>} = unicode:characters_to_nfkc_binary(<<0, 128>>), + {error, <<0>>, <<128>>} = unicode:characters_to_nfd_binary(<<0, 128>>), + {error, <<0>>, <<128>>} = unicode:characters_to_nfkd_binary(<<0, 128>>), + + LargeBin = binary:copy(<<"abcde">>, 50), + LargeList = binary_to_list(LargeBin), + + {error, LargeList, <<128>>} = unicode:characters_to_nfc_list(<<LargeBin/binary, 128>>), + {error, LargeList, <<128>>} = unicode:characters_to_nfkc_list(<<LargeBin/binary, 128>>), + {error, LargeList, <<128>>} = unicode:characters_to_nfd_list(<<LargeBin/binary, 128>>), + {error, LargeList, <<128>>} = unicode:characters_to_nfkd_list(<<LargeBin/binary, 128>>), + + {error, LargeBin, <<128>>} = unicode:characters_to_nfc_binary(<<LargeBin/binary, 128>>), + {error, LargeBin, <<128>>} = unicode:characters_to_nfkc_binary(<<LargeBin/binary, 128>>), + {error, LargeBin, <<128>>} = unicode:characters_to_nfd_binary(<<LargeBin/binary, 128>>), + {error, LargeBin, <<128>>} = unicode:characters_to_nfkd_binary(<<LargeBin/binary, 128>>), + ok. diff --git a/lib/stdlib/test/unicode_util_SUITE.erl b/lib/stdlib/test/unicode_util_SUITE.erl index e9b3d7f98d..03c24c7027 100644 --- a/lib/stdlib/test/unicode_util_SUITE.erl +++ b/lib/stdlib/test/unicode_util_SUITE.erl @@ -97,6 +97,8 @@ cp(_) -> "hejsan" = fetch(<<"hejsan">>, Get), "hejsan" = fetch(["hej",<<"san">>], Get), "hejsan" = fetch(["hej"|<<"san">>], Get), + {error, <<128>>} = Get(<<128>>), + {error, [<<128>>, 0]} = Get([<<128>>, 0]), ok. gc(Config) -> @@ -106,6 +108,8 @@ gc(Config) -> "hejsan" = fetch(<<"hejsan">>, Get), "hejsan" = fetch(["hej",<<"san">>], Get), "hejsan" = fetch(["hej"|<<"san">>], Get), + {error, <<128>>} = Get(<<128>>), + {error, [<<128>>, 0]} = Get([<<128>>, 0]), 0 = fold(fun verify_gc/3, 0, DataDir ++ "/GraphemeBreakTest.txt"), ok. diff --git a/lib/stdlib/uc_spec/gen_unicode_mod.escript b/lib/stdlib/uc_spec/gen_unicode_mod.escript index c8b815e435..fefd7d3b70 100755 --- a/lib/stdlib/uc_spec/gen_unicode_mod.escript +++ b/lib/stdlib/uc_spec/gen_unicode_mod.escript @@ -170,7 +170,7 @@ gen_header(Fd) -> io:put_chars(Fd, "-export([spec_version/0, lookup/1, get_case/1]).\n"), io:put_chars(Fd, "-inline([class/1]).\n"), io:put_chars(Fd, "-compile(nowarn_unused_vars).\n"), - io:put_chars(Fd, "-dialyzer({no_improper_lists, cp/1}).\n"), + io:put_chars(Fd, "-dialyzer({no_improper_lists, [cp/1, gc_prepend/2, gc_e_cont/2]}).\n"), io:put_chars(Fd, "-type gc() :: char()|[char()].\n\n\n"), ok. @@ -237,39 +237,43 @@ gen_static(Fd) -> gen_norm(Fd) -> io:put_chars(Fd, - "-spec nfd(unicode:chardata()) -> maybe_improper_list(gc(),unicode:chardata()).\n" + "-spec nfd(unicode:chardata()) -> maybe_improper_list(gc(),unicode:chardata()) | {error, unicode:chardata()}.\n" "nfd(Str0) ->\n" " case gc(Str0) of\n" " [GC|R] when GC < 127 -> [GC|R];\n" " [GC|Str] -> [decompose(GC)|Str];\n" - " [] -> []\n end.\n\n" + " [] -> [];\n" + " {error,_}=Error -> Error\n end.\n\n" ), io:put_chars(Fd, - "-spec nfkd(unicode:chardata()) -> maybe_improper_list(gc(),unicode:chardata()).\n" + "-spec nfkd(unicode:chardata()) -> maybe_improper_list(gc(),unicode:chardata()) | {error, unicode:chardata()}.\n" "nfkd(Str0) ->\n" " case gc(Str0) of\n" " [GC|R] when GC < 127 -> [GC|R];\n" " [GC|Str] -> [decompose_compat(GC)|Str];\n" - " [] -> []\n end.\n\n" + " [] -> [];\n" + " {error,_}=Error -> Error\n end.\n\n" ), io:put_chars(Fd, - "-spec nfc(unicode:chardata()) -> maybe_improper_list(gc(),unicode:chardata()).\n" + "-spec nfc(unicode:chardata()) -> maybe_improper_list(gc(),unicode:chardata()) | {error, unicode:chardata()}.\n" "nfc(Str0) ->\n" " case gc(Str0) of\n" " [GC|R] when GC < 255 -> [GC|R];\n" " [GC|Str] -> [compose(decompose(GC))|Str];\n" - " [] -> []\n end.\n\n" + " [] -> [];\n" + " {error,_}=Error -> Error\n end.\n\n" ), io:put_chars(Fd, - "-spec nfkc(unicode:chardata()) -> maybe_improper_list(gc(),unicode:chardata()).\n" + "-spec nfkc(unicode:chardata()) -> maybe_improper_list(gc(),unicode:chardata()) | {error, unicode:chardata()}.\n" "nfkc(Str0) ->\n" " case gc(Str0) of\n" " [GC|R] when GC < 127 -> [GC|R];\n" " [GC|Str] -> [compose_compat_0(decompose_compat(GC))|Str];\n" - " [] -> []\n end.\n\n" + " [] -> [];\n" + " {error,_}=Error -> Error\n end.\n\n" ), io:put_chars(Fd, @@ -448,18 +452,20 @@ gen_ws(Fd, Props) -> gen_cp(Fd) -> io:put_chars(Fd, "-spec cp(String::unicode:chardata()) ->" - " maybe_improper_list().\n"), + " maybe_improper_list() | {error, unicode:chardata()}.\n"), io:put_chars(Fd, "cp([C|_]=L) when is_integer(C) -> L;\n"), io:put_chars(Fd, "cp([List]) -> cp(List);\n"), io:put_chars(Fd, "cp([List|R]) ->\n"), io:put_chars(Fd, " case cp(List) of\n"), io:put_chars(Fd, " [] -> cp(R);\n"), io:put_chars(Fd, " [CP] -> [CP|R];\n"), - io:put_chars(Fd, " [C|R0] -> [C|[R0|R]]\n"), + io:put_chars(Fd, " [C|R0] -> [C|[R0|R]];\n"), + io:put_chars(Fd, " {error,Error} -> {error,[Error|R]}\n"), io:put_chars(Fd, " end;\n"), io:put_chars(Fd, "cp([]) -> [];\n"), io:put_chars(Fd, "cp(<<C/utf8, R/binary>>) -> [C|R];\n"), - io:put_chars(Fd, "cp(<<>>) -> [].\n\n"), + io:put_chars(Fd, "cp(<<>>) -> [];\n"), + io:put_chars(Fd, "cp(<<R/binary>>) -> {error,R}.\n\n"), ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -468,7 +474,7 @@ gen_gc(Fd, GBP) -> %% see http://www.unicode.org/reports/tr29/#Grapheme_Cluster_Boundary_Rules io:put_chars(Fd, "-spec gc(String::unicode:chardata()) ->" - " maybe_improper_list().\n"), + " maybe_improper_list() | {error, unicode:chardata()}.\n"), io:put_chars(Fd, "gc(Str) ->\n" " gc_1(cp(Str)).\n\n" @@ -521,7 +527,8 @@ gen_gc(Fd, GBP) -> [GenEBG(CP) || CP <- merge_ranges(maps:get(e_base_gaz,GBP))], io:put_chars(Fd, "gc_1([CP|R]) -> gc_extend(R, CP);\n"), - io:put_chars(Fd, "gc_1([]) -> [].\n\n"), + io:put_chars(Fd, "gc_1([]) -> [];\n"), + io:put_chars(Fd, "gc_1({error,_}=Error) -> Error.\n\n"), io:put_chars(Fd, "%% Handle Prepend\n"), io:put_chars(Fd, @@ -536,7 +543,8 @@ gen_gc(Fd, GBP) -> " [GC|R1] -> [[CP0|GC]|R1]\n" " end\n" " end;\n" - " [] -> [CP0]\n" + " [] -> [CP0];\n" + " {error,R} -> [CP0|R]\n" " end.\n\n"), IsCtrl = fun(Range) -> io:format(Fd, "is_control~s true;\n", [gen_single_clause(Range)]) end, @@ -574,7 +582,10 @@ gen_gc(Fd, GBP) -> " [_]=Acc -> Acc;\n" " [_|_]=Acc -> [lists:reverse(Acc)];\n" " Acc -> [Acc]\n" - " end.\n\n"), + " end;\n" + "gc_extend({error,R}, T, Acc0) ->\n" + " gc_extend([], T, Acc0) ++ [R].\n\n" + ), [ZWJ] = maps:get(zwj, GBP), GenExtend = fun(R) when R =:= ZWJ -> io:format(Fd, "is_extend~s zwj;\n", [gen_single_clause(ZWJ)]); (Range) -> io:format(Fd, "is_extend~s true;\n", [gen_single_clause(Range)]) @@ -604,6 +615,11 @@ gen_gc(Fd, GBP) -> " case Acc of\n" " [A] -> [A];\n" " _ -> [lists:reverse(Acc)]\n" + " end;\n" + " {error,R} ->\n" + " case Acc of\n" + " [A] -> [A|R];\n" + " _ -> [lists:reverse(Acc)|R]\n" " end\n" " end.\n\n"), @@ -660,6 +676,7 @@ gen_gc(Fd, GBP) -> [GenHangulT_1(CP) || CP <- merge_ranges(maps:get(t,GBP))], io:put_chars(Fd, " R1 -> gc_extend(R1, R0, Acc)\n end.\n\n"), + io:put_chars(Fd, "gc_h_lv_lvt({error,_}=Error, Acc) -> gc_extend(Error, [], Acc);\n"), io:put_chars(Fd, "%% Handle Hangul LV\n"), GenHangulLV = fun(Range) -> io:format(Fd, "gc_h_lv_lvt~s gc_h_V(R1,[CP|Acc]);\n", [gen_clause2(Range)]) end, diff --git a/lib/tools/doc/src/lcnt.xml b/lib/tools/doc/src/lcnt.xml index 9c8ce148e9..6e66a957ab 100644 --- a/lib/tools/doc/src/lcnt.xml +++ b/lib/tools/doc/src/lcnt.xml @@ -38,7 +38,7 @@ <modulesummary>A runtime system Lock Profiling tool.</modulesummary> <description> <p>The <c>lcnt</c> module is used to profile the internal ethread locks in the - Erlang Runtime System. With <c>lcnt</c> enabled, Internal counters in the + Erlang Runtime System. With <c>lcnt</c> enabled, internal counters in the runtime system are updated each time a lock is taken. The counters stores information about the number of acquisition tries and the number of collisions that has occurred during the acquisition tries. The counters also record the @@ -47,17 +47,17 @@ <p> The data produced by the lock counters will give an estimate on how well the runtime system will behave from a parallelizable view point for the - scenarios tested. This tool was mainly developed to help erlang runtime + scenarios tested. This tool was mainly developed to help Erlang runtime developers iron out potential and generic bottlenecks. </p> <p>Locks in the emulator are named after what type of resource they protect and where in the emulator they are initialized, those are lock 'classes'. Most of those locks are also instantiated several times, and given unique identifiers, to increase locking granularity. Typically an instantiated lock protects a disjunct set of - the resource, i.e ets-tables, processes or ports. In other cases it protects a - specific range of a resource, e.g. <c>pix_lock</c> which protects index to process + the resource, for example ets tables, processes or ports. In other cases it protects a + specific range of a resource, for example <c>pix_lock</c> which protects index to process mappings, and is given a unique number within the class. A unique lock in <c>lcnt</c> - is referenced by a name (class) and an identifier, <c>{Name, Id}</c>. + is referenced by a name (class) and an identifier: <c>{Name, Id}</c>. </p> <p>Some locks in the system are static and protects global resources, for example <c>bif_timers</c> and the <c>run_queue</c> locks. Other locks are dynamic and not diff --git a/lib/tools/doc/src/lcnt_chapter.xml b/lib/tools/doc/src/lcnt_chapter.xml index 6cfdb5cf1b..1981d66117 100644 --- a/lib/tools/doc/src/lcnt_chapter.xml +++ b/lib/tools/doc/src/lcnt_chapter.xml @@ -42,42 +42,32 @@ completed its access to the resource and unlocked it. The <c>lcnt</c> tool measures these lock conflicts. </p> <p> - Locks has an inherent cost in execution time and memory space. It takes time initialize, destroy, aquiring or releasing locks. To decrease lock contention it + Locks have an inherent cost in execution time and memory space. It takes time initialize, destroy, aquiring or releasing locks. To decrease lock contention it some times necessary to use finer grained locking strategies. This will usually also increase the locking overhead and hence there is a tradeoff between lock contention and overhead. In general, lock contention increases with the number of threads running concurrently. The <c>lcnt</c> tool does not measure locking overhead. </p> <section> <title> Enabling lock-counting </title> - <p>For investigation of locks in the emulator we use an internal tool called <c>lcnt</c> (short for lock-count). The VM needs to be compiled with this option enabled. To enable this, use:</p> + <p>For investigation of locks in the emulator we use an internal tool called <c>lcnt</c> (short for lock-count). The VM needs to be compiled with this option enabled. + To compile a lock-counting VM along with a normal VM, use:</p> <pre> cd $ERL_TOP -./configure --enable-lock-counter - </pre> - - <p> - Another way to enable this alongside a normal VM is to compile it at emulator directory level, much like a debug build. To compile it this way do the following, - </p> - <pre> -cd $ERL_TOP/erts/emulator -make lcnt FLAVOR=smp - </pre> - <p> and then starting Erlang with,</p> +./configure --enable-lock-counter</pre> + <p>Start the lock-counting VM like this:</p> <pre> -$ERL_TOP/bin/cerl -lcnt - </pre> - <p>To verify that you lock-counting enabled check that <c>[lock-counting]</c> appears in the status text when the VM is started.</p> +$ERL_TOP/bin/erl -emu_type lcnt</pre> + <p>To verify that lock counting is enabled check that <c>[lock-counting]</c> appears in the status text when the VM is started.</p> <pre> -Erlang R13B03 (erts-5.7.4) [source] [64-bit] [smp:8:8] [rq:8] [async-threads:0] [hipe] - [kernel-poll:false] [lock-counting] - </pre> +Erlang/OTP 20 [erts-9.0] [64-bit] [smp:8:8] [ds:8:8:10] [async-threads:10] [hipe] + [kernel-poll:false] [lock-counting]</pre> </section> <section> <title>Getting started</title> <p>Once you have a lock counting enabled VM the module <c>lcnt</c> can be used. The module is intended to be used from the current running nodes shell. To access remote nodes use <c>lcnt:clear(Node)</c> and <c>lcnt:collect(Node)</c>. </p> <p>All locks are continuously monitored and its statistics updated. Use <c>lcnt:clear/0</c> to initially clear all counters before running any specific tests. This command will also reset the duration timer internally.</p> - <p>To retrieve lock statistics information use, <c>lcnt:collect/0,1</c>. The collect operation will start a <c>lcnt</c> server if it not already started. All collected data will be built into an erlang term and uploaded to the server and a duration time will also be uploaded. This duration is the time between <c>lcnt:clear/0,1</c> and <c>lcnt:collect/0,1</c>.</p> + <p>To retrieve lock statistics information, use <c>lcnt:collect/0,1</c>. The collect operation will start a <c>lcnt</c> server if it not already started. All collected data will be built into an Erlang term and uploaded to the server and a duration time will also be uploaded. This duration is the time between <c>lcnt:clear/0,1</c> and <c>lcnt:collect/0,1</c>.</p> <p>Once the data is collected to the server it can be filtered, sorted and printed in many different ways.</p> <p>See the <seealso marker="lcnt">reference manual</seealso> for a description of each function.</p> diff --git a/lib/tools/test/lcnt_SUITE.erl b/lib/tools/test/lcnt_SUITE.erl index d39a5deeab..2e48b11740 100644 --- a/lib/tools/test/lcnt_SUITE.erl +++ b/lib/tools/test/lcnt_SUITE.erl @@ -29,7 +29,8 @@ -export([t_load/1, t_conflicts/1, t_locations/1, - t_swap_keys/1]). + t_swap_keys/1, + smoke_lcnt/1]). init_per_testcase(_Case, Config) -> Config. @@ -43,7 +44,8 @@ suite() -> {timetrap,{minutes,4}}]. all() -> - [t_load, t_conflicts, t_locations, t_swap_keys]. + [t_load, t_conflicts, t_locations, t_swap_keys, + smoke_lcnt]. %%---------------------------------------------------------------------- %% Tests @@ -146,3 +148,82 @@ t_swap_keys_file([File|Files]) -> ok = lcnt:conflicts(), ok = lcnt:stop(), t_swap_keys_file(Files). + +%% Simple smoke test of actual lock-counting, if running on +%% a run-time with lock-counting enabled. + +smoke_lcnt(Config) -> + case erlang:system_info(build_type) of + lcnt -> + do_smoke_lcnt(Config); + _ -> + {skip,"Lock counting is not enabled"} + end. + +do_smoke_lcnt(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + SaveFile = filename:join(PrivDir, atom_to_list(?FUNCTION_NAME)), + {Time,ok} = timer:tc(fun() -> lcnt:apply(fun() -> big_bang(200) end) end), + io:format("~p ms\n", [Time]), + ok = lcnt:conflicts(), + ok = lcnt:save(SaveFile), + ok = lcnt:load(SaveFile), + ok = lcnt:conflicts(), + lcnt:stop(). + + +%%% +%%% A slightly modified version of Rickard Green's Big Bang benchmark. +%%% + +big_bang(N) when is_integer(N) -> + Procs = spawn_procs(N), + RMsgs = lists:map(fun (P) -> {done, P} end, Procs), + send_procs(Procs, {procs, Procs, self()}), + receive_msgs(RMsgs), + lists:foreach(fun (P) -> exit(P, normal) end, Procs). + +pinger([], [], true) -> + receive + {procs, Procs, ReportTo} -> + pinger(Procs, [], ReportTo) + end; +pinger([], [], false) -> + receive {ping, From} -> From ! {pong, self()} end, + pinger([],[],false); +pinger([], [], ReportTo) -> + ReportTo ! {done, self()}, + pinger([],[],false); +pinger([],[Po|Pos] = Pongers, ReportTo) -> + receive + {ping, From} -> + From ! {pong, self()}, + pinger([], Pongers, ReportTo); + {pong, Po} -> + pinger([], Pos, ReportTo) + end; +pinger([Pi|Pis], Pongers, ReportTo) -> + receive {ping, From} -> From ! {pong, self()} + after 0 -> ok + end, + Pi ! {ping, self()}, + pinger(Pis, [Pi|Pongers], ReportTo). + +spawn_procs(N) when N =< 0 -> + []; +spawn_procs(N) -> + [spawn_link(fun () -> pinger([], [], true) end) | spawn_procs(N-1)]. + +send_procs([], Msg) -> + Msg; +send_procs([P|Ps], Msg) -> + P ! Msg, + send_procs(Ps, Msg). + +receive_msgs([]) -> + ok; +receive_msgs([M|Ms]) -> + receive + M -> + receive_msgs(Ms) + end. diff --git a/lib/wx/c_src/egl_impl.h b/lib/wx/c_src/egl_impl.h index 719b4926db..7ecd484de5 100644 --- a/lib/wx/c_src/egl_impl.h +++ b/lib/wx/c_src/egl_impl.h @@ -112,7 +112,7 @@ typedef long int int32_t; typedef long long int int64_t; typedef unsigned long long int uint64_t; #elif defined(WIN32) && defined(_MSC_VER) -typedef long int int32_t; +typedef __int32 int32_t; typedef __int64 int64_t; typedef unsigned __int64 uint64_t; #elif defined(WIN32) && defined(__GNUC__) diff --git a/lib/wx/c_src/wxe_impl.cpp b/lib/wx/c_src/wxe_impl.cpp index 7817e7fa8a..1510866f09 100644 --- a/lib/wx/c_src/wxe_impl.cpp +++ b/lib/wx/c_src/wxe_impl.cpp @@ -267,7 +267,7 @@ int WxeApp::dispatch_cmds() return more; } -#define BREAK_BATCH 200 +#define BREAK_BATCH 10000 int WxeApp::dispatch(wxeFifo * batch) { @@ -284,7 +284,7 @@ int WxeApp::dispatch(wxeFifo * batch) if(blevel>0) { blevel--; if(blevel==0) - wait += BREAK_BATCH*100; + wait += BREAK_BATCH/4; } break; case WXE_BATCH_BEGIN: @@ -317,7 +317,7 @@ int WxeApp::dispatch(wxeFifo * batch) erl_drv_mutex_lock(wxe_batch_locker_m); batch->Cleanup(); } - if(blevel <= 0 || wait > BREAK_BATCH) { + if(blevel <= 0 || wait >= BREAK_BATCH) { erl_drv_mutex_unlock(wxe_batch_locker_m); if(blevel > 0) { return 1; // We are still in a batch but we can let wx check for events |