diff options
Diffstat (limited to 'lib')
196 files changed, 12323 insertions, 4985 deletions
diff --git a/lib/common_test/doc/src/ct_netconfc.xml b/lib/common_test/doc/src/ct_netconfc.xml index 32a1175d81..8fbe5f3df6 100644 --- a/lib/common_test/doc/src/ct_netconfc.xml +++ b/lib/common_test/doc/src/ct_netconfc.xml @@ -412,11 +412,11 @@ </func> <func> - <name since="OTP 18.3">create_subscription(Client) -> Result</name> - <name since="OTP 18.3">create_subscription(Client, Stream) -> Result</name> - <name since="OTP 18.3">create_subscription(Client, Stream, Filter) -> Result</name> - <name since="OTP 18.3">create_subscription(Client, Stream, Filter, Timeout) -> Result</name> - <name name="create_subscription" arity="5" clause_i="2" since="OTP 18.3"/> + <name since="OTP R15B02">create_subscription(Client) -> Result</name> + <name since="OTP R15B02">create_subscription(Client, Stream) -> Result</name> + <name since="OTP R15B02">create_subscription(Client, Stream, Filter) -> Result</name> + <name since="OTP R15B02">create_subscription(Client, Stream, Filter, Timeout) -> Result</name> + <name name="create_subscription" arity="5" clause_i="2" since="OTP R15B02"/> <name name="create_subscription" arity="6" since="OTP R15B02"/> <fsummary>Creates a subscription for event notifications.</fsummary> <desc> @@ -515,7 +515,7 @@ create_subscription(Client, Stream, Filter, StartTime, StopTime, Timeout)</pre> <func> <name name="edit_config" arity="3" since="OTP R15B02"/> - <name name="edit_config" arity="4" clause_i="1" since="OTP R15B02"/> + <name name="edit_config" arity="4" clause_i="1" since="OTP 18.0"/> <name name="edit_config" arity="4" clause_i="2" since="OTP R15B02"/> <name name="edit_config" arity="5" since="OTP 18.0"/> <fsummary>Edits configuration data.</fsummary> @@ -599,7 +599,7 @@ create_subscription(Client, Stream, Filter, StartTime, StopTime, Timeout)</pre> <func> <name name="get_event_streams" arity="1" since="OTP 20.0"/> <name name="get_event_streams" arity="2" clause_i="1" since="OTP R15B02"/> - <name name="get_event_streams" arity="2" clause_i="2" since="OTP R15B02"/> + <name name="get_event_streams" arity="2" clause_i="2" since="OTP 20.0"/> <name name="get_event_streams" arity="3" since="OTP R15B02"/> <fsummary>Sends a request to get the specified event streams.</fsummary> <desc> diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl index a10d939919..a07e61199b 100644 --- a/lib/common_test/src/ct_config.erl +++ b/lib/common_test/src/ct_config.erl @@ -592,7 +592,7 @@ encrypt_config_file(SrcFileName, EncryptFileName, {file,KeyFile}) -> encrypt_config_file(SrcFileName, EncryptFileName, {key,Key}) -> _ = crypto:start(), - {Key,IVec} = make_crypto_key(Key), + {CryptoKey,IVec} = make_crypto_key(Key), case file:read_file(SrcFileName) of {ok,Bin0} -> Bin1 = term_to_binary({SrcFileName,Bin0}), @@ -600,7 +600,7 @@ encrypt_config_file(SrcFileName, EncryptFileName, {key,Key}) -> 0 -> Bin1; N -> list_to_binary([Bin1,random_bytes(8-N)]) end, - EncBin = crypto:block_encrypt(des3_cbc, Key, IVec, Bin2), + EncBin = crypto:block_encrypt(des3_cbc, CryptoKey, IVec, Bin2), case file:write_file(EncryptFileName, EncBin) of ok -> io:format("~ts --(encrypt)--> ~ts~n", @@ -631,10 +631,10 @@ decrypt_config_file(EncryptFileName, TargetFileName, {file,KeyFile}) -> decrypt_config_file(EncryptFileName, TargetFileName, {key,Key}) -> _ = crypto:start(), - {Key,IVec} = make_crypto_key(Key), + {CryptoKey,IVec} = make_crypto_key(Key), case file:read_file(EncryptFileName) of {ok,Bin} -> - DecBin = crypto:block_decrypt(des3_cbc, Key, IVec, Bin), + DecBin = crypto:block_decrypt(des3_cbc, CryptoKey, IVec, Bin), case catch binary_to_term(DecBin) of {'EXIT',_} -> {error,bad_file}; diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 7e98e6395f..506147474f 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -314,8 +314,8 @@ add_defaults(Mod,Func, GroupPath) -> ErrStr = io_lib:format("~n*** ERROR *** " "~w:suite/0 failed: ~tp~n", [Suite,Reason]), - io:format(ErrStr, []), - io:format(?def_gl, ErrStr, []), + io:format("~ts", [ErrStr]), + io:format(?def_gl, "~ts", [ErrStr]), {suite0_failed,{exited,Reason}}; SuiteInfo when is_list(SuiteInfo) -> case lists:all(fun(E) when is_tuple(E) -> true; @@ -337,16 +337,16 @@ add_defaults(Mod,Func, GroupPath) -> "Invalid return value from " "~w:suite/0: ~tp~n", [Suite,SuiteInfo]), - io:format(ErrStr, []), - io:format(?def_gl, ErrStr, []), + io:format("~ts", [ErrStr]), + io:format(?def_gl, "~ts", [ErrStr]), {suite0_failed,bad_return_value} end; SuiteInfo -> ErrStr = io_lib:format("~n*** ERROR *** " "Invalid return value from " "~w:suite/0: ~tp~n", [Suite,SuiteInfo]), - io:format(ErrStr, []), - io:format(?def_gl, ErrStr, []), + io:format("~ts", [ErrStr]), + io:format(?def_gl, "~ts", [ErrStr]), {suite0_failed,bad_return_value} end. @@ -373,8 +373,8 @@ add_defaults1(Mod,Func, GroupPath, SuiteInfo) -> "Invalid return value from " "~w:group(~tw): ~tp~n", [Mod,GrName,BadGr0Val]), - io:format(Gr0ErrStr, []), - io:format(?def_gl, Gr0ErrStr, []), + io:format("~ts", [Gr0ErrStr]), + io:format(?def_gl, "~ts", [Gr0ErrStr]), {group0_failed,bad_return_value}; _ -> Args = if Func == init_per_group ; Func == end_per_group -> @@ -395,8 +395,8 @@ add_defaults1(Mod,Func, GroupPath, SuiteInfo) -> "Invalid return value from " "~w:~tw/0: ~tp~n", [Mod,Func,BadTC0Val]), - io:format(TC0ErrStr, []), - io:format(?def_gl, TC0ErrStr, []), + io:format("~ts", [TC0ErrStr]), + io:format(?def_gl, "~ts", [TC0ErrStr]), {testcase0_failed,bad_return_value}; _ -> %% let test case info (also for all config funcs) override @@ -972,11 +972,10 @@ error_notification(Mod,Func,_Args,{Error,Loc}) -> end, PrintError = fun(ErrorFormat, ErrorArgs) -> - Div = "~n- - - - - - - - - - - - - - - - - - - " - "- - - - - - - - - - - - - - - - - - - - -~n", + Div = "\n- - - - - - - - - - - - - - - - - - - " + "- - - - - - - - - - - - - - - - - - - - -\n", ErrorStr2 = io_lib:format(ErrorFormat, ErrorArgs), - io:format(?def_gl, lists:concat([Div,ErrorStr2,Div,"~n"]), - []), + io:format(?def_gl, "~ts~n", [lists:concat([Div,ErrorStr2,Div])]), Link = "\n\n<a href=\"#end\">" "Full error description and stacktrace" @@ -985,7 +984,8 @@ error_notification(Mod,Func,_Args,{Error,Loc}) -> ct_logs:tc_log(ct_error_notify, ?MAX_IMPORTANCE, "CT Error Notification", - ErrorHtml2++Link, [], []) + "~ts", [ErrorHtml2++Link], + []) end, case Loc of [{?MODULE,error_in_suite}] -> @@ -1181,7 +1181,7 @@ get_all(Mod, ConfTests) -> ErrStr = io_lib:format("~n*** ERROR *** " "~w:all/0 failed: ~tp~n", [Mod,ExitReason]), - io:format(?def_gl, ErrStr, []), + io:format(?def_gl, "~ts", [ErrStr]), %% save the error info so it doesn't get printed twice ct_util:set_testdata_async({{error_in_suite,Mod}, ExitReason}); diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 07a1693d5d..814b80b8bd 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -542,7 +542,7 @@ tc_print(Category,Importance,Format,Args,Opts) -> undefined -> atom_to_list(Category); Hd -> Hd end, - Str = lists:concat([get_header(Heading),Format,"\n\n"]), + Str = lists:flatten([get_header(Heading),Format,"\n\n"]), try io:format(?def_gl, Str, Args) catch @@ -935,7 +935,7 @@ create_io_fun(FromPid, CtLogFd, EscChars) -> {_HdOrFt,S,A} -> {false,S,A}; {S,A} -> {true,S,A} end, - try io_lib:format(Str, Args) of + try io_lib:format(lists:flatten(Str), Args) of IoStr when Escapable, EscChars, IoList == [] -> escape_chars(IoStr); IoStr when Escapable, EscChars -> @@ -1138,10 +1138,10 @@ set_evmgr_gl(GL) -> open_ctlog(MiscIoName) -> {ok,Fd} = file:open(?ct_log_name,[write,{encoding,utf8}]), - io:format(Fd, header("Common Test Framework Log", {[],[1,2],[]}), []), + io:format(Fd, "~ts", [header("Common Test Framework Log", {[],[1,2],[]})]), case file:consult(ct_run:variables_file_name("../")) of {ok,Vars} -> - io:format(Fd, config_table(Vars), []); + io:format(Fd, "~ts", [config_table(Vars)]); {error,Reason} -> {ok,Cwd} = file:get_cwd(), Dir = filename:dirname(Cwd), @@ -1213,7 +1213,7 @@ print_style_error(Fd, IoFormat, StyleSheet, Reason) -> close_ctlog(Fd) -> io:format(Fd, "\n</pre>\n", []), - io:format(Fd, [xhtml("<br><br>\n", "<br /><br />\n") | footer()], []), + io:format(Fd, "~ts", [[xhtml("<br><br>\n", "<br /><br />\n") | footer()]]), ok = file:close(Fd). %%%----------------------------------------------------------------- diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index fd33ee2280..9fc169789c 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -350,7 +350,7 @@ master_loop(#state{node_ctrl_pids=[], io_lib:format("~-40.40.*ts~tp\n", [$_,atom_to_list(Node),Result]) end,lists:reverse(Finished)), - log(all,"TEST RESULTS",Str,[]), + log(all,"TEST RESULTS","~ts", [Str]), log(all,"Info","Updating log files",[]), refresh_logs(LogDirs,[]), @@ -574,7 +574,7 @@ refresh_logs([],Refreshed) -> io_lib:format("Refreshing logs in ~tp... ~tp", [D,Result]) end,Refreshed), - log(all,"Info",Str,[]). + log(all,"Info","~ts", [Str]). %%%----------------------------------------------------------------- %%% NODE CONTROLLER, runs and controls tests on a test node. diff --git a/lib/common_test/src/ct_repeat.erl b/lib/common_test/src/ct_repeat.erl index 8b1c7d47bb..b97c6e59e7 100644 --- a/lib/common_test/src/ct_repeat.erl +++ b/lib/common_test/src/ct_repeat.erl @@ -278,7 +278,7 @@ log_loop_info(Args) -> ForceStop -> io_lib:format("force_stop is set to: ~w",[ForceStop]) end, - ct_logs:log("Test loop info",LogStr1++LogStr2++LogStr3++LogStr4,[]) + ct_logs:log("Test loop info","~ts", [LogStr1++LogStr2++LogStr3++LogStr4]) end. ts(Secs) -> diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl index 86081369b9..fe869a4373 100644 --- a/lib/common_test/src/cth_log_redirect.erl +++ b/lib/common_test/src/cth_log_redirect.erl @@ -194,10 +194,10 @@ handle_call({log, case LogFunc of tc_log -> ct_logs:tc_log(Category, ?STD_IMPORTANCE, - Header, String, [], []); + Header, "~ts", [String], []); tc_log_async -> ct_logs:tc_log_async(sasl, ?STD_IMPORTANCE, - Header, String, []) + Header, "~ts", [String]) end, {reply,ok,State}; @@ -261,34 +261,34 @@ handle_remote_events(Bool) -> format_header(#eh_state{curr_suite = undefined, curr_group = undefined, curr_func = undefined}) -> - io_lib:format("System report", []); + lists:flatten(io_lib:format("System report", [])); format_header(#eh_state{curr_suite = Suite, curr_group = undefined, curr_func = undefined}) -> - io_lib:format("System report during ~w", [Suite]); + lists:flatten(io_lib:format("System report during ~w", [Suite])); format_header(#eh_state{curr_suite = Suite, curr_group = undefined, curr_func = TcOrConf}) -> - io_lib:format("System report during ~w:~tw/1", - [Suite,TcOrConf]); + lists:flatten(io_lib:format("System report during ~w:~tw/1", + [Suite,TcOrConf])); format_header(#eh_state{curr_suite = Suite, curr_group = Group, curr_func = Conf}) when Conf == init_per_group; Conf == end_per_group -> - io_lib:format("System report during ~w:~w/2 for ~tw", - [Suite,Conf,Group]); + lists:flatten(io_lib:format("System report during ~w:~w/2 for ~tw", + [Suite,Conf,Group])); format_header(#eh_state{curr_suite = Suite, curr_group = Group, parallel_tcs = true}) -> - io_lib:format("System report during ~tw in ~w", - [Group,Suite]); + lists:flatten(io_lib:format("System report during ~tw in ~w", + [Group,Suite])); format_header(#eh_state{curr_suite = Suite, curr_group = Group, curr_func = TC}) -> - io_lib:format("System report during ~w:~tw/1 in ~tw", - [Suite,TC,Group]). + lists:flatten(io_lib:format("System report during ~w:~tw/1 in ~tw", + [Suite,TC,Group])). diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl index b0742717ae..c9b4cb10c6 100644 --- a/lib/common_test/src/cth_surefire.erl +++ b/lib/common_test/src/cth_surefire.erl @@ -235,7 +235,7 @@ close_suite(#state{ test_cases = TCs, url_base = UrlBase } = State) -> terminate(State = #state{ test_cases = [] }) -> {ok,D} = file:open(State#state.filepath,[write,{encoding,utf8}]), io:format(D, "<?xml version=\"1.0\" encoding= \"UTF-8\" ?>", []), - io:format(D, to_xml(State), []), + io:format(D, "~ts", [to_xml(State)]), catch file:sync(D), catch file:close(D); terminate(State) -> diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl index 34f2feb33c..1518c6e8d6 100644 --- a/lib/common_test/src/test_server_ctrl.erl +++ b/lib/common_test/src/test_server_ctrl.erl @@ -1558,7 +1558,7 @@ do_test_cases(TopCases, SkipCases, Html1} end, - print(html, Header), + print(html, "~ts", [Header]), print(html, xhtml("<p>", "<h4>")), print_timestamp(html, "Test started at "), @@ -1605,10 +1605,10 @@ do_test_cases(TopCases, SkipCases, [?suitelog_name,CoverLog,?unexpected_io_log]), print(html, "<p>~ts</p>\n" ++ - xhtml(["<table bgcolor=\"white\" border=\"3\" cellpadding=\"5\">\n", - "<thead>\n"], - ["<table id=\"",?sortable_table_name,"\">\n", - "<thead>\n"]) ++ + xhtml("<table bgcolor=\"white\" border=\"3\" cellpadding=\"5\">\n" ++ + "<thead>\n", + "<table id=\"" ++ ?sortable_table_name ++ "\">\n" ++ + "<thead>\n") ++ "<tr><th>Num</th><th>Module</th><th>Group</th>" ++ "<th>Case</th><th>Log</th><th>Time</th><th>Result</th>" ++ "<th>Comment</th></tr>\n</thead>\n<tbody>\n", @@ -3306,7 +3306,8 @@ skip_case1(Type, CaseNum, Mod, Func, Comment, Mode) -> true -> print(2,"*** Skipping test case #~w ~tw ***", [CaseNum,{Mod,Func}]) end, - TR = xhtml("<tr valign=\"top\">", ["<tr class=\"",odd_or_even(),"\">"]), + TR = xhtml("<tr valign=\"top\">", + "<tr class=\"" ++ odd_or_even() ++ "\">"), GroupName = case get_name(Mode) of undefined -> ""; Name -> cast_to_list(Name) @@ -3796,8 +3797,8 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, end, print(minor, - escape_chars(io_lib:format("Config value:\n\n ~tp\n", [Args2Print])), - []), + "~ts", + [escape_chars(io_lib:format("Config value:\n\n ~tp\n", [Args2Print]))]), print(minor, "Current directory is ~tp\n", [Cwd]), GrNameStr = case GrName of @@ -3806,7 +3807,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, end, print(major, "=started ~s", [lists:flatten(timestamp_get(""))]), {{Col0,Col1},Style} = get_font_style((RunInit==run_init), Mode), - TR = xhtml("<tr valign=\"top\">", ["<tr class=\"",odd_or_even(),"\">"]), + TR = xhtml("<tr valign=\"top\">", "<tr class=\"" ++ odd_or_even() ++ "\">"), EncMinorBase = uri_encode(MinorBase), print(html, TR ++ "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>" "<td>" ++ Col0 ++ "~w" ++ Col1 ++ "</td>" @@ -3831,7 +3832,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, print(minor, "<a name=\"end\"></a>", [], internal_raw), print(minor, "\n", [], internal_raw), print_timestamp(minor, "Ended at "), - print(major, "=ended ~s", [lists:flatten(timestamp_get(""))]), + print(major, "=ended ~s", [timestamp_get("")]), do_unless_parallel(Main, fun() -> file:set_cwd(filename:dirname(TSDir)) end), @@ -4075,9 +4076,9 @@ progress(failed, CaseNum, Mod, Func, GrName, Loc, {testcase_aborted,Reason}, _T, FormatLoc = test_server_sup:format_loc(Loc), print(minor, "=== Location: ~ts", [FormatLoc]), print(minor, - escape_chars(io_lib:format("=== Reason: {testcase_aborted,~tp}", - [Reason])), - []), + "~ts", + [escape_chars(io_lib:format("=== Reason: {testcase_aborted,~tp}", + [Reason]))]), failed; progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time, @@ -4115,8 +4116,8 @@ progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time, print(minor, "=== Location: ~w", [unknown]), {FStr,FormattedReason} = format_exception(Reason), print(minor, - escape_chars(io_lib:format("=== Reason: " ++ FStr, [FormattedReason])), - []), + "~ts", + [escape_chars(io_lib:format("=== Reason: " ++ FStr, [FormattedReason]))]), failed; progress(failed, CaseNum, Mod, Func, GrName, Loc, Reason, Time, @@ -4150,8 +4151,9 @@ progress(failed, CaseNum, Mod, Func, GrName, Loc, Reason, Time, FormatLoc = test_server_sup:format_loc(LocMin), print(minor, "=== Location: ~ts", [FormatLoc]), {FStr,FormattedReason} = format_exception(Reason), - print(minor, "=== Reason: " ++ - escape_chars(io_lib:format(FStr, [FormattedReason])), []), + print(minor, "~ts", + ["=== Reason: " ++ + escape_chars(io_lib:format(FStr, [FormattedReason]))]), failed; progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time, @@ -4184,8 +4186,8 @@ progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time, "~ts</tr>\n", [TimeStr,Comment]), print(minor, - escape_chars(io_lib:format("=== Returned value: ~tp", [RetVal])), - []), + "~ts", + [escape_chars(io_lib:format("=== Returned value: ~tp", [RetVal]))]), ok. %%-------------------------------------------------------------------- @@ -4542,7 +4544,7 @@ timestamp_get(Leader) -> timestamp_get_internal(Leader, Format) -> {YY,MM,DD,H,M,S} = time_get(), - io_lib:format(Format, [Leader,YY,MM,DD,H,M,S]). + lists:flatten(io_lib:format(Format, [Leader,YY,MM,DD,H,M,S])). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% time_get() -> {YY,MM,DD,H,M,S} diff --git a/lib/common_test/test_server/ts_benchmark.erl b/lib/common_test/test_server/ts_benchmark.erl index e4e06b54c2..a9486262b3 100644 --- a/lib/common_test/test_server/ts_benchmark.erl +++ b/lib/common_test/test_server/ts_benchmark.erl @@ -45,7 +45,7 @@ run(Specs, Opts, Vars) -> || Spec <- Specs], file:delete(filename:join(Cwd,"latest_benchmark")), {ok,D} = file:open(filename:join(Cwd,"latest_benchmark"),[write]), - io:format(D,BDir,[]), + io:format(D,"~ts", [BDir]), file:close(D). diff --git a/lib/common_test/test_server/ts_erl_config.erl b/lib/common_test/test_server/ts_erl_config.erl index 537628e39a..f3972bea4e 100644 --- a/lib/common_test/test_server/ts_erl_config.erl +++ b/lib/common_test/test_server/ts_erl_config.erl @@ -208,7 +208,11 @@ erl_interface(Vars,OsType) -> {filename:join(Dir, "lib"), filename:join([Dir, "src", "eidefs.mk"])}; {srctree, _Root, Target} -> - {filename:join([Dir, "obj", Target]), + Obj = case is_debug_build() of + true -> "obj.debug"; + false -> "obj" + end, + {filename:join([Dir, Obj, Target]), filename:join([Dir, "src", Target, "eidefs.mk"])} end} end, diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml index 7addadf82c..02e6203137 100644 --- a/lib/compiler/doc/src/notes.xml +++ b/lib/compiler/doc/src/notes.xml @@ -32,6 +32,26 @@ <p>This document describes the changes made to the Compiler application.</p> +<section><title>Compiler 7.3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>An optimization that avoided allocation of a stack + frame for some <c>case</c> expressions was introduced in + OTP 21. (ERL-504/OTP-14808) It turns out that in rare + circumstances, this optimization is not safe. Therefore, + this optimization has been disabled.</p> + <p>A similar optimization will be included in OTP 22 in a + safe way.</p> + <p> + Own Id: OTP-15501 Aux Id: ERL-807, ERL-514, OTP-14808 </p> + </item> + </list> + </section> + +</section> + <section><title>Compiler 7.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/compiler/scripts/.gitignore b/lib/compiler/scripts/.gitignore new file mode 100644 index 0000000000..4e4eba766d --- /dev/null +++ b/lib/compiler/scripts/.gitignore @@ -0,0 +1 @@ +/smoke-build diff --git a/lib/compiler/scripts/smoke b/lib/compiler/scripts/smoke new file mode 100755 index 0000000000..2429f104c0 --- /dev/null +++ b/lib/compiler/scripts/smoke @@ -0,0 +1,122 @@ +#!/usr/bin/env escript +%% -*- erlang -*- +-mode(compile). + +main(_Args) -> + setup(), + clone_elixir(), + build_elixir(), + test_elixir(), + setup_mix(), + smoke(main), + smoke(rabbitmq), + halt(0). + +setup() -> + ScriptsDir = scripts_dir(), + SmokeBuildDir = filename:join(ScriptsDir, "smoke-build"), + _ = file:make_dir(SmokeBuildDir), + ok = file:set_cwd(SmokeBuildDir), + ok. + +clone_elixir() -> + {ok,SmokeDir} = file:get_cwd(), + DotGitDir = filename:join([SmokeDir,"elixir",".git"]), + ElixirRepo = "[email protected]:elixir-lang/elixir.git", + case filelib:is_dir(DotGitDir) of + false -> + cmd("git clone " ++ ElixirRepo); + true -> + GetHeadSHA1 = "cd elixir && git rev-parse --verify HEAD", + Before = os:cmd(GetHeadSHA1), + cmd("cd elixir && git pull --ff-only origin master"), + case os:cmd(GetHeadSHA1) of + Before -> + ok; + _After -> + %% There were some changes. Clean to force a re-build. + cmd("cd elixir && make clean") + end + end. + +build_elixir() -> + cmd("cd elixir && make compile"). + +test_elixir() -> + cmd("cd elixir && make test_stdlib"). + +setup_mix() -> + MixExsFile = filename:join(scripts_dir(), "smoke-mix.exs"), + {ok,MixExs} = file:read_file(MixExsFile), + ok = file:write_file("mix.exs", MixExs), + + {ok,SmokeDir} = file:get_cwd(), + ElixirBin = filename:join([SmokeDir,"elixir","bin"]), + PATH = ElixirBin ++ ":" ++ os:getenv("PATH"), + os:putenv("PATH", PATH), + mix("local.rebar --force"), + ok. + +smoke(Set) -> + os:putenv("SMOKE_DEPS_SET", atom_to_list(Set)), + _ = file:delete("mix.lock"), + cmd("touch mix.exs"), + mix("deps.clean --all"), + mix("deps.get"), + mix("deps.compile"), + ok. + +scripts_dir() -> + Root = code:lib_dir(compiler), + filename:join(Root, "scripts"). + +mix(Cmd) -> + cmd("mix " ++ Cmd). + +cmd(Cmd) -> + run("sh", ["-c",Cmd]). + +run(Program0, Args) -> + Program = case os:find_executable(Program0) of + Path when is_list(Path) -> + Path; + false -> + abort("Unable to find program: ~s\n", [Program0]) + end, + Cmd = case {Program0,Args} of + {"sh",["-c"|ShCmd]} -> + ShCmd; + {_,_} -> + lists:join(" ", [Program0|Args]) + end, + io:format("\n# ~s\n", [Cmd]), + Options = [{args,Args},binary,exit_status,stderr_to_stdout], + try open_port({spawn_executable,Program}, Options) of + Port -> + case run_loop(Port, <<>>) of + 0 -> + ok; + ExitCode -> + abort("*** Failed with exit code: ~p\n", + [ExitCode]) + end + catch + error:_ -> + abort("Failed to execute ~s\n", [Program0]) + end. + +run_loop(Port, Output) -> + receive + {Port,{exit_status,Status}} -> + Status; + {Port,{data,Bin}} -> + io:put_chars(Bin), + run_loop(Port, <<Output/binary,Bin/binary>>); + Msg -> + io:format("L: ~p~n", [Msg]), + run_loop(Port, Output) + end. + +abort(Format, Args) -> + io:format(Format, Args), + halt(1). diff --git a/lib/compiler/scripts/smoke-mix.exs b/lib/compiler/scripts/smoke-mix.exs new file mode 100644 index 0000000000..82ae3370fe --- /dev/null +++ b/lib/compiler/scripts/smoke-mix.exs @@ -0,0 +1,95 @@ +defmodule Smoke.MixProject do + use Mix.Project + + def project do + [ + app: :smoke, + version: "0.1.0", + elixir: "~> 1.8", + start_permanent: Mix.env() == :prod, + deps: deps() + ] + end + + # Run "mix help compile.app" to learn about applications. + def application do + [ + extra_applications: [:logger] + ] + end + + # Run "mix help deps" to learn about dependencies. + defp deps do + case :os.getenv('SMOKE_DEPS_SET') do + 'main' -> + [ + {:bear, "~> 0.8.7"}, + {:cloudi_core, "~> 1.7"}, + {:concuerror, "~> 0.20.0"}, + {:cowboy, "~> 2.6.1"}, + {:ecto, "~> 3.0.6"}, + {:ex_doc, "~> 0.19.3"}, + {:distillery, "~> 2.0.12"}, + {:erlydtl, "~> 0.12.1"}, + {:gen_smtp, "~> 0.13.0"}, + {:getopt, "~> 1.0.1"}, + {:gettext, "~> 0.16.1"}, + {:gpb, "~> 4.6"}, + {:gproc, "~> 0.8.0"}, + {:graphql, "~> 0.15.0", hex: :graphql_erl}, + {:hackney, "~> 1.15.0"}, + {:ibrowse, "~> 4.4.1"}, + {:jose, "~> 1.9.0"}, + {:lager, "~> 3.6"}, + {:locus, "~> 1.6"}, + {:nimble_parsec, "~> 0.5.0"}, + {:phoenix, "~> 1.4.0"}, + {:riak_pb, "~> 2.3"}, + {:scalaris, git: "https://github.com/scalaris-team/scalaris", + compile: build_scalaris()}, + {:tdiff, "~> 0.1.2"}, + {:webmachine, "~> 1.11"}, + {:wings, git: "https://github.com/dgud/wings.git", + compile: build_wings()}, + {:zotonic_stdlib, "~> 1.0"}, + ] + 'rabbitmq' -> + [{:rabbit_common, "~> 3.7"}] + _ -> + [] + end + end + + defp build_scalaris do + # Only compile the Erlang code. + + """ + echo '-include("rt_simple.hrl").' >include/rt.hrl + (cd src && erlc -W0 -I ../include -I ../contrib/log4erl/include -I ../contrib/yaws/include *.erl) + (cd src/comm_layer && erlc -W0 -I ../../include -I *.erl) + (cd src/cp && erlc -W0 -I ../../include -I *.erl) + (cd src/crdt && erlc -W0 -I ../../include -I *.erl) + (cd src/json && erlc -W0 -I ../../include -I *.erl) + (cd src/paxos && erlc -W0 -I ../../include -I *.erl) + (cd src/rbr && erlc -W0 -I ../../include -I *.erl) + (cd src/rrepair && erlc -W0 -I ../../include -I *.erl) + (cd src/time && erlc -W0 -I ../../include -I *.erl) + (cd src/transactions && erlc -W0 -I ../../include -I *.erl) + (cd src/tx && erlc -W0 -I ../../include -I *.erl) + """ + end + + defp build_wings do + # If the Erlang system is not installed, the build will + # crash in plugins_src/accel when attempting to build + # the accel driver. Since there is very little Erlang code in + # the directory, skip the entire directory. + + """ + echo "all:\n\t" >plugins_src/accel/Makefile + git commit -a -m'Disable for smoke testing' + git tag -a -m'Smoke test' vsmoke_test + make + """ + end +end diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 961dacc6c9..97c73d0e07 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -49,7 +49,6 @@ MODULES = \ beam_a \ beam_asm \ beam_block \ - beam_bs \ beam_clean \ beam_dict \ beam_disasm \ @@ -104,6 +103,7 @@ BEAM_H = $(wildcard ../priv/beam_h/*.h) HRL_FILES= \ beam_disasm.hrl \ + beam_ssa_opt.hrl \ beam_ssa.hrl \ core_parse.hrl \ v3_kernel.hrl diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index dd2537a699..1ac892a8f1 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -100,8 +100,12 @@ rename_instr({bs_put_utf16=I,F,Fl,Src}) -> {bs_put,F,{I,Fl},[Src]}; rename_instr({bs_put_utf32=I,F,Fl,Src}) -> {bs_put,F,{I,Fl},[Src]}; -rename_instr({bs_put_string,_,_}=I) -> - {bs_put,{f,0},I,[]}; +rename_instr({bs_put_string,_,{string,String}}) -> + %% Only happens when compiling from .S files. In old + %% .S files, String is a list. In .S in OTP 22 and later, + %% String is a binary. + {bs_put,{f,0},{bs_put_binary,8,{field_flags,[unsigned,big]}}, + [{atom,all},{literal,iolist_to_binary([String])}]}; rename_instr({bs_add=I,F,[Src1,Src2,U],Dst}) when is_integer(U) -> {bif,I,F,[Src1,Src2,{integer,U}],Dst}; rename_instr({bs_utf8_size=I,F,Src,Dst}) -> @@ -118,8 +122,8 @@ rename_instr({bs_private_append=I,F,Sz,U,Src,Flags,Dst}) -> {bs_init,F,{I,U,Flags},none,[Sz,Src],Dst}; rename_instr(bs_init_writable=I) -> {bs_init,{f,0},I,1,[{x,0}],{x,0}}; -rename_instr({test,Op,F,[Ctx,Bits,{string,Str}]}) -> - %% When compiling from a .S file. +rename_instr({test,bs_match_string=Op,F,[Ctx,Bits,{string,Str}]}) when is_list(Str) -> + %% When compiling from an old .S file. Starting from OTP 22, Str is a binary. <<Bs:Bits/bits,_/bits>> = list_to_binary(Str), {test,Op,F,[Ctx,Bs]}; rename_instr({put_map_assoc,Fail,S,D,R,L}) -> diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index df0321e85a..bc1290f6fd 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -424,8 +424,8 @@ encode_arg({f, W}, Dict) -> {encode(?tag_f, W), Dict}; %% encode_arg({'char', C}, Dict) -> %% {encode(?tag_h, C), Dict}; -encode_arg({string, String}, Dict0) -> - {Offset, Dict} = beam_dict:string(String, Dict0), +encode_arg({string, BinString}, Dict0) when is_binary(BinString) -> + {Offset, Dict} = beam_dict:string(BinString, Dict0), {encode(?tag_u, Offset), Dict}; encode_arg({extfunc, M, F, A}, Dict0) -> {Index, Dict} = beam_dict:import(M, F, A, Dict0), diff --git a/lib/compiler/src/beam_bs.erl b/lib/compiler/src/beam_bs.erl deleted file mode 100644 index 15d8d687fc..0000000000 --- a/lib/compiler/src/beam_bs.erl +++ /dev/null @@ -1,183 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2018. 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% -%% -%% Purpose: Peephole optimization of binary syntax instructions. - --module(beam_bs). - --export([module/2]). --import(lists, [reverse/1]). - --spec module(beam_utils:module_code(), [compile:option()]) -> - {'ok',beam_utils:module_code()}. - -module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> - Fs = [function(F) || F <- Fs0], - {ok,{Mod,Exp,Attr,Fs,Lc}}. - -function({function,Name,Arity,CLabel,Is0}) -> - try - Is = bs_opt(Is0), - {function,Name,Arity,CLabel,Is} - catch - Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - -%%% -%%% Evaluate construction of constant bit fields. -%%% Combine bs_skip_bits2 and bs_test_tail2 instructions. -%%% - -bs_opt([{bs_put,_,_,_}=I|Is0]) -> - {BsPuts0,Is} = collect_bs_puts(Is0, [I]), - BsPuts = opt_bs_puts(BsPuts0), - BsPuts ++ bs_opt(Is); -bs_opt([{test,bs_skip_bits2,F,[Ctx,{integer,I},Unit,_Flags]}, - {test,bs_test_tail2,F,[Ctx,Bits]}|Is]) -> - [{test,bs_test_tail2,F,[Ctx,Bits+I*Unit]}|bs_opt(Is)]; -bs_opt([{test,bs_skip_bits2,F,[Ctx,{integer,I1},Unit1,Flags]}, - {test,bs_skip_bits2,F,[Ctx,{integer,I2},Unit2,_]}|Is]) -> - I = {test,bs_skip_bits2,F, - [Ctx,{integer,I1*Unit1+I2*Unit2},1,Flags]}, - bs_opt([I|Is]); -bs_opt([I|Is]) -> - [I|bs_opt(Is)]; -bs_opt([]) -> []. - -collect_bs_puts([{bs_put,_,_,_}=I|Is], Acc) -> - collect_bs_puts(Is, [I|Acc]); -collect_bs_puts([_|_]=Is, Acc) -> - {reverse(Acc),Is}. - -opt_bs_puts(Is) -> - opt_bs_1(Is, []). - -opt_bs_1([{bs_put,Fail, - {bs_put_float,1,Flags0},[{integer,Sz},Src]}=I0|Is], Acc) -> - try eval_put_float(Src, Sz, Flags0) of - <<Int:Sz>> -> - Flags = force_big(Flags0), - I = {bs_put,Fail,{bs_put_integer,1,Flags}, - [{integer,Sz},{integer,Int}]}, - opt_bs_1([I|Is], Acc) - catch - error:_ -> - opt_bs_1(Is, [I0|Acc]) - end; -opt_bs_1([{bs_put,_,{bs_put_integer,1,_},[{integer,8},{integer,_}]}|_]=IsAll, - Acc0) -> - {Is,Acc} = bs_collect_string(IsAll, Acc0), - opt_bs_1(Is, Acc); -opt_bs_1([{bs_put,Fail,{bs_put_integer,1,F},[{integer,Sz},{integer,N}]}=I|Is0], - Acc) when Sz > 8 -> - case field_endian(F) of - big -> - %% We can do this optimization for any field size without - %% risk for code explosion. - case bs_split_int(N, Sz, Fail, Is0) of - no_split -> opt_bs_1(Is0, [I|Acc]); - Is -> opt_bs_1(Is, Acc) - end; - little when Sz < 128 -> - %% We only try to optimize relatively small fields, to - %% avoid an explosion in code size. - <<Int:Sz>> = <<N:Sz/little>>, - Flags = force_big(F), - Is = [{bs_put,Fail,{bs_put_integer,1,Flags}, - [{integer,Sz},{integer,Int}]}|Is0], - opt_bs_1(Is, Acc); - _ -> %native or too wide little field - opt_bs_1(Is0, [I|Acc]) - end; -opt_bs_1([{bs_put,Fail,{Op,U,F},[{integer,Sz},Src]}|Is], Acc) when U > 1 -> - opt_bs_1([{bs_put,Fail,{Op,1,F},[{integer,U*Sz},Src]}|Is], Acc); -opt_bs_1([I|Is], Acc) -> - opt_bs_1(Is, [I|Acc]); -opt_bs_1([], Acc) -> reverse(Acc). - -eval_put_float(Src, Sz, Flags) when Sz =< 256 -> - %%Only evaluate if Sz is reasonable. - Val = value(Src), - case field_endian(Flags) of - little -> <<Val:Sz/little-float-unit:1>>; - big -> <<Val:Sz/big-float-unit:1>> - %% native intentionally not handled here - we can't optimize - %% it. - end. - -value({integer,I}) -> I; -value({float,F}) -> F. - -bs_collect_string(Is, [{bs_put,_,{bs_put_string,Len,{string,Str}},[]}|Acc]) -> - bs_coll_str_1(Is, Len, reverse(Str), Acc); -bs_collect_string(Is, Acc) -> - bs_coll_str_1(Is, 0, [], Acc). - -bs_coll_str_1([{bs_put,_,{bs_put_integer,U,_},[{integer,Sz},{integer,V}]}|Is], - Len, StrAcc, IsAcc) when U*Sz =:= 8 -> - Byte = V band 16#FF, - bs_coll_str_1(Is, Len+1, [Byte|StrAcc], IsAcc); -bs_coll_str_1(Is, Len, StrAcc, IsAcc) -> - {Is,[{bs_put,{f,0},{bs_put_string,Len,{string,reverse(StrAcc)}},[]}|IsAcc]}. - -field_endian({field_flags,F}) -> field_endian_1(F). - -field_endian_1([big=E|_]) -> E; -field_endian_1([little=E|_]) -> E; -field_endian_1([native=E|_]) -> E; -field_endian_1([_|Fs]) -> field_endian_1(Fs). - -force_big({field_flags,F}) -> - {field_flags,force_big_1(F)}. - -force_big_1([big|_]=Fs) -> Fs; -force_big_1([little|Fs]) -> [big|Fs]; -force_big_1([F|Fs]) -> [F|force_big_1(Fs)]. - -bs_split_int(0, Sz, _, _) when Sz > 64 -> - %% We don't want to split in this case because the - %% string will consist of only zeroes. - no_split; -bs_split_int(-1, Sz, _, _) when Sz > 64 -> - %% We don't want to split in this case because the - %% string will consist of only 255 bytes. - no_split; -bs_split_int(N, Sz, Fail, Acc) -> - FirstByteSz = case Sz rem 8 of - 0 -> 8; - Rem -> Rem - end, - bs_split_int_1(N, FirstByteSz, Sz, Fail, Acc). - -bs_split_int_1(-1, _, Sz, Fail, Acc) when Sz > 64 -> - I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, - [{integer,Sz},{integer,-1}]}, - [I|Acc]; -bs_split_int_1(0, _, Sz, Fail, Acc) when Sz > 64 -> - I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, - [{integer,Sz},{integer,0}]}, - [I|Acc]; -bs_split_int_1(N, ByteSz, Sz, Fail, Acc) when Sz > 0 -> - Mask = (1 bsl ByteSz) - 1, - I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, - [{integer,ByteSz},{integer,N band Mask}]}, - bs_split_int_1(N bsr ByteSz, 8, Sz-ByteSz, Fail, [I|Acc]); -bs_split_int_1(_, _, _, _, Acc) -> Acc. diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index 990e86062a..b2056332e6 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -126,18 +126,17 @@ import(Mod0, Name0, Arity, #asm{imports=Imp0,next_import=NextIndex}=D0) {NextIndex,D2#asm{imports=Imp,next_import=NextIndex+1}} end. -%% Returns the index for a string in the string table (adding the string to the -%% table if necessary). +%% Returns the index for a binary string in the string table (adding +%% the string to the table if necessary). %% string(String, Dict) -> {Offset, Dict'} --spec string(string(), bdict()) -> {non_neg_integer(), bdict()}. +-spec string(binary(), bdict()) -> {non_neg_integer(), bdict()}. -string(Str, Dict) when is_list(Str) -> +string(BinString, Dict) when is_binary(BinString) -> #asm{strings=Strings,string_offset=NextOffset} = Dict, - StrBin = list_to_binary(Str), - case old_string(StrBin, Strings) of + case old_string(BinString, Strings) of none -> - NewDict = Dict#asm{strings = <<Strings/binary,StrBin/binary>>, - string_offset=NextOffset+byte_size(StrBin)}, + NewDict = Dict#asm{strings = <<Strings/binary,BinString/binary>>, + string_offset=NextOffset+byte_size(BinString)}, {NextOffset,NewDict}; Offset when is_integer(Offset) -> {NextOffset-Offset,Dict} diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index 49bfb5606f..09925b2872 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -31,7 +31,7 @@ %%% erlang:error(function_clause, Args) => jump FuncInfoLabel %%% --import(lists, [reverse/1,seq/2,splitwith/2]). +-import(lists, [reverse/1,reverse/2,seq/2,splitwith/2]). -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. @@ -53,7 +53,7 @@ function({function,Name,Arity,CLabel,Is0}) -> -record(st, {lbl :: beam_asm:label(), %func_info label loc :: [_], %location for func_info - arity :: arity() %arity for function + arity :: arity() %arity for function }). function_1(Is0) -> @@ -79,13 +79,15 @@ translate_1(Ar, I, Is, #st{arity=Arity}=St, [{line,_}=Line|Acc1]=Acc0) -> no -> translate(Is, St, [I|Acc0]); {yes,function_clause,Acc2} -> - case {Line,St} of - {{line,Loc},#st{lbl=Fi,loc=Loc}} -> + case {Is,Line,St} of + {[return|_],{line,Loc},#st{lbl=Fi,loc=Loc}} -> Instr = {jump,{f,Fi}}, translate(Is, St, [Instr|Acc2]); - {_,_} -> - %% This must be "error(function_clause, Args)" in - %% the Erlang source code or a fun. Don't translate. + {_,_,_} -> + %% Not a call_only instruction, or not the same + %% location information as in in the line instruction + %% before the func_info instruction. Not safe + %% to translate to a jump. translate(Is, St, [I|Acc0]) end; {yes,Instr,Acc2} -> @@ -148,10 +150,15 @@ dig_out_fc(Arity, Is0) -> (_) -> true end, Is0), {Regs,Acc} = dig_out_fc_1(reverse(Is), Regs0, Acc0), - case is_fc(Arity, Regs) of - true -> - {yes,function_clause,Acc}; - false -> + case Regs of + #{{x,0}:={atom,function_clause},{x,1}:=Args} -> + case moves_from_stack(Args, 0, []) of + {Moves,Arity} -> + {yes,function_clause,reverse(Moves, Acc)}; + {_,_} -> + no + end; + #{} -> no end. @@ -160,8 +167,10 @@ dig_out_fc_1([{block,Bl}|Is], Regs0, Acc) -> dig_out_fc_1(Is, Regs, Acc); dig_out_fc_1([{bs_set_position,_,_}=I|Is], Regs, Acc) -> dig_out_fc_1(Is, Regs, [I|Acc]); -dig_out_fc_1([{bs_get_tail,_,_,Live}=I|Is], Regs0, Acc) -> - Regs = prune_xregs(Live, Regs0), +dig_out_fc_1([{bs_get_tail,Src,Dst,Live0}|Is], Regs0, Acc) -> + Regs = prune_xregs(Live0, Regs0), + Live = dig_out_stack_live(Regs, Live0), + I = {bs_get_tail,Src,Dst,Live}, dig_out_fc_1(Is, Regs, [I|Acc]); dig_out_fc_1([_|_], _Regs, _Acc) -> {#{},[]}; @@ -182,25 +191,50 @@ dig_out_fc_block([{set,_,_,_}|_], _Regs) -> #{}; dig_out_fc_block([], Regs) -> Regs. -prune_xregs(Live, Regs) -> - maps:filter(fun({x,X}, _) -> X < Live end, Regs). - -is_fc(Arity, Regs) -> +dig_out_stack_live(Regs, Default) -> + Reg = {x,2}, case Regs of - #{{x,0}:={atom,function_clause},{x,1}:=Args} -> - is_fc_1(Args, 0) =:= Arity; + #{Reg:=List} -> + dig_out_stack_live_1(List, Default); #{} -> - false + Default end. -is_fc_1({cons,{arg,I},T}, I) -> - is_fc_1(T, I+1); -is_fc_1(nil, I) -> - I; -is_fc_1(_, _) -> -1. +dig_out_stack_live_1({cons,{arg,N},T}, Live) -> + dig_out_stack_live_1(T, max(N + 1, Live)); +dig_out_stack_live_1({cons,_,T}, Live) -> + dig_out_stack_live_1(T, Live); +dig_out_stack_live_1(nil, Live) -> + Live; +dig_out_stack_live_1(_, Live) -> Live. + +prune_xregs(Live, Regs) -> + maps:filter(fun({x,X}, _) -> X < Live end, Regs). + +moves_from_stack({cons,{arg,N},_}, I, _Acc) when N =/= I -> + %% Wrong argument. Give up. + {[],-1}; +moves_from_stack({cons,H,T}, I, Acc) -> + case H of + {arg,I} -> + moves_from_stack(T, I+1, Acc); + _ -> + moves_from_stack(T, I+1, [{move,H,{x,I}}|Acc]) + end; +moves_from_stack(nil, I, Acc) -> + {reverse(Acc),I}; +moves_from_stack({literal,[H|T]}, I, Acc) -> + Cons = {cons,tag_literal(H),tag_literal(T)}, + moves_from_stack(Cons, I, Acc). get_reg(R, Regs) -> case Regs of #{R:=Val} -> Val; #{} -> R end. + +tag_literal([]) -> nil; +tag_literal(T) when is_atom(T) -> {atom,T}; +tag_literal(T) when is_float(T) -> {float,T}; +tag_literal(T) when is_integer(T) -> {integer,T}; +tag_literal(T) -> {literal,T}. diff --git a/lib/compiler/src/beam_ssa_bsm.erl b/lib/compiler/src/beam_ssa_bsm.erl index 9631bf3334..466337db0e 100644 --- a/lib/compiler/src/beam_ssa_bsm.erl +++ b/lib/compiler/src/beam_ssa_bsm.erl @@ -877,7 +877,8 @@ annotate_context_parameters(F, ModInfo) -> %% Assertion. error(conflicting_parameter_types); (K, suitable_for_reuse, Acc) -> - Acc#{ K => match_context }; + T = beam_validator:type_anno(match_context), + Acc#{ K => T }; (_K, _V, Acc) -> Acc end, TypeAnno0, ParamInfo), diff --git a/lib/compiler/src/beam_ssa_codegen.erl b/lib/compiler/src/beam_ssa_codegen.erl index d3facc5911..c2d5035b19 100644 --- a/lib/compiler/src/beam_ssa_codegen.erl +++ b/lib/compiler/src/beam_ssa_codegen.erl @@ -161,7 +161,7 @@ add_parameter_annos([{label, _}=Entry | Body], Anno) -> (_K, _V, Acc) -> Acc end, [], maps:get(registers, Anno)), - [Entry | Annos] ++ Body. + [Entry | sort(Annos)] ++ Body. cg_fun(Blocks, St0) -> Linear0 = linearize(Blocks), @@ -1071,8 +1071,8 @@ cg_block([#cg_set{op={bif,Name},dst=Dst0,args=Args0}]=Is0, {Dst0,Fail}, St0) -> {z,_} -> %% The result of the BIF call will only be used once. Convert to %% a test instruction. - Test = bif_to_test(Name, Args, ensure_label(Fail, St0)), - {Test,St0}; + {Test,St1} = bif_to_test(Name, Args, ensure_label(Fail, St0), St0), + {Test,St1}; _ -> %% Must explicitly call the BIF since the result will be used %% more than once. @@ -1269,16 +1269,17 @@ cg_copy_1([], _St) -> []. element(1, Val) =:= atom orelse element(1, Val) =:= literal)). +bif_to_test('or', [V1,V2], {f,Lbl}=Fail, St0) when Lbl =/= 0 -> + {SuccLabel,St} = new_label(St0), + {[{test,is_eq_exact,{f,SuccLabel},[V1,{atom,false}]}, + {test,is_eq_exact,Fail,[V2,{atom,true}]}, + {label,SuccLabel}],St}; +bif_to_test(Op, Args, Fail, St) -> + {bif_to_test(Op, Args, Fail),St}. + bif_to_test('and', [V1,V2], Fail) -> [{test,is_eq_exact,Fail,[V1,{atom,true}]}, {test,is_eq_exact,Fail,[V2,{atom,true}]}]; -bif_to_test('or', [V1,V2], {f,Lbl}=Fail) when Lbl =/= 0 -> - %% Labels are spaced 2 apart. We can create a new - %% label by incrementing the Fail label. - SuccLabel = Lbl + 1, - [{test,is_eq_exact,{f,SuccLabel},[V1,{atom,false}]}, - {test,is_eq_exact,Fail,[V2,{atom,true}]}, - {label,SuccLabel}]; bif_to_test('not', [Var], Fail) -> [{test,is_eq_exact,Fail,[Var,{atom,false}]}]; bif_to_test(Name, Args, Fail) -> @@ -1448,7 +1449,12 @@ cg_call(#cg_set{anno=Anno,op=call,dst=Dst0,args=[#b_local{}=Func0|Args0]}, Line = call_line(Where, local, Anno), Call = build_call(call, Arity, {f,FuncLbl}, Context, Dst), Is = setup_args(Args, Anno, Context, St) ++ Line ++ Call, - {Is,St}; + case Anno of + #{ result_type := Info } -> + {Is ++ [{'%', {type_info, Dst, Info}}], St}; + #{} -> + {Is, St} + end; cg_call(#cg_set{anno=Anno0,op=call,dst=Dst0,args=[#b_remote{}=Func0|Args0]}, Where, Context, St) -> [Dst|Args] = beam_args([Dst0|Args0], St), @@ -1724,6 +1730,14 @@ copy(Src, Dst) -> [{move,Src,Dst}]. force_reg({literal,_}=Lit, Reg) -> {Reg,[{move,Lit,Reg}]}; +force_reg({integer,_}=Lit, Reg) -> + {Reg,[{move,Lit,Reg}]}; +force_reg({atom,_}=Lit, Reg) -> + {Reg,[{move,Lit,Reg}]}; +force_reg({float,_}=Lit, Reg) -> + {Reg,[{move,Lit,Reg}]}; +force_reg(nil=Lit, Reg) -> + {Reg,[{move,Lit,Reg}]}; force_reg({Kind,_}=R, _) when Kind =:= x; Kind =:= y -> {R,[]}. @@ -2017,9 +2031,7 @@ is_gc_bif(Bif, Args) -> %% new_label(St) -> {L,St}. new_label(#cg{lcount=Next}=St) -> - %% Advance the label counter by 2 to allow us to create - %% a label for 'or' by incrementing an existing label. - {Next,St#cg{lcount=Next+2}}. + {Next,St#cg{lcount=Next+1}}. %% call_line(tail|body, Func, Anno) -> [] | [{line,...}]. %% Produce a line instruction if it will be needed by the diff --git a/lib/compiler/src/beam_ssa_dead.erl b/lib/compiler/src/beam_ssa_dead.erl index 067d9a6741..09b29025c6 100644 --- a/lib/compiler/src/beam_ssa_dead.erl +++ b/lib/compiler/src/beam_ssa_dead.erl @@ -181,9 +181,9 @@ shortcut_2(L, Bs0, UnsetVars0, St) -> %% We have a potentially suitable br. %% Now update the set of variables that will never %% be set if this block will be skipped. - UnsetVars1 = [V || #b_set{dst=V} <- Is], - UnsetVars = ordsets:union(UnsetVars0, - ordsets:from_list(UnsetVars1)), + SetInThisBlock = [V || #b_set{dst=V} <- Is], + UnsetVars = update_unset_vars(L, Br, SetInThisBlock, + UnsetVars0, St), %% Continue checking whether this br is suitable. shortcut_3(Br, Bs#{from:=L}, UnsetVars, St) @@ -296,6 +296,37 @@ shortcut_3(Br, Bs, UnsetVars, #st{target=Target}=St) -> end end. +update_unset_vars(L, Br, SetInThisBlock, UnsetVars, #st{skippable=Skippable}) -> + case is_map_key(L, Skippable) of + true -> + %% None of the variables used in this block are used in + %% the successors. We can speed up compilation by avoiding + %% adding variables to the UnsetVars if the presence of + %% those variable would not change the outcome of the + %% tests in is_br_safe/2. + case Br of + #b_br{bool=Bool} -> + case member(Bool, SetInThisBlock) of + true -> + %% Bool is a variable defined in this + %% block. It will change the outcome of + %% the `not member(V, UnsetVars)` check in + %% is_br_safe/2. The other variables + %% defined in this block will not. + ordsets:add_element(Bool, UnsetVars); + false -> + %% Bool is either a variable not defined + %% in this block or a literal. Adding it + %% to the UnsetVars set would not change + %% the outcome of the tests in + %% is_br_safe/2. + UnsetVars + end + end; + false -> + ordsets:union(UnsetVars, ordsets:from_list(SetInThisBlock)) + end. + shortcut_two_way(#b_br{succ=Succ,fail=Fail}, Bs0, UnsetVars0, St) -> case shortcut_2(Succ, Bs0, UnsetVars0, St#st{target=Fail}) of {#b_br{bool=#b_literal{},succ=Fail},_,_}=Res -> @@ -919,11 +950,11 @@ used_vars([{L,#b_blk{is=Is}=Blk}|Bs], UsedVars0, Skip0) -> Used = used_vars_blk(Blk, Used0), UsedVars = used_vars_phis(Is, L, Used, UsedVars0), - %% combine_eqs/1 needs different variable usage - %% information than shortcut_opt/1. The Skip - %% map will have an entry for each block that - %% can be skipped (does not bind any variable used - %% in successor). + %% combine_eqs/1 needs different variable usage information than + %% shortcut_opt/1. The Skip map will have an entry for each block + %% that can be skipped (does not bind any variable used in + %% successor). This information is also useful for speeding up + %% shortcut_opt/1. Defined0 = [Def || #b_set{dst=Def} <- Is], Defined = ordsets:from_list(Defined0), diff --git a/lib/compiler/src/beam_ssa_opt.erl b/lib/compiler/src/beam_ssa_opt.erl index 2dda67eac6..e528bb4dfb 100644 --- a/lib/compiler/src/beam_ssa_opt.erl +++ b/lib/compiler/src/beam_ssa_opt.erl @@ -18,64 +18,165 @@ %% %CopyrightEnd% %% +%%% +%%% This is a collection of various optimizations that don't need a separate +%%% pass by themselves and/or are mutually beneficial to other passes. +%%% +%%% The optimizations are applied in "phases," each with a list of sub-passes +%%% to run. These sub-passes are applied on all functions in a module before +%%% moving on to the next phase, which lets us gather module-level information +%%% in one phase and then apply it in the next without having to risk working +%%% with incomplete information. +%%% +%%% Each sub-pass operates on a #st{} record and a func_info_db(), where the +%%% former is just a #b_function{} whose blocks can be represented either in +%%% linear or map form, and the latter is a map with information about all +%%% functions in the module (see beam_ssa_opt.hrl for more details). +%%% + -module(beam_ssa_opt). -export([module/2]). --include("beam_ssa.hrl"). --import(lists, [all/2,append/1,foldl/3,keyfind/3,member/2, +-include("beam_ssa_opt.hrl"). + +-import(lists, [all/2,append/1,duplicate/2,foldl/3,keyfind/3,member/2, reverse/1,reverse/2, - splitwith/2,takewhile/2,unzip/1]). + splitwith/2,sort/1,takewhile/2,unzip/1]). + +-define(DEFAULT_REPETITIONS, 2). -spec module(beam_ssa:b_module(), [compile:option()]) -> {'ok',beam_ssa:b_module()}. -module(#b_module{body=Fs0}=Module, Opts) -> - Ps = passes(Opts), - Fs = functions(Fs0, Ps), - {ok,Module#b_module{body=Fs}}. +-record(st, {ssa :: [{beam_ssa:label(),beam_ssa:b_blk()}] | + beam_ssa:block_map(), + args :: [beam_ssa:b_var()], + cnt :: beam_ssa:label(), + anno :: beam_ssa:anno()}). +-type st_map() :: #{ func_id() => #st{} }. + +module(Module, Opts) -> + FuncDb0 = case proplists:get_value(no_module_opt, Opts, false) of + false -> build_func_db(Module); + true -> #{} + end, + + %% Passes that perform module-level optimizations are often aided by + %% optimizing callers before callees and vice versa, so we optimize all + %% functions in call order, flipping it as required. + StMap0 = build_st_map(Module), + Order = get_call_order_po(StMap0, FuncDb0), + + Phases = + [{Order, prologue_passes(Opts)}] ++ + repeat(Opts, repeated_passes(Opts), Order) ++ + [{Order, epilogue_passes(Opts)}], + + {StMap, _FuncDb} = foldl(fun({FuncIds, Ps}, {StMap, FuncDb}) -> + phase(FuncIds, Ps, StMap, FuncDb) + end, {StMap0, FuncDb0}, Phases), + + {ok, finish(Module, StMap)}. + +phase([FuncId | Ids], Ps, StMap, FuncDb0) -> + try compile:run_sub_passes(Ps, {map_get(FuncId, StMap), FuncDb0}) of + {St, FuncDb} -> + phase(Ids, Ps, StMap#{ FuncId => St }, FuncDb) + catch + Class:Error:Stack -> + #b_local{name=Name,arity=Arity} = FuncId, + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end; +phase([], _Ps, StMap, FuncDb) -> + {StMap, FuncDb}. + +%% Repeats the given passes, alternating the order between runs to make the +%% type pass more efficient. +repeat(Opts, Ps, OrderA) -> + Repeat = proplists:get_value(ssa_opt_repeat, Opts, ?DEFAULT_REPETITIONS), + OrderB = reverse(OrderA), + repeat_1(Repeat, Ps, OrderA, OrderB). -functions([F|Fs], Ps) -> - [function(F, Ps)|functions(Fs, Ps)]; -functions([], _Ps) -> []. +repeat_1(0, _Opts, _OrderA, _OrderB) -> + []; +repeat_1(N, Ps, OrderA, OrderB) when N > 0, N rem 2 =:= 0 -> + [{OrderA, Ps} | repeat_1(N - 1, Ps, OrderA, OrderB)]; +repeat_1(N, Ps, OrderA, OrderB) when N > 0, N rem 2 =:= 1 -> + [{OrderB, Ps} | repeat_1(N - 1, Ps, OrderA, OrderB)]. --type b_blk() :: beam_ssa:b_blk(). --type b_var() :: beam_ssa:b_var(). --type label() :: beam_ssa:label(). +%% + +get_func_id(F) -> + {_Mod, Name, Arity} = beam_ssa:get_anno(func_info, F), + #b_local{name=#b_literal{val=Name}, arity=Arity}. + +-spec build_st_map(#b_module{}) -> st_map(). +build_st_map(#b_module{body=Fs}) -> + build_st_map_1(Fs, #{}). + +build_st_map_1([F | Fs], Map) -> + #b_function{anno=Anno,args=Args,cnt=Counter,bs=Bs} = F, + St = #st{anno=Anno,args=Args,cnt=Counter,ssa=Bs}, + build_st_map_1(Fs, Map#{ get_func_id(F) => St }); +build_st_map_1([], Map) -> + Map. + +-spec finish(#b_module{}, st_map()) -> #b_module{}. +finish(#b_module{body=Fs0}=Module, StMap) -> + Module#b_module{body=finish_1(Fs0, StMap)}. + +finish_1([F0 | Fs], StMap) -> + #st{anno=Anno,cnt=Counter,ssa=Blocks} = map_get(get_func_id(F0), StMap), + F = F0#b_function{anno=Anno,bs=Blocks,cnt=Counter}, + [F | finish_1(Fs, StMap)]; +finish_1([], _StMap) -> + []. + +%% --record(st, {ssa :: beam_ssa:block_map() | [{label(),b_blk()}], - args :: [b_var()], - cnt :: label()}). -define(PASS(N), {N,fun N/1}). -passes(Opts0) -> +prologue_passes(Opts) -> Ps = [?PASS(ssa_opt_split_blocks), ?PASS(ssa_opt_coalesce_phis), + ?PASS(ssa_opt_tail_phis), ?PASS(ssa_opt_element), ?PASS(ssa_opt_linearize), + ?PASS(ssa_opt_tuple_size), ?PASS(ssa_opt_record), - - %% Run ssa_opt_cse twice, because it will help ssa_opt_dead, - %% and ssa_opt_dead will help ssa_opt_cse. Run ssa_opt_live - %% twice, because it will help ssa_opt_dead and ssa_opt_dead - %% will help ssa_opt_live. - ?PASS(ssa_opt_cse), - ?PASS(ssa_opt_type), - ?PASS(ssa_opt_live), + ?PASS(ssa_opt_cse), %Helps the first type pass. + ?PASS(ssa_opt_type_start)], + passes_1(Ps, Opts). + +%% These passes all benefit from each other (in roughly this order), so they +%% are repeated as required. +repeated_passes(Opts) -> + Ps = [?PASS(ssa_opt_live), + ?PASS(ssa_opt_bs_puts), ?PASS(ssa_opt_dead), - ?PASS(ssa_opt_cse), %Second time. - ?PASS(ssa_opt_float), - ?PASS(ssa_opt_live), %Second time. + ?PASS(ssa_opt_cse), + ?PASS(ssa_opt_tail_phis), + ?PASS(ssa_opt_type_continue)], %Must run after ssa_opt_dead to + %clean up phi nodes. + passes_1(Ps, Opts). +epilogue_passes(Opts) -> + Ps = [?PASS(ssa_opt_type_finish), + ?PASS(ssa_opt_float), + ?PASS(ssa_opt_live), %One last time to clean up the + %mess left by the float pass. ?PASS(ssa_opt_bsm), ?PASS(ssa_opt_bsm_units), ?PASS(ssa_opt_bsm_shortcut), - ?PASS(ssa_opt_misc), - ?PASS(ssa_opt_tuple_size), ?PASS(ssa_opt_sw), ?PASS(ssa_opt_blockify), ?PASS(ssa_opt_sink), ?PASS(ssa_opt_merge_blocks), ?PASS(ssa_opt_trim_unreachable)], + passes_1(Ps, Opts). + +passes_1(Ps, Opts0) -> Negations = [{list_to_atom("no_"++atom_to_list(N)),N} || {N,_} <- Ps], Opts = proplists:substitute_negations(Negations, Opts0), @@ -87,36 +188,132 @@ passes(Opts0) -> {NoName,fun(S) -> S end} end || {Name,_}=P <- Ps]. -function(#b_function{anno=Anno,bs=Blocks0,args=Args,cnt=Count0}=F, Ps) -> +%% Builds a function information map with basic information about incoming and +%% outgoing local calls, as well as whether the function is exported. +-spec build_func_db(#b_module{}) -> func_info_db(). +build_func_db(#b_module{body=Fs,exports=Exports}) -> try - St = #st{ssa=Blocks0,args=Args,cnt=Count0}, - #st{ssa=Blocks,cnt=Count} = compile:run_sub_passes(Ps, St), - F#b_function{bs=Blocks,cnt=Count} + fdb_1(Fs, gb_sets:from_list(Exports), #{}) catch - Class:Error:Stack -> - #{func_info:={_,Name,Arity}} = Anno, - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) + %% All module-level optimizations are invalid when a NIF can override a + %% function, so we have to bail out. + throw:load_nif -> #{} end. +fdb_1([#b_function{ args=Args,bs=Bs }=F | Fs], Exports, FuncDb0) -> + Id = get_func_id(F), + + #b_local{name=#b_literal{val=Name}, arity=Arity} = Id, + Exported = gb_sets:is_element({Name, Arity}, Exports), + ArgTypes = duplicate(length(Args), #{}), + + FuncDb1 = case FuncDb0 of + %% We may have an entry already if someone's called us. + #{ Id := Info } -> + FuncDb0#{ Id := Info#func_info{ exported=Exported, + arg_types=ArgTypes }}; + #{} -> + FuncDb0#{ Id => #func_info{ exported=Exported, + arg_types=ArgTypes }} + end, + + FuncDb = beam_ssa:fold_rpo(fun(_L, #b_blk{is=Is}, FuncDb) -> + fdb_is(Is, Id, FuncDb) + end, FuncDb1, Bs), + + fdb_1(Fs, Exports, FuncDb); +fdb_1([], _Exports, FuncDb) -> + FuncDb. + +fdb_is([#b_set{op=call, + args=[#b_local{}=Callee | _]} | Is], + Caller, FuncDb) -> + fdb_is(Is, Caller, fdb_update(Caller, Callee, FuncDb)); +fdb_is([#b_set{op=call, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=load_nif}}, + _Path, _LoadInfo]} | _Is], _Caller, _FuncDb) -> + throw(load_nif); +fdb_is([_ | Is], Caller, FuncDb) -> + fdb_is(Is, Caller, FuncDb); +fdb_is([], _Caller, FuncDb) -> + FuncDb. + +fdb_update(Caller, Callee, FuncDb) -> + CallerVertex = maps:get(Caller, FuncDb, #func_info{}), + CalleeVertex = maps:get(Callee, FuncDb, #func_info{}), + + Calls = ordsets:add_element(Callee, CallerVertex#func_info.out), + CalledBy = ordsets:add_element(Caller, CalleeVertex#func_info.in), + + FuncDb#{ Caller => CallerVertex#func_info{out=Calls}, + Callee => CalleeVertex#func_info{in=CalledBy} }. + +%% Returns the post-order of all local calls in this module. That is, it starts +%% with the functions that don't call any others and then walks up the call +%% chain. +%% +%% Functions where module-level optimization is disabled are added last in +%% arbitrary order. + +get_call_order_po(StMap, FuncDb) -> + Leaves = maps:fold(fun(Id, #func_info{out=[]}, Acc) -> + [Id | Acc]; + (_, _, Acc) -> + Acc + end, [], FuncDb), + + Order = gco_po_1(sort(Leaves), FuncDb, [], #{}), + + Order ++ maps:fold(fun(K, _V, Acc) -> + case is_map_key(K, FuncDb) of + false -> [K | Acc]; + true -> Acc + end + end, [], StMap). + +gco_po_1([Id | Ids], FuncDb, Children, Seen) when not is_map_key(Id, Seen) -> + [Id | gco_po_1(Ids, FuncDb, [Id | Children], Seen#{ Id => true })]; +gco_po_1([_Id | Ids], FuncDb, Children, Seen) -> + gco_po_1(Ids, FuncDb, Children, Seen); +gco_po_1([], FuncDb, [_|_]=Children, Seen) -> + gco_po_1(gco_po_parents(Children, FuncDb), FuncDb, [], Seen); +gco_po_1([], _FuncDb, [], _Seen) -> + []. + +gco_po_parents([Child | Children], FuncDb) -> + #{ Child := #func_info{in=Parents}} = FuncDb, + Parents ++ gco_po_parents(Children, FuncDb); +gco_po_parents([], _FuncDb) -> + []. + %%% %%% Trivial sub passes. %%% -ssa_opt_dead(#st{ssa=Linear}=St) -> - St#st{ssa=beam_ssa_dead:opt(Linear)}. +ssa_opt_dead({#st{ssa=Linear}=St, FuncDb}) -> + {St#st{ssa=beam_ssa_dead:opt(Linear)}, FuncDb}. -ssa_opt_linearize(#st{ssa=Blocks}=St) -> - St#st{ssa=beam_ssa:linearize(Blocks)}. +ssa_opt_linearize({#st{ssa=Blocks}=St, FuncDb}) -> + {St#st{ssa=beam_ssa:linearize(Blocks)}, FuncDb}. -ssa_opt_type(#st{ssa=Linear,args=Args}=St) -> - St#st{ssa=beam_ssa_type:opt(Linear, Args)}. +ssa_opt_type_start({#st{ssa=Linear0,args=Args,anno=Anno}=St0, FuncDb0}) -> + {Linear, FuncDb} = beam_ssa_type:opt_start(Linear0, Args, Anno, FuncDb0), + {St0#st{ssa=Linear}, FuncDb}. -ssa_opt_blockify(#st{ssa=Linear}=St) -> - St#st{ssa=maps:from_list(Linear)}. +ssa_opt_type_continue({#st{ssa=Linear0,args=Args,anno=Anno}=St0, FuncDb0}) -> + {Linear, FuncDb} = beam_ssa_type:opt_continue(Linear0, Args, Anno, FuncDb0), + {St0#st{ssa=Linear}, FuncDb}. -ssa_opt_trim_unreachable(#st{ssa=Blocks}=St) -> - St#st{ssa=beam_ssa:trim_unreachable(Blocks)}. +ssa_opt_type_finish({#st{args=Args,anno=Anno0}=St0, FuncDb0}) -> + {Anno, FuncDb} = beam_ssa_type:opt_finish(Args, Anno0, FuncDb0), + {St0#st{anno=Anno}, FuncDb}. + +ssa_opt_blockify({#st{ssa=Linear}=St, FuncDb}) -> + {St#st{ssa=maps:from_list(Linear)}, FuncDb}. + +ssa_opt_trim_unreachable({#st{ssa=Blocks}=St, FuncDb}) -> + {St#st{ssa=beam_ssa:trim_unreachable(Blocks)}, FuncDb}. %%% %%% Split blocks before certain instructions to enable more optimizations. @@ -128,14 +325,14 @@ ssa_opt_trim_unreachable(#st{ssa=Blocks}=St) -> %%% for sinking get_tuple_element instructions. %%% -ssa_opt_split_blocks(#st{ssa=Blocks0,cnt=Count0}=St) -> +ssa_opt_split_blocks({#st{ssa=Blocks0,cnt=Count0}=St, FuncDb}) -> P = fun(#b_set{op={bif,element}}) -> true; (#b_set{op=call}) -> true; (#b_set{op=make_fun}) -> true; (_) -> false end, {Blocks,Count} = beam_ssa:split_blocks(P, Blocks0, Count0), - St#st{ssa=Blocks,cnt=Count}. + {St#st{ssa=Blocks,cnt=Count}, FuncDb}. %%% %%% Coalesce phi nodes. @@ -159,10 +356,10 @@ ssa_opt_split_blocks(#st{ssa=Blocks0,cnt=Count0}=St) -> %%% different registers). %%% -ssa_opt_coalesce_phis(#st{ssa=Blocks0}=St) -> +ssa_opt_coalesce_phis({#st{ssa=Blocks0}=St, FuncDb}) -> Ls = beam_ssa:rpo(Blocks0), Blocks = c_phis_1(Ls, Blocks0), - St#st{ssa=Blocks}. + {St#st{ssa=Blocks}, FuncDb}. c_phis_1([L|Ls], Blocks0) -> case maps:get(L, Blocks0) of @@ -234,6 +431,160 @@ c_fix_branches([{_,Pred}|As], L, Blocks0) -> c_fix_branches([], _, Blocks) -> Blocks. %%% +%%% Eliminate phi nodes in the tail of a function. +%%% +%%% Try to eliminate short blocks that starts with a phi node +%%% and end in a return. For example: +%%% +%%% Result = phi { Res1, 4 }, { literal true, 5 } +%%% Ret = put_tuple literal ok, Result +%%% ret Ret +%%% +%%% The code in this block can be inserted at the end blocks 4 and +%%% 5. Thus, the following code can be inserted into block 4: +%%% +%%% Ret:1 = put_tuple literal ok, Res1 +%%% ret Ret:1 +%%% +%%% And the following code into block 5: +%%% +%%% Ret:2 = put_tuple literal ok, literal true +%%% ret Ret:2 +%%% +%%% Which can be further simplified to: +%%% +%%% ret literal {ok, true} +%%% +%%% This transformation may lead to more code improvements: +%%% +%%% - Stack trimming +%%% - Fewer test_heap instructions +%%% - Smaller stack frames +%%% + +ssa_opt_tail_phis({#st{ssa=SSA0,cnt=Count0}=St, FuncDb}) -> + {SSA,Count} = opt_tail_phis(SSA0, Count0), + {St#st{ssa=SSA,cnt=Count}, FuncDb}. + +opt_tail_phis(Blocks, Count) when is_map(Blocks) -> + opt_tail_phis(maps:values(Blocks), Blocks, Count); +opt_tail_phis(Linear0, Count0) when is_list(Linear0) -> + Blocks0 = maps:from_list(Linear0), + {Blocks,Count} = opt_tail_phis(Blocks0, Count0), + {beam_ssa:linearize(Blocks),Count}. + +opt_tail_phis([#b_blk{is=Is0,last=Last}|Bs], Blocks0, Count0) -> + case {Is0,Last} of + {[#b_set{op=phi,args=[_,_|_]}|_],#b_ret{arg=#b_var{}}=Ret} -> + {Phis,Is} = splitwith(fun(#b_set{op=Op}) -> Op =:= phi end, Is0), + case suitable_tail_ops(Is) of + true -> + {Blocks,Count} = opt_tail_phi(Phis, Is, Ret, + Blocks0, Count0), + opt_tail_phis(Bs, Blocks, Count); + false -> + opt_tail_phis(Bs, Blocks0, Count0) + end; + {_,_} -> + opt_tail_phis(Bs, Blocks0, Count0) + end; +opt_tail_phis([], Blocks, Count) -> + {Blocks,Count}. + +opt_tail_phi(Phis0, Is, Ret, Blocks0, Count0) -> + Phis = rel2fam(reduce_phis(Phis0)), + {Blocks,Count,Cost} = + foldl(fun(PhiArg, Acc) -> + opt_tail_phi_arg(PhiArg, Is, Ret, Acc) + end, {Blocks0,Count0,0}, Phis), + MaxCost = length(Phis) * 3 + 2, + if + Cost =< MaxCost -> + %% The transformation would cause at most a slight + %% increase in code size if no more optimizations + %% can be applied. + {Blocks,Count}; + true -> + %% The code size would be increased too much. + {Blocks0,Count0} + end. + +reduce_phis([#b_set{dst=PhiDst,args=PhiArgs}|Is]) -> + [{L,{PhiDst,Val}} || {Val,L} <- PhiArgs] ++ reduce_phis(Is); +reduce_phis([]) -> []. + +opt_tail_phi_arg({PredL,Sub0}, Is0, Ret0, {Blocks0,Count0,Cost0}) -> + Blk0 = map_get(PredL, Blocks0), + #b_blk{is=IsPrefix,last=#b_br{succ=Next,fail=Next}} = Blk0, + case is_exit_bif(IsPrefix) of + false -> + Sub1 = maps:from_list(Sub0), + {Is1,Count,Sub} = new_names(Is0, Sub1, Count0, []), + Is2 = [sub(I, Sub) || I <- Is1], + Cost = build_cost(Is2, Cost0), + Is = IsPrefix ++ Is2, + Ret = sub(Ret0, Sub), + Blk = Blk0#b_blk{is=Is,last=Ret}, + Blocks = Blocks0#{PredL:=Blk}, + {Blocks,Count,Cost}; + true -> + %% The block ends in a call to a function that + %% will cause an exception. + {Blocks0,Count0,Cost0+3} + end. + +is_exit_bif([#b_set{op=call, + args=[#b_remote{mod=#b_literal{val=Mod}, + name=#b_literal{val=Name}}|Args]}]) -> + erl_bifs:is_exit_bif(Mod, Name, length(Args)); +is_exit_bif(_) -> false. + +new_names([#b_set{dst=Dst}=I|Is], Sub0, Count0, Acc) -> + {NewDst,Count} = new_var(Dst, Count0), + Sub = Sub0#{Dst=>NewDst}, + new_names(Is, Sub, Count, [I#b_set{dst=NewDst}|Acc]); +new_names([], Sub, Count, Acc) -> + {reverse(Acc),Count,Sub}. + +suitable_tail_ops(Is) -> + all(fun(#b_set{op=Op}) -> + is_suitable_tail_op(Op) + end, Is). + +is_suitable_tail_op({bif,_}) -> true; +is_suitable_tail_op(put_list) -> true; +is_suitable_tail_op(put_tuple) -> true; +is_suitable_tail_op(_) -> false. + +build_cost([#b_set{op=put_list,args=Args}|Is], Cost) -> + case are_all_literals(Args) of + true -> + build_cost(Is, Cost); + false -> + build_cost(Is, Cost + 1) + end; +build_cost([#b_set{op=put_tuple,args=Args}|Is], Cost) -> + case are_all_literals(Args) of + true -> + build_cost(Is, Cost); + false -> + build_cost(Is, Cost + length(Args) + 1) + end; +build_cost([#b_set{op={bif,_},args=Args}|Is], Cost) -> + case are_all_literals(Args) of + true -> + build_cost(Is, Cost); + false -> + build_cost(Is, Cost + 1) + end; +build_cost([], Cost) -> Cost. + +are_all_literals(Args) -> + all(fun(#b_literal{}) -> true; + (_) -> false + end, Args). + +%%% %%% Order element/2 calls. %%% %%% Order an unbroken chain of element/2 calls for the same tuple @@ -242,7 +593,7 @@ c_fix_branches([], _, Blocks) -> Blocks. %%% be replaced with get_tuple_element/3 instructions. %%% -ssa_opt_element(#st{ssa=Blocks}=St) -> +ssa_opt_element({#st{ssa=Blocks}=St, FuncDb}) -> %% Collect the information about element instructions in this %% function. GetEls = collect_element_calls(beam_ssa:linearize(Blocks)), @@ -254,7 +605,7 @@ ssa_opt_element(#st{ssa=Blocks}=St) -> %% For each chain, swap the first element call with the %% element call with the highest index. - St#st{ssa=swap_element_calls(Chains, Blocks)}. + {St#st{ssa=swap_element_calls(Chains, Blocks)}, FuncDb}. collect_element_calls([{L,#b_blk{is=Is0,last=Last}}|Bs]) -> case {Is0,Last} of @@ -315,9 +666,9 @@ swap_element_calls_1([], _, Blocks) -> %%% when applicable. %%% -ssa_opt_record(#st{ssa=Linear}=St) -> +ssa_opt_record({#st{ssa=Linear}=St, FuncDb}) -> Blocks = maps:from_list(Linear), - St#st{ssa=record_opt(Linear, Blocks)}. + {St#st{ssa=record_opt(Linear, Blocks)}, FuncDb}. record_opt([{L,#b_blk{is=Is0,last=Last}=Blk0}|Bs], Blocks) -> Is = record_opt_is(Is0, Last, Blocks), @@ -401,9 +752,9 @@ is_tagged_tuple_4([], _, _) -> no. %%% subexpressions across instructions that clobber the X registers. %%% -ssa_opt_cse(#st{ssa=Linear}=St) -> +ssa_opt_cse({#st{ssa=Linear}=St, FuncDb}) -> M = #{0=>#{}}, - St#st{ssa=cse(Linear, #{}, M)}. + {St#st{ssa=cse(Linear, #{}, M)}, FuncDb}. cse([{L,#b_blk{is=Is0,last=Last0}=Blk}|Bs], Sub0, M0) -> Es0 = maps:get(L, M0), @@ -544,13 +895,13 @@ cse_suitable(#b_set{}) -> false. bs :: beam_ssa:block_map() }). -ssa_opt_float(#st{ssa=Linear0,cnt=Count0}=St) -> +ssa_opt_float({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> NonGuards0 = float_non_guards(Linear0), NonGuards = gb_sets:from_list(NonGuards0), Blocks = maps:from_list(Linear0), Fs = #fs{non_guards=NonGuards,bs=Blocks}, {Linear,Count} = float_opt(Linear0, Count0, Fs), - St#st{ssa=Linear,cnt=Count}. + {St#st{ssa=Linear,cnt=Count}, FuncDb}. float_non_guards([{L,#b_blk{is=Is}}|Bs]) -> case Is of @@ -788,12 +1139,12 @@ float_flush_regs(#fs{regs=Rs}) -> %%% with a cheaper instructions %%% -ssa_opt_live(#st{ssa=Linear0}=St) -> +ssa_opt_live({#st{ssa=Linear0}=St, FuncDb}) -> RevLinear = reverse(Linear0), Blocks0 = maps:from_list(RevLinear), Blocks = live_opt(RevLinear, #{}, Blocks0), Linear = beam_ssa:linearize(Blocks), - St#st{ssa=Linear}. + {St#st{ssa=Linear}, FuncDb}. live_opt([{L,Blk0}|Bs], LiveMap0, Blocks) -> Blk1 = beam_ssa_share:block(Blk0, Blocks), @@ -855,14 +1206,9 @@ live_opt_is([#b_set{op=succeeded,dst=SuccDst=SuccDstVar, #b_set{dst=Dst}=I|Is], Live0, Acc) -> case gb_sets:is_member(Dst, Live0) of true -> - case gb_sets:is_member(SuccDst, Live0) of - true -> - Live1 = gb_sets:add(Dst, Live0), - Live = gb_sets:delete_any(SuccDst, Live1), - live_opt_is([I|Is], Live, [SuccI|Acc]); - false -> - live_opt_is([I|Is], Live0, Acc) - end; + Live1 = gb_sets:add(Dst, Live0), + Live = gb_sets:delete_any(SuccDst, Live1), + live_opt_is([I|Is], Live, [SuccI|Acc]); false -> case live_opt_unused(I) of {replace,NewI0} -> @@ -902,24 +1248,32 @@ live_opt_unused(#b_set{op=get_map_element}=Set) -> live_opt_unused(_) -> keep. %%% -%%% Optimize binary matching instructions. +%%% Optimize binary matching. +%%% +%%% * If the value of segment is never extracted, rewrite +%%% to a bs_skip instruction. +%%% +%%% * Coalesce adjacent bs_skip instructions and skip instructions +%%% with bs_test_tail. %%% -ssa_opt_bsm(#st{ssa=Linear}=St) -> +ssa_opt_bsm({#st{ssa=Linear}=St, FuncDb}) -> Extracted0 = bsm_extracted(Linear), Extracted = cerl_sets:from_list(Extracted0), - St#st{ssa=bsm_skip(Linear, Extracted)}. + {St#st{ssa=bsm_skip(Linear, Extracted)}, FuncDb}. -bsm_skip([{L,#b_blk{is=Is0}=Blk}|Bs], Extracted) -> +bsm_skip([{L,#b_blk{is=Is0}=Blk}|Bs0], Extracted) -> + Bs = bsm_skip(Bs0, Extracted), Is = bsm_skip_is(Is0, Extracted), - [{L,Blk#b_blk{is=Is}}|bsm_skip(Bs, Extracted)]; + coalesce_skips({L,Blk#b_blk{is=Is}}, Bs); bsm_skip([], _) -> []. bsm_skip_is([I0|Is], Extracted) -> case I0 of - #b_set{op=bs_match,args=[#b_literal{val=string}|_]} -> - [I0|bsm_skip_is(Is, Extracted)]; - #b_set{op=bs_match,dst=Ctx,args=[Type,PrevCtx|Args0]} -> + #b_set{op=bs_match, + dst=Ctx, + args=[#b_literal{val=T}=Type,PrevCtx|Args0]} + when T =/= string, T =/= skip -> I = case cerl_sets:is_element(Ctx, Extracted) of true -> I0; @@ -943,18 +1297,75 @@ bsm_extracted([{_,#b_blk{is=Is}}|Bs]) -> end; bsm_extracted([]) -> []. +coalesce_skips({L,#b_blk{is=[#b_set{op=bs_extract}=Extract|Is0], + last=Last0}=Blk0}, Bs0) -> + case coalesce_skips_is(Is0, Last0, Bs0) of + not_possible -> + [{L,Blk0}|Bs0]; + {Is,Last,Bs} -> + Blk = Blk0#b_blk{is=[Extract|Is],last=Last}, + [{L,Blk}|Bs] + end; +coalesce_skips({L,#b_blk{is=Is0,last=Last0}=Blk0}, Bs0) -> + case coalesce_skips_is(Is0, Last0, Bs0) of + not_possible -> + [{L,Blk0}|Bs0]; + {Is,Last,Bs} -> + Blk = Blk0#b_blk{is=Is,last=Last}, + [{L,Blk}|Bs] + end. + +coalesce_skips_is([#b_set{op=bs_match, + args=[#b_literal{val=skip}, + Ctx0,Type,Flags, + #b_literal{val=Size0}, + #b_literal{val=Unit0}]}=Skip0, + #b_set{op=succeeded}], + #b_br{succ=L2,fail=Fail}=Br0, + Bs0) when is_integer(Size0) -> + case Bs0 of + [{L2,#b_blk{is=[#b_set{op=bs_match, + dst=SkipDst, + args=[#b_literal{val=skip},_,_,_, + #b_literal{val=Size1}, + #b_literal{val=Unit1}]}, + #b_set{op=succeeded}=Succeeded], + last=#b_br{fail=Fail}=Br}}|Bs] when is_integer(Size1) -> + SkipBits = Size0 * Unit0 + Size1 * Unit1, + Skip = Skip0#b_set{dst=SkipDst, + args=[#b_literal{val=skip},Ctx0, + Type,Flags, + #b_literal{val=SkipBits}, + #b_literal{val=1}]}, + Is = [Skip,Succeeded], + {Is,Br,Bs}; + [{L2,#b_blk{is=[#b_set{op=bs_test_tail, + args=[_Ctx,#b_literal{val=TailSkip}]}], + last=#b_br{succ=NextSucc,fail=Fail}}}|Bs] -> + SkipBits = Size0 * Unit0, + TestTail = Skip0#b_set{op=bs_test_tail, + args=[Ctx0,#b_literal{val=SkipBits+TailSkip}]}, + Br = Br0#b_br{bool=TestTail#b_set.dst,succ=NextSucc}, + Is = [TestTail], + {Is,Br,Bs}; + _ -> + not_possible + end; +coalesce_skips_is(_, _, _) -> + not_possible. + %%% %%% Short-cutting binary matching instructions. %%% -ssa_opt_bsm_shortcut(#st{ssa=Linear}=St) -> +ssa_opt_bsm_shortcut({#st{ssa=Linear}=St, FuncDb}) -> Positions = bsm_positions(Linear, #{}), case map_size(Positions) of 0 -> %% No binary matching instructions. - St; + {St, FuncDb}; _ -> - St#st{ssa=bsm_shortcut(Linear, Positions)} + {St#st{ssa=bsm_shortcut(Linear, Positions)}, FuncDb} end. bsm_positions([{L,#b_blk{is=Is,last=Last}}|Bs], PosMap0) -> @@ -1016,8 +1427,8 @@ bsm_shortcut([], _PosMap) -> []. %%% Eliminate redundant bs_test_unit2 instructions. %%% -ssa_opt_bsm_units(#st{ssa=Linear}=St) -> - St#st{ssa=bsm_units(Linear, #{})}. +ssa_opt_bsm_units({#st{ssa=Linear}=St, FuncDb}) -> + {St#st{ssa=bsm_units(Linear, #{})}, FuncDb}. bsm_units([{L,#b_blk{last=#b_br{succ=Succ,fail=Fail}}=Block0} | Bs], UnitMaps0) -> UnitsIn = maps:get(L, UnitMaps0, #{}), @@ -1117,91 +1528,172 @@ bsm_units_join_1([], _MapA, Right) -> Right. %%% -%%% Miscellanous optimizations in execution order. +%%% Optimize binary construction. +%%% +%%% If an integer segment or a float segment has a literal size and +%%% a literal value, convert to a binary segment. Coalesce adjacent +%%% literal binary segments. Literal binary segments will be converted +%%% to bs_put_string instructions in later pass. %%% -ssa_opt_misc(#st{ssa=Linear}=St) -> - St#st{ssa=misc_opt(Linear, #{})}. +ssa_opt_bs_puts({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> + {Linear,Count} = opt_bs_puts(Linear0, Count0, []), + {St#st{ssa=Linear,cnt=Count}, FuncDb}. -misc_opt([{L,#b_blk{is=Is0,last=Last0}=Blk0}|Bs], Sub0) -> - {Is,Sub} = misc_opt_is(Is0, Sub0, []), - Last = sub(Last0, Sub), - Blk = Blk0#b_blk{is=Is,last=Last}, - [{L,Blk}|misc_opt(Bs, Sub)]; -misc_opt([], _) -> []. +opt_bs_puts([{L,#b_blk{is=Is}=Blk0}|Bs], Count0, Acc0) -> + case Is of + [#b_set{op=bs_put}=I0] -> + case opt_bs_put(L, I0, Blk0, Count0, Acc0) of + not_possible -> + opt_bs_puts(Bs, Count0, [{L,Blk0}|Acc0]); + {Count,Acc1} -> + Acc = opt_bs_puts_merge(Acc1), + opt_bs_puts(Bs, Count, Acc) + end; + _ -> + opt_bs_puts(Bs, Count0, [{L,Blk0}|Acc0]) + end; +opt_bs_puts([], Count, Acc) -> + {reverse(Acc),Count}. -misc_opt_is([#b_set{op=phi}=I0|Is], Sub0, Acc) -> - #b_set{dst=Dst,args=Args} = I = sub(I0, Sub0), - case all_same(Args) of +opt_bs_puts_merge([{L1,#b_blk{is=Is}=Blk0},{L2,#b_blk{is=AccIs}}=BAcc|Acc]) -> + case {AccIs,Is} of + {[#b_set{op=bs_put, + args=[#b_literal{val=binary}, + #b_literal{}, + #b_literal{val=Bin0}, + #b_literal{val=all}, + #b_literal{val=1}]}], + [#b_set{op=bs_put, + args=[#b_literal{val=binary}, + #b_literal{}, + #b_literal{val=Bin1}, + #b_literal{val=all}, + #b_literal{val=1}]}=I0]} -> + %% Coalesce the two segments to one. + Bin = <<Bin0/bitstring,Bin1/bitstring>>, + I = I0#b_set{args=bs_put_args(binary, Bin, all)}, + Blk = Blk0#b_blk{is=[I]}, + [{L2,Blk}|Acc]; + {_,_} -> + [{L1,Blk0},BAcc|Acc] + end. + +opt_bs_put(L, I0, #b_blk{last=Br0}=Blk0, Count0, Acc) -> + case opt_bs_put(I0) of + [Bin] when is_bitstring(Bin) -> + Args = bs_put_args(binary, Bin, all), + I = I0#b_set{args=Args}, + Blk = Blk0#b_blk{is=[I]}, + {Count0,[{L,Blk}|Acc]}; + [{int,Int,Size},Bin] when is_bitstring(Bin) -> + %% Construct a bs_put_integer instruction following + %% by a bs_put_binary instruction. + IntArgs = bs_put_args(integer, Int, Size), + BinArgs = bs_put_args(binary, Bin, all), + {BinL,BinVarNum} = {Count0,Count0+1}, + Count = Count0 + 2, + BinVar = #b_var{name={'@ssa_bool',BinVarNum}}, + BinI = I0#b_set{dst=BinVar,args=BinArgs}, + BinBlk = Blk0#b_blk{is=[BinI],last=Br0#b_br{bool=BinVar}}, + IntI = I0#b_set{args=IntArgs}, + IntBlk = Blk0#b_blk{is=[IntI],last=Br0#b_br{succ=BinL}}, + {Count,[{BinL,BinBlk},{L,IntBlk}|Acc]}; + not_possible -> + not_possible + end. + +opt_bs_put(#b_set{args=[#b_literal{val=binary},_,#b_literal{val=Val}, + #b_literal{val=all},#b_literal{val=Unit}]}) + when is_bitstring(Val) -> + if + bit_size(Val) rem Unit =:= 0 -> + [Val]; true -> - %% Eliminate the phi node if there is just one source - %% value or if the values are identical. - [{Val,_}|_] = Args, - Sub = Sub0#{Dst=>Val}, - misc_opt_is(Is, Sub, Acc); - false -> - misc_opt_is(Is, Sub0, [I|Acc]) - end; -misc_opt_is([#b_set{op={bif,'and'}}=I0], Sub, Acc) -> - #b_set{dst=Dst,args=Args} = I = sub(I0, Sub), - case eval_and(Args) of - error -> - misc_opt_is([], Sub, [I|Acc]); - Val -> - misc_opt_is([], Sub#{Dst=>Val}, Acc) - end; -misc_opt_is([#b_set{op={bif,'or'}}=I0], Sub, Acc) -> - #b_set{dst=Dst,args=Args} = I = sub(I0, Sub), - case eval_or(Args) of - error -> - misc_opt_is([], Sub, [I|Acc]); - Val -> - misc_opt_is([], Sub#{Dst=>Val}, Acc) + not_possible end; -misc_opt_is([#b_set{}=I0|Is], Sub, Acc) -> - #b_set{op=Op,dst=Dst,args=Args} = I = sub(I0, Sub), - case make_literal(Op, Args) of - #b_literal{}=Literal -> - misc_opt_is(Is, Sub#{Dst=>Literal}, Acc); - error -> - misc_opt_is(Is, Sub, [I|Acc]) +opt_bs_put(#b_set{args=[#b_literal{val=Type},#b_literal{val=Flags}, + #b_literal{val=Val},#b_literal{val=Size}, + #b_literal{val=Unit}]}=I0) when is_integer(Size) -> + EffectiveSize = Size * Unit, + if + EffectiveSize > 0 -> + case {Type,opt_bs_put_endian(Flags)} of + {integer,big} when is_integer(Val) -> + if + EffectiveSize < 64 -> + [<<Val:EffectiveSize>>]; + true -> + opt_bs_put_split_int(Val, EffectiveSize) + end; + {integer,little} when is_integer(Val), EffectiveSize < 128 -> + %% To avoid an explosion in code size, we only try + %% to optimize relatively small fields. + <<Int:EffectiveSize>> = <<Val:EffectiveSize/little>>, + Args = bs_put_args(Type, Int, EffectiveSize), + I = I0#b_set{args=Args}, + opt_bs_put(I); + {binary,_} when is_bitstring(Val) -> + <<Bitstring:EffectiveSize/bits,_/bits>> = Val, + [Bitstring]; + {float,Endian} -> + try + [opt_bs_put_float(Val, EffectiveSize, Endian)] + catch error:_ -> + not_possible + end; + {_,_} -> + not_possible + end; + true -> + not_possible end; -misc_opt_is([], Sub, Acc) -> - {reverse(Acc),Sub}. +opt_bs_put(#b_set{}) -> not_possible. -all_same([{H,_}|T]) -> - all(fun({E,_}) -> E =:= H end, T). - -make_literal(put_tuple, Args) -> - case make_literal_list(Args, []) of - error -> - error; - List -> - #b_literal{val=list_to_tuple(List)} - end; -make_literal(put_list, [#b_literal{val=H},#b_literal{val=T}]) -> - #b_literal{val=[H|T]}; -make_literal(_, _) -> error. +opt_bs_put_float(N, Sz, Endian) -> + case Endian of + big -> <<N:Sz/big-float-unit:1>>; + little -> <<N:Sz/little-float-unit:1>> + end. -make_literal_list([#b_literal{val=H}|T], Acc) -> - make_literal_list(T, [H|Acc]); -make_literal_list([_|_], _) -> - error; -make_literal_list([], Acc) -> - reverse(Acc). - -eval_and(Args) -> - case Args of - [_,#b_literal{val=false}=Res] -> Res; - [Res,#b_literal{val=true}] -> Res; - [_,_] -> error +bs_put_args(Type, Val, Size) -> + [#b_literal{val=Type}, + #b_literal{val=[unsigned,big]}, + #b_literal{val=Val}, + #b_literal{val=Size}, + #b_literal{val=1}]. + +opt_bs_put_endian([big=E|_]) -> E; +opt_bs_put_endian([little=E|_]) -> E; +opt_bs_put_endian([native=E|_]) -> E; +opt_bs_put_endian([_|Fs]) -> opt_bs_put_endian(Fs). + +opt_bs_put_split_int(Int, Size) -> + Pos = opt_bs_put_split_int_1(Int, 0, Size - 1), + UpperSize = Size - Pos, + if + Pos =:= 0 -> + %% Value is 0 or -1 -- keep the original instruction. + not_possible; + UpperSize < 64 -> + %% No or few leading zeroes or ones. + [<<Int:Size>>]; + true -> + %% There are 64 or more leading ones or zeroes in + %% the resulting binary. Split into two separate + %% segments to avoid an explosion in code size. + [{int,Int bsr Pos,UpperSize},<<Int:Pos>>] end. -eval_or(Args) -> - case Args of - [Res,#b_literal{val=false}] -> Res; - [_,#b_literal{val=true}=Res] -> Res; - [_,_] -> error +opt_bs_put_split_int_1(_Int, L, R) when L > R -> + 8 * ((L + 7) div 8); +opt_bs_put_split_int_1(Int, L, R) -> + Mid = (L + R) div 2, + case Int bsr Mid of + Upper when Upper =:= 0; Upper =:= -1 -> + opt_bs_put_split_int_1(Int, L, Mid - 1); + _ -> + opt_bs_put_split_int_1(Int, Mid + 1, R) end. %%% @@ -1264,9 +1756,9 @@ eval_or(Args) -> %%% is_tuple_of_arity instruction by the loader. %%% -ssa_opt_tuple_size(#st{ssa=Linear0,cnt=Count0}=St) -> +ssa_opt_tuple_size({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> {Linear,Count} = opt_tup_size(Linear0, Count0, []), - St#st{ssa=Linear,cnt=Count}. + {St#st{ssa=Linear,cnt=Count}, FuncDb}. opt_tup_size([{L,#b_blk{is=Is,last=Last}=Blk}|Bs], Count0, Acc0) -> case {Is,Last} of @@ -1339,9 +1831,9 @@ opt_tup_size_is([], _, _, _Acc) -> none. %%% is 'true' or 'false' can be rewritten to a is_boolean test. %%% -ssa_opt_sw(#st{ssa=Linear0,cnt=Count0}=St) -> +ssa_opt_sw({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> {Linear,Count} = opt_sw(Linear0, #{}, Count0, []), - St#st{ssa=Linear,cnt=Count}. + {St#st{ssa=Linear,cnt=Count}, FuncDb}. opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Last0}=Blk0}|Bs], Phis0, Count0, Acc) -> Phis = opt_sw_phis(Is, Phis0), @@ -1432,9 +1924,10 @@ opt_sw_literals([], Acc) -> Acc. %%% Merge blocks. %%% -ssa_opt_merge_blocks(#st{ssa=Blocks}=St) -> +ssa_opt_merge_blocks({#st{ssa=Blocks}=St, FuncDb}) -> Preds = beam_ssa:predecessors(Blocks), - St#st{ssa=merge_blocks_1(beam_ssa:rpo(Blocks), Preds, Blocks)}. + Merged = merge_blocks_1(beam_ssa:rpo(Blocks), Preds, Blocks), + {St#st{ssa=Merged}, FuncDb}. merge_blocks_1([L|Ls], Preds0, Blocks0) -> case Preds0 of @@ -1444,6 +1937,7 @@ merge_blocks_1([L|Ls], Preds0, Blocks0) -> true -> #b_blk{is=Is0} = Blk0, #b_blk{is=Is1} = Blk1, + verify_merge_is(Is1), Is = Is0 ++ Is1, Blk = Blk1#b_blk{is=Is}, Blocks1 = maps:remove(L, Blocks0), @@ -1469,13 +1963,24 @@ merge_update_preds([], _, _, Preds) -> Preds. rename_label(From, From, To) -> To; rename_label(Lbl, _, _) -> Lbl. -is_merge_allowed(_, _, #b_blk{is=[#b_set{op=peek_message}|_]}) -> +verify_merge_is([#b_set{op=Op}|_]) -> + %% The merged block has only one predecessor, so it should not have any phi + %% nodes. + true = Op =/= phi; %Assertion. +verify_merge_is(_) -> + ok. + +is_merge_allowed(_, #b_blk{}, #b_blk{is=[#b_set{op=peek_message}|_]}) -> false; -is_merge_allowed(L, Blk0, #b_blk{}) -> - case beam_ssa:successors(Blk0) of +is_merge_allowed(L, #b_blk{last=#b_br{}}=Blk, #b_blk{}) -> + %% The predecessor block must have exactly one successor (L) for + %% the merge to be safe. + case beam_ssa:successors(Blk) of [L] -> true; [_|_] -> false - end. + end; +is_merge_allowed(_, #b_blk{last=#b_switch{}}, #b_blk{}) -> + false. %%% %%% When a tuple is matched, the pattern matching compiler generates a @@ -1493,7 +1998,7 @@ is_merge_allowed(L, Blk0, #b_blk{}) -> %%% extracted values. %%% -ssa_opt_sink(#st{ssa=Blocks0}=St) -> +ssa_opt_sink({#st{ssa=Blocks0}=St, FuncDb}) -> Linear = beam_ssa:linearize(Blocks0), %% Create a map with all variables that define get_tuple_element @@ -1534,7 +2039,7 @@ ssa_opt_sink(#st{ssa=Blocks0}=St) -> From = maps:get(V, Defs), move_defs(V, From, To, A) end, Blocks0, DefLoc), - St#st{ssa=Blocks}. + {St#st{ssa=Blocks}, FuncDb}. def_blocks([{L,#b_blk{is=Is}}|Bs]) -> def_blocks_is(Is, L, def_blocks(Bs)); @@ -1769,3 +2274,9 @@ sub_arg(Old, Sub) -> #{Old:=New} -> New; #{} -> Old end. + +new_var(#b_var{name={Base,N}}, Count) -> + true = is_integer(N), %Assertion. + {#b_var{name={Base,Count}},Count+1}; +new_var(#b_var{name=Base}, Count) -> + {#b_var{name={Base,Count}},Count+1}. diff --git a/lib/compiler/src/beam_ssa_opt.hrl b/lib/compiler/src/beam_ssa_opt.hrl new file mode 100644 index 0000000000..37711a6f48 --- /dev/null +++ b/lib/compiler/src/beam_ssa_opt.hrl @@ -0,0 +1,53 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. 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% +%% + +-include("beam_ssa.hrl"). + +-record(func_info, + {%% Local calls going in/out of this function. + in = ordsets:new() :: ordsets:ordset(func_id()), + out = ordsets:new() :: ordsets:ordset(func_id()), + + %% Whether the function is exported or not; some optimizations may + %% need to be suppressed if it is. + exported = true :: boolean(), + + %% The inferred types of each argument (as opposed to parameter), + %% indexed by call site. + %% + %% This is more effective than the naive approach of joining into a + %% "parameter_type" as we go as it lets us narrow parameter types + %% without having to visit all callers on each pass, which helps a lot + %% when dealing with co-recursive functions. + arg_types = [] :: list(arg_type_map()), + + %% The inferred return type of this function, this is either [type()] + %% or [] to note absence. + ret_type = [] :: list()}). + +-type arg_key() :: {CallerId :: func_id(), + CallDst :: beam_ssa:b_var()}. +-type arg_type_map() :: #{ arg_key() => term() }. + +%% Per-function metadata used by various optimization passes to perform +%% module-level optimization. If a function is absent it means that +%% module-level optimization has been turned off for said function. +-type func_id() :: beam_ssa:b_local(). +-type func_info_db() :: #{ func_id() => #func_info{} }. diff --git a/lib/compiler/src/beam_ssa_pre_codegen.erl b/lib/compiler/src/beam_ssa_pre_codegen.erl index 56fe9b4793..fde1118c29 100644 --- a/lib/compiler/src/beam_ssa_pre_codegen.erl +++ b/lib/compiler/src/beam_ssa_pre_codegen.erl @@ -72,7 +72,7 @@ -import(lists, [all/2,any/2,append/1,duplicate/2, foldl/3,last/1,map/2,member/2,partition/2, - reverse/1,reverse/2,sort/1,zip/2]). + reverse/1,reverse/2,sort/1,splitwith/2,zip/2]). -spec module(beam_ssa:b_module(), [compile:option()]) -> {'ok',beam_ssa:b_module()}. @@ -1031,7 +1031,7 @@ need_frame_1([#b_set{op=call,args=[Func|_]}|Is], Context) -> case Func of #b_remote{mod=#b_literal{val=Mod}, name=#b_literal{val=Name}, - arity=Arity} -> + arity=Arity} when is_atom(Mod), is_atom(Name) -> case erl_bifs:is_exit_bif(Mod, Name, Arity) of true -> false; @@ -1993,21 +1993,35 @@ reserve_zregs(Blocks, Intervals, Res) -> end, beam_ssa:fold_rpo(F, [0], Res, Blocks). +reserve_zreg([#b_set{op=call,dst=Dst}], + #b_br{bool=Dst}, _ShortLived, A) -> + %% If type optimization has determined that the result of a call can be + %% used directly in a branch, we must avoid reserving a z register or code + %% generation will fail. + A; reserve_zreg([#b_set{op={bif,tuple_size},dst=Dst}, #b_set{op={bif,'=:='},args=[Dst,Val]}], Last, ShortLived, A0) -> case {Val,Last} of - {#b_literal{val=Arity},#b_br{}} when Arity bsr 32 =:= 0 -> + {#b_literal{val=Arity},#b_br{bool=#b_var{}}} when Arity bsr 32 =:= 0 -> %% These two instructions can be combined to a test_arity %% instruction provided that the arity variable is short-lived. reserve_zreg_1(Dst, ShortLived, A0); {_,_} -> - %% Either the arity is too big, or the boolean value from - %% '=:=' will be returned. + %% Either the arity is too big, or the boolean value is not + %% used in a conditional branch. A0 end; reserve_zreg([#b_set{op={bif,tuple_size},dst=Dst}], #b_switch{}, ShortLived, A) -> reserve_zreg_1(Dst, ShortLived, A); +reserve_zreg([#b_set{op={bif,'xor'}}], _Last, _ShortLived, A) -> + %% There is no short, easy way to rewrite 'xor' to a series of + %% test instructions. + A; +reserve_zreg([#b_set{op={bif,is_record}}], _Last, _ShortLived, A) -> + %% There is no short, easy way to rewrite is_record/2 to a series of + %% test instructions. + A; reserve_zreg([#b_set{op=Op,dst=Dst}|Is], Last, ShortLived, A0) -> IsZReg = case Op of bs_match_string -> true; @@ -2072,23 +2086,95 @@ reserve_freg([], Res) -> Res. %% will allocate the lowest free X register for the variable. reserve_xregs(Blocks, Res) -> - F = fun(L, #b_blk{is=Is,last=Last}, R) -> - {Xs0,Used0} = reserve_terminator(L, Last, Blocks, R), - reserve_xregs_is(reverse(Is), R, Xs0, Used0) - end, - beam_ssa:fold_po(F, Res, Blocks). - + Ls = reverse(beam_ssa:rpo(Blocks)), + reserve_xregs(Ls, Blocks, #{}, Res). + +reserve_xregs([L|Ls], Blocks, XsMap0, Res0) -> + #b_blk{anno=Anno,is=Is0,last=Last} = map_get(L, Blocks), + + %% Calculate mapping from variable name to the preferred + %% register. + Xs0 = reserve_terminator(L, Is0, Last, Blocks, XsMap0, Res0), + + %% We need to figure out where the code generator will + %% place instructions that will do a garbage collection. + %% Insert 'gc' markers as pseudo-instructions in the + %% instruction sequence. + Is1 = reverse(Is0), + Is2 = res_place_gc_instrs(Is1, []), + Is = res_place_allocate(Anno, Is2), + + %% Add register hints for variables that are defined + %% in the (reversed) instruction sequence. + {Res,Xs} = reserve_xregs_is(Is, Res0, Xs0, []), + + XsMap = XsMap0#{L=>Xs}, + reserve_xregs(Ls, Blocks, XsMap, Res); +reserve_xregs([], _, _, Res) -> Res. + +%% Insert explicit 'gc' markers points where there will +%% be a garbage collection. (Note that the instruction +%% sequence passed to this function is reversed.) + +res_place_gc_instrs([#b_set{op=phi}=I|Is], Acc) -> + res_place_gc_instrs(Is, [I|Acc]); +res_place_gc_instrs([#b_set{op=Op}=I|Is], Acc) + when Op =:= call; Op =:= make_fun -> + case Acc of + [] -> + res_place_gc_instrs(Is, [I|Acc]); + [GC|_] when GC =:= gc; GC =:= test_heap -> + res_place_gc_instrs(Is, [I,gc|Acc]); + [_|_] -> + res_place_gc_instrs(Is, [I,gc|Acc]) + end; +res_place_gc_instrs([#b_set{op=Op,args=Args}=I|Is], Acc0) -> + case beam_ssa_codegen:classify_heap_need(Op, Args) of + neutral -> + case Acc0 of + [test_heap|Acc] -> + res_place_gc_instrs(Is, [test_heap,I|Acc]); + Acc -> + res_place_gc_instrs(Is, [I|Acc]) + end; + {put,_} -> + case Acc0 of + [test_heap|Acc] -> + res_place_gc_instrs(Is, [test_heap,I|Acc]); + Acc -> + res_place_gc_instrs(Is, [test_heap,I|Acc]) + end; + _ -> + res_place_gc_instrs(Is, [gc,I|Acc0]) + end; +res_place_gc_instrs([], Acc) -> + %% Reverse and replace 'test_heap' markers with 'gc'. + %% (The distinction is no longer useful.) + res_place_gc_instrs_rev(Acc, []). + +res_place_gc_instrs_rev([test_heap|Is], [gc|_]=Acc) -> + res_place_gc_instrs_rev(Is, Acc); +res_place_gc_instrs_rev([test_heap|Is], Acc) -> + res_place_gc_instrs_rev(Is, [gc|Acc]); +res_place_gc_instrs_rev([gc|Is], [gc|_]=Acc) -> + res_place_gc_instrs_rev(Is, Acc); +res_place_gc_instrs_rev([I|Is], Acc) -> + res_place_gc_instrs_rev(Is, [I|Acc]); +res_place_gc_instrs_rev([], Acc) -> Acc. + +res_place_allocate(#{yregs:=_}, Is) -> + %% There will be an 'allocate' instruction inserted here. + Is ++ [gc]; +res_place_allocate(#{}, Is) -> Is. + +reserve_xregs_is([gc|Is], Res, Xs0, Used) -> + %% At this point, the code generator will place an instruction + %% that does a garbage collection. We must prune the remembered + %% registers. + Xs = res_xregs_prune(Xs0, Used, Res), + reserve_xregs_is(Is, Res, Xs, Used); reserve_xregs_is([#b_set{op=Op,dst=Dst,args=Args}=I|Is], Res0, Xs0, Used0) -> - Xs1 = case is_gc_safe(I) of - true -> - Xs0; - false -> - %% There may be a garbage collection after executing this - %% instruction. We will need prune the list of preferred - %% X registers. - res_xregs_prune(Xs0, Used0, Res0) - end, - Res = reserve_xreg(Dst, Xs1, Res0), + Res = reserve_xreg(Dst, Xs0, Res0), Used1 = ordsets:union(Used0, beam_ssa:used(I)), Used = ordsets:del_element(Dst, Used1), case Op of @@ -2099,28 +2185,74 @@ reserve_xregs_is([#b_set{op=Op,dst=Dst,args=Args}=I|Is], Res0, Xs0, Used0) -> Xs = reserve_call_args(tl(Args)), reserve_xregs_is(Is, Res, Xs, Used); _ -> - reserve_xregs_is(Is, Res, Xs1, Used) + reserve_xregs_is(Is, Res, Xs0, Used) end; -reserve_xregs_is([], Res, _Xs, _Used) -> Res. - -reserve_terminator(L, #b_br{bool=#b_literal{val=true},succ=Succ}, Blocks, Res) -> - case maps:get(Succ, Blocks) of +reserve_xregs_is([], Res, Xs, _Used) -> + {Res,Xs}. + +%% Pick up register hints from the successors of this blocks. +reserve_terminator(_L, _Is, #b_br{bool=#b_var{},succ=Succ,fail=?BADARG_BLOCK}, + _Blocks, XsMap, _Res) -> + %% We know that no variables are used at ?BADARG_BLOCK, so + %% any register hints from the success blocks are safe to use. + map_get(Succ, XsMap); +reserve_terminator(L, Is, #b_br{bool=#b_var{},succ=Succ,fail=Fail}, + Blocks, XsMap, Res) when Succ =/= Fail -> + #{Succ:=SuccBlk,Fail:=FailBlk} = Blocks, + case {SuccBlk,FailBlk} of + {#b_blk{is=[],last=#b_br{succ=PhiL,fail=PhiL}}, + #b_blk{is=[],last=#b_br{succ=PhiL,fail=PhiL}}} -> + %% Both branches ultimately transfer to the same + %% block (via two blocks with no instructions). + %% Pick up register hints from the phi nodes + %% in the common block. + #{PhiL:=#b_blk{is=PhiIs}} = Blocks, + Xs = res_xregs_from_phi(PhiIs, Succ, Res, #{}), + res_xregs_from_phi(PhiIs, Fail, Res, Xs); + {_,_} when Is =/= [] -> + case last(Is) of + #b_set{op=succeeded,args=[Arg]} -> + %% We know that Arg will not be used at the failure + %% label, so we can pick up register hints from the + %% success label. + Br = #b_br{bool=#b_literal{val=true},succ=Succ,fail=Succ}, + case reserve_terminator(L, [], Br, Blocks, XsMap, Res) of + #{Arg:=Reg} -> #{Arg=>Reg}; + #{} -> #{} + end; + _ -> + %% Register hints from the success block may not + %% be safe at the failure block, and vice versa. + #{} + end; + {_,_} -> + %% Register hints from the success block may not + %% be safe at the failure block, and vice versa. + #{} + end; +reserve_terminator(L, Is, #b_br{bool=#b_literal{val=true},succ=Succ}, + Blocks, XsMap, Res) -> + case map_get(Succ, Blocks) of #b_blk{is=[],last=Last} -> - reserve_terminator(Succ, Last, Blocks, Res); - #b_blk{is=[_|_]=Is} -> - {res_xregs_from_phi(Is, L, Res, #{}),[]} + reserve_terminator(Succ, Is, Last, Blocks, XsMap, Res); + #b_blk{is=[_|_]=PhiIs} -> + res_xregs_from_phi(PhiIs, L, Res, #{}) end; -reserve_terminator(_, Last, _, _) -> - {#{},beam_ssa:used(Last)}. +reserve_terminator(_, _, _, _, _, _) -> #{}. +%% Pick up a reservation from a phi node. res_xregs_from_phi([#b_set{op=phi,dst=Dst,args=Args}|Is], Pred, Res, Acc) -> case [V || {#b_var{}=V,L} <- Args, L =:= Pred] of [] -> + %% The value of the phi node for this predecessor + %% is a literal. Nothing to do here. res_xregs_from_phi(Is, Pred, Res, Acc); [V] -> case Res of #{Dst:={prefer,Reg}} -> + %% Try placing V in the same register as for + %% the phi node. res_xregs_from_phi(Is, Pred, Res, Acc#{V=>Reg}); #{Dst:=_} -> res_xregs_from_phi(Is, Pred, Res, Acc) @@ -2140,12 +2272,12 @@ reserve_call_args([], _, Xs) -> Xs. reserve_xreg(V, Xs, Res) -> case Res of #{V:=_} -> - %% Already reserved. + %% Already reserved (but not as an X register). Res; #{} -> case Xs of #{V:=X} -> - %% Add a hint that a specific X register is + %% Add a hint that this specific X register is %% preferred, unless it is already in use. Res#{V=>{prefer,X}}; #{} -> @@ -2154,23 +2286,15 @@ reserve_xreg(V, Xs, Res) -> end end. -is_gc_safe(#b_set{op=phi}) -> - false; -is_gc_safe(#b_set{op=Op,args=Args}) -> - case beam_ssa_codegen:classify_heap_need(Op, Args) of - neutral -> true; - {put,_} -> true; - _ -> false - end. - %% res_xregs_prune(PreferredRegs, Used, Res) -> PreferredRegs. -%% Prune the list of preferred to only include X registers that -%% are guaranteed to survice a garbage collection. +%% Prune the list of preferred registers, to make sure that +%% there are no "holes" (uninitialized X registers) when +%% invoking the garbage collector. -res_xregs_prune(Xs, Used, Res) -> +res_xregs_prune(Xs, Used, Res) when map_size(Xs) =/= 0 -> %% The number of safe registers is the number of the X registers %% used after this point. The actual number of safe registers may - %% be highter than this number, but this is a conservative safe + %% be higher than this number, but this is a conservative safe %% estimate. NumSafe = foldl(fun(V, N) -> case Res of @@ -2182,7 +2306,8 @@ res_xregs_prune(Xs, Used, Res) -> %% Remove unsafe registers from the list of potential %% preferred registers. - maps:filter(fun(_, {x,X}) -> X < NumSafe end, Xs). + maps:filter(fun(_, {x,X}) -> X < NumSafe end, Xs); +res_xregs_prune(Xs, _Used, _Res) -> Xs. %%% %%% Register allocation using linear scan. @@ -2488,7 +2613,7 @@ rel2fam(S0) -> sofs:to_external(S). split_phis(Is) -> - partition(fun(#b_set{op=Op}) -> Op =:= phi end, Is). + splitwith(fun(#b_set{op=Op}) -> Op =:= phi end, Is). is_yreg({y,_}) -> true; is_yreg({x,_}) -> false; diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl index 95fc3bb0e9..8bd6772ac5 100644 --- a/lib/compiler/src/beam_ssa_type.erl +++ b/lib/compiler/src/beam_ssa_type.erl @@ -19,19 +19,22 @@ %% -module(beam_ssa_type). --export([opt/2]). +-export([opt_start/4, opt_continue/4, opt_finish/3]). --include("beam_ssa.hrl"). +-include("beam_ssa_opt.hrl"). -import(lists, [all/2,any/2,droplast/1,foldl/3,last/1,member/2, - reverse/1,sort/1]). + partition/2,reverse/1,sort/1]). -define(UNICODE_INT, #t_integer{elements={0,16#10FFFF}}). --record(d, {ds :: #{beam_ssa:b_var():=beam_ssa:b_set()}, - ls :: #{beam_ssa:label():=type_db()}, - once :: cerl_sets:set(beam_ssa:b_var()), - sub :: #{beam_ssa:b_var():=beam_ssa:value()} - }). +-record(d, + {ds :: #{beam_ssa:b_var():=beam_ssa:b_set()}, + ls :: #{beam_ssa:label():=type_db()}, + once :: cerl_sets:set(beam_ssa:b_var()), + func_id :: func_id(), + func_db :: func_info_db(), + sub = #{} :: #{beam_ssa:b_var():=beam_ssa:value()}, + ret_type = [] :: [type()]}). -define(ATOM_SET_SIZE, 5). @@ -49,36 +52,155 @@ {'binary',pos_integer()} | 'cons' | 'float' | 'list' | 'map' | 'nil' |'number'. -type type_db() :: #{beam_ssa:var_name():=type()}. --spec opt([{Label0,Block0}], Args) -> [{Label,Block}] when - Label0 :: beam_ssa:label(), - Block0 :: beam_ssa:b_blk(), +-spec opt_start(Linear, Args, Anno, FuncDb) -> {Linear, FuncDb} when + Linear :: [{non_neg_integer(), beam_ssa:b_blk()}], Args :: [beam_ssa:b_var()], - Label :: beam_ssa:label(), - Block :: beam_ssa:b_blk(). - -opt(Linear, Args) -> - UsedOnce = used_once(Linear, Args), + Anno :: beam_ssa:anno(), + FuncDb :: func_info_db(). +opt_start(Linear, Args, Anno, FuncDb) -> + %% This is the first run through the module, so our arg_types can be + %% incomplete as we may not have visited all call sites at least once. Ts = maps:from_list([{V,any} || #b_var{}=V <- Args]), + opt_continue_1(Linear, Args, get_func_id(Anno), Ts, FuncDb). + +-spec opt_continue(Linear, Args, Anno, FuncDb) -> {Linear, FuncDb} when + Linear :: [{non_neg_integer(), beam_ssa:b_blk()}], + Args :: [beam_ssa:b_var()], + Anno :: beam_ssa:anno(), + FuncDb :: func_info_db(). +opt_continue(Linear, Args, Anno, FuncDb) -> + Id = get_func_id(Anno), + case FuncDb of + #{ Id := #func_info{exported=false,arg_types=ArgTypes} } -> + %% This is a local function and we're guaranteed to have visited + %% every call site at least once, so we know that the parameter + %% types are at least as narrow as the join of all argument types. + Ts = join_arg_types(Args, ArgTypes, Anno), + opt_continue_1(Linear, Args, Id, Ts, FuncDb); + #{} -> + %% We can't infer the parameter types of exported functions, nor + %% the ones where module-level optimization is disabled, but + %% running the pass again could still help other functions. + Ts = maps:from_list([{V,any} || #b_var{}=V <- Args]), + opt_continue_1(Linear, Args, Id, Ts, FuncDb) + end. + +join_arg_types(Args, ArgTypes, Anno) -> + %% We suppress type optimization for parameters that have already been + %% optimized by another pass, as they may have done things we have no idea + %% how to interpret and running them over could generate incorrect code. + ParamTypes = maps:get(parameter_type_info, Anno, #{}), + Ts0 = join_arg_types_1(Args, ArgTypes, #{}), + maps:fold(fun(Arg, _V, Ts) -> + maps:put(Arg, any, Ts) + end, Ts0, ParamTypes). + +join_arg_types_1([Arg | Args], [TM | TMs], Ts) when map_size(TM) =/= 0 -> + join_arg_types_1(Args, TMs, Ts#{ Arg => join(maps:values(TM))}); +join_arg_types_1([Arg | Args], [_TM | TMs], Ts) -> + join_arg_types_1(Args, TMs, Ts#{ Arg => any }); +join_arg_types_1([], [], Ts) -> + Ts. + +-spec opt_continue_1(Linear, Args, Id, Ts, FuncDb) -> Result when + Linear :: [{non_neg_integer(), beam_ssa:b_blk()}], + Args :: [beam_ssa:b_var()], + Id :: func_id(), + Ts :: type_db(), + FuncDb :: func_info_db(), + Result :: {Linear, FuncDb}. +opt_continue_1(Linear0, Args, Id, Ts, FuncDb0) -> + UsedOnce = used_once(Linear0, Args), FakeCall = #b_set{op=call,args=[#b_remote{mod=#b_literal{val=unknown}, name=#b_literal{val=unknown}, arity=0}]}, Defs = maps:from_list([{Var,FakeCall#b_set{dst=Var}} || #b_var{}=Var <- Args]), - D = #d{ds=Defs,ls=#{0=>Ts,?BADARG_BLOCK=>#{}}, - once=UsedOnce,sub=#{}}, - opt_1(Linear, D). -opt_1([{L,Blk}|Bs], #d{ls=Ls}=D) -> + D = #d{ func_db=FuncDb0, + func_id=Id, + ds=Defs, + ls=#{0=>Ts,?BADARG_BLOCK=>#{}}, + once=UsedOnce }, + + {Linear, FuncDb, NewRet} = opt_1(Linear0, D, []), + + case FuncDb of + #{ Id := Entry0 } -> + Entry = Entry0#func_info{ret_type=NewRet}, + {Linear, FuncDb#{ Id := Entry }}; + #{} -> + %% Module-level optimizations have been turned off for this + %% function. + {Linear, FuncDb} + end. + +-spec opt_finish(Args, Anno, FuncDb) -> {Anno, FuncDb} when + Args :: [beam_ssa:b_var()], + Anno :: beam_ssa:anno(), + FuncDb :: func_info_db(). +opt_finish(Args, Anno, FuncDb) -> + Id = get_func_id(Anno), + case FuncDb of + #{ Id := #func_info{exported=false,arg_types=ArgTypes} } -> + ParamInfo0 = maps:get(parameter_type_info, Anno, #{}), + ParamInfo = opt_finish_1(Args, ArgTypes, ParamInfo0), + {Anno#{ parameter_type_info => ParamInfo }, FuncDb}; + #{} -> + {Anno, FuncDb} + end. + +opt_finish_1([Arg | Args], [TypeMap | TypeMaps], ParamInfo) + when is_map_key(Arg, ParamInfo); %% See join_arg_types/3 + map_size(TypeMap) =:= 0 -> + opt_finish_1(Args, TypeMaps, ParamInfo); +opt_finish_1([Arg | Args], [TypeMap | TypeMaps], ParamInfo0) -> + case join(maps:values(TypeMap)) of + any -> + opt_finish_1(Args, TypeMaps, ParamInfo0); + JoinedType -> + JoinedType = verified_type(JoinedType), + ParamInfo = ParamInfo0#{ Arg => validator_anno(JoinedType) }, + opt_finish_1(Args, TypeMaps, ParamInfo) + end; +opt_finish_1([], [], ParamInfo) -> + ParamInfo. + +validator_anno(#t_tuple{size=Size,exact=Exact}) -> + beam_validator:type_anno(tuple, Size, Exact); +validator_anno(#t_integer{elements={Same,Same}}) -> + beam_validator:type_anno(integer, Same); +validator_anno(#t_integer{}) -> + beam_validator:type_anno(integer); +validator_anno(float) -> + beam_validator:type_anno(float); +validator_anno(#t_atom{elements=[Val]}) -> + beam_validator:type_anno(atom, Val); +validator_anno(#t_atom{}=A) -> + case t_is_boolean(A) of + true -> beam_validator:type_anno(bool); + false -> beam_validator:type_anno(atom) + end; +validator_anno(T) -> + beam_validator:type_anno(T). + +get_func_id(Anno) -> + #{func_info:={_Mod, Name, Arity}} = Anno, + #b_local{name=#b_literal{val=Name}, arity=Arity}. + +opt_1([{L,Blk}|Bs], #d{ls=Ls}=D, Acc) -> case Ls of #{L:=Ts} -> - opt_2(L, Blk, Bs, Ts, D); + opt_2(L, Blk, Bs, Ts, D, Acc); #{} -> %% This block is never reached. Discard it. - opt_1(Bs, D) + opt_1(Bs, D, Acc) end; -opt_1([], #d{}) -> []. +opt_1([], D, Acc) -> + #d{func_db=FuncDb,ret_type=NewRet} = D, + {reverse(Acc), FuncDb, NewRet}. -opt_2(L, #b_blk{is=Is0}=Blk0, Bs, Ts, #d{sub=Sub}=D0) -> +opt_2(L, #b_blk{is=Is0}=Blk0, Bs, Ts, #d{sub=Sub}=D0, Acc) -> case Is0 of [#b_set{op=call,dst=Dst, args=[#b_remote{mod=#b_literal{val=Mod}, @@ -94,34 +216,43 @@ opt_2(L, #b_blk{is=Is0}=Blk0, Bs, Ts, #d{sub=Sub}=D0) -> Ret = #b_ret{arg=Dst}, Blk = Blk0#b_blk{is=[I],last=Ret}, Ls = maps:remove(L, D0#d.ls), - D = D0#d{ls=Ls}, - [{L,Blk}|opt_1(Bs, D)]; + + %% We potentially lack a return value. + RetType = join([none | D0#d.ret_type]), + + D = D0#d{ls=Ls,ret_type=[RetType]}, + opt_1(Bs, D, [{L,Blk} | Acc]); false -> - opt_3(L, Blk0, Bs, Ts, D0) + opt_3(L, Blk0, Bs, Ts, D0, Acc) end; _ -> - opt_3(L, Blk0, Bs, Ts, D0) + opt_3(L, Blk0, Bs, Ts, D0, Acc) end. opt_3(L, #b_blk{is=Is0,last=Last0}=Blk0, Bs, Ts0, - #d{ds=Ds0,ls=Ls0,sub=Sub0}=D0) -> - {Is,Ts,Ds,Sub} = opt_is(Is0, Ts0, Ds0, Ls0, Sub0, []), - D1 = D0#d{ds=Ds,sub=Sub}, - Last1 = simplify_terminator(Last0, Sub, Ts), + #d{ds=Ds0,ls=Ls0,sub=Sub0,func_db=Fdb0}=D0, Acc) -> + {Is,Ts,Ds,Fdb,Sub} = opt_is(Is0, Ts0, Ds0, Fdb0, Ls0, D0, Sub0, []), + D1 = D0#d{ds=Ds,sub=Sub,func_db=Fdb}, + Last1 = simplify_terminator(Last0, Sub, Ts, Ds), Last = opt_terminator(Last1, Ts, Ds), D = update_successors(Last, Ts, D1), Blk = Blk0#b_blk{is=Is,last=Last}, - [{L,Blk}|opt_1(Bs, D)]. + opt_1(Bs, D, [{L,Blk} | Acc]). -simplify_terminator(#b_br{bool=Bool}=Br, Sub, Ts) -> +simplify_terminator(#b_br{bool=Bool}=Br, Sub, Ts, _Ds) -> Br#b_br{bool=simplify_arg(Bool, Sub, Ts)}; -simplify_terminator(#b_switch{arg=Arg}=Sw, Sub, Ts) -> +simplify_terminator(#b_switch{arg=Arg}=Sw, Sub, Ts, _Ds) -> Sw#b_switch{arg=simplify_arg(Arg, Sub, Ts)}; -simplify_terminator(#b_ret{arg=Arg}=Ret, Sub, Ts) -> - Ret#b_ret{arg=simplify_arg(Arg, Sub, Ts)}. +simplify_terminator(#b_ret{arg=Arg}=Ret, Sub, Ts, Ds) -> + %% Reducing the result of a call to a literal (fairly common for 'ok') + %% breaks tail call optimization. + case Ds of + #{ Arg := #b_set{op=call}} -> Ret; + #{} -> Ret#b_ret{arg=simplify_arg(Arg, Sub, Ts)} + end. opt_is([#b_set{op=phi,dst=Dst,args=Args0}=I0|Is], - Ts0, Ds0, Ls, Sub0, Acc) -> + Ts0, Ds0, Fdb, Ls, D, Sub0, Acc) -> %% Simplify the phi node by removing all predecessor blocks that no %% longer exists or no longer branches to this block. Args = [{simplify_arg(Arg, Sub0, Ts0),From} || @@ -132,15 +263,61 @@ opt_is([#b_set{op=phi,dst=Dst,args=Args0}=I0|Is], %% value or if the values are identical. [{Val,_}|_] = Args, Sub = Sub0#{Dst=>Val}, - opt_is(Is, Ts0, Ds0, Ls, Sub, Acc); + opt_is(Is, Ts0, Ds0, Fdb, Ls, D, Sub, Acc); false -> I = I0#b_set{args=Args}, Ts = update_types(I, Ts0, Ds0), Ds = Ds0#{Dst=>I}, - opt_is(Is, Ts, Ds, Ls, Sub0, [I|Acc]) + opt_is(Is, Ts, Ds, Fdb, Ls, D, Sub0, [I|Acc]) + end; +opt_is([#b_set{op=call,args=Args0,dst=Dst}=I0 | Is], + Ts0, Ds0, Fdb0, Ls, D, Sub, Acc) -> + Args = simplify_args(Args0, Sub, Ts0), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + + %% This is a bit of a kludge; we know that any instruction whose return + %% type is 'none' will fail at runtime, but we don't yet have a way to cut + %% a block short so we move on like nothing nothing happened. + %% + %% This complicates argument type optimization as unreachable calls can + %% add types that will never occur, so we skip optimizing this call if + %% the type of any of its arguments is 'none'. + [_Callee | Rest] = Args, + case all(fun(Arg) -> get_type(Arg, Ts0) =/= none end, Rest) of + true -> + {Ts, Ds, Fdb, I} = opt_call(I1, D, Ts0, Ds0, Fdb0), + opt_is(Is, Ts, Ds, Fdb, Ls, D, Sub, [I|Acc]); + false -> + Ts = Ts0#{ Dst => any }, + Ds = Ds0#{ Dst => I1 }, + opt_is(Is, Ts, Ds, Fdb0, Ls, D, Sub, [I1|Acc]) + end; +opt_is([#b_set{op=succeeded,args=[Arg],dst=Dst}=I], + Ts0, Ds0, Fdb, Ls, D, Sub0, Acc) -> + case Ds0 of + #{ Arg := #b_set{op=call} } -> + %% The success check of a call is part of exception handling and + %% must not be optimized away. We still have to update its type + %% though. + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{Dst=>I}, + + opt_is([], Ts, Ds, Fdb, Ls, D, Sub0, [I|Acc]); + #{} -> + Args = simplify_args([Arg], Sub0, Ts0), + Type = type(succeeded, Args, Ts0, Ds0), + case get_literal_from_type(Type) of + #b_literal{}=Lit -> + Sub = Sub0#{Dst=>Lit}, + opt_is([], Ts0, Ds0, Fdb, Ls, D, Sub, Acc); + none -> + Ts = Ts0#{Dst=>Type}, + Ds = Ds0#{Dst=>I}, + opt_is([], Ts, Ds, Fdb, Ls, D, Sub0, [I|Acc]) + end end; opt_is([#b_set{args=Args0,dst=Dst}=I0|Is], - Ts0, Ds0, Ls, Sub0, Acc) -> + Ts0, Ds0, Fdb, Ls, D, Sub0, Acc) -> Args = simplify_args(Args0, Sub0, Ts0), I1 = beam_ssa:normalize(I0#b_set{args=Args}), case simplify(I1, Ts0) of @@ -148,16 +325,76 @@ opt_is([#b_set{args=Args0,dst=Dst}=I0|Is], I = beam_ssa:normalize(I2), Ts = update_types(I, Ts0, Ds0), Ds = Ds0#{Dst=>I}, - opt_is(Is, Ts, Ds, Ls, Sub0, [I|Acc]); + opt_is(Is, Ts, Ds, Fdb, Ls, D, Sub0, [I|Acc]); #b_literal{}=Lit -> Sub = Sub0#{Dst=>Lit}, - opt_is(Is, Ts0, Ds0, Ls, Sub, Acc); + opt_is(Is, Ts0, Ds0, Fdb, Ls, D, Sub, Acc); #b_var{}=Var -> - Sub = Sub0#{Dst=>Var}, - opt_is(Is, Ts0, Ds0, Ls, Sub, Acc) + case Is of + [#b_set{op=succeeded,dst=SuccDst,args=[Dst]}] -> + %% We must remove this 'succeeded' instruction. + Sub = Sub0#{Dst=>Var,SuccDst=>#b_literal{val=true}}, + opt_is([], Ts0, Ds0, Fdb, Ls, D, Sub, Acc); + _ -> + Sub = Sub0#{Dst=>Var}, + opt_is(Is, Ts0, Ds0, Fdb, Ls, D, Sub, Acc) + end end; -opt_is([], Ts, Ds, _Ls, Sub, Acc) -> - {reverse(Acc),Ts,Ds,Sub}. +opt_is([], Ts, Ds, Fdb, _Ls, _D, Sub, Acc) -> + {reverse(Acc), Ts, Ds, Fdb, Sub}. + +opt_call(#b_set{dst=Dst,args=[#b_local{}=Callee|Args]}=I0, D, Ts0, Ds0, Fdb0) -> + {Ts, Ds, I} = opt_local_call(I0, Ts0, Ds0, Fdb0), + case Fdb0 of + #{ Callee := #func_info{exported=false,arg_types=ArgTypes0}=Info } -> + %% Update the argument types of *this exact call*, the types + %% will be joined later when the callee is optimized. + CallId = {D#d.func_id, Dst}, + ArgTypes = update_arg_types(Args, ArgTypes0, CallId, Ts0), + + Fdb = Fdb0#{ Callee => Info#func_info{arg_types=ArgTypes} }, + {Ts, Ds, Fdb, I}; + #{} -> + %% We can't narrow the argument types of exported functions as they + %% can receive anything as part of an external call. + {Ts, Ds, Fdb0, I} + end; +opt_call(#b_set{dst=Dst}=I, _D, Ts0, Ds0, Fdb) -> + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{ Dst => I }, + {Ts, Ds, Fdb, I}. + +opt_local_call(#b_set{dst=Dst,args=[Id|_]}=I0, Ts0, Ds0, Fdb) -> + %% We skip propagating 'none' as we don't yet have a good way to cut a + %% block short. + Type = case Fdb of + #{ Id := #func_info{ret_type=[T]} } when T =/= none -> T; + #{} -> any + end, + I = case Type of + any -> I0; + _ -> beam_ssa:add_anno(result_type, validator_anno(Type), I0) + end, + Ts = Ts0#{ Dst => Type }, + Ds = Ds0#{ Dst => I }, + {Ts, Ds, I}. + +update_arg_types([Arg | Args], [TypeMap0 | TypeMaps], CallId, Ts) -> + %% Match contexts are treated as bitstrings when optimizing arguments, as + %% we don't yet support removing the "bs_start_match3" instruction. + NewType = case get_type(Arg, Ts) of + #t_bs_match{} -> {binary, 1}; + Type -> Type + end, + PrevType = maps:get(CallId, TypeMap0, NewType), + + %% The new type must be narrower than the old one. + true = meet(NewType, PrevType) =/= none, %Assertion. + + TypeMap = TypeMap0#{ CallId => NewType }, + [TypeMap | update_arg_types(Args, TypeMaps, CallId, Ts)]; +update_arg_types([], [], _CallId, _Ts) -> + []. simplify(#b_set{op={bif,'and'},args=Args}=I, Ts) -> case is_safe_bool_op(Args, Ts) of @@ -289,7 +526,7 @@ simplify(#b_set{op=put_tuple,args=Args}=I, _Ts) -> none -> I; List -> #b_literal{val=list_to_tuple(List)} end; -simplify(#b_set{op=succeeded,args=[#b_literal{}]}, _Ts) -> +simplify(#b_set{op=wait_timeout,args=[#b_literal{val=0}]}, _Ts) -> #b_literal{val=true}; simplify(#b_set{op=wait_timeout,args=[#b_literal{val=infinity}]}=I, _Ts) -> I#b_set{op=wait,args=[]}; @@ -436,12 +673,12 @@ update_successors(#b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail}, Ts0, D0) -> %% no need to include the type database passed on to the %% successors of this block. Ts = maps:remove(Bool, Ts0), - D = update_successor(Fail, Ts, D0), - SuccTs = infer_types(Bool, Ts, D0), + {SuccTs,FailTs} = infer_types(Bool, Ts, D0), + D = update_successor(Fail, FailTs, D0), update_successor(Succ, SuccTs, D); false -> - D = update_successor_bool(Bool, false, Fail, Ts0, D0), - SuccTs = infer_types(Bool, Ts0, D0), + {SuccTs,FailTs} = infer_types(Bool, Ts0, D0), + D = update_successor_bool(Bool, false, Fail, FailTs, D0), update_successor_bool(Bool, true, Succ, SuccTs, D) end; update_successors(#b_switch{arg=#b_var{}=V,fail=Fail,list=List}, Ts0, D0) -> @@ -458,14 +695,36 @@ update_successors(#b_switch{arg=#b_var{}=V,fail=Fail,list=List}, Ts0, D0) -> end, foldl(F, D, List); false -> - D = update_successor(Fail, Ts0, D0), + %% V can not be equal to any of the values in List at the fail + %% block. + FailTs = subtract_sw_list(V, List, Ts0), + D = update_successor(Fail, FailTs, D0), F = fun({Val,S}, A) -> T = get_type(Val, Ts0), update_successor(S, Ts0#{V=>T}, A) end, foldl(F, D, List) - end; -update_successors(#b_ret{}, _Ts, D) -> D. + end; +update_successors(#b_ret{arg=Arg}, Ts, D) -> + FuncId = D#d.func_id, + case D#d.ds of + #{ Arg := #b_set{op=call,args=[FuncId | _]} } -> + %% Returning a call to ourselves doesn't affect our own return + %% type. + D; + #{} -> + RetType = join([get_type(Arg, Ts) | D#d.ret_type]), + D#d{ret_type=[RetType]} + end. + +subtract_sw_list(V, List, Ts) -> + Ts#{ V := sub_sw_list_1(get_type(V, Ts), List, Ts) }. + +sub_sw_list_1(Type, [{Val,_}|T], Ts) -> + ValType = get_type(Val, Ts), + sub_sw_list_1(subtract(Type, ValType), T, Ts); +sub_sw_list_1(Type, [], _Ts) -> + Type. update_successor_bool(#b_var{}=Var, BoolValue, S, Ts, D) -> case t_is_boolean(get_type(Var, Ts)) of @@ -542,6 +801,14 @@ type(call, [#b_remote{mod=#b_literal{val=Mod}, {_,_} -> #t_tuple{} end; + {erlang,'++',[List1,List2]} -> + case get_type(List1, Ts) =:= cons orelse + get_type(List2, Ts) =:= cons of + true -> cons; + false -> list + end; + {erlang,'--',[_,_]} -> + list; {math,_,_} -> case is_math_bif(Name, length(Args)) of false -> any; @@ -607,6 +874,8 @@ type(succeeded, [#b_var{}=Src], Ts, Ds) -> #b_set{} -> t_boolean() end; +type(succeeded, [#b_literal{}], _Ts, _Ds) -> + t_atom(true); type(_, _, _, _) -> any. arith_op_type(Args, Ts) -> @@ -803,15 +1072,23 @@ simplify_not(#b_br{bool=#b_var{}=V,succ=Succ,fail=Fail}=Br0, Ts, Ds) -> %%% %%% Calculate the set of variables that are only used once in the -%%% block that they are defined in. That will allow us to discard type -%%% information for variables that will never be referenced by the -%%% successor blocks, potentially improving compilation times. +%%% terminator of the block that defines them. That will allow us to +%%% discard type information for variables that will never be +%%% referenced by the successor blocks, potentially improving +%%% compilation times. %%% used_once(Linear, Args) -> Map0 = used_once_1(reverse(Linear), #{}), Map = maps:without(Args, Map0), - cerl_sets:from_list(maps:keys(Map)). + Used0 = cerl_sets:from_list(maps:keys(Map)), + Used1 = used_in_terminators(Linear, []), + cerl_sets:intersection(Used0, Used1). + +used_in_terminators([{_,#b_blk{last=Last}}|Bs], Acc) -> + used_in_terminators(Bs, beam_ssa:used(Last) ++ Acc); +used_in_terminators([], Acc) -> + cerl_sets:from_list(Acc). used_once_1([{L,#b_blk{is=Is,last=Last}}|Bs], Uses0) -> Uses = used_once_2([Last|reverse(Is)], L, Uses0), @@ -873,10 +1150,80 @@ get_type(#b_literal{val=Val}, _Ts) -> any end. +%% infer_types(Var, Types, #d{}) -> {SuccTypes,FailTypes} +%% Looking at the expression that defines the variable Var, infer +%% the types for the variables in the arguments. Return the updated +%% type database for the case that the expression evaluates to +%% true, and and for the case that it evaluates to false. +%% +%% Here is an example. The variable being asked about is +%% the variable Bool, which is defined like this: +%% +%% Bool = is_nonempty_list L +%% +%% If 'is_nonempty_list L' evaluates to 'true', L must +%% must be cons. The meet of the previously known type of L and 'cons' +%% will be added to SuccTypes. +%% +%% On the other hand, if 'is_nonempty_list L' evaluates to false, L +%% is not cons and cons can be subtracted from the previously known +%% type for L. For example, if L was known to be 'list', subtracting +%% 'cons' would give 'nil' as the only possible type. The result of the +%% subtraction for L will be added to FailTypes. +%% +%% Here is another example, asking about the variable Bool: +%% +%% Head = bif:hd L +%% Bool = succeeded Head +%% +%% 'succeeded Head' will evaluate to 'true' if the instrution that +%% defined Head succeeded. In this case, it is the 'bif:hd L' +%% instruction, which will succeed if L is 'cons'. Thus, the meet of +%% the previous type for L and 'cons' will be added to SuccTypes. +%% +%% If 'succeeded Head' evaluates to 'false', it means that 'bif:hd L' +%% failed and that L is not 'cons'. 'cons' can be subtracted from the +%% previously known type for L and the result put in FailTypes. + infer_types(#b_var{}=V, Ts, #d{ds=Ds}) -> #{V:=#b_set{op=Op,args=Args}} = Ds, - Types = infer_type(Op, Args, Ds), - meet_types(Types, Ts). + Types0 = infer_type(Op, Args, Ds), + + %% We must be careful with types inferred from '=:='. + %% + %% If we have seen L =:= [a], we know that L is 'cons' if the + %% comparison succeeds. However, if the comparison fails, L could + %% still be 'cons'. Therefore, we must not subtract 'cons' from the + %% previous type of L. + %% + %% However, it is safe to subtract a type inferred from '=:=' if + %% it is single-valued, e.g. if it is [] or the atom 'true'. + EqTypes0 = infer_eq_type(Op, Args, Ts, Ds), + {Types1,EqTypes} = partition(fun({_,T}) -> + is_singleton_type(T) + end, EqTypes0), + + Types = Types1 ++ Types0, + {meet_types(EqTypes++Types, Ts),subtract_types(Types, Ts)}. + +infer_eq_type({bif,'=:='}, [#b_var{}=Src,#b_literal{}=Lit], Ts, Ds) -> + Def = maps:get(Src, Ds), + Type = get_type(Lit, Ts), + [{Src,Type}|infer_tuple_size(Def, Lit) ++ + infer_first_element(Def, Lit)]; +infer_eq_type({bif,'=:='}, [#b_var{}=Arg0,#b_var{}=Arg1], Ts, _Ds) -> + %% As an example, assume that L1 is known to be 'list', and L2 is + %% known to be 'cons'. Then if 'L1 =:= L2' evaluates to 'true', it can + %% be inferred that L1 is 'cons' (the meet of 'cons' and 'list'). + Type0 = get_type(Arg0, Ts), + Type1 = get_type(Arg1, Ts), + Type = meet(Type0, Type1), + [{V,MeetType} || + {V,OrigType,MeetType} <- + [{Arg0,Type0,Type},{Arg1,Type1,Type}], + OrigType =/= MeetType]; +infer_eq_type(_Op, _Args, _Ts, _Ds) -> + []. infer_type({bif,element}, [#b_literal{val=Pos},#b_var{}=Tuple], _Ds) -> if @@ -885,20 +1232,27 @@ infer_type({bif,element}, [#b_literal{val=Pos},#b_var{}=Tuple], _Ds) -> true -> [] end; -infer_type({bif,'=:='}, [#b_var{}=Src,#b_literal{}=Lit], Ds) -> - Def = maps:get(Src, Ds), - Type = get_type(Lit, #{}), - [{Src,Type}|infer_tuple_size(Def, Lit) ++ - infer_first_element(Def, Lit)]; +infer_type({bif,element}, [#b_var{}=Position,#b_var{}=Tuple], _Ds) -> + [{Position,t_integer()},{Tuple,#t_tuple{}}]; infer_type({bif,Bif}, [#b_var{}=Src]=Args, _Ds) -> case inferred_bif_type(Bif, Args) of any -> []; T -> [{Src,T}] end; +infer_type({bif,binary_part}, [#b_var{}=Src,_], _Ds) -> + [{Src,{binary,8}}]; infer_type({bif,is_map_key}, [_,#b_var{}=Src], _Ds) -> [{Src,map}]; infer_type({bif,map_get}, [_,#b_var{}=Src], _Ds) -> [{Src,map}]; +infer_type({bif,Bif}, [_,_]=Args, _Ds) -> + case inferred_bif_type(Bif, Args) of + any -> []; + T -> [{A,T} || #b_var{}=A <- Args] + end; +infer_type({bif,binary_part}, [#b_var{}=Src,Pos,Len], _Ds) -> + [{Src,{binary,8}}| + [{V,t_integer()} || #b_var{}=V <- [Pos,Len]]]; infer_type(bs_start_match, [#b_var{}=Bin], _Ds) -> [{Bin,{binary,1}}]; infer_type(is_nonempty_list, [#b_var{}=Src], _Ds) -> @@ -969,6 +1323,7 @@ inferred_bif_type(is_number, [_]) -> number; inferred_bif_type(is_tuple, [_]) -> #t_tuple{}; inferred_bif_type(abs, [_]) -> number; inferred_bif_type(bit_size, [_]) -> {binary,1}; +inferred_bif_type('bnot', [_]) -> t_integer(); inferred_bif_type(byte_size, [_]) -> {binary,1}; inferred_bif_type(ceil, [_]) -> number; inferred_bif_type(float, [_]) -> number; @@ -976,10 +1331,25 @@ inferred_bif_type(floor, [_]) -> number; inferred_bif_type(hd, [_]) -> cons; inferred_bif_type(length, [_]) -> list; inferred_bif_type(map_size, [_]) -> map; +inferred_bif_type('not', [_]) -> t_boolean(); inferred_bif_type(round, [_]) -> number; inferred_bif_type(trunc, [_]) -> number; inferred_bif_type(tl, [_]) -> cons; inferred_bif_type(tuple_size, [_]) -> #t_tuple{}; +inferred_bif_type('and', [_,_]) -> t_boolean(); +inferred_bif_type('or', [_,_]) -> t_boolean(); +inferred_bif_type('xor', [_,_]) -> t_boolean(); +inferred_bif_type('band', [_,_]) -> t_integer(); +inferred_bif_type('bor', [_,_]) -> t_integer(); +inferred_bif_type('bsl', [_,_]) -> t_integer(); +inferred_bif_type('bsr', [_,_]) -> t_integer(); +inferred_bif_type('bxor', [_,_]) -> t_integer(); +inferred_bif_type('div', [_,_]) -> t_integer(); +inferred_bif_type('rem', [_,_]) -> t_integer(); +inferred_bif_type('+', [_,_]) -> number; +inferred_bif_type('-', [_,_]) -> number; +inferred_bif_type('*', [_,_]) -> number; +inferred_bif_type('/', [_,_]) -> number; inferred_bif_type(_, _) -> any. infer_tuple_size(#b_set{op={bif,tuple_size},args=[#b_var{}=Tuple]}, @@ -1088,6 +1458,9 @@ t_tuple_size(#t_tuple{size=Size,exact=true}) -> t_tuple_size(_) -> none. +is_singleton_type(Type) -> + get_literal_from_type(Type) =/= none. + %% join(Type1, Type2) -> Type %% Return the "join" of Type1 and Type2. The join is a more general %% type than Type1 and Type2. For example: @@ -1152,14 +1525,40 @@ gcd(A, B) -> meet_types([{V,T0}|Vs], Ts) -> #{V:=T1} = Ts, - T = meet(T0, T1), - meet_types(Vs, Ts#{V:=T}); + case meet(T0, T1) of + T1 -> meet_types(Vs, Ts); + T -> meet_types(Vs, Ts#{V:=T}) + end; meet_types([], Ts) -> Ts. meet([T1,T2|Ts]) -> meet([meet(T1, T2)|Ts]); meet([T]) -> T. +subtract_types([{V,T0}|Vs], Ts) -> + #{V:=T1} = Ts, + case subtract(T1, T0) of + T1 -> subtract_types(Vs, Ts); + T -> subtract_types(Vs, Ts#{V:=T}) + end; +subtract_types([], Ts) -> Ts. + +%% subtract(Type1, Type2) -> Type. +%% Subtract Type2 from Type1. Example: +%% +%% subtract(list, cons) -> nil + +subtract(#t_atom{elements=[_|_]=Set0}, #t_atom{elements=[_|_]=Set1}) -> + case ordsets:subtract(Set0, Set1) of + [] -> none; + [_|_]=Set -> #t_atom{elements=Set} + end; +subtract(number, float) -> #t_integer{}; +subtract(number, #t_integer{elements=any}) -> float; +subtract(list, cons) -> nil; +subtract(list, nil) -> cons; +subtract(T, _) -> T. + %% meet(Type1, Type2) -> Type %% Return the "meet" of Type1 and Type2. The meet is a narrower %% type than Type1 and Type2. For example: diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index 51ff580a7a..acf3838da4 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -200,6 +200,8 @@ create_map(Trim, Moves) -> (Any) -> Any end. +remap([{'%',_}=I|Is], Map, Acc) -> + remap(Is, Map, [I|Acc]); remap([{block,Bl0}|Is], Map, Acc) -> Bl = remap_block(Bl0, Map, []), remap(Is, Map, [{block,Bl}|Acc]); @@ -279,6 +281,8 @@ safe_labels([_|Is], Acc) -> safe_labels(Is, Acc); safe_labels([], Acc) -> cerl_sets:from_list(Acc). +is_safe_label([{'%',_}|Is]) -> + is_safe_label(Is); is_safe_label([{line,_}|Is]) -> is_safe_label(Is); is_safe_label([{badmatch,{Tag,_}}|_]) -> @@ -337,6 +341,8 @@ frame_layout_2(Is) -> reverse(Is). %% to safe labels (i.e., the code at those labels don't depend %% on the contents of any Y register). +frame_size([{'%',_}|Is], Safe) -> + frame_size(Is, Safe); frame_size([{block,_}|Is], Safe) -> frame_size(Is, Safe); frame_size([{call_fun,_}|Is], Safe) -> @@ -393,6 +399,8 @@ frame_size_branch(L, Is, Safe) -> %% This function handles the same instructions as frame_size/2. It %% assumes that any labels in the instructions are safe labels. +is_not_used(Y, [{'%',_}|Is]) -> + is_not_used(Y, Is); is_not_used(Y, [{apply,_}|Is]) -> is_not_used(Y, Is); is_not_used(Y, [{bif,_,{f,_},Ss,Dst}|Is]) -> diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 1945faba7f..b56d53d4ce 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -26,6 +26,7 @@ %% Interface for compiler. -export([module/2, format_error/1]). +-export([type_anno/1, type_anno/2, type_anno/3]). -import(lists, [any/2,dropwhile/2,foldl/3,map/2,foreach/2,reverse/1]). @@ -44,6 +45,33 @@ module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts) {error,[{atom_to_list(Mod),Es}]} end. +%% Provides a stable interface for type annotations, used by certain passes to +%% indicate that we can safely assume that a register has a given type. +-spec type_anno(term()) -> term(). +type_anno(atom) -> {atom,[]}; +type_anno(bool) -> bool; +type_anno({binary,_}) -> term; +type_anno(cons) -> cons; +type_anno(float) -> {float,[]}; +type_anno(integer) -> {integer,[]}; +type_anno(list) -> list; +type_anno(map) -> map; +type_anno(match_context) -> match_context; +type_anno(number) -> number; +type_anno(nil) -> nil. + +-spec type_anno(term(), term()) -> term(). +type_anno(atom, Value) -> {atom, Value}; +type_anno(float, Value) -> {float, Value}; +type_anno(integer, Value) -> {integer, Value}. + +-spec type_anno(term(), term(), term()) -> term(). +type_anno(tuple, Size, Exact) when is_integer(Size) -> + case Exact of + true -> {tuple, Size}; + false -> {tuple, [Size]} + end. + -spec format_error(term()) -> iolist(). format_error({{_M,F,A},{I,Off,limit}}) -> @@ -93,28 +121,6 @@ validate(Module, Fs) -> Ft = index_parameter_types(Fs, []), validate_0(Module, Fs, Ft). -index_parameter_types([{function,_,_,Entry,Code0}|Fs], Acc0) -> - Code = dropwhile(fun({label,L}) when L =:= Entry -> false; - (_) -> true - end, Code0), - case Code of - [{label,Entry}|Is] -> - Acc = index_parameter_types_1(Is, Entry, Acc0), - index_parameter_types(Fs, Acc); - _ -> - %% Something serious is wrong. Ignore it for now. - %% It will be detected and diagnosed later. - index_parameter_types(Fs, Acc0) - end; -index_parameter_types([], Acc) -> - gb_trees:from_orddict(lists:sort(Acc)). - -index_parameter_types_1([{'%', {type_info, Reg, Type}} | Is], Entry, Acc) -> - Key = {Entry, Reg}, - index_parameter_types_1(Is, Entry, [{Key, Type} | Acc]); -index_parameter_types_1(_, _, Acc) -> - Acc. - validate_0(_Module, [], _) -> []; validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> try validate_1(Code, Name, Ar, Entry, Ft) of @@ -167,6 +173,32 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> slots=0 :: non_neg_integer() %Number of slots }). +index_parameter_types([{function,_,_,Entry,Code0}|Fs], Acc0) -> + Code = dropwhile(fun({label,L}) when L =:= Entry -> false; + (_) -> true + end, Code0), + case Code of + [{label,Entry}|Is] -> + Acc = index_parameter_types_1(Is, Entry, Acc0), + index_parameter_types(Fs, Acc); + _ -> + %% Something serious is wrong. Ignore it for now. + %% It will be detected and diagnosed later. + index_parameter_types(Fs, Acc0) + end; +index_parameter_types([], Acc) -> + gb_trees:from_orddict(lists:sort(Acc)). + +index_parameter_types_1([{'%', {type_info, Reg, Type0}} | Is], Entry, Acc) -> + Type = case Type0 of + match_context -> #ms{}; + _ -> Type0 + end, + Key = {Entry, Reg}, + index_parameter_types_1(Is, Entry, [{Key, Type} | Acc]); +index_parameter_types_1(_, _, Acc) -> + Acc. + validate_1(Is, Name, Arity, Entry, Ft) -> validate_2(labels(Is), Name, Arity, Entry, Ft). @@ -271,11 +303,11 @@ valfun_1(_I, #vst{current=none}=Vst) -> %% the original R10B compiler thought would return. Vst; valfun_1({badmatch,Src}, Vst) -> - assert_term(Src, Vst), + assert_not_fragile(Src, Vst), verify_y_init(Vst), kill_state(Vst); valfun_1({case_end,Src}, Vst) -> - assert_term(Src, Vst), + assert_not_fragile(Src, Vst), verify_y_init(Vst), kill_state(Vst); valfun_1(if_end, Vst) -> @@ -283,40 +315,21 @@ valfun_1(if_end, Vst) -> kill_state(Vst); valfun_1({try_case_end,Src}, Vst) -> verify_y_init(Vst), - assert_term(Src, Vst), + assert_not_fragile(Src, Vst), kill_state(Vst); %% Instructions that cannot cause exceptions valfun_1({bs_get_tail,Ctx,Dst,Live}, Vst0) -> + bsm_validate_context(Ctx, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), Vst = prune_x_regs(Live, Vst0), - #vst{current=#st{x=Xs,y=Ys}} = Vst, - {Reg, Tree} = case Ctx of - {x,X} -> {X, Xs}; - {y,Y} -> {Y, Ys}; - _ -> error({bad_source,Ctx}) - end, - Type = case gb_trees:lookup(Reg, Tree) of - {value,#ms{}} -> propagate_fragility(term, [Ctx], Vst); - _ -> error({bad_context,Reg}) - end, - set_type_reg(Type, Dst, Vst); + extract_term(binary, [Ctx], Dst, Vst, Vst0); valfun_1(bs_init_writable=I, Vst) -> call(I, 1, Vst); valfun_1(build_stacktrace=I, Vst) -> call(I, 1, Vst); -valfun_1({move,{y,_}=Src,{y,_}=Dst}, Vst) -> - %% The stack trimming optimization may generate a move from an initialized - %% but unassigned Y register to another Y register. - case get_term_type_1(Src, Vst) of - {catchtag,_} -> error({catchtag,Src}); - {trytag,_} -> error({trytag,Src}); - Type -> set_type_reg(Type, Dst, Vst) - end; -valfun_1({move,Src,Dst}, Vst0) -> - Type = get_move_term_type(Src, Vst0), - Vst = set_type_reg(Type, Dst, Vst0), - set_alias(Src, Dst, Vst); +valfun_1({move,Src,Dst}, Vst) -> + assign(Src, Dst, Vst); valfun_1({fmove,Src,{fr,_}=Dst}, Vst) -> assert_type(float, Src, Vst), set_freg(Dst, Vst); @@ -324,7 +337,7 @@ valfun_1({fmove,{fr,_}=Src,Dst}, Vst0) -> assert_freg_set(Src, Vst0), assert_fls(checked, Vst0), Vst = eat_heap_float(Vst0), - set_type_reg({float,[]}, Dst, Vst); + create_term({float,[]}, Dst, Vst); valfun_1({kill,{y,_}=Reg}, Vst) -> set_type_y(initialized, Reg, Vst); valfun_1({init,{y,_}=Reg}, Vst) -> @@ -346,24 +359,24 @@ valfun_1({bif,Op,{f,_},Src,Dst}=I, Vst) -> end; %% Put instructions. valfun_1({put_list,A,B,Dst}, Vst0) -> - assert_term(A, Vst0), - assert_term(B, Vst0), + assert_not_fragile(A, Vst0), + assert_not_fragile(B, Vst0), Vst = eat_heap(2, Vst0), - set_type_reg(cons, Dst, Vst); + create_term(cons, Dst, Vst); valfun_1({put_tuple2,Dst,{list,Elements}}, Vst0) -> - _ = [assert_term(El, Vst0) || El <- Elements], + _ = [assert_not_fragile(El, Vst0) || El <- Elements], Size = length(Elements), Vst = eat_heap(Size+1, Vst0), Type = {tuple,Size}, - set_type_reg(Type, Dst, Vst); + create_term(Type, Dst, Vst); valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) -> Vst1 = eat_heap(1, Vst0), - Vst = set_type_reg(tuple_in_progress, Dst, Vst1), + Vst = create_term(tuple_in_progress, Dst, Vst1), #vst{current=St0} = Vst, St = St0#st{puts_left={Sz,{Dst,{tuple,Sz}}}}, Vst#vst{current=St}; valfun_1({put,Src}, Vst0) -> - assert_term(Src, Vst0), + assert_not_fragile(Src, Vst0), Vst = eat_heap(1, Vst0), #vst{current=St0} = Vst, case St0 of @@ -371,7 +384,7 @@ valfun_1({put,Src}, Vst0) -> error(not_building_a_tuple); #st{puts_left={1,{Dst,Type}}} -> St = St0#st{puts_left=none}, - set_type_reg(Type, Dst, Vst#vst{current=St}); + create_term(Type, Dst, Vst#vst{current=St}); #st{puts_left={PutsLeft,Info}} when is_integer(PutsLeft) -> St = St0#st{puts_left={PutsLeft-1,Info}}, Vst#vst{current=St} @@ -386,25 +399,13 @@ valfun_1(remove_message, Vst) -> %% The message term is no longer fragile. It can be used %% without restrictions. remove_fragility(Vst); -valfun_1({'%', {type_info, Reg, Info0}}, Vst0) -> +valfun_1({'%', {type_info, Reg, match_context}}, Vst) -> + update_type(fun meet/2, #ms{}, Reg, Vst); +valfun_1({'%', {type_info, Reg, Type}}, Vst) -> %% Explicit type information inserted by optimization passes to indicate %% that Reg has a certain type, so that we can accept cross-function type %% optimizations. - %% - %% At the moment we only allow this when narrowing from 'term' which is - %% what to expect with function parameters, but in theory any narrowing - %% conversion should be legal. - case get_move_term_type(Reg, Vst0) of - term -> - Type0 = case Info0 of - match_context -> #ms{}; - _ -> Info0 - end, - Type = propagate_fragility(Type0, [Reg], Vst0), - set_type_reg(Type, Reg, Vst0); - _ -> - error(bad_type_info) - end; + update_type(fun meet/2, Type, Reg, Vst); valfun_1({'%',_}, Vst) -> Vst; valfun_1({line,_}, Vst) -> @@ -481,20 +482,20 @@ valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) -> valfun_1({get_list,Src,D1,D2}, Vst0) -> assert_not_literal(Src), assert_type(cons, Src, Vst0), - Vst = set_type_reg(term, Src, D1, Vst0), - set_type_reg(term, Src, D2, Vst); + Vst = extract_term(term, [Src], D1, Vst0), + extract_term(term, [Src], D2, Vst); valfun_1({get_hd,Src,Dst}, Vst) -> assert_not_literal(Src), assert_type(cons, Src, Vst), - set_type_reg(term, Src, Dst, Vst); + extract_term(term, [Src], Dst, Vst); valfun_1({get_tl,Src,Dst}, Vst) -> assert_not_literal(Src), assert_type(cons, Src, Vst), - set_type_reg(term, Src, Dst, Vst); + extract_term(term, [Src], Dst, Vst); valfun_1({get_tuple_element,Src,I,Dst}, Vst) -> assert_not_literal(Src), assert_type({tuple_element,I+1}, Src, Vst), - set_type_reg(term, Src, Dst, Vst); + extract_term(term, [Src], Dst, Vst); valfun_1({jump,{f,Lbl}}, Vst) -> kill_state(branch_state(Lbl, Vst)); valfun_1(I, Vst) -> @@ -593,68 +594,59 @@ valfun_4({make_fun2,_,_,_,Live}, Vst) -> call(make_fun, Live, Vst); %% Other BIFs valfun_4({bif,tuple_size,{f,Fail},[Tuple],Dst}=I, Vst0) -> - TupleType0 = get_term_type(Tuple, Vst0), Vst1 = branch_state(Fail, Vst0), - TupleType = upgrade_tuple_type({tuple,[0]}, TupleType0), - Vst = set_aliased_type(TupleType, Tuple, Vst1), + Vst = update_type(fun meet/2, {tuple,[0]}, Tuple, Vst1), set_type_reg_expr({integer,[]}, I, Dst, Vst); valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) -> - TupleType0 = get_term_type(Tuple, Vst0), - PosType = get_term_type(Pos, Vst0), + PosType = get_durable_term_type(Pos, Vst0), Vst1 = branch_state(Fail, Vst0), - TupleType = upgrade_tuple_type({tuple,[get_tuple_size(PosType)]}, TupleType0), - Vst = set_aliased_type(TupleType, Tuple, Vst1), - set_type_reg(term, Tuple, Dst, Vst); + Type = {tuple,[get_tuple_size(PosType)]}, + Vst = update_type(fun meet/2, Type, Tuple, Vst1), + extract_term(term, [Tuple], Dst, Vst); valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) -> validate_src(Src, Vst), kill_state(Vst); valfun_4(raw_raise=I, Vst) -> call(I, 3, Vst); -valfun_4({bif,map_get,{f,Fail},[_Key,Map]=Src,Dst}, Vst0) -> - validate_src(Src, Vst0), +valfun_4({bif,map_get,{f,Fail},[_Key,Map]=Ss,Dst}, Vst0) -> + validate_src(Ss, Vst0), Vst1 = branch_state(Fail, Vst0), - Vst = set_aliased_type(map, Map, Vst1), - Type = propagate_fragility(term, Src, Vst), - set_type_reg(Type, Dst, Vst); -valfun_4({bif,is_map_key,{f,Fail},[_Key,Map]=Src,Dst}, Vst0) -> - validate_src(Src, Vst0), + Vst = update_type(fun meet/2, map, Map, Vst1), + extract_term(term, Ss, Dst, Vst); +valfun_4({bif,is_map_key,{f,Fail},[_Key,Map]=Ss,Dst}, Vst0) -> + validate_src(Ss, Vst0), Vst1 = branch_state(Fail, Vst0), - Vst = set_aliased_type(map, Map, Vst1), - Type = propagate_fragility(bool, Src, Vst), - set_type_reg(Type, Dst, Vst); -valfun_4({bif,Op,{f,Fail},[Cons]=Src,Dst}, Vst0) + Vst = update_type(fun meet/2, map, Map, Vst1), + extract_term(bool, Ss, Dst, Vst); +valfun_4({bif,Op,{f,Fail},[Cons]=Ss,Dst}, Vst0) when Op =:= hd; Op =:= tl -> - validate_src(Src, Vst0), + validate_src(Ss, Vst0), Vst1 = branch_state(Fail, Vst0), - Vst = set_aliased_type(cons, Cons, Vst1), - Type0 = bif_type(Op, Src, Vst), - Type = propagate_fragility(Type0, Src, Vst), - set_type_reg(Type, Dst, Vst); -valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) -> - validate_src(Src, Vst0), + Vst = update_type(fun meet/2, cons, Cons, Vst1), + Type = bif_type(Op, Ss, Vst), + extract_term(Type, Ss, Dst, Vst); +valfun_4({bif,Op,{f,Fail},Ss,Dst}, Vst0) -> + validate_src(Ss, Vst0), Vst = branch_state(Fail, Vst0), - Type0 = bif_type(Op, Src, Vst), - Type = propagate_fragility(Type0, Src, Vst), - set_type_reg(Type, Dst, Vst); -valfun_4({gc_bif,Op,{f,Fail},Live,Src,Dst}, #vst{current=St0}=Vst0) -> + Type = bif_type(Op, Ss, Vst), + extract_term(Type, Ss, Dst, Vst); +valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, #vst{current=St0}=Vst0) -> + validate_src(Ss, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), St = kill_heap_allocation(St0), Vst1 = Vst0#vst{current=St}, Vst2 = branch_state(Fail, Vst1), - Vst3 = prune_x_regs(Live, Vst2), - Vst = case Op of - map_size -> - set_type(map, hd(Src), Vst3); - _ -> - Vst3 + Vst3 = case Op of + length -> update_type(fun meet/2, list, hd(Ss), Vst2); + map_size -> update_type(fun meet/2, map, hd(Ss), Vst2); + _ -> Vst2 end, - validate_src(Src, Vst), - Type0 = bif_type(Op, Src, Vst), - Type = propagate_fragility(Type0, Src, Vst), - set_type_reg(Type, Dst, Vst); + Type = bif_type(Op, Ss, Vst3), + Vst = prune_x_regs(Live, Vst3), + extract_term(Type, Ss, Dst, Vst, Vst0); valfun_4(return, #vst{current=#st{numy=none}}=Vst) -> - assert_term({x,0}, Vst), + assert_not_fragile({x,0}, Vst), kill_state(Vst); valfun_4(return, #vst{current=#st{numy=NumY}}) -> error({stack_frame,NumY}); @@ -664,7 +656,7 @@ valfun_4({loop_rec,{f,Fail},Dst}, Vst0) -> %% remove_message/0 is executed. If control transfers %% to the loop_rec_end/1 instruction, no part of %% this term must be stored in a Y register. - set_type_reg({fragile,term}, Dst, Vst); + create_term({fragile,term}, Dst, Vst); valfun_4({wait,_}, Vst) -> verify_y_init(Vst), kill_state(Vst); @@ -680,7 +672,7 @@ valfun_4(timeout, #vst{current=St}=Vst) -> valfun_4(send, Vst) -> call(send, 2, Vst); valfun_4({set_tuple_element,Src,Tuple,I}, Vst) -> - assert_term(Src, Vst), + assert_not_fragile(Src, Vst), assert_type({tuple_element,I+1}, Tuple, Vst), Vst; %% Match instructions. @@ -692,52 +684,15 @@ valfun_4({select_val,Src,{f,Fail},{list,Choices}}, Vst0) -> valfun_4({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) -> assert_type(tuple, Tuple, Vst), assert_arities(Choices), - TupleType = case get_term_type(Tuple, Vst) of - {fragile,TupleType0} -> TupleType0; - TupleType0 -> TupleType0 - end, + TupleType = get_durable_term_type(Tuple, Vst), kill_state(branch_arities(Choices, Tuple, TupleType, branch_state(Fail, Vst))); %% New bit syntax matching instructions. -valfun_4({test,bs_start_match3,{f,Fail},Live,[Src],Dst}, Vst0) -> - %% Match states are always okay as input. - SrcType = get_move_term_type(Src, Vst0), - DstType = propagate_fragility(bsm_match_state(), [Src], Vst0), - verify_live(Live, Vst0), - verify_y_init(Vst0), - Vst1 = prune_x_regs(Live, Vst0), - BranchVst = case SrcType of - #ms{} -> - %% The failure branch will never be taken when Src is a - %% match context. Therefore, the type for Src at the - %% failure label must not be match_context (or we could - %% reject legal code). - set_type_reg(term, Src, Vst1); - _ -> - Vst1 - end, - Vst = branch_state(Fail, BranchVst), - set_type_reg(DstType, Dst, Vst); -valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst0) -> - %% Match states are always okay as input. - SrcType = get_move_term_type(Src, Vst0), - DstType = propagate_fragility(bsm_match_state(Slots), [Src], Vst0), - verify_live(Live, Vst0), - verify_y_init(Vst0), - Vst1 = prune_x_regs(Live, Vst0), - BranchVst = case SrcType of - #ms{} -> - %% The failure branch will never be taken when Src is a - %% match context. Therefore, the type for Src at the - %% failure label must not be match_context (or we could - %% reject legal code). - set_type_reg(term, Src, Vst1); - _ -> - Vst1 - end, - Vst = branch_state(Fail, BranchVst), - set_type_reg(DstType, Dst, Vst); +valfun_4({test,bs_start_match3,{f,Fail},Live,[Src],Dst}, Vst) -> + validate_bs_start_match(Fail, Live, bsm_match_state(), Src, Dst, Vst); +valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst) -> + validate_bs_start_match(Fail, Live, bsm_match_state(Slots), Src, Dst, Vst); valfun_4({test,bs_match_string,{f,Fail},[Ctx,_,_]}, Vst) -> bsm_validate_context(Ctx, Vst), branch_state(Fail, Vst); @@ -779,74 +734,76 @@ valfun_4({bs_get_position, Ctx, Dst, Live}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), Vst = prune_x_regs(Live, Vst0), - set_type_reg(bs_position, Dst, Vst); + create_term(bs_position, Dst, Vst); valfun_4({bs_set_position, Ctx, Pos}, Vst) -> bsm_validate_context(Ctx, Vst), assert_type(bs_position, Pos, Vst), Vst; %% Other test instructions. -valfun_4({test,is_float,{f,Lbl},[Float]}, Vst) -> - assert_term(Float, Vst), - set_type({float,[]}, Float, branch_state(Lbl, Vst)); -valfun_4({test,is_tuple,{f,Lbl},[Tuple]}, Vst) -> - Type0 = get_term_type(Tuple, Vst), - Type = upgrade_tuple_type({tuple,[0]}, Type0), - set_aliased_type(Type, Tuple, branch_state(Lbl, Vst)); -valfun_4({test,is_nonempty_list,{f,Lbl},[Cons]}, Vst) -> - assert_term(Cons, Vst), - Type = cons, - set_aliased_type(Type, Cons, branch_state(Lbl, Vst)); +valfun_4({test,is_atom,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, {atom,[]}, Src, Vst); +valfun_4({test,is_boolean,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, bool, Src, Vst); +valfun_4({test,is_float,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, {float,[]}, Src, Vst); +valfun_4({test,is_tuple,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, {tuple,[0]}, Src, Vst); +valfun_4({test,is_integer,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, {integer,[]}, Src, Vst); +valfun_4({test,is_nonempty_list,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, cons, Src, Vst); +valfun_4({test,is_list,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, list, Src, Vst); +valfun_4({test,is_nil,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, nil, Src, Vst); +valfun_4({test,is_map,{f,Lbl},[Src]}, Vst) -> + case Src of + {Tag,_} when Tag =:= x; Tag =:= y -> + type_test(Lbl, map, Src, Vst); + {literal,Map} when is_map(Map) -> + Vst; + _ -> + assert_term(Src, Vst), + kill_state(Vst) + end; valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) -> assert_type(tuple, Tuple, Vst), - Type = {tuple,Sz}, - set_aliased_type(Type, Tuple, branch_state(Lbl, Vst)); + update_type(fun meet/2, {tuple,Sz}, Tuple, branch_state(Lbl, Vst)); valfun_4({test,is_tagged_tuple,{f,Lbl},[Src,Sz,_Atom]}, Vst) -> - validate_src([Src], Vst), - Type = {tuple,Sz}, - set_aliased_type(Type, Src, branch_state(Lbl, Vst)); + assert_term(Src, Vst), + update_type(fun meet/2, {tuple,Sz}, Src, branch_state(Lbl, Vst)); valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) -> assert_type(map, Src, Vst), assert_unique_map_keys(List), branch_state(Lbl, Vst); -valfun_4({test,is_map,{f,Lbl},[Src]}, Vst0) -> - Vst = branch_state(Lbl, Vst0), - case Src of - {Tag,_} when Tag =:= x; Tag =:= y -> - Type = map, - set_aliased_type(Type, Src, Vst); - {literal,Map} when is_map(Map) -> - Vst0; - _ -> - kill_state(Vst0) - end; valfun_4({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst0) -> validate_src(Ss, Vst0), Infer = infer_types(Src, Vst0), Vst1 = Infer(Val, Vst0), - Vst = branch_state(Lbl, Vst1), - case Val of - {literal,Tuple} when is_tuple(Tuple) -> - Type0 = get_term_type(Val, Vst), - Type = upgrade_tuple_type({tuple,tuple_size(Tuple)}, - Type0), - set_aliased_type(Type, Src, Vst); - _ -> - Vst - end; + Vst2 = update_ne_types(Src, Val, Vst1), + Vst3 = branch_state(Lbl, Vst2), + Vst = Vst3#vst{current=Vst1#vst.current}, + update_eq_types(Src, Val, Vst); +valfun_4({test,is_ne_exact,{f,Lbl},[Src,Val]=Ss}, Vst0) -> + validate_src(Ss, Vst0), + Vst1 = update_eq_types(Src, Val, Vst0), + Vst2 = branch_state(Lbl, Vst1), + Vst = Vst2#vst{current=Vst0#vst.current}, + update_ne_types(Src, Val, Vst); valfun_4({test,_Op,{f,Lbl},Src}, Vst) -> validate_src(Src, Vst), branch_state(Lbl, Vst); valfun_4({bs_add,{f,Fail},[A,B,_],Dst}, Vst) -> - assert_term(A, Vst), - assert_term(B, Vst), - set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); + assert_not_fragile(A, Vst), + assert_not_fragile(B, Vst), + create_term({integer,[]}, Dst, branch_state(Fail, Vst)); valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), - set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); + create_term({integer,[]}, Dst, branch_state(Fail, Vst)); valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), - set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); + create_term({integer,[]}, Dst, branch_state(Fail, Vst)); valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), @@ -854,12 +811,12 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> is_integer(Sz) -> ok; true -> - assert_term(Sz, Vst0) + assert_not_fragile(Sz, Vst0) end, Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), - set_type_reg(binary, Dst, Vst); + create_term(binary, Dst, Vst); valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), @@ -872,43 +829,43 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), - set_type_reg(binary, Dst, Vst); + create_term(binary, Dst, Vst); valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), - assert_term(Bits, Vst0), - assert_term(Bin, Vst0), + assert_not_fragile(Bits, Vst0), + assert_not_fragile(Bin, Vst0), Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), - set_type_reg(binary, Dst, Vst); + create_term(binary, Dst, Vst); valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst0) -> - assert_term(Bits, Vst0), - assert_term(Bin, Vst0), + assert_not_fragile(Bits, Vst0), + assert_not_fragile(Bin, Vst0), Vst = branch_state(Fail, Vst0), - set_type_reg(binary, Dst, Vst); + create_term(binary, Dst, Vst); valfun_4({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> Vst; valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) -> - assert_term(Sz, Vst), - assert_term(Src, Vst), + assert_not_fragile(Sz, Vst), + assert_not_fragile(Src, Vst), branch_state(Fail, Vst); valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}, Vst) -> - assert_term(Sz, Vst), - assert_term(Src, Vst), + assert_not_fragile(Sz, Vst), + assert_not_fragile(Src, Vst), branch_state(Fail, Vst); valfun_4({bs_put_integer,{f,Fail},Sz,_,_,Src}, Vst) -> - assert_term(Sz, Vst), - assert_term(Src, Vst), + assert_not_fragile(Sz, Vst), + assert_not_fragile(Src, Vst), branch_state(Fail, Vst); valfun_4({bs_put_utf8,{f,Fail},_,Src}, Vst) -> - assert_term(Src, Vst), + assert_not_fragile(Src, Vst), branch_state(Fail, Vst); valfun_4({bs_put_utf16,{f,Fail},_,Src}, Vst) -> - assert_term(Src, Vst), + assert_not_fragile(Src, Vst), branch_state(Fail, Vst); valfun_4({bs_put_utf32,{f,Fail},_,Src}, Vst) -> - assert_term(Src, Vst), + assert_not_fragile(Src, Vst), branch_state(Fail, Vst); %% Map instructions. valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> @@ -925,7 +882,7 @@ verify_get_map(Fail, Src, List, Vst0) -> assert_type(map, Src, Vst0), Vst1 = foldl(fun(D, Vsti) -> case is_reg_defined(D,Vsti) of - true -> set_type_reg(term,D,Vsti); + true -> create_term(term, D, Vsti); false -> Vsti end end, Vst0, extract_map_vals(List)), @@ -944,7 +901,7 @@ extract_map_keys([]) -> []. verify_get_map_pair([Src,Dst|Vs], Map, Vst0, Vsti0) -> assert_term(Src, Vst0), - Vsti = set_type_reg(term, Map, Dst, Vsti0), + Vsti = extract_term(term, [Map], Dst, Vsti0), verify_get_map_pair(Vs, Map, Vst0, Vsti); verify_get_map_pair([], _Map, _Vst0, Vst) -> Vst. @@ -952,13 +909,29 @@ verify_put_map(Fail, Src, Dst, Live, List, Vst0) -> assert_type(map, Src, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), - foreach(fun (Term) -> assert_term(Term, Vst0) end, List), + foreach(fun (Term) -> assert_not_fragile(Term, Vst0) end, List), Vst1 = heap_alloc(0, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), Keys = extract_map_keys(List), assert_unique_map_keys(Keys), - set_type_reg(map, Dst, Vst). + create_term(map, Dst, Vst). + +%% +%% Common code for validating bs_start_match* instructions. +%% + +validate_bs_start_match(Fail, Live, Type, Src, Dst, Vst0) -> + verify_live(Live, Vst0), + verify_y_init(Vst0), + + %% #ms{} can represent either a match context or a term, so we have to mark + %% the source as a term if it fails, and retain the incoming type if it + %% succeeds (match context or not). + Vst1 = set_aliased_type(term, Src, Vst0), + Vst2 = prune_x_regs(Live, Vst1), + Vst3 = branch_state(Fail, Vst2), + extract_term(Type, [Src], Dst, Vst3, Vst0). %% %% Common code for validating bs_get* instructions. @@ -969,7 +942,7 @@ validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst0) -> verify_y_init(Vst0), Vst1 = prune_x_regs(Live, Vst0), Vst = branch_state(Fail, Vst1), - set_type_reg(Type, Dst, Vst). + create_term(Type, Dst, Vst). %% %% Common code for validating bs_skip_utf* instructions. @@ -1042,43 +1015,62 @@ verify_call_args(_, Live, _) -> verify_call_args_1(0, _) -> ok; verify_call_args_1(N, Vst) -> X = N - 1, - get_term_type({x,X}, Vst), + assert_not_fragile({x,X}, Vst), verify_call_args_1(X, Vst). verify_local_call(Lbl, Live, Vst) -> - F = fun({R, _Ctx}) -> - verify_call_match_context(Lbl, R, Vst) - end, - MsRegs = all_ms_in_x_regs(Live, Vst), - verify_no_ms_aliases(MsRegs), - foreach(F, MsRegs). + F = fun({R, Type}) -> + verify_arg_type(Lbl, R, Type, Vst) + end, + TRegs = typed_call_regs(Live, Vst), + verify_no_ms_aliases(TRegs), + foreach(F, TRegs). -all_ms_in_x_regs(0, _Vst) -> +typed_call_regs(0, _Vst) -> []; -all_ms_in_x_regs(Live0, Vst) -> +typed_call_regs(Live0, Vst) -> Live = Live0 - 1, R = {x,Live}, - case get_move_term_type(R, Vst) of - #ms{}=M -> [{R,M} | all_ms_in_x_regs(Live, Vst)]; - _ -> all_ms_in_x_regs(Live, Vst) - end. + [{R, get_move_term_type(R, Vst)} | typed_call_regs(Live, Vst)]. %% Verifies that the same match context isn't present twice. -verify_no_ms_aliases(MsRegs) -> - CtxIds = [Id || {_, #ms{id=Id}} <- MsRegs], +verify_no_ms_aliases(Regs) -> + CtxIds = [Id || {_, #ms{id=Id}} <- Regs], UniqueCtxIds = ordsets:from_list(CtxIds), if length(UniqueCtxIds) < length(CtxIds) -> - error({multiple_match_contexts, MsRegs}); + error({multiple_match_contexts, Regs}); length(UniqueCtxIds) =:= length(CtxIds) -> ok end. -%% Verifies that the target label accepts match contexts in the given register. -verify_call_match_context(Lbl, Ctx, #vst{ft=Ft}) -> - case gb_trees:lookup({Lbl, Ctx}, Ft) of - {value, match_context} -> ok; - none -> error(no_bs_start_match2) +%% Verifies that the given argument narrows to what the function expects. +verify_arg_type(Lbl, Reg, #ms{}, #vst{ft=Ft}) -> + %% Match contexts require explicit support, and may not be passed to a + %% function that accepts arbitrary terms. + case gb_trees:lookup({Lbl, Reg}, Ft) of + {value, #ms{}} -> ok; + _ -> error(no_bs_start_match2) + end; +verify_arg_type(Lbl, Reg, GivenType, #vst{ft=Ft}) -> + case gb_trees:lookup({Lbl, Reg}, Ft) of + {value, bool} when GivenType =:= {atom, true}; + GivenType =:= {atom, false}; + GivenType =:= {atom, []} -> + %% We don't yet support upgrading true/false to bool, so we + %% assume unknown atoms can be bools when validating calls. + ok; + {value, #ms{}} -> + %% Functions that accept match contexts also accept all other + %% terms. This will change once we support union types. + ok; + {value, RequiredType} -> + case meet(GivenType, RequiredType) of + none -> error({bad_arg_type, Reg, GivenType, RequiredType}); + _ -> ok + end; + none -> + ok end. allocate(Zero, Stk, Heap, Live, #vst{current=#st{numy=none}}=Vst0) -> @@ -1298,27 +1290,25 @@ bsm_restore(Reg, SavePoint, Vst) -> _ -> error({illegal_restore,SavePoint,range}) end. - select_val_branches(Src, Choices, Vst) -> Infer = infer_types(Src, Vst), - select_val_branches_1(Choices, Infer, Vst). + select_val_branches_1(Choices, Src, Infer, Vst). -select_val_branches_1([Val,{f,L}|T], Infer, Vst0) -> - Vst = branch_state(L, Infer(Val, Vst0)), - select_val_branches_1(T, Infer, Vst); -select_val_branches_1([], _, Vst) -> Vst. +select_val_branches_1([Val,{f,L}|T], Src, Infer, Vst0) -> + Vst1 = set_aliased_type(Val, Src, Infer(Val, Vst0)), + Vst = branch_state(L, Vst1), + select_val_branches_1(T, Src, Infer, Vst); +select_val_branches_1([], _, _, Vst) -> Vst. infer_types(Src, Vst) -> case get_def(Src, Vst) of {bif,is_map,{f,_},[Map],_} -> - fun({atom,true}, S) -> set_type_reg(map, Map, S); + fun({atom,true}, S) -> update_type(fun meet/2, map, Map, S); (_, S) -> S end; {bif,tuple_size,{f,_},[Tuple],_} -> fun({integer,Arity}, S) -> - Type0 = get_term_type(Tuple, S), - Type = upgrade_tuple_type({tuple,Arity}, Type0), - set_type(Type, Tuple, S); + update_type(fun meet/2, {tuple,Arity}, Tuple, S); (_, S) -> S end; {bif,'=:=',{f,_},[ArityReg,{integer,_}=Val],_} when ArityReg =/= Src -> @@ -1335,11 +1325,93 @@ infer_types(Src, Vst) -> %%% Keeping track of types. %%% -set_alias(Reg1, Reg2, #vst{current=St0}=Vst) -> - case Reg1 of +%% Assigns Src to Dst and marks them as aliasing each other. +assign({y,_}=Src, {y,_}=Dst, Vst) -> + %% The stack trimming optimization may generate a move from an initialized + %% but unassigned Y register to another Y register. + case get_term_type_1(Src, Vst) of + initialized -> set_type_reg(initialized, Dst, Vst); + _ -> assign_1(Src, Dst, Vst) + end; +assign({Kind,_}=Reg, Dst, Vst) when Kind =:= x; Kind =:= y -> + assign_1(Reg, Dst, Vst); +assign(Literal, Dst, Vst) -> + create_term(get_term_type(Literal, Vst), Dst, Vst). + +%% Creates a completely new term with the given type. +create_term(Type, Dst, Vst) -> + set_type_reg(Type, Dst, Vst). + +%% Extracts a term from Ss, propagating fragility. +extract_term(Type, Ss, Dst, Vst) -> + extract_term(Type, Ss, Dst, Vst, Vst). + +%% As extract_term/4, but uses the incoming Vst for fragility in case x-regs +%% have been pruned and the sources can no longer be found. +extract_term(Type0, Ss, Dst, Vst, OrigVst) -> + Type = propagate_fragility(Type0, Ss, OrigVst), + set_type_reg(Type, Dst, Vst). + +%% Helper function for simple "is_type" tests. +type_test(Fail, Type, Reg, Vst0) -> + assert_term(Reg, Vst0), + Vst = branch_state(Fail, update_type(fun subtract/2, Type, Reg, Vst0)), + update_type(fun meet/2, Type, Reg, Vst). + +%% This is used when linear code finds out more and more information about a +%% type, so that the type gets more specialized. +update_type(Merge, Type0, Reg, Vst) -> + %% If the old type can't be merged with the new one, the type information + %% is inconsistent and we know that some instructions will never be + %% executed at run-time. For example: + %% + %% {test,is_list,Fail,[Reg]}. + %% {test,is_tuple,Fail,[Reg]}. + %% {test,test_arity,Fail,[Reg,5]}. + %% + %% Note that the test_arity instruction can never be reached, so we use the + %% new type instead of 'none'. + Type = case Merge(get_durable_term_type(Reg, Vst), Type0) of + none -> Type0; + T -> T + end, + set_aliased_type(propagate_fragility(Type, [Reg], Vst), Reg, Vst). + +update_ne_types(LHS, RHS, Vst) -> + T1 = get_durable_term_type(LHS, Vst), + T2 = get_durable_term_type(RHS, Vst), + Type = propagate_fragility(subtract(T1, T2), [LHS], Vst), + set_aliased_type(Type, LHS, Vst). + +update_eq_types(LHS, RHS, Vst0) -> + T1 = get_durable_term_type(LHS, Vst0), + T2 = get_durable_term_type(RHS, Vst0), + Meet = meet(T1, T2), + Vst = case T1 =/= Meet of + true -> + LType = propagate_fragility(Meet, [LHS], Vst0), + set_aliased_type(LType, LHS, Vst0); + false -> + Vst0 + end, + case T2 =/= Meet of + true -> + RType = propagate_fragility(Meet, [RHS], Vst0), + set_aliased_type(RType, RHS, Vst); + false -> + Vst + end. + +%% Helper functions for the above. + +assign_1(Src, Dst, Vst0) -> + Type = get_move_term_type(Src, Vst0), + Vst = set_type_reg(Type, Dst, Vst0), + case Src of {Kind,_} when Kind =:= x; Kind =:= y -> + #vst{current=St0} = Vst, #st{aliases=Aliases0} = St0, - Aliases = Aliases0#{Reg1=>Reg2,Reg2=>Reg1}, + Aliases = Aliases0#{Src=>Dst,Dst=>Src}, St = St0#st{aliases=Aliases}, Vst#vst{current=St}; _ -> @@ -1473,6 +1545,12 @@ assert_term(Src, Vst) -> get_term_type(Src, Vst), ok. +assert_not_fragile(Src, Vst) -> + case get_term_type(Src, Vst) of + {fragile, _} -> error({fragile_message_reference, Src}); + _ -> ok + end. + assert_not_literal({x,_}) -> ok; assert_not_literal({y,_}) -> ok; assert_not_literal(Literal) -> error({literal_not_allowed,Literal}). @@ -1509,12 +1587,16 @@ assert_not_literal(Literal) -> error({literal_not_allowed,Literal}). %% %% term Any valid Erlang (but not of the special types above). %% +%% binary Binary or bitstring. +%% %% bool The atom 'true' or the atom 'false'. %% %% cons Cons cell: [_|_] %% %% nil Empty list: [] %% +%% list List: [] or [_|_] +%% %% {tuple,[Sz]} Tuple. An element has been accessed using %% element/2 or setelement/3 so that it is known that %% the type is a tuple of size at least Sz. @@ -1535,7 +1617,7 @@ assert_not_literal(Literal) -> error({literal_not_allowed,Literal}). %% %% map Map. %% -%% +%% none A conflict in types. There will be an exception at runtime. %% %% FRAGILITY %% --------- @@ -1548,14 +1630,55 @@ assert_not_literal(Literal) -> error({literal_not_allowed,Literal}). %% Such terms are wrapped in a {fragile,Type} tuple, where Type is one %% of the types described above. -assert_type(WantedType, Term, Vst) -> - case get_term_type(Term, Vst) of - {fragile,Type} -> - assert_type(WantedType, Type); - Type -> - assert_type(WantedType, Type) +%% meet(Type1, Type2) -> Type +%% Return the meet of two types. The meet is a more specific type. +%% It will be 'none' if the types are in conflict. + +meet(Same, Same) -> + Same; +meet(term, Other) -> + Other; +meet(Other, term) -> + Other; +meet(T1, T2) -> + case {erlang:min(T1, T2),erlang:max(T1, T2)} of + {{atom,_}=A,{atom,[]}} -> A; + {bool,{atom,B}=Atom} when is_boolean(B) -> Atom; + {bool,{atom,[]}} -> bool; + {cons,list} -> cons; + {{float,_}=T,{float,[]}} -> T; + {{integer,_}=T,{integer,[]}} -> T; + {list,nil} -> nil; + {number,{integer,_}=T} -> T; + {number,{float,_}=T} -> T; + {{tuple,Size1},{tuple,Size2}} -> + case {Size1,Size2} of + {[Sz1],[Sz2]} -> + {tuple,[erlang:max(Sz1, Sz2)]}; + {Sz1,[Sz2]} when Sz2 =< Sz1 -> + {tuple,Sz1}; + {_,_} -> + none + end; + {_,_} -> none end. +%% subtract(Type1, Type2) -> Type +%% Subtract Type2 from Type2. Example: +%% subtract(list, nil) -> cons + +subtract(list, nil) -> cons; +subtract(list, cons) -> nil; +subtract(number, {integer,[]}) -> {float,[]}; +subtract(number, {float,[]}) -> {integer,[]}; +subtract(bool, {atom,false}) -> {atom, true}; +subtract(bool, {atom,true}) -> {atom, false}; +subtract(Type, _) -> Type. + +assert_type(WantedType, Term, Vst) -> + Type = get_durable_term_type(Term, Vst), + assert_type(WantedType, Type). + assert_type(Correct, Correct) -> ok; assert_type(float, {float,_}) -> ok; assert_type(tuple, {tuple,_}) -> ok; @@ -1573,34 +1696,6 @@ assert_type(cons, {literal,[_|_]}) -> assert_type(Needed, Actual) -> error({bad_type,{needed,Needed},{actual,Actual}}). -%% upgrade_tuple_type(NewTupleType, OldType) -> TupleType. -%% upgrade_tuple_type/2 is used when linear code finds out more and -%% more information about a tuple type, so that the type gets more -%% specialized. If OldType is not a tuple type, the type information -%% is inconsistent, and we know that some instructions will never -%% be executed at run-time. - -upgrade_tuple_type(NewType, {fragile,OldType}) -> - make_fragile(upgrade_tuple_type_1(NewType, OldType)); -upgrade_tuple_type(NewType, OldType) -> - upgrade_tuple_type_1(NewType, OldType). - -upgrade_tuple_type_1({tuple,[Sz]}, {tuple,[OldSz]}=T) when Sz < OldSz -> - %% The old type has a higher value for the least tuple size. - T; -upgrade_tuple_type_1({tuple,[Sz]}, {tuple,OldSz}=T) - when is_integer(Sz), is_integer(OldSz), Sz =< OldSz -> - %% The old size is exact, and the new size is smaller than the old size. - T; -upgrade_tuple_type_1({tuple,_}=T, _) -> - %% The new type information is exact or has a higher value for - %% the least tuple size. - %% Note that inconsistencies are also handled in this - %% clause, e.g. if the old type was an integer or a tuple accessed - %% outside its size; inconsistences will generally cause an exception - %% at run-time but are safe from our point of view. - T. - get_tuple_size({integer,[]}) -> 0; get_tuple_size({integer,Sz}) -> Sz; get_tuple_size(_) -> 0. @@ -1608,6 +1703,17 @@ get_tuple_size(_) -> 0. validate_src(Ss, Vst) when is_list(Ss) -> foreach(fun(S) -> get_term_type(S, Vst) end, Ss). +%% get_durable_term_type(Src, ValidatorState) -> Type +%% Get the type of the source Src. The returned type Type will be +%% a standard Erlang type (no catch/try tags or match contexts). +%% Fragility will be stripped. + +get_durable_term_type(Src, Vst) -> + case get_term_type(Src, Vst) of + {fragile,Type} -> Type; + Type -> Type + end. + %% get_move_term_type(Src, ValidatorState) -> Type %% Get the type of the source Src. The returned type Type will be %% a standard Erlang type (no catch/try tags). Match contexts are OK. @@ -1641,6 +1747,8 @@ get_term_type_1(nil=T, _) -> T; get_term_type_1({atom,A}=T, _) when is_atom(A) -> T; get_term_type_1({float,F}=T, _) when is_float(F) -> T; get_term_type_1({integer,I}=T, _) when is_integer(I) -> T; +get_term_type_1({literal,[_|_]}, _) -> cons; +get_term_type_1({literal,Bitstring}, _) when is_bitstring(Bitstring) -> binary; get_term_type_1({literal,Map}, _) when is_map(Map) -> map; get_term_type_1({literal,Tuple}, _) when is_tuple(Tuple) -> {tuple,tuple_size(Tuple)}; @@ -1746,7 +1854,7 @@ merge_regs_1([{R1,_}|Rs1], [{R2,_}|_]=Rs2) when R1 < R2 -> merge_regs_1([{R1,_}|_]=Rs1, [{R2,_}|Rs2]) when R1 > R2 -> merge_regs_1(Rs1, Rs2); merge_regs_1([{R,Type1}|Rs1], [{R,Type2}|Rs2]) -> - [{R,merge_types(Type1, Type2)}|merge_regs_1(Rs1, Rs2)]; + [{R,join(Type1, Type2)}|merge_regs_1(Rs1, Rs2)]; merge_regs_1([], []) -> []; merge_regs_1([], [_|_]) -> []; merge_regs_1([_|_], []) -> []. @@ -1765,63 +1873,90 @@ merge_y_regs_1(Y, S, Regs0) when Y >= 0 -> Type0 -> merge_y_regs_1(Y-1, S, Regs0); Type1 -> - Type = merge_types(Type0, Type1), + Type = join(Type0, Type1), Regs = gb_trees:update(Y, Type, Regs0), merge_y_regs_1(Y-1, S, Regs) end; merge_y_regs_1(_, _, Regs) -> Regs. -%% merge_types(Type1, Type2) -> Type +%% join(Type1, Type2) -> Type %% Return the most specific type possible. %% Note: Type1 must NOT be the same as Type2. -merge_types({fragile,Same}=Type, Same) -> +join({literal,_}=T1, T2) -> + join_literal(T1, T2); +join(T1, {literal,_}=T2) -> + join_literal(T2, T1); +join({fragile,Same}=Type, Same) -> Type; -merge_types({fragile,T1}, T2) -> - make_fragile(merge_types(T1, T2)); -merge_types(Same, {fragile,Same}=Type) -> +join({fragile,T1}, T2) -> + make_fragile(join(T1, T2)); +join(Same, {fragile,Same}=Type) -> Type; -merge_types(T1, {fragile,T2}) -> - make_fragile(merge_types(T1, T2)); -merge_types(uninitialized=I, _) -> I; -merge_types(_, uninitialized=I) -> I; -merge_types(initialized=I, _) -> I; -merge_types(_, initialized=I) -> I; -merge_types({catchtag,T0},{catchtag,T1}) -> +join(T1, {fragile,T2}) -> + make_fragile(join(T1, T2)); +join(uninitialized=I, _) -> I; +join(_, uninitialized=I) -> I; +join(initialized=I, _) -> I; +join(_, initialized=I) -> I; +join({catchtag,T0},{catchtag,T1}) -> {catchtag,ordsets:from_list(T0++T1)}; -merge_types({trytag,T0},{trytag,T1}) -> +join({trytag,T0},{trytag,T1}) -> {trytag,ordsets:from_list(T0++T1)}; -merge_types({tuple,A}, {tuple,B}) -> +join({tuple,A}, {tuple,B}) -> {tuple,[min(tuple_sz(A), tuple_sz(B))]}; -merge_types({Type,A}, {Type,B}) +join({Type,A}, {Type,B}) when Type =:= atom; Type =:= integer; Type =:= float -> if A =:= B -> {Type,A}; true -> {Type,[]} end; -merge_types({Type,_}, number) +join({Type,_}, number) when Type =:= integer; Type =:= float -> number; -merge_types(number, {Type,_}) +join(number, {Type,_}) when Type =:= integer; Type =:= float -> number; -merge_types(bool, {atom,A}) -> +join(bool, {atom,A}) -> merge_bool(A); -merge_types({atom,A}, bool) -> +join({atom,A}, bool) -> merge_bool(A); -merge_types(cons, {literal,[_|_]}) -> - cons; -merge_types({literal,[_|_]}, cons) -> - cons; -merge_types({literal,[_|_]}, {literal,[_|_]}) -> - cons; -merge_types(#ms{id=Id1,valid=B1,slots=Slots1}, +join({atom,_}, {atom,_}) -> + {atom,[]}; +join(#ms{id=Id1,valid=B1,slots=Slots1}, #ms{id=Id2,valid=B2,slots=Slots2}) -> Id = if Id1 =:= Id2 -> Id1; true -> make_ref() end, #ms{id=Id,valid=B1 band B2,slots=min(Slots1, Slots2)}; -merge_types(T1, T2) when T1 =/= T2 -> - %% Too different. All we know is that the type is a 'term'. +join(T1, T2) when T1 =/= T2 -> + %% We've exhaused all other options, so the type must either be a list or + %% a 'term'. + join_list(T1, T2). + +%% Merges types of literals. Note that the left argument must either be a +%% literal or exactly equal to the second argument. +join_literal(Same, Same) -> + Same; +join_literal({literal,[_|_]}, T) -> + join_literal(T, cons); +join_literal({literal,#{}}, T) -> + join_literal(T, map); +join_literal({literal,Tuple}, T) when is_tuple(Tuple) -> + join_literal(T, {tuple, tuple_size(Tuple)}); +join_literal({literal,_}, T) -> + %% Bitstring, fun, or similar. + join_literal(T, term); +join_literal(T1, T2) -> + %% We're done extracting the types, try merging them again. + join(T1, T2). + +join_list(nil, cons) -> list; +join_list(nil, list) -> list; +join_list(cons, list) -> list; +join_list(T, nil) -> join_list(nil, T); +join_list(T, cons) -> join_list(cons, T); +join_list(_, _) -> + %% Not a list, so it must be a term. term. tuple_sz([Sz]) -> Sz; @@ -1925,13 +2060,16 @@ bif_type('+', Src, Vst) -> bif_type('*', Src, Vst) -> arith_type(Src, Vst); bif_type(abs, [Num], Vst) -> - case get_term_type(Num, Vst) of + case get_durable_term_type(Num, Vst) of {float,_}=T -> T; {integer,_}=T -> T; _ -> number end; bif_type(float, _, _) -> {float,[]}; bif_type('/', _, _) -> {float,[]}; +%% Binary operations +bif_type('byte_size', _, _) -> {integer,[]}; +bif_type('bit_size', _, _) -> {integer,[]}; %% Integer operations. bif_type(ceil, [_], _) -> {integer,[]}; bif_type('div', [_,_], _) -> {integer,[]}; @@ -1974,6 +2112,7 @@ bif_type(is_port, [_], _) -> bool; bif_type(is_reference, [_], _) -> bool; bif_type(is_tuple, [_], _) -> bool; %% Misc. +bif_type(tuple_size, [_], _) -> {integer,[]}; bif_type(node, [], _) -> {atom,[]}; bif_type(node, [_], _) -> {atom,[]}; bif_type(hd, [_], _) -> term; @@ -2010,12 +2149,16 @@ is_bif_safe(_, _) -> false. arith_type([A], Vst) -> %% Unary '+' or '-'. - case get_term_type(A, Vst) of + case get_durable_term_type(A, Vst) of + {integer,_} -> {integer,[]}; {float,_} -> {float,[]}; _ -> number end; arith_type([A,B], Vst) -> - case {get_term_type(A, Vst),get_term_type(B, Vst)} of + TypeA = get_durable_term_type(A, Vst), + TypeB = get_durable_term_type(B, Vst), + case {TypeA, TypeB} of + {{integer,_},{integer,_}} -> {integer,[]}; {{float,_},_} -> {float,[]}; {_,{float,_}} -> {float,[]}; {_,_} -> number @@ -2037,10 +2180,24 @@ return_type_1(erlang, setelement, 3, Vst) -> {tuple,[0]} end, case get_term_type({x,0}, Vst) of - {integer,[]} -> TupleType; - {integer,I} -> upgrade_tuple_type({tuple,[I]}, TupleType); - _ -> TupleType + {integer,[]} -> + TupleType; + {integer,I} -> + case meet({tuple,[I]}, TupleType) of + none -> TupleType; + T -> T + end; + _ -> + TupleType + end; +return_type_1(erlang, '++', 2, Vst) -> + case get_term_type({x,0}, Vst) =:= cons orelse + get_term_type({x,1}, Vst) =:= cons of + true -> cons; + false -> list end; +return_type_1(erlang, '--', 2, _Vst) -> + list; return_type_1(erlang, F, A, _) -> return_type_erl(F, A); return_type_1(math, F, A, _) -> diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl index 677094b3cd..415b579240 100644 --- a/lib/compiler/src/beam_z.erl +++ b/lib/compiler/src/beam_z.erl @@ -71,6 +71,31 @@ undo_renames([{get_hd,Src,Dst1},{get_tl,Src,Dst2}|Is]) -> [{get_list,Src,Dst1,Dst2}|undo_renames(Is)]; undo_renames([{get_tl,Src,Dst2},{get_hd,Src,Dst1}|Is]) -> [{get_list,Src,Dst1,Dst2}|undo_renames(Is)]; +undo_renames([{bs_put,_,{bs_put_binary,1,_}, + [{atom,all},{literal,<<>>}]}|Is]) -> + undo_renames(Is); +undo_renames([{bs_put,Fail,{bs_put_binary,1,_Flags}, + [{atom,all},{literal,BinString}]}|Is0]) -> + Bits = bit_size(BinString), + Bytes = Bits div 8, + case Bits rem 8 of + 0 -> + I = {bs_put_string,byte_size(BinString), + {string,BinString}}, + [undo_rename(I)|undo_renames(Is0)]; + Rem -> + <<Binary:Bytes/bytes,Int:Rem>> = BinString, + PutInt = {bs_put_integer,Fail,{integer,Rem},1, + {field_flags,[unsigned,big]},{integer,Int}}, + Is = [PutInt|undo_renames(Is0)], + case Binary of + <<>> -> + Is; + _ -> + [{bs_put_string,byte_size(Binary), + {string,Binary}}|Is] + end + end; undo_renames([I|Is]) -> [undo_rename(I)|undo_renames(Is)]; undo_renames([]) -> []. @@ -79,8 +104,6 @@ undo_rename({bs_put,F,{I,U,Fl},[Sz,Src]}) -> {I,F,Sz,U,Fl,Src}; undo_rename({bs_put,F,{I,Fl},[Src]}) -> {I,F,Fl,Src}; -undo_rename({bs_put,{f,0},{bs_put_string,_,_}=I,[]}) -> - I; undo_rename({bif,bs_add=I,F,[Src1,Src2,{integer,U}],Dst}) -> {I,F,[Src1,Src2,U],Dst}; undo_rename({bif,bs_utf8_size=I,F,[Src],Dst}) -> @@ -101,7 +124,7 @@ undo_rename({test,bs_match_string=Op,F,[Ctx,Bin0]}) -> 0 -> Bin0; Rem -> <<Bin0/bitstring,0:(8-Rem)>> end, - {test,Op,F,[Ctx,Bits,{string,binary_to_list(Bin)}]}; + {test,Op,F,[Ctx,Bits,{string,Bin}]}; undo_rename({put_map,Fail,assoc,S,D,R,L}) -> {put_map_assoc,Fail,S,D,R,L}; undo_rename({put_map,Fail,exact,S,D,R,L}) -> diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 14c8c5b4ab..53d3cec2d7 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -268,6 +268,10 @@ expand_opt(r21, Os) -> [no_put_tuple2 | expand_opt(no_bsm3, Os)]; expand_opt({debug_info_key,_}=O, Os) -> [encrypt_debug_info,O|Os]; +expand_opt(no_type_opt, Os) -> + [no_ssa_opt_type_start, + no_ssa_opt_type_continue, + no_ssa_opt_type_finish | Os]; expand_opt(O, Os) -> [O|Os]. expand_opt_before_21(Os) -> @@ -855,8 +859,6 @@ asm_passes() -> {iff,dblk,{listing,"block"}}, {unless,no_except,{pass,beam_except}}, {iff,dexcept,{listing,"except"}}, - {unless,no_bs_opt,{pass,beam_bs}}, - {iff,dbs,{listing,"bs"}}, {unless,no_jopt,{pass,beam_jump}}, {iff,djmp,{listing,"jump"}}, {unless,no_peep_opt,{pass,beam_peep}}, @@ -2084,7 +2086,6 @@ pre_load() -> L = [beam_a, beam_asm, beam_block, - beam_bs, beam_clean, beam_dict, beam_except, diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 1472e3fde1..108a0ca100 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -24,7 +24,6 @@ beam_a, beam_asm, beam_block, - beam_bs, beam_clean, beam_dict, beam_disasm, diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index ce9762899e..d925decce6 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -195,6 +195,7 @@ is_safe(erlang, is_float, 1) -> true; is_safe(erlang, is_function, 1) -> true; is_safe(erlang, is_integer, 1) -> true; is_safe(erlang, is_list, 1) -> true; +is_safe(erlang, is_map, 1) -> true; is_safe(erlang, is_number, 1) -> true; is_safe(erlang, is_pid, 1) -> true; is_safe(erlang, is_port, 1) -> true; diff --git a/lib/compiler/src/sys_core_inline.erl b/lib/compiler/src/sys_core_inline.erl index 5a6cc45e4a..3380e3f1bd 100644 --- a/lib/compiler/src/sys_core_inline.erl +++ b/lib/compiler/src/sys_core_inline.erl @@ -195,6 +195,9 @@ kill_id_anns(Body) -> cerl_trees:map(fun(#c_fun{anno=A0}=CFun) -> A = kill_id_anns_1(A0), CFun#c_fun{anno=A}; + (#c_var{anno=A0}=Var) -> + A = kill_id_anns_1(A0), + Var#c_var{anno=A}; (Expr) -> %% Mark everything as compiler generated to %% suppress bogus warnings. diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 45e0ed5088..34930c3afe 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -2627,7 +2627,8 @@ cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) -> [],A#a.us,St2}. c_call_erl(Fun, Args) -> - cerl:c_call(cerl:c_atom(erlang), cerl:c_atom(Fun), Args). + As = [compiler_generated], + cerl:ann_c_call(As, cerl:c_atom(erlang), cerl:c_atom(Fun), Args). %% lit_vars(Literal) -> [Var]. diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 40428b7f2d..f042a5cb51 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -105,6 +105,8 @@ CORE_MODULES = \ lfe_andor_SUITE \ lfe_guard_SUITE +NO_MOD_OPT = $(NO_OPT) + NO_OPT_MODULES= $(NO_OPT:%=%_no_opt_SUITE) NO_OPT_ERL_FILES= $(NO_OPT_MODULES:%=%.erl) POST_OPT_MODULES= $(NO_OPT:%=%_post_opt_SUITE) @@ -113,6 +115,8 @@ INLINE_MODULES= $(INLINE:%=%_inline_SUITE) INLINE_ERL_FILES= $(INLINE_MODULES:%=%.erl) R21_MODULES= $(R21:%=%_r21_SUITE) R21_ERL_FILES= $(R21_MODULES:%=%.erl) +NO_MOD_OPT_MODULES= $(NO_MOD_OPT:%=%_no_module_opt_SUITE) +NO_MOD_OPT_ERL_FILES= $(NO_MOD_OPT_MODULES:%=%.erl) ERL_FILES= $(MODULES:%=%.erl) CORE_FILES= $(CORE_MODULES:%=%.core) @@ -142,7 +146,7 @@ EBIN = . # ---------------------------------------------------- make_emakefile: $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) \ - $(INLINE_ERL_FILES) $(R21_ERL_FILES) + $(INLINE_ERL_FILES) $(R21_ERL_FILES) $(NO_MOD_OPT_ERL_FILES) $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \ > $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile +no_copt +no_postopt \ @@ -154,6 +158,8 @@ make_emakefile: $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) \ -o$(EBIN) $(INLINE_MODULES) >> $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile +r21 $(ERL_COMPILE_FLAGS) \ -o$(EBIN) $(R21_MODULES) >> $(EMAKEFILE) + $(ERL_TOP)/make/make_emakefile +no_module_opt $(ERL_COMPILE_FLAGS) \ + -o$(EBIN) $(NO_MOD_OPT_MODULES) >> $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile +from_core $(ERL_COMPILE_FLAGS) \ -o$(EBIN) $(CORE_MODULES) >> $(EMAKEFILE) @@ -183,6 +189,9 @@ docs: %_r21_SUITE.erl: %_SUITE.erl sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ +%_no_module_opt_SUITE.erl: %_SUITE.erl + sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ + # ---------------------------------------------------- # Release Target # ---------------------------------------------------- @@ -195,7 +204,8 @@ release_tests_spec: make_emakefile $(INSTALL_DATA) compiler.spec compiler.cover \ $(EMAKEFILE) $(ERL_FILES) "$(RELSYSDIR)" $(INSTALL_DATA) $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) \ - $(INLINE_ERL_FILES) $(R21_ERL_FILES) "$(RELSYSDIR)" + $(INLINE_ERL_FILES) $(R21_ERL_FILES) \ + $(NO_MOD_OPT_ERL_FILES) "$(RELSYSDIR)" $(INSTALL_DATA) $(CORE_FILES) "$(RELSYSDIR)" for file in $(ERL_DUMMY_FILES); do \ module=`basename $$file .erl`; \ diff --git a/lib/compiler/test/apply_SUITE.erl b/lib/compiler/test/apply_SUITE.erl index 0f82a56fb7..2ee518b1a0 100644 --- a/lib/compiler/test/apply_SUITE.erl +++ b/lib/compiler/test/apply_SUITE.erl @@ -73,6 +73,7 @@ mfa(Config) when is_list(Config) -> {'EXIT',_} = (catch ?APPLY2(Mod, (id(bazzzzzz)), a, b)), {'EXIT',_} = (catch ?APPLY2({}, baz, a, b)), {'EXIT',_} = (catch ?APPLY2(?MODULE, [], a, b)), + {'EXIT',_} = (catch bad_literal_call(1)), ok = apply(Mod, foo, id([])), {[a,b|c]} = apply(Mod, bar, id([[a,b|c]])), @@ -92,6 +93,13 @@ mfa(Config) when is_list(Config) -> apply(Mod, foo, []). +%% The single call to this function with a literal argument caused type +%% optimization to swap out the 'mod' field of a #b_remote{}, which was +%% mishandled during code generation as it assumed that the module would always +%% be an atom. +bad_literal_call(I) -> + I:foo(). + foo() -> ok. diff --git a/lib/compiler/test/beam_except_SUITE.erl b/lib/compiler/test/beam_except_SUITE.erl index da61931136..9380fe06c8 100644 --- a/lib/compiler/test/beam_except_SUITE.erl +++ b/lib/compiler/test/beam_except_SUITE.erl @@ -21,7 +21,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - multiple_allocs/1,coverage/1]). + multiple_allocs/1,bs_get_tail/1,coverage/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -31,6 +31,7 @@ all() -> groups() -> [{p,[parallel], [multiple_allocs, + bs_get_tail, coverage]}]. init_per_suite(Config) -> @@ -63,6 +64,17 @@ place(lee) -> conditions() -> (talking = going) = storage + [large = wanted]. +bs_get_tail(Config) -> + {<<"abc">>,0,0,Config} = bs_get_tail_1(id(<<0:32, "abc">>), 0, 0, Config), + {'EXIT', + {function_clause, + [{?MODULE,bs_get_tail_1,[<<>>,0,0,Config],_}|_]}} = + (catch bs_get_tail_1(id(<<>>), 0, 0, Config)), + ok. + +bs_get_tail_1(<<_:32, Rest/binary>>, Z1, Z2, F1) -> + {Rest,Z1,Z2,F1}. + coverage(_) -> File = {file,"fake.erl"}, ok = fc(a), @@ -88,8 +100,19 @@ coverage(_) -> {'EXIT',{{strange,Self},[{?MODULE,foo,[any],[File,{line,14}]}|_]}} = (catch foo(any)), + {ok,succeed,1,2} = foobar(succeed, 1, 2), + {'EXIT',{function_clause,[{?MODULE,foobar,[[fail],1,2], + [{file,"fake.erl"},{line,16}]}|_]}} = + (catch foobar([fail], 1, 2)), + {'EXIT',{function_clause,[{?MODULE,fake_function_clause,[{a,b},42.0],_}|_]}} = + (catch fake_function_clause({a,b})), + ok. +fake_function_clause(A) -> error(function_clause, [A,42.0]). + +id(I) -> I. + -file("fake.erl", 1). fc(a) -> %Line 2 ok; %Line 3 @@ -104,3 +127,6 @@ bar(X) -> %Line 8 %% Cover collection code for function_clause exceptions. foo(A) -> %Line 13 error({strange,self()}, [A]). %Line 14 +%% Cover beam_except:tag_literal/1. +foobar(A, B, C) when is_atom(A) -> %Line 16 + {ok,A,B,C}. %Line 17 diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index 918e45ff6f..a7ffc3f60a 100644 --- a/lib/compiler/test/beam_type_SUITE.erl +++ b/lib/compiler/test/beam_type_SUITE.erl @@ -213,11 +213,18 @@ coverage(Config) -> [_|_] -> ok end, + + %% Cover beam_type:verified_type(none). + {'EXIT',{badarith,_}} = (catch (id(2) / id(1)) band 16#ff), + ok. booleans(_Config) -> {'EXIT',{{case_clause,_},_}} = (catch do_booleans_1(42)), + ok = do_booleans_2(42, 41), + error = do_booleans_2(42, 42), + AnyAtom = id(atom), true = is_atom(AnyAtom), false = is_boolean(AnyAtom), @@ -246,6 +253,19 @@ do_booleans_1(B) -> no -> no end. +do_booleans_2(A, B) -> + Not = not do_booleans_cmp(A, B), + case Not of + true -> + case Not of + true -> error; + false -> ok + end; + false -> ok + end. + +do_booleans_cmp(A, B) -> A > B. + setelement(_Config) -> T0 = id({a,42}), {a,_} = T0, diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 661b48a080..585d0e7191 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -579,14 +579,26 @@ receive_stacked(Config) -> ok. +aliased_types(Config) -> + Seq = lists:seq(1, 5), + 1 = aliased_types_1(Seq, Config), + + {1,1} = aliased_types_2(Seq), + {42,none} = aliased_types_2([]), + + gurka = aliased_types_3([gurka]), + gaffel = aliased_types_3([gaffel]), + + ok. + %% ERL-735: validator failed to track types on aliased registers, rejecting %% legitimate optimizations. %% %% move x0 y0 %% bif hd L1 x0 %% get_hd y0 %% The validator failed to see that y0 was a list -aliased_types(Config) when is_list(Config) -> - Bug = lists:seq(1, 5), +%% +aliased_types_1(Bug, Config) -> if Config =/= [gurka, gaffel] -> %% Pointless branch. _ = hd(Bug), @@ -594,6 +606,31 @@ aliased_types(Config) when is_list(Config) -> hd(Bug) end. +%% ERL-832: validator failed to realize that a Y register was a cons. +aliased_types_2(Bug) -> + Res = case Bug of + [] -> id(42); + _ -> hd(Bug) + end, + {Res,case Bug of + [] -> none; + _ -> hd(Bug) + end}. + +%% ERL-832 part deux; validator failed to realize that an aliased register was +%% a cons. +aliased_types_3(Bug) -> + List = [Y || Y <- Bug], + case List of + [] -> Bug; + _ -> + if + hd(List) -> a:a(); + true -> ok + end, + hd(List) + end. + %%%------------------------------------------------------------------------- transform_remove(Remove, Module) -> @@ -652,3 +689,6 @@ night(Turned) -> ok. participating(_, _, _, _) -> ok. + +id(I) -> + I. diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl index ccc49df005..69017d87e7 100644 --- a/lib/compiler/test/bs_construct_SUITE.erl +++ b/lib/compiler/test/bs_construct_SUITE.erl @@ -153,6 +153,8 @@ l(I_13, I_big1, I_16, Bin) -> [0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 16#77,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF, 16#FF,16#FF,16#FF,16#FF,16#FF,16#FF]), + ?T(<< (<<"abc",7:3>>):3/binary >>, + [$a,$b,$c]), %% Mix different units. ?T(<<37558955:(I_16-12)/unit:8,1:1>>, @@ -311,6 +313,9 @@ fail(Config) when is_list(Config) -> {'EXIT',{badarg,_}} = (catch <<0:(-(1 bsl 100))>>), {'EXIT',{badarg,_}} = (catch <<Bin/binary,0:(-(1 bsl 100))>>), + %% Unaligned sizes with literal binaries. + {'EXIT',{badarg,_}} = (catch <<0,(<<7777:17>>)/binary>>), + ok. float_bin(Config) when is_list(Config) -> diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 6eae7b1404..7452466666 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -391,7 +391,6 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> do_listing(Simple, TargetDir, dcg, ".codegen"), do_listing(Simple, TargetDir, dblk, ".block"), do_listing(Simple, TargetDir, dexcept, ".except"), - do_listing(Simple, TargetDir, dbs, ".bs"), do_listing(Simple, TargetDir, djmp, ".jump"), do_listing(Simple, TargetDir, dclean, ".clean"), do_listing(Simple, TargetDir, dpeep, ".peep"), @@ -1250,7 +1249,8 @@ do_opt_guards_fun([]) -> []. is_exception(guard_SUITE, {'-complex_not/1-fun-4-',1}) -> true; is_exception(guard_SUITE, {'-complex_not/1-fun-5-',1}) -> true; is_exception(guard_SUITE, {bad_guards,1}) -> true; -is_exception(guard_SUITE, {nested_not_2b,4}) -> true; +is_exception(guard_SUITE, {nested_not_2b,6}) -> true; %% w/o type optimization +is_exception(guard_SUITE, {nested_not_2b,2}) -> true; %% with type optimization is_exception(_, _) -> false. sys_pre_attributes(Config) -> diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl index 012810aba2..831e8279aa 100644 --- a/lib/compiler/test/float_SUITE.erl +++ b/lib/compiler/test/float_SUITE.erl @@ -20,7 +20,8 @@ -module(float_SUITE). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - pending/1,bif_calls/1,math_functions/1,mixed_float_and_int/1]). + pending/1,bif_calls/1,math_functions/1,mixed_float_and_int/1, + subtract_number_type/1]). -include_lib("common_test/include/ct.hrl"). @@ -28,7 +29,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [pending, bif_calls, math_functions, - mixed_float_and_int]. + mixed_float_and_int, subtract_number_type]. groups() -> []. @@ -176,5 +177,15 @@ mixed_float_and_int(Config) when is_list(Config) -> pc(Cov, NotCov, X) -> round(Cov/(Cov+NotCov)*100) + 42 + 2.0*X. +subtract_number_type(Config) when is_list(Config) -> + 120 = fact(5). + +fact(N) -> + fact(N, 1). + +fact(0, P) -> P; +fact(1, P) -> P; +fact(N, P) -> fact(N-1, P*N). + id(I) -> I. diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 78276982eb..60ab969929 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -25,7 +25,7 @@ match_in_call/1,untuplify/1,shortcut_boolean/1,letify_guard/1, selectify/1,deselectify/1,underscore/1,match_map/1,map_vars_used/1, coverage/1,grab_bag/1,literal_binary/1, - unary_op/1]). + unary_op/1,eq_types/1]). -include_lib("common_test/include/ct.hrl"). @@ -40,7 +40,7 @@ groups() -> match_in_call,untuplify, shortcut_boolean,letify_guard,selectify,deselectify, underscore,match_map,map_vars_used,coverage, - grab_bag,literal_binary,unary_op]}]. + grab_bag,literal_binary,unary_op,eq_types]}]. init_per_suite(Config) -> @@ -870,5 +870,25 @@ unary_op_1(Vop@1) -> end end. +eq_types(_Config) -> + Ref = make_ref(), + Ref = eq_types(Ref, any), + ok. + +eq_types(A, B) -> + %% {put_tuple2,{y,0},{list,[{x,0},{x,1}]}}. + Term0 = {A, B}, + Term = id(Term0), + + %% {test,is_eq_exact,{f,3},[{y,0},{x,0}]}. + %% Here beam_validator must infer that {x,0} has the + %% same type as {y,0}. + Term = Term0, + + %% {get_tuple_element,{x,0},0,{x,0}}. + {Ref22,_} = Term, + + Ref22. + id(I) -> I. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 2a6303ece8..e999c8ffae 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -223,10 +223,6 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, expect_error(fun() -> beam_block:module(BlockInput, []) end), - %% beam_bs - BsInput = BlockInput, - expect_error(fun() -> beam_bs:module(BsInput, []) end), - %% beam_except ExceptInput = {?MODULE,[{foo,0}],[], [{function,foo,0,2, diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index 4219768d6f..12108445f0 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -25,7 +25,7 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, export/1,recv/1,coverage/1,otp_7980/1,ref_opt/1, - wait/1,recv_in_try/1,double_recv/1]). + wait/1,recv_in_try/1,double_recv/1,receive_var_zero/1]). -include_lib("common_test/include/ct.hrl"). @@ -45,7 +45,7 @@ all() -> groups() -> [{p,test_lib:parallel(), [recv,coverage,otp_7980,ref_opt,export,wait, - recv_in_try,double_recv]}]. + recv_in_try,double_recv,receive_var_zero]}]. init_per_suite(Config) -> @@ -378,4 +378,27 @@ do_double_recv(_, Msg) -> error end. +%% Test 'after Z', when Z =:= 0 been propagated as an immediate by the type +%% optimization pass. +receive_var_zero(Config) when is_list(Config) -> + self() ! x, + self() ! y, + Z = zero(), + timeout = receive + z -> ok + after Z -> timeout + end, + timeout = receive + after Z -> timeout + end, + self() ! w, + receive + x -> ok; + Other -> + ct:fail({bad_message,Other}) + end. + +zero() -> 0. + + id(I) -> I. diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index 4502f5b68a..26149e11e6 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -81,6 +81,8 @@ opt_opts(Mod) -> (no_put_tuple2) -> true; (no_bsm3) -> true; (no_bsm_opt) -> true; + (no_module_opt) -> true; + (no_type_opt) -> true; (_) -> false end, Opts). @@ -93,8 +95,9 @@ get_data_dir(Config) -> Opts = [{return,list}], Data1 = re:replace(Data0, "_no_opt_SUITE", "_SUITE", Opts), Data2 = re:replace(Data1, "_post_opt_SUITE", "_SUITE", Opts), - Data = re:replace(Data2, "_inline_SUITE", "_SUITE", Opts), - re:replace(Data, "_r21_SUITE", "_SUITE", Opts). + Data3 = re:replace(Data2, "_inline_SUITE", "_SUITE", Opts), + Data4 = re:replace(Data3, "_r21_SUITE", "_SUITE", Opts), + re:replace(Data4, "_no_module_opt_SUITE", "_SUITE", Opts). is_cloned_mod(Mod) -> is_cloned_mod_1(atom_to_list(Mod)). @@ -105,6 +108,7 @@ is_cloned_mod_1("no_opt_SUITE") -> true; is_cloned_mod_1("post_opt_SUITE") -> true; is_cloned_mod_1("inline_SUITE") -> true; is_cloned_mod_1("21_SUITE") -> true; +is_cloned_mod_1("no_module_opt_SUITE") -> true; is_cloned_mod_1([_|T]) -> is_cloned_mod_1(T); is_cloned_mod_1([]) -> false. diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index 1f39348998..c5d0bf8420 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -42,7 +42,7 @@ comprehensions/1,maps/1,maps_bin_opt_info/1, redundant_boolean_clauses/1, latin1_fallback/1,underscore/1,no_warnings/1, - bit_syntax/1,inlining/1]). + bit_syntax/1,inlining/1,tuple_calls/1]). init_per_testcase(_Case, Config) -> Config. @@ -64,7 +64,8 @@ groups() -> bin_opt_info,bin_construction,comprehensions,maps, maps_bin_opt_info, redundant_boolean_clauses,latin1_fallback, - underscore,no_warnings,bit_syntax,inlining]}]. + underscore,no_warnings,bit_syntax,inlining, + tuple_calls]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -970,6 +971,20 @@ inlining(Config) -> run(Config, Ts), ok. +tuple_calls(Config) -> + %% Make sure that no spurious warnings are generated. + Ts = [{inlining_1, + <<"-compile(tuple_calls). + dispatch(X) -> + (list_to_atom(\"prefix_\" ++ + atom_to_list(suffix))):doit(X). + ">>, + [], + []} + ], + run(Config, Ts), + ok. + %%% %%% End of test cases. %%% diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk index 97179b7fc4..efedb414ad 100644 --- a/lib/compiler/vsn.mk +++ b/lib/compiler/vsn.mk @@ -1 +1 @@ -COMPILER_VSN = 7.3 +COMPILER_VSN = 7.3.1 diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 6836e30a1b..987bc3fe0f 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -914,7 +914,8 @@ rand_seed_nif(_Seed) -> ?nif_stub. -type pk_sign_verify_opts() :: [ rsa_sign_verify_opt() ] . -type rsa_sign_verify_opt() :: {rsa_padding, rsa_sign_verify_padding()} - | {rsa_pss_saltlen, integer()} . + | {rsa_pss_saltlen, integer()} + | {rsa_mgf1_md, sha2()}. -type rsa_sign_verify_padding() :: rsa_pkcs1_padding | rsa_pkcs1_pss_padding | rsa_x931_padding | rsa_no_padding diff --git a/lib/crypto/test/Makefile b/lib/crypto/test/Makefile index e046a25338..8b320e01a9 100644 --- a/lib/crypto/test/Makefile +++ b/lib/crypto/test/Makefile @@ -6,6 +6,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # ---------------------------------------------------- MODULES = \ + crypto_bench_SUITE \ blowfish_SUITE \ crypto_SUITE \ engine_SUITE @@ -77,7 +78,7 @@ release_spec: release_tests_spec: $(TEST_TARGET) $(INSTALL_DIR) "$(RELSYSDIR)" - $(INSTALL_DATA) crypto.spec crypto.cover $(RELTEST_FILES) "$(RELSYSDIR)" + $(INSTALL_DATA) crypto.spec crypto_bench.spec crypto.cover $(RELTEST_FILES) "$(RELSYSDIR)" @tar cfh - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) chmod -R u+w "$(RELSYSDIR)" diff --git a/lib/crypto/test/crypto.spec b/lib/crypto/test/crypto.spec index cc09970cb3..4a95275687 100644 --- a/lib/crypto/test/crypto.spec +++ b/lib/crypto/test/crypto.spec @@ -1 +1,6 @@ {suites,"../crypto_test",all}. + +{skip_suites, "../crypto_test", [crypto_bench_SUITE + ], + "Benchmarks run separately"}. + diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 82d098ebd1..003e0c58b1 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -156,7 +156,7 @@ groups() -> ]}, {dh, [], [generate_compute, compute_bug]}, - {ecdh, [], [generate_all_supported, compute, generate]}, + {ecdh, [], [use_all_elliptic_curves, compute, generate]}, {srp, [], [generate_compute]}, {des_cbc, [], [block]}, {des_cfb, [], [block]}, @@ -563,32 +563,43 @@ compute(Config) when is_list(Config) -> Gen = proplists:get_value(compute, Config), lists:foreach(fun do_compute/1, Gen). %%-------------------------------------------------------------------- -generate_all_supported() -> - [{doc, " Test that all curves from crypto:ec_curves/0 returns two binaries"}]. -generate_all_supported(_Config) -> +use_all_elliptic_curves() -> + [{doc, " Test that all curves from crypto:ec_curves/0"}]. +use_all_elliptic_curves(_Config) -> + Msg = <<"hello world!">>, + Sups = crypto:supports(), + Curves = proplists:get_value(curves, Sups), + Hashs = proplists:get_value(hashs, Sups), + ct:log("Lib: ~p~nFIPS: ~p~nCurves:~n~p~nHashs: ~p", [crypto:info_lib(), + crypto:info_fips(), + Curves, + Hashs]), Results = - [try - crypto:generate_key(ecdh, C) - of - {B1,B2} when is_binary(B1) and is_binary(B2) -> - %% That is, seems like it works as expected. - {ok,C}; - Err -> - ct:log("ERROR: Curve ~p generated ~p", [C,Err]), - {error,{C,Err}} - catch - Cls:Err:Stack -> - ct:log("ERROR: Curve ~p exception ~p:~p~n~p", [C,Cls,Err,Stack]), - {error,{C,{Cls,Err}}} - end - || C <- crypto:ec_curves(), - not lists:member(C, [ed25519, ed448]) + [{{Curve,Hash}, + try + {Pub,Priv} = crypto:generate_key(ecdh, Curve), + true = is_binary(Pub), + true = is_binary(Priv), + Sig = crypto:sign(ecdsa, Hash, Msg, [Priv, Curve]), + crypto:verify(ecdsa, Hash, Msg, Sig, [Pub, Curve]) + catch + C:E -> + {C,E} + end} + || Curve <- Curves -- [ed25519, ed448, x25519, x448, ipsec3, ipsec4], + Hash <- Hashs -- [md4, md5, ripemd160, sha3_224, sha3_256, sha3_384, sha3_512] ], - OK = [C || {ok,C} <- Results], - ct:log("Ok (len=~p): ~p", [length(OK), OK]), - false = lists:any(fun({error,_}) -> true; - (_) -> false - end, Results). + Fails = + lists:filter(fun({_,true}) -> false; + (_) -> true + end, Results), + case Fails of + [] -> + ok; + _ -> + ct:log("Fails:~n~p",[Fails]), + ct:fail("Bad curve(s)",[]) + end. %%-------------------------------------------------------------------- generate() -> diff --git a/lib/crypto/test/crypto_bench.spec b/lib/crypto/test/crypto_bench.spec new file mode 100644 index 0000000000..b9a26d94db --- /dev/null +++ b/lib/crypto/test/crypto_bench.spec @@ -0,0 +1,3 @@ +{suites, "../crypto_test", [ + crypto_bench_SUITE + ]}. diff --git a/lib/crypto/test/crypto_bench_SUITE.erl b/lib/crypto/test/crypto_bench_SUITE.erl new file mode 100644 index 0000000000..c66a27f0c8 --- /dev/null +++ b/lib/crypto/test/crypto_bench_SUITE.erl @@ -0,0 +1,400 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2018. 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(crypto_bench_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct_event.hrl"). +-include_lib("common_test/include/ct.hrl"). + +suite() -> [%%{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}, + {timetrap,{minutes,2}} + ]. + +all() -> + [ + {group, textblock_256} + ]. + +groups() -> + [ + {textblock_256, [], [ + {group, ciphers_128}, + {group, ciphers_256} + ]}, + + {ciphers_128, [{repeat, 5}], [ + block, + stream + ]}, + + {ciphers_256, [{repeat, 5}], [ + block, + stream, + chacha + ]} + ]. + +%%%---------------------------------------------------------------- +%%% +init_per_suite(Config0) -> + try crypto:start() of + _ -> + [{_,_,Info}] = crypto:info_lib(), + ct:comment("~s",[Info]), + ct:pal("Crypto version: ~p~n~n~p",[Info,crypto:supports()]), + Config1 = measure_openssl_aes_cbc([128,256], Config0), + calibrate([{sec_goal,10} | Config1]) + + catch _:_ -> + {fail, "Crypto did not start"} + end. + +end_per_suite(_Config) -> + application:stop(crypto). + +%%%---------------------------------------------------------------- +%%% +init_per_group(Group, Config) -> + case atom_to_list(Group) of + "ciphers_"++KeySizeStr -> + KeySize = list_to_integer(KeySizeStr), + [{key_size,KeySize} | Config]; + + "textblock_"++BlockSizeStr -> + BlockSize = list_to_integer(BlockSizeStr), + [{block_size,BlockSize} | Config]; + + _ -> + Config + end. + +end_per_group(_Group, Config) -> + Config. + + +measure_openssl_aes_cbc(KeySizes, Config) -> + BLno_acc = [baseline(aes_cbc, KeySize, false) || KeySize <- KeySizes], + ct:pal("Non-accelerated baseline encryption time [µs/block]:~n~p", [BLno_acc]), + BLacc = [baseline(aes_cbc, KeySize, true) || KeySize <- KeySizes], + ct:pal("Possibly accelerated baseline encryption time [µs/block]:~n~p", [BLacc]), + [{acc,BLacc}, + {no_acc,BLno_acc} | Config]. + +calibrate(Config) -> + Secs = proplists:get_value(sec_goal, Config, 10), + {_,Empty} = data(empty, 0, 0), + {Ne,Te} = run1(Secs*3000, Empty), + report(["Overhead"], Te/Ne), + [{overhead,Te/Ne} | Config]. + +%%%================================================================ +%%% +%%% +block(Config) -> + run_cryptos([aes_cbc, aes_gcm, aes_ccm], + Config). + +stream(Config) -> + run_cryptos([aes_ctr], + Config). + +chacha(Config) -> + run_cryptos([chacha20, chacha20_poly1305], + Config). + + +%%%================================================================ +%%% +%%% + +run_cryptos(Cryptos, Config) -> + KeySize = proplists:get_value(key_size, Config), + BlockSize = proplists:get_value(block_size, Config), + MilliSecGoal = 1000*proplists:get_value(sec_goal,Config), + OverHead = proplists:get_value(overhead, Config, 0), + [try + TimePerOpBrutto = run(Crypto,KeySize,BlockSize,MilliSecGoal), + %% ct:pal("Brutto: ~p Overhead: ~p (~.2f %) Netto: ~p", + %% [TimePerOpBrutto, OverHead, 100*OverHead/TimePerOpBrutto,TimePerOpBrutto - OverHead]), + TimePerOpBrutto - OverHead + of + TimePerOp -> % µs + %% First, Report speed of encrypting blocks of 1000. [blocks/sec] + ReportUnit = 1000, + Label = [fmt(Crypto)," key:",KeySize," block:",BlockSize], + report(Label, + (BlockSize/ReportUnit)*1000000/TimePerOp + ), + + EffCrypto = case Crypto of + X -> X + end, + %% Percent of accelerated speed + case find_value([acc,{EffCrypto,KeySize},BlockSize], Config) of + undefined -> + ok; + TimePerOpBaseAcc -> + report(["Percent of acc OpenSSL "|Label], + 100*TimePerOpBaseAcc/TimePerOp % Percent of base *speed* + ) + end, + + %% Percent of non-accelerated speed + case find_value([no_acc,{EffCrypto,KeySize},BlockSize], Config) of + undefined -> + ok; + TimePerOpBaseNoAcc -> + report(["Percent of noacc OpenSSL "|Label], + 100*TimePerOpBaseNoAcc/TimePerOp % Percent of base *speed* + ) + end + catch + _:_ -> + ct:pal("~p unsupported",[{Crypto,KeySize,BlockSize}]) + end + || Crypto <- Cryptos, + supported(Crypto) + ]. + + +run(Crypto, KeySize, BlockSize, MilliSecGoal) -> + {_Type, Funs} = data(Crypto, KeySize, BlockSize), + {Nc,Tc} = run1(MilliSecGoal, Funs), + Tc/Nc. + +fmt(X) -> X. + + +find_value(KeyPath, PropList, Default) -> + try find_value(KeyPath, PropList) + of + undefined -> Default + catch + error:function_clause -> Default + end. + +find_value(KeyPath, PropList) -> + lists:foldl(fun(K, L) when is_list(L) -> proplists:get_value(K,L); + (_, _) -> undefined + end, PropList, KeyPath). + +%%%================================================================ +%%% +%%% +funs({block, {Type, Key, IV, Block}}) -> + {fun() -> ok end, + fun(_) -> crypto:block_encrypt(Type, Key, IV, Block) end, + fun(_) -> ok end}; + +funs({stream, {Type, Key, IV, Block}}) -> + {fun() -> {crypto:stream_init(Type, Key, IV),ok} end, + fun({Ctx,_}) -> crypto:stream_encrypt(Ctx, Block) end, + fun(_) -> ok end}. + + +data(aes_cbc, KeySize, BlockSize) -> + Type = case KeySize of + 128 -> aes_cbc128; + 256 -> aes_cbc256 + end, + Key = mk_bin(KeySize div 8), + IV = mk_bin(16), + Block = mk_bin(BlockSize), + {Type, funs({block, {Type, Key, IV, Block}})}; + +data(aes_gcm, KeySize, BlockSize) -> + Type = aes_gcm, + Key = mk_bin(KeySize div 8), + IV = mk_bin(12), + Block = mk_bin(BlockSize), + AAD = <<01,02,03,04>>, + {Type, funs({block, {Type, Key, IV, {AAD,Block,16}}})}; + +data(aes_ccm, KeySize, BlockSize) -> + Type = aes_ccm, + Key = mk_bin(KeySize div 8), + IV = mk_bin(12), + Block = mk_bin(BlockSize), + AAD = <<01,02,03,04>>, + {Type, funs({block, {Type, Key, IV, {AAD,Block,12}}})}; + +data(aes_ctr, KeySize, BlockSize) -> + Type = aes_ctr, + Key = mk_bin(KeySize div 8), + IV = mk_bin(16), + Block = mk_bin(BlockSize), + {Type, funs({stream, {Type, Key, IV, Block}})}; + +data(chacha20_poly1305, 256=KeySize, BlockSize) -> + Type = chacha20_poly1305, + Key = mk_bin(KeySize div 8), + IV = mk_bin(16), + AAD = <<01,02,03,04>>, + Block = mk_bin(BlockSize), + {Type, funs({block, {Type, Key, IV, {AAD,Block}}})}; + +data(chacha20, 256=KeySize, BlockSize) -> + Type = chacha20, + Key = mk_bin(KeySize div 8), + IV = mk_bin(16), + Block = mk_bin(BlockSize), + {Type, funs({stream, {Type, Key, IV, Block}})}; + +data(empty, 0, 0) -> + {undefined, + {fun() -> ok end, + fun(X) -> X end, + fun(_) -> ok end}}. + +%%%================================================================ +%%% +%%% +run1(MilliSecGoal, Funs) -> + Parent = self(), + Pid = spawn(fun() -> + {Fi,Fu,Ff} = Funs, + Ctx0 = Fi(), + erlang:garbage_collect(), + T0 = start_time(), + {N,Ctx} = loop(Fu, Ctx0, 0), + T = elapsed_time(T0), + Ff(Ctx), + Parent ! {result,N,microseconds(T)} + end), + Pid ! go, + receive + after MilliSecGoal -> + Pid ! stop + end, + receive + {result,N,MicroSecs} -> + {N,MicroSecs} + end. + + +loop(F, Ctx, N) -> + receive + stop -> + {N, Ctx} + after 0 -> + loop(F, F(Ctx), N+1) + end. + +%%%---------------------------------------------------------------- +report(LabelList, Value) -> + Label = report_chars(lists:concat(LabelList)), + ct:pal("ct_event:notify ~p: ~p", [Label, Value]), + ct_event:notify( + #event{name = benchmark_data, + data = [{name, Label}, + {value,Value}]}). + +report_chars(Cs) -> + [case C of + $- -> $_; + _ -> C + end || C <- Cs]. + +%%%---------------------------------------------------------------- +supported(Algorithm) -> + lists:member(Algorithm, + [A || {_,As} <- crypto:supports(), A <- As] + ). + +%%%---------------------------------------------------------------- +start_time() -> + erlang:system_time(). + +elapsed_time(StartTime) -> + erlang:system_time() - StartTime. + +microseconds(Time) -> + erlang:convert_time_unit(Time, native, microsecond). + +%%%---------------------------------------------------------------- + +%% Example output: +%% +DT:aes-128-cbc:3:16 +%% +R:135704772:aes-128-cbc:2.980000 +%% +DT:aes-128-cbc:3:64 +%% +R:36835089:aes-128-cbc:3.000000 +%% +DT:aes-128-cbc:3:256 +%% +R:9398616:aes-128-cbc:3.000000 +%% +DT:aes-128-cbc:3:1024 +%% +R:2355683:aes-128-cbc:2.990000 +%% +DT:aes-128-cbc:3:8192 +%% +R:294508:aes-128-cbc:2.990000 +%% +H:16:64:256:1024:8192 +%% +F:22:aes-128-cbc:728616225.50:785815232.00:802015232.00:806762338.46:806892821.40 + +baseline(Crypto, KeySize, EVP) -> + Spec= + case {Crypto,KeySize} of + {aes_cbc, 128} -> "aes-128-cbc"; + {aes_cbc, 256} -> "aes-256-cbc" + end, + {{Crypto,KeySize}, baseline(Spec, EVP)}. + +baseline(Spec, EVP) -> + Cmd = + case EVP of + true -> "openssl speed -mr -evp " ++ Spec; + false-> "openssl speed -mr " ++ Spec + end, + get_base_values(string:tokens(os:cmd(Cmd),"\n"), Spec, []). + + +get_base_values(["+DT:"++Sdt, + "+R:"++Sr + |T], Crypto, Acc) -> + [Crypto0,_GoalSecs0,BlockSize0] = string:tokens(Sdt, ":"), + [Nblocks0,Crypto0,RealSecs0] = string:tokens(Sr, ":"), + Crypto = fix_possible_space_bug(Crypto0), + RealSecs = list_to_float(RealSecs0), + BlockSize = list_to_integer(BlockSize0), + Nblocks = list_to_integer(Nblocks0), + get_base_values(T, Crypto, [{BlockSize, 1000000*RealSecs/Nblocks} | Acc]); + +get_base_values([_|T], Crypto, Acc) -> + get_base_values(T, Crypto, Acc); + +get_base_values([], _, Acc) -> + lists:sort(Acc). + +fix_possible_space_bug(S) -> lists:concat(lists:join("-",string:tokens(S,"- "))). + +%%%---------------------------------------------------------------- +mk_bin(Size) when Size =< 256 -> + list_to_binary(lists:seq(0,Size-1)); + +mk_bin(Size) when 1024 =< Size -> + B = mk_bin(Size div 4), + Brest = mk_bin(Size rem 4), + <<B/binary, B/binary, B/binary, B/binary, Brest/binary>>; + +mk_bin(Size) when 256 < Size -> + B = mk_bin(Size div 2), + Brest = mk_bin(Size rem 2), + <<B/binary, B/binary, Brest/binary>>. + diff --git a/lib/erl_interface/configure.in b/lib/erl_interface/configure.in index 46dd995289..14f06f946f 100644 --- a/lib/erl_interface/configure.in +++ b/lib/erl_interface/configure.in @@ -77,6 +77,15 @@ AC_ARG_ENABLE(threads, esac ], [ threads_disabled=maybe ]) +AC_ARG_ENABLE(mask-real-errno, +[ --disable-mask-real-errno do not mask real 'errno'], +[ case "$enableval" in + no) mask_real_errno=no ;; + *) mask_real_errno=yes ;; + esac ], +[ mask_real_errno=yes ]) + + dnl ---------------------------------------------------------------------- dnl Checks for programs dnl ---------------------------------------------------------------------- @@ -95,6 +104,10 @@ AC_CHECK_SIZEOF(long) AC_CHECK_SIZEOF(void *) AC_CHECK_SIZEOF(long long) +if test $mask_real_errno = yes; then + AC_DEFINE(EI_HIDE_REAL_ERRNO, 1, [Define if 'errno' should not be exposed as is in 'erl_errno']) +fi + dnl We set EI_64BIT mode when long is 8 bytes, this makes things dnl work on windows and unix correctly if test $ac_cv_sizeof_long = 8; then @@ -153,7 +166,7 @@ AC_CHECK_LIB([socket], [getpeername]) # Checks for header files. AC_HEADER_STDC AC_HEADER_SYS_WAIT -AC_CHECK_HEADERS([arpa/inet.h fcntl.h limits.h malloc.h netdb.h netinet/in.h stddef.h stdlib.h string.h sys/param.h sys/socket.h sys/select.h sys/time.h unistd.h sys/types.h]) +AC_CHECK_HEADERS([arpa/inet.h fcntl.h limits.h malloc.h netdb.h netinet/in.h stddef.h stdlib.h string.h sys/param.h sys/socket.h sys/select.h sys/time.h unistd.h sys/types.h sys/uio.h]) # Checks for typedefs, structures, and compiler characteristics. # fixme AC_C_CONST & AC_C_VOLATILE needed for Windows? @@ -188,7 +201,7 @@ AC_CHECK_FUNCS([dup2 gethostbyaddr gethostbyname \ gethostbyaddr_r \ gethostbyname_r gethostname writev \ gethrtime gettimeofday inet_ntoa memchr memmove memset select \ - socket strchr strerror strrchr strstr uname]) + socket strchr strerror strrchr strstr uname sysconf]) AC_CHECK_FUNC(res_gethostbyname, [], AC_CHECK_LIB(resolv, res_gethostbyname) ) @@ -250,6 +263,7 @@ AC_SUBST(EI_THREADS) case "$threads_disabled" in no|maybe) LM_CHECK_THR_LIB + ETHR_CHK_GCC_ATOMIC_OPS([]) case "$THR_LIB_NAME" in "") @@ -263,7 +277,7 @@ case "$threads_disabled" in EI_THREADS="true" THR_DEFS="$THR_DEFS -D_WIN32_WINNT=0x0600 -DWINVER=0x0600" ;; - pthread) + pthread) EI_THREADS="true" ;; *) diff --git a/lib/erl_interface/doc/src/ei_connect.xml b/lib/erl_interface/doc/src/ei_connect.xml index 6f16c0652e..e318dd6664 100644 --- a/lib/erl_interface/doc/src/ei_connect.xml +++ b/lib/erl_interface/doc/src/ei_connect.xml @@ -85,6 +85,273 @@ the <c>_tmo</c> suffix.</p> </section> + <section> + <marker id="ussi"/> + <title>User Supplied Socket Implementation</title> + <p>By default <c>ei</c> supplies a TCP/IPv4 socket interface + that is used when communicating. The user can however plug in + his/her own IPv4 socket implementation. This, for example, in order + to communicate over TLS. A user supplied socket implementation + is plugged in by passing a + <seealso marker="#ei_socket_callbacks">callback structure</seealso> + to either + <seealso marker="#ei_connect_init"><c>ei_connect_init_ussi()</c></seealso> + or + <seealso marker="#ei_connect_init"><c>ei_connect_xinit_ussi()</c></seealso>.</p> + + <p>All callbacks in the <c>ei_socket_callbacks</c> structure + <em>should</em> return zero on success; and a posix error + code on failure.</p> + + <p>The <c>addr</c> argument of the <c>listen</c>, <c>accept</c>, + and <c>connect</c> callbacks refer to appropriate address + structure for currently used protocol. Currently <c>ei</c> + only supports IPv4. That is, at this time <c>addr</c> always + points to a <c>struct sockaddr_in</c> structure.</p> + + <p>The <c>ei_socket_callbacks</c> structure may be enlarged in + the future. All fields not set, <em>needs</em> to be zeroed out.</p> + + <marker id="ei_socket_callbacks"/> + <code type="none"><![CDATA[ +typedef struct { + int flags; + int (*socket)(void **ctx, void *setup_ctx); + int (*close)(void *ctx); + int (*listen)(void *ctx, void *addr, int *len, int backlog); + int (*accept)(void **ctx, void *addr, int *len, unsigned tmo); + int (*connect)(void *ctx, void *addr, int len, unsigned tmo); + int (*writev)(void *ctx, const void *iov, int iovcnt, ssize_t *len, unsigned tmo); + int (*write)(void *ctx, const char *buf, ssize_t *len, unsigned tmo); + int (*read)(void *ctx, char *buf, ssize_t *len, unsigned tmo); + int (*handshake_packet_header_size)(void *ctx, int *sz); + int (*connect_handshake_complete)(void *ctx); + int (*accept_handshake_complete)(void *ctx); + int (*get_fd)(void *ctx, int *fd); +} ei_socket_callbacks; + ]]></code> + + <taglist> + + <tag><c>flags</c></tag> + <item> + <p>Flags informing <c>ei</c> about the behaviour of the + callbacks. Flags should be bitwise or:ed together. If no flag, + is set, the <c>flags</c> field should contain <c>0</c>. Currently, + supported flags:</p> + <taglist> + <tag><c>EI_SCLBK_FLG_FULL_IMPL</c></tag> + <item> + <p> + If set, the <c>accept()</c>, <c>connect()</c>, + <c>writev()</c>, <c>write()</c>, and <c>read()</c> callbacks + implements timeouts. The timeout is passed in the <c>tmo</c> + argument and is given in milli seconds. Note that the + <c>tmo</c> argument to these callbacks differ from the + timeout arguments in the <c>ei</c> API. Zero means a zero + timeout. That is, poll and timeout immediately unless the + operation is successful. <c>EI_SCLBK_INF_TMO</c> + (max <c>unsigned</c>) means infinite timeout. The file + descriptor is in blocking mode when a callback is called, + and it must be in blocking mode when the callback returns. + </p> + <p> + If not set, <c>ei</c> will implement the timeout using + <c>select()</c> in order to determine when to call the + callbacks and when to time out. The <c>tmo</c> arguments + of the <c>accept()</c>, <c>connect()</c>, <c>writev()</c>, + <c>write()</c>, and <c>read()</c> callbacks should be + ignored. The callbacks may be called in non-blocking mode. + The callbacks are not allowed to change between blocking + and non-blocking mode. In order for this to work, + <c>select()</c> needs to interact with the socket primitives + used the same way as it interacts with the ordinary socket + primitives. If this is not the case, the callbacks + <em>need</em> to implement timeouts and this flag should + be set. + </p> + </item> + </taglist> + <p>More flags may be introduced in the future.</p> + </item> + + <tag><c>int (*socket)(void **ctx, void *setup_ctx)</c></tag> + <item> + <p>Create a socket and a context for the socket.</p> + + <p>On success it should set <c>*ctx</c> to point to a context for + the created socket. This context will be passed to all other + socket callbacks. This function will be passed the same + <c>setup_context</c> as passed to the preceeding + <seealso marker="#ei_connect_init"><c>ei_connect_init_ussi()</c></seealso> + or + <seealso marker="#ei_connect_init"><c>ei_connect_xinit_ussi()</c></seealso> + call.</p> + + <note><p>During the lifetime of a socket, the pointer <c>*ctx</c> + <em>has</em> to remain the same. That is, it cannot later be + relocated.</p></note> + + <p>This callback is mandatory.</p> + </item> + + <tag><c>int (*close)(void *ctx)</c></tag> + <item> + <p>Close the socket identified by <c>ctx</c> and destroy the context.</p> + + <p>This callback is mandatory.</p> + </item> + + <tag><c>int (*listen)(void *ctx, void *addr, int *len, int backlog)</c></tag> + <item> + <p>Bind the socket identified by <c>ctx</c> to a local interface + and then listen on it.</p> + + <p>The <c>addr</c> and <c>len</c> arguments are both input and output + arguments. When called <c>addr</c> points to an address structure of + lenght <c>*len</c> containing information on how to bind the socket. + Uppon return this callback should have updated the structure referred + by <c>addr</c> with information on how the socket actually was bound. + <c>*len</c> should be updated to reflect the size of <c>*addr</c> + updated. <c>backlog</c> identifies the size of the backlog for the + listen socket.</p> + + <p>This callback is mandatory.</p> + </item> + + <tag><c>int (*accept)(void **ctx, void *addr, int *len, unsigned tmo)</c></tag> + <item> + <p>Accept connections on the listen socket identified by + <c>*ctx</c>.</p> + + <p>When a connection is accepted, a new context for the accepted + connection should be created and <c>*ctx</c> should be updated + to point to the new context for the accepted connection. When + called <c>addr</c> points to an uninitialized address structure + of lenght <c>*len</c>. Uppon return this callback should have + updated this structure with information about the client address. + <c>*len</c> should be updated to reflect the size of <c>*addr</c> + updated. + </p> + + <p>If the <c>EI_SCLBK_FLG_FULL_IMPL</c> flag has been set, + <c>tmo</c> contains timeout time in milliseconds.</p> + + <note><p>During the lifetime of a socket, the pointer <c>*ctx</c> + <em>has</em> to remain the same. That is, it cannot later be + relocated.</p></note> + + <p>This callback is mandatory.</p> + </item> + + <tag><c>int (*connect)(void *ctx, void *addr, int len, unsigned tmo)</c></tag> + <item> + <p>Connect the socket identified by <c>ctx</c> to the address + identified by <c>addr</c>.</p> + + <p>When called <c>addr</c> points to an address structure of + lenght <c>len</c> containing information on where to connect.</p> + + <p>If the <c>EI_SCLBK_FLG_FULL_IMPL</c> flag has been set, + <c>tmo</c> contains timeout time in milliseconds.</p> + + <p>This callback is mandatory.</p> + </item> + + <tag><c>int (*writev)(void *ctx, const void *iov, long iovcnt, ssize_t *len, unsigned tmo)</c></tag> + <item> + <p>Write data on the connected socket identified by <c>ctx</c>.</p> + + <p><c>iov</c> points to an array of <c>struct iovec</c> structures of + length <c>iovcnt</c> containing data to write to the socket. On success, + this callback should set <c>*len</c> to the amount of bytes successfully + written on the socket.</p> + + <p>If the <c>EI_SCLBK_FLG_FULL_IMPL</c> flag has been set, + <c>tmo</c> contains timeout time in milliseconds.</p> + + <p>This callback is optional. Set the <c>writev</c> field + in the the <c>ei_socket_callbacks</c> structure to <c>NULL</c> if not + implemented.</p> + </item> + + <tag><c>int (*write)(void *ctx, const char *buf, ssize_t *len, unsigned tmo)</c></tag> + <item> + <p>Write data on the connected socket identified by <c>ctx</c>.</p> + + <p>When called <c>buf</c> points to a buffer of length <c>*len</c> + containing the data to write on the socket. On success, this callback + should set <c>*len</c> to the amount of bytes successfully written on + the socket.</p> + + <p>If the <c>EI_SCLBK_FLG_FULL_IMPL</c> flag has been set, + <c>tmo</c> contains timeout time in milliseconds.</p> + + <p>This callback is mandatory.</p> + </item> + + <tag><c>int (*read)(void *ctx, char *buf, ssize_t *len, unsigned tmo)</c></tag> + <item> + <p>Read data on the connected socket identified by <c>ctx</c>.</p> + + <p><c>buf</c> points to a buffer of length <c>*len</c> where the + read data should be placed. On success, this callback should update + <c>*len</c> to the amount of bytes successfully read on the socket.</p> + + <p>If the <c>EI_SCLBK_FLG_FULL_IMPL</c> flag has been set, + <c>tmo</c> contains timeout time in milliseconds.</p> + + <p>This callback is mandatory.</p> + </item> + + <tag><c>int (*handshake_packet_header_size)(void *ctx, int *sz)</c></tag> + <item> + <p>Inform about handshake packet header size to use during the Erlang + distribution handshake.</p> + + <p>On success, <c>*sz</c> should be set to the handshake packet header + size to use. Valid values are <c>2</c> and <c>4</c>. Erlang TCP + distribution use a handshake packet size of <c>2</c> and Erlang TLS + distribution use a handshake packet size of <c>4</c>.</p> + + <p>This callback is mandatory.</p> + </item> + + <tag><c>int (*connect_handshake_complete)(void *ctx)</c></tag> + <item> + <p>Called when a locally started handshake has completed successfully.</p> + + <p>This callback is optional. Set the <c>connect_handshake_complete</c> field + in the <c>ei_socket_callbacks</c> structure to <c>NULL</c> if not implemented.</p> + </item> + + <tag><c>int (*accept_handshake_complete)(void *ctx)</c></tag> + <item> + <p>Called when a remotely started handshake has completed successfully.</p> + + <p>This callback is optional. Set the <c>accept_handshake_complete</c> field in + the <c>ei_socket_callbacks</c> structure to <c>NULL</c> if not implemented.</p> + </item> + + <tag><c>int (*get_fd)(void *ctx, int *fd)</c></tag> + <item> + <p>Inform about file descriptor used by the socket which is identified + by <c>ctx</c>.</p> + + <note><p>During the lifetime of a socket, the file descriptor + <em>has</em> to remain the same. That is, repeated calls to this + callback with the same context <c>should</c> always report the same + file descriptor.</p> + <p>The file descriptor <em>has</em> to be a real file descriptor. + That is, no other operation should be able to get the same file + descriptor until it has been released by the <c>close()</c> + callback.</p> + </note> + + <p>This callback is mandatory.</p> + </item> + </taglist> + </section> <funcs> <func> <name since=""><ret>struct hostent *</ret><nametext>ei_gethostbyaddr(const char *addr, int len, int type)</nametext></name> @@ -96,6 +363,7 @@ <p>Convenience functions for some common name lookup functions.</p> </desc> </func> + <func> <name since=""><ret>int</ret><nametext>ei_accept(ei_cnode *ec, int listensock, ErlConnect *conp)</nametext></name> @@ -141,6 +409,14 @@ typedef struct { </func> <func> + <name since="OTP @OTP-15442@"><ret>int</ret><nametext>ei_close_connection(int fd)</nametext></name> + <fsummary>Close a connection.</fsummary> + <desc> + <p>Closes a previously opened connection or listen socket.</p> + </desc> + </func> + + <func> <name since=""><ret>int</ret><nametext>ei_connect(ei_cnode* ec, char *nodename)</nametext></name> <name since=""><ret>int</ret><nametext>ei_xconnect(ei_cnode* ec, Erl_IpAddr adr, char *alivename)</nametext></name> <fsummary>Establish a connection to an Erlang node.</fsummary> @@ -193,7 +469,9 @@ fd = ei_xconnect(&ec, &addr, ALIVE); <func> <name since=""><ret>int</ret><nametext>ei_connect_init(ei_cnode* ec, const char* this_node_name, const char *cookie, short creation)</nametext></name> + <name since="OTP @OTP-15442@"><ret>int</ret><nametext>ei_connect_init_ussi(ei_cnode* ec, const char* this_node_name, const char *cookie, short creation, ei_socket_callbacks *cbs, int cbs_sz, void *setup_context)</nametext></name> <name since=""><ret>int</ret><nametext>ei_connect_xinit(ei_cnode* ec, const char *thishostname, const char *thisalivename, const char *thisnodename, Erl_IpAddr thisipaddr, const char *cookie, short creation)</nametext></name> + <name since="OTP @OTP-15442@"><ret>int</ret><nametext>ei_connect_xinit_ussi(ei_cnode* ec, const char *thishostname, const char *thisalivename, const char *thisnodename, Erl_IpAddr thisipaddr, const char *cookie, short creation, ei_socket_callbacks *cbs, int cbs_sz, void *setup_context)</nametext></name> <fsummary>Initialize for a connection.</fsummary> <desc> <p>Initializes the <c>ec</c> structure, to @@ -236,6 +514,21 @@ fd = ei_xconnect(&ec, &addr, ALIVE); <item> <p><c>thispaddr</c> if the IP address of the host.</p> </item> + <item> + <p><c>cbs</c> is a pointer to a + <seealso marker="#ei_socket_callbacks">callback structure</seealso> + implementing and alternative socket interface.</p> + </item> + <item> + <p><c>cbs_sz</c> is the size of the structure + pointed to by <c>cbs</c>.</p> + </item> + <item> + <p><c>setup_context</c> is a pointer to a structure that + will be passed as second argument to the <c>socket</c> callback + in the <c>cbs</c> structure.</p> + </item> + </list> <p>A C-node acting as a server is assigned a creation number when it calls <c>ei_publish()</c>.</p> @@ -299,6 +592,45 @@ if (ei_connect_init(&ec, "madonna", "cookie...", n++) < 0) { </func> <func> + <name since="OTP @OTP-15442@"><ret>int</ret><nametext>ei_listen(ei_cnode *ec, int *port, int backlog)</nametext></name> + <name since="OTP @OTP-15442@"><ret>int</ret><nametext>ei_xlisten(ei_cnode *ec, Erl_IpAddr adr, int *port, int backlog)</nametext></name> + <fsummary>Create a listen socket.</fsummary> + <desc> + <p>Used by a server process to setup a listen socket which + later can be used for accepting connections from client processes. + </p> + <list type="bulleted"> + <item> + <p><c>ec</c> is the C-node structure.</p> + </item> + <item> + <p><c>adr</c> is local interface to bind to.</p> + </item> + <item> + <p><c>port</c> is a pointer to an integer containing the + port number to bind to. If <c>*port</c> equals <c>0</c> + when calling <c>ei_listen()</c>, the socket will be bound to + an ephemeral port. On success, <c>ei_listen()</c> will update + the value of <c>*port</c> to the port actually bound to. + </p> + </item> + <item> + <p><c>backlog</c> is maximum backlog of pending connections.</p> + </item> + </list> + <p><c>ei_listen</c> will create a socket, bind to a port on the + local interface identified by <c>adr</c> (or all local interfaces if + <c>ei_listen()</c> is called), and mark the socket as a passive socket + (that is, a socket that will be used for accepting incoming connections). + </p> + <p> + On success, a file descriptor is returned which can be used in a call to + <c>ei_accept()</c>. On failure, <c>ERL_ERROR</c> is returned and + <c>erl_errno</c> is set to <c>EIO</c>.</p> + </desc> + </func> + + <func> <name since=""><ret>int</ret><nametext>ei_publish(ei_cnode *ec, int port)</nametext></name> <fsummary>Publish a node name.</fsummary> <desc> diff --git a/lib/erl_interface/include/ei.h b/lib/erl_interface/include/ei.h index 948f89be85..92674571e2 100644 --- a/lib/erl_interface/include/ei.h +++ b/lib/erl_interface/include/ei.h @@ -35,6 +35,7 @@ #include <winsock2.h> #include <windows.h> #include <winbase.h> +typedef LONG_PTR ssize_t; /* Sigh... */ #endif #include <stdio.h> /* Need type FILE */ @@ -286,6 +287,31 @@ typedef struct { char nodename[MAXNODELEN+1]; } ErlConnect; +#define EI_SCLBK_INF_TMO (~((unsigned) 0)) + +#define EI_SCLBK_FLG_FULL_IMPL (1 << 0) + +typedef struct { + int flags; + + int (*socket)(void **ctx, void *setup_ctx); + int (*close)(void *ctx); + int (*listen)(void *ctx, void *addr, int *len, int backlog); + int (*accept)(void **ctx, void *addr, int *len, unsigned tmo); + int (*connect)(void *ctx, void *addr, int len, unsigned tmo); + int (*writev)(void *ctx, const void *iov, int iovcnt, ssize_t *len, unsigned tmo); + int (*write)(void *ctx, const char *buf, ssize_t *len, unsigned tmo); + int (*read)(void *ctx, char *buf, ssize_t *len, unsigned tmo); + + int (*handshake_packet_header_size)(void *ctx, int *sz); + int (*connect_handshake_complete)(void *ctx); + int (*accept_handshake_complete)(void *ctx); + int (*get_fd)(void *ctx, int *fd); + + /* end of version 1 */ + +} ei_socket_callbacks; + typedef struct ei_cnode_s { char thishostname[EI_MAXHOSTNAMELEN+1]; char thisnodename[MAXNODELEN+1]; @@ -295,6 +321,8 @@ typedef struct ei_cnode_s { char ei_connect_cookie[EI_MAX_COOKIE_SIZE+1]; short creation; erlang_pid self; + ei_socket_callbacks *cbs; + void *setup_context; } ei_cnode; typedef struct in_addr *Erl_IpAddr; @@ -308,7 +336,6 @@ typedef struct ei_x_buff_TAG { int index; } ei_x_buff; - /* -------------------------------------------------------------------- */ /* Function definitions (listed in same order as documentation) */ /* -------------------------------------------------------------------- */ @@ -322,6 +349,16 @@ int ei_connect_xinit (ei_cnode* ec, const char *thishostname, Erl_IpAddr thisipaddr, const char *cookie, const short creation); +int ei_connect_init_ussi(ei_cnode* ec, const char* this_node_name, + const char *cookie, short creation, + ei_socket_callbacks *cbs, int cbs_sz, + void *setup_context); +int ei_connect_xinit_ussi(ei_cnode* ec, const char *thishostname, + const char *thisalivename, const char *thisnodename, + Erl_IpAddr thisipaddr, const char *cookie, + const short creation, ei_socket_callbacks *cbs, + int cbs_sz, void *setup_context); + int ei_connect(ei_cnode* ec, char *nodename); int ei_connect_tmo(ei_cnode* ec, char *nodename, unsigned ms); int ei_xconnect(ei_cnode* ec, Erl_IpAddr adr, char *alivename); @@ -348,11 +385,15 @@ int ei_rpc_from(ei_cnode* ec, int fd, int timeout, erlang_msg* msg, int ei_publish(ei_cnode* ec, int port); int ei_publish_tmo(ei_cnode* ec, int port, unsigned ms); +int ei_listen(ei_cnode *ec, int *port, int backlog); +int ei_xlisten(ei_cnode *ec, Erl_IpAddr adr, int *port, int backlog); int ei_accept(ei_cnode* ec, int lfd, ErlConnect *conp); int ei_accept_tmo(ei_cnode* ec, int lfd, ErlConnect *conp, unsigned ms); int ei_unpublish(ei_cnode* ec); int ei_unpublish_tmo(const char *alive, unsigned ms); +int ei_close_connection(int fd); + const char *ei_thisnodename(const ei_cnode* ec); const char *ei_thishostname(const ei_cnode* ec); const char *ei_thisalivename(const ei_cnode* ec); diff --git a/lib/erl_interface/src/Makefile.in b/lib/erl_interface/src/Makefile.in index 614e7325a9..24ead76afb 100644 --- a/lib/erl_interface/src/Makefile.in +++ b/lib/erl_interface/src/Makefile.in @@ -31,12 +31,11 @@ .PHONY : debug opt release clean distclean depend -TARGET = @TARGET@ - # ---------------------------------------------------- # Application version and release dir specification # ---------------------------------------------------- include ../vsn.mk +include $(ERL_TOP)/make/target.mk include $(TARGET)/eidefs.mk include $(ERL_TOP)/make/output.mk diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index 9df4fa3b6c..1132c9fc23 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -21,8 +21,6 @@ * Purpose: Connect to any node at any host. (EI version) */ -#include "eidef.h" - #include <stdlib.h> #include <sys/types.h> #include <fcntl.h> @@ -84,7 +82,9 @@ #include <string.h> #include <errno.h> #include <ctype.h> +#include <stddef.h> +#include "eidef.h" #include "eiext.h" #include "ei_portio.h" #include "ei_internal.h" @@ -103,6 +103,10 @@ int ei_tracelevel = 0; #define COOKIE_FILE "/.erlang.cookie" #define EI_MAX_HOME_PATH 1024 +#define EI_SOCKET_CALLBACKS_SZ_V1 \ + (offsetof(ei_socket_callbacks, get_fd) \ + + sizeof(int (*)(void *))) + /* FIXME why not macro? */ static char *null_cookie = ""; @@ -113,35 +117,51 @@ static int get_home(char *buf, int size); static unsigned gen_challenge(void); static void gen_digest(unsigned challenge, char cookie[], unsigned char digest[16]); -static int send_status(int fd, char *status, unsigned ms); -static int recv_status(int fd, unsigned ms); -static int send_challenge(int fd, char *nodename, - unsigned challenge, unsigned version, unsigned ms); -static int recv_challenge(int fd, unsigned *challenge, - unsigned *version, - unsigned *flags, ErlConnect *namebuf, unsigned ms); -static int send_challenge_reply(int fd, unsigned char digest[16], +static int send_status(ei_socket_callbacks *cbs, void *ctx, + int pkt_sz, char *status, unsigned ms); +static int recv_status(ei_socket_callbacks *cbs, void *ctx, + int pkt_sz, unsigned ms); +static int send_challenge(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, + char *nodename, unsigned challenge, + unsigned version, unsigned ms); +static int recv_challenge(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, + unsigned *challenge, unsigned *version, + unsigned *flags, char *namebuf, unsigned ms); +static int send_challenge_reply(ei_socket_callbacks *cbs, void *ctx, + int pkt_sz, unsigned char digest[16], unsigned challenge, unsigned ms); -static int recv_challenge_reply(int fd, - unsigned our_challenge, +static int recv_challenge_reply(ei_socket_callbacks *cbs, void *ctx, + int pkt_sz, unsigned our_challenge, char cookie[], unsigned *her_challenge, unsigned ms); -static int send_challenge_ack(int fd, unsigned char digest[16], unsigned ms); -static int recv_challenge_ack(int fd, - unsigned our_challenge, +static int send_challenge_ack(ei_socket_callbacks *cbs, void *ctx, + int pkt_sz, unsigned char digest[16], + unsigned ms); +static int recv_challenge_ack(ei_socket_callbacks *cbs, void *ctx, + int pkt_sz, unsigned our_challenge, char cookie[], unsigned ms); -static int send_name(int fd, char *nodename, - unsigned version, unsigned ms); +static int send_name(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, + char *nodename, unsigned version, unsigned ms); -/* Common for both handshake types */ -static int recv_name(int fd, - unsigned *version, - unsigned *flags, ErlConnect *namebuf, unsigned ms); +static int recv_name(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, + unsigned *version, unsigned *flags, char *namebuf, + unsigned ms); static struct hostent* dyn_gethostbyname_r(const char *name, struct hostent *hostp, char **buffer_p, int buflen, int *h_errnop); +static void abort_connection(ei_socket_callbacks *cbs, void *ctx); +static int close_connection(ei_socket_callbacks *cbs, void *ctx, int fd); + +static char * +estr(int e) +{ + char *str = strerror(e); + if (!str) + return "unknown error"; + return str; +} /*************************************************************************** @@ -154,25 +174,206 @@ dyn_gethostbyname_r(const char *name, struct hostent *hostp, char **buffer_p, typedef struct ei_socket_info_s { int socket; + ei_socket_callbacks *cbs; + void *ctx; int dist_version; ei_cnode cnode; /* A copy, not a pointer. We don't know when freed */ char cookie[EI_MAX_COOKIE_SIZE+1]; } ei_socket_info; +/*************************************************************************** + * + * XXX + * + ***************************************************************************/ + +#ifndef ETHR_HAVE___atomic_compare_exchange_n +# define ETHR_HAVE___atomic_compare_exchange_n 0 +#endif +#ifndef ETHR_HAVE___atomic_load_n +# define ETHR_HAVE___atomic_load_n 0 +#endif +#ifndef ETHR_HAVE___atomic_store_n +# define ETHR_HAVE___atomic_store_n 0 +#endif + +#if defined(_REENTRANT) \ + && (!(ETHR_HAVE___atomic_compare_exchange_n & SIZEOF_VOID_P) \ + || !(ETHR_HAVE___atomic_load_n & SIZEOF_VOID_P) \ + || !(ETHR_HAVE___atomic_store_n & SIZEOF_VOID_P)) +# undef EI_DISABLE_SEQ_SOCKET_INFO +# define EI_DISABLE_SEQ_SOCKET_INFO +#endif + +#ifdef __WIN32__ +# undef EI_DISABLE_SEQ_SOCKET_INFO +# define EI_DISABLE_SEQ_SOCKET_INFO +#endif + +#ifndef EI_DISABLE_SEQ_SOCKET_INFO + +#ifdef _REENTRANT + +#define EI_ATOMIC_CMPXCHG_ACQ_REL(VARP, XCHGP, NEW) \ + __atomic_compare_exchange_n((VARP), (XCHGP), (NEW), 0, \ + __ATOMIC_ACQ_REL, __ATOMIC_ACQUIRE) +#define EI_ATOMIC_LOAD_ACQ(VARP) \ + __atomic_load_n((VARP), __ATOMIC_ACQUIRE) +#define EI_ATOMIC_STORE_REL(VARP, NEW) \ + __atomic_store_n((VARP), (NEW), __ATOMIC_RELEASE) + +#else /* ! _REENTRANT */ + +#define EI_ATOMIC_CMPXCHG_ACQ_REL(VARP, XCHGP, NEW) \ + (*(VARP) == *(XCHGP) \ + ? ((*(VARP) = (NEW)), !0) \ + : ((*(XCHGP) = *(VARP)), 0)) +#define EI_ATOMIC_LOAD_ACQ(VARP) (*(VARP)) +#define EI_ATOMIC_STORE_REL(VARP, NEW) (*(VARP) = (NEW)) + +#endif /* ! _REENTRANT */ + +#define EI_SOCKET_INFO_SEG_BITS 5 +#define EI_SOCKET_INFO_SEG_SIZE (1 << EI_SOCKET_INFO_SEG_BITS) +#define EI_SOCKET_INFO_SEG_MASK (EI_SOCKET_INFO_SEG_SIZE - 1) + +typedef struct { + int max_fds; + ei_socket_info *segments[1]; /* Larger in reality... */ +} ei_socket_info_data__; + +static ei_socket_info_data__ *socket_info_data = NULL; + +static int init_socket_info(void) +{ + int max_fds; + int i; + size_t segments_len; + ei_socket_info_data__ *info_data, *xchg; + + if (EI_ATOMIC_LOAD_ACQ(&socket_info_data) != NULL) + return !0; /* Already initialized... */ + +#if defined(HAVE_SYSCONF) && defined(_SC_OPEN_MAX) + max_fds = sysconf(_SC_OPEN_MAX); +#else + max_fds = 1024; +#endif + + if (max_fds < 0) + return 0; + + segments_len = ((max_fds-1)/EI_SOCKET_INFO_SEG_SIZE + 1); + + info_data = malloc(sizeof(ei_socket_info_data__) + + (sizeof(ei_socket_info *)*(segments_len-1))); + if (!info_data) + return 0; + + info_data->max_fds = max_fds; + for (i = 0; i < segments_len; i++) + info_data->segments[i] = NULL; + + xchg = NULL; + if (!EI_ATOMIC_CMPXCHG_ACQ_REL(&socket_info_data, &xchg, info_data)) + free(info_data); /* Already initialized... */ + + return !0; +} + +static int put_ei_socket_info(int fd, int dist_version, char* cookie, ei_cnode *ec, + ei_socket_callbacks *cbs, void *ctx) +{ + int six; + ei_socket_info *seg, *si; + int socket; + + if (fd < 0 || socket_info_data->max_fds <= fd) + return -1; + + socket = fd; + six = fd >> EI_SOCKET_INFO_SEG_BITS; + seg = EI_ATOMIC_LOAD_ACQ(&socket_info_data->segments[six]); + + if (!seg) { + ei_socket_info *xchg; + int i; + seg = malloc(sizeof(ei_socket_info)*EI_SOCKET_INFO_SEG_SIZE); + if (!seg) + return -1; + for (i = 0; i < EI_SOCKET_INFO_SEG_SIZE; i++) { + seg[i].socket = -1; + } + + xchg = NULL; + if (!EI_ATOMIC_CMPXCHG_ACQ_REL(&socket_info_data->segments[six], &xchg, seg)) { + free(seg); + seg = xchg; + } + } + + si = &seg[fd & EI_SOCKET_INFO_SEG_MASK]; + + if (dist_version < 0) { + socket = -1; + si->cbs = NULL; + si->ctx = NULL; + } + else { + si->dist_version = dist_version; + si->cnode = *ec; + si->cbs = cbs; + si->ctx = ctx; + strcpy(si->cookie, cookie); + } + + EI_ATOMIC_STORE_REL(&si->socket, socket); + + return 0; +} + +static ei_socket_info* get_ei_socket_info(int fd) +{ + int six, socket; + ei_socket_info *seg, *si; + + if (fd < 0 || socket_info_data->max_fds <= fd) + return NULL; + + six = fd >> EI_SOCKET_INFO_SEG_BITS; + seg = EI_ATOMIC_LOAD_ACQ(&socket_info_data->segments[six]); + + if (!seg) + return NULL; + + si = &seg[fd & EI_SOCKET_INFO_SEG_MASK]; + socket = EI_ATOMIC_LOAD_ACQ(&si->socket); + if (socket != fd) + return NULL; + return si; +} + +#else /* EI_DISABLE_SEQ_SOCKET_INFO */ + int ei_n_sockets = 0, ei_sz_sockets = 0; ei_socket_info *ei_sockets = NULL; + #ifdef _REENTRANT ei_mutex_t* ei_sockets_lock = NULL; #endif /* _REENTRANT */ +static int init_socket_info(void) +{ +#ifdef _REENTRANT + if (ei_sockets_lock == NULL) { + ei_sockets_lock = ei_mutex_create(); + } +#endif /* _REENTRANT */ + return !0; +} -/*************************************************************************** - * - * XXX - * - ***************************************************************************/ - -static int put_ei_socket_info(int fd, int dist_version, char* cookie, ei_cnode *ec) +static int put_ei_socket_info(int fd, int dist_version, char* cookie, ei_cnode *ec, + ei_socket_callbacks *cbs, void *ctx) { int i; @@ -182,11 +383,13 @@ static int put_ei_socket_info(int fd, int dist_version, char* cookie, ei_cnode * for (i = 0; i < ei_n_sockets; ++i) { if (ei_sockets[i].socket == fd) { if (dist_version == -1) { - memmove(&ei_sockets[i], &ei_sockets[i+1], + memmove(&ei_sockets[i], &ei_sockets[i+1], sizeof(ei_sockets[0])*(ei_n_sockets-i-1)); } else { ei_sockets[i].dist_version = dist_version; /* Copy the content, see ei_socket_info */ + ei_sockets[i].cbs = cbs; + ei_sockets[i].ctx = ctx; ei_sockets[i].cnode = *ec; strcpy(ei_sockets[i].cookie, cookie); } @@ -209,7 +412,9 @@ static int put_ei_socket_info(int fd, int dist_version, char* cookie, ei_cnode * } ei_sockets[ei_n_sockets].socket = fd; ei_sockets[ei_n_sockets].dist_version = dist_version; - ei_sockets[i].cnode = *ec; + ei_sockets[ei_n_sockets].cnode = *ec; + ei_sockets[ei_n_sockets].cbs = cbs; + ei_sockets[ei_n_sockets].ctx = ctx; strcpy(ei_sockets[ei_n_sockets].cookie, cookie); ++ei_n_sockets; } @@ -219,14 +424,6 @@ static int put_ei_socket_info(int fd, int dist_version, char* cookie, ei_cnode * return 0; } -#if 0 -/* FIXME not used ?! */ -static int remove_ei_socket_info(int fd, int dist_version, char* cookie) -{ - return put_ei_socket_info(fd, -1, NULL); -} -#endif - static ei_socket_info* get_ei_socket_info(int fd) { int i; @@ -248,6 +445,13 @@ static ei_socket_info* get_ei_socket_info(int fd) return NULL; } +#endif /* EI_DISABLE_SEQ_SOCKET_INFO */ + +static int remove_ei_socket_info(int fd) +{ + return put_ei_socket_info(fd, -1, NULL, NULL, NULL, NULL); +} + ei_cnode *ei_fd_to_cnode(int fd) { ei_socket_info *sockinfo = get_ei_socket_info(fd); @@ -255,6 +459,19 @@ ei_cnode *ei_fd_to_cnode(int fd) return &sockinfo->cnode; } +int ei_get_cbs_ctx__(ei_socket_callbacks **cbs, void **ctx, int fd) +{ + ei_socket_info *sockinfo = get_ei_socket_info(fd); + if (sockinfo) { + *cbs = sockinfo->cbs; + *ctx = sockinfo->ctx; + return 0; + } + + *cbs = NULL; + *ctx = NULL; + return EBADF; +} /*************************************************************************** * Get/Set tracelevel @@ -333,21 +550,6 @@ const char *ei_getfdcookie(int fd) return r; } -/* call with cookie to set value to use on descriptor fd, -* or specify NULL to use default -*/ -/* FIXME why defined but not used? */ -#if 0 -static int ei_setfdcookie(ei_cnode* ec, int fd, char *cookie) -{ - int dist_version = ei_distversion(fd); - - if (cookie == NULL) - cookie = ec->ei_connect_cookie; - return put_ei_socket_info(fd, dist_version, cookie); -} -#endif - static int get_int32(unsigned char *s) { return ((s[0] << 24) | (s[1] << 16) | (s[2] << 8) | (s[3] )); @@ -405,12 +607,16 @@ static int initWinSock(void) * Initailize by setting: * thishostname, thisalivename, thisnodename and thisipaddr */ -int ei_connect_xinit(ei_cnode* ec, const char *thishostname, - const char *thisalivename, const char *thisnodename, - Erl_IpAddr thisipaddr, const char *cookie, - const short creation) +int ei_connect_xinit_ussi(ei_cnode* ec, const char *thishostname, + const char *thisalivename, const char *thisnodename, + Erl_IpAddr thisipaddr, const char *cookie, + const short creation, ei_socket_callbacks *cbs, + int cbs_sz, void *setup_context) { char *dbglevel; + + if (cbs != &ei_default_socket_callbacks) + EI_SET_HAVE_PLUGIN_SOCKET_IMPL__; /* FIXME this code was enabled for 'erl'_connect_xinit(), why not here? */ #if 0 @@ -422,12 +628,16 @@ int ei_connect_xinit(ei_cnode* ec, const char *thishostname, #endif #endif -#ifdef _REENTRANT - if (ei_sockets_lock == NULL) { - ei_sockets_lock = ei_mutex_create(); + if (!init_socket_info()) { + EI_TRACE_ERR0("ei_connect_xinit","can't initiate socket info"); + return ERL_ERROR; } -#endif /* _REENTRANT */ + if (cbs_sz < EI_SOCKET_CALLBACKS_SZ_V1) { + EI_TRACE_ERR0("ei_connect_xinit","invalid size of ei_socket_callbacks struct"); + return ERL_ERROR; + } + ec->creation = creation & 0x3; /* 2 bits */ if (cookie) { @@ -469,6 +679,9 @@ int ei_connect_xinit(ei_cnode* ec, const char *thishostname, ec->self.serial = 0; ec->self.creation = creation & 0x3; /* 2 bits */ + ec->cbs = cbs; + ec->setup_context = setup_context; + if ((dbglevel = getenv("EI_TRACELEVEL")) != NULL || (dbglevel = getenv("ERL_DEBUG_DIST")) != NULL) ei_tracelevel = atoi(dbglevel); @@ -476,14 +689,27 @@ int ei_connect_xinit(ei_cnode* ec, const char *thishostname, return 0; } +int ei_connect_xinit(ei_cnode* ec, const char *thishostname, + const char *thisalivename, const char *thisnodename, + Erl_IpAddr thisipaddr, const char *cookie, + const short creation) +{ + return ei_connect_xinit_ussi(ec, thishostname, thisalivename, thisnodename, + thisipaddr, cookie, creation, + &ei_default_socket_callbacks, + sizeof(ei_default_socket_callbacks), + NULL); +} /* * Initialize by set: thishostname, thisalivename, * thisnodename and thisipaddr. At success return 0, * otherwise return -1. */ -int ei_connect_init(ei_cnode* ec, const char* this_node_name, - const char *cookie, short creation) +int ei_connect_init_ussi(ei_cnode* ec, const char* this_node_name, + const char *cookie, short creation, + ei_socket_callbacks *cbs, int cbs_sz, + void *setup_context) { char thishostname[EI_MAXHOSTNAMELEN+1]; char thisnodename[MAXNODELEN+1]; @@ -500,12 +726,7 @@ int ei_connect_init(ei_cnode* ec, const char* this_node_name, return ERL_ERROR; } #endif /* win32 */ -#ifdef _REENTRANT - if (ei_sockets_lock == NULL) { - ei_sockets_lock = ei_mutex_create(); - } -#endif /* _REENTRANT */ - + /* gethostname requires len to be max(hostname) + 1 */ if (gethostname(thishostname, EI_MAXHOSTNAMELEN+1) == -1) { #ifdef __WIN32__ @@ -561,43 +782,22 @@ int ei_connect_init(ei_cnode* ec, const char* this_node_name, sprintf(thisnodename, "%s@%s", this_node_name, hp->h_name); } } - res = ei_connect_xinit(ec, thishostname, thisalivename, thisnodename, - (struct in_addr *)*hp->h_addr_list, cookie, creation); + res = ei_connect_xinit_ussi(ec, thishostname, thisalivename, thisnodename, + (struct in_addr *)*hp->h_addr_list, cookie, creation, + cbs, cbs_sz, setup_context); if (buf != buffer) free(buf); return res; } - -/* connects to port at ip-address ip_addr -* and returns fd to socket -* port has to be in host byte order -*/ -static int cnct(uint16 port, struct in_addr *ip_addr, int addr_len, unsigned ms) +int ei_connect_init(ei_cnode* ec, const char* this_node_name, + const char *cookie, short creation) { - int s, res; - struct sockaddr_in iserv_addr; - - if ((s = socket(AF_INET, SOCK_STREAM, 0)) < 0) { - erl_errno = errno; - return ERL_ERROR; - } - - memset((char*)&iserv_addr, 0, sizeof(struct sockaddr_in)); - memcpy((char*)&iserv_addr.sin_addr, (char*)ip_addr, addr_len); - iserv_addr.sin_family = AF_INET; - iserv_addr.sin_port = htons(port); - - if ((res = ei_connect_t(s, (struct sockaddr*)&iserv_addr, - sizeof(iserv_addr),ms)) < 0) { - erl_errno = (res == -2) ? ETIMEDOUT : EIO; - closesocket(s); - return ERL_ERROR; - } - - return s; -} /* cnct */ - + return ei_connect_init_ussi(ec, this_node_name, cookie, creation, + &ei_default_socket_callbacks, + sizeof(ei_default_socket_callbacks), + NULL); +} /* * Same as ei_gethostbyname_r, but also handles ERANGE error @@ -758,91 +958,218 @@ int ei_connect(ei_cnode* ec, char *nodename) * the node through epmd at that host * */ -int ei_xconnect_tmo(ei_cnode* ec, Erl_IpAddr adr, char *alivename, unsigned ms) +int ei_xconnect_tmo(ei_cnode* ec, Erl_IpAddr ip_addr, char *alivename, unsigned ms) { - struct in_addr *ip_addr=(struct in_addr *) adr; + ei_socket_callbacks *cbs = ec->cbs; + void *ctx; int rport = 0; /*uint16 rport = 0;*/ int sockd; - int one = 1; int dist = 0; - ErlConnect her_name; unsigned her_flags, her_version; - + unsigned our_challenge, her_challenge; + unsigned char our_digest[16]; + int err; + int pkt_sz; + struct sockaddr_in addr; + unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; + erl_errno = EIO; /* Default error code */ EI_TRACE_CONN1("ei_xconnect","-> CONNECT attempt to connect to %s", alivename); - if ((rport = ei_epmd_port_tmo(ip_addr,alivename,&dist, ms)) < 0) { + if ((rport = ei_epmd_port_tmo(ip_addr,alivename,&dist, tmo)) < 0) { EI_TRACE_ERR0("ei_xconnect","-> CONNECT can't get remote port"); /* ei_epmd_port_tmo() has set erl_errno */ return ERL_NO_PORT; } - - /* we now have port number to enode, try to connect */ - if((sockd = cnct((uint16)rport, ip_addr, sizeof(struct in_addr),ms)) < 0) { - EI_TRACE_ERR0("ei_xconnect","-> CONNECT socket connect failed"); - /* cnct() has set erl_errno */ - return ERL_CONNECT_FAIL; - } - - EI_TRACE_CONN0("ei_xconnect","-> CONNECT connected to remote"); - /* FIXME why connect before checking 'dist' output from ei_epmd_port() ?! */ if (dist <= 4) { EI_TRACE_ERR0("ei_xconnect","-> CONNECT remote version not compatible"); - goto error; + return ERL_ERROR; } - else { - unsigned our_challenge, her_challenge; - unsigned char our_digest[16]; - - if (send_name(sockd, ec->thisnodename, (unsigned) dist, ms)) - goto error; - if (recv_status(sockd, ms)) - goto error; - if (recv_challenge(sockd, &her_challenge, &her_version, - &her_flags, &her_name, ms)) - goto error; - our_challenge = gen_challenge(); - gen_digest(her_challenge, ec->ei_connect_cookie, our_digest); - if (send_challenge_reply(sockd, our_digest, our_challenge, ms)) - goto error; - if (recv_challenge_ack(sockd, our_challenge, - ec->ei_connect_cookie, ms)) - goto error; - put_ei_socket_info(sockd, dist, null_cookie, ec); /* FIXME check == 0 */ + + err = ei_socket_ctx__(cbs, &ctx, ec->setup_context); + if (err) { + EI_TRACE_ERR2("ei_xconnect","-> SOCKET failed: %s (%d)", + estr(err), err); + erl_errno = err; + return ERL_CONNECT_FAIL; + } + + memset((void *) &addr, 0, sizeof(struct sockaddr_in)); + memcpy((void *) &addr.sin_addr, (void *) ip_addr, sizeof(addr.sin_addr)); + addr.sin_family = AF_INET; + addr.sin_port = htons(rport); + + err = ei_connect_ctx_t__(cbs, ctx, (void *) &addr, sizeof(addr), tmo); + if (err) { + EI_TRACE_ERR2("ei_xconnect","-> CONNECT socket connect failed: %s (%d)", + estr(err), err); + abort_connection(cbs, ctx); + erl_errno = err; + return ERL_CONNECT_FAIL; } - setsockopt(sockd, IPPROTO_TCP, TCP_NODELAY, (char *)&one, sizeof(one)); - setsockopt(sockd, SOL_SOCKET, SO_KEEPALIVE, (char *)&one, sizeof(one)); + EI_TRACE_CONN0("ei_xconnect","-> CONNECT connected to remote"); - EI_TRACE_CONN1("ei_xconnect","-> CONNECT (ok) remote = %s",alivename); + err = EI_GET_FD__(cbs, ctx, &sockd); + if (err) { + EI_CONN_SAVE_ERRNO__(err); + goto error; + } + + err = cbs->handshake_packet_header_size(ctx, &pkt_sz); + if (err) { + EI_CONN_SAVE_ERRNO__(err); + goto error; + } + + if (send_name(cbs, ctx, pkt_sz, ec->thisnodename, (unsigned) dist, tmo)) + goto error; + if (recv_status(cbs, ctx, pkt_sz, tmo)) + goto error; + if (recv_challenge(cbs, ctx, pkt_sz, &her_challenge, + &her_version, &her_flags, NULL, tmo)) + goto error; + our_challenge = gen_challenge(); + gen_digest(her_challenge, ec->ei_connect_cookie, our_digest); + if (send_challenge_reply(cbs, ctx, pkt_sz, our_digest, our_challenge, tmo)) + goto error; + if (recv_challenge_ack(cbs, ctx, pkt_sz, our_challenge, + ec->ei_connect_cookie, tmo)) + goto error; + if (put_ei_socket_info(sockd, dist, null_cookie, ec, cbs, ctx) != 0) + goto error; + + if (cbs->connect_handshake_complete) { + err = cbs->connect_handshake_complete(ctx); + if (err) { + EI_TRACE_ERR2("ei_xconnect","-> CONNECT failed: %s (%d)", + estr(err), err); + close_connection(cbs, ctx, sockd); + EI_CONN_SAVE_ERRNO__(err); + return ERL_ERROR; + } + } + EI_TRACE_CONN1("ei_xconnect","-> CONNECT (ok) remote = %s",alivename); + erl_errno = 0; return sockd; error: EI_TRACE_ERR0("ei_xconnect","-> CONNECT failed"); - closesocket(sockd); + abort_connection(cbs, ctx); return ERL_ERROR; } /* ei_xconnect */ -int ei_xconnect(ei_cnode* ec, Erl_IpAddr adr, char *alivename) +int ei_xconnect(ei_cnode* ec, Erl_IpAddr ip_addr, char *alivename) { - return ei_xconnect_tmo(ec, adr, alivename, 0); + return ei_xconnect_tmo(ec, ip_addr, alivename, 0); } +int ei_listen(ei_cnode *ec, int *port, int backlog) +{ + struct in_addr ip_addr; + ip_addr.s_addr = htonl(INADDR_ANY); + return ei_xlisten(ec, &ip_addr, port, backlog); +} + +int ei_xlisten(ei_cnode *ec, struct in_addr *ip_addr, int *port, int backlog) +{ + ei_socket_callbacks *cbs = ec->cbs; + struct sockaddr_in sock_addr; + void *ctx; + int fd, err, len; + + err = ei_socket_ctx__(cbs, &ctx, ec->setup_context); + if (err) { + EI_TRACE_ERR2("ei_xlisten","-> SOCKET failed: %s (%d)", + estr(err), err); + erl_errno = err; + return ERL_ERROR; + } + + memset((void *) &sock_addr, 0, sizeof(struct sockaddr_in)); + memcpy((void *) &sock_addr.sin_addr, (void *) ip_addr, sizeof(*ip_addr)); + sock_addr.sin_family = AF_INET; + sock_addr.sin_port = htons((short) *port); + + len = sizeof(sock_addr); + err = ei_listen_ctx__(cbs, ctx, (void *) &sock_addr, &len, backlog); + if (err) { + EI_TRACE_ERR2("ei_xlisten","-> listen failed: %s (%d)", + estr(err), err); + erl_errno = err; + goto error; + } + + if (len != sizeof(sock_addr)) { + if (len < offsetof(struct sockaddr_in, sin_addr) + sizeof(sock_addr.sin_addr) + || len < offsetof(struct sockaddr_in, sin_port) + sizeof(sock_addr.sin_port)) { + erl_errno = EIO; + EI_TRACE_ERR0("ei_xlisten","-> get info failed"); + goto error; + } + } + + memcpy((void *) ip_addr, (void *) &sock_addr.sin_addr, sizeof(*ip_addr)); + *port = (int) ntohs(sock_addr.sin_port); + + err = EI_GET_FD__(cbs, ctx, &fd); + if (err) { + erl_errno = err; + goto error; + } + + if (put_ei_socket_info(fd, 0, null_cookie, ec, cbs, ctx) != 0) { + EI_TRACE_ERR0("ei_xlisten","-> save socket info failed"); + erl_errno = EIO; + goto error; + } + + erl_errno = 0; + + return fd; + +error: + abort_connection(cbs, ctx); + return ERL_ERROR; +} + +static int close_connection(ei_socket_callbacks *cbs, void *ctx, int fd) +{ + int err; + remove_ei_socket_info(fd); + err = ei_close_ctx__(cbs, ctx); + if (err) { + erl_errno = err; + return ERL_ERROR; + } + return 0; +} - /* - * For symmetry reasons -*/ -#if 0 int ei_close_connection(int fd) { - return closesocket(fd); + ei_socket_callbacks *cbs; + void *ctx; + int err = EI_GET_CBS_CTX__(&cbs, &ctx, fd); + if (err) + erl_errno = err; + else { + if (close_connection(cbs, ctx, fd) == 0) + return 0; + } + EI_TRACE_ERR2("ei_close_connection","<- CLOSE socket close failed: %s (%d)", + estr(erl_errno), erl_errno); + return ERL_ERROR; } /* ei_close_connection */ -#endif + +static void abort_connection(ei_socket_callbacks *cbs, void *ctx) +{ + (void) ei_close_ctx__(cbs, ctx); +} /* * Accept and initiate a connection from another @@ -857,25 +1184,71 @@ int ei_accept(ei_cnode* ec, int lfd, ErlConnect *conp) int ei_accept_tmo(ei_cnode* ec, int lfd, ErlConnect *conp, unsigned ms) { int fd; - struct sockaddr_in cli_addr; - int cli_addr_len=sizeof(struct sockaddr_in); unsigned her_version, her_flags; - ErlConnect her_name; + char tmp_nodename[MAXNODELEN+1]; + char *her_name; + int pkt_sz, err; + struct sockaddr_in addr; + int addr_len = sizeof(struct sockaddr_in); + ei_socket_callbacks *cbs; + void *ctx; + unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; erl_errno = EIO; /* Default error code */ + + err = EI_GET_CBS_CTX__(&cbs, &ctx, lfd); + if (err) { + EI_CONN_SAVE_ERRNO__(err); + return ERL_ERROR; + } + EI_TRACE_CONN0("ei_accept","<- ACCEPT waiting for connection"); + + if (conp) { + her_name = &conp->nodename[0]; + } + else { + her_name = &tmp_nodename[0]; + } - if ((fd = ei_accept_t(lfd, (struct sockaddr*) &cli_addr, - &cli_addr_len, ms )) < 0) { - EI_TRACE_ERR0("ei_accept","<- ACCEPT socket accept failed"); - erl_errno = (fd == -2) ? ETIMEDOUT : EIO; - goto error; + /* + * ei_accept_ctx_t__() replaces the pointer to the listen context + * with a pointer to the accepted connection context on success. + */ + err = ei_accept_ctx_t__(cbs, &ctx, (void *) &addr, &addr_len, tmo); + if (err) { + EI_TRACE_ERR2("ei_accept","<- ACCEPT socket accept failed: %s (%d)", + estr(err), err); + EI_CONN_SAVE_ERRNO__(err); + return ERL_ERROR; + } + + err = EI_GET_FD__(cbs, ctx, &fd); + if (err) { + EI_TRACE_ERR2("ei_accept","<- ACCEPT get fd failed: %s (%d)", + estr(err), err); + EI_CONN_SAVE_ERRNO__(err); + } + + if (addr_len != sizeof(struct sockaddr_in)) { + if (addr_len < (offsetof(struct sockaddr_in, sin_addr) + + sizeof(addr.sin_addr))) { + EI_TRACE_ERR0("ei_accept","<- ACCEPT get addr failed"); + goto error; + } + } + + err = cbs->handshake_packet_header_size(ctx, &pkt_sz); + if (err) { + EI_TRACE_ERR2("ei_accept","<- ACCEPT get packet size failed: %s (%d)", + estr(err), err); + EI_CONN_SAVE_ERRNO__(err); } EI_TRACE_CONN0("ei_accept","<- ACCEPT connected to remote"); - if (recv_name(fd, &her_version, &her_flags, &her_name, ms)) { + if (recv_name(cbs, ctx, pkt_sz, &her_version, &her_flags, her_name, tmo)) { EI_TRACE_ERR0("ei_accept","<- ACCEPT initial ident failed"); goto error; } @@ -888,34 +1261,46 @@ int ei_accept_tmo(ei_cnode* ec, int lfd, ErlConnect *conp, unsigned ms) unsigned our_challenge; unsigned her_challenge; unsigned char our_digest[16]; - - if (send_status(fd,"ok", ms)) + + if (send_status(cbs, ctx, pkt_sz, "ok", tmo)) goto error; our_challenge = gen_challenge(); - if (send_challenge(fd, ec->thisnodename, - our_challenge, her_version, ms)) + if (send_challenge(cbs, ctx, pkt_sz, ec->thisnodename, + our_challenge, her_version, tmo)) goto error; - if (recv_challenge_reply(fd, our_challenge, - ec->ei_connect_cookie, - &her_challenge, ms)) + if (recv_challenge_reply(cbs, ctx, pkt_sz, our_challenge, + ec->ei_connect_cookie, &her_challenge, tmo)) goto error; gen_digest(her_challenge, ec->ei_connect_cookie, our_digest); - if (send_challenge_ack(fd, our_digest, ms)) + if (send_challenge_ack(cbs, ctx, pkt_sz, our_digest, tmo)) goto error; - put_ei_socket_info(fd, her_version, null_cookie, ec); + if (put_ei_socket_info(fd, her_version, null_cookie, ec, cbs, ctx) != 0) + goto error; + } + if (conp) { + memcpy((void *) conp->ipadr, (void *) &addr.sin_addr, sizeof(conp->ipadr)); + strcpy(&conp->nodename[0], her_name); + } + + if (cbs->accept_handshake_complete) { + err = cbs->accept_handshake_complete(ctx); + if (err) { + EI_TRACE_ERR2("ei_xconnect","-> ACCEPT handshake failed: %s (%d)", + estr(err), err); + close_connection(cbs, ctx, fd); + EI_CONN_SAVE_ERRNO__(err); + return ERL_ERROR; + } } - if (conp) - *conp = her_name; - EI_TRACE_CONN1("ei_accept","<- ACCEPT (ok) remote = %s",her_name.nodename); + EI_TRACE_CONN1("ei_accept","<- ACCEPT (ok) remote = %s",her_name); erl_errno = 0; /* No error */ return fd; error: EI_TRACE_ERR0("ei_accept","<- ACCEPT failed"); - if (fd>=0) - closesocket(fd); + abort_connection(cbs, ctx); return ERL_ERROR; } /* ei_accept */ @@ -927,36 +1312,57 @@ error: */ int ei_receive_tmo(int fd, unsigned char *bufp, int bufsize, unsigned ms) { - int len; + ssize_t len; unsigned char fourbyte[4]={0,0,0,0}; - int res; - - if ((res = ei_read_fill_t(fd, (char *) bufp, 4, ms)) != 4) { - erl_errno = (res == -2) ? ETIMEDOUT : EIO; + int err; + ei_socket_callbacks *cbs; + void *ctx; + unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; + + err = EI_GET_CBS_CTX__(&cbs, &ctx, fd); + if (err) { + EI_CONN_SAVE_ERRNO__(err); + return ERL_ERROR; + } + + len = (ssize_t) 4; + err = ei_read_fill_ctx_t__(cbs, ctx, (char *) bufp, &len, tmo); + if (!err && len != (ssize_t) 4) + err = EIO; + if (err) { + EI_CONN_SAVE_ERRNO__(err); return ERL_ERROR; } /* Tick handling */ - if ((len = get_int32(bufp)) == ERL_TICK) - { - ei_write_fill_t(fd, (char *) fourbyte, 4, ms); + len = get_int32(bufp); + if (len == ERL_TICK) { + len = 4; + ei_write_fill_ctx_t__(cbs, ctx, (char *) fourbyte, &len, tmo); /* FIXME ok to ignore error or timeout? */ erl_errno = EAGAIN; return ERL_TICK; } - else if (len > bufsize) - { + + if (len > bufsize) { /* FIXME: We should drain the message. */ erl_errno = EMSGSIZE; return ERL_ERROR; } - else if ((res = ei_read_fill_t(fd, (char *) bufp, len, ms)) != len) - { - erl_errno = (res == -2) ? ETIMEDOUT : EIO; - return ERL_ERROR; + else { + ssize_t need = len; + err = ei_read_fill_ctx_t__(cbs, ctx, (char *) bufp, &len, tmo); + if (err) { + EI_CONN_SAVE_ERRNO__(err); + return ERL_ERROR; + } + if (len != need) { + erl_errno = EIO; + return ERL_ERROR; + } } - return len; + return (int) len; } @@ -1112,36 +1518,11 @@ int ei_rpc_to(ei_cnode *ec, int fd, char *mod, char *fun, int ei_rpc_from(ei_cnode *ec, int fd, int timeout, erlang_msg *msg, ei_x_buff *x) { - fd_set readmask; - struct timeval tv; - struct timeval *t = NULL; - - if (timeout >= 0) { - tv.tv_sec = timeout / 1000; - tv.tv_usec = (timeout % 1000) * 1000; - t = &tv; - } - - FD_ZERO(&readmask); - FD_SET(fd,&readmask); - - switch (select(fd+1, &readmask, NULL, NULL, t)) { - case -1: - erl_errno = EIO; - return ERL_ERROR; - - case 0: - erl_errno = ETIMEDOUT; - return ERL_TIMEOUT; - - default: - if (FD_ISSET(fd, &readmask)) { - return ei_xreceive_msg(fd, msg, x); - } else { - erl_errno = EIO; - return ERL_ERROR; - } - } + unsigned tmo = timeout < 0 ? EI_SCLBK_INF_TMO : (unsigned) timeout; + int res = ei_xreceive_msg_tmo(fd, msg, x, tmo); + if (res < 0 && erl_errno == ETIMEDOUT) + return ERL_TIMEOUT; + return res; } /* rpc_from */ /* @@ -1295,19 +1676,34 @@ static char *hex(char digest[16], char buff[33]) return buff; } -static int read_2byte_package(int fd, char **buf, int *buflen, - int *is_static, unsigned ms) +static int read_hs_package(ei_socket_callbacks *cbs, void *ctx, + int pkt_sz, char **buf, int *buflen, + int *is_static, unsigned ms) { - unsigned char nbuf[2]; + unsigned char nbuf[4]; unsigned char *x = nbuf; - unsigned len; - int res; - - if((res = ei_read_fill_t(fd, (char *)nbuf, 2, ms)) != 2) { - erl_errno = (res == -2) ? ETIMEDOUT : EIO; + ssize_t len, need; + int err; + + len = (ssize_t) pkt_sz; + err = ei_read_fill_ctx_t__(cbs, ctx, (char *)nbuf, &len, ms); + if (!err && len != (ssize_t) pkt_sz) + err = EIO; + if (err) { + EI_CONN_SAVE_ERRNO__(err); return -1; } - len = get16be(x); + + switch (pkt_sz) { + case 2: + len = get16be(x); + break; + case 4: + len = get32be(x); + break; + default: + return -1; + } if (len > *buflen) { if (*is_static) { @@ -1329,20 +1725,26 @@ static int read_2byte_package(int fd, char **buf, int *buflen, *buflen = len; } } - if ((res = ei_read_fill_t(fd, *buf, len, ms)) != len) { - erl_errno = (res == -2) ? ETIMEDOUT : EIO; + need = len; + err = ei_read_fill_ctx_t__(cbs, ctx, *buf, &len, ms); + if (!err && len != need) + err = EIO; + if (err) { + EI_CONN_SAVE_ERRNO__(err); return -1; } return len; } -static int send_status(int fd, char *status, unsigned ms) +static int send_status(ei_socket_callbacks *cbs, void *ctx, + int pkt_sz, char *status, unsigned ms) { char *buf, *s; char dbuf[DEFBUF_SIZ]; - int siz = strlen(status) + 1 + 2; - int res; + int siz = strlen(status) + 1 + pkt_sz; + int err; + ssize_t len; buf = (siz > DEFBUF_SIZ) ? malloc(siz) : dbuf; if (!buf) { @@ -1350,14 +1752,28 @@ static int send_status(int fd, char *status, unsigned ms) return -1; } s = buf; - put16be(s,siz - 2); + switch (pkt_sz) { + case 2: + put16be(s,siz - 2); + break; + case 4: + put32be(s,siz - 4); + break; + default: + return -1; + } put8(s, 's'); memcpy(s, status, strlen(status)); - if ((res = ei_write_fill_t(fd, buf, siz, ms)) != siz) { - EI_TRACE_ERR0("send_status","-> SEND_STATUS socket write failed"); + len = (ssize_t) siz; + err = ei_write_fill_ctx_t__(cbs, ctx, buf, &len, ms); + if (!err && len != (ssize_t) siz) + err = EIO; + if (err) { + EI_TRACE_ERR2("send_status","-> SEND_STATUS socket write failed: %s (%d)", + estr(err), err); if (buf != dbuf) - free(buf); - erl_errno = (res == -2) ? ETIMEDOUT : EIO; + free(buf); + EI_CONN_SAVE_ERRNO__(err); return -1; } EI_TRACE_CONN1("send_status","-> SEND_STATUS (%s)",status); @@ -1367,7 +1783,8 @@ static int send_status(int fd, char *status, unsigned ms) return 0; } -static int recv_status(int fd, unsigned ms) +static int recv_status(ei_socket_callbacks *cbs, void *ctx, + int pkt_sz, unsigned ms) { char dbuf[DEFBUF_SIZ]; char *buf = dbuf; @@ -1375,7 +1792,8 @@ static int recv_status(int fd, unsigned ms) int buflen = DEFBUF_SIZ; int rlen; - if ((rlen = read_2byte_package(fd, &buf, &buflen, &is_static, ms)) <= 0) { + if ((rlen = read_hs_package(cbs, ctx, pkt_sz, + &buf, &buflen, &is_static, ms)) <= 0) { EI_TRACE_ERR1("recv_status", "<- RECV_STATUS socket read failed (%d)", rlen); goto error; @@ -1396,7 +1814,10 @@ error: return -1; } -static int send_name_or_challenge(int fd, char *nodename, +static int send_name_or_challenge(ei_socket_callbacks *cbs, + void *ctx, + int pkt_sz, + char *nodename, int f_chall, unsigned challenge, unsigned version, @@ -1405,9 +1826,10 @@ static int send_name_or_challenge(int fd, char *nodename, char *buf; unsigned char *s; char dbuf[DEFBUF_SIZ]; - int siz = 2 + 1 + 2 + 4 + strlen(nodename); + int siz = pkt_sz + 1 + 2 + 4 + strlen(nodename); const char* function[] = {"SEND_NAME", "SEND_CHALLENGE"}; - int res; + int err; + ssize_t len; if (f_chall) siz += 4; @@ -1417,7 +1839,16 @@ static int send_name_or_challenge(int fd, char *nodename, return -1; } s = (unsigned char *)buf; - put16be(s,siz - 2); + switch (pkt_sz) { + case 2: + put16be(s,siz - 2); + break; + case 4: + put32be(s,siz - 4); + break; + default: + return -1; + } put8(s, 'n'); put16be(s, version); put32be(s, (DFLAG_EXTENDED_REFERENCES @@ -1433,13 +1864,16 @@ static int send_name_or_challenge(int fd, char *nodename, if (f_chall) put32be(s, challenge); memcpy(s, nodename, strlen(nodename)); - - if ((res = ei_write_fill_t(fd, buf, siz, ms)) != siz) { + len = (ssize_t) siz; + err = ei_write_fill_ctx_t__(cbs, ctx, buf, &len, ms); + if (!err && len != (ssize_t) siz) + err = EIO; + if (err) { EI_TRACE_ERR1("send_name_or_challenge", "-> %s socket write failed", function[f_chall]); if (buf != dbuf) free(buf); - erl_errno = (res == -2) ? ETIMEDOUT : EIO; + EI_CONN_SAVE_ERRNO__(err); return -1; } @@ -1448,9 +1882,9 @@ static int send_name_or_challenge(int fd, char *nodename, return 0; } -static int recv_challenge(int fd, unsigned *challenge, - unsigned *version, - unsigned *flags, ErlConnect *namebuf, unsigned ms) +static int recv_challenge(ei_socket_callbacks *cbs, void *ctx, + int pkt_sz, unsigned *challenge, unsigned *version, + unsigned *flags, char *namebuf, unsigned ms) { char dbuf[DEFBUF_SIZ]; char *buf = dbuf; @@ -1458,13 +1892,13 @@ static int recv_challenge(int fd, unsigned *challenge, int buflen = DEFBUF_SIZ; int rlen; char *s; - struct sockaddr_in sin; - socklen_t sin_len = sizeof(sin); char tag; - + char tmp_nodename[MAXNODELEN+1]; + erl_errno = EIO; /* Default */ - if ((rlen = read_2byte_package(fd, &buf, &buflen, &is_static, ms)) <= 0) { + if ((rlen = read_hs_package(cbs, ctx, pkt_sz, &buf, &buflen, + &is_static, ms)) <= 0) { EI_TRACE_ERR1("recv_challenge", "<- RECV_CHALLENGE socket read failed (%d)",rlen); goto error; @@ -1505,22 +1939,19 @@ static int recv_challenge(int fd, unsigned *challenge, goto error; } - if (getpeername(fd, (struct sockaddr *) &sin, &sin_len) < 0) { - EI_TRACE_ERR0("recv_challenge","<- RECV_CHALLENGE can't get peername"); - erl_errno = errno; - goto error; - } - memcpy(namebuf->ipadr, &(sin.sin_addr.s_addr), - sizeof(sin.sin_addr.s_addr)); - memcpy(namebuf->nodename, s, rlen - 11); - namebuf->nodename[rlen - 11] = '\0'; + if (!namebuf) + namebuf = &tmp_nodename[0]; + + memcpy(namebuf, s, rlen - 11); + namebuf[rlen - 11] = '\0'; + if (!is_static) free(buf); EI_TRACE_CONN4("recv_challenge","<- RECV_CHALLENGE (ok) node = %s, " "version = %u, " "flags = %u, " "challenge = %d", - namebuf->nodename, + namebuf, *version, *flags, *challenge @@ -1533,24 +1964,40 @@ error: return -1; } -static int send_challenge_reply(int fd, unsigned char digest[16], +static int send_challenge_reply(ei_socket_callbacks *cbs, void *ctx, + int pkt_sz, unsigned char digest[16], unsigned challenge, unsigned ms) { char *s; char buf[DEFBUF_SIZ]; - int siz = 2 + 1 + 4 + 16; - int res; + int siz = pkt_sz + 1 + 4 + 16; + int err; + ssize_t len; s = buf; - put16be(s,siz - 2); + switch (pkt_sz) { + case 2: + put16be(s,siz - 2); + break; + case 4: + put32be(s,siz - 4); + break; + default: + return -1; + } put8(s, 'r'); put32be(s, challenge); memcpy(s, digest, 16); - - if ((res = ei_write_fill_t(fd, buf, siz, ms)) != siz) { - EI_TRACE_ERR0("send_challenge_reply", - "-> SEND_CHALLENGE_REPLY socket write failed"); - erl_errno = (res == -2) ? ETIMEDOUT : EIO; + + len = (ssize_t) siz; + err = ei_write_fill_ctx_t__(cbs, ctx, buf, &len, ms); + if (!err && len != (ssize_t) siz) + err = EIO; + if (err) { + EI_TRACE_ERR2("send_challenge_reply", + "-> SEND_CHALLENGE_REPLY socket write failed: %s (%d)", + estr(err), err); + EI_CONN_SAVE_ERRNO__(err); return -1; } @@ -1563,11 +2010,13 @@ static int send_challenge_reply(int fd, unsigned char digest[16], return 0; } -static int recv_challenge_reply (int fd, - unsigned our_challenge, - char cookie[], - unsigned *her_challenge, - unsigned ms) +static int recv_challenge_reply(ei_socket_callbacks *cbs, + void *ctx, + int pkt_sz, + unsigned our_challenge, + char cookie[], + unsigned *her_challenge, + unsigned ms) { char dbuf[DEFBUF_SIZ]; char *buf = dbuf; @@ -1580,7 +2029,7 @@ static int recv_challenge_reply (int fd, erl_errno = EIO; /* Default */ - if ((rlen = read_2byte_package(fd, &buf, &buflen, &is_static, ms)) != 21) { + if ((rlen = read_hs_package(cbs, ctx, pkt_sz, &buf, &buflen, &is_static, ms)) != 21) { EI_TRACE_ERR1("recv_challenge_reply", "<- RECV_CHALLENGE_REPLY socket read failed (%d)",rlen); goto error; @@ -1620,23 +2069,38 @@ error: return -1; } -static int send_challenge_ack(int fd, unsigned char digest[16], unsigned ms) +static int send_challenge_ack(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, + unsigned char digest[16], unsigned ms) { char *s; char buf[DEFBUF_SIZ]; - int siz = 2 + 1 + 16; - int res; + int siz = pkt_sz + 1 + 16; + int err; + ssize_t len; s = buf; - - put16be(s,siz - 2); + switch (pkt_sz) { + case 2: + put16be(s,siz - 2); + break; + case 4: + put32be(s,siz - 4); + break; + default: + return -1; + } put8(s, 'a'); memcpy(s, digest, 16); - if ((res = ei_write_fill_t(fd, buf, siz, ms)) != siz) { - EI_TRACE_ERR0("recv_challenge_reply", - "-> SEND_CHALLENGE_ACK socket write failed"); - erl_errno = (res == -2) ? ETIMEDOUT : EIO; + len = (ssize_t) siz; + err = ei_write_fill_ctx_t__(cbs, ctx, buf, &len, ms); + if (!err && len != (ssize_t) siz) + err = EIO; + if (err) { + EI_TRACE_ERR2("recv_challenge_reply", + "-> SEND_CHALLENGE_ACK socket write failed: %s (%d)", + estr(err), err); + EI_CONN_SAVE_ERRNO__(err); return -1; } @@ -1649,8 +2113,8 @@ static int send_challenge_ack(int fd, unsigned char digest[16], unsigned ms) return 0; } -static int recv_challenge_ack(int fd, - unsigned our_challenge, +static int recv_challenge_ack(ei_socket_callbacks *cbs, void *ctx, + int pkt_sz, unsigned our_challenge, char cookie[], unsigned ms) { char dbuf[DEFBUF_SIZ]; @@ -1664,7 +2128,7 @@ static int recv_challenge_ack(int fd, erl_errno = EIO; /* Default */ - if ((rlen = read_2byte_package(fd, &buf, &buflen, &is_static, ms)) != 17) { + if ((rlen = read_hs_package(cbs, ctx, pkt_sz, &buf, &buflen, &is_static, ms)) != 17) { EI_TRACE_ERR1("recv_challenge_ack", "<- RECV_CHALLENGE_ACK socket read failed (%d)",rlen); goto error; @@ -1701,20 +2165,24 @@ error: return -1; } -static int send_name(int fd, char *nodename, unsigned version, unsigned ms) +static int send_name(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, + char *nodename, unsigned version, unsigned ms) { - return send_name_or_challenge(fd, nodename, 0, 0, version, ms); + return send_name_or_challenge(cbs, ctx, pkt_sz, nodename, 0, + 0, version, ms); } -static int send_challenge(int fd, char *nodename, - unsigned challenge, unsigned version, unsigned ms) +static int send_challenge(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, + char *nodename, unsigned challenge, unsigned version, + unsigned ms) { - return send_name_or_challenge(fd, nodename, 1, challenge, version, ms); + return send_name_or_challenge(cbs, ctx, pkt_sz, nodename, 1, + challenge, version, ms); } -static int recv_name(int fd, - unsigned *version, - unsigned *flags, ErlConnect *namebuf, unsigned ms) +static int recv_name(ei_socket_callbacks *cbs, void *ctx, + int pkt_sz, unsigned *version, + unsigned *flags, char *namebuf, unsigned ms) { char dbuf[DEFBUF_SIZ]; char *buf = dbuf; @@ -1722,13 +2190,13 @@ static int recv_name(int fd, int buflen = DEFBUF_SIZ; int rlen; char *s; - struct sockaddr_in sin; - socklen_t sin_len = sizeof(sin); + char tmp_nodename[MAXNODELEN+1]; char tag; erl_errno = EIO; /* Default */ - if ((rlen = read_2byte_package(fd, &buf, &buflen, &is_static, ms)) <= 0) { + if ((rlen = read_hs_package(cbs, ctx, pkt_sz, &buf, &buflen, + &is_static, ms)) <= 0) { EI_TRACE_ERR1("recv_name","<- RECV_NAME socket read failed (%d)",rlen); goto error; } @@ -1759,21 +2227,18 @@ static int recv_name(int fd, erl_errno = EIO; goto error; } - - if (getpeername(fd, (struct sockaddr *) &sin, &sin_len) < 0) { - EI_TRACE_ERR0("recv_name","<- RECV_NAME can't get peername"); - erl_errno = errno; - goto error; - } - memcpy(namebuf->ipadr, &(sin.sin_addr.s_addr), - sizeof(sin.sin_addr.s_addr)); - memcpy(namebuf->nodename, s, rlen - 7); - namebuf->nodename[rlen - 7] = '\0'; + + if (!namebuf) + namebuf = &tmp_nodename[0]; + + memcpy(namebuf, s, rlen - 7); + namebuf[rlen - 7] = '\0'; + if (!is_static) free(buf); EI_TRACE_CONN3("recv_name", "<- RECV_NAME (ok) node = %s, version = %u, flags = %u", - namebuf->nodename,*version,*flags); + namebuf,*version,*flags); erl_errno = 0; return 0; @@ -1867,3 +2332,4 @@ static int get_cookie(char *buf, int bufsize) return 1; /* Success! */ } + diff --git a/lib/erl_interface/src/connect/eirecv.c b/lib/erl_interface/src/connect/eirecv.c index 7b9dbfc387..47eea06ced 100644 --- a/lib/erl_interface/src/connect/eirecv.c +++ b/lib/erl_interface/src/connect/eirecv.c @@ -60,22 +60,36 @@ ei_recv_internal (int fd, int arity; int version; int index = 0; - int i = 0; - int res; + int err; int show_this_msg = 0; + ei_socket_callbacks *cbs; + void *ctx; + ssize_t rlen; + unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; + + err = EI_GET_CBS_CTX__(&cbs, &ctx, fd); + if (err) { + EI_CONN_SAVE_ERRNO__(err); + return -1; + } /* get length field */ - if ((res = ei_read_fill_t(fd, header, 4, ms)) != 4) - { - erl_errno = (res == -2) ? ETIMEDOUT : EIO; + rlen = 4; + err = ei_read_fill_ctx_t__(cbs, ctx, header, &rlen, tmo); + if (!err && rlen != 4) + err = EIO; + if (err) { + EI_CONN_SAVE_ERRNO__(err); return -1; } + len = get32be(s); /* got tick - respond and return */ if (!len) { char tock[] = {0,0,0,0}; - ei_write_fill_t(fd, tock, sizeof(tock), ms); /* Failure no problem */ + ssize_t wlen = sizeof(tock); + ei_write_fill_ctx_t__(cbs, ctx, tock, &wlen, tmo); /* Failure no problem */ *msglenp = 0; return 0; /* maybe flag ERL_EAGAIN [sverkerw] */ } @@ -86,9 +100,12 @@ ei_recv_internal (int fd, ei_trace(-1,NULL); /* read enough to get at least entire header */ - bytesread = (len > EIRECVBUF ? EIRECVBUF : len); - if ((i = ei_read_fill_t(fd,header,bytesread,ms)) != bytesread) { - erl_errno = (i == -2) ? ETIMEDOUT : EIO; + rlen = bytesread = (len > EIRECVBUF ? EIRECVBUF : len); + err = ei_read_fill_ctx_t__(cbs, ctx, header, &rlen, tmo); + if (!err && rlen != bytesread) + err = EIO; + if (err) { + EI_CONN_SAVE_ERRNO__(err); return -1; } @@ -212,12 +229,17 @@ ei_recv_internal (int fd, */ if (msglen > *bufsz) { if (staticbufp) { - int sz = EIRECVBUF; /* flush in rest of packet */ while (remain > 0) { - if (remain < sz) sz = remain; - if ((i=ei_read_fill_t(fd,header,sz,ms)) <= 0) break; - remain -= i; + rlen = remain > EIRECVBUF ? EIRECVBUF : remain; + err = ei_read_fill_ctx_t__(cbs, ctx, header, &rlen, tmo); + if (err) { + EI_CONN_SAVE_ERRNO__(err); + return -1; + } + if (rlen == 0) + break; + remain -= rlen; } erl_errno = EMSGSIZE; return -1; @@ -247,11 +269,15 @@ ei_recv_internal (int fd, /* read the rest of the message into callers buffer */ if (remain > 0) { - if ((i = ei_read_fill_t(fd,mbuf+bytesread-index,remain,ms)) != remain) { - *msglenp = bytesread-index+1; /* actual bytes in users buffer */ - erl_errno = (i == -2) ? ETIMEDOUT : EIO; - return -1; - } + rlen = remain; + err = ei_read_fill_ctx_t__(cbs, ctx, mbuf+bytesread-index, &rlen, tmo); + if (!err && rlen != remain) + err = EIO; + if (err) { + *msglenp = bytesread-index+1; /* actual bytes in users buffer */ + EI_CONN_SAVE_ERRNO__(err); + return -1; + } } if (show_this_msg) diff --git a/lib/erl_interface/src/connect/send.c b/lib/erl_interface/src/connect/send.c index 37d7db6d68..d97532d123 100644 --- a/lib/erl_interface/src/connect/send.c +++ b/lib/erl_interface/src/connect/send.c @@ -58,10 +58,17 @@ int ei_send_encoded_tmo(int fd, const erlang_pid *to, char *s, header[1200]; /* see size calculation below */ erlang_trace *token = NULL; int index = 5; /* reserve 5 bytes for control message */ - int res; -#ifdef HAVE_WRITEV - struct iovec v[2]; -#endif + int err; + ei_socket_callbacks *cbs; + void *ctx; + ssize_t len, tot_len; + unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; + + err = EI_GET_CBS_CTX__(&cbs, &ctx, fd); + if (err) { + EI_CONN_SAVE_ERRNO__(err); + return ERL_ERROR; + } /* are we tracing? */ /* check that he can receive trace tokens first */ @@ -91,30 +98,47 @@ int ei_send_encoded_tmo(int fd, const erlang_pid *to, if (ei_tracelevel >= 4) ei_show_sendmsg(stderr,header,msg); -#ifdef HAVE_WRITEV - - v[0].iov_base = (char *)header; - v[0].iov_len = index; - v[1].iov_base = (char *)msg; - v[1].iov_len = msglen; - - if ((res = ei_writev_fill_t(fd,v,2,ms)) != index+msglen) { - erl_errno = (res == -2) ? ETIMEDOUT : EIO; - return -1; - } - -#else /* !HAVE_WRITEV */ - - if ((res = ei_write_fill_t(fd,header,index,ms)) != index) { - erl_errno = (res == -2) ? ETIMEDOUT : EIO; - return -1; + +#ifdef EI_HAVE_STRUCT_IOVEC__ + if (ei_socket_callbacks_have_writev__(cbs)) { + struct iovec v[2]; + + v[0].iov_base = (char *)header; + v[0].iov_len = index; + v[1].iov_base = (char *)msg; + v[1].iov_len = msglen; + + len = tot_len = (ssize_t) index+msglen; + err = ei_writev_fill_ctx_t__(cbs, ctx, v, 2, &len, tmo); + if (!err && len != tot_len) + err = EIO; + if (err) { + EI_CONN_SAVE_ERRNO__(err); + return -1; + } + + return 0; } - if ((res = ei_write_fill_t(fd,msg,msglen,ms)) != msglen) { - erl_errno = (res == -2) ? ETIMEDOUT : EIO; - return -1; +#endif /* EI_HAVE_STRUCT_IOVEC__ */ + + /* no writev() */ + len = tot_len = (ssize_t) index; + err = ei_write_fill_ctx_t__(cbs, ctx, header, &len, tmo); + if (!err && len != tot_len) + err = EIO; + if (err) { + EI_CONN_SAVE_ERRNO__(err); + return -1; } -#endif /* !HAVE_WRITEV */ + len = tot_len = (ssize_t) msglen; + err = ei_write_fill_ctx_t__(cbs, ctx, msg, &len, tmo); + if (!err && len != tot_len) + err = EIO; + if (err) { + EI_CONN_SAVE_ERRNO__(err); + return -1; + } return 0; } diff --git a/lib/erl_interface/src/connect/send_exit.c b/lib/erl_interface/src/connect/send_exit.c index 2e298e3221..b4f7e14c7f 100644 --- a/lib/erl_interface/src/connect/send_exit.c +++ b/lib/erl_interface/src/connect/send_exit.c @@ -55,6 +55,17 @@ int ei_send_exit_tmo(int fd, const erlang_pid *from, const erlang_pid *to, char *s; int index = 0; int len = strlen(reason) + 1080; /* see below */ + ei_socket_callbacks *cbs; + void *ctx; + int err; + ssize_t wlen; + unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; + + err = EI_GET_CBS_CTX__(&cbs, &ctx, fd); + if (err) { + EI_CONN_SAVE_ERRNO__(err); + return ERL_ERROR; + } if (len > EISMALLBUF) if (!(dbuf = malloc(len))) @@ -92,10 +103,16 @@ int ei_send_exit_tmo(int fd, const erlang_pid *from, const erlang_pid *to, if (ei_tracelevel >= 4) ei_show_sendmsg(stderr,msgbuf,NULL); - ei_write_fill_t(fd,msgbuf,index,ms); - /* FIXME ignore timeout etc? erl_errno?! */ - - if (dbuf) free(dbuf); + wlen = (ssize_t) index; + err = ei_write_fill_ctx_t__(cbs, ctx, msgbuf, &wlen, tmo); + if (!err && wlen != (ssize_t) index) + err = EIO; + if (dbuf) + free(dbuf); + if (err) { + EI_CONN_SAVE_ERRNO__(err); + return ERL_ERROR; + } return 0; } diff --git a/lib/erl_interface/src/connect/send_reg.c b/lib/erl_interface/src/connect/send_reg.c index 62478f042d..80d61e57b5 100644 --- a/lib/erl_interface/src/connect/send_reg.c +++ b/lib/erl_interface/src/connect/send_reg.c @@ -51,11 +51,17 @@ int ei_send_reg_encoded_tmo(int fd, const erlang_pid *from, char *s, header[1400]; /* see size calculation below */ erlang_trace *token = NULL; int index = 5; /* reserve 5 bytes for control message */ - int res; + int err; + ei_socket_callbacks *cbs; + void *ctx; + ssize_t len, tot_len; + unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; -#ifdef HAVE_WRITEV - struct iovec v[2]; -#endif + err = EI_GET_CBS_CTX__(&cbs, &ctx, fd); + if (err) { + EI_CONN_SAVE_ERRNO__(err); + return ERL_ERROR; + } /* are we tracing? */ /* check that he can receive trace tokens first */ @@ -86,29 +92,45 @@ int ei_send_reg_encoded_tmo(int fd, const erlang_pid *from, if (ei_tracelevel >= 4) ei_show_sendmsg(stderr,header,msg); -#ifdef HAVE_WRITEV +#ifdef EI_HAVE_STRUCT_IOVEC__ + if (ei_socket_callbacks_have_writev__(cbs)) { + struct iovec v[2]; - v[0].iov_base = (char *)header; - v[0].iov_len = index; - v[1].iov_base = (char *)msg; - v[1].iov_len = msglen; + v[0].iov_base = (char *)header; + v[0].iov_len = index; + v[1].iov_base = (char *)msg; + v[1].iov_len = msglen; - if ((res = ei_writev_fill_t(fd,v,2,ms)) != index+msglen) { - erl_errno = (res == -2) ? ETIMEDOUT : EIO; - return -1; + len = tot_len = (ssize_t) index+msglen; + err = ei_writev_fill_ctx_t__(cbs, ctx, v, 2, &len, tmo); + if (!err && len != tot_len) + err = EIO; + if (err) { + EI_CONN_SAVE_ERRNO__(err); + return -1; + } + return 0; } -#else - +#endif /* EI_HAVE_STRUCT_IOVEC__ */ + /* no writev() */ - if ((res = ei_write_fill_t(fd,header,index,ms)) != index) { - erl_errno = (res == -2) ? ETIMEDOUT : EIO; - return -1; + len = tot_len = (ssize_t) index; + err = ei_write_fill_ctx_t__(cbs, ctx, header, &len, tmo); + if (!err && len != tot_len) + err = EIO; + if (err) { + EI_CONN_SAVE_ERRNO__(err); + return -1; } - if ((res = ei_write_fill_t(fd,msg,msglen,ms)) != msglen) { - erl_errno = (res == -2) ? ETIMEDOUT : EIO; - return -1; + + len = tot_len = (ssize_t) msglen; + err = ei_write_fill_ctx_t__(cbs, ctx, msg, &len, tmo); + if (!err && len != tot_len) + err = EIO; + if (err) { + EI_CONN_SAVE_ERRNO__(err); + return -1; } -#endif return 0; } diff --git a/lib/erl_interface/src/epmd/epmd_port.c b/lib/erl_interface/src/epmd/epmd_port.c index 2ec418b24a..492c3fb3aa 100644 --- a/lib/erl_interface/src/epmd/epmd_port.c +++ b/lib/erl_interface/src/epmd/epmd_port.c @@ -62,31 +62,38 @@ int ei_epmd_connect_tmo(struct in_addr *inaddr, unsigned ms) { static unsigned int epmd_port = 0; - struct sockaddr_in saddr; - int sd; - int res; + int port, sd, err; + struct in_addr ip_addr; + struct sockaddr_in addr; + unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; + + err = ei_socket__(&sd); + if (err) { + erl_errno = err; + return -1; + } if (epmd_port == 0) { char* port_str = getenv("ERL_EPMD_PORT"); epmd_port = (port_str != NULL) ? atoi(port_str) : EPMD_PORT; } - memset(&saddr, 0, sizeof(saddr)); - saddr.sin_port = htons(epmd_port); - saddr.sin_family = AF_INET; - if (!inaddr) saddr.sin_addr.s_addr = htonl(INADDR_LOOPBACK); - else memmove(&saddr.sin_addr,inaddr,sizeof(saddr.sin_addr)); + port = (int) epmd_port; - if (((sd = socket(PF_INET, SOCK_STREAM, 0)) < 0)) - { - erl_errno = errno; - return -1; + if (!inaddr) { + ip_addr.s_addr = htonl(INADDR_LOOPBACK); + inaddr = &ip_addr; } + + memset((void *) &addr, 0, sizeof(struct sockaddr_in)); + memcpy((void *) &addr.sin_addr, (void *) inaddr, sizeof(addr.sin_addr)); + addr.sin_family = AF_INET; + addr.sin_port = htons(port); - if ((res = ei_connect_t(sd,(struct sockaddr *)&saddr,sizeof(saddr),ms)) < 0) - { - erl_errno = (res == -2) ? ETIMEDOUT : errno; - closesocket(sd); + err = ei_connect_t__(sd, (void *) &addr, sizeof(addr), tmo); + if (err) { + erl_errno = err; + ei_close__(sd); return -1; } @@ -104,6 +111,9 @@ static int ei_epmd_r4_port (struct in_addr *addr, const char *alive, int port; int dist_high, dist_low, proto; int res; + int err; + ssize_t dlen; + unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; #if defined(VXWORKS) char ntoabuf[32]; #endif @@ -124,10 +134,14 @@ static int ei_epmd_r4_port (struct in_addr *addr, const char *alive, return -1; } - if ((res = ei_write_fill_t(fd, buf, len+2, ms)) != len+2) { - closesocket(fd); - erl_errno = (res == -2) ? ETIMEDOUT : EIO; - return -1; + dlen = len + 2; + err = ei_write_fill_t__(fd, buf, &dlen, tmo); + if (!err && dlen != (ssize_t) len + 2) + erl_errno = EIO; + if (err) { + ei_close__(fd); + EI_CONN_SAVE_ERRNO__(err); + return -1; } #ifdef VXWORKS @@ -142,12 +156,15 @@ static int ei_epmd_r4_port (struct in_addr *addr, const char *alive, "-> PORT2_REQ alive=%s ip=%s",alive,inet_ntoa(*addr)); #endif - /* read first two bytes (response type, response) */ - if ((res = ei_read_fill_t(fd, buf, 2, ms)) != 2) { - EI_TRACE_ERR0("ei_epmd_r4_port","<- CLOSE"); - erl_errno = (res == -2) ? ETIMEDOUT : EIO; - closesocket(fd); - return -2; /* version mismatch */ + dlen = (ssize_t) 2; + err = ei_read_fill_t__(fd, buf, &dlen, tmo); + if (!err && dlen != (ssize_t) 2) + erl_errno = EIO; + if (err) { + EI_TRACE_ERR0("ei_epmd_r4_port","<- CLOSE"); + ei_close__(fd); + EI_CONN_SAVE_ERRNO__(err); + return -2; } s = buf; @@ -156,7 +173,7 @@ static int ei_epmd_r4_port (struct in_addr *addr, const char *alive, if (res != EI_EPMD_PORT2_RESP) { /* response type */ EI_TRACE_ERR1("ei_epmd_r4_port","<- unknown (%d)",res); EI_TRACE_ERR0("ei_epmd_r4_port","-> CLOSE"); - closesocket(fd); + ei_close__(fd); erl_errno = EIO; return -1; } @@ -167,7 +184,7 @@ static int ei_epmd_r4_port (struct in_addr *addr, const char *alive, if ((res = get8(s))) { /* got negative response */ EI_TRACE_ERR1("ei_epmd_r4_port","<- PORT2_RESP result=%d (failure)",res); - closesocket(fd); + ei_close__(fd); erl_errno = EIO; return -1; } @@ -175,14 +192,18 @@ static int ei_epmd_r4_port (struct in_addr *addr, const char *alive, EI_TRACE_CONN1("ei_epmd_r4_port","<- PORT2_RESP result=%d (ok)",res); /* expecting remaining 8 bytes */ - if ((res = ei_read_fill_t(fd,buf,8,ms)) != 8) { + dlen = (ssize_t) 8; + err = ei_read_fill_t__(fd, buf, &dlen, tmo); + if (!err && dlen != (ssize_t) 8) + err = EIO; + if (err) { EI_TRACE_ERR0("ei_epmd_r4_port","<- CLOSE"); - erl_errno = (res == -2) ? ETIMEDOUT : EIO; - closesocket(fd); + ei_close__(fd); + EI_CONN_SAVE_ERRNO__(err); return -1; } - closesocket(fd); + ei_close__(fd); s = buf; port = get16be(s); diff --git a/lib/erl_interface/src/epmd/epmd_publish.c b/lib/erl_interface/src/epmd/epmd_publish.c index 47d68a6db0..20b8e867e8 100644 --- a/lib/erl_interface/src/epmd/epmd_publish.c +++ b/lib/erl_interface/src/epmd/epmd_publish.c @@ -68,8 +68,10 @@ static int ei_epmd_r4_publish (int port, const char *alive, unsigned ms) int nlen = strlen(alive); int len = elen + nlen + 13; /* hard coded: be careful! */ int n; - int res, creation; - + int err, res, creation; + ssize_t dlen; + unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; + if (len > sizeof(buf)-2) { erl_errno = ERANGE; @@ -93,29 +95,39 @@ static int ei_epmd_r4_publish (int port, const char *alive, unsigned ms) if ((fd = ei_epmd_connect_tmo(NULL,ms)) < 0) return fd; - if ((res = ei_write_fill_t(fd, buf, len+2, ms)) != len+2) { - closesocket(fd); - erl_errno = (res == -2) ? ETIMEDOUT : EIO; - return -1; + dlen = (ssize_t) len+2; + err = ei_write_fill_t__(fd, buf, &dlen, tmo); + if (!err && dlen != (ssize_t) len + 2) + erl_errno = EIO; + if (err) { + ei_close__(fd); + EI_CONN_SAVE_ERRNO__(err); + return -1; } EI_TRACE_CONN6("ei_epmd_r4_publish", "-> ALIVE2_REQ alive=%s port=%d ntype=%d " "proto=%d dist-high=%d dist-low=%d", alive,port,'H',EI_MYPROTO,EI_DIST_HIGH,EI_DIST_LOW); - - if ((n = ei_read_fill_t(fd, buf, 4, ms)) != 4) { + + dlen = (ssize_t) 4; + err = ei_read_fill_t__(fd, buf, &dlen, tmo); + n = (int) dlen; + if (!err && n != 4) + err = EIO; + if (err) { EI_TRACE_ERR0("ei_epmd_r4_publish","<- CLOSE"); - closesocket(fd); - erl_errno = (n == -2) ? ETIMEDOUT : EIO; + ei_close__(fd); + EI_CONN_SAVE_ERRNO__(err); return -2; /* version mismatch */ } + /* Don't close fd here! It keeps us registered with epmd */ s = buf; if (((res=get8(s)) != EI_EPMD_ALIVE2_RESP)) { /* response */ EI_TRACE_ERR1("ei_epmd_r4_publish","<- unknown (%d)",res); EI_TRACE_ERR0("ei_epmd_r4_publish","-> CLOSE"); - closesocket(fd); + ei_close__(fd); erl_errno = EIO; return -1; } @@ -124,7 +136,7 @@ static int ei_epmd_r4_publish (int port, const char *alive, unsigned ms) if (((res=get8(s)) != 0)) { /* 0 == success */ EI_TRACE_ERR1("ei_epmd_r4_publish"," result=%d (fail)",res); - closesocket(fd); + ei_close__(fd); erl_errno = EIO; return -1; } diff --git a/lib/erl_interface/src/epmd/epmd_unpublish.c b/lib/erl_interface/src/epmd/epmd_unpublish.c index 255d0ffb59..c112f74147 100644 --- a/lib/erl_interface/src/epmd/epmd_unpublish.c +++ b/lib/erl_interface/src/epmd/epmd_unpublish.c @@ -58,7 +58,9 @@ int ei_unpublish_tmo(const char *alive, unsigned ms) char buf[EPMDBUF]; char *s = (char*)buf; int len = 1 + strlen(alive); - int fd, res; + int fd, err; + ssize_t dlen; + unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; if (len > sizeof(buf)-3) { erl_errno = ERANGE; @@ -72,20 +74,29 @@ int ei_unpublish_tmo(const char *alive, unsigned ms) /* FIXME can't connect, return success?! At least commen whats up */ if ((fd = ei_epmd_connect_tmo(NULL,ms)) < 0) return fd; - if ((res = ei_write_fill_t(fd, buf, len+2,ms)) != len+2) { - closesocket(fd); - erl_errno = (res == -2) ? ETIMEDOUT : EIO; - return -1; + dlen = (ssize_t) len+2; + err = ei_write_fill_t__(fd, buf, &dlen, tmo); + if (!err && dlen != (ssize_t) len + 2) + erl_errno = EIO; + if (err) { + ei_close__(fd); + EI_CONN_SAVE_ERRNO__(err); + return -1; } EI_TRACE_CONN1("ei_unpublish_tmo","-> STOP %s",alive); - - if ((res = ei_read_fill_t(fd, buf, 7, ms)) != 7) { - closesocket(fd); - erl_errno = (res == -2) ? ETIMEDOUT : EIO; - return -1; + + dlen = (ssize_t) 7; + err = ei_read_fill_t__(fd, buf, &dlen, tmo); + if (!err && dlen != (ssize_t) 7) + erl_errno = EIO; + if (err) { + ei_close__(fd); + EI_CONN_SAVE_ERRNO__(err); + return -1; } - closesocket(fd); + + ei_close__(fd); buf[7]=(char)0; /* terminate the string */ if (!strcmp("STOPPED",(char *)buf)) { diff --git a/lib/erl_interface/src/legacy/erl_connect.c b/lib/erl_interface/src/legacy/erl_connect.c index 7ffd545d3e..e2fd4611c0 100644 --- a/lib/erl_interface/src/legacy/erl_connect.c +++ b/lib/erl_interface/src/legacy/erl_connect.c @@ -179,15 +179,13 @@ int erl_xconnect(Erl_IpAddr addr, char *alivename) * * API: erl_close_connection() * - * Close a connection. FIXME call ei_close_connection() later. - * * Returns 0 on success and -1 on failure. * ***************************************************************************/ int erl_close_connection(int fd) { - return closesocket(fd); + return ei_close_connection(fd); } /* @@ -220,7 +218,10 @@ int erl_reg_send(int fd, char *server_name, ETERM *msg) ei_x_buff x; int r; - ei_x_new_with_version(&x); + if (ei_x_new_with_version(&x) < 0) { + erl_errno = ENOMEM; + return 0; + } if (ei_x_encode_term(&x, msg) < 0) { erl_errno = EINVAL; r = 0; diff --git a/lib/erl_interface/src/misc/ei_internal.h b/lib/erl_interface/src/misc/ei_internal.h index aa6aacd703..0c58245c0a 100644 --- a/lib/erl_interface/src/misc/ei_internal.h +++ b/lib/erl_interface/src/misc/ei_internal.h @@ -22,19 +22,20 @@ #ifndef _EI_INTERNAL_H #define _EI_INTERNAL_H +#ifdef EI_HIDE_REAL_ERRNO +# define EI_CONN_SAVE_ERRNO__(E) \ + ((E) == ETIMEDOUT ? (erl_errno = ETIMEDOUT) : (erl_errno = EIO)) +#else +# define EI_CONN_SAVE_ERRNO__(E) \ + (erl_errno = (E)) +#endif + /* * Some useful stuff not to be exported to users. */ #ifdef __WIN32__ #define MAXPATHLEN 256 -#define writesocket(sock,buf,nbyte) send(sock,buf,nbyte,0) -#define readsocket(sock,buf,nbyte) recv(sock,buf,nbyte,0) -#else /* not __WIN32__ */ -#define writesocket write -#define readsocket read -#define closesocket close -#define ioctlsocket ioctl #endif /* @@ -155,4 +156,7 @@ extern int ei_tracelevel; void ei_trace_printf(const char *name, int level, const char *format, ...); int ei_internal_use_r9_pids_ports(void); + +int ei_get_cbs_ctx__(ei_socket_callbacks **cbs, void **ctx, int fd); + #endif /* _EI_INTERNAL_H */ diff --git a/lib/erl_interface/src/misc/ei_portio.c b/lib/erl_interface/src/misc/ei_portio.c index 8cd35bf2e5..726b1af82d 100644 --- a/lib/erl_interface/src/misc/ei_portio.c +++ b/lib/erl_interface/src/misc/ei_portio.c @@ -22,6 +22,7 @@ #ifdef __WIN32__ #include <winsock2.h> #include <windows.h> +#include <winbase.h> #include <process.h> #include <stdio.h> #include <stdlib.h> @@ -35,10 +36,6 @@ static unsigned long param_one = 1; #define SET_BLOCKING(Sock) ioctlsocket((Sock),FIONBIO,¶m_zero) #define SET_NONBLOCKING(Sock) ioctlsocket((Sock),FIONBIO,¶m_one) -#define ERROR_WOULDBLOCK WSAEWOULDBLOCK -#define ERROR_TIMEDOUT WSAETIMEDOUT -#define ERROR_INPROGRESS WSAEINPROGRESS -#define GET_SOCKET_ERROR() WSAGetLastError() #define MEANS_SOCKET_ERROR(Ret) ((Ret == SOCKET_ERROR)) #define IS_INVALID_SOCKET(Sock) ((Sock) == INVALID_SOCKET) @@ -53,15 +50,16 @@ static unsigned long param_one = 1; #include <sys/types.h> #include <ioLib.h> #include <unistd.h> +#include <sys/types.h> +#include <sys/socket.h> +#include <netinet/in.h> +#include <netinet/tcp.h> +#include <timers.h> static unsigned long param_zero = 0; static unsigned long param_one = 1; #define SET_BLOCKING(Sock) ioctl((Sock),FIONBIO,(int)¶m_zero) #define SET_NONBLOCKING(Sock) ioctl((Sock),FIONBIO,(int)¶m_one) -#define ERROR_WOULDBLOCK EWOULDBLOCK -#define ERROR_TIMEDOUT ETIMEDOUT -#define ERROR_INPROGRESS EINPROGRESS -#define GET_SOCKET_ERROR() (errno) #define MEANS_SOCKET_ERROR(Ret) ((Ret) == ERROR) #define IS_INVALID_SOCKET(Sock) ((Sock) < 0) @@ -69,106 +67,394 @@ static unsigned long param_one = 1; #include <stdlib.h> #include <sys/types.h> #include <sys/socket.h> -#include <sys/uio.h> #include <unistd.h> #include <fcntl.h> #include <errno.h> +#include <netinet/in.h> +#include <netinet/tcp.h> +#include <arpa/inet.h> +#include <netdb.h> -#ifndef EWOULDBLOCK -#define ERROR_WOULDBLOCK EAGAIN -#else -#define ERROR_WOULDBLOCK EWOULDBLOCK -#endif #define SET_BLOCKING(fd) fcntl((fd), F_SETFL, \ fcntl((fd), F_GETFL, 0) & ~O_NONBLOCK) #define SET_NONBLOCKING(fd) fcntl((fd), F_SETFL, \ fcntl((fd), F_GETFL, 0) | O_NONBLOCK) -#define ERROR_TIMEDOUT ETIMEDOUT -#define ERROR_INPROGRESS EINPROGRESS -#define GET_SOCKET_ERROR() (errno) #define MEANS_SOCKET_ERROR(Ret) ((Ret) < 0) #define IS_INVALID_SOCKET(Sock) ((Sock) < 0) #endif /* common includes */ -#include "eidef.h" #include <stdio.h> #include <stdlib.h> #include <string.h> -#include "ei_portio.h" -#include "ei_internal.h" - #ifdef HAVE_SYS_TIME_H #include <sys/time.h> #else #include <time.h> #endif +#include "eidef.h" +#include "ei_portio.h" +#include "ei_internal.h" + +#ifdef __WIN32__ + +#define writesocket(sock,buf,nbyte) send(sock,buf,nbyte,0) +#define readsocket(sock,buf,nbyte) recv(sock,buf,nbyte,0) -#ifdef HAVE_WRITEV -static int ei_writev_t(int fd, struct iovec *iov, int iovcnt, unsigned ms) +static int get_error(void) { - int res; - if (ms != 0) { - fd_set writemask; - struct timeval tv; - tv.tv_sec = (time_t) (ms / 1000U); - ms %= 1000U; - tv.tv_usec = (time_t) (ms * 1000U); - FD_ZERO(&writemask); - FD_SET(fd,&writemask); - switch (select(fd+1, NULL, &writemask, NULL, &tv)) { - case -1 : - return -1; /* i/o error */ - case 0: - return -2; /* timeout */ - default: - if (!FD_ISSET(fd, &writemask)) { - return -1; /* Other error */ - } - } + switch (WSAGetLastError()) { + case WSAEWOULDBLOCK: return EWOULDBLOCK; + case WSAETIMEDOUT: return ETIMEDOUT; + case WSAEINPROGRESS: return EINPROGRESS; + case WSA_NOT_ENOUGH_MEMORY: return ENOMEM; + case WSA_INVALID_PARAMETER: return EINVAL; + case WSAEBADF: return EBADF; + case WSAEINVAL: return EINVAL; + case WSAEADDRINUSE: return EADDRINUSE; + case WSAENETUNREACH: return ENETUNREACH; + case WSAECONNABORTED: return ECONNABORTED; + case WSAECONNRESET: return ECONNRESET; + case WSAECONNREFUSED: return ECONNREFUSED; + case WSAEHOSTUNREACH: return EHOSTUNREACH; + case WSAEMFILE: return EMFILE; + case WSAEALREADY: return EALREADY; + default: return EIO; } +} + +#else /* not __WIN32__ */ + +#define writesocket write +#define readsocket read +#define closesocket close +#define ioctlsocket ioctl + +static int get_error(void) +{ + int err = errno; + if (err == 0) + return EIO; /* Make sure never to return 0 as error code... */ + return err; +} + +#endif + +int ei_plugin_socket_impl__ = 0; + +/* + * Callbacks for communication over TCP/IPv4 + */ + +static int tcp_get_fd(void *ctx, int *fd) +{ + return EI_DFLT_CTX_TO_FD__(ctx, fd); +} + +static int tcp_hs_packet_header_size(void *ctx, int *sz) +{ + int fd; + *sz = 2; + return EI_DFLT_CTX_TO_FD__(ctx, &fd); +} + +static int tcp_handshake_complete(void *ctx) +{ + int res, fd, one = 1; + + res = EI_DFLT_CTX_TO_FD__(ctx, &fd); + if (res) + return res; + + res = setsockopt(fd, IPPROTO_TCP, TCP_NODELAY, (char *)&one, sizeof(one)); + if (MEANS_SOCKET_ERROR(res)) + return get_error(); + + res = setsockopt(fd, SOL_SOCKET, SO_KEEPALIVE, (char *)&one, sizeof(one)); + if (MEANS_SOCKET_ERROR(res)) + return get_error(); + + return 0; +} + +static int tcp_socket(void **ctx, void *setup_ctx) +{ + int fd = socket(AF_INET, SOCK_STREAM, 0); + if (MEANS_SOCKET_ERROR(fd)) + return get_error(); + + *ctx = EI_FD_AS_CTX__(fd); + return 0; +} + +static int tcp_close(void *ctx) +{ + int fd, res; + + res = EI_DFLT_CTX_TO_FD__(ctx, &fd); + if (res) + return res; + + res = closesocket(fd); + if (MEANS_SOCKET_ERROR(res)) + return get_error(); + + return 0; +} + +static int tcp_listen(void *ctx, void *addr, int *len, int backlog) +{ + int res, fd; + socklen_t sz = (socklen_t) *len; + int on = 1; + + res = EI_DFLT_CTX_TO_FD__(ctx, &fd); + if (res) + return res; + + res = setsockopt(fd, SOL_SOCKET, SO_REUSEADDR, (char *) &on, sizeof(on)); + if (MEANS_SOCKET_ERROR(res)) + return get_error(); + + res = bind(fd, (struct sockaddr *) addr, sz); + if (MEANS_SOCKET_ERROR(res)) + return get_error(); + + res = getsockname(fd, (struct sockaddr *) addr, (socklen_t *) &sz); + if (MEANS_SOCKET_ERROR(res)) + return get_error(); + *len = (int) sz; + + res = listen(fd, backlog); + if (MEANS_SOCKET_ERROR(res)) + return get_error(); + + return 0; +} + +static int tcp_accept(void **ctx, void *addr, int *len, unsigned unused) +{ + int fd, res; + socklen_t addr_len = (socklen_t) *len; + + if (!ctx) + return EINVAL; + + res = EI_DFLT_CTX_TO_FD__(*ctx, &fd); + if (res) + return res; + + res = accept(fd, (struct sockaddr*) &addr, &addr_len); + if (MEANS_SOCKET_ERROR(res)) + return get_error(); + + *len = (int) addr_len; + + *ctx = EI_FD_AS_CTX__(res); + return 0; +} + +static int tcp_connect(void *ctx, void *addr, int len, unsigned unused) +{ + int res, fd; + + res = EI_DFLT_CTX_TO_FD__(ctx, &fd); + if (res) + return res; + + res = connect(fd, (struct sockaddr *) addr, len); + if (MEANS_SOCKET_ERROR(res)) + return get_error(); + + return 0; +} + +#if defined(EI_HAVE_STRUCT_IOVEC__) && defined(HAVE_WRITEV) + +static int tcp_writev(void *ctx, const void *viov, int iovcnt, ssize_t *len, unsigned unused) +{ + const struct iovec *iov = (const struct iovec *) viov; + int fd, error; + ssize_t res; + + error = EI_DFLT_CTX_TO_FD__(ctx, &fd); + if (error) + return error; + res = writev(fd, iov, iovcnt); - return (res < 0) ? -1 : res; + if (MEANS_SOCKET_ERROR(res)) + return get_error(); + *len = res; + return 0; +} + +#endif + +static int tcp_write(void *ctx, const char* buf, ssize_t *len, unsigned unused) +{ + int error, fd; + ssize_t res; + + error = EI_DFLT_CTX_TO_FD__(ctx, &fd); + if (error) + return error; + + res = writesocket(fd, buf, *len); + if (MEANS_SOCKET_ERROR(res)) + return get_error(); + *len = res; + return 0; } -int ei_writev_fill_t(int fd, const struct iovec *iov, int iovcnt, unsigned ms) +static int tcp_read(void *ctx, char* buf, ssize_t *len, unsigned unused) { - int i; - int done; + int error, fd; + ssize_t res; + + error = EI_DFLT_CTX_TO_FD__(ctx, &fd); + if (error) + return error; + + res = readsocket(fd, buf, *len); + if (MEANS_SOCKET_ERROR(res)) + return get_error(); + *len = res; + return 0; +} + +ei_socket_callbacks ei_default_socket_callbacks = { + 0, /* flags */ + tcp_socket, + tcp_close, + tcp_listen, + tcp_accept, + tcp_connect, +#if defined(EI_HAVE_STRUCT_IOVEC__) && defined(HAVE_WRITEV) + tcp_writev, +#else + NULL, +#endif + tcp_write, + tcp_read, + + tcp_hs_packet_header_size, + tcp_handshake_complete, + tcp_handshake_complete, + tcp_get_fd + +}; + + +/* + * + */ + +#if defined(EI_HAVE_STRUCT_IOVEC__) + +int ei_socket_callbacks_have_writev__(ei_socket_callbacks *cbs) +{ + return !!cbs->writev; +} + +static int writev_ctx_t__(ei_socket_callbacks *cbs, void *ctx, + const struct iovec *iov, int iovcnt, + ssize_t *len, + unsigned ms) +{ + int error; + + if (!(cbs->flags & EI_SCLBK_FLG_FULL_IMPL) && ms != EI_SCLBK_INF_TMO) { + int fd; + + error = EI_GET_FD__(cbs, ctx, &fd); + if (error) + return error; + + do { + fd_set writemask; + struct timeval tv; + + tv.tv_sec = (time_t) (ms / 1000U); + ms %= 1000U; + tv.tv_usec = (time_t) (ms * 1000U); + FD_ZERO(&writemask); + FD_SET(fd,&writemask); + switch (select(fd+1, NULL, &writemask, NULL, &tv)) { + case -1 : + error = get_error(); + if (error != EINTR) + return error; + break; + case 0: + return ETIMEDOUT; /* timeout */ + default: + if (!FD_ISSET(fd, &writemask)) { + return EIO; /* Other error */ + } + error = 0; + break; + } + } while (error == EINTR); + } + do { + error = cbs->writev(ctx, (const void *) iov, iovcnt, len, ms); + } while (error == EINTR); + return error; +} + +int ei_writev_fill_ctx_t__(ei_socket_callbacks *cbs, void *ctx, + const struct iovec *iov, int iovcnt, + ssize_t *len, + unsigned ms) +{ + ssize_t i, done, sum; struct iovec *iov_base = NULL; struct iovec *current_iov; int current_iovcnt; - int sum; + int fd, error; + int basic; + + if (!cbs->writev) + return ENOTSUP; + + error = EI_GET_FD__(cbs, ctx, &fd); + if (error) + return error; + basic = !(cbs->flags & EI_SCLBK_FLG_FULL_IMPL); + for (sum = 0, i = 0; i < iovcnt; ++i) { sum += iov[i].iov_len; } - if (ms != 0U) { + if (basic && ms != 0U) { SET_NONBLOCKING(fd); } current_iovcnt = iovcnt; current_iov = (struct iovec *) iov; done = 0; for (;;) { - i = ei_writev_t(fd, current_iov, current_iovcnt, ms); - if (i <= 0) { /* ei_writev_t should always return at least 1 */ + + error = writev_ctx_t__(cbs, ctx, current_iov, current_iovcnt, &i, ms); + if (error) { + *len = done; if (ms != 0U) { SET_BLOCKING(fd); } if (iov_base != NULL) { free(iov_base); } - return (i); - } + return error; + } done += i; if (done < sum) { if (iov_base == NULL) { iov_base = malloc(sizeof(struct iovec) * iovcnt); if (iov_base == NULL) { - return -1; + *len = done; + return ENOMEM; } memcpy(iov_base, iov, sizeof(struct iovec) * iovcnt); current_iov = iov_base; @@ -189,195 +475,383 @@ int ei_writev_fill_t(int fd, const struct iovec *iov, int iovcnt, unsigned break; } } - if (ms != 0U) { + if (basic && ms != 0U) { SET_BLOCKING(fd); } if (iov_base != NULL) { free(iov_base); } - return (sum); + *len = done; + return 0; } +#endif /* defined(EI_HAVE_STRUCT_IOVEC__) */ -#endif - -int ei_connect_t(int fd, void *sinp, int sin_siz, unsigned ms) +int ei_socket_ctx__(ei_socket_callbacks *cbs, void **ctx, void *setup_ctx) { int res; - int error; - int s_res; - struct timeval tv; - fd_set writefds; - fd_set exceptfds; - - if (ms == 0) { - res = connect(fd, sinp, sin_siz); - return (res < 0) ? -1 : res; - } else { - SET_NONBLOCKING(fd); - res = connect(fd, sinp, sin_siz); - error = GET_SOCKET_ERROR(); - SET_BLOCKING(fd); - if (!MEANS_SOCKET_ERROR(res)) { - return (res < 0) ? -1 : res; - } else { - if (error != ERROR_WOULDBLOCK && - error != ERROR_INPROGRESS) { - return -1; - } else { - tv.tv_sec = (long) (ms/1000U); - ms %= 1000U; - tv.tv_usec = (long) (ms * 1000U); - FD_ZERO(&writefds); - FD_SET(fd,&writefds); - FD_ZERO(&exceptfds); - FD_SET(fd,&exceptfds); - s_res = select(fd + 1, NULL, &writefds, &exceptfds, &tv); - switch (s_res) { - case 0: - return -2; - case 1: - if (FD_ISSET(fd, &exceptfds)) { - return -1; - } else { - return 0; /* Connect completed */ - } - default: - return -1; - } - } - } - } + + do { + res = cbs->socket(ctx, setup_ctx); + } while (res == EINTR); + + return res; } -int ei_accept_t(int fd, void *addr, void *addrlen, unsigned ms) +int ei_close_ctx__(ei_socket_callbacks *cbs, void *ctx) { - int res; - if (ms != 0) { - fd_set readmask; - struct timeval tv; - tv.tv_sec = (time_t) (ms / 1000U); - ms %= 1000U; - tv.tv_usec = (time_t) (ms * 1000U); - FD_ZERO(&readmask); - FD_SET(fd,&readmask); - switch (select(fd+1, &readmask, NULL, NULL, &tv)) { - case -1 : - return -1; /* i/o error */ - case 0: - return -2; /* timeout */ - default: - if (!FD_ISSET(fd, &readmask)) { - return -1; /* Other error */ - } - } - } - res = (int) accept(fd,addr,addrlen); - return (res < 0) ? -1 : res; + return cbs->close(ctx); } + +int ei_connect_ctx_t__(ei_socket_callbacks *cbs, void *ctx, + void *addr, int len, unsigned ms) +{ + int res, fd; + + if ((cbs->flags & EI_SCLBK_FLG_FULL_IMPL) || ms == EI_SCLBK_INF_TMO) { + do { + res = cbs->connect(ctx, addr, len, ms); + } while (res == EINTR); + return res; + } + + res = EI_GET_FD__(cbs, ctx, &fd); + if (res) + return res; + SET_NONBLOCKING(fd); + do { + res = cbs->connect(ctx, addr, len, 0); + } while (res == EINTR); + SET_BLOCKING(fd); + + switch (res) { + case EINPROGRESS: + case EAGAIN: +#ifdef EWOULDBLOCK +#if EWOULDBLOCK != EAGAIN + case EWOULDBLOCK: +#endif +#endif + break; + default: + return res; + } + while (1) { + struct timeval tv; + fd_set writefds; + fd_set exceptfds; + + tv.tv_sec = (long) (ms/1000U); + ms %= 1000U; + tv.tv_usec = (long) (ms * 1000U); + FD_ZERO(&writefds); + FD_SET(fd,&writefds); + FD_ZERO(&exceptfds); + FD_SET(fd,&exceptfds); + res = select(fd + 1, NULL, &writefds, &exceptfds, &tv); + switch (res) { + case -1: + res = get_error(); + if (res != EINTR) + return res; + break; + case 0: + return ETIMEDOUT; + case 1: + if (!FD_ISSET(fd, &exceptfds)) + return 0; /* Connect completed */ + /* fall through... */ + default: + return EIO; + } + } +} -static int ei_read_t(int fd, char* buf, int len, unsigned ms) +int ei_listen_ctx__(ei_socket_callbacks *cbs, void *ctx, + void *adr, int *len, int backlog) { int res; - if (ms != 0) { - fd_set readmask; - struct timeval tv; - tv.tv_sec = (time_t) (ms / 1000U); - ms %= 1000U; - tv.tv_usec = (time_t) (ms * 1000U); - FD_ZERO(&readmask); - FD_SET(fd,&readmask); - switch (select(fd+1, &readmask, NULL, NULL, &tv)) { - case -1 : - return -1; /* i/o error */ - case 0: - return -2; /* timeout */ - default: - if (!FD_ISSET(fd, &readmask)) { - return -1; /* Other error */ - } - } + + do { + res = cbs->listen(ctx, adr, len, backlog); + } while (res == EINTR); + return res; +} + +int ei_accept_ctx_t__(ei_socket_callbacks *cbs, void **ctx, + void *addr, int *len, unsigned ms) +{ + int error; + + if (!(cbs->flags & EI_SCLBK_FLG_FULL_IMPL) && ms != EI_SCLBK_INF_TMO) { + int fd; + + error = EI_GET_FD__(cbs, *ctx, &fd); + if (error) + return error; + + do { + fd_set readmask; + struct timeval tv; + + tv.tv_sec = (time_t) (ms / 1000U); + ms %= 1000U; + tv.tv_usec = (time_t) (ms * 1000U); + FD_ZERO(&readmask); + FD_SET(fd,&readmask); + switch (select(fd+1, &readmask, NULL, NULL, &tv)) { + case -1 : + error = get_error(); + if (error != EINTR) + return error; + break; + case 0: + return ETIMEDOUT; /* timeout */ + default: + if (!FD_ISSET(fd, &readmask)) { + return EIO; /* Other error */ + } + error = 0; + break; + } + } while (error == EINTR); } - res = readsocket(fd, buf, len); - return (res < 0) ? -1 : res; + do { + error = cbs->accept(ctx, addr, len, ms); + } while (error == EINTR); + return error; } -static int ei_write_t(int fd, const char* buf, int len, unsigned ms) +static int read_ctx_t__(ei_socket_callbacks *cbs, void *ctx, + char* buf, ssize_t *len, unsigned ms) { - int res; - if (ms != 0) { - fd_set writemask; - struct timeval tv; - tv.tv_sec = (time_t) (ms / 1000U); - ms %= 1000U; - tv.tv_usec = (time_t) (ms * 1000U); - FD_ZERO(&writemask); - FD_SET(fd,&writemask); - switch (select(fd+1, NULL, &writemask, NULL, &tv)) { - case -1 : - return -1; /* i/o error */ - case 0: - return -2; /* timeout */ - default: - if (!FD_ISSET(fd, &writemask)) { - return -1; /* Other error */ - } - } + int error; + + if (!(cbs->flags & EI_SCLBK_FLG_FULL_IMPL) && ms != EI_SCLBK_INF_TMO) { + int fd; + + error = EI_GET_FD__(cbs, ctx, &fd); + if (error) + return error; + + do { + fd_set readmask; + struct timeval tv; + + tv.tv_sec = (time_t) (ms / 1000U); + ms %= 1000U; + tv.tv_usec = (time_t) (ms * 1000U); + FD_ZERO(&readmask); + FD_SET(fd,&readmask); + switch (select(fd+1, &readmask, NULL, NULL, &tv)) { + case -1 : + error = get_error(); + if (error != EINTR) + return error; + break; + case 0: + return ETIMEDOUT; /* timeout */ + default: + if (!FD_ISSET(fd, &readmask)) { + return EIO; /* Other error */ + } + error = 0; + break; + } + } while (error == EINTR); + } + do { + error = cbs->read(ctx, buf, len, ms); + } while (error == EINTR); + return error; +} + +static int write_ctx_t__(ei_socket_callbacks *cbs, void *ctx, const char* buf, ssize_t *len, unsigned ms) +{ + int error; + + if (!(cbs->flags & EI_SCLBK_FLG_FULL_IMPL) && ms != EI_SCLBK_INF_TMO) { + int fd; + + error = EI_GET_FD__(cbs, ctx, &fd); + if (error) + return error; + + do { + fd_set writemask; + struct timeval tv; + + tv.tv_sec = (time_t) (ms / 1000U); + ms %= 1000U; + tv.tv_usec = (time_t) (ms * 1000U); + FD_ZERO(&writemask); + FD_SET(fd,&writemask); + switch (select(fd+1, NULL, &writemask, NULL, &tv)) { + case -1 : + error = get_error(); + if (error != EINTR) + return error; + break; + case 0: + return ETIMEDOUT; /* timeout */ + default: + if (!FD_ISSET(fd, &writemask)) { + return EIO; /* Other error */ + } + error = 0; + break; + } + } while (error == EINTR); } - res = writesocket(fd, buf, len); - return (res < 0) ? -1 : res; + do { + error = cbs->write(ctx, buf, len, ms); + } while (error == EINTR); + return error; } /* * Fill buffer, return buffer length, 0 for EOF, < 0 (and sets errno) * for error. */ -int ei_read_fill_t(int fd, char* buf, int len, unsigned ms) +int ei_read_fill_ctx_t__(ei_socket_callbacks *cbs, void *ctx, char* buf, ssize_t *len, unsigned ms) { - int i,got=0; + ssize_t got = 0; + ssize_t want = *len; do { - i = ei_read_t(fd, buf+got, len-got, ms); - if (i <= 0) - return (i); - got += i; - } while (got < len); - return (len); - + ssize_t read_len = want-got; + int error; + + do { + error = read_ctx_t__(cbs, ctx, buf+got, &read_len, ms); + } while (error == EINTR); + if (error) + return error; + if (read_len == 0) { + *len = got; + return 0; + } + got += read_len; + } while (got < want); + + *len = got; + return 0; } /* read_fill */ -int ei_read_fill(int fd, char* buf, int len) +int ei_read_fill_ctx__(ei_socket_callbacks *cbs, void *ctx, char* buf, ssize_t *len) { - return ei_read_fill_t(fd, buf, len, 0); + return ei_read_fill_ctx_t__(cbs, ctx, buf, len, 0); } /* write entire buffer on fd or fail (setting errno) */ -int ei_write_fill_t(int fd, const char *buf, int len, unsigned ms) +int ei_write_fill_ctx_t__(ei_socket_callbacks *cbs, void *ctx, const char *buf, ssize_t *len, unsigned ms) { - int i,done=0; - if (ms != 0U) { + ssize_t tot = *len, done = 0; + int error, fd = -1, basic = !(cbs->flags & EI_SCLBK_FLG_FULL_IMPL); + + if (basic && ms != 0U) { + error = EI_GET_FD__(cbs, ctx, &fd); + if (error) + return error; SET_NONBLOCKING(fd); } do { - i = ei_write_t(fd, buf+done, len-done, ms); - if (i <= 0) { - if (ms != 0U) { + ssize_t write_len = tot-done; + error = write_ctx_t__(cbs, ctx, buf+done, &write_len, ms); + if (error) { + *len = done; + if (basic && ms != 0U) { SET_BLOCKING(fd); } - return (i); + return error; } - done += i; - } while (done < len); - if (ms != 0U) { + done += write_len; + } while (done < tot); + if (basic && ms != 0U) { SET_BLOCKING(fd); } - return (len); + *len = done; + return 0; +} + +int ei_write_fill_ctx__(ei_socket_callbacks *cbs, void *ctx, const char *buf, ssize_t *len) +{ + return ei_write_fill_ctx_t__(cbs, ctx, buf, len, 0); +} + +/* + * Internal API for TCP/IPv4 + */ + +int ei_connect_t__(int fd, void *addr, int len, unsigned ms) +{ + return ei_connect_ctx_t__(&ei_default_socket_callbacks, EI_FD_AS_CTX__(fd), + addr, len, ms); } -int ei_write_fill(int fd, const char *buf, int len) +int ei_socket__(int *fd) { - return ei_write_fill_t(fd, buf, len, 0); + void *ctx; + int error = ei_socket_ctx__(&ei_default_socket_callbacks, &ctx, NULL); + if (error) + return error; + return EI_GET_FD__(&ei_default_socket_callbacks, ctx, fd); } +int ei_close__(int fd) +{ + return ei_close_ctx__(&ei_default_socket_callbacks, EI_FD_AS_CTX__(fd)); +} + +int ei_listen__(int fd, void *adr, int *len, int backlog) +{ + return ei_listen_ctx__(&ei_default_socket_callbacks, EI_FD_AS_CTX__(fd), + adr, len, backlog); +} + +int ei_accept_t__(int *fd, void *addr, int *len, unsigned ms) +{ + void *ctx = EI_FD_AS_CTX__(*fd); + int error = ei_accept_ctx_t__(&ei_default_socket_callbacks, &ctx, + addr, len, ms); + if (error) + return error; + return EI_GET_FD__(&ei_default_socket_callbacks, ctx, fd); +} + +int ei_read_fill_t__(int fd, char* buf, ssize_t *len, unsigned ms) +{ + return ei_read_fill_ctx_t__(&ei_default_socket_callbacks, EI_FD_AS_CTX__(fd), + buf, len, ms); +} + +int ei_read_fill__(int fd, char* buf, ssize_t *len) +{ + return ei_read_fill_ctx_t__(&ei_default_socket_callbacks, EI_FD_AS_CTX__(fd), + buf, len, 0); +} + +int ei_write_fill_t__(int fd, const char *buf, ssize_t *len, unsigned ms) +{ + return ei_write_fill_ctx_t__(&ei_default_socket_callbacks, EI_FD_AS_CTX__(fd), + buf, len, ms); +} + +int ei_write_fill__(int fd, const char *buf, ssize_t *len) +{ + return ei_write_fill_ctx_t__(&ei_default_socket_callbacks, EI_FD_AS_CTX__(fd), + buf, len, 0); +} + +#if defined(EI_HAVE_STRUCT_IOVEC__) && defined(HAVE_WRITEV) + +int ei_writev_fill_t__(int fd, const struct iovec *iov, int iovcnt, ssize_t *len, unsigned ms) +{ + return ei_writev_fill_ctx_t__(&ei_default_socket_callbacks, EI_FD_AS_CTX__(fd), + iov, iovcnt, len, ms); +} + +#endif + diff --git a/lib/erl_interface/src/misc/ei_portio.h b/lib/erl_interface/src/misc/ei_portio.h index bded811a35..a84b5ca09c 100644 --- a/lib/erl_interface/src/misc/ei_portio.h +++ b/lib/erl_interface/src/misc/ei_portio.h @@ -21,21 +21,94 @@ */ #ifndef _EI_PORTIO_H #define _EI_PORTIO_H -#if !defined(__WIN32__) && !defined(VXWORKS) -#ifdef HAVE_WRITEV + +#undef EI_HAVE_STRUCT_IOVEC__ +#if !defined(__WIN32__) && !defined(VXWORKS) && defined(HAVE_SYS_UIO_H) /* Declaration of struct iovec *iov should be visible in this scope. */ -#include <sys/uio.h> +# include <sys/uio.h> +# define EI_HAVE_STRUCT_IOVEC__ #endif + +/* + * Internal API. Should not be used outside of the erl_interface application... + */ + +int ei_socket_ctx__(ei_socket_callbacks *cbs, void **ctx, void *setup); +int ei_close_ctx__(ei_socket_callbacks *cbs, void *ctx); +int ei_listen_ctx__(ei_socket_callbacks *cbs, void *ctx, void *adr, int *len, int backlog); +int ei_accept_ctx_t__(ei_socket_callbacks *cbs, void **ctx, void *addr, int *len, unsigned ms); +int ei_connect_ctx_t__(ei_socket_callbacks *cbs, void *ctx, void *addr, int len, unsigned ms); +int ei_read_fill_ctx__(ei_socket_callbacks *cbs, void *ctx, char* buf, ssize_t *len); +int ei_write_fill_ctx__(ei_socket_callbacks *cbs, void *ctx, const char *buf, ssize_t *len); +int ei_read_fill_ctx_t__(ei_socket_callbacks *cbs, void *ctx, char* buf, ssize_t *len, unsigned ms); +int ei_write_fill_ctx_t__(ei_socket_callbacks *cbs, void *ctx, const char *buf, ssize_t *len, unsigned ms); +#if defined(EI_HAVE_STRUCT_IOVEC__) +int ei_writev_fill_ctx_t__(ei_socket_callbacks *cbs, void *ctx, const struct iovec *iov, int iovcnt, ssize_t *len, unsigned ms); +int ei_socket_callbacks_have_writev__(ei_socket_callbacks *cbs); #endif -int ei_accept_t(int fd, void *addr, void *addrlen, unsigned ms); -int ei_connect_t(int fd, void *sinp, int sin_siz, unsigned ms); -int ei_read_fill(int fd, char* buf, int len); -int ei_write_fill(int fd, const char *buf, int len); -int ei_read_fill_t(int fd, char* buf, int len, unsigned ms); -int ei_write_fill_t(int fd, const char *buf, int len, unsigned ms); -#ifdef HAVE_WRITEV -int ei_writev_fill_t(int fd, const struct iovec *iov, int iovcnt, unsigned ms); +ei_socket_callbacks ei_default_socket_callbacks; + +#define EI_FD_AS_CTX__(FD) \ + ((void *) (long) (FD)) + +#define EI_DFLT_CTX_TO_FD__(CTX, FD) \ + ((int) (long) (CTX) < 0 \ + ? EBADF \ + : (*(FD) = (int) (long) (CTX), 0)) + +#define EI_GET_FD__(CBS, CTX, FD) \ + ((CBS) == &ei_default_socket_callbacks \ + ? EI_DFLT_CTX_TO_FD__((CTX), FD) \ + : (CBS)->get_fd((CTX), (FD))) + +extern int ei_plugin_socket_impl__; + +#if !defined(_REENTRANT) + +#define EI_HAVE_PLUGIN_SOCKET_IMPL__ \ + ei_plugin_socket_impl__ +#define EI_SET_HAVE_PLUGIN_SOCKET_IMPL__ \ + ei_plugin_socket_impl__ = 1 + +#elif ((ETHR_HAVE___atomic_load_n & SIZEOF_INT) \ + && (ETHR_HAVE___atomic_store_n & SIZEOF_INT)) + +#define EI_HAVE_PLUGIN_SOCKET_IMPL__ \ + __atomic_load_n(&ei_plugin_socket_impl__, __ATOMIC_ACQUIRE) +#define EI_SET_HAVE_PLUGIN_SOCKET_IMPL__ \ + __atomic_store_n(&ei_plugin_socket_impl__, 1, __ATOMIC_RELEASE) + +#else + +/* No gcc atomics; always lookup using ei_get_cbs_ctx()... */ +#define EI_HAVE_PLUGIN_SOCKET_IMPL__ 0 +#define EI_SET_HAVE_PLUGIN_SOCKET_IMPL__ (void) 0 + +#endif + +#define EI_GET_CBS_CTX__(CBS, CTX, FD) \ + (EI_HAVE_PLUGIN_SOCKET_IMPL__ \ + ? ei_get_cbs_ctx__((CBS), (CTX), (FD)) \ + : ((FD) < 0 \ + ? EBADF \ + : (*(CBS) = &ei_default_socket_callbacks, \ + *(CTX) = EI_FD_AS_CTX__((FD)), \ + 0))) +/* + * The following uses our own TCP/IPv4 socket implementation... + */ +int ei_socket__(int *fd); +int ei_close__(int fd); +int ei_listen__(int fd, void *adr, int *len, int backlog); +int ei_accept_t__(int *fd, void *addr, int *len, unsigned ms); +int ei_connect_t__(int fd, void *addr, int len, unsigned ms); +int ei_read_fill__(int fd, char* buf, ssize_t *len); +int ei_write_fill__(int fd, const char *buf, ssize_t *len); +int ei_read_fill_t__(int fd, char* buf, ssize_t *len, unsigned ms); +int ei_write_fill_t__(int fd, const char *buf, ssize_t *len, unsigned ms); +#if defined(EI_HAVE_STRUCT_IOVEC__) && defined(HAVE_WRITEV) +int ei_writev_fill_t__(int fd, const struct iovec *iov, int iovcnt, ssize_t *len, unsigned ms); #endif #endif /* _EI_PORTIO_H */ diff --git a/lib/erl_interface/src/not_used/send_link.c b/lib/erl_interface/src/not_used/send_link.c index 7be476fd93..38fae27df4 100644 --- a/lib/erl_interface/src/not_used/send_link.c +++ b/lib/erl_interface/src/not_used/send_link.c @@ -50,6 +50,7 @@ static int link_unlink(int fd, const erlang_pid *from, const erlang_pid *to, char *s; int index = 0; int n; + unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; index = 5; /* max sizes: */ ei_encode_version(msgbuf,&index); /* 1 */ @@ -69,7 +70,7 @@ static int link_unlink(int fd, const erlang_pid *from, const erlang_pid *to, if (ei_trace_distribution > 1) ei_show_sendmsg(stderr,msgbuf,NULL); #endif - n = ei_write_fill_t(fd,msgbuf,index,ms); + n = ei_write_fill_t__(fd,msgbuf,index,tmo); return (n==index ? 0 : -1); } diff --git a/lib/erl_interface/test/ei_accept_SUITE.erl b/lib/erl_interface/test/ei_accept_SUITE.erl index 78a433d21b..9c9c3f86b6 100644 --- a/lib/erl_interface/test/ei_accept_SUITE.erl +++ b/lib/erl_interface/test/ei_accept_SUITE.erl @@ -81,12 +81,10 @@ ei_accept(Config) when is_list(Config) -> ei_threaded_accept(Config) when is_list(Config) -> Einode = filename:join(proplists:get_value(data_dir, Config), "eiaccnode"), - N = 1, % 3, + N = 3, Host = atom_to_list(node()), - Port = 6767, - start_einode(Einode, N, Host, Port), + start_einode(Einode, N, Host), io:format("started eiaccnode"), - %%spawn_link(fun() -> start_einode(Einode, N, Host, Port) end), TestServerPid = self(), [spawn_link(fun() -> send_rec_einode(I, TestServerPid) end) || I <- lists:seq(0, N-1)], [receive I -> ok end || I <- lists:seq(0, N-1) ], @@ -159,10 +157,9 @@ send_rec_einode(N, TestServerPid) -> ct:fail(EINode) end. -start_einode(Einode, N, Host, Port) -> +start_einode(Einode, N, Host) -> Einodecmd = Einode ++ " " ++ atom_to_list(erlang:get_cookie()) - ++ " " ++ integer_to_list(N) ++ " " ++ Host ++ " " - ++ integer_to_list(Port) ++ " nothreads", + ++ " " ++ integer_to_list(N) ++ " " ++ Host, io:format("Einodecmd ~p ~n", [Einodecmd]), open_port({spawn, Einodecmd}, []), ok. diff --git a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c index 50df848b69..f41d741609 100644 --- a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c +++ b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c @@ -125,45 +125,26 @@ static void cmd_ei_connect_init(char* buf, int len) ei_x_free(&res); } -static int my_listen(int port) -{ - int listen_fd; - struct sockaddr_in addr; - const char *on = "1"; - - if ((listen_fd = socket(AF_INET, SOCK_STREAM, 0)) < 0) - return -1; - - setsockopt(listen_fd, SOL_SOCKET, SO_REUSEADDR, on, sizeof(on)); - - memset((void*) &addr, 0, (size_t) sizeof(addr)); - addr.sin_family = AF_INET; - addr.sin_port = htons(port); - addr.sin_addr.s_addr = htonl(INADDR_ANY); - - if (bind(listen_fd, (struct sockaddr*) &addr, sizeof(addr)) < 0) - return -1; - - listen(listen_fd, 5); - return listen_fd; -} - static void cmd_ei_publish(char* buf, int len) { int index = 0; - int listen, r; - long port; + int iport, lfd, r; + long lport; ei_x_buff x; int i; /* get port */ - if (ei_decode_long(buf, &index, &port) < 0) + if (ei_decode_long(buf, &index, &lport) < 0) fail("expected int (port)"); /* Make a listen socket */ - if ((listen = my_listen(port)) <= 0) + + iport = (int) lport; + lfd = ei_listen(&ec, &iport, 5); + if (lfd < 0) fail("listen"); + lport = (long) iport; - if ((i = ei_publish(&ec, port)) == -1) + if ((i = ei_publish(&ec, lport)) == -1) fail("ei_publish"); #ifdef VXWORKS save_fd(i); @@ -171,7 +152,7 @@ static void cmd_ei_publish(char* buf, int len) /* send listen-fd, result and errno */ ei_x_new_with_version(&x); ei_x_encode_tuple_header(&x, 3); - ei_x_encode_long(&x, listen); + ei_x_encode_long(&x, (long) lfd); ei_x_encode_long(&x, i); ei_x_encode_long(&x, erl_errno); send_bin_term(&x); diff --git a/lib/erl_interface/test/ei_accept_SUITE_data/eiaccnode.c b/lib/erl_interface/test/ei_accept_SUITE_data/eiaccnode.c index 308f843530..c850d20f3c 100644 --- a/lib/erl_interface/test/ei_accept_SUITE_data/eiaccnode.c +++ b/lib/erl_interface/test/ei_accept_SUITE_data/eiaccnode.c @@ -47,8 +47,6 @@ #define MAIN main #endif -static int my_listen(int port); - /* A small einode. To be called from the test case ei_accept_SUITE:multi_thread @@ -64,7 +62,6 @@ static int my_listen(int port); */ static const char* cookie, * desthost; -static int port; /* actually base port */ #ifndef SD_SEND #ifdef SHUTWR @@ -74,10 +71,6 @@ static int port; /* actually base port */ #endif #endif -#ifndef __WIN32__ -#define closesocket(fd) close(fd) -#endif - #ifdef __WIN32__ static DWORD WINAPI #else @@ -86,26 +79,32 @@ static void* einode_thread(void* num) { int n = (int)num; + int port; ei_cnode ec; - char myname[100], destname[100]; + char myname[100], destname[100], filename[100]; int r, fd, listen; ErlConnect conn; erlang_msg msg; -/* FILE* f;*/ + FILE* file; - sprintf(myname, "eiacc%d", n); - printf("thread %d (%s) listening\n", n, myname, destname); + sprintf(filename, "eiacc%d_trace.txt", n); + file = fopen(filename, "w"); + + sprintf(myname, "eiacc%d", n); fflush(file); r = ei_connect_init(&ec, myname, cookie, 0); - if ((listen = my_listen(port+n)) <= 0) { - printf("listen err\n"); + port = 0; + listen = ei_listen(&ec, &port, 5); + if (listen <= 0) { + fprintf(file, "listen err\n"); fflush(file); exit(7); } - if (ei_publish(&ec, port + n) == -1) { - printf("ei_publish port %d\n", port+n); + fprintf(file, "thread %d (%s:%s) listening on port %d\n", n, myname, destname, port); + if (ei_publish(&ec, port) == -1) { + fprintf(file, "ei_publish port %d\n", port+n); fflush(file); exit(8); } fd = ei_accept(&ec, listen, &conn); - printf("ei_accept %d\n", fd); + fprintf(file, "ei_accept %d\n", fd); fflush(file); if (fd >= 0) { ei_x_buff x, xs; int index, version; @@ -117,37 +116,38 @@ static void* if (got == ERL_TICK) continue; if (got == ERL_ERROR) { - printf("receive error %d\n", n); + fprintf(file, "receive error %d\n", n); fflush(file); return 0; } - printf("received %d\n", got); + fprintf(file, "received %d\n", got); fflush(file); break; } index = 0; if (ei_decode_version(x.buff, &index, &version) != 0) { - printf("ei_decode_version %d\n", n); + fprintf(file, "ei_decode_version %d\n", n); fflush(file); return 0; } if (ei_decode_pid(x.buff, &index, &pid) != 0) { - printf("ei_decode_pid %d\n", n); + fprintf(file, "ei_decode_pid %d\n", n); fflush(file); return 0; } -/* fprintf(f, "got pid from %s \n", pid.node);*/ + fprintf(file, "got pid from %s \n", pid.node); fflush(file); ei_x_new_with_version(&xs); ei_x_encode_tuple_header(&xs, 2); ei_x_encode_long(&xs, n); ei_x_encode_pid(&xs, &pid); r = ei_send(fd, &pid, xs.buff, xs.index); -/* fprintf(f, "sent %d bytes %d\n", xs.index, r);*/ + fprintf(file, "sent %d bytes %d\n", xs.index, r); fflush(file); shutdown(fd, SD_SEND); - closesocket(fd); + ei_close_connection(fd); ei_x_free(&x); ei_x_free(&xs); } else { - printf("coudn't connect fd %d r %d\n", fd, r); + fprintf(file, "coudn't connect fd %d r %d\n", fd, r); fflush(file); } - printf("done thread %d\n", n); -/* fclose(f);*/ + ei_close_connection(listen); + fprintf(file, "done thread %d\n", n); + fclose(file); return 0; } @@ -170,12 +170,14 @@ MAIN(int argc, char *argv[]) if (n > 100) exit(2); desthost = argv[3]; - port = atoi(argv[4]); -#ifndef VXWORKS - no_threads = argv[5] != NULL && strcmp(argv[5], "nothreads") == 0; -#else + if (argc == 3) + no_threads = 0; + else + no_threads = argv[4] != NULL && strcmp(argv[4], "nothreads") == 0; +#ifdef VXWORKS no_threads = 1; #endif + for (i = 0; i < n; ++i) { if (!no_threads) { #ifndef VXWORKS @@ -209,27 +211,3 @@ MAIN(int argc, char *argv[]) printf("ok\n"); return 0; } - -static int my_listen(int port) -{ - int listen_fd; - struct sockaddr_in addr; - const char *on = "1"; - - if ((listen_fd = socket(AF_INET, SOCK_STREAM, 0)) < 0) - return -1; - - setsockopt(listen_fd, SOL_SOCKET, SO_REUSEADDR, on, sizeof(on)); - - memset((void*) &addr, 0, (size_t) sizeof(addr)); - addr.sin_family = AF_INET; - addr.sin_port = htons(port); - addr.sin_addr.s_addr = htonl(INADDR_ANY); - - if (bind(listen_fd, (struct sockaddr*) &addr, sizeof(addr)) < 0) - return -1; - - listen(listen_fd, 5); - return listen_fd; -} - diff --git a/lib/erl_interface/test/erl_eterm_SUITE_data/cnode.c b/lib/erl_interface/test/erl_eterm_SUITE_data/cnode.c index bead0f8413..b87feb9dfc 100644 --- a/lib/erl_interface/test/erl_eterm_SUITE_data/cnode.c +++ b/lib/erl_interface/test/erl_eterm_SUITE_data/cnode.c @@ -20,7 +20,7 @@ #include <stdlib.h> #include <stdio.h> - +#include <string.h> #include "ei.h" #include "erl_interface.h" @@ -68,6 +68,7 @@ MAIN(int argc, char **argv) char host[80]; int number; ETERM *ref, *ref1, *ref2; + FILE *dfile = fopen("cnode_debug_printout", "w"); erl_init(NULL, 0); @@ -80,28 +81,30 @@ MAIN(int argc, char **argv) gethostname(host, sizeof(host)); sprintf(node, "c%d@%s", number, host); - printf("s = %d\n", s); + fprintf(dfile, "s = %d\n", s); fflush(dfile); sprintf(server, "test_server@%s", host); fd = erl_connect(server); - printf("fd = %d\n", fd); + fprintf(dfile, "fd = %d\n", fd); -/* printf("dist = %d\n", erl_distversion(fd)); */ +/* fprintf(dfile, "dist = %d\n", erl_distversion(fd)); */ #if 1 ref = erl_mk_long_ref(node, 4711, 113, 98, 0); #else ref = erl_mk_ref(node, 4711, 0); #endif - printf("ref = %d\n", ref); + fprintf(dfile, "ref = %p\n", ref); fflush(dfile); s = erl_reg_send(fd, "mip", ref); - printf("s = %d\n", s); + fprintf(dfile, "s = %d\n", s); fflush(dfile); { ETERM* emsg; emsg = SELF(fd); - erl_reg_send(fd,"mip",emsg); + fprintf(dfile, "pid = %p\n", emsg); fflush(dfile); + s = erl_reg_send(fd,"mip",emsg); + fprintf(dfile, "s2 = %d\n", s); fflush(dfile); erl_free_term(emsg); } @@ -116,28 +119,29 @@ MAIN(int argc, char **argv) #endif switch (s) { case ERL_TICK: - printf("tick\n"); + fprintf(dfile, "tick\n"); break; case ERL_ERROR: - printf("error\n"); + fprintf(dfile, "error: %s (%d)\n", strerror(erl_errno), erl_errno); break; case ERL_MSG: - printf("msg %d\n", msgsize); + fprintf(dfile, "msg %d\n", msgsize); break; default: - printf("unknown result %d\n", s); + fprintf(dfile, "unknown result %d\n", s); break; } + fflush(dfile); } while (s == ERL_TICK); s = erl_reg_send(fd, "mip", msg.msg); - printf("s = %d\n", s); + fprintf(dfile, "s = %d\n", s); fflush(dfile); s = erl_reg_send(fd, "mip", msg.to); - printf("s = %d\n", s); + fprintf(dfile, "s = %d\n", s); fflush(dfile); #if 0 /* from = NULL! */ s = erl_reg_send(fd, "mip", msg.from); - printf("s = %d\n", s); + fprintf(dfile, "s = %d\n", s); fflush(dfile); #endif #if 0 @@ -150,17 +154,19 @@ MAIN(int argc, char **argv) ref1 = erl_mk_long_ref(node, 4711, 113, 98, 0); ref2 = erl_mk_ref(node, 4711, 0); s = erl_encode(ref1, buf1); - printf("enc1 s = %d\n", s); + fprintf(dfile, "enc1 s = %d\n", s); fflush(dfile); s = erl_encode(ref2, buf2); - printf("enc2 s = %d\n", s); + fprintf(dfile, "enc2 s = %d\n", s); fflush(dfile); s = erl_compare_ext(buf1, buf2); - printf("comp s = %d\n", s); + fprintf(dfile, "comp s = %d\n", s); fflush(dfile); /* Compare, in another way */ s = erl_match(ref1, ref2); - printf("match s = %d\n", s); + fprintf(dfile, "match s = %d\n", s); fflush(dfile); #endif + fclose(dfile); + erl_close_connection(fd); return 0; diff --git a/lib/inets/doc/src/httpd_util.xml b/lib/inets/doc/src/httpd_util.xml index 29971ba8ae..e0f947f860 100644 --- a/lib/inets/doc/src/httpd_util.xml +++ b/lib/inets/doc/src/httpd_util.xml @@ -45,8 +45,7 @@ <fsummary>Converts the date to the Erlang date format.</fsummary> <type> <v>DateString = string()</v> - <v>ErlDate = {{Year,Month,Date},{Hour,Min,Sec}}</v> - <v>Year = Month = Date = Hour = Min = Sec = integer()</v> + <v>ErlDate = calendar:datetime() </v> </type> <desc> <p><c>convert_request_date/1</c> converts <c>DateString</c> to @@ -281,10 +280,10 @@ <func> <name since="">rfc1123_date() -> RFC1123Date</name> - <name since="">rfc1123_date({{YYYY,MM,DD},{Hour,Min,Sec}}) -> RFC1123Date</name> + <name since="">rfc1123_date(Date) -> RFC1123Date</name> <fsummary>Returns the current date in RFC 1123 format.</fsummary> <type> - <v>YYYY = MM = DD = Hour = Min = Sec = integer()</v> + <v> Date = calendar:datetime()</v> <v>RFC1123Date = string()</v> </type> <desc> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index dd8c4115a5..2faa49e541 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,25 @@ <file>notes.xml</file> </header> - <section><title>Inets 7.0.3</title> + <section><title>Inets 7.0.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Make sure ipv6 addresses with brackets in URIs are + converted correctly before passing to lower level + functions like gen_tcp and ssl functions. Could cause + connection to fail.</p> + <p> + Own Id: OTP-15544 Aux Id: ERIERL-289 </p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 7.0.3</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 1bf5d25c98..8b356d8026 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -805,11 +805,12 @@ handle_unix_socket_options(#request{unix_socket = UnixSocket}, error({badarg, [{ipfamily, Else}, {unix_socket, UnixSocket}]}) end. -connect_and_send_first_request(Address, Request, #state{options = Options0} = State) -> +connect_and_send_first_request(Address, #request{ipv6_host_with_brackets = HasBrackets} = Request, + #state{options = Options0} = State) -> SocketType = socket_type(Request), ConnTimeout = (Request#request.settings)#http_options.connect_timeout, Options = handle_unix_socket_options(Request, Options0), - case connect(SocketType, Address, Options, ConnTimeout) of + case connect(SocketType, format_address(Address, HasBrackets), Options, ConnTimeout) of {ok, Socket} -> ClientClose = httpc_request:is_client_closing( @@ -1739,3 +1740,8 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) -> end. +format_address({Host, Port}, true) when is_list(Host)-> + {ok, Address} = inet:parse_address(string:strip(string:strip(Host, right, $]), left, $[)), + {Address, Port}; +format_address(HostPort, _) -> + HostPort. diff --git a/lib/inets/test/httpd_bench_SUITE.erl b/lib/inets/test/httpd_bench_SUITE.erl index 4b549dcb5b..087516f56c 100644 --- a/lib/inets/test/httpd_bench_SUITE.erl +++ b/lib/inets/test/httpd_bench_SUITE.erl @@ -37,7 +37,8 @@ %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- suite() -> - [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}]. + [{timetrap, {minutes, 1}}, + {ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}]. all() -> [ @@ -499,8 +500,8 @@ start_dummy("http"= Protocol, Config) -> Conf = [ %%{big, filename:join(DataDir, "1M_file")}, %%{small, filename:join(DataDir, "1k_file")}, - {big, {gen, crypto:rand_bytes(1000000)}}, - {small, {gen, crypto:rand_bytes(1000)}}, + {big, {gen, crypto:strong_rand_bytes(1000000)}}, + {small, {gen, crypto:strong_rand_bytes(1000)}}, {http_version, HTTPVersion}, {keep_alive, ?config(keep_alive, Config)} ], @@ -519,8 +520,8 @@ start_dummy("https" = Protocol, Config) -> Opts = [{active, true}, {nodelay, true}, {reuseaddr, true} | SSLOpts], Conf = [%%{big, filename:join(DataDir, "1M_file")}, %%{small, filename:join(DataDir, "1k_file")}, - {big, {gen, crypto:rand_bytes(1000000)}}, - {small, {gen, crypto:rand_bytes(1000)}}, + {big, {gen, crypto:strong_rand_bytes(1000000)}}, + {small, {gen, crypto:strong_rand_bytes(1000)}}, {http_version, HTTPVersion}, {keep_alive, ?config(keep_alive, Config)} ], diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 52c05a7974..1d1560213e 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 7.0.3 +INETS_VSN = 7.0.4 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/doc/src/gen_sctp.xml b/lib/kernel/doc/src/gen_sctp.xml index 1e7009b3a8..f70d6c24db 100644 --- a/lib/kernel/doc/src/gen_sctp.xml +++ b/lib/kernel/doc/src/gen_sctp.xml @@ -284,7 +284,7 @@ connect(Socket, Ip, Port>, <func> <name name="listen" arity="2" clause_i="1" since=""/> - <name name="listen" arity="2" clause_i="2" since=""/> + <name name="listen" arity="2" clause_i="2" since="OTP R15B"/> <fsummary>Set up a socket to listen.</fsummary> <desc> <p>Sets up a socket to listen on the IP address and port number diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index 104c698591..709ba8e8fd 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -1007,13 +1007,34 @@ get_tcpi_sacked(Sock) -> <marker id="option-linger"></marker> </item> <tag><c>{linger, {true|false, Seconds}}</c></tag> - <item> + <item> <p>Determines the time-out, in seconds, for flushing unsent data - in the <c>close/1</c> socket call. If the first component of - the value tuple is <c>false</c>, the second is ignored. This - means that <c>close/1</c> returns immediately, not waiting - for data to be flushed. Otherwise, the second component is - the flushing time-out, in seconds.</p> + in the <c>close/1</c> socket call. </p> + <p>The first component is if linger is enabled, the second component + is the flushing time-out, in seconds. There are 3 alternatives:</p> + <taglist> + <tag><c>{false, _}</c></tag> + <item> + <p>close/1 or shutdown/2 returns immediately, + not waiting for data to be flushed, with closing + happening in the background.</p> + </item> + <tag><c>{true, 0}</c></tag> + <item> + <p>Aborts the connection when it is closed. + Discards any data still remaining in the send buffers + and sends RST to the peer.</p> + <p>This avoids TCP's TIME_WAIT state, but leaves open + the possibility that another "incarnation" of this connection + being created.</p> + </item> + <tag><c>{true, Time} when Time > 0</c></tag> + <item> + <p>close/1 or shutdown/2 will not return until + all queued messages for the socket have been successfully + sent or the linger timeout (Time) has been reached.</p> + </item> + </taglist> </item> <tag><c>{low_msgq_watermark, Size}</c></tag> <item> diff --git a/lib/kernel/doc/src/logger.xml b/lib/kernel/doc/src/logger.xml index e09c5db5e3..0668676096 100644 --- a/lib/kernel/doc/src/logger.xml +++ b/lib/kernel/doc/src/logger.xml @@ -245,6 +245,12 @@ logger:error("error happened because: ~p", [Reason]). % Without macro </desc> </datatype> <datatype> + <name name="olp_config"/> + <desc> + <p></p> + </desc> + </datatype> + <datatype> <name name="primary_config"/> <desc> <p>Primary configuration data for Logger. The following @@ -597,8 +603,8 @@ start(_, []) -> <name name="get_config" arity="0" since="OTP 21.0"/> <fsummary>Look up the current Logger configuration</fsummary> <desc> - <p>Look up all current Logger configuration, including primary - and handler configuration, and module level settings.</p> + <p>Look up all current Logger configuration, including primary, + handler, and proxy configuration, and module level settings.</p> </desc> </func> @@ -636,6 +642,17 @@ start(_, []) -> </func> <func> + <name name="get_proxy_config" arity="0" since="OTP 21.3"/> + <fsummary>Look up the current configuration for the Logger proxy.</fsummary> + <desc> + <p>Look up the current configuration for the Logger proxy.</p> + <p>For more information about the proxy, see + section <seealso marker="logger_chapter#proxy">Logger + Proxy</seealso> in the Kernel User's Guide.</p> + </desc> + </func> + + <func> <name name="get_module_level" arity="0" since="OTP 21.0"/> <fsummary>Look up all current module levels.</fsummary> <desc> @@ -801,6 +818,27 @@ start(_, []) -> </func> <func> + <name name="set_proxy_config" arity="1" since="OTP 21.3"/> + <fsummary>Set configuration data for the Logger proxy.</fsummary> + <desc> + <p>Set configuration data for the Logger proxy. This + overwrites the current proxy configuration. Keys that are not + specified in the <c><anno>Config</anno></c> map gets default + values.</p> + <p>To modify the existing configuration, + use <seealso marker="#update_proxy_config-1"> + <c>update_proxy_config/1</c></seealso>, or, if a more + complex merge is needed, read the current configuration + with <seealso marker="#get_proxy_config-0"><c>get_proxy_config/0</c> + </seealso>, then do the merge before writing the new + configuration back with this function.</p> + <p>For more information about the proxy, see + section <seealso marker="logger_chapter#proxy">Logger + Proxy</seealso> in the Kernel User's Guide.</p> + </desc> + </func> + + <func> <name name="set_module_level" arity="2" since="OTP 21.0"/> <fsummary>Set the log level for the specified modules.</fsummary> <desc> @@ -1013,6 +1051,25 @@ logger:set_process_metadata(maps:merge(logger:get_process_metadata(), Meta)). </seealso>.</p> </desc> </func> + + <func> + <name name="update_proxy_config" arity="1" since="OTP 21.3"/> + <fsummary>Update configuration data for the Logger proxy.</fsummary> + <desc> + <p>Update configuration data for the Logger proxy. This function + behaves as if it was implemented as follows:</p> + <code type="erl"> +Old = logger:get_proxy_config(), +logger:set_proxy_config(maps:merge(Old, Config)). + </code> + <p>To overwrite the existing configuration without any merge, + use <seealso marker="#set_proxy_config-1"><c>set_proxy_config/1</c> + </seealso>.</p> + <p>For more information about the proxy, see + section <seealso marker="logger_chapter#proxy">Logger + Proxy</seealso> in the Kernel User's Guide.</p> + </desc> + </func> </funcs> <section> diff --git a/lib/kernel/doc/src/logger_chapter.xml b/lib/kernel/doc/src/logger_chapter.xml index c7e87e6668..03b9edcf8f 100644 --- a/lib/kernel/doc/src/logger_chapter.xml +++ b/lib/kernel/doc/src/logger_chapter.xml @@ -693,8 +693,10 @@ logger:debug(#{got => connection_request, id => Id, state => State}, with <seealso marker="#logger_sasl_compatible"> <c>logger_sasl_compatible</c></seealso>.</p> <p>With this parameter, you can modify or disable the default - handler, add custom handlers and primary logger filters, and - set log levels per module.</p> + handler, add custom handlers and primary logger filters, set + log levels per module, and modify + the <seealso marker="#proxy">proxy</seealso> + configuration.</p> <p><c>Config</c> is any (zero or more) of the following:</p> <taglist> <tag><c>{handler, default, undefined}</c></tag> @@ -746,6 +748,14 @@ logger:debug(#{got => connection_request, id => Id, state => State}, <p>for each <c>Module</c>.</p> <p>Multiple entries of this type are allowed.</p> </item> + <tag><c>{proxy, ProxyConfig}</c></tag> + <item> + <p>Sets the proxy configuration, equivalent to calling</p> + <pre><seealso marker="logger#set_proxy_config/1"> + logger:set_proxy_config(ProxyConfig) + </seealso></pre> + <p>Only one entry of this type is allowed.</p> + </item> </taglist> <p>See section <seealso marker="#config_examples">Configuration @@ -1334,9 +1344,50 @@ logger:add_handler(my_disk_log_h, logger_disk_log_h, </section> <section> + <marker id="proxy"/> + <title>Logger Proxy</title> + <p>The Logger proxy is an Erlang process which is part of the + Kernel application's supervision tree. During startup, the proxy + process registers itself as the <c>system_logger</c>, meaning + that log events produced by the emulator are sent to this + process.</p> + <p>When a log event is issued on a process which has its group + leader on a remote node, Logger automatically forwards the log + event to the group leader's node. To achieve this, it first + sends the log event as an Erlang message from the original + client process to the proxy on the local node, and the proxy in + turn forwards the event to the proxy on the remote node.</p> + <p>When receiving a log event, either from the emulator or from a + remote node, the proxy calls the Logger API to log the event.</p> + <p>The proxy process is overload protected in the same way as + described in + section <seealso marker="#overload_protection">Protecting the + Handler from Overload</seealso>, but with the following default + values:</p> + <code> + #{sync_mode_qlen => 500, + drop_mode_qlen => 1000, + flush_qlen => 5000, + burst_limit_enable => false, + overload_kill_enable => false}</code> + <p>For log events from the emulator, synchronous message passing + mode is not applicable, since all messages are passed + asynchronously by the emulator. Drop mode is achieved by setting + the <c>system_logger</c> to <c>undefined</c>, forcing the + emulator to drop events until it is set back to the proxy pid + again.</p> + <p>The proxy uses <seealso marker="erts:erlang#send_nosuspend/2"> + <c>erlang:send_nosuspend/2</c></seealso> when sending log + events to a remote node. If the message could not be sent + without suspending the sender, it is dropped. This is to avoid + blocking the proxy process.</p> + </section> + + <section> <title>See Also</title> <p> <seealso marker="disk_log"><c>disk_log(3)</c></seealso>, + <seealso marker="erts:erlang"><c>erlang(3)</c></seealso>, <seealso marker="error_logger"><c>error_logger(3)</c></seealso>, <seealso marker="logger"><c>logger(3)</c></seealso>, <seealso marker="logger_disk_log_h"><c>logger_disk_log_h(3)</c></seealso>, diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 57f17defc8..3d1506ea08 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -118,6 +118,8 @@ MODULES = \ logger_h_common \ logger_filters \ logger_formatter \ + logger_olp \ + logger_proxy \ logger_server \ logger_simple_h \ logger_sup \ @@ -151,7 +153,7 @@ INTERNAL_HRL_FILES= application_master.hrl disk_log.hrl \ inet_dns.hrl inet_res.hrl \ inet_boot.hrl inet_config.hrl inet_int.hrl \ inet_dns_record_adts.hrl \ - logger_internal.hrl logger_h_common.hrl + logger_internal.hrl logger_olp.hrl logger_h_common.hrl ERL_FILES= $(MODULES:%=%.erl) @@ -279,6 +281,8 @@ $(EBIN)/logger_config.beam: logger_internal.hrl ../include/logger.hrl $(EBIN)/logger_disk_log_h.beam: logger_h_common.hrl logger_internal.hrl ../include/logger.hrl ../include/file.hrl $(EBIN)/logger_filters.beam: logger_internal.hrl ../include/logger.hrl $(EBIN)/logger_formatter.beam: logger_internal.hrl ../include/logger.hrl +$(EBIN)/logger_olp.beam: logger_olp.hrl logger_internal.hrl +$(EBIN)/logger_proxy.beam: logger_internal.hrl $(EBIN)/logger_server.beam: logger_internal.hrl ../include/logger.hrl $(EBIN)/logger_simple_h.beam: logger_internal.hrl ../include/logger.hrl $(EBIN)/logger_std_h.beam: logger_h_common.hrl logger_internal.hrl ../include/logger.hrl ../include/file.hrl diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl index b7e8868911..7a14e2635c 100644 --- a/lib/kernel/src/erl_epmd.erl +++ b/lib/kernel/src/erl_epmd.erl @@ -77,8 +77,8 @@ stop() -> %% -spec port_please(Name, Host) -> {ok, Port, Version} | noport when - Name :: string(), - Host :: inet:ip_address(), + Name :: atom() | string(), + Host :: atom() | string() | inet:ip_address(), Port :: non_neg_integer(), Version :: non_neg_integer(). @@ -86,8 +86,8 @@ port_please(Node, Host) -> port_please(Node, Host, infinity). -spec port_please(Name, Host, Timeout) -> {ok, Port, Version} | noport when - Name :: string(), - Host :: inet:ip_address(), + Name :: atom() | string(), + Host :: atom() | string() | inet:ip_address(), Timeout :: non_neg_integer() | infinity, Port :: non_neg_integer(), Version :: non_neg_integer(). diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index fe073621c8..a1d9e8e215 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -68,6 +68,8 @@ logger_formatter, logger_h_common, logger_handler_watcher, + logger_olp, + logger_proxy, logger_server, logger_simple_h, logger_std_h, diff --git a/lib/kernel/src/logger.erl b/lib/kernel/src/logger.erl index 6762998d4f..abdd9a9ceb 100644 --- a/lib/kernel/src/logger.erl +++ b/lib/kernel/src/logger.erl @@ -43,11 +43,14 @@ get_module_level/0, get_module_level/1, set_primary_config/1, set_primary_config/2, set_handler_config/2, set_handler_config/3, + set_proxy_config/1, update_primary_config/1, update_handler_config/2, update_handler_config/3, + update_proxy_config/1, update_formatter_config/2, update_formatter_config/3, get_primary_config/0, get_handler_config/1, get_handler_config/0, get_handler_ids/0, get_config/0, + get_proxy_config/0, add_handlers/1]). %% Private configuration @@ -122,6 +125,18 @@ {filters,log | stop,[{filter_id(),filter()}]} | {module_level,level(),[module()]}]. +-type olp_config() :: #{sync_mode_qlen => non_neg_integer(), + drop_mode_qlen => pos_integer(), + flush_qlen => pos_integer(), + burst_limit_enable => boolean(), + burst_limit_max_count => pos_integer(), + burst_limit_window_time => pos_integer(), + overload_kill_enable => boolean(), + overload_kill_qlen => pos_integer(), + overload_kill_mem_size => pos_integer(), + overload_kill_restart_after => + non_neg_integer() | infinity}. + -export_type([log_event/0, level/0, report/0, @@ -137,7 +152,8 @@ filter_arg/0, filter_return/0, config_handler/0, - formatter_config/0]). + formatter_config/0, + olp_config/0]). %%%----------------------------------------------------------------- %%% API @@ -390,6 +406,7 @@ set_primary_config(Key,Value) -> set_primary_config(Config) -> logger_server:set_config(primary,Config). + -spec set_handler_config(HandlerId,level,Level) -> Return when HandlerId :: handler_id(), Level :: level() | all | none, @@ -419,6 +436,11 @@ set_handler_config(HandlerId,Key,Value) -> set_handler_config(HandlerId,Config) -> logger_server:set_config(HandlerId,Config). +-spec set_proxy_config(Config) -> ok | {error,term()} when + Config :: olp_config(). +set_proxy_config(Config) -> + logger_server:set_config(proxy,Config). + -spec update_primary_config(Config) -> ok | {error,term()} when Config :: primary_config(). update_primary_config(Config) -> @@ -453,6 +475,11 @@ update_handler_config(HandlerId,Key,Value) -> update_handler_config(HandlerId,Config) -> logger_server:update_config(HandlerId,Config). +-spec update_proxy_config(Config) -> ok | {error,term()} when + Config :: olp_config(). +update_proxy_config(Config) -> + logger_server:update_config(proxy,Config). + -spec get_primary_config() -> Config when Config :: primary_config(). get_primary_config() -> @@ -486,6 +513,12 @@ get_handler_ids() -> {ok,#{handlers:=HandlerIds}} = logger_config:get(?LOGGER_TABLE,primary), HandlerIds. +-spec get_proxy_config() -> Config when + Config :: olp_config(). +get_proxy_config() -> + {ok,Config} = logger_config:get(?LOGGER_TABLE,proxy), + Config. + -spec update_formatter_config(HandlerId,FormatterConfig) -> ok | {error,term()} when HandlerId :: handler_id(), @@ -606,10 +639,12 @@ unset_process_metadata() -> -spec get_config() -> #{primary=>primary_config(), handlers=>[handler_config()], + proxy=>olp_config(), module_levels=>[{module(),level() | all | none}]}. get_config() -> #{primary=>get_primary_config(), handlers=>get_handler_config(), + proxy=>get_proxy_config(), module_levels=>lists:keysort(1,get_module_level())}. -spec internal_init_logger() -> ok | {error,term()}. @@ -672,6 +707,17 @@ init_kernel_handlers(Env) -> %% This function is responsible for resolving the handler config %% and then starting the correct handlers. This is done after the %% kernel supervisor tree has been started as it needs the logger_sup. +add_handlers(kernel) -> + Env = get_logger_env(kernel), + case get_proxy_opts(Env) of + undefined -> + add_handlers(kernel,Env); + Opts -> + case set_proxy_config(Opts) of + ok -> add_handlers(kernel,Env); + {error, Reason} -> {error,{bad_proxy_config,Reason}} + end + end; add_handlers(App) when is_atom(App) -> add_handlers(App,get_logger_env(App)); add_handlers(HandlerConfig) -> @@ -729,6 +775,8 @@ check_logger_config(kernel,[{filters,_,_}|Env]) -> check_logger_config(kernel,Env); check_logger_config(kernel,[{module_level,_,_}|Env]) -> check_logger_config(kernel,Env); +check_logger_config(kernel,[{proxy,_}|Env]) -> + check_logger_config(kernel,Env); check_logger_config(_,Bad) -> throw(Bad). @@ -784,6 +832,13 @@ get_primary_filters(Env) -> _ -> throw({multiple_filters,Env}) end. +get_proxy_opts(Env) -> + case [P || P={proxy,_} <- Env] of + [{proxy,Opts}] -> Opts; + [] -> undefined; + _ -> throw({multiple_proxies,Env}) + end. + %% This function looks at the kernel logger environment %% and updates it so that the correct logger is configured init_default_config(Type,Env) when Type==standard_io; @@ -880,30 +935,30 @@ log_allowed(Location,Level,Msg,Meta0) when is_map(Meta0) -> maps:merge(Location,maps:merge(proc_meta(),Meta0))), case node(maps:get(gl,Meta)) of Node when Node=/=node() -> - log_remote(Node,Level,Msg,Meta), - do_log_allowed(Level,Msg,Meta); + log_remote(Node,Level,Msg,Meta); _ -> - do_log_allowed(Level,Msg,Meta) - end. + ok + end, + do_log_allowed(Level,Msg,Meta,tid()). -do_log_allowed(Level,{Format,Args}=Msg,Meta) +do_log_allowed(Level,{Format,Args}=Msg,Meta,Tid) when ?IS_LEVEL(Level), is_list(Format), is_list(Args), is_map(Meta) -> - logger_backend:log_allowed(#{level=>Level,msg=>Msg,meta=>Meta},tid()); -do_log_allowed(Level,Report,Meta) + logger_backend:log_allowed(#{level=>Level,msg=>Msg,meta=>Meta},Tid); +do_log_allowed(Level,Report,Meta,Tid) when ?IS_LEVEL(Level), ?IS_REPORT(Report), is_map(Meta) -> logger_backend:log_allowed(#{level=>Level,msg=>{report,Report},meta=>Meta}, - tid()); -do_log_allowed(Level,String,Meta) + Tid); +do_log_allowed(Level,String,Meta,Tid) when ?IS_LEVEL(Level), ?IS_STRING(String), is_map(Meta) -> logger_backend:log_allowed(#{level=>Level,msg=>{string,String},meta=>Meta}, - tid()). + Tid). tid() -> ets:whereis(?LOGGER_TABLE). @@ -913,7 +968,7 @@ log_remote(Node,Level,Msg,Meta) -> log_remote(Node,{log,Level,Msg,Meta}). log_remote(Node,Request) -> - {logger,Node} ! Request, + logger_proxy:log({remote,Node,Request}), ok. add_default_metadata(Meta) -> diff --git a/lib/kernel/src/logger_config.erl b/lib/kernel/src/logger_config.erl index 5e9faf332c..5024d20cfe 100644 --- a/lib/kernel/src/logger_config.erl +++ b/lib/kernel/src/logger_config.erl @@ -66,6 +66,8 @@ get(Tid,What) -> case ets:lookup(Tid,table_key(What)) of [{_,_,Config}] -> {ok,Config}; + [{_,Config}] when What=:=proxy -> + {ok,Config}; [] -> {error,{not_found,What}} end. @@ -79,10 +81,15 @@ get(Tid,What,Level) -> [Data] -> {ok,Data} end. +create(Tid,proxy,Config) -> + ets:insert(Tid,{table_key(proxy),Config}); create(Tid,What,Config) -> LevelInt = level_to_int(maps:get(level,Config)), ets:insert(Tid,{table_key(What),LevelInt,Config}). +set(Tid,proxy,Config) -> + ets:insert(Tid,{table_key(proxy),Config}), + ok; set(Tid,What,Config) -> LevelInt = level_to_int(maps:get(level,Config)), %% Should do this only if the level has actually changed. Possibly @@ -148,5 +155,6 @@ int_to_level(?LOG_ALL) -> all. %%%----------------------------------------------------------------- %%% Internal +table_key(proxy) -> ?PROXY_KEY; table_key(primary) -> ?PRIMARY_KEY; table_key(HandlerId) -> {?HANDLER_KEY,HandlerId}. diff --git a/lib/kernel/src/logger_disk_log_h.erl b/lib/kernel/src/logger_disk_log_h.erl index 41e0d51a9d..47b39da900 100644 --- a/lib/kernel/src/logger_disk_log_h.erl +++ b/lib/kernel/src/logger_disk_log_h.erl @@ -24,7 +24,7 @@ -include("logger_h_common.hrl"). %%% API --export([info/1, filesync/1, reset/1]). +-export([filesync/1]). %% logger_h_common callbacks -export([init/2, check_config/4, reset_state/2, @@ -47,25 +47,6 @@ filesync(Name) -> logger_h_common:filesync(?MODULE,Name). -%%%----------------------------------------------------------------- -%%% --spec info(Name) -> Info | {error,Reason} when - Name :: atom(), - Info :: term(), - Reason :: handler_busy | {badarg,term()}. - -info(Name) -> - logger_h_common:info(?MODULE,Name). - -%%%----------------------------------------------------------------- -%%% --spec reset(Name) -> ok | {error,Reason} when - Name :: atom(), - Reason :: handler_busy | {badarg,term()}. - -reset(Name) -> - logger_h_common:reset(?MODULE,Name). - %%%=================================================================== %%% logger callbacks %%%=================================================================== diff --git a/lib/kernel/src/logger_h_common.erl b/lib/kernel/src/logger_h_common.erl index 74a2d158fc..e69f6de38d 100644 --- a/lib/kernel/src/logger_h_common.erl +++ b/lib/kernel/src/logger_h_common.erl @@ -24,11 +24,11 @@ -include("logger_internal.hrl"). %% API --export([start_link/1, info/2, filesync/2, reset/2]). +-export([filesync/2]). -%% gen_server and proc_lib callbacks --export([init/1, handle_call/3, handle_cast/2, handle_info/2, - terminate/2, code_change/3]). +%% logger_olp callbacks +-export([init/1, handle_load/2, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3, notify/2, reset_state/1]). %% logger callbacks -export([log/2, adding_handler/1, removing_handler/1, changing_config/3, @@ -37,52 +37,45 @@ %% Library functions for handlers -export([error_notify/1]). -%%%----------------------------------------------------------------- --define(CONFIG_KEYS,[sync_mode_qlen, - drop_mode_qlen, - flush_qlen, - burst_limit_enable, - burst_limit_max_count, - burst_limit_window_time, - overload_kill_enable, - overload_kill_qlen, - overload_kill_mem_size, - overload_kill_restart_after, - filesync_repeat_interval]). --define(READ_ONLY_KEYS,[handler_pid,mode_tab]). +-define(OLP_KEYS,[sync_mode_qlen, + drop_mode_qlen, + flush_qlen, + burst_limit_enable, + burst_limit_max_count, + burst_limit_window_time, + overload_kill_enable, + overload_kill_qlen, + overload_kill_mem_size, + overload_kill_restart_after]). + +-define(COMMON_KEYS,[filesync_repeat_interval]). + +-define(READ_ONLY_KEYS,[olp]). %%%----------------------------------------------------------------- %%% API %% This function is called by the logger_sup supervisor -start_link(Args) -> - proc_lib:start_link(?MODULE,init,[Args]). - filesync(Module, Name) -> call(Module, Name, filesync). -info(Module, Name) -> - call(Module, Name, info). - -reset(Module, Name) -> - call(Module, Name, reset). - %%%----------------------------------------------------------------- %%% Handler being added adding_handler(#{id:=Name,module:=Module}=Config) -> HConfig0 = maps:get(config, Config, #{}), - HandlerConfig0 = maps:without(?CONFIG_KEYS,HConfig0), + HandlerConfig0 = maps:without(?OLP_KEYS++?COMMON_KEYS,HConfig0), case Module:check_config(Name,set,undefined,HandlerConfig0) of {ok,HandlerConfig} -> - ModifiedCommon = maps:with(?CONFIG_KEYS,HandlerConfig), - CommonConfig0 = maps:with(?CONFIG_KEYS,HConfig0), + ModifiedCommon = maps:with(?COMMON_KEYS,HandlerConfig), + CommonConfig0 = maps:with(?COMMON_KEYS,HConfig0), CommonConfig = maps:merge( maps:merge(get_default_config(), CommonConfig0), ModifiedCommon), case check_config(CommonConfig) of ok -> HConfig = maps:merge(CommonConfig,HandlerConfig), - start(Config#{config => HConfig}); + OlpOpts = maps:with(?OLP_KEYS,HConfig0), + start(OlpOpts, Config#{config => HConfig}); {error,Faulty} -> {error,{invalid_config,Module,Faulty}} end; @@ -92,11 +85,11 @@ adding_handler(#{id:=Name,module:=Module}=Config) -> %%%----------------------------------------------------------------- %%% Handler being removed -removing_handler(#{id:=Name, module:=Module}) -> +removing_handler(#{id:=Name, module:=Module, config:=#{olp:=Olp}}) -> case whereis(?name_to_reg_name(Module,Name)) of undefined -> ok; - Pid -> + _Pid -> %% We don't want to do supervisor:terminate_child here %% since we need to distinguish this explicit stop from a %% system termination in order to avoid circular attempts @@ -106,7 +99,7 @@ removing_handler(#{id:=Name, module:=Module}) -> %% the restart type is temporary, which means that the %% child specification is automatically removed from the %% supervisor when the process dies. - _ = gen_server:call(Pid, stop), + _ = logger_olp:stop(Olp), ok end. @@ -116,34 +109,52 @@ changing_config(SetOrUpdate, #{id:=Name,config:=OldHConfig,module:=Module}, NewConfig0) -> NewHConfig0 = maps:get(config, NewConfig0, #{}), - OldHandlerConfig = maps:without(?CONFIG_KEYS++?READ_ONLY_KEYS,OldHConfig), - NewHandlerConfig0 = maps:without(?CONFIG_KEYS++?READ_ONLY_KEYS,NewHConfig0), + NoHandlerKeys = ?OLP_KEYS++?COMMON_KEYS++?READ_ONLY_KEYS, + OldHandlerConfig = maps:without(NoHandlerKeys,OldHConfig), + NewHandlerConfig0 = maps:without(NoHandlerKeys,NewHConfig0), case Module:check_config(Name, SetOrUpdate, OldHandlerConfig,NewHandlerConfig0) of {ok, NewHandlerConfig} -> - ModifiedCommon = maps:with(?CONFIG_KEYS,NewHandlerConfig), - NewCommonConfig0 = maps:with(?CONFIG_KEYS,NewHConfig0), + ModifiedCommon = maps:with(?COMMON_KEYS,NewHandlerConfig), + NewCommonConfig0 = maps:with(?COMMON_KEYS,NewHConfig0), + OldCommonConfig = maps:with(?COMMON_KEYS,OldHConfig), CommonDefault = case SetOrUpdate of set -> get_default_config(); update -> - maps:with(?CONFIG_KEYS,OldHConfig) + OldCommonConfig end, NewCommonConfig = maps:merge( maps:merge(CommonDefault,NewCommonConfig0), ModifiedCommon), case check_config(NewCommonConfig) of ok -> - ReadOnly = maps:with(?READ_ONLY_KEYS,OldHConfig), - NewHConfig = maps:merge( - maps:merge(NewCommonConfig,NewHandlerConfig), - ReadOnly), - NewConfig = NewConfig0#{config=>NewHConfig}, - HPid = maps:get(handler_pid,OldHConfig), - case call(HPid, {change_config,NewConfig}) of - ok -> {ok,NewConfig}; - Error -> Error + OlpDefault = + case SetOrUpdate of + set -> + logger_olp:get_default_opts(); + update -> + maps:with(?OLP_KEYS,OldHConfig) + end, + Olp = maps:get(olp,OldHConfig), + NewOlpOpts = maps:merge(OlpDefault, + maps:with(?OLP_KEYS,NewHConfig0)), + case logger_olp:set_opts(Olp,NewOlpOpts) of + ok -> + maybe_set_repeated_filesync(Olp,OldCommonConfig, + NewCommonConfig), + ReadOnly = maps:with(?READ_ONLY_KEYS,OldHConfig), + NewHConfig = + maps:merge( + maps:merge( + maps:merge(NewCommonConfig,NewHandlerConfig), + ReadOnly), + NewOlpOpts), + NewConfig = NewConfig0#{config=>NewHConfig}, + {ok,NewConfig}; + Error -> + Error end; {error,Faulty} -> {error,{invalid_config,Module,Faulty}} @@ -158,14 +169,12 @@ changing_config(SetOrUpdate, LogEvent :: logger:log_event(), Config :: logger:handler_config(). -log(LogEvent, Config = #{id := Name, - config := #{handler_pid := HPid, - mode_tab := ModeTab}}) -> +log(LogEvent, Config = #{config := #{olp:=Olp}}) -> %% if the handler has crashed, we must drop this event %% and hope the handler restarts so we can try again - true = is_process_alive(HPid), + true = is_process_alive(logger_olp:get_pid(Olp)), Bin = log_to_binary(LogEvent, Config), - call_cast_or_drop(Name, HPid, ModeTab, Bin). + logger_olp:load(Olp,Bin). %%%----------------------------------------------------------------- %%% Remove internal fields from configuration @@ -180,18 +189,23 @@ filter_config(#{config:=HConfig}=Config) -> %%% %%% The handler process is linked to logger_sup, which is part of the %%% kernel application's supervision tree. -start(#{id := Name} = Config0) -> +start(OlpOpts0, #{id := Name, module:=Module, config:=HConfig} = Config0) -> + RegName = ?name_to_reg_name(Module,Name), ChildSpec = #{id => Name, - start => {?MODULE, start_link, [Config0]}, + start => {logger_olp, start_link, [RegName,?MODULE, + Config0, OlpOpts0]}, restart => temporary, shutdown => 2000, type => worker, modules => [?MODULE]}, case supervisor:start_child(logger_sup, ChildSpec) of - {ok,Pid,Config} -> + {ok,Pid,Olp} -> ok = logger_handler_watcher:register_handler(Name,Pid), - {ok,Config}; + OlpOpts = logger_olp:get_opts(Olp), + {ok,Config0#{config=>(maps:merge(HConfig,OlpOpts))#{olp=>Olp}}}; + {error,{Reason,Ch}} when is_tuple(Ch), element(1,Ch)==child -> + {error,Reason}; Error -> Error end. @@ -200,103 +214,50 @@ start(#{id := Name} = Config0) -> %%% gen_server callbacks %%%=================================================================== -init(#{id := Name, module := Module, - formatter := Formatter, config := HConfig0} = Config0) -> - RegName = ?name_to_reg_name(Module,Name), - register(RegName, self()), +init(#{id := Name, module := Module, config := HConfig}) -> process_flag(trap_exit, true), - process_flag(message_queue_data, off_heap), ?init_test_hooks(), - ?start_observation(Name), - case Module:init(Name, HConfig0) of + case Module:init(Name, HConfig) of {ok,HState} -> - try ets:new(Name, [public]) of - ModeTab -> - ?set_mode(ModeTab, async), - T0 = ?timestamp(), - HConfig = HConfig0#{handler_pid => self(), - mode_tab => ModeTab}, - Config = Config0#{config => HConfig}, - proc_lib:init_ack({ok,self(),Config}), - %% Storing common config in state to avoid copying - %% (sending) the config data for each log message - CommonConfig = maps:with(?CONFIG_KEYS,HConfig), - State = - ?merge_with_stats( - CommonConfig#{id => Name, - module => Module, - mode_tab => ModeTab, - mode => async, - ctrl_sync_count => - ?CONTROLLER_SYNC_INTERVAL, - last_qlen => 0, - last_log_ts => T0, - last_op => sync, - burst_win_ts => T0, - burst_msg_count => 0, - formatter => Formatter, - handler_state => HState}), - State1 = set_repeated_filesync(State), - unset_restart_flag(State1), - gen_server:enter_loop(?MODULE, [], State1) - catch - _:Error -> - unregister(RegName), - error_notify({init_handler,Name,Error}), - proc_lib:init_ack(Error) - end; + %% Storing common config in state to avoid copying + %% (sending) the config data for each log message + CommonConfig = maps:with(?COMMON_KEYS,HConfig), + State = CommonConfig#{id => Name, + module => Module, + ctrl_sync_count => + ?CONTROLLER_SYNC_INTERVAL, + last_op => sync, + handler_state => HState}, + State1 = set_repeated_filesync(State), + {ok,State1}; Error -> - unregister(RegName), - error_notify({init_handler,Name,Error}), - proc_lib:init_ack(Error) + Error end. -%% This is the synchronous log event. -handle_call({log, Bin}, _From, State) -> - {Result,State1} = do_log(Bin, call, State), - %% Result == ok | dropped - {reply,Result, State1}; +%% This is the log event. +handle_load(Bin, #{id:=Name, + module:=Module, + handler_state:=HandlerState, + ctrl_sync_count := CtrlSync}=State) -> + if CtrlSync==0 -> + {_,HS1} = Module:write(Name, sync, Bin, HandlerState), + State#{handler_state => HS1, + ctrl_sync_count => ?CONTROLLER_SYNC_INTERVAL, + last_op=>write}; + true -> + {_,HS1} = Module:write(Name, async, Bin, HandlerState), + State#{handler_state => HS1, + ctrl_sync_count => CtrlSync-1, + last_op=>write} + end. handle_call(filesync, _From, State = #{id := Name, module := Module, handler_state := HandlerState}) -> {Result,HandlerState1} = Module:filesync(Name,sync,HandlerState), - {reply, Result, State#{handler_state=>HandlerState1, last_op=>sync}}; - -handle_call({change_config, #{formatter:=Formatter, config:=NewHConfig}}, _From, - State = #{filesync_repeat_interval := FSyncInt0}) -> - %% In the future, if handler_state must be updated due to config - %% change, then we need to add a callback to Module here. - CommonConfig = maps:with(?CONFIG_KEYS,NewHConfig), - State1 = maps:merge(State, CommonConfig), - State2 = - case maps:get(filesync_repeat_interval, NewHConfig) of - FSyncInt0 -> - State1; - _FSyncInt1 -> - set_repeated_filesync(cancel_repeated_filesync(State1)) - end, - {reply, ok, State2#{formatter:=Formatter}}; - -handle_call(info, _From, State) -> - {reply, State, State}; - -handle_call(reset, _From, - #{id:=Name,module:=Module,handler_state:=HandlerState}=State) -> - State1 = ?merge_with_stats(State), - {reply, ok, State1#{last_qlen => 0, - last_log_ts => ?timestamp(), - handler_state => Module:reset_state(Name,HandlerState)}}; - -handle_call(stop, _From, State) -> - {stop, {shutdown,stopped}, ok, State}. - -%% This is the asynchronous log event. -handle_cast({log, Bin}, State) -> - {_,State1} = do_log(Bin, cast, State), - {noreply, State1}; + {reply, Result, State#{handler_state=>HandlerState1, last_op=>sync}}. %% If FILESYNC_REPEAT_INTERVAL is set to a millisec value, this %% clause gets called repeatedly by the handler. In order to @@ -319,168 +280,83 @@ handle_cast(repeated_filesync, {_,HS} = Module:filesync(Name, async, HandlerState), State#{handler_state => HS, last_op => sync} end, - {noreply,set_repeated_filesync(State1)}. + {noreply,set_repeated_filesync(State1)}; + +handle_cast({set_repeated_filesync,FSyncInt},State) -> + State1 = State#{filesync_repeat_interval=>FSyncInt}, + State2 = set_repeated_filesync(cancel_repeated_filesync(State1)), + {noreply, State2}. handle_info(Info, #{id := Name, module := Module, handler_state := HandlerState} = State) -> {noreply,State#{handler_state => Module:handle_info(Name,Info,HandlerState)}}. -terminate(Reason, State = #{id := Name, - module := Module, - handler_state := HandlerState}) -> +terminate(overloaded=Reason, #{id:=Name}=State) -> + _ = log_handler_info(Name,"Handler ~p overloaded and stopping",[Name],State), + do_terminate(Reason,State), + ConfigResult = logger:get_handler_config(Name), + case ConfigResult of + {ok,#{module:=Module}=HConfig0} -> + spawn(fun() -> logger:remove_handler(Name) end), + HConfig = try Module:filter_config(HConfig0) + catch _:_ -> HConfig0 + end, + {ok,fun() -> logger:add_handler(Name,Module,HConfig) end}; + Error -> + error_notify({Name,restart_impossible,Error}), + Error + end; +terminate(Reason, State) -> + do_terminate(Reason, State). + +do_terminate(Reason, State = #{id := Name, + module := Module, + handler_state := HandlerState}) -> _ = cancel_repeated_filesync(State), _ = Module:terminate(Name, Reason, HandlerState), - ok = stop_or_restart(Name, Reason, State), - unregister(?name_to_reg_name(Module, Name)), ok. code_change(_OldVsn, State, _Extra) -> {ok, State}. +reset_state(#{id:=Name, module:=Module, handler_state:=HandlerState} = State) -> + State#{handler_state=>Module:reset_state(Name, HandlerState)}. %%%----------------------------------------------------------------- %%% Internal functions call(Module, Name, Op) when is_atom(Name) -> - call(?name_to_reg_name(Module,Name), Op); + case logger_olp:call(?name_to_reg_name(Module,Name), Op) of + {error,busy} -> {error,handler_busy}; + Other -> Other + end; call(_, Name, Op) -> {error,{badarg,{Op,[Name]}}}. -call(Server, Msg) -> - try - gen_server:call(Server, Msg, ?DEFAULT_CALL_TIMEOUT) - catch - _:{timeout,_} -> {error,handler_busy} - end. - -%% check for overload between every event (and set Mode to async, -%% sync or drop accordingly), but never flush the whole mailbox -%% before LogWindowSize events have been handled -do_log(Bin, CallOrCast, State = #{id:=Name, mode:=Mode0}) -> - T1 = ?timestamp(), - - %% check if the handler is getting overloaded, or if it's - %% recovering from overload (the check must be done for each - %% event to react quickly to large bursts of events and - %% to ensure that the handler can never end up in drop mode - %% with an empty mailbox, which would stop operation) - {Mode1,QLen,Mem,State1} = check_load(State), - - if (Mode1 == drop) andalso (Mode0 =/= drop) -> - log_handler_info(Name, "Handler ~p switched to drop mode", - [Name], State); - (Mode0 == drop) andalso ((Mode1 == async) orelse (Mode1 == sync)) -> - log_handler_info(Name, "Handler ~p switched to ~w mode", - [Name,Mode1], State); - true -> - ok - end, - - %% kill the handler if it can't keep up with the load - kill_if_choked(Name, QLen, Mem, State), - - if Mode1 == flush -> - flush(Name, QLen, T1, State1); - true -> - write(Name, Mode1, T1, Bin, CallOrCast, State1) - end. - -%% this clause is called by do_log/3 after an overload check -%% has been performed, where QLen > FlushQLen -flush(Name, _QLen0, T1, State=#{last_log_ts := _T0, mode_tab := ModeTab}) -> - %% flush messages in the mailbox (a limited number in - %% order to not cause long delays) - NewFlushed = flush_log_events(?FLUSH_MAX_N), - - %% write info in log about flushed messages +notify({mode_change,Mode0,Mode1},#{id:=Name}=State) -> + log_handler_info(Name,"Handler ~p switched from ~p to ~p mode", + [Name,Mode0,Mode1], State); +notify({flushed,Flushed},#{id:=Name}=State) -> log_handler_info(Name, "Handler ~p flushed ~w log events", - [Name,NewFlushed], State), - - %% because of the receive loop when flushing messages, the - %% handler will be scheduled out often and the mailbox could - %% grow very large, so we'd better check the queue again here - {_,_QLen1} = process_info(self(), message_queue_len), - ?observe(Name,{max_qlen,_QLen1}), - - %% Add 1 for the current log event - ?observe(Name,{flushed,NewFlushed+1}), - - State1 = ?update_max_time(?diff_time(T1,_T0),State), - State2 = ?update_max_qlen(_QLen1,State1), - {dropped,?update_other(flushed,FLUSHED,NewFlushed, - State2#{mode => ?set_mode(ModeTab,async), - last_qlen => 0, - last_log_ts => T1})}. - -%% this clause is called to write to file -write(Name, Mode, T1, Bin, _CallOrCast, - State = #{module := Module, - handler_state := HandlerState, - mode_tab := ModeTab, - ctrl_sync_count := CtrlSync, - last_qlen := LastQLen, - last_log_ts := T0}) -> - %% check if we need to limit the number of writes - %% during a burst of log events - {DoWrite,State1} = limit_burst(State), - - %% only log synhrounously every ?CONTROLLER_SYNC_INTERVAL time, to - %% give the handler time between writes so it can keep up with - %% incoming messages - {Result,LastQLen1,HandlerState1} = - if DoWrite, CtrlSync == 0 -> - ?observe(Name,{_CallOrCast,1}), - {_,HS1} = Module:write(Name, sync, Bin, HandlerState), - {ok,element(2, process_info(self(), message_queue_len)),HS1}; - DoWrite -> - ?observe(Name,{_CallOrCast,1}), - {_,HS1} = Module:write(Name, async, Bin, HandlerState), - {ok,LastQLen,HS1}; - not DoWrite -> - ?observe(Name,{flushed,1}), - {dropped,LastQLen,HandlerState} - end, - - %% Check if the time since the previous log event is long enough - - %% and the queue length small enough - to assume the mailbox has - %% been emptied, and if so, do filesync operation and reset mode to - %% async. Note that this is the best we can do to detect an idle - %% handler without setting a timer after each log call/cast. If the - %% time between two consecutive log events is fast and no new - %% event comes in after the last one, idle state won't be detected! - Time = ?diff_time(T1,T0), - State2 = - if (LastQLen1 < ?FILESYNC_OK_QLEN) andalso - (Time > ?IDLE_DETECT_TIME_USEC) -> - {_,HS2} = Module:filesync(Name,async,HandlerState), - State1#{mode => ?change_mode(ModeTab, Mode, async), - burst_msg_count => 0, - handler_state => HS2}; - true -> - State1#{mode => Mode, handler_state => HandlerState1} - end, - State3 = ?update_calls_or_casts(_CallOrCast,1,State2), - State4 = ?update_max_qlen(LastQLen1,State3), - State5 = - ?update_max_time(Time, - State4#{last_qlen := LastQLen1, - last_log_ts => T1, - last_op => write, - ctrl_sync_count => - if CtrlSync==0 -> ?CONTROLLER_SYNC_INTERVAL; - true -> CtrlSync-1 - end}), - {Result,State5}. + [Name,Flushed], State); +notify(restart,#{id:=Name}=State) -> + log_handler_info(Name, "Handler ~p restarted", [Name], State); +notify(idle,#{id:=Name,module:=Module,handler_state:=HandlerState}=State) -> + {_,HS} = Module:filesync(Name,async,HandlerState), + State#{handler_state=>HS, last_op=>sync}. log_handler_info(Name, Format, Args, #{module:=Module, - formatter:=Formatter, - handler_state:=HandlerState}) -> - Config = #{formatter=>Formatter}, + handler_state:=HandlerState}=State) -> + Config = + case logger:get_handler_config(Name) of + {ok,Conf} -> Conf; + _ -> #{formatter=>{?DEFAULT_FORMATTER,?DEFAULT_FORMAT_CONFIG}} + end, Meta = #{time=>erlang:system_time(microsecond)}, Bin = log_to_binary(#{level => notice, msg => {Format,Args}, meta => Meta}, Config), - _ = Module:write(Name, async, Bin, HandlerState), - ok. + {_,HS} = Module:write(Name, async, Bin, HandlerState), + State#{handler_state=>HS, last_op=>write}. %%%----------------------------------------------------------------- %%% Convert log data on any form to binary @@ -540,42 +416,8 @@ string_to_binary(String) -> %%%----------------------------------------------------------------- %%% Check that the configuration term is valid check_config(Config) when is_map(Config) -> - case check_common_config(maps:to_list(Config)) of - ok -> - case overload_levels_ok(Config) of - true -> - ok; - false -> - Faulty = maps:with([sync_mode_qlen, - drop_mode_qlen, - flush_qlen],Config), - {error,{invalid_levels,Faulty}} - end; - Error -> - Error - end. + check_common_config(maps:to_list(Config)). -check_common_config([{sync_mode_qlen,N}|Config]) when is_integer(N) -> - check_common_config(Config); -check_common_config([{drop_mode_qlen,N}|Config]) when is_integer(N) -> - check_common_config(Config); -check_common_config([{flush_qlen,N}|Config]) when is_integer(N) -> - check_common_config(Config); -check_common_config([{burst_limit_enable,Bool}|Config]) when is_boolean(Bool) -> - check_common_config(Config); -check_common_config([{burst_limit_max_count,N}|Config]) when is_integer(N) -> - check_common_config(Config); -check_common_config([{burst_limit_window_time,N}|Config]) when is_integer(N) -> - check_common_config(Config); -check_common_config([{overload_kill_enable,Bool}|Config]) when is_boolean(Bool) -> - check_common_config(Config); -check_common_config([{overload_kill_qlen,N}|Config]) when is_integer(N) -> - check_common_config(Config); -check_common_config([{overload_kill_mem_size,N}|Config]) when is_integer(N) -> - check_common_config(Config); -check_common_config([{overload_kill_restart_after,NorA}|Config]) - when is_integer(NorA); NorA == infinity -> - check_common_config(Config); check_common_config([{filesync_repeat_interval,NorA}|Config]) when is_integer(NorA); NorA == no_repeat -> check_common_config(Config); @@ -585,156 +427,7 @@ check_common_config([]) -> ok. get_default_config() -> - #{sync_mode_qlen => ?SYNC_MODE_QLEN, - drop_mode_qlen => ?DROP_MODE_QLEN, - flush_qlen => ?FLUSH_QLEN, - burst_limit_enable => ?BURST_LIMIT_ENABLE, - burst_limit_max_count => ?BURST_LIMIT_MAX_COUNT, - burst_limit_window_time => ?BURST_LIMIT_WINDOW_TIME, - overload_kill_enable => ?OVERLOAD_KILL_ENABLE, - overload_kill_qlen => ?OVERLOAD_KILL_QLEN, - overload_kill_mem_size => ?OVERLOAD_KILL_MEM_SIZE, - overload_kill_restart_after => ?OVERLOAD_KILL_RESTART_AFTER, - filesync_repeat_interval => ?FILESYNC_REPEAT_INTERVAL}. - -%%%----------------------------------------------------------------- -%%% Overload Protection -call_cast_or_drop(_Name, HandlerPid, ModeTab, Bin) -> - %% If the handler process is getting overloaded, the log event - %% will be synchronous instead of asynchronous (slows down the - %% logging tempo of a process doing lots of logging. If the - %% handler is choked, drop mode is set and no event will be sent. - try ?get_mode(ModeTab) of - async -> - gen_server:cast(HandlerPid, {log,Bin}); - sync -> - case call(HandlerPid, {log,Bin}) of - ok -> - ok; - _Other -> - %% dropped or {error,handler_busy} - ?observe(_Name,{dropped,1}), - ok - end; - drop -> - ?observe(_Name,{dropped,1}) - catch - %% if the ETS table doesn't exist (maybe because of a - %% handler restart), we can only drop the event - _:_ -> ?observe(_Name,{dropped,1}) - end, - ok. - -set_restart_flag(#{id := Name, module := Module} = State) -> - log_handler_info(Name, "Handler ~p overloaded and stopping", [Name], State), - Flag = list_to_atom(lists:concat([Module,"_",Name,"_restarting"])), - spawn(fun() -> - register(Flag, self()), - timer:sleep(infinity) - end), - ok. - -unset_restart_flag(#{id := Name, module := Module} = State) -> - Flag = list_to_atom(lists:concat([Module,"_",Name,"_restarting"])), - case whereis(Flag) of - undefined -> - ok; - Pid -> - exit(Pid, kill), - log_handler_info(Name, "Handler ~p restarted", [Name], State) - end. - -check_load(State = #{id:=_Name, mode_tab := ModeTab, mode := Mode, - sync_mode_qlen := SyncModeQLen, - drop_mode_qlen := DropModeQLen, - flush_qlen := FlushQLen}) -> - {_,Mem} = process_info(self(), memory), - ?observe(_Name,{max_mem,Mem}), - {_,QLen} = process_info(self(), message_queue_len), - ?observe(_Name,{max_qlen,QLen}), - %% When the handler process gets scheduled in, it's impossible - %% to predict the QLen. We could jump "up" arbitrarily from say - %% async to sync, async to drop, sync to flush, etc. However, when - %% the handler process manages the log events (without flushing), - %% one after the other, we will move "down" from drop to sync and - %% from sync to async. This way we don't risk getting stuck in - %% drop or sync mode with an empty mailbox. - {Mode1,_NewDrops,_NewFlushes} = - if - QLen >= FlushQLen -> - {flush, 0,1}; - QLen >= DropModeQLen -> - %% Note that drop mode will force log events to - %% be dropped on the client side (never sent get to - %% the handler). - IncDrops = if Mode == drop -> 0; true -> 1 end, - {?change_mode(ModeTab, Mode, drop), IncDrops,0}; - QLen >= SyncModeQLen -> - {?change_mode(ModeTab, Mode, sync), 0,0}; - true -> - {?change_mode(ModeTab, Mode, async), 0,0} - end, - State1 = ?update_other(drops,DROPS,_NewDrops,State), - {Mode1, QLen, Mem, - ?update_other(flushes,FLUSHES,_NewFlushes, - State1#{last_qlen => QLen})}. - -limit_burst(#{burst_limit_enable := false}=State) -> - {true,State}; -limit_burst(#{burst_win_ts := BurstWinT0, - burst_msg_count := BurstMsgCount, - burst_limit_window_time := BurstLimitWinTime, - burst_limit_max_count := BurstLimitMaxCnt} = State) -> - if (BurstMsgCount >= BurstLimitMaxCnt) -> - %% the limit for allowed messages has been reached - BurstWinT1 = ?timestamp(), - case ?diff_time(BurstWinT1,BurstWinT0) of - BurstCheckTime when BurstCheckTime < (BurstLimitWinTime*1000) -> - %% we're still within the burst time frame - {false,?update_other(burst_drops,BURSTS,1,State)}; - _BurstCheckTime -> - %% burst time frame passed, reset counters - {true,State#{burst_win_ts => BurstWinT1, - burst_msg_count => 0}} - end; - true -> - %% the limit for allowed messages not yet reached - {true,State#{burst_win_ts => BurstWinT0, - burst_msg_count => BurstMsgCount+1}} - end. - -kill_if_choked(Name, QLen, Mem, State = #{overload_kill_enable := KillIfOL, - overload_kill_qlen := OLKillQLen, - overload_kill_mem_size := OLKillMem}) -> - if KillIfOL andalso - ((QLen > OLKillQLen) orelse (Mem > OLKillMem)) -> - set_restart_flag(State), - exit({shutdown,{overloaded,Name,QLen,Mem}}); - true -> - ok - end. - -flush_log_events(Limit) -> - process_flag(priority, high), - Flushed = flush_log_events(0, Limit), - process_flag(priority, normal), - Flushed. - -flush_log_events(Limit, Limit) -> - Limit; -flush_log_events(N, Limit) -> - %% flush log events but leave other events, such as - %% filesync, info and change_config, so that these - %% have a chance to be processed even under heavy load - receive - {'$gen_cast',{log,_}} -> - flush_log_events(N+1, Limit); - {'$gen_call',{Pid,MRef},{log,_}} -> - Pid ! {MRef, dropped}, - flush_log_events(N+1, Limit) - after - 0 -> N - end. + #{filesync_repeat_interval => ?FILESYNC_REPEAT_INTERVAL}. set_repeated_filesync(#{filesync_repeat_interval:=FSyncInt} = State) when is_integer(FSyncInt) -> @@ -752,51 +445,12 @@ cancel_repeated_filesync(State) -> error -> State end. - -stop_or_restart(Name, {shutdown,Reason={overloaded,_Name,_QLen,_Mem}}, - #{overload_kill_restart_after := RestartAfter}) -> - %% If we're terminating because of an overload situation (see - %% kill_if_choked/4), we need to remove the handler and set a - %% restart timer. A separate process must perform this in order to - %% avoid deadlock. - HandlerPid = self(), - ConfigResult = logger:get_handler_config(Name), - RemoveAndRestart = - fun() -> - MRef = erlang:monitor(process, HandlerPid), - receive - {'DOWN',MRef,_,_,_} -> - ok - after 30000 -> - error_notify(Reason), - exit(HandlerPid, kill) - end, - case ConfigResult of - {ok,#{module:=HMod}=HConfig0} when is_integer(RestartAfter) -> - _ = logger:remove_handler(Name), - HConfig = try HMod:filter_config(HConfig0) - catch _:_ -> HConfig0 - end, - _ = timer:apply_after(RestartAfter, logger, add_handler, - [Name,HMod,HConfig]); - {ok,_} -> - _ = logger:remove_handler(Name); - {error,CfgReason} when is_integer(RestartAfter) -> - error_notify({Name,restart_impossible,CfgReason}); - {error,_} -> - ok - end - end, - spawn(RemoveAndRestart), - ok; -stop_or_restart(_Name, _Reason, _State) -> - ok. - -overload_levels_ok(HandlerConfig) -> - SMQL = maps:get(sync_mode_qlen, HandlerConfig, ?SYNC_MODE_QLEN), - DMQL = maps:get(drop_mode_qlen, HandlerConfig, ?DROP_MODE_QLEN), - FQL = maps:get(flush_qlen, HandlerConfig, ?FLUSH_QLEN), - (DMQL > 1) andalso (SMQL =< DMQL) andalso (DMQL =< FQL). - error_notify(Term) -> ?internal_log(error, Term). + +maybe_set_repeated_filesync(_Olp, + #{filesync_repeat_interval:=FSyncInt}, + #{filesync_repeat_interval:=FSyncInt}) -> + ok; +maybe_set_repeated_filesync(Olp,_,#{filesync_repeat_interval:=FSyncInt}) -> + logger_olp:cast(Olp,{set_repeated_filesync,FSyncInt}). diff --git a/lib/kernel/src/logger_h_common.hrl b/lib/kernel/src/logger_h_common.hrl index 261b0a6246..004a61d9d9 100644 --- a/lib/kernel/src/logger_h_common.hrl +++ b/lib/kernel/src/logger_h_common.hrl @@ -1,50 +1,22 @@ - -%%%----------------------------------------------------------------- -%%% Overload protection configuration - -%%! *** NOTE *** -%%! It's important that: -%%! SYNC_MODE_QLEN =< DROP_MODE_QLEN =< FLUSH_QLEN -%%! and that DROP_MODE_QLEN >= 2. -%%! Otherwise the handler could end up in drop mode with no new -%%! log requests to process. This would cause all future requests -%%! to be dropped (no switch to async mode would ever take place). - -%% This specifies the message_queue_len value where the log -%% requests switch from asynchronous casts to synchronous calls. --define(SYNC_MODE_QLEN, 10). -%% Above this message_queue_len, log requests will be dropped, -%% i.e. no log requests get sent to the handler process. --define(DROP_MODE_QLEN, 200). -%% Above this message_queue_len, the handler process will flush -%% its mailbox and only leave this number of messages in it. --define(FLUSH_QLEN, 1000). - -%% Never flush more than this number of messages in one go, -%% or the handler will be unresponsive for seconds (keep this -%% number as large as possible or the mailbox could grow large). --define(FLUSH_MAX_N, 5000). - -%% BURST_LIMIT_MAX_COUNT is the max number of log requests allowed -%% to be written within a BURST_LIMIT_WINDOW_TIME time frame. --define(BURST_LIMIT_ENABLE, true). --define(BURST_LIMIT_MAX_COUNT, 500). --define(BURST_LIMIT_WINDOW_TIME, 1000). - -%% This enables/disables the feature to automatically get the -%% handler terminated if it gets too loaded (and can't keep up). --define(OVERLOAD_KILL_ENABLE, false). -%% If the message_queue_len goes above this size even after -%% flushing has been performed, the handler is terminated. --define(OVERLOAD_KILL_QLEN, 20000). -%% If the memory usage exceeds this level --define(OVERLOAD_KILL_MEM_SIZE, 3000000). - -%% This is the default time that the handler will wait before -%% restarting and accepting new requests. The value 'infinity' -%% disables restarts. --define(OVERLOAD_KILL_RESTART_AFTER, 5000). -%%-define(OVERLOAD_KILL_RESTART_AFTER, infinity). +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2015. 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% +%% %% The handler sends asynchronous write requests to the process %% controlling the i/o device, but every once in this interval @@ -65,12 +37,6 @@ -define(FILESYNC_REPEAT_INTERVAL, 5000). %%-define(FILESYNC_REPEAT_INTERVAL, no_repeat). -%% This is the time after last message received that we think/hope -%% that the handler has an empty mailbox (no new log request has -%% come in). --define(IDLE_DETECT_TIME_MSEC, 100). --define(IDLE_DETECT_TIME_USEC, 100000). - %% Default disk log option values -define(DISK_LOG_TYPE, wrap). -define(DISK_LOG_MAX_NO_FILES, 10). @@ -83,43 +49,6 @@ list_to_atom(lists:concat([MODULE,"_",Name]))). %%%----------------------------------------------------------------- -%%% Overload protection macros - --define(timestamp(), erlang:monotonic_time(microsecond)). - --define(get_mode(Tid), - case ets:lookup(Tid, mode) of - [{mode,M}] -> M; - _ -> async - end). - --define(set_mode(Tid, M), - begin ets:insert(Tid, {mode,M}), M end). - --define(change_mode(Tid, M0, M1), - if M0 == M1 -> - M0; - true -> - ets:insert(Tid, {mode,M1}), - M1 - end). - --define(min(X1, X2), - if X2 == undefined -> X1; - X2 < X1 -> X2; - true -> X1 - end). - --define(max(X1, X2), - if - X2 == undefined -> X1; - X2 > X1 -> X2; - true -> X1 - end). - --define(diff_time(OS_T1, OS_T0), OS_T1-OS_T0). - -%%%----------------------------------------------------------------- %%% The test hook macros make it possible to observe and manipulate %%% internal handler functionality. When enabled, these macros will %%% slow down execution and therefore should not be include in code @@ -183,7 +112,6 @@ [{_,ERROR}] -> ERROR catch _:_ -> disk_log:sync(LOG) end). - -define(DEFAULT_CALL_TIMEOUT, 5000). -else. % DEFAULTS! -define(TEST_HOOKS_TAB, undefined). @@ -196,68 +124,4 @@ -define(file_datasync(DEVICE), file:datasync(DEVICE)). -define(disk_log_write(LOG, MODE, DATA), disk_log_write(LOG, MODE, DATA)). -define(disk_log_sync(LOG), disk_log:sync(LOG)). - -define(DEFAULT_CALL_TIMEOUT, 10000). --endif. - -%%%----------------------------------------------------------------- -%%% These macros enable statistics counters in the state of the -%%% handler which is useful for analysing the overload protection -%%% behaviour. These counters should not be included in code to be -%%% officially released (as some counters will grow very large -%%% over time). - -%%-define(SAVE_STATS, true). --ifdef(SAVE_STATS). - -define(merge_with_stats(STATE), - STATE#{flushes => 0, flushed => 0, drops => 0, - burst_drops => 0, casts => 0, calls => 0, - max_qlen => 0, max_time => 0}). - - -define(update_max_qlen(QLEN, STATE), - begin #{max_qlen := QLEN0} = STATE, - STATE#{max_qlen => ?max(QLEN0,QLEN)} end). - - -define(update_calls_or_casts(CALL_OR_CAST, INC, STATE), - case CALL_OR_CAST of - cast -> - #{casts := CASTS0} = STATE, - STATE#{casts => CASTS0+INC}; - call -> - #{calls := CALLS0} = STATE, - STATE#{calls => CALLS0+INC} - end). - - -define(update_max_time(TIME, STATE), - begin #{max_time := TIME0} = STATE, - STATE#{max_time => ?max(TIME0,TIME)} end). - - -define(update_other(OTHER, VAR, INCVAL, STATE), - begin #{OTHER := VAR} = STATE, - STATE#{OTHER => VAR+INCVAL} end). - --else. % DEFAULT! - -define(merge_with_stats(STATE), STATE). - -define(update_max_qlen(_QLEN, STATE), STATE). - -define(update_calls_or_casts(_CALL_OR_CAST, _INC, STATE), STATE). - -define(update_max_time(_TIME, STATE), STATE). - -define(update_other(_OTHER, _VAR, _INCVAL, STATE), STATE). --endif. - -%%%----------------------------------------------------------------- -%%% These macros enable callbacks that make it possible to analyse -%%% the overload protection behaviour from outside the handler -%%% process (including dropped requests on the client side). -%%% An external callback module (?OBSERVER_MOD) is required which -%%% is not part of the kernel application. For this reason, these -%%% callbacks should not be included in code to be officially released. - -%%-define(OBSERVER_MOD, logger_test). --ifdef(OBSERVER_MOD). - -define(start_observation(NAME), ?OBSERVER:start_observation(NAME)). - -define(observe(NAME,EVENT), ?OBSERVER:observe(NAME,EVENT)). - --else. % DEFAULT! - -define(start_observation(_NAME), ok). - -define(observe(_NAME,_EVENT), ok). -endif. -%%! <--- diff --git a/lib/kernel/src/logger_internal.hrl b/lib/kernel/src/logger_internal.hrl index d96a4ac78b..e53922e5d3 100644 --- a/lib/kernel/src/logger_internal.hrl +++ b/lib/kernel/src/logger_internal.hrl @@ -19,6 +19,7 @@ %% -include_lib("kernel/include/logger.hrl"). -define(LOGGER_TABLE,logger). +-define(PROXY_KEY,'$proxy_config$'). -define(PRIMARY_KEY,'$primary_config$'). -define(HANDLER_KEY,'$handler_config$'). -define(LOGGER_META_KEY,'$logger_metadata$'). @@ -40,12 +41,14 @@ -define(DEFAULT_LOGGER_CALL_TIMEOUT, infinity). --define(LOG_INTERNAL(Level,Report), +-define(LOG_INTERNAL(Level,Report),?DO_LOG_INTERNAL(Level,[Report])). +-define(LOG_INTERNAL(Level,Format,Args),?DO_LOG_INTERNAL(Level,[Format,Args])). +-define(DO_LOG_INTERNAL(Level,Data), case logger:allow(Level,?MODULE) of true -> %% Spawn this to avoid deadlocks - _ = spawn(logger,macro_log,[?LOCATION,Level,Report, - logger:add_default_metadata(#{})]), + _ = spawn(logger,macro_log,[?LOCATION,Level|Data]++ + [logger:add_default_metadata(#{})]), ok; false -> ok diff --git a/lib/kernel/src/logger_olp.erl b/lib/kernel/src/logger_olp.erl new file mode 100644 index 0000000000..009280a9c9 --- /dev/null +++ b/lib/kernel/src/logger_olp.erl @@ -0,0 +1,626 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017-2018. 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(logger_olp). +-behaviour(gen_server). + +-include("logger_olp.hrl"). +-include("logger_internal.hrl"). + +%% API +-export([start_link/4, load/2, info/1, reset/1, stop/1, restart/1, + set_opts/2, get_opts/1, get_default_opts/0, get_pid/1, + call/2, cast/2, get_ref/0, get_ref/1]). + +%% gen_server and proc_lib callbacks +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +-define(OPT_KEYS,[sync_mode_qlen, + drop_mode_qlen, + flush_qlen, + burst_limit_enable, + burst_limit_max_count, + burst_limit_window_time, + overload_kill_enable, + overload_kill_qlen, + overload_kill_mem_size, + overload_kill_restart_after]). + +-export_type([olp_ref/0, options/0]). + +-opaque olp_ref() :: {atom(),pid(),ets:tid()}. + +-type options() :: logger:olp_config(). + +%%%----------------------------------------------------------------- +%%% API + +-spec start_link(Name,Module,Args,Options) -> {ok,Pid,Olp} | {error,Reason} when + Name :: atom(), + Module :: module(), + Args :: term(), + Options :: options(), + Pid :: pid(), + Olp :: olp_ref(), + Reason :: term(). +start_link(Name,Module,Args,Options0) when is_map(Options0) -> + Options = maps:merge(get_default_opts(),Options0), + case check_opts(Options) of + ok -> + proc_lib:start_link(?MODULE,init,[[Name,Module,Args,Options]]); + Error -> + Error + end. + +-spec load(Olp, Msg) -> ok when + Olp :: olp_ref(), + Msg :: term(). +load({_Name,Pid,ModeRef},Msg) -> + %% If the process is getting overloaded, the message will be + %% synchronous instead of asynchronous (slows down the tempo of a + %% process causing much load). If the process is choked, drop mode + %% is set and no message is sent. + try ?get_mode(ModeRef) of + async -> + gen_server:cast(Pid, {'$olp_load',Msg}); + sync -> + case call(Pid, {'$olp_load',Msg}) of + ok -> + ok; + _Other -> + %% dropped or {error,busy} + ?observe(_Name,{dropped,1}), + ok + end; + drop -> + ?observe(_Name,{dropped,1}) + catch + %% if the ETS table doesn't exist (maybe because of a + %% process restart), we can only drop the event + _:_ -> ?observe(_Name,{dropped,1}) + end, + ok. + +-spec info(Olp) -> map() | {error, busy} when + Olp :: atom() | pid() | olp_ref(). +info(Olp) -> + call(Olp, info). + +-spec reset(Olp) -> ok | {error, busy} when + Olp :: atom() | pid() | olp_ref(). +reset(Olp) -> + call(Olp, reset). + +-spec stop(Olp) -> ok when + Olp :: atom() | pid() | olp_ref(). +stop({_Name,Pid,_ModRef}) -> + stop(Pid); +stop(Pid) -> + _ = gen_server:call(Pid, stop), + ok. + +-spec set_opts(Olp, Opts) -> ok | {error,term()} | {error, busy} when + Olp :: atom() | pid() | olp_ref(), + Opts :: options(). +set_opts(Olp, Opts) -> + call(Olp, {set_opts,Opts}). + +-spec get_opts(Olp) -> options() | {error, busy} when + Olp :: atom() | pid() | olp_ref(). +get_opts(Olp) -> + call(Olp, get_opts). + +-spec get_default_opts() -> options(). +get_default_opts() -> + #{sync_mode_qlen => ?SYNC_MODE_QLEN, + drop_mode_qlen => ?DROP_MODE_QLEN, + flush_qlen => ?FLUSH_QLEN, + burst_limit_enable => ?BURST_LIMIT_ENABLE, + burst_limit_max_count => ?BURST_LIMIT_MAX_COUNT, + burst_limit_window_time => ?BURST_LIMIT_WINDOW_TIME, + overload_kill_enable => ?OVERLOAD_KILL_ENABLE, + overload_kill_qlen => ?OVERLOAD_KILL_QLEN, + overload_kill_mem_size => ?OVERLOAD_KILL_MEM_SIZE, + overload_kill_restart_after => ?OVERLOAD_KILL_RESTART_AFTER}. + +-spec restart(fun(() -> any())) -> ok. +restart(Fun) -> + Result = + try Fun() + catch C:R:S -> + {error,{restart_failed,Fun,C,R,S}} + end, + ?LOG_INTERNAL(debug,[{logger_olp,restart}, + {result,Result}]), + ok. + +-spec get_ref() -> olp_ref(). +get_ref() -> + get(olp_ref). + +-spec get_ref(PidOrName) -> olp_ref() | {error, busy} when + PidOrName :: pid() | atom(). +get_ref(PidOrName) -> + call(PidOrName,get_ref). + +-spec get_pid(olp_ref()) -> pid(). +get_pid({_Name,Pid,_ModeRef}) -> + Pid. + +%%%=================================================================== +%%% gen_server callbacks +%%%=================================================================== + +init([Name,Module,Args,Options]) -> + register(Name, self()), + process_flag(message_queue_data, off_heap), + + ?start_observation(Name), + + try ets:new(Name, [public]) of + ModeRef -> + OlpRef = {Name,self(),ModeRef}, + put(olp_ref,OlpRef), + try Module:init(Args) of + {ok,CBState} -> + ?set_mode(ModeRef, async), + T0 = ?timestamp(), + proc_lib:init_ack({ok,self(),OlpRef}), + %% Storing options in state to avoid copying + %% (sending) the option data with each message + State0 = ?merge_with_stats( + Options#{id => Name, + idle=> true, + module => Module, + mode_ref => ModeRef, + mode => async, + last_qlen => 0, + last_load_ts => T0, + burst_win_ts => T0, + burst_msg_count => 0, + cb_state => CBState}), + State = reset_restart_flag(State0), + gen_server:enter_loop(?MODULE, [], State); + Error -> + _ = ets:delete(ModeRef), + unregister(Name), + proc_lib:init_ack(Error) + catch + _:Error -> + _ = ets:delete(ModeRef), + unregister(Name), + proc_lib:init_ack(Error) + end + catch + _:Error -> + unregister(Name), + proc_lib:init_ack(Error) + end. + +%% This is the synchronous load event. +handle_call({'$olp_load', Msg}, _From, State) -> + {Result,State1} = do_load(Msg, call, State#{idle=>false}), + %% Result == ok | dropped + reply_return(Result,State1); + +handle_call(get_ref,_From,#{id:=Name,mode_ref:=ModeRef}=State) -> + reply_return({Name,self(),ModeRef},State); + +handle_call({set_opts,Opts0},_From,State) -> + Opts = maps:merge(maps:with(?OPT_KEYS,State),Opts0), + case check_opts(Opts) of + ok -> + reply_return(ok, maps:merge(State,Opts)); + Error -> + reply_return(Error, State) + end; + +handle_call(get_opts,_From,State) -> + reply_return(maps:with(?OPT_KEYS,State), State); + +handle_call(info, _From, State) -> + reply_return(State, State); + +handle_call(reset, _From, #{module:=Module,cb_state:=CBState}=State) -> + State1 = ?merge_with_stats(State), + CBState1 = try_callback_call(Module,reset_state,[CBState],CBState), + reply_return(ok, State1#{idle => true, + last_qlen => 0, + last_load_ts => ?timestamp(), + cb_state => CBState1}); + +handle_call(stop, _From, State) -> + {stop, {shutdown,stopped}, ok, State}; + +handle_call(Msg, From, #{module:=Module,cb_state:=CBState}=State) -> + case try_callback_call(Module,handle_call,[Msg, From, CBState]) of + {reply,Reply,CBState1} -> + reply_return(Reply,State#{cb_state=>CBState1}); + {noreply,CBState1} -> + noreply_return(State#{cb_state=>CBState1}); + {stop, Reason, Reply, CBState1} -> + {stop, Reason, Reply, State#{cb_state=>CBState1}}; + {stop, Reason, CBState1} -> + {stop, Reason, State#{cb_state=>CBState1}} + end. + +%% This is the asynchronous load event. +handle_cast({'$olp_load', Msg}, State) -> + {_Result,State1} = do_load(Msg, cast, State#{idle=>false}), + noreply_return(State1); + +handle_cast(Msg, #{module:=Module, cb_state:=CBState} = State) -> + case try_callback_call(Module,handle_cast,[Msg, CBState]) of + {noreply,CBState1} -> + noreply_return(State#{cb_state=>CBState1}); + {stop, Reason, CBState1} -> + {stop, Reason, State#{cb_state=>CBState1}} + end. + +handle_info(timeout, #{mode_ref:=_ModeRef, mode:=Mode} = State) -> + State1 = notify(idle,State), + State2 = maybe_notify_mode_change(async,State1), + {noreply, State2#{idle => true, + mode => ?change_mode(_ModeRef, Mode, async), + burst_msg_count => 0}}; +handle_info(Msg, #{module := Module, cb_state := CBState} = State) -> + case try_callback_call(Module,handle_info,[Msg, CBState]) of + {noreply,CBState1} -> + noreply_return(State#{cb_state=>CBState1}); + {stop, Reason, CBState1} -> + {stop, Reason, State#{cb_state=>CBState1}}; + {load,CBState1} -> + {_,State1} = do_load(Msg, cast, State#{idle=>false, + cb_state=>CBState1}), + noreply_return(State1) + end. + +terminate({shutdown,{overloaded,_QLen,_Mem}}, + #{id:=Name, module := Module, cb_state := CBState, + overload_kill_restart_after := RestartAfter} = State) -> + %% We're terminating because of an overload situation (see + %% kill_if_choked/3). + unregister(Name), %%!!!! to avoid error printout of callback crashed on stop + case try_callback_call(Module,terminate,[overloaded,CBState],ok) of + {ok,Fun} when is_function(Fun,0), is_integer(RestartAfter) -> + set_restart_flag(State), + _ = timer:apply_after(RestartAfter,?MODULE,restart,[Fun]), + ok; + _ -> + ok + end; +terminate(Reason, #{id:=Name, module:=Module, cb_state:=CBState}) -> + _ = try_callback_call(Module,terminate,[Reason,CBState],ok), + unregister(Name), + ok. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + + +%%%----------------------------------------------------------------- +%%% Internal functions +-spec call(Olp, term()) -> term() | {error,busy} when + Olp :: atom() | pid() | olp_ref(). +call({_Name, Pid, _ModeRef},Msg) -> + call(Pid, Msg); +call(Server, Msg) -> + try + gen_server:call(Server, Msg) + catch + _:{timeout,_} -> {error,busy} + end. + +-spec cast(olp_ref(),term()) -> ok. +cast({_Name, Pid, _ModeRef},Msg) -> + gen_server:cast(Pid, Msg). + +%% check for overload between every event (and set Mode to async, +%% sync or drop accordingly), but never flush the whole mailbox +%% before LogWindowSize events have been handled +do_load(Msg, CallOrCast, State) -> + T1 = ?timestamp(), + State1 = ?update_time(T1,State), + + %% check if the process is getting overloaded, or if it's + %% recovering from overload (the check must be done for each + %% event to react quickly to large bursts of events and + %% to ensure that the handler can never end up in drop mode + %% with an empty mailbox, which would stop operation) + {Mode1,QLen,Mem,State2} = check_load(State1), + + %% kill the handler if it can't keep up with the load + kill_if_choked(QLen, Mem, State2), + + if Mode1 == flush -> + flush(T1, State2); + true -> + handle_load(Mode1, T1, Msg, CallOrCast, State2) + end. + +%% this function is called by do_load/3 after an overload check +%% has been performed, where QLen > FlushQLen +flush(T1, State=#{id := _Name, mode := Mode, last_load_ts := _T0, mode_ref := ModeRef}) -> + %% flush load messages in the mailbox (a limited number in order + %% to not cause long delays) + NewFlushed = flush_load(?FLUSH_MAX_N), + + %% write info in log about flushed messages + State1=notify({flushed,NewFlushed},State), + + %% because of the receive loop when flushing messages, the + %% handler will be scheduled out often and the mailbox could + %% grow very large, so we'd better check the queue again here + {_,QLen1} = process_info(self(), message_queue_len), + ?observe(_Name,{max_qlen,QLen1}), + + %% Add 1 for the current log event + ?observe(_Name,{flushed,NewFlushed+1}), + + State2 = ?update_max_time(?diff_time(T1,_T0),State1), + State3 = ?update_max_qlen(QLen1,State2), + State4 = maybe_notify_mode_change(async,State3), + {dropped,?update_other(flushed,FLUSHED,NewFlushed, + State4#{mode => ?change_mode(ModeRef,Mode,async), + last_qlen => QLen1, + last_load_ts => T1})}. + +%% this function is called to actually handle the message +handle_load(Mode, T1, Msg, _CallOrCast, + State = #{id := _Name, + module := Module, + cb_state := CBState, + last_qlen := LastQLen, + last_load_ts := _T0}) -> + %% check if we need to limit the number of writes + %% during a burst of log events + {DoWrite,State1} = limit_burst(State), + + {Result,LastQLen1,CBState1} = + if DoWrite -> + ?observe(_Name,{_CallOrCast,1}), + CBS = try_callback_call(Module,handle_load,[Msg,CBState]), + {ok,element(2, process_info(self(), message_queue_len)),CBS}; + true -> + ?observe(_Name,{flushed,1}), + {dropped,LastQLen,CBState} + end, + State2 = State1#{cb_state=>CBState1}, + + State3 = State2#{mode => Mode}, + State4 = ?update_calls_or_casts(_CallOrCast,1,State3), + State5 = ?update_max_qlen(LastQLen1,State4), + State6 = + ?update_max_time(?diff_time(T1,_T0), + State5#{last_qlen := LastQLen1, + last_load_ts => T1}), + State7 = case Result of + ok -> + S = ?update_freq(T1,State6), + ?update_other(writes,WRITES,1,S); + _ -> + State6 + end, + {Result,State7}. + + +%%%----------------------------------------------------------------- +%%% Check that the options are valid +check_opts(Options) when is_map(Options) -> + case do_check_opts(maps:to_list(Options)) of + ok -> + case overload_levels_ok(Options) of + true -> + ok; + false -> + Faulty = maps:with([sync_mode_qlen, + drop_mode_qlen, + flush_qlen],Options), + {error,{invalid_olp_levels,Faulty}} + end; + {error,Key,Value} -> + {error,{invalid_olp_config,#{Key=>Value}}} + end. + +do_check_opts([{sync_mode_qlen,N}|Options]) when is_integer(N) -> + do_check_opts(Options); +do_check_opts([{drop_mode_qlen,N}|Options]) when is_integer(N) -> + do_check_opts(Options); +do_check_opts([{flush_qlen,N}|Options]) when is_integer(N) -> + do_check_opts(Options); +do_check_opts([{burst_limit_enable,Bool}|Options]) when is_boolean(Bool) -> + do_check_opts(Options); +do_check_opts([{burst_limit_max_count,N}|Options]) when is_integer(N) -> + do_check_opts(Options); +do_check_opts([{burst_limit_window_time,N}|Options]) when is_integer(N) -> + do_check_opts(Options); +do_check_opts([{overload_kill_enable,Bool}|Options]) when is_boolean(Bool) -> + do_check_opts(Options); +do_check_opts([{overload_kill_qlen,N}|Options]) when is_integer(N) -> + do_check_opts(Options); +do_check_opts([{overload_kill_mem_size,N}|Options]) when is_integer(N) -> + do_check_opts(Options); +do_check_opts([{overload_kill_restart_after,NorA}|Options]) + when is_integer(NorA); NorA == infinity -> + do_check_opts(Options); +do_check_opts([{Key,Value}|_]) -> + {error,Key,Value}; +do_check_opts([]) -> + ok. + +set_restart_flag(#{id := Name, module := Module}) -> + Flag = list_to_atom(lists:concat([Module,"_",Name,"_restarting"])), + spawn(fun() -> + register(Flag, self()), + timer:sleep(infinity) + end), + ok. + +reset_restart_flag(#{id := Name, module := Module} = State) -> + Flag = list_to_atom(lists:concat([Module,"_",Name,"_restarting"])), + case whereis(Flag) of + undefined -> + State; + Pid -> + exit(Pid, kill), + notify(restart,State) + end. + +check_load(State = #{id:=_Name, mode_ref := ModeRef, mode := Mode, + sync_mode_qlen := SyncModeQLen, + drop_mode_qlen := DropModeQLen, + flush_qlen := FlushQLen}) -> + {_,Mem} = process_info(self(), memory), + ?observe(_Name,{max_mem,Mem}), + {_,QLen} = process_info(self(), message_queue_len), + ?observe(_Name,{max_qlen,QLen}), + %% When the handler process gets scheduled in, it's impossible + %% to predict the QLen. We could jump "up" arbitrarily from say + %% async to sync, async to drop, sync to flush, etc. However, when + %% the handler process manages the log events (without flushing), + %% one after the other, we will move "down" from drop to sync and + %% from sync to async. This way we don't risk getting stuck in + %% drop or sync mode with an empty mailbox. + {Mode1,_NewDrops,_NewFlushes} = + if + QLen >= FlushQLen -> + {flush, 0,1}; + QLen >= DropModeQLen -> + %% Note that drop mode will force load messages to + %% be dropped on the client side (never sent to + %% the olp process). + IncDrops = if Mode == drop -> 0; true -> 1 end, + {?change_mode(ModeRef, Mode, drop), IncDrops,0}; + QLen >= SyncModeQLen -> + {?change_mode(ModeRef, Mode, sync), 0,0}; + true -> + {?change_mode(ModeRef, Mode, async), 0,0} + end, + State1 = ?update_other(drops,DROPS,_NewDrops,State), + State2 = ?update_max_qlen(QLen,State1), + State3 = maybe_notify_mode_change(Mode1,State2), + {Mode1, QLen, Mem, + ?update_other(flushes,FLUSHES,_NewFlushes, + State3#{last_qlen => QLen})}. + +limit_burst(#{burst_limit_enable := false}=State) -> + {true,State}; +limit_burst(#{burst_win_ts := BurstWinT0, + burst_msg_count := BurstMsgCount, + burst_limit_window_time := BurstLimitWinTime, + burst_limit_max_count := BurstLimitMaxCnt} = State) -> + if (BurstMsgCount >= BurstLimitMaxCnt) -> + %% the limit for allowed messages has been reached + BurstWinT1 = ?timestamp(), + case ?diff_time(BurstWinT1,BurstWinT0) of + BurstCheckTime when BurstCheckTime < (BurstLimitWinTime*1000) -> + %% we're still within the burst time frame + {false,?update_other(burst_drops,BURSTS,1,State)}; + _BurstCheckTime -> + %% burst time frame passed, reset counters + {true,State#{burst_win_ts => BurstWinT1, + burst_msg_count => 0}} + end; + true -> + %% the limit for allowed messages not yet reached + {true,State#{burst_win_ts => BurstWinT0, + burst_msg_count => BurstMsgCount+1}} + end. + +kill_if_choked(QLen, Mem, #{overload_kill_enable := KillIfOL, + overload_kill_qlen := OLKillQLen, + overload_kill_mem_size := OLKillMem}) -> + if KillIfOL andalso + ((QLen > OLKillQLen) orelse (Mem > OLKillMem)) -> + exit({shutdown,{overloaded,QLen,Mem}}); + true -> + ok + end. + +flush_load(Limit) -> + process_flag(priority, high), + Flushed = flush_load(0, Limit), + process_flag(priority, normal), + Flushed. + +flush_load(Limit, Limit) -> + Limit; +flush_load(N, Limit) -> + %% flush log events but leave other events, such as info, reset + %% and stop, so that these have a chance to be processed even + %% under heavy load + receive + {'$gen_cast',{'$olp_load',_}} -> + flush_load(N+1, Limit); + {'$gen_call',{Pid,MRef},{'$olp_load',_}} -> + Pid ! {MRef, dropped}, + flush_load(N+1, Limit); + {log,_,_,_,_} -> + flush_load(N+1, Limit); + {log,_,_,_} -> + flush_load(N+1, Limit) + after + 0 -> N + end. + +overload_levels_ok(Options) -> + SMQL = maps:get(sync_mode_qlen, Options, ?SYNC_MODE_QLEN), + DMQL = maps:get(drop_mode_qlen, Options, ?DROP_MODE_QLEN), + FQL = maps:get(flush_qlen, Options, ?FLUSH_QLEN), + (DMQL > 1) andalso (SMQL =< DMQL) andalso (DMQL =< FQL). + +maybe_notify_mode_change(drop,#{mode:=Mode0}=State) + when Mode0=/=drop -> + notify({mode_change,Mode0,drop},State); +maybe_notify_mode_change(Mode1,#{mode:=drop}=State) + when Mode1==async; Mode1==sync -> + notify({mode_change,drop,Mode1},State); +maybe_notify_mode_change(_,State) -> + State. + +notify(Note,#{module:=Module,cb_state:=CBState}=State) -> + CBState1 = try_callback_call(Module,notify,[Note,CBState],CBState), + State#{cb_state=>CBState1}. + +try_callback_call(Module, Function, Args) -> + try_callback_call(Module, Function, Args, '$no_default_return'). + +try_callback_call(Module, Function, Args, DefRet) -> + try apply(Module, Function, Args) + catch + throw:R -> R; + error:undef:S when DefRet=/='$no_default_return' -> + case S of + [{Module,Function,Args,_}|_] -> + DefRet; + _ -> + erlang:raise(error,undef,S) + end + end. + +noreply_return(#{idle:=true}=State) -> + {noreply,State}; +noreply_return(#{idle:=false}=State) -> + {noreply,State,?IDLE_DETECT_TIME}. + +reply_return(Reply,#{idle:=true}=State) -> + {reply,Reply,State}; +reply_return(Reply,#{idle:=false}=State) -> + {reply,Reply,State,?IDLE_DETECT_TIME}. diff --git a/lib/kernel/src/logger_olp.hrl b/lib/kernel/src/logger_olp.hrl new file mode 100644 index 0000000000..9b4f5ebf27 --- /dev/null +++ b/lib/kernel/src/logger_olp.hrl @@ -0,0 +1,180 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2015. 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% +%% + +%%%----------------------------------------------------------------- +%%% Overload protection configuration + +%%! *** NOTE *** +%%! It's important that: +%%! SYNC_MODE_QLEN =< DROP_MODE_QLEN =< FLUSH_QLEN +%%! and that DROP_MODE_QLEN >= 2. +%%! Otherwise the process could end up in drop mode with no new +%%! log requests to process. This would cause all future requests +%%! to be dropped (no switch to async mode would ever take place). + +%% This specifies the message_queue_len value where the log +%% requests switch from asynchronous casts to synchronous calls. +-define(SYNC_MODE_QLEN, 10). +%% Above this message_queue_len, log requests will be dropped, +%% i.e. no log requests get sent to the process. +-define(DROP_MODE_QLEN, 200). +%% Above this message_queue_len, the process will flush its mailbox +%% and only leave this number of messages in it. +-define(FLUSH_QLEN, 1000). + +%% Never flush more than this number of messages in one go, or the +%% process will be unresponsive for seconds (keep this number as large +%% as possible or the mailbox could grow large). +-define(FLUSH_MAX_N, 5000). + +%% BURST_LIMIT_MAX_COUNT is the max number of log requests allowed +%% to be written within a BURST_LIMIT_WINDOW_TIME time frame. +-define(BURST_LIMIT_ENABLE, true). +-define(BURST_LIMIT_MAX_COUNT, 500). +-define(BURST_LIMIT_WINDOW_TIME, 1000). + +%% This enables/disables the feature to automatically terminate the +%% process if it gets too loaded (and can't keep up). +-define(OVERLOAD_KILL_ENABLE, false). +%% If the message_queue_len goes above this size even after +%% flushing has been performed, the process is terminated. +-define(OVERLOAD_KILL_QLEN, 20000). +%% If the memory usage exceeds this level, the process is terminated. +-define(OVERLOAD_KILL_MEM_SIZE, 3000000). + +%% This is the default time to wait before restarting and accepting +%% new requests. The value 'infinity' disables restarts. +-define(OVERLOAD_KILL_RESTART_AFTER, 5000). + +%% This is the time in milliseconds after last load message received +%% that we notify the callback about being idle. +-define(IDLE_DETECT_TIME, 100). + +%%%----------------------------------------------------------------- +%%% Overload protection macros + +-define(timestamp(), erlang:monotonic_time(microsecond)). + +-define(get_mode(Tid), + case ets:lookup(Tid, mode) of + [{mode,M}] -> M; + _ -> async + end). + +-define(set_mode(Tid, M), + begin ets:insert(Tid, {mode,M}), M end). + +-define(change_mode(Tid, M0, M1), + if M0 == M1 -> + M0; + true -> + ets:insert(Tid, {mode,M1}), + M1 + end). + +-define(max(X1, X2), + if + X2 == undefined -> X1; + X2 > X1 -> X2; + true -> X1 + end). + +-define(diff_time(OS_T1, OS_T0), OS_T1-OS_T0). + +%%%----------------------------------------------------------------- +%%% These macros enable statistics counters in the state of the +%%% process, which is useful for analysing the overload protection +%%% behaviour. These counters should not be included in code to be +%%% officially released (as some counters will grow very large over +%%% time). + +%% -define(SAVE_STATS, true). +-ifdef(SAVE_STATS). + -define(merge_with_stats(STATE), + begin + TIME = ?timestamp(), + STATE#{start => TIME, time => {TIME,0}, + flushes => 0, flushed => 0, drops => 0, + burst_drops => 0, casts => 0, calls => 0, + writes => 0, max_qlen => 0, max_time => 0, + freq => {TIME,0,0}} end). + + -define(update_max_qlen(QLEN, STATE), + begin #{max_qlen := QLEN0} = STATE, + STATE#{max_qlen => ?max(QLEN0,QLEN)} end). + + -define(update_calls_or_casts(CALL_OR_CAST, INC, STATE), + case CALL_OR_CAST of + cast -> + #{casts := CASTS0} = STATE, + STATE#{casts => CASTS0+INC}; + call -> + #{calls := CALLS0} = STATE, + STATE#{calls => CALLS0+INC} + end). + + -define(update_max_time(TIME, STATE), + begin #{max_time := TIME0} = STATE, + STATE#{max_time => ?max(TIME0,TIME)} end). + + -define(update_other(OTHER, VAR, INCVAL, STATE), + begin #{OTHER := VAR} = STATE, + STATE#{OTHER => VAR+INCVAL} end). + + -define(update_freq(TIME,STATE), + begin + case STATE of + #{freq := {START, 49, _}} -> + STATE#{freq => {TIME, 0, trunc(1000000*50/(?diff_time(TIME,START)))}}; + #{freq := {START, N, FREQ}} -> + STATE#{freq => {START, N+1, FREQ}} + end end). + + -define(update_time(TIME,STATE), + begin #{start := START} = STATE, + STATE#{time => {TIME,trunc((?diff_time(TIME,START))/1000000)}} end). + +-else. % DEFAULT! + -define(merge_with_stats(STATE), STATE). + -define(update_max_qlen(_QLEN, STATE), STATE). + -define(update_calls_or_casts(_CALL_OR_CAST, _INC, STATE), STATE). + -define(update_max_time(_TIME, STATE), STATE). + -define(update_other(_OTHER, _VAR, _INCVAL, STATE), STATE). + -define(update_freq(_TIME, STATE), STATE). + -define(update_time(_TIME, STATE), STATE). +-endif. + +%%%----------------------------------------------------------------- +%%% These macros enable callbacks that make it possible to analyse the +%%% overload protection behaviour from outside the process (including +%%% dropped requests on the client side). An external callback module +%%% (?OBSERVER_MOD) is required which is not part of the kernel +%%% application. For this reason, these callbacks should not be +%%% included in code to be officially released. + +%%-define(OBSERVER_MOD, logger_test). +-ifdef(OBSERVER_MOD). + -define(start_observation(NAME), ?OBSERVER:start_observation(NAME)). + -define(observe(NAME,EVENT), ?OBSERVER:observe(NAME,EVENT)). + +-else. % DEFAULT! + -define(start_observation(_NAME), ok). + -define(observe(_NAME,_EVENT), ok). +-endif. diff --git a/lib/kernel/src/logger_proxy.erl b/lib/kernel/src/logger_proxy.erl new file mode 100644 index 0000000000..24b293805c --- /dev/null +++ b/lib/kernel/src/logger_proxy.erl @@ -0,0 +1,165 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017-2018. 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(logger_proxy). + +%% API +-export([start_link/0, restart/0, log/1, child_spec/0, get_default_config/0]). + +%% logger_olp callbacks +-export([init/1, handle_load/2, handle_info/2, terminate/2, + notify/2]). + +-include("logger_internal.hrl"). + +-define(SERVER,?MODULE). + +%%%----------------------------------------------------------------- +%%% API +-spec log(RemoteLog) -> ok when + RemoteLog :: {remote,node(),LogEvent}, + LogEvent :: {log,Level,Format,Args,Meta} | + {log,Level,StringOrReport,Meta}, + Level :: logger:level(), + Format :: io:format(), + Args :: list(term()), + StringOrReport :: unicode:chardata() | logger:report(), + Meta :: logger:metadata(). +log(RemoteLog) -> + Olp = persistent_term:get(?MODULE), + case logger_olp:get_pid(Olp) =:= self() of + true -> + %% This happens when the log event comes from the + %% emulator, and the group leader is on a remote node. + _ = handle_load(RemoteLog, no_state), + ok; + false -> + logger_olp:load(Olp, RemoteLog) + end. + +%% Called by supervisor +-spec start_link() -> {ok,pid(),logger_olp:olp_ref()} | {error,term()}. +start_link() -> + %% Notice that sync_mode is only used when logging to remote node, + %% i.e. when the log/2 API function is called. + %% + %% When receiving log events from the emulator or from a remote + %% node, the log event is sent as a message to this process, and + %% thus received directly in handle_info/2. This means that the + %% mode (async/sync/drop) is not read before the message is + %% sent. Thus sync mode is never entered, and drop mode is + %% implemented by setting the system_logger flag to undefined (see + %% notify/2) + %% + %% Burst limit is disabled, since this is only a proxy and we + %% don't want to limit bursts twice (here and in the handler). + logger_olp:start_link(?SERVER,?MODULE,[],logger:get_proxy_config()). + +%% Fun used for restarting this process after it has been killed due +%% to overload (must set overload_kill_enable=>true in opts) +restart() -> + case supervisor:start_child(logger_sup, child_spec()) of + {ok,_Pid,Olp} -> + {ok,Olp}; + {error,{Reason,Ch}} when is_tuple(Ch), element(1,Ch)==child -> + {error,Reason}; + Error -> + Error + end. + +%% Called internally and by logger_sup +child_spec() -> + Name = ?SERVER, + #{id => Name, + start => {?MODULE, start_link, []}, + restart => temporary, + shutdown => 2000, + type => worker, + modules => [?MODULE]}. + +get_default_config() -> + OlpDefault = logger_olp:get_default_opts(), + OlpDefault#{sync_mode_qlen=>500, + drop_mode_qlen=>1000, + flush_qlen=>5000, + burst_limit_enable=>false}. + +%%%=================================================================== +%%% gen_server callbacks +%%%=================================================================== + +init([]) -> + process_flag(trap_exit, true), + _ = erlang:system_flag(system_logger,self()), + persistent_term:put(?MODULE,logger_olp:get_ref()), + {ok,no_state}. + +%% Log event to send to the node where the group leader of it's client resides +handle_load({remote,Node,Log},State) -> + %% If the connection is overloaded (send_nosuspend returns false), + %% we drop the message. + _ = erlang:send_nosuspend({?SERVER,Node},Log), + State; +%% Log event to log on this node +handle_load({log,Level,Format,Args,Meta},State) -> + try_log([Level,Format,Args,Meta]), + State; +handle_load({log,Level,Report,Meta},State) -> + try_log([Level,Report,Meta]), + State. + +%% Log event sent to this process e.g. from the emulator - it is really load +handle_info(Log,State) when is_tuple(Log), element(1,Log)==log -> + {load,State}. + +terminate(overloaded, _State) -> + _ = erlang:system_flag(system_logger,undefined), + {ok,fun ?MODULE:restart/0}; +terminate(_Reason, _State) -> + _ = erlang:system_flag(system_logger,whereis(logger)), + ok. + +notify({mode_change,Mode0,Mode1},State) -> + _ = if Mode1=:=drop -> % entering drop mode + erlang:system_flag(system_logger,undefined); + Mode0=:=drop -> % leaving drop mode + erlang:system_flag(system_logger,self()); + true -> + ok + end, + ?LOG_INTERNAL(notice,"~w switched from ~w to ~w mode",[?MODULE,Mode0,Mode1]), + State; +notify({flushed,Flushed},State) -> + ?LOG_INTERNAL(notice, "~w flushed ~w log events",[?MODULE,Flushed]), + State; +notify(restart,State) -> + ?LOG_INTERNAL(notice, "~w restarted", [?MODULE]), + State; +notify(_Note,State) -> + State. + +%%%----------------------------------------------------------------- +%%% Internal functions +try_log(Args) -> + try apply(logger,log,Args) + catch C:R:S -> + ?LOG_INTERNAL(debug,[{?MODULE,log_failed}, + {log,Args}, + {reason,{C,R,S}}]) + end. diff --git a/lib/kernel/src/logger_server.erl b/lib/kernel/src/logger_server.erl index b7735dbcf7..722246e82c 100644 --- a/lib/kernel/src/logger_server.erl +++ b/lib/kernel/src/logger_server.erl @@ -22,8 +22,7 @@ -behaviour(gen_server). %% API --export([start_link/0, - add_handler/3, remove_handler/1, +-export([start_link/0, add_handler/3, remove_handler/1, add_filter/2, remove_filter/2, set_module_level/2, unset_module_level/0, unset_module_level/1, cache_module_level/1, @@ -43,7 +42,7 @@ -define(SERVER, logger). -define(LOGGER_SERVER_TAG, '$logger_cb_process'). --record(state, {tid, async_req, async_req_queue}). +-record(state, {tid, async_req, async_req_queue, remote_logger}). %%%=================================================================== %%% API @@ -155,6 +154,8 @@ init([]) -> process_flag(trap_exit, true), put(?LOGGER_SERVER_TAG,true), Tid = logger_config:new(?LOGGER_TABLE), + %% Store initial proxy config. logger_proxy reads config from here at startup. + logger_config:create(Tid,proxy,logger_proxy:get_default_config()), PrimaryConfig = maps:merge(default_config(primary), #{handlers=>[simple]}), logger_config:create(Tid,primary,PrimaryConfig), @@ -221,6 +222,24 @@ handle_call({add_filter,Id,Filter}, _From,#state{tid=Tid}=State) -> handle_call({remove_filter,Id,FilterId}, _From, #state{tid=Tid}=State) -> Reply = do_remove_filter(Tid,Id,FilterId), {reply,Reply,State}; +handle_call({change_config,SetOrUpd,proxy,Config0},_From,#state{tid=Tid}=State) -> + Default = + case SetOrUpd of + set -> + logger_proxy:get_default_config(); + update -> + {ok,OldConfig} = logger_config:get(Tid,proxy), + OldConfig + end, + Config = maps:merge(Default,Config0), + Reply = + case logger_olp:set_opts(logger_proxy,Config) of + ok -> + logger_config:set(Tid,proxy,Config); + Error -> + Error + end, + {reply,Reply,State}; handle_call({change_config,SetOrUpd,primary,Config0}, _From, #state{tid=Tid}=State) -> {ok,#{handlers:=Handlers}=OldConfig} = logger_config:get(Tid,primary), @@ -357,7 +376,7 @@ terminate(_Reason, _State) -> %%%=================================================================== %%% Internal functions %%%=================================================================== -call(Request) -> +call(Request) when is_tuple(Request) -> Action = element(1,Request), case get(?LOGGER_SERVER_TAG) of true when @@ -369,6 +388,7 @@ call(Request) -> gen_server:call(?SERVER,Request,?DEFAULT_LOGGER_CALL_TIMEOUT) end. + do_add_filter(Tid,Id,{FId,_} = Filter) -> case logger_config:get(Tid,Id) of {ok,Config} -> @@ -413,11 +433,13 @@ default_config(Id,Module) -> sanity_check(Owner,Key,Value) -> sanity_check_1(Owner,[{Key,Value}]). -sanity_check(HandlerId,Config) when is_map(Config) -> - sanity_check_1(HandlerId,maps:to_list(Config)); +sanity_check(Owner,Config) when is_map(Config) -> + sanity_check_1(Owner,maps:to_list(Config)); sanity_check(_,Config) -> {error,{invalid_config,Config}}. +sanity_check_1(proxy,_Config) -> + ok; % Details are checked by logger_olp:set_opts/2 sanity_check_1(Owner,Config) when is_list(Config) -> try Type = get_type(Owner), diff --git a/lib/kernel/src/logger_std_h.erl b/lib/kernel/src/logger_std_h.erl index 63d1dbaba2..0669164bb6 100644 --- a/lib/kernel/src/logger_std_h.erl +++ b/lib/kernel/src/logger_std_h.erl @@ -26,7 +26,7 @@ -include_lib("kernel/include/file.hrl"). %% API --export([info/1, filesync/1, reset/1]). +-export([filesync/1]). %% logger_h_common callbacks -export([init/2, check_config/4, reset_state/2, @@ -36,6 +36,8 @@ -export([log/2, adding_handler/1, removing_handler/1, changing_config/3, filter_config/1]). +-define(DEFAULT_CALL_TIMEOUT, 5000). + %%%=================================================================== %%% API %%%=================================================================== @@ -49,25 +51,6 @@ filesync(Name) -> logger_h_common:filesync(?MODULE,Name). -%%%----------------------------------------------------------------- -%%% --spec info(Name) -> Info | {error,Reason} when - Name :: atom(), - Info :: term(), - Reason :: handler_busy | {badarg,term()}. - -info(Name) -> - logger_h_common:info(?MODULE,Name). - -%%%----------------------------------------------------------------- -%%% --spec reset(Name) -> ok | {error,Reason} when - Name :: atom(), - Reason :: handler_busy | {badarg,term()}. - -reset(Name) -> - logger_h_common:reset(?MODULE,Name). - %%%=================================================================== %%% logger callbacks - just forward to logger_h_common %%%=================================================================== diff --git a/lib/kernel/src/logger_sup.erl b/lib/kernel/src/logger_sup.erl index 3d6f482e20..9ea8558a16 100644 --- a/lib/kernel/src/logger_sup.erl +++ b/lib/kernel/src/logger_sup.erl @@ -50,7 +50,9 @@ init([]) -> start => {logger_handler_watcher, start_link, []}, shutdown => brutal_kill}, - {ok, {SupFlags, [Watcher]}}. + Proxy = logger_proxy:child_spec(), + + {ok, {SupFlags, [Watcher,Proxy]}}. %%%=================================================================== %%% Internal functions diff --git a/lib/kernel/src/standard_error.erl b/lib/kernel/src/standard_error.erl index 5d649e5f94..ef5b532960 100644 --- a/lib/kernel/src/standard_error.erl +++ b/lib/kernel/src/standard_error.erl @@ -27,7 +27,8 @@ -define(PROCNAME_SUP, standard_error_sup). %% Defines for control ops --define(CTRL_OP_GET_WINSIZE,100). +-define(ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER, 16#018b0900). +-define(CTRL_OP_GET_WINSIZE, (100 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)). %% %% The basic server and start-up. diff --git a/lib/kernel/src/user.erl b/lib/kernel/src/user.erl index 872e63ab53..0c9e1ea303 100644 --- a/lib/kernel/src/user.erl +++ b/lib/kernel/src/user.erl @@ -28,7 +28,8 @@ -define(NAME, user). %% Defines for control ops --define(CTRL_OP_GET_WINSIZE,100). +-define(ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER, 16#018b0900). +-define(CTRL_OP_GET_WINSIZE, (100 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)). %% %% The basic server and start-up. diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index 9f914aa222..08286dd476 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -32,9 +32,10 @@ -define(OP_BEEP,4). -define(OP_PUTC_SYNC,5). % Control op --define(CTRL_OP_GET_WINSIZE,100). --define(CTRL_OP_GET_UNICODE_STATE,101). --define(CTRL_OP_SET_UNICODE_STATE,102). +-define(ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER, 16#018b0900). +-define(CTRL_OP_GET_WINSIZE, (100 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)). +-define(CTRL_OP_GET_UNICODE_STATE, (101 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)). +-define(CTRL_OP_SET_UNICODE_STATE, (102 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)). %% start() %% start(ArgumentList) diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile index 4a86265a4a..8a6ffe7e72 100644 --- a/lib/kernel/test/Makefile +++ b/lib/kernel/test/Makefile @@ -76,8 +76,11 @@ MODULES= \ logger_filters_SUITE \ logger_formatter_SUITE \ logger_legacy_SUITE \ + logger_olp_SUITE \ + logger_proxy_SUITE \ logger_simple_h_SUITE \ logger_std_h_SUITE \ + logger_stress_SUITE \ logger_test_lib \ os_SUITE \ pg2_SUITE \ diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 244bd7e2a0..52edfaee29 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -53,7 +53,7 @@ active_once_closed/1, send_timeout/1, send_timeout_active/1, otp_7731/1, zombie_sockets/1, otp_7816/1, otp_8102/1, wrapping_oct/0, wrapping_oct/1, otp_9389/1, otp_13939/1, - otp_12242/1]). + otp_12242/1, delay_send_error/1]). %% Internal exports. -export([sender/3, not_owner/1, passive_sockets_server/2, priority_server/1, @@ -97,7 +97,7 @@ all() -> active_once_closed, send_timeout, send_timeout_active, otp_7731, wrapping_oct, zombie_sockets, otp_7816, otp_8102, otp_9389, - otp_12242]. + otp_12242, delay_send_error]. groups() -> []. @@ -3427,3 +3427,32 @@ otp_12242(Addr) when tuple_size(Addr) =:= 4 -> wait(Mref) -> receive {'DOWN',Mref,_,_,Reason} -> Reason end. + +%% OTP-15536 +%% Test that send error works correctly for delay_send +delay_send_error(Config) -> + {ok, LS} = gen_tcp:listen(0, [{reuseaddr, true}, {packet, 1}, {active, false}]), + {ok,{{0,0,0,0},PortNum}}=inet:sockname(LS), + P = spawn_link( + fun() -> + {ok, S} = gen_tcp:accept(LS), + receive die -> gen_tcp:close(S) end + end), + erlang:monitor(process, P), + {ok, S} = gen_tcp:connect("localhost", PortNum, + [{packet, 1}, {active, false}, {delay_send, true}]), + + %% Do a couple of sends first to see that it works + ok = gen_tcp:send(S, "hello"), + ok = gen_tcp:send(S, "hello"), + ok = gen_tcp:send(S, "hello"), + + %% Make the receiver close + P ! die, + receive _Down -> ok end, + + ok = gen_tcp:send(S, "hello"), + timer:sleep(500), %% Sleep in order for delay_send to have time to trigger + + %% This used to result in a double free + {error, closed} = gen_tcp:send(S, "hello"). diff --git a/lib/kernel/test/init_SUITE.erl b/lib/kernel/test/init_SUITE.erl index 7828cc4716..a0154b2694 100644 --- a/lib/kernel/test/init_SUITE.erl +++ b/lib/kernel/test/init_SUITE.erl @@ -295,7 +295,7 @@ is_real_system(KernelVsn, StdlibVsn) -> %% before restart. %% ------------------------------------------------ many_restarts() -> - [{timetrap,{minutes,8}}]. + [{timetrap,{minutes,16}}]. many_restarts(Config) when is_list(Config) -> {ok, Node} = loose_node:start(init_test, "", ?DEFAULT_TIMEOUT_SEC), @@ -315,7 +315,7 @@ loop_restart(N,Node,EHPid) -> loose_node:stop(Node), ct:fail(not_stopping) end, - ok = wait_for(30, Node, EHPid), + ok = wait_for(60, Node, EHPid), loop_restart(N-1,Node,rpc:call(Node,erlang,whereis,[logger])). wait_for(0,Node,_) -> @@ -367,7 +367,8 @@ restart(Config) when is_list(Config) -> SysProcs0 = rpc:call(Node, ?MODULE, find_system_processes, []), io:format("SysProcs0=~p~n", [SysProcs0]), [InitPid, PurgerPid, LitCollectorPid, - DirtySigNPid, DirtySigHPid, DirtySigMPid] = SysProcs0, + DirtySigNPid, DirtySigHPid, DirtySigMPid, + PrimFilePid] = SysProcs0, InitPid = rpc:call(Node, erlang, whereis, [init]), PurgerPid = rpc:call(Node, erlang, whereis, [erts_code_purger]), Procs = rpc:call(Node, erlang, processes, []), @@ -385,7 +386,8 @@ restart(Config) when is_list(Config) -> SysProcs1 = rpc:call(Node, ?MODULE, find_system_processes, []), io:format("SysProcs1=~p~n", [SysProcs1]), [InitPid1, PurgerPid1, LitCollectorPid1, - DirtySigNPid1, DirtySigHPid1, DirtySigMPid1] = SysProcs1, + DirtySigNPid1, DirtySigHPid1, DirtySigMPid1, + PrimFilePid1] = SysProcs1, %% Still the same init process! InitPid1 = rpc:call(Node, erlang, whereis, [init]), @@ -411,6 +413,10 @@ restart(Config) when is_list(Config) -> DirtySigMP = pid_to_list(DirtySigMPid), DirtySigMP = pid_to_list(DirtySigMPid1), + %% and same prim_file helper process! + PrimFileP = pid_to_list(PrimFilePid), + PrimFileP = pid_to_list(PrimFilePid1), + NewProcs0 = rpc:call(Node, erlang, processes, []), NewProcs = NewProcs0 -- SysProcs1, case check_processes(NewProcs, MaxPid) of @@ -437,7 +443,8 @@ restart(Config) when is_list(Config) -> literal_collector, dirty_sig_handler_normal, dirty_sig_handler_high, - dirty_sig_handler_max}). + dirty_sig_handler_max, + prim_file}). find_system_processes() -> find_system_procs(processes(), #sys_procs{}). @@ -448,7 +455,8 @@ find_system_procs([], SysProcs) -> SysProcs#sys_procs.literal_collector, SysProcs#sys_procs.dirty_sig_handler_normal, SysProcs#sys_procs.dirty_sig_handler_high, - SysProcs#sys_procs.dirty_sig_handler_max]; + SysProcs#sys_procs.dirty_sig_handler_max, + SysProcs#sys_procs.prim_file]; find_system_procs([P|Ps], SysProcs) -> case process_info(P, [initial_call, priority]) of [{initial_call,{erl_init,start,2}},_] -> @@ -472,6 +480,9 @@ find_system_procs([P|Ps], SysProcs) -> {priority,max}] -> undefined = SysProcs#sys_procs.dirty_sig_handler_max, find_system_procs(Ps, SysProcs#sys_procs{dirty_sig_handler_max = P}); + [{initial_call,{prim_file,start,0}},_] -> + undefined = SysProcs#sys_procs.prim_file, + find_system_procs(Ps, SysProcs#sys_procs{prim_file = P}); _ -> find_system_procs(Ps, SysProcs) end. diff --git a/lib/kernel/test/kernel_bench.spec b/lib/kernel/test/kernel_bench.spec index 4de133f21b..898ceb59e0 100644 --- a/lib/kernel/test/kernel_bench.spec +++ b/lib/kernel/test/kernel_bench.spec @@ -1,2 +1,3 @@ {groups,"../kernel_test",zlib_SUITE,[bench]}. {groups,"../kernel_test",file_SUITE,[bench]}. +{suites,"../kernel_test",[logger_stress_SUITE]}. diff --git a/lib/kernel/test/logger.cover b/lib/kernel/test/logger.cover index 960bc0abff..9691aa295e 100644 --- a/lib/kernel/test/logger.cover +++ b/lib/kernel/test/logger.cover @@ -4,9 +4,12 @@ logger_backend, logger_config, logger_disk_log_h, - logger_h_common, logger_filters, logger_formatter, + logger_handler_watcher, + logger_h_common, + logger_olp, + logger_proxy, logger_server, logger_simple_h, logger_std_h, diff --git a/lib/kernel/test/logger.spec b/lib/kernel/test/logger.spec index 1ab90b3e93..3aec37951d 100644 --- a/lib/kernel/test/logger.spec +++ b/lib/kernel/test/logger.spec @@ -7,5 +7,7 @@ logger_filters_SUITE, logger_formatter_SUITE, logger_legacy_SUITE, + logger_olp_SUITE, + logger_proxy_SUITE, logger_simple_h_SUITE, logger_std_h_SUITE]}. diff --git a/lib/kernel/test/logger_disk_log_h_SUITE.erl b/lib/kernel/test/logger_disk_log_h_SUITE.erl index 87b8250781..9bbec42de8 100644 --- a/lib/kernel/test/logger_disk_log_h_SUITE.erl +++ b/lib/kernel/test/logger_disk_log_h_SUITE.erl @@ -24,6 +24,7 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/logger.hrl"). -include_lib("kernel/src/logger_internal.hrl"). +-include_lib("kernel/src/logger_olp.hrl"). -include_lib("kernel/src/logger_h_common.hrl"). -include_lib("stdlib/include/ms_transform.hrl"). -include_lib("kernel/include/file.hrl"). @@ -97,7 +98,6 @@ all() -> formatter_fail, config_fail, bad_input, - info_and_reset, reconfig, sync, disk_log_full, @@ -306,9 +306,9 @@ logging(cleanup, _Config) -> filter_config(_Config) -> ok = logger:add_handler(?MODULE,logger_disk_log_h,#{}), {ok,#{config:=HConfig}=Config} = logger:get_handler_config(?MODULE), - HConfig = maps:without([handler_pid,mode_tab],HConfig), + HConfig = maps:without([olp],HConfig), - FakeFullHConfig = HConfig#{handler_pid=>self(),mode_tab=>erlang:make_ref()}, + FakeFullHConfig = HConfig#{olp=>{regname,self(),erlang:make_ref()}}, #{config:=HConfig} = logger_disk_log_h:filter_config(Config#{config=>FakeFullHConfig}), ok. @@ -351,9 +351,7 @@ errors(Config) -> %% Read-only fields may (accidentially) be included in the change, %% but it won't take effect {ok,C} = logger:get_handler_config(Name1), - ok = logger:set_handler_config(Name1,config, - #{handler_pid=>self(), - mode_tab=>erlang:make_ref()}), + ok = logger:set_handler_config(Name1,config,#{olp=>dummyvalue}), {ok,C} = logger:get_handler_config(Name1), @@ -419,19 +417,16 @@ config_fail(_Config) -> filter_default=>log, formatter=>{?MODULE,self()}}), - {error,{handler_not_added,{invalid_config,logger_disk_log_h, - {invalid_levels,#{drop_mode_qlen:=1}}}}} = + {error,{handler_not_added,{invalid_olp_levels,#{drop_mode_qlen:=1}}}} = logger:add_handler(?MODULE,logger_disk_log_h, #{config => #{drop_mode_qlen=>1}}), - {error,{handler_not_added,{invalid_config,logger_disk_log_h, - {invalid_levels,#{sync_mode_qlen:=43, - drop_mode_qlen:=42}}}}} = + {error,{handler_not_added,{invalid_olp_levels,#{sync_mode_qlen:=43, + drop_mode_qlen:=42}}}} = logger:add_handler(?MODULE,logger_disk_log_h, #{config => #{sync_mode_qlen=>43, drop_mode_qlen=>42}}), - {error,{handler_not_added,{invalid_config,logger_disk_log_h, - {invalid_levels,#{drop_mode_qlen:=43, - flush_qlen:=42}}}}} = + {error,{handler_not_added,{invalid_olp_levels,#{drop_mode_qlen:=43, + flush_qlen:=42}}}} = logger:add_handler(?MODULE,logger_disk_log_h, #{config => #{drop_mode_qlen=>43, flush_qlen=>42}}), @@ -445,7 +440,7 @@ config_fail(_Config) -> #{max_no_files=>2}), %% incorrect values of OP params {ok,#{config := HConfig}} = logger:get_handler_config(?MODULE), - {error,{invalid_config,logger_disk_log_h,{invalid_levels,_}}} = + {error,{invalid_olp_levels,_}} = logger:update_handler_config(?MODULE,config, HConfig#{sync_mode_qlen=>100, flush_qlen=>99}), @@ -459,18 +454,7 @@ config_fail(cleanup,_Config) -> bad_input(_Config) -> {error,{badarg,{filesync,["BadType"]}}} = - logger_disk_log_h:filesync("BadType"), - {error,{badarg,{info,["BadType"]}}} = logger_disk_log_h:info("BadType"), - {error,{badarg,{reset,["BadType"]}}} = logger_disk_log_h:reset("BadType"). - -info_and_reset(_Config) -> - ok = logger:add_handler(?MODULE,logger_disk_log_h, - #{filter_default=>log, - formatter=>{?MODULE,self()}}), - #{id := ?MODULE} = logger_disk_log_h:info(?MODULE), - ok = logger_disk_log_h:reset(?MODULE). -info_and_reset(cleanup,_Config) -> - logger:remove_handler(?MODULE). + logger_disk_log_h:filesync("BadType"). reconfig(Config) -> Dir = ?config(priv_dir,Config), @@ -479,7 +463,7 @@ reconfig(Config) -> #{filter_default=>log, filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]), formatter=>{?MODULE,self()}}), - #{id := ?MODULE, + #{%id := ?MODULE, sync_mode_qlen := ?SYNC_MODE_QLEN, drop_mode_qlen := ?DROP_MODE_QLEN, flush_qlen := ?FLUSH_QLEN, @@ -490,13 +474,14 @@ reconfig(Config) -> overload_kill_qlen := ?OVERLOAD_KILL_QLEN, overload_kill_mem_size := ?OVERLOAD_KILL_MEM_SIZE, overload_kill_restart_after := ?OVERLOAD_KILL_RESTART_AFTER, - filesync_repeat_interval := ?FILESYNC_REPEAT_INTERVAL, - handler_state := - #{log_opts := #{type := ?DISK_LOG_TYPE, - max_no_files := ?DISK_LOG_MAX_NO_FILES, - max_no_bytes := ?DISK_LOG_MAX_NO_BYTES, - file := DiskLogFile}}} = - logger_disk_log_h:info(?MODULE), + cb_state := + #{handler_state := + #{log_opts := #{type := ?DISK_LOG_TYPE, + max_no_files := ?DISK_LOG_MAX_NO_FILES, + max_no_bytes := ?DISK_LOG_MAX_NO_BYTES, + file := DiskLogFile}}, + filesync_repeat_interval := ?FILESYNC_REPEAT_INTERVAL}} = + logger_olp:info(h_proc_name()), {ok,#{config := #{sync_mode_qlen := ?SYNC_MODE_QLEN, drop_mode_qlen := ?DROP_MODE_QLEN, @@ -527,7 +512,7 @@ reconfig(Config) -> overload_kill_restart_after => infinity, filesync_repeat_interval => no_repeat}, ok = logger:set_handler_config(?MODULE, config, HConfig1), - #{id := ?MODULE, + #{%id := ?MODULE, sync_mode_qlen := 1, drop_mode_qlen := 2, flush_qlen := 3, @@ -538,8 +523,8 @@ reconfig(Config) -> overload_kill_qlen := 100000, overload_kill_mem_size := 10000000, overload_kill_restart_after := infinity, - filesync_repeat_interval := no_repeat} = - logger_disk_log_h:info(?MODULE), + cb_state := #{filesync_repeat_interval := no_repeat}} = + logger_olp:info(h_proc_name()), {ok,#{config:=HConfig1}} = logger:get_handler_config(?MODULE), ok = logger:update_handler_config(?MODULE, config, @@ -577,12 +562,13 @@ reconfig(Config) -> max_no_files => 1, max_no_bytes => 1024, file => File}}), - #{handler_state := - #{log_opts := #{type := halt, - max_no_files := 1, - max_no_bytes := 1024, - file := File}}} = - logger_disk_log_h:info(?MODULE), + #{cb_state := + #{handler_state := + #{log_opts := #{type := halt, + max_no_files := 1, + max_no_bytes := 1024, + file := File}}}} = + logger_olp:info(h_proc_name()), {ok,#{config := #{type := halt, max_no_files := 1, @@ -650,13 +636,8 @@ sync(Config) -> {ok,#{config := HConfig}} = logger:get_handler_config(?MODULE), HConfig1 = HConfig#{filesync_repeat_interval => no_repeat}, ok = logger:update_handler_config(?MODULE, config, HConfig1), - no_repeat = maps:get(filesync_repeat_interval, - logger_disk_log_h:info(?MODULE)), - %% The following timer is to make sure the time from last log - %% ("first") to next ("second") is long enough, so the a flush is - %% triggered by the idle timeout between "fourth" and "fifth". - timer:sleep(?IDLE_DETECT_TIME_MSEC*2), + maps:get(cb_state,logger_olp:info(h_proc_name()))), start_tracer([{logger_disk_log_h,disk_log_write,3}, {disk_log,sync,1}], @@ -666,10 +647,10 @@ sync(Config) -> {disk_log,sync}]), logger:notice("second", ?domain), - timer:sleep(?IDLE_DETECT_TIME_MSEC*2), + timer:sleep(?IDLE_DETECT_TIME*2), logger:notice("third", ?domain), %% wait for automatic disk_log_sync - check_tracer(?IDLE_DETECT_TIME_MSEC*2), + check_tracer(?IDLE_DETECT_TIME*2), try_read_file(Log, {ok,<<"first\nsecond\nthird\n">>}, 1000), @@ -678,14 +659,15 @@ sync(Config) -> WaitT = 4500, OneSync = {logger_h_common,handle_cast,repeated_filesync}, %% receive 1 repeated_filesync per sec - start_tracer([{logger_h_common,handle_cast,2}], + start_tracer([{{logger_h_common,handle_cast,2}, + [{[repeated_filesync,'_'],[],[{message,{caller}}]}]}], [OneSync || _ <- lists:seq(1, trunc(WaitT/SyncInt))]), HConfig2 = HConfig#{filesync_repeat_interval => SyncInt}, ok = logger:update_handler_config(?MODULE, config, HConfig2), SyncInt = maps:get(filesync_repeat_interval, - logger_disk_log_h:info(?MODULE)), + maps:get(cb_state,logger_olp:info(h_proc_name()))), timer:sleep(WaitT), HConfig3 = HConfig#{filesync_repeat_interval => no_repeat}, ok = logger:update_handler_config(?MODULE, config, HConfig3), @@ -803,7 +785,7 @@ disk_log_full(cleanup, _Config) -> dbg:stop_clear(), logger:remove_handler(?MODULE). -disk_log_events(Config) -> +disk_log_events(_Config) -> Node = node(), Log = ?MODULE, ok = logger:add_handler(?MODULE, @@ -860,10 +842,12 @@ write_failure(Config) -> rpc:call(Node, ets, insert, [?TEST_HOOKS_TAB,{tester,self()}]), rpc:call(Node, ?MODULE, set_internal_log, [?MODULE,internal_log]), rpc:call(Node, ?MODULE, set_result, [disk_log_write,ok]), - HState = rpc:call(Node, logger_disk_log_h, info, [?STANDARD_HANDLER]), - ct:pal("LogOpts = ~p", [LogOpts = maps:get(log_opts, - maps:get(handler_state,HState))]), - + HState = rpc:call(Node, logger_olp, info, [h_proc_name(?STANDARD_HANDLER)]), + LogOpts = maps:get(log_opts, + maps:get(handler_state, + maps:get(cb_state,HState))), + ct:pal("LogOpts = ~p", [LogOpts]), + %% ?check and ?check_no_log in this test only check for internal log events ok = log_on_remote_node(Node, "Logged1"), rpc:call(Node, logger_disk_log_h, filesync, [?STANDARD_HANDLER]), @@ -914,15 +898,16 @@ sync_failure(Config) -> rpc:call(Node, ets, insert, [?TEST_HOOKS_TAB,{tester,self()}]), rpc:call(Node, ?MODULE, set_internal_log, [?MODULE,internal_log]), rpc:call(Node, ?MODULE, set_result, [disk_log_sync,ok]), - HState = rpc:call(Node, logger_disk_log_h, info, [?STANDARD_HANDLER]), - LogOpts = maps:get(log_opts, maps:get(handler_state,HState)), + HState = rpc:call(Node, logger_olp, info, [h_proc_name(?STANDARD_HANDLER)]), + LogOpts = maps:get(log_opts, maps:get(handler_state, + maps:get(cb_state,HState))), SyncInt = 500, ok = rpc:call(Node, logger, update_handler_config, [?STANDARD_HANDLER, config, #{filesync_repeat_interval => SyncInt}]), - Info = rpc:call(Node, logger_disk_log_h, info, [?STANDARD_HANDLER]), - SyncInt = maps:get(filesync_repeat_interval, Info), + Info = rpc:call(Node, logger_olp, info, [h_proc_name(?STANDARD_HANDLER)]), + SyncInt = maps:get(filesync_repeat_interval, maps:get(cb_state, Info)), ok = log_on_remote_node(Node, "Logged1"), ?check_no_log, @@ -1198,7 +1183,7 @@ qlen_kill_new(Config) -> receive {'DOWN', MRef, _, _, Info} -> case Info of - {shutdown,{overloaded,?MODULE,QLen,Mem}} -> + {shutdown,{overloaded,QLen,Mem}} -> ct:pal("Terminated with qlen = ~w, mem = ~w", [QLen,Mem]); killed -> ct:pal("Slow shutdown, handler process was killed!", []) @@ -1208,7 +1193,7 @@ qlen_kill_new(Config) -> ok after 5000 -> - Info = logger_disk_log_h:info(?MODULE), + Info = logger_olp:info(h_proc_name()), ct:pal("Handler state = ~p", [Info]), ct:fail("Handler not dead! It should not have survived this!") end. @@ -1235,7 +1220,7 @@ mem_kill_new(Config) -> receive {'DOWN', MRef, _, _, Info} -> case Info of - {shutdown,{overloaded,?MODULE,QLen,Mem}} -> + {shutdown,{overloaded,QLen,Mem}} -> ct:pal("Terminated with qlen = ~w, mem = ~w", [QLen,Mem]); killed -> ct:pal("Slow shutdown, handler process was killed!", []) @@ -1245,7 +1230,7 @@ mem_kill_new(Config) -> ok after 5000 -> - Info = logger_disk_log_h:info(?MODULE), + Info = logger_olp:info(h_proc_name()), ct:pal("Handler state = ~p", [Info]), ct:fail("Handler not dead! It should not have survived this!") end. @@ -1271,7 +1256,7 @@ restart_after(Config) -> ok after 5000 -> - Info1 = logger_std_h:info(?MODULE), + Info1 = logger_olp:info(h_proc_name()), ct:pal("Handler state = ~p", [Info1]), ct:fail("Handler not dead! It should not have survived this!") end, @@ -1295,7 +1280,7 @@ restart_after(Config) -> ok after 5000 -> - Info2 = logger_std_h:info(?MODULE), + Info2 = logger_olp:info(h_proc_name()), ct:pal("Handler state = ~p", [Info2]), ct:fail("Handler not dead! It should not have survived this!") end, @@ -1316,11 +1301,15 @@ handler_requests_under_load(Config) -> flush_qlen => 2000, burst_limit_enable => false}}, ok = logger:update_handler_config(?MODULE, NewHConfig), - Pid = spawn_link(fun() -> send_requests(?MODULE, 1, [{filesync,[]}, - {info,[]}, - {reset,[]}, - {change_config,[]}]) - end), + Pid = spawn_link( + fun() -> send_requests(1,[{logger_disk_log_h,filesync,[?MODULE],[]}, + {logger_olp,info,[h_proc_name()],[]}, + {logger_olp,reset,[h_proc_name()],[]}, + {logger,update_handler_config, + [?MODULE, config, + #{overload_kill_enable => false}], + []}]) + end), Procs = 100, Sent = Procs * send_burst({n,5000}, {spawn,Procs,10}, {chars,79}, notice), Pid ! {self(),finish}, @@ -1332,29 +1321,22 @@ handler_requests_under_load(Config) -> [E || E <- Res, is_tuple(E) andalso (element(1,E) == error)] end, - Errors = [{Req,FindError(Res)} || {Req,Res} <- ReqResult], - NoOfReqs = lists:foldl(fun({_,Res}, N) -> N + length(Res) end, 0, ReqResult), + Errors = [{Func,FindError(Res)} || {_,Func,_,Res} <- ReqResult], + NoOfReqs = lists:foldl(fun({_,_,_,Res}, N) -> N + length(Res) end, + 0, ReqResult), ct:pal("~w requests made. Errors: ~n~p", [NoOfReqs,Errors]), ok = file_delete(Log). handler_requests_under_load(cleanup, _Config) -> ok = stop_handler(?MODULE). -send_requests(HName, TO, Reqs = [{Req,Res}|Rs]) -> +send_requests(TO, Reqs = [{Mod,Func,Args,Res}|Rs]) -> receive {From,finish} -> From ! {self(),Reqs} after TO -> - Result = - case Req of - change_config -> - logger:update_handler_config(HName, logger_disk_log_h, - #{overload_kill_enable => - false}); - Func -> - logger_disk_log_h:Func(HName) - end, - send_requests(HName, TO, Rs ++ [{Req,[Result|Res]}]) + Result = apply(Mod,Func,Args), + send_requests(TO, Rs ++ [{Mod,Func,Args,[Result|Res]}]) end. %%%----------------------------------------------------------------- @@ -1472,15 +1454,6 @@ format(Msg,Tag) -> erlang:display(Error), exit(Error). -remove(Handler, LogName) -> - logger_disk_log_h:remove(Handler, LogName), - HState = #{log_names := Logs} = logger_disk_log_h:info(), - false = maps:is_key(LogName, HState), - false = lists:member(LogName, Logs), - false = logger_config:exist(?LOGGER_TABLE, LogName), - {error,no_such_log} = disk_log:info(LogName), - ok. - start_and_add(Name, Config, LogOpts) -> HConfig = maps:get(config, Config, #{}), HConfig1 = maps:merge(HConfig, LogOpts), @@ -1607,7 +1580,9 @@ start_tracer(Trace,Expected) -> ok. tpl([{M,F,A}|Trace]) -> - {ok,Match} = dbg:tpl(M,F,A,c), + tpl([{{M,F,A},c}|Trace]); +tpl([{{M,F,A},MS}|Trace]) -> + {ok,Match} = dbg:tpl(M,F,A,MS), case lists:keyfind(matched,1,Match) of {_,_,1} -> ok; diff --git a/lib/kernel/test/logger_env_var_SUITE.erl b/lib/kernel/test/logger_env_var_SUITE.erl index e8d1a313dc..9d2ad11be8 100644 --- a/lib/kernel/test/logger_env_var_SUITE.erl +++ b/lib/kernel/test/logger_env_var_SUITE.erl @@ -59,7 +59,8 @@ groups() -> logger_undefined, logger_many_handlers_default_first, logger_many_handlers_default_last, - logger_many_handlers_default_last_broken_filter + logger_many_handlers_default_last_broken_filter, + logger_proxy ]}, {bad,[],[bad_error_logger, bad_level, @@ -541,6 +542,19 @@ logger_many_handlers(Config, Env, LogErr, LogInfo, NumProgress) -> ok. +logger_proxy(Config) -> + %% assume current node runs with default settings + DefOpts = logger_olp:get_opts(logger_proxy), + {ok,_,Node} = setup(Config, + [{logger,[{proxy,#{sync_mode_qlen=>0, + drop_mode_qlen=>2}}]}]), + Expected = DefOpts#{sync_mode_qlen:=0, + drop_mode_qlen:=2}, + Expected = rpc:call(Node,logger_olp,get_opts,[logger_proxy]), + Expected = rpc:call(Node,logger,get_proxy_config,[]), + + ok. + sasl_compatible_false(Config) -> Log = file(Config,?FUNCTION_NAME), {ok,_,Node} = setup(Config, diff --git a/lib/kernel/test/logger_olp_SUITE.erl b/lib/kernel/test/logger_olp_SUITE.erl new file mode 100644 index 0000000000..ea3eec89f5 --- /dev/null +++ b/lib/kernel/test/logger_olp_SUITE.erl @@ -0,0 +1,90 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. 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(logger_olp_SUITE). + +-compile(export_all). + +-include_lib("kernel/src/logger_olp.hrl"). + +suite() -> + [{timetrap,{seconds,30}}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_Group, Config) -> + Config. + +end_per_group(_Group, _Config) -> + ok. + +init_per_testcase(_TestCase, Config) -> + Config. + +end_per_testcase(Case, Config) -> + try apply(?MODULE,Case,[cleanup,Config]) + catch error:undef -> ok + end, + ok. + +groups() -> + []. + +all() -> + [idle_timer]. + +%%%----------------------------------------------------------------- +%%% Test cases +idle_timer(_Config) -> + {ok,_Pid,Olp} = logger_olp:start_link(?MODULE,?MODULE,self(),#{}), + [logger_olp:load(Olp,{msg,N}) || N<-lists:seq(1,3)], + timer:sleep(?IDLE_DETECT_TIME*2), + [{load,{msg,1}}, + {load,{msg,2}}, + {load,{msg,3}}, + {notify,idle}] = test_server:messages_get(), + logger_olp:cast(Olp,hello), + timer:sleep(?IDLE_DETECT_TIME*2), + [{cast,hello}] = test_server:messages_get(), + ok. +idle_timer(cleanup,_Config) -> + unlink(whereis(?MODULE)), + logger_olp:stop(?MODULE), + ok. + +%%%----------------------------------------------------------------- +%%% Olp callbacks +init(P) -> + {ok,P}. + +handle_load(M,P) -> + P ! {load,M}, + P. + +handle_cast(M,P) -> + P ! {cast,M}, + {noreply,P}. + +notify(N,P) -> + P ! {notify,N}, + P. diff --git a/lib/kernel/test/logger_proxy_SUITE.erl b/lib/kernel/test/logger_proxy_SUITE.erl new file mode 100644 index 0000000000..777531e4ed --- /dev/null +++ b/lib/kernel/test/logger_proxy_SUITE.erl @@ -0,0 +1,274 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. 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(logger_proxy_SUITE). + +-compile(export_all). + +%% -include_lib("common_test/include/ct.hrl"). +%% -include_lib("kernel/include/logger.hrl"). +%% -include_lib("kernel/src/logger_internal.hrl"). + +%% -define(str,"Log from "++atom_to_list(?FUNCTION_NAME)++ +%% ":"++integer_to_list(?LINE)). +%% -define(map_rep,#{function=>?FUNCTION_NAME, line=>?LINE}). +%% -define(keyval_rep,[{function,?FUNCTION_NAME}, {line,?LINE}]). + +%% -define(MY_LOC(N),#{mfa=>{?MODULE,?FUNCTION_NAME,?FUNCTION_ARITY}, +%% file=>?FILE, line=>?LINE-N}). + +%% -define(TRY(X), my_try(fun() -> X end)). + + +-define(HNAME,list_to_atom(lists:concat([?MODULE,"_",?FUNCTION_NAME]))). +-define(LOC,#{mfa=>{?MODULE,?FUNCTION_NAME,?FUNCTION_ARITY},line=>?LINE}). +-define(ENSURE_TIME,5000). + +suite() -> + [{timetrap,{seconds,30}}, + {ct_hooks,[logger_test_lib]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_Group, Config) -> + Config. + +end_per_group(_Group, _Config) -> + ok. + +init_per_testcase(_TestCase, Config) -> + Config. + +end_per_testcase(Case, Config) -> + try apply(?MODULE,Case,[cleanup,Config]) + catch error:undef -> ok + end, + ok. + +groups() -> + []. + +all() -> + [basic, + emulator, + remote, + remote_emulator, + config, + restart_after, + terminate]. + +%%%----------------------------------------------------------------- +%%% Test cases +basic(_Config) -> + ok = logger:add_handler(?HNAME,?MODULE,#{config=>self()}), + logger_proxy ! {log,notice,"Log from: ~p; ~p",[?FUNCTION_NAME,?LINE],L1=?LOC}, + ok = ensure(L1), + logger_proxy ! {log,notice,[{test_case,?FUNCTION_NAME},{line,?LINE}],L2=?LOC}, + ok = ensure(L2), + logger_proxy:log({remote,node(),{log,notice, + "Log from: ~p; ~p", + [?FUNCTION_NAME,?LINE], + L3=?LOC}}), + ok = ensure(L3), + logger_proxy:log({remote,node(),{log,notice, + [{test_case,?FUNCTION_NAME}, + {line,?LINE}], + L4=?LOC}}), + ok = ensure(L4), + ok. +basic(cleanup,_Config) -> + ok = logger:remove_handler(?HNAME). + +emulator(_Config) -> + ok = logger:add_handler(?HNAME,?MODULE,#{config=>self()}), + Pid = spawn(fun() -> erlang:error(some_reason) end), + ok = ensure(#{pid=>Pid}), + ok. +emulator(cleanup,_Config) -> + ok = logger:remove_handler(?HNAME). + +remote(Config) -> + {ok,_,Node} = logger_test_lib:setup(Config,[{logger,[{proxy,#{}}]}]), + ok = logger:add_handler(?HNAME,?MODULE,#{config=>self()}), + L1 = ?LOC, spawn(Node,fun() -> logger:notice("Log from ~p; ~p",[?FUNCTION_NAME,?LINE],L1) end), + ok = ensure(L1), + L2 = ?LOC, spawn(Node,fun() -> logger:notice([{test_case,?FUNCTION_NAME},{line,?LINE}],L2) end), + ok = ensure(L2), + ok. +remote(cleanup,_Config) -> + ok = logger:remove_handler(?HNAME). + +remote_emulator(Config) -> + {ok,_,Node} = logger_test_lib:setup(Config,[{logger,[{proxy,#{}}]}]), + ok = logger:add_handler(?HNAME,?MODULE,#{config=>self()}), + Pid = spawn(Node,fun() -> erlang:error(some_reason) end), + ok = ensure(#{pid=>Pid}), + ok. +remote_emulator(cleanup,_Config) -> + ok = logger:remove_handler(?HNAME). + +config(_Config) -> + C1 = #{sync_mode_qlen:=SQ, + drop_mode_qlen:=DQ} = logger:get_proxy_config(), + C1 = logger_olp:get_opts(logger_proxy), + + %% Update the existing config with these two values + SQ1 = SQ+1, + DQ1 = DQ+1, + ok = logger:update_proxy_config(#{sync_mode_qlen=>SQ1, + drop_mode_qlen=>DQ1}), + C2 = logger:get_proxy_config(), % reads from ets table + C2 = logger_olp:get_opts(logger_proxy), % ensure consistency with process opts + C2 = C1#{sync_mode_qlen:=SQ1, + drop_mode_qlen:=DQ1}, + + %% Update the existing again with only one value + SQ2 = SQ+2, + ok = logger:update_proxy_config(#{sync_mode_qlen=>SQ2}), + C3 = logger:get_proxy_config(), + C3 = logger_olp:get_opts(logger_proxy), + C3 = C2#{sync_mode_qlen:=SQ2}, + + %% Set the config, i.e. merge with defaults + ok = logger:set_proxy_config(#{sync_mode_qlen=>SQ1}), + C4 = logger:get_proxy_config(), + C4 = logger_olp:get_opts(logger_proxy), + C4 = C1#{sync_mode_qlen:=SQ1}, + + %% Reset to default + ok = logger:set_proxy_config(#{}), + C5 = logger:get_proxy_config(), + C5 = logger_olp:get_opts(logger_proxy), + C5 = logger_proxy:get_default_config(), + + %% Errors + {error,{invalid_olp_config,_}} = + logger:set_proxy_config(#{faulty_key=>1}), + {error,{invalid_olp_config,_}} = + logger:set_proxy_config(#{sync_mode_qlen=>infinity}), + {error,{invalid_config,[]}} = logger:set_proxy_config([]), + + {error,{invalid_olp_config,_}} = + logger:update_proxy_config(#{faulty_key=>1}), + {error,{invalid_olp_config,_}} = + logger:update_proxy_config(#{sync_mode_qlen=>infinity}), + {error,{invalid_config,[]}} = logger:update_proxy_config([]), + + C5 = logger:get_proxy_config(), + C5 = logger_olp:get_opts(logger_proxy), + + ok. +config(cleanup,_Config) -> + _ = logger:set_logger_proxy(logger_proxy:get_default_config()), + ok. + +restart_after(_Config) -> + Restart = 3000, + ok = logger:update_proxy_config(#{overload_kill_enable => true, + overload_kill_qlen => 10, + overload_kill_restart_after => Restart}), + Proxy = whereis(logger_proxy), + Proxy = erlang:system_info(system_logger), + ProxyConfig = logger:get_proxy_config(), + ProxyConfig = logger_olp:get_opts(logger_proxy), + + Ref = erlang:monitor(process,Proxy), + spawn(fun() -> + [logger_proxy ! {log,debug, + [{test_case,?FUNCTION_NAME}, + {line,?LINE}], + ?LOC} || _ <- lists:seq(1,100)] + end), + receive + {'DOWN',Ref,_,_,_Reason} -> + undefined = erlang:system_info(system_logger), + timer:sleep(Restart), + poll_restarted(10) + after 5000 -> + ct:fail(proxy_not_terminated) + end, + + Proxy1 = whereis(logger_proxy), + Proxy1 = erlang:system_info(system_logger), + ProxyConfig = logger:get_proxy_config(), + ProxyConfig = logger_olp:get_opts(logger_proxy), + + ok. +restart_after(cleanup,_Config) -> + _ = logger:set_logger_proxy(logger_proxy:get_default_config()), + ok. + +%% Test that system_logger flag is set to logger process if +%% logger_proxy terminates for other reason than overloaded. +terminate(_Config) -> + Logger = whereis(logger), + Proxy = whereis(logger_proxy), + Proxy = erlang:system_info(system_logger), + ProxyConfig = logger:get_proxy_config(), + ProxyConfig = logger_olp:get_opts(logger_proxy), + + Ref = erlang:monitor(process,Proxy), + ok = logger_olp:stop(Proxy), + receive + {'DOWN',Ref,_,_,_Reason} -> + Logger = erlang:system_info(system_logger), + logger_proxy:restart(), + poll_restarted(10) + after 5000 -> + ct:fail(proxy_not_terminated) + end, + + Proxy1 = whereis(logger_proxy), + Proxy1 = erlang:system_info(system_logger), + ProxyConfig = logger:get_proxy_config(), + ProxyConfig = logger_olp:get_opts(logger_proxy), + + ok. + +%%%----------------------------------------------------------------- +%%% Internal functions + +poll_restarted(0) -> + ct:fail(proxy_not_restarted); +poll_restarted(N) -> + timer:sleep(1000), + case whereis(logger_proxy) of + undefined -> + poll_restarted(N-1); + _Pid -> + ok + end. + +%% Logger handler callback +log(#{meta:=Meta},#{config:=Pid}) -> + Pid ! {logged,Meta}. + +%% Check that the log from the logger callback function log/2 is received +ensure(Match) -> + receive {logged,Meta} -> + case maps:with(maps:keys(Match),Meta) of + Match -> ok; + _NoMatch -> {error,Match,Meta,test_server:messages_get()} + end + after ?ENSURE_TIME -> {error,Match,test_server:messages_get()} + end. diff --git a/lib/kernel/test/logger_std_h_SUITE.erl b/lib/kernel/test/logger_std_h_SUITE.erl index eb17a6d857..484d914ec3 100644 --- a/lib/kernel/test/logger_std_h_SUITE.erl +++ b/lib/kernel/test/logger_std_h_SUITE.erl @@ -25,10 +25,15 @@ -include_lib("kernel/include/logger.hrl"). -include_lib("kernel/src/logger_internal.hrl"). -include_lib("kernel/src/logger_h_common.hrl"). +-include_lib("kernel/src/logger_olp.hrl"). -include_lib("stdlib/include/ms_transform.hrl"). -include_lib("kernel/include/file.hrl"). --define(check_no_log, [] = test_server:messages_get()). +-define(check_no_log, + begin + timer:sleep(?IDLE_DETECT_TIME*2), + [] = test_server:messages_get() + end). -define(check(Expected), receive {log,Expected} -> @@ -115,7 +120,6 @@ all() -> crash_std_h_to_file, crash_std_h_to_disk_log, bad_input, - info_and_reset, reconfig, file_opts, sync, @@ -209,9 +213,9 @@ default_formatter(_Config) -> filter_config(_Config) -> ok = logger:add_handler(?MODULE,logger_std_h,#{}), {ok,#{config:=HConfig}=Config} = logger:get_handler_config(?MODULE), - HConfig = maps:without([handler_pid,mode_tab],HConfig), + HConfig = maps:without([olp],HConfig), - FakeFullHConfig = HConfig#{handler_pid=>self(),mode_tab=>erlang:make_ref()}, + FakeFullHConfig = HConfig#{olp=>{regname,self(),erlang:make_ref()}}, #{config:=HConfig} = logger_std_h:filter_config(Config#{config=>FakeFullHConfig}), ok. @@ -246,13 +250,13 @@ errors(Config) -> _ -> NoDir = lists:concat(["/",?MODULE,"_dir"]), {error, - {handler_not_added,{{open_failed,NoDir,eacces},_}}} = + {handler_not_added,{open_failed,NoDir,eacces}}} = logger:add_handler(myh2,logger_std_h, #{config=>#{type=>{file,NoDir}}}) end, {error, - {handler_not_added,{{open_failed,Log,_},_}}} = + {handler_not_added,{open_failed,Log,_}}} = logger:add_handler(myh3,logger_std_h, #{config=>#{type=>{file,Log,[bad_file_opt]}}}), @@ -320,19 +324,16 @@ config_fail(_Config) -> #{config => #{restart_type => bad}, filter_default=>log, formatter=>{?MODULE,self()}}), - {error,{handler_not_added,{invalid_config,logger_std_h, - {invalid_levels,#{drop_mode_qlen:=1}}}}} = + {error,{handler_not_added,{invalid_olp_levels,#{drop_mode_qlen:=1}}}} = logger:add_handler(?MODULE,logger_std_h, #{config => #{drop_mode_qlen=>1}}), - {error,{handler_not_added,{invalid_config,logger_std_h, - {invalid_levels,#{sync_mode_qlen:=43, - drop_mode_qlen:=42}}}}} = + {error,{handler_not_added,{invalid_olp_levels,#{sync_mode_qlen:=43, + drop_mode_qlen:=42}}}} = logger:add_handler(?MODULE,logger_std_h, #{config => #{sync_mode_qlen=>43, drop_mode_qlen=>42}}), - {error,{handler_not_added,{invalid_config,logger_std_h, - {invalid_levels,#{drop_mode_qlen:=43, - flush_qlen:=42}}}}} = + {error,{handler_not_added,{invalid_olp_levels,#{drop_mode_qlen:=43, + flush_qlen:=42}}}} = logger:add_handler(?MODULE,logger_std_h, #{config => #{drop_mode_qlen=>43, flush_qlen=>42}}), @@ -344,7 +345,7 @@ config_fail(_Config) -> logger:set_handler_config(?MODULE,config, #{type=>{file,"file"}}), - {error,{invalid_config,logger_std_h,{invalid_levels,_}}} = + {error,{invalid_olp_levels,_}} = logger:set_handler_config(?MODULE,config, #{sync_mode_qlen=>100, flush_qlen=>99}), @@ -355,9 +356,7 @@ config_fail(_Config) -> %% Read-only fields may (accidentially) be included in the change, %% but it won't take effect {ok,C} = logger:get_handler_config(?MODULE), - ok = logger:set_handler_config(?MODULE,config, - #{handler_pid=>self(), - mode_tab=>erlang:make_ref()}), + ok = logger:set_handler_config(?MODULE,config,#{olp=>dummyvalue}), {ok,C} = logger:get_handler_config(?MODULE), ok. @@ -425,10 +424,13 @@ crash_std_h(Config,Func,Var,Type,Log) -> %% logger would send the log event to the logger process here instead %% of logging it itself. log_on_remote_node(Node,Msg) -> + Pid = self(), _ = spawn_link(Node, fun() -> erlang:group_leader(whereis(user),self()), - logger:notice(Msg) + logger:notice(Msg), + Pid ! done end), + receive done -> ok end, ok. @@ -456,14 +458,7 @@ sync_and_read(Node,file,Log) -> end. bad_input(_Config) -> - {error,{badarg,{filesync,["BadType"]}}} = logger_std_h:filesync("BadType"), - {error,{badarg,{info,["BadType"]}}} = logger_std_h:info("BadType"), - {error,{badarg,{reset,["BadType"]}}} = logger_std_h:reset("BadType"). - - -info_and_reset(_Config) -> - #{id := ?STANDARD_HANDLER} = logger_std_h:info(?STANDARD_HANDLER), - ok = logger_std_h:reset(?STANDARD_HANDLER). + {error,{badarg,{filesync,["BadType"]}}} = logger_std_h:filesync("BadType"). reconfig(Config) -> Dir = ?config(priv_dir,Config), @@ -473,9 +468,10 @@ reconfig(Config) -> filter_default=>log, filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]), formatter=>{?MODULE,self()}}), - #{id := ?MODULE, - handler_state := #{type := standard_io, - file_ctrl_pid := FileCtrlPid}, + #{%id := ?MODULE, + cb_state:=#{handler_state := #{type := standard_io, + file_ctrl_pid := FileCtrlPid}, + filesync_repeat_interval := no_repeat}, sync_mode_qlen := ?SYNC_MODE_QLEN, drop_mode_qlen := ?DROP_MODE_QLEN, flush_qlen := ?FLUSH_QLEN, @@ -485,9 +481,8 @@ reconfig(Config) -> overload_kill_enable := ?OVERLOAD_KILL_ENABLE, overload_kill_qlen := ?OVERLOAD_KILL_QLEN, overload_kill_mem_size := ?OVERLOAD_KILL_MEM_SIZE, - overload_kill_restart_after := ?OVERLOAD_KILL_RESTART_AFTER, - filesync_repeat_interval := no_repeat} = DefaultInfo = - logger_std_h:info(?MODULE), + overload_kill_restart_after := ?OVERLOAD_KILL_RESTART_AFTER} = + logger_olp:info(h_proc_name()), {ok, #{config:= @@ -518,9 +513,10 @@ reconfig(Config) -> overload_kill_mem_size => 10000000, overload_kill_restart_after => infinity, filesync_repeat_interval => 5000}), - #{id := ?MODULE, - handler_state := #{type := standard_io, - file_ctrl_pid := FileCtrlPid}, + #{%id := ?MODULE, + cb_state := #{handler_state := #{type := standard_io, + file_ctrl_pid := FileCtrlPid}, + filesync_repeat_interval := no_repeat}, sync_mode_qlen := 1, drop_mode_qlen := 2, flush_qlen := 3, @@ -530,8 +526,7 @@ reconfig(Config) -> overload_kill_enable := true, overload_kill_qlen := 100000, overload_kill_mem_size := 10000000, - overload_kill_restart_after := infinity, - filesync_repeat_interval := no_repeat} = Info = logger_std_h:info(?MODULE), + overload_kill_restart_after := infinity} = logger_olp:info(h_proc_name()), {ok,#{config := #{type := standard_io, @@ -613,7 +608,7 @@ file_opts(Config) -> Log = filename:join(Dir, lists:concat([?FUNCTION_NAME,".log"])), BadFileOpts = [raw], BadType = {file,Log,BadFileOpts}, - {error,{handler_not_added,{{open_failed,Log,enoent},_}}} = + {error,{handler_not_added,{open_failed,Log,enoent}}} = logger:add_handler(?MODULE, logger_std_h, #{config => #{type => BadType}}), @@ -626,7 +621,9 @@ file_opts(Config) -> filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]), formatter=>{?MODULE,self()}}), - #{handler_state := #{type := OkType}} = logger_std_h:info(?MODULE), + #{cb_state := #{handler_state := #{type := OkType}}} = + logger_olp:info(h_proc_name()), + {ok,#{config := #{type := OkType}}} = logger:get_handler_config(?MODULE), logger:notice(M1=?msg,?domain), ?check(M1), B1 = ?bin(M1), @@ -675,11 +672,8 @@ sync(Config) -> %% a filesync is still performed when handler goes idle ok = logger:update_handler_config(?MODULE, config, #{filesync_repeat_interval => no_repeat}), - no_repeat = maps:get(filesync_repeat_interval, logger_std_h:info(?MODULE)), - %% The following timer is to make sure the time from last log - %% ("second") to next ("third") is long enough, so the a flush is - %% triggered by the idle timeout between "thrid" and "fourth". - timer:sleep(?IDLE_DETECT_TIME_MSEC*2), + no_repeat = maps:get(filesync_repeat_interval, + maps:get(cb_state, logger_olp:info(h_proc_name()))), start_tracer([{logger_std_h, write_to_dev, 5}, {file, datasync, 1}], [{logger_std_h, write_to_dev, <<"third\n">>}, @@ -688,22 +682,24 @@ sync(Config) -> {file,datasync}]), logger:notice("third", ?domain), %% wait for automatic filesync - timer:sleep(?IDLE_DETECT_TIME_MSEC*2), + timer:sleep(?IDLE_DETECT_TIME*2), logger:notice("fourth", ?domain), %% wait for automatic filesync - check_tracer(?IDLE_DETECT_TIME_MSEC*2), + check_tracer(?IDLE_DETECT_TIME*2), %% switch repeated filesync on and verify that the looping works SyncInt = 1000, WaitT = 4500, OneSync = {logger_h_common,handle_cast,repeated_filesync}, %% receive 1 repeated_filesync per sec - start_tracer([{logger_h_common,handle_cast,2}], + start_tracer([{{logger_h_common,handle_cast,2}, + [{[repeated_filesync,'_'],[],[]}]}], [OneSync || _ <- lists:seq(1, trunc(WaitT/SyncInt))]), ok = logger:update_handler_config(?MODULE, config, #{filesync_repeat_interval => SyncInt}), - SyncInt = maps:get(filesync_repeat_interval, logger_std_h:info(?MODULE)), + SyncInt = maps:get(filesync_repeat_interval, + maps:get(cb_state,logger_olp:info(h_proc_name()))), timer:sleep(WaitT), ok = logger:update_handler_config(?MODULE, config, #{filesync_repeat_interval => no_repeat}), @@ -764,8 +760,6 @@ sync_failure(Config) -> ok = rpc:call(Node, logger, update_handler_config, [?STANDARD_HANDLER, config, #{filesync_repeat_interval => SyncInt}]), - Info = rpc:call(Node, logger_std_h, info, [?STANDARD_HANDLER]), - SyncInt = maps:get(filesync_repeat_interval, Info), ok = log_on_remote_node(Node, "Logged1"), ?check_no_log, @@ -1095,7 +1089,7 @@ qlen_kill_new(Config) -> receive {'DOWN', MRef, _, _, Info} -> case Info of - {shutdown,{overloaded,?MODULE,QLen,Mem}} -> + {shutdown,{overloaded,QLen,Mem}} -> ct:pal("Terminated with qlen = ~w, mem = ~w", [QLen,Mem]); killed -> ct:pal("Slow shutdown, handler process was killed!", []) @@ -1105,7 +1099,7 @@ qlen_kill_new(Config) -> ok after 5000 -> - Info = logger_std_h:info(?MODULE), + Info = logger_olp:info(h_proc_name()), ct:pal("Handler state = ~p", [Info]), ct:fail("Handler not dead! It should not have survived this!") end. @@ -1146,7 +1140,7 @@ mem_kill_new(Config) -> receive {'DOWN', MRef, _, _, Info} -> case Info of - {shutdown,{overloaded,?MODULE,QLen,Mem}} -> + {shutdown,{overloaded,QLen,Mem}} -> ct:pal("Terminated with qlen = ~w, mem = ~w", [QLen,Mem]); killed -> ct:pal("Slow shutdown, handler process was killed!", []) @@ -1156,7 +1150,7 @@ mem_kill_new(Config) -> ok after 5000 -> - Info = logger_std_h:info(?MODULE), + Info = logger_olp:info(h_proc_name()), ct:pal("Handler state = ~p", [Info]), ct:fail("Handler not dead! It should not have survived this!") end. @@ -1187,7 +1181,7 @@ restart_after(Config) -> ok after 5000 -> - Info1 = logger_std_h:info(?MODULE), + Info1 = logger_olp:info(h_proc_name()), ct:pal("Handler state = ~p", [Info1]), ct:fail("Handler not dead! It should not have survived this!") end, @@ -1212,7 +1206,7 @@ restart_after(Config) -> ok after 5000 -> - Info2 = logger_std_h:info(?MODULE), + Info2 = logger_olp:info(h_proc_name()), ct:pal("Handler state = ~p", [Info2]), ct:fail("Handler not dead! It should not have survived this!") end, @@ -1234,11 +1228,15 @@ handler_requests_under_load(Config) -> flush_qlen => 2000, burst_limit_enable => false}}, ok = logger:update_handler_config(?MODULE, NewHConfig), - Pid = spawn_link(fun() -> send_requests(?MODULE, 1, [{filesync,[]}, - {info,[]}, - {reset,[]}, - {change_config,[]}]) - end), + Pid = spawn_link( + fun() -> send_requests(1,[{logger_std_h,filesync,[?MODULE],[]}, + {logger_olp,info,[h_proc_name()],[]}, + {logger_olp,reset,[h_proc_name()],[]}, + {logger,update_handler_config, + [?MODULE, config, + #{overload_kill_enable => false}], + []}]) + end), Sent = send_burst({t,10000}, seq, {chars,79}, notice), Pid ! {self(),finish}, ReqResult = receive {Pid,Result} -> Result end, @@ -1249,8 +1247,9 @@ handler_requests_under_load(Config) -> [E || E <- Res, is_tuple(E) andalso (element(1,E) == error)] end, - Errors = [{Req,FindError(Res)} || {Req,Res} <- ReqResult], - NoOfReqs = lists:foldl(fun({_,Res}, N) -> N + length(Res) end, 0, ReqResult), + Errors = [{Func,FindError(Res)} || {_,Func,_,Res} <- ReqResult], + NoOfReqs = lists:foldl(fun({_,_,_,Res}, N) -> N + length(Res) end, + 0, ReqResult), ct:pal("~w requests made. Errors: ~n~p", [NoOfReqs,Errors]), ok = file_delete(Log). handler_requests_under_load(cleanup, _Config) -> @@ -1272,22 +1271,14 @@ recreate_deleted_log(cleanup, _Config) -> %%%----------------------------------------------------------------- %%% -send_requests(HName, TO, Reqs = [{Req,Res}|Rs]) -> +send_requests(TO, Reqs = [{Mod,Func,Args,Res}|Rs]) -> receive {From,finish} -> From ! {self(),Reqs} after TO -> - Result = - case Req of - change_config -> - logger:update_handler_config(HName, config, - #{overload_kill_enable => - false}); - Func -> - logger_std_h:Func(HName) - end, - send_requests(HName, TO, Rs ++ [{Req,[Result|Res]}]) + Result = apply(Mod,Func,Args), + send_requests(TO, Rs ++ [{Mod,Func,Args,[Result|Res]}]) end. @@ -1624,7 +1615,8 @@ start_tracer(Trace,Expected) -> Pid = self(), FileCtrlPid = maps:get(file_ctrl_pid, maps:get(handler_state, - logger_std_h:info(?MODULE))), + maps:get(cb_state, + logger_olp:info(h_proc_name())))), dbg:tracer(process,{fun tracer/2,{Pid,Expected}}), dbg:p(whereis(h_proc_name()),[c]), dbg:p(FileCtrlPid,[c]), @@ -1632,7 +1624,9 @@ start_tracer(Trace,Expected) -> ok. tpl([{M,F,A}|Trace]) -> - {ok,Match} = dbg:tpl(M,F,A,[]), + tpl([{{M,F,A},[]}|Trace]); +tpl([{{M,F,A},MS}|Trace]) -> + {ok,Match} = dbg:tpl(M,F,A,MS), case lists:keyfind(matched,1,Match) of {_,_,1} -> ok; diff --git a/lib/kernel/test/logger_stress_SUITE.erl b/lib/kernel/test/logger_stress_SUITE.erl new file mode 100644 index 0000000000..4072e8c86a --- /dev/null +++ b/lib/kernel/test/logger_stress_SUITE.erl @@ -0,0 +1,456 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. 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(logger_stress_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct_event.hrl"). +-include_lib("kernel/include/logger.hrl"). +-include_lib("kernel/src/logger_h_common.hrl"). + +-ifdef(SAVE_STATS). + -define(COLLECT_STATS(_All_,_Procs_), + ct:pal("~p",[stats(_All_,_Procs_)])). +-else. + -define(COLLECT_STATS(_All_,_Procs__), ok). +-endif. + +-define(TEST_DURATION,120). % seconds + +suite() -> + [{timetrap,{minutes,3}}, + {ct_hooks,[logger_test_lib]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_Group, Config) -> + Config. + +end_per_group(_Group, _Config) -> + ok. + +init_per_testcase(_TestCase, Config) -> + Config. + +end_per_testcase(Case, Config) -> + try apply(?MODULE,Case,[cleanup,Config]) + catch error:undef -> ok + end, + ok. + +groups() -> + []. + +all() -> + [allow_events, + reject_events, + std_handler, + disk_log_handler, + emulator_events, + remote_events, + remote_to_disk_log, + remote_emulator_events, + remote_emulator_to_disk_log]. + +%%%----------------------------------------------------------------- +%%% Test cases +%%%----------------------------------------------------------------- +%% Time from log macro call to handler callback +allow_events(Config) -> + {ok,_,Node} = + logger_test_lib:setup(Config, + [{logger, + [{handler,default,?MODULE,#{}}]}, + {logger_level,notice}]), + N = 100000, + {T,_} = timer:tc(fun() -> rpc:call(Node,?MODULE,nlogs,[N]) end), + IOPS = N * 1000/T, % log events allowed per millisecond + ct_event:notify(#event{name = benchmark_data, + data = [{value,IOPS}]}), + {comment,io_lib:format("~.2f accepted events pr millisecond", + [IOPS])}. + +%% Time from log macro call to reject (log level) +reject_events(Config) -> + {ok,_,Node} = + logger_test_lib:setup(Config, + [{logger, + [{handler,default,?MODULE,#{}}]}, + {logger_level,error}]), + N = 1000000, + {T,_} = timer:tc(fun() -> rpc:call(Node,?MODULE,nlogs,[N]) end), + IOPS = N * 1000/T, % log events rejected per millisecond + ct_event:notify(#event{name = benchmark_data, + data = [{value,IOPS}]}), + {comment,io_lib:format("~.2f rejected events pr millisecond", + [IOPS])}. + +%% Cascading failure that produce gen_server and proc_lib reports - +%% how many of the produced log events are actually written to a log +%% with logger_std_h file handler. +std_handler(Config) -> + {ok,_,Node} = + logger_test_lib:setup(Config, + [{logger, + [{handler,default,logger_std_h, + #{config=>#{type=>{file,"default.log"}}}}]}]), + + cascade({Node,{logger_backend,log_allowed,2},[]}, + {Node,{logger_std_h,write,4},[{default,logger_std_h_default}]}, + fun otp_cascading/0). +std_handler(cleanup,_Config) -> + _ = file:delete("default.log"), + ok. + +%% Cascading failure that produce gen_server and proc_lib reports - +%% how many of the produced log events are actually written to a log +%% with logger_disk_log_h wrap file handler. +disk_log_handler(Config) -> + {ok,_,Node} = + logger_test_lib:setup(Config, + [{logger, + [{handler,default,logger_disk_log_h,#{}}]}]), + cascade({Node,{logger_backend,log_allowed,2},[]}, + {Node,{logger_disk_log_h,write,4}, + [{default,logger_disk_log_h_default}]}, + fun otp_cascading/0). +disk_log_handler(cleanup,_Config) -> + Files = filelib:wildcard("default.log.*"), + [_ = file:delete(F) || F <- Files], + ok. + +%% Cascading failure that produce log events from the emulator - how +%% many of the produced log events pass through the proxy. +emulator_events(Config) -> + {ok,_,Node} = + logger_test_lib:setup(Config, + [{logger, + [{handler,default,?MODULE,#{}}]}]), + cascade({Node,{?MODULE,producer,0},[]}, + {Node,{?MODULE,log,2},[{proxy,logger_proxy}]}, + fun em_cascading/0). + +%% Cascading failure that produce gen_server and proc_lib reports on +%% remote node - how many of the produced log events pass through the +%% proxy. +remote_events(Config) -> + {ok,_,Node1} = + logger_test_lib:setup([{postfix,1}|Config], + [{logger, + [{handler,default,?MODULE,#{}}]}]), + {ok,_,Node2} = + logger_test_lib:setup([{postfix,2}|Config],[]), + cascade({Node2,{logger_backend,log_allowed,2},[{remote_proxy,logger_proxy}]}, + {Node1,{?MODULE,log,2},[{local_proxy,logger_proxy}]}, + fun otp_cascading/0). + +%% Cascading failure that produce gen_server and proc_lib reports on +%% remote node - how many of the produced log events are actually +%% written to a log with logger_disk_log_h wrap file handler. +remote_to_disk_log(Config) -> + {ok,_,Node1} = + logger_test_lib:setup([{postfix,1}|Config], + [{logger, + [{handler,default,logger_disk_log_h,#{}}]}]), + {ok,_,Node2} = + logger_test_lib:setup([{postfix,2}|Config],[]), + cascade({Node2,{logger_backend,log_allowed,2},[{remote_proxy,logger_proxy}]}, + {Node1,{logger_disk_log_h,write,4}, + [{local_proxy,logger_proxy}, + {local_default,logger_disk_log_h_default}]}, + fun otp_cascading/0). +remote_to_disk_log(cleanup,_Config) -> + Files = filelib:wildcard("default.log.*"), + [_ = file:delete(F) || F <- Files], + ok. + +%% Cascading failure that produce log events from the emulator on +%% remote node - how many of the produced log events pass through the +%% proxy. +remote_emulator_events(Config) -> + {ok,_,Node1} = + logger_test_lib:setup([{postfix,1}|Config], + [{logger, + [{handler,default,?MODULE,#{}}]}]), + {ok,_,Node2} = + logger_test_lib:setup([{postfix,2}|Config],[]), + cascade({Node2,{?MODULE,producer,0},[{remote_proxy,logger_proxy}]}, + {Node1,{?MODULE,log,2},[{local_proxy,logger_proxy}]}, + fun em_cascading/0). + +%% Cascading failure that produce log events from the emulator on +%% remote node - how many of the produced log events are actually +%% written to a log with logger_disk_log_h wrap file handler. +remote_emulator_to_disk_log(Config) -> + {ok,_,Node1} = + logger_test_lib:setup([{postfix,1}|Config], + [{logger, + [{handler,default,logger_disk_log_h,#{}}]}]), + {ok,_,Node2} = + logger_test_lib:setup([{postfix,2}|Config],[]), + cascade({Node2,{?MODULE,producer,0},[{remote_proxy,logger_proxy}]}, + {Node1,{logger_disk_log_h,write,4}, + [{local_proxy,logger_proxy}, + {local_default,logger_disk_log_h_default}]}, + fun em_cascading/0). +remote_emulator_to_disk_log(cleanup,_Config) -> + Files = filelib:wildcard("default.log.*"), + [_ = file:delete(F) || F <- Files], + ok. + +%%%----------------------------------------------------------------- +%%% Internal functions +nlogs(N) -> + group_leader(whereis(user),self()), + Str = "\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "[\\]^_`abcdefghijklmnopqr", + [?LOG_NOTICE(Str) || _ <- lists:seq(1,N)], + ok. + +%% cascade(ProducerInfo,ConsumerInfo,TestFun) +cascade({PNode,PMFA,_PStatProcs},{CNode,CMFA,_CStatProcs},TestFun) -> + Tab = ets:new(counter,[set,public]), + ets:insert(Tab,{producer,0}), + ets:insert(Tab,{consumer,0}), + dbg:tracer(process,{fun tracer/2,{Tab,PNode,CNode}}), + dbg:n(PNode), + dbg:n(CNode), + dbg:cn(node()), + dbg:p(all,[call,arity]), + dbg:tpl(PMFA,[]), + dbg:tpl(CMFA,[]), + + Pid = rpc:call(CNode,?MODULE,wrap_test,[PNode,TestFun]), + MRef = erlang:monitor(process,Pid), + TO = ?TEST_DURATION*1000, + receive {'DOWN',MRef,_,_,Reason} -> + ct:fail({remote_pid_down,Reason}) + after TO -> + All = ets:lookup_element(Tab,producer,2), + Written = ets:lookup_element(Tab,consumer,2), + dbg:stop_clear(), + ?COLLECT_STATS(All, + [{PNode,P,Id} || {Id,P} <- _PStatProcs] ++ + [{CNode,P,Id} || {Id,P} <- _CStatProcs]), + Ratio = Written/All * 100, + ct_event:notify(#event{name = benchmark_data, + data = [{value,Ratio}]}), + {comment,io_lib:format("~p % (~p written, ~p produced)", + [round(Ratio),Written,All])} + end. + +wrap_test(Fun) -> + wrap_test(node(),Fun). +wrap_test(Node,Fun) -> + reset(), + group_leader(whereis(user),self()), + rpc:call(Node,?MODULE,do_fun,[Fun]). + +do_fun(Fun) -> + reset(), + Fun(). + +reset() -> + reset([logger_std_h_default, logger_disk_log_h_default, logger_proxy]). +reset([P|Ps]) -> + is_pid(whereis(P)) andalso logger_olp:reset(P), + reset(Ps); +reset([]) -> + ok. + + +tracer({trace,_,call,{?MODULE,producer,_}},{Tab,_PNode,_CNode}=S) -> + ets:update_counter(Tab,producer,1), + S; +tracer({trace,Pid,call,{logger_backend,log_allowed,_}},{Tab,PNode,_CNode}=S) when node(Pid)=:=PNode -> + ets:update_counter(Tab,producer,1), + S; +tracer({trace,_,call,{?MODULE,log,_}},{Tab,_PNode,_CNode}=S) -> + ets:update_counter(Tab,consumer,1), + S; +tracer({trace,_,call,{_,write,_}},{Tab,_PNode,_CNode}=S) -> + ets:update_counter(Tab,consumer,1), + S; +tracer(_,S) -> + S. + + +%%%----------------------------------------------------------------- +%%% Collect statistics +-define(STAT_KEYS, + [burst_drops, + calls, + casts, + drops, + flushed, + flushes, + freq, + last_qlen, + max_qlen, + time, + writes]). +-define(EVENT_KEYS, + [calls,casts,flushed]). + +stats(All,Procs) -> + NI = [{Id,rpc:call(N,logger_olp,info,[P])} || {N,P,Id}<-Procs], + [{all,All}|[stats(Id,I,All) || {Id,I} <- NI]]. + +stats(Id,Info,All) -> + S = maps:with(?STAT_KEYS,Info), + AllOnProc = lists:sum(maps:values(maps:with(?EVENT_KEYS,S))), + if All>0 -> + Writes = maps:get(writes,S), + {_,ActiveTime} = maps:get(time,S), + Rate = round(100*Writes/All), + RateOnProc = + if AllOnProc>0 -> + round(100*Writes/AllOnProc); + true -> + 0 + end, + AvFreq = + if ActiveTime>0 -> + round(Writes/ActiveTime); + true -> + 0 + end, + {Id, + {stats,S}, + {rate,Rate}, + {rate_on_proc,RateOnProc}, + {av_freq,AvFreq}}; + true -> + {Id,none} + end. + +%%%----------------------------------------------------------------- +%%% Spawn a lot of processes that crash repeatedly, causing a lot of +%%% error reports from the emulator. +em_cascading() -> + spawn(fun() -> super() end). + +super() -> + process_flag(trap_exit,true), + spawn_link(fun server/0), + [spawn_link(fun client/0) || _<-lists:seq(1,10000)], + super_loop(). + +super_loop() -> + receive + {'EXIT',_,server} -> + spawn_link(fun server/0), + super_loop(); + {'EXIT',_,_} -> + _L = lists:sum(lists:seq(1,10000)), + spawn_link(fun client/0), + super_loop() + end. + +client() -> + receive + after 1 -> + case whereis(server) of + Pid when is_pid(Pid) -> + ok; + undefined -> + producer(), + erlang:error(some_exception) + end + end, + client(). + +server() -> + register(server,self()), + receive + after 3000 -> + exit(server) + end. + + +%%%----------------------------------------------------------------- +%%% Create a supervisor tree with processes that crash repeatedly, +%%% causing a lot of supervisor reports and crashreports +otp_cascading() -> + {ok,Pid} = supervisor:start_link({local,otp_super}, ?MODULE, [otp_super]), + unlink(Pid), + Pid. + +otp_server_sup() -> + supervisor:start_link({local,otp_server_sup},?MODULE,[otp_server_sup]). + +otp_client_sup(N) -> + supervisor:start_link({local,otp_client_sup},?MODULE,[otp_client_sup,N]). + +otp_server() -> + gen_server:start_link({local,otp_server},?MODULE,[otp_server],[]). + +otp_client() -> + gen_server:start_link(?MODULE,[otp_client],[]). + +init([otp_super]) -> + {ok, {{one_for_one, 200, 10}, + [{client_sup, + {?MODULE, otp_client_sup, [10000]}, + permanent, 1000, supervisor, [?MODULE]}, + {server_sup, + {?MODULE, otp_server_sup, []}, + permanent, 1000, supervisor, [?MODULE]} + ]}}; +init([otp_server_sup]) -> + {ok, {{one_for_one, 2, 10}, + [{server, + {?MODULE, otp_server, []}, + permanent, 1000, worker, [?MODULE]} + ]}}; +init([otp_client_sup,N]) -> + spawn(fun() -> + [supervisor:start_child(otp_client_sup,[]) + || _ <- lists:seq(1,N)] + end), + {ok, {{simple_one_for_one, N*10, 1}, + [{client, + {?MODULE, otp_client, []}, + permanent, 1000, worker, [?MODULE]} + ]}}; +init([otp_server]) -> + {ok, server, 10000}; +init([otp_client]) -> + {ok, client,1}. + +handle_info(timeout, client) -> + true = is_pid(whereis(otp_server)), + {noreply,client,1}; +handle_info(timeout, server) -> + exit(self(), some_error). + +%%%----------------------------------------------------------------- +%%% Logger callbacks +log(_LogEvent,_Config) -> + ok. + +%%%----------------------------------------------------------------- +%%% Function to trace on for counting produced emulator messages +producer() -> + ok. diff --git a/lib/kernel/test/logger_test_lib.erl b/lib/kernel/test/logger_test_lib.erl index 81eb9ce5eb..be4bc427fb 100644 --- a/lib/kernel/test/logger_test_lib.erl +++ b/lib/kernel/test/logger_test_lib.erl @@ -28,11 +28,17 @@ post_end_per_testcase/5, post_end_per_suite/3]). setup(Config,Vars) -> + Postfix = case proplists:get_value(postfix, Config) of + undefined -> ""; + P -> ["_",P] + end, FuncStr = lists:concat([proplists:get_value(suite, Config), "_", - proplists:get_value(tc, Config)]), + proplists:get_value(tc, Config)| + Postfix]), ConfigFileName = filename:join(proplists:get_value(priv_dir, Config), FuncStr), file:write_file(ConfigFileName ++ ".config", io_lib:format("[{kernel, ~p}].",[Vars])), - case test_server:start_node(proplists:get_value(tc, Config), slave, + Sname = lists:concat([proplists:get_value(tc,Config)|Postfix]), + case test_server:start_node(Sname, slave, [{args, ["-pa ",filename:dirname(code:which(?MODULE)), " -boot start_sasl -kernel start_timer true " "-config ",ConfigFileName]}]) of diff --git a/lib/mnesia/doc/src/mnesia.xml b/lib/mnesia/doc/src/mnesia.xml index 94f1af34bf..11b0b8e987 100644 --- a/lib/mnesia/doc/src/mnesia.xml +++ b/lib/mnesia/doc/src/mnesia.xml @@ -2077,6 +2077,13 @@ mnesia:create_table(employee, <fsummary>Starts a local Mnesia system.</fsummary> <desc> <marker id="start"></marker> + <p>Mnesia startup is asynchronous. The function call + <c>mnesia:start()</c> returns the atom <c>ok</c> and then + starts to initialize the different tables. Depending on the + size of the database, this can take some time, and the + application programmer must wait for the tables that the + application needs before they can be used. This is achieved + by using the function <c>mnesia:wait_for_tables/2</c>.</p> <p>The startup procedure for a set of Mnesia nodes is a fairly complicated operation. A Mnesia system consists of a set of nodes, with Mnesia started locally on all diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl index 223dba3f90..77afb8250c 100644 --- a/lib/mnesia/src/mnesia.erl +++ b/lib/mnesia/src/mnesia.erl @@ -838,18 +838,20 @@ read(Tid, Ts, Tab, Key, LockKind) tid -> Store = Ts#tidstore.store, Oid = {Tab, Key}, - Objs = - case LockKind of - read -> - mnesia_locker:rlock(Tid, Store, Oid); - write -> - mnesia_locker:rwlock(Tid, Store, Oid); - sticky_write -> - mnesia_locker:sticky_rwlock(Tid, Store, Oid); - _ -> - abort({bad_type, Tab, LockKind}) - end, - add_written(?ets_lookup(Store, Oid), Tab, Objs); + ObjsFun = + fun() -> + case LockKind of + read -> + mnesia_locker:rlock(Tid, Store, Oid); + write -> + mnesia_locker:rwlock(Tid, Store, Oid); + sticky_write -> + mnesia_locker:sticky_rwlock(Tid, Store, Oid); + _ -> + abort({bad_type, Tab, LockKind}) + end + end, + add_written(?ets_lookup(Store, Oid), Tab, ObjsFun, LockKind); _Protocol -> dirty_read(Tab, Key) end; @@ -1202,14 +1204,20 @@ add_previous(_Tid, Ts, _Type, Tab) -> %% This routine fixes up the return value from read/1 so that %% it is correct with respect to what this particular transaction %% has already written, deleted .... etc +%% The actual read from the table is not done if not needed due to local +%% transaction context, and if so, no extra read lock is needed either. -add_written([], _Tab, Objs) -> - Objs; % standard normal fast case -add_written(Written, Tab, Objs) -> +add_written([], _Tab, ObjsFun, _LockKind) -> + ObjsFun(); % standard normal fast case +add_written(Written, Tab, ObjsFun, LockKind) -> case val({Tab, setorbag}) of bag -> - add_written_to_bag(Written, Objs, []); + add_written_to_bag(Written, ObjsFun(), []); + _ when LockKind == read; + LockKind == write -> + add_written_to_set(Written); _ -> + _ = ObjsFun(), % Fall back to request new lock and read from source add_written_to_set(Written) end. diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl index a71e8fc29c..d6b5eff9b5 100644 --- a/lib/observer/test/crashdump_helper.erl +++ b/lib/observer/test/crashdump_helper.erl @@ -204,4 +204,4 @@ dump_persistent_terms() -> create_persistent_terms() -> persistent_term:put({?MODULE,first}, {pid,42.0}), persistent_term:put({?MODULE,second}, [1,2,3]), - persistent_term:get(). + {persistent_term:get({?MODULE,first}),persistent_term:get({?MODULE,second})}. diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index 8c5e618f4a..31cf7011d4 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -615,9 +615,8 @@ special(File,Procs) -> #proc{dict=Dict} = ProcDetails, %% io:format("~p\n", [Dict]), - Pts1 = crashdump_helper:create_persistent_terms(), - Pts2 = proplists:get_value(pts,Dict), - true = lists:sort(Pts1) =:= lists:sort(Pts2), + Pts = crashdump_helper:create_persistent_terms(), + Pts = proplists:get_value(pts,Dict), io:format(" persistent terms ok",[]), ok; _ -> diff --git a/lib/odbc/c_src/odbcserver.c b/lib/odbc/c_src/odbcserver.c index 8c799f6ff1..fb4f61417e 100644 --- a/lib/odbc/c_src/odbcserver.c +++ b/lib/odbc/c_src/odbcserver.c @@ -2749,6 +2749,11 @@ static diagnos get_diagnos(SQLSMALLINT handleType, SQLHANDLE handle, Boolean ext errmsg_buffer_size = errmsg_buffer_size - errmsg_size; acc_errmsg_size = acc_errmsg_size + errmsg_size; current_errmsg_pos = current_errmsg_pos + errmsg_size; + } else if(result == SQL_SUCCESS_WITH_INFO && errmsg_size >= errmsg_buffer_size) { + memcpy(diagnos.sqlState, current_sql_state, SQL_STATE_SIZE); + diagnos.nativeError = nativeError; + acc_errmsg_size = errmsg_buffer_size; + break; } else { break; } diff --git a/lib/runtime_tools/examples/dist.systemtap b/lib/runtime_tools/examples/dist.systemtap index bb20d617e1..4102a5243c 100644 --- a/lib/runtime_tools/examples/dist.systemtap +++ b/lib/runtime_tools/examples/dist.systemtap @@ -19,18 +19,18 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("dist-monitor") +probe process("beam.smp").mark("dist-monitor") { printf("monitor: pid %d, who %s, what %s, node %s, type %s, reason %s\n", pid(), @@ -38,38 +38,38 @@ probe process("beam").mark("dist-monitor") user_string($arg5)); } -probe process("beam").mark("dist-port_busy") +probe process("beam.smp").mark("dist-port_busy") { printf("dist port_busy: node %s, port %s, remote_node %s, blocked pid %s\n", user_string($arg1), user_string($arg2), user_string($arg3), user_string($arg4)); - blocked_procs[user_string($arg4)] = timestamp; + blocked_procs[user_string($arg4)] = local_clock_ns(); } -probe process("beam").mark("dist-port_busy") +probe process("beam.smp").mark("dist-port_busy") { printf("dist port_busy: node %s, port %s, remote_node %s, blocked pid %s\n", user_string($arg1), user_string($arg2), user_string($arg3), user_string($arg4)); - blocked_procs[user_string($arg4)] = timestamp; + blocked_procs[user_string($arg4)] = local_clock_ns(); } -probe process("beam").mark("dist-output") +probe process("beam.smp").mark("dist-output") { printf("dist output: node %s, port %s, remote_node %s bytes %d\n", user_string($arg1), user_string($arg2), user_string($arg3), $arg4); } -probe process("beam").mark("dist-outputv") +probe process("beam.smp").mark("dist-outputv") { printf("port outputv: node %s, port %s, remote_node %s bytes %d\n", user_string($arg1), user_string($arg2), user_string($arg3), $arg4); } -probe process("beam").mark("process-scheduled") +probe process("beam.smp").mark("process-scheduled") { pidstr = user_string($arg1); if (pidstr in blocked_procs) { printf("blocked pid %s scheduled now, waited %d microseconds\n", - pidstr, (timestamp - blocked_procs[pidstr]) / 1000); + pidstr, (local_clock_ns() - blocked_procs[pidstr]) / 1000); delete blocked_procs[pidstr]; } } diff --git a/lib/runtime_tools/examples/driver1.systemtap b/lib/runtime_tools/examples/driver1.systemtap index e1ee8ecffc..f5bc28b42d 100644 --- a/lib/runtime_tools/examples/driver1.systemtap +++ b/lib/runtime_tools/examples/driver1.systemtap @@ -19,108 +19,102 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("driver-init") +probe process("beam.smp").mark("driver__init") { printf("driver init name %s major %d minor %d flags %d\n", user_string($arg1), $arg2, $arg3, $arg4); } -probe process("beam").mark("driver-start") +probe process("beam.smp").mark("driver__start") { printf("driver start pid %s driver name %s port %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("driver-stop") +probe process("beam.smp").mark("driver__stop") { printf("driver stop pid %s driver name %s port %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("driver-finish") +probe process("beam.smp").mark("driver__finish") { printf("driver finish driver name %s\n", user_string($arg1)); } -probe process("beam").mark("driver-flush") +probe process("beam.smp").mark("driver__flush") { printf("driver flush pid %s port %s port name %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("driver-output") +probe process("beam.smp").mark("driver__output") { printf("driver output pid %s port %s port name %s bytes %d\n", user_string($arg1), user_string($arg2), user_string($arg3), $arg4); } -probe process("beam").mark("driver-outputv") +probe process("beam.smp").mark("driver__outputv") { printf("driver outputv pid %s port %s port name %s bytes %d\n", user_string($arg1), user_string($arg2), user_string($arg3), $arg4); } -probe process("beam").mark("driver-control") +probe process("beam.smp").mark("driver__control") { printf("driver control pid %s port %s port name %s command %d bytes %d\n", user_string($arg1), user_string($arg2), user_string($arg3), $arg4, $arg5); } -probe process("beam").mark("driver-call") +probe process("beam.smp").mark("driver__call") { printf("driver call pid %s port %s port name %s command %d bytes %d\n", user_string($arg1), user_string($arg2), user_string($arg3), $arg4, $arg5); } -probe process("beam").mark("driver-event") -{ - printf("driver event pid %s port %s port name %s\n", - user_string($arg1), user_string($arg2), user_string($arg3)); -} - -probe process("beam").mark("driver-ready_input") +probe process("beam.smp").mark("driver__ready_input") { printf("driver ready_input pid %s port %s port name %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("driver-ready_output") +probe process("beam.smp").mark("driver__ready_output") { printf("driver ready_output pid %s port %s port name %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("driver-timeout") +probe process("beam.smp").mark("driver__timeout") { printf("driver timeout pid %s port %s port name %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("driver-ready_async") +probe process("beam.smp").mark("driver__ready_async") { printf("driver ready_async pid %s port %s port name %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("driver-process_exit") +probe process("beam.smp").mark("driver__process_exit") { printf("driver process_exit pid %s port %s port name %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("driver-stop_select") +probe process("beam.smp").mark("driver__stop_select") { printf("driver stop_select driver name %s\n", user_string($arg1)); } diff --git a/lib/runtime_tools/examples/function-calls.systemtap b/lib/runtime_tools/examples/function-calls.systemtap index 9c44b2d014..6bb173b3ec 100644 --- a/lib/runtime_tools/examples/function-calls.systemtap +++ b/lib/runtime_tools/examples/function-calls.systemtap @@ -18,51 +18,51 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("local-function-entry") +probe process("beam.smp").mark("local-function-entry") { printf("pid %s enter (local) %s depth %d\n", user_string($arg1), user_string($arg2), $arg3); } -probe process("beam").mark("global-function-entry") +probe process("beam.smp").mark("global-function-entry") { printf("pid %s enter (global) %s depth %d\n", user_string($arg1), user_string($arg2), $arg3); } -probe process("beam").mark("function-return") +probe process("beam.smp").mark("function-return") { printf("pid %s return %s depth %d\n", user_string($arg1), user_string($arg2), $arg3); } -probe process("beam").mark("bif-entry") +probe process("beam.smp").mark("bif-entry") { printf("pid %s BIF entry mfa %s\n", user_string($arg1), user_string($arg2)); } -probe process("beam").mark("bif-return") +probe process("beam.smp").mark("bif-return") { printf("pid %s BIF return mfa %s\n", user_string($arg1), user_string($arg2)); } -probe process("beam").mark("nif-entry") +probe process("beam.smp").mark("nif-entry") { printf("pid %s NIF entry mfa %s\n", user_string($arg1), user_string($arg2)); } -probe process("beam").mark("nif-return") +probe process("beam.smp").mark("nif-return") { printf("pid %s NIF return mfa %s\n", user_string($arg1), user_string($arg2)); } diff --git a/lib/runtime_tools/examples/garbage-collection.systemtap b/lib/runtime_tools/examples/garbage-collection.systemtap index e414eea821..14f0d6851c 100644 --- a/lib/runtime_tools/examples/garbage-collection.systemtap +++ b/lib/runtime_tools/examples/garbage-collection.systemtap @@ -18,33 +18,33 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("gc_major-start") +probe process("beam.smp").mark("gc_major-start") { printf("GC major start pid %s need %d words\n", user_string($arg1), $arg2); } -probe process("beam").mark("gc_minor-start") +probe process("beam.smp").mark("gc_minor-start") { printf("GC minor start pid %s need %d words\n", user_string($arg1), $arg2); } -probe process("beam").mark("gc_major-end") +probe process("beam.smp").mark("gc_major-end") { printf("GC major end pid %s reclaimed %d words\n", user_string($arg1), $arg2); } -probe process("beam").mark("gc_minor-start") +probe process("beam.smp").mark("gc_minor-start") { printf("GC minor end pid %s reclaimed %d words\n", user_string($arg1), $arg2); } diff --git a/lib/runtime_tools/examples/memory1.systemtap b/lib/runtime_tools/examples/memory1.systemtap index 04df4d64c4..2fdc5a796c 100644 --- a/lib/runtime_tools/examples/memory1.systemtap +++ b/lib/runtime_tools/examples/memory1.systemtap @@ -18,34 +18,34 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("copy-struct") +probe process("beam.smp").mark("copy-struct") { printf("copy_struct %d bytes\n", $arg1); } -probe process("beam").mark("copy-object") +probe process("beam.smp").mark("copy-object") { printf("copy_object pid %s %d bytes\n", user_string($arg1), $arg2); } -probe process("beam").mark("process-heap_grow") +probe process("beam.smp").mark("process-heap_grow") { printf("proc heap grow pid %s %d -> %d bytes\n", user_string($arg1), $arg2, $arg3); } -probe process("beam").mark("process-heap_shrink") +probe process("beam.smp").mark("process-heap_shrink") { printf("proc heap shrink pid %s %d -> %d bytes\n", user_string($arg1), $arg2, $arg3); diff --git a/lib/runtime_tools/examples/messages.systemtap b/lib/runtime_tools/examples/messages.systemtap index f2ef56a22b..49b7f46d69 100644 --- a/lib/runtime_tools/examples/messages.systemtap +++ b/lib/runtime_tools/examples/messages.systemtap @@ -18,15 +18,15 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ probe begin @@ -38,7 +38,7 @@ probe begin printf("\n"); } -probe process("beam").mark("message-send") +probe process("beam.smp").mark("message-send") { if ($arg4 == 0 && $arg5 == 0 && $arg6 == 0) { printf("send: %s -> %s: %d words\n", @@ -51,7 +51,7 @@ probe process("beam").mark("message-send") } } -probe process("beam").mark("message-send-remote") +probe process("beam.smp").mark("message-send-remote") { if ($arg5 == 0 && $arg6 == 0 && $arg7 == 0) { printf("send : %s -> %s %s: %d words\n", @@ -64,7 +64,7 @@ probe process("beam").mark("message-send-remote") } } -probe process("beam").mark("message-queued") +probe process("beam.smp").mark("message-queued") { if ($arg4 == 0 && $arg5 == 0 && $arg6 == 0) { printf("queued: %s: %d words, queue len %d\n", user_string($arg1), $arg2, $arg3); @@ -75,7 +75,7 @@ probe process("beam").mark("message-queued") } } -probe process("beam").mark("message-receive") +probe process("beam.smp").mark("message-receive") { if ($arg4 == 0 && $arg5 == 0 && $arg6 == 0) { printf("receive: %s: %d words, queue len %d\n", diff --git a/lib/runtime_tools/examples/port1.systemtap b/lib/runtime_tools/examples/port1.systemtap index f7ce03a65e..235581b0b1 100644 --- a/lib/runtime_tools/examples/port1.systemtap +++ b/lib/runtime_tools/examples/port1.systemtap @@ -18,15 +18,15 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ probe begin @@ -96,19 +96,19 @@ probe begin driver_map["udp_inet", 62] = "BINDX"; } -probe process("beam").mark("port-open") +probe process("beam.smp").mark("port-open") { printf("port open pid %s port name %s port %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("port-command") +probe process("beam.smp").mark("port-command") { printf("port command pid %s port %s port name %s command type %s\n", user_string($arg1), user_string($arg2), user_string($arg3), user_string($arg4)); } -probe process("beam").mark("port-control") +probe process("beam.smp").mark("port-control") { cmd = driver_map[user_string($arg3), $arg4]; cmd_str = (cmd == "") ? "unknown" : cmd; @@ -118,36 +118,36 @@ probe process("beam").mark("port-control") /* port-exit is fired as a result of port_close() or exit signal */ -probe process("beam").mark("port-exit") +probe process("beam.smp").mark("port-exit") { printf("port exit pid %s port %s port name %s reason %s\n", user_string($arg1), user_string($arg2), user_string($arg3), user_string($arg4)); } -probe process("beam").mark("port-connect") +probe process("beam.smp").mark("port-connect") { printf("port connect pid %s port %s port name %s new pid %s\n", user_string($arg1), user_string($arg2), user_string($arg3), user_string($arg4)); } -probe process("beam").mark("port-busy") +probe process("beam.smp").mark("port-busy") { printf("port busy %s\n", user_string($arg1)); } -probe process("beam").mark("port-not_busy") +probe process("beam.smp").mark("port-not_busy") { printf("port not busy %s\n", user_string($arg1)); } -probe process("beam").mark("aio_pool-add") +probe process("beam.smp").mark("aio_pool-add") { printf("async I/O pool add thread %d queue len %d\n", $arg1, $arg2); } -probe process("beam").mark("aio_pool-get") +probe process("beam.smp").mark("aio_pool-get") { printf("async I/O pool get thread %d queue len %d\n", $arg1, $arg2); } -global driver_map;
\ No newline at end of file +global driver_map; diff --git a/lib/runtime_tools/examples/process-scheduling.systemtap b/lib/runtime_tools/examples/process-scheduling.systemtap index b0b74257b3..231c589f64 100644 --- a/lib/runtime_tools/examples/process-scheduling.systemtap +++ b/lib/runtime_tools/examples/process-scheduling.systemtap @@ -18,28 +18,28 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("process-scheduled") +probe process("beam.smp").mark("process-scheduled") { printf(" Schedule pid %s mfa %s\n", user_string($arg1), user_string($arg2)); } -probe process("beam").mark("process-unscheduled") +probe process("beam.smp").mark("process-unscheduled") { printf("Unschedule pid %s\n", user_string($arg1)); } -probe process("beam").mark("process-hibernate") +probe process("beam.smp").mark("process-hibernate") { printf(" Hibernate pid %s resume mfa %s\n", user_string($arg1), user_string($arg2)); diff --git a/lib/runtime_tools/examples/spawn-exit.systemtap b/lib/runtime_tools/examples/spawn-exit.systemtap index 89bca14496..a7b4a0a3ea 100644 --- a/lib/runtime_tools/examples/spawn-exit.systemtap +++ b/lib/runtime_tools/examples/spawn-exit.systemtap @@ -18,34 +18,34 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("process-spawn") +probe process("beam.smp").mark("process-spawn") { printf("pid %s mfa %s\n", user_string($arg1), user_string($arg2)); } -probe process("beam").mark("process-exit") +probe process("beam.smp").mark("process-exit") { printf("pid %s reason %s\n", user_string($arg1), user_string($arg2)); } -probe process("beam").mark("process-exit_signal") +probe process("beam.smp").mark("process-exit_signal") { printf("sender %s -> pid %s reason %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("process-exit_signal-remote") +probe process("beam.smp").mark("process-exit_signal-remote") { printf("sender %s -> node %s pid %s reason %s\n", user_string($arg1), user_string($arg2), user_string($arg3), user_string($arg4)); diff --git a/lib/runtime_tools/examples/user-probe-n.systemtap b/lib/runtime_tools/examples/user-probe-n.systemtap index 25f7503283..8a0a89c931 100644 --- a/lib/runtime_tools/examples/user-probe-n.systemtap +++ b/lib/runtime_tools/examples/user-probe-n.systemtap @@ -18,18 +18,19 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("user_trace-n0") + +probe process("beam.smp").mark("user_trace-n0") { printf("probe n0: %s %s %d %d %d %d '%s' '%s' '%s' '%s'\n", user_string($arg1), @@ -41,7 +42,7 @@ probe process("beam").mark("user_trace-n0") $arg9 == NULL ? "" : user_string($arg9)); } -probe process("beam").mark("user_trace-n1") +probe process("beam.smp").mark("user_trace-n1") { printf("probe n1: %s %s %d %d %d %d '%s' '%s' '%s' '%s'\n", user_string($arg1), diff --git a/lib/runtime_tools/examples/user-probe.systemtap b/lib/runtime_tools/examples/user-probe.systemtap index 1777476e54..ce9dde30f8 100644 --- a/lib/runtime_tools/examples/user-probe.systemtap +++ b/lib/runtime_tools/examples/user-probe.systemtap @@ -18,23 +18,23 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("user_trace-s1") +probe process("beam.smp").mark("user_trace-s1") { printf("%s\n", user_string($arg1)); } -probe process("beam").mark("user_trace-i4s4") +probe process("beam.smp").mark("user_trace-i4s4") { printf("%s %s %d %d %d %d '%s' '%s' '%s' '%s'\n", user_string($arg1), diff --git a/lib/sasl/src/systools.erl b/lib/sasl/src/systools.erl index dd1a58c3c1..34eca6679f 100644 --- a/lib/sasl/src/systools.erl +++ b/lib/sasl/src/systools.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. 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. @@ -73,7 +73,7 @@ make_tar(RelName, Opt) -> script2boot(File) -> case systools_lib:file_term2binary(File ++ ".script", File ++ ".boot") of {error,Error} -> - io:format(systools_make:format_error(Error)), + io:format("~ts", [systools_make:format_error(Error)]), error; _ -> ok @@ -84,7 +84,7 @@ script2boot(File, Output0, _Opt) -> Output = Output0++".boot", case systools_lib:file_term2binary(Input, Output) of {error,Error} -> - io:format(systools_make:format_error(Error)), + io:format("~ts", [systools_make:format_error(Error)]), error; _ -> ok diff --git a/lib/sasl/src/systools_relup.erl b/lib/sasl/src/systools_relup.erl index e836d57670..5f1176ec69 100644 --- a/lib/sasl/src/systools_relup.erl +++ b/lib/sasl/src/systools_relup.erl @@ -587,7 +587,7 @@ default(warnings_as_errors) -> false. print_error({error, Mod, Error}) -> S = apply(Mod, format_error, [Error]), - io:format(S, []); + io:format("~ts", [S]); print_error(Other) -> io:format("Error: ~tp~n", [Other]). diff --git a/lib/ssh/test/ssh_bench_SUITE.erl b/lib/ssh/test/ssh_bench_SUITE.erl index 764c52b624..2ac4e5636a 100644 --- a/lib/ssh/test/ssh_bench_SUITE.erl +++ b/lib/ssh/test/ssh_bench_SUITE.erl @@ -109,11 +109,10 @@ connect(Config) -> lists:foreach( fun(KexAlg) -> PrefAlgs = preferred_algorithms(KexAlg), - report([{value, measure_connect(Config, - [{preferred_algorithms,PrefAlgs}])}, - {suite, ?MODULE}, - {name, mk_name(["Connect erlc erld ",KexAlg," [µs]"])} - ]) + TimeMicroSec = measure_connect(Config, + [{preferred_algorithms,PrefAlgs}]), + report(["Connect erlc erld ",KexAlg," [connects per sec]"], + 1000000 / TimeMicroSec) end, KexAlgs). @@ -130,7 +129,7 @@ measure_connect(Config, Opts) -> [begin {Time, {ok,Pid}} = timer:tc(ssh,connect,["localhost", Port, ConnectOptions]), ssh:close(Pid), - Time + Time % in µs end || _ <- lists:seq(1,?Nruns)]). %%%---------------------------------------------------------------- @@ -178,10 +177,6 @@ gen_data(DataSz) -> <<Data0/binary, Data1/binary>>. -%% connect_measure(Port, Cipher, Mac, Data, Options) -> -%% report([{value, 1}, -%% {suite, ?MODULE}, -%% {name, mk_name(["Transfer 1M bytes ",Cipher,"/",Mac," [µs]"])}]); connect_measure(Port, Cipher, Mac, Data, Options) -> AES_GCM = {cipher, []}, @@ -220,10 +215,8 @@ connect_measure(Port, Cipher, Mac, Data, Options) -> ssh:close(C), Time end || _ <- lists:seq(1,?Nruns)], - - report([{value, median(Times)}, - {suite, ?MODULE}, - {name, mk_name(["Transfer 1M bytes ",Cipher,"/",Mac," [µs]"])}]). + report(["Transfer ",Cipher,"/",Mac," [Mbyte per sec]"], + 1000000 / median(Times)). send_wait_acc(C, Ch, Data) -> ssh_connection:send(C, Ch, Data), @@ -238,12 +231,6 @@ send_wait_acc(C, Ch, Data) -> %%% %%%---------------------------------------------------------------- -mk_name(Name) -> [char(C) || C <- lists:concat(Name)]. - -char($-) -> $_; -char(C) -> C. - -%%%---------------------------------------------------------------- preferred_algorithms(KexAlg) -> [{kex, [KexAlg]}, {public_key, ['ssh-rsa']}, @@ -265,11 +252,22 @@ median(Data) when is_list(Data) -> 1 -> lists:nth(N div 2 + 1, SortedData) end, - ct:log("median(~p) = ~p",[SortedData,Median]), + ct:pal("median(~p) = ~p",[SortedData,Median]), Median. +%%%---------------------------------------------------------------- +report(LabelList, Value) -> + Label = report_chars(lists:concat(LabelList)), + ct:pal("ct_event:notify ~p: ~p", [Label, Value]), + ct_event:notify( + #event{name = benchmark_data, + data = [{suite, ?MODULE}, + {name, Label}, + {value, Value}]}). + +report_chars(Cs) -> + [case C of + $- -> $_; + _ -> C + end || C <- Cs]. -report(Data) -> - ct:log("EventData = ~p",[Data]), - ct_event:notify(#event{name = benchmark_data, - data = Data}). diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index 778e4a5fc8..6aa587dc7f 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -1124,12 +1124,12 @@ start_our_shell(_User, _Peer) -> ssh_exec_echo(Cmd) -> spawn(fun() -> - io:format("echo "++Cmd ++ "\n") + io:format("echo ~s\n", [Cmd]) end). ssh_exec_echo(Cmd, User) -> spawn(fun() -> - io:format(io_lib:format("echo ~s ~s\n",[User,Cmd])) + io:format("echo ~s ~s\n",[User,Cmd]) end). ssh_exec_echo(Cmd, User, _PeerAddr) -> ssh_exec_echo(Cmd,User). diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 6fcfe55285..82eb8ff700 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -27,6 +27,37 @@ </header> <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 9.1.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix encoding of the SRP extension length field in ssl. + The old encoding of the SRP extension length could cause + interoperability problems with third party SSL + implementations when SRP was used.</p> + <p> + Own Id: OTP-15477 Aux Id: ERL-790 </p> + </item> + <item> + <p> + Guarantee active once data delivery, handling TCP stream + properly.</p> + <p> + Own Id: OTP-15504 Aux Id: ERL-371 </p> + </item> + <item> + <p> + Correct gen_statem returns for some error cases</p> + <p> + Own Id: OTP-15505</p> + </item> + </list> + </section> + +</section> + <section><title>SSL 9.1.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 2da70131e1..200fb89a4d 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -83,8 +83,9 @@ <p><c>| {ciphers, ciphers()}</c></p> <p><c>| {user_lookup_fun, {fun(), term()}}, {psk_identity, string()}, {srp_identity, {string(), string()}}</c></p> - <p><c>| {reuse_sessions, boolean()}</c></p> - <p><c>| {reuse_session, fun()} {next_protocols_advertised, [binary()]}</c></p> + <p><c>| {reuse_sessions, boolean() | save()}</c></p> + <p><c>| {reuse_session, fun() | binary()} </c></p> + <p><c>| {next_protocols_advertised, [binary()]}</c></p> <p><c>| {client_preferred_next_protocols, {client | server, [binary()]} | {client | server, [binary()], binary()}}</c></p> <p><c>| {log_alert, boolean()}</c></p> @@ -593,11 +594,23 @@ fun(srp, Username :: string(), UserState :: term()) -> <item><p>In mode <c>verify_none</c> the default behavior is to allow all x509-path validation errors. See also option <c>verify_fun</c>.</p> </item> + + <tag><marker id="client_reuse_session"/><c>{reuse_session, binary()}</c></tag> + <item><p>Reuses a specific session earlier saved with the option + <c>{reuse_sessions, save} since ssl-9.2</c> + </p></item> - <tag><c>{reuse_sessions, boolean()}</c></tag> - <item><p>Specifies if the client is to try to reuse sessions - when possible.</p></item> - + <tag><c>{reuse_sessions, boolean() | save}</c></tag> + <item><p>When <c>save</c> is specified a new connection will be negotiated + and saved for later reuse. The session ID can be fetched with + <seealso marker="#connection_information">connection_information/2</seealso> + and used with the client option <seealso marker="#client_reuse_session">reuse_session</seealso> + The boolean value true specifies that if possible, automatized session reuse will + be performed. If a new session is created, and is unique in regard + to previous stored sessions, it will be saved for possible later reuse. + Value <c>save</c> since ssl-9.2 + </p></item> + <tag><c>{cacerts, [public_key:der_encoded()]}</c></tag> <item><p>The DER-encoded trusted certificates. If this option is supplied it overrides option <c>cacertfile</c>.</p></item> @@ -796,11 +809,14 @@ fun(srp, Username :: string(), UserState :: term()) -> </item> <tag><c>{reuse_sessions, boolean()}</c></tag> - <item><p>Specifies if the server is to agree to reuse sessions - when requested by the clients. See also option <c>reuse_session</c>. + <item><p>The boolean value true specifies that the server will + agree to reuse sessions. Setting it to false will result in an empty + session table, that is no sessions will be reused. + See also option <seealso marker="#server_reuse_session">reuse_session</seealso> </p></item> - <tag><c>{reuse_session, fun(SuggestedSessionId, + <tag><marker id="server_reuse_session"/> + <c>{reuse_session, fun(SuggestedSessionId, PeerCert, Compression, CipherSuite) -> boolean()}</c></tag> <item><p>Enables the TLS/DTLS server to have a local policy for deciding if a session is to be reused or not. diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index b9daeedc78..cbd5c8e0a9 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -108,9 +108,11 @@ pids(_) -> %%==================================================================== %% State transition handling %%==================================================================== -next_record(#state{unprocessed_handshake_events = N} = State) when N > 0 -> - {no_record, State#state{unprocessed_handshake_events = N-1}}; - +next_record(#state{handshake_env = + #handshake_env{unprocessed_handshake_events = N} = HsEnv} + = State) when N > 0 -> + {no_record, State#state{handshake_env = + HsEnv#handshake_env{unprocessed_handshake_events = N-1}}}; next_record(#state{protocol_buffers = #protocol_buffers{dtls_cipher_texts = [#ssl_tls{epoch = Epoch} = CT | Rest]} = Buffers, @@ -250,19 +252,22 @@ handle_protocol_record(#ssl_tls{type = ?HANDSHAKE, fragment = Data}, StateName, #state{protocol_buffers = Buffers0, - negotiated_version = Version} = State0) -> + negotiated_version = Version} = State) -> try case dtls_handshake:get_dtls_handshake(Version, Data, Buffers0) of {[], Buffers} -> - next_event(StateName, no_record, State0#state{protocol_buffers = Buffers}); + next_event(StateName, no_record, State#state{protocol_buffers = Buffers}); {Packets, Buffers} -> - State = State0#state{protocol_buffers = Buffers}, + HsEnv = State#state.handshake_env, Events = dtls_handshake_events(Packets), {next_state, StateName, - State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} + State#state{protocol_buffers = Buffers, + handshake_env = + HsEnv#handshake_env{unprocessed_handshake_events + = unprocessed_events(Events)}}, Events} end catch throw:#alert{} = Alert -> - handle_own_alert(Alert, Version, StateName, State0) + handle_own_alert(Alert, Version, StateName, State) end; %%% DTLS record protocol level change cipher messages handle_protocol_record(#ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = Data}, StateName, State) -> @@ -300,7 +305,7 @@ send_handshake(Handshake, #state{connection_states = ConnectionStates} = State) #{epoch := Epoch} = ssl_record:current_connection_state(ConnectionStates, write), send_handshake_flight(queue_handshake(Handshake, State), Epoch). -queue_handshake(Handshake0, #state{tls_handshake_history = Hist0, +queue_handshake(Handshake0, #state{handshake_env = #handshake_env{tls_handshake_history = Hist0} = HsEnv, negotiated_version = Version, flight_buffer = #{handshakes := HsBuffer0, change_cipher_spec := undefined, @@ -309,9 +314,9 @@ queue_handshake(Handshake0, #state{tls_handshake_history = Hist0, Hist = update_handshake_history(Handshake0, Handshake, Hist0), State#state{flight_buffer = Flight0#{handshakes => [Handshake | HsBuffer0], next_sequence => Seq +1}, - tls_handshake_history = Hist}; + handshake_env = HsEnv#handshake_env{tls_handshake_history = Hist}}; -queue_handshake(Handshake0, #state{tls_handshake_history = Hist0, +queue_handshake(Handshake0, #state{handshake_env = #handshake_env{tls_handshake_history = Hist0} = HsEnv, negotiated_version = Version, flight_buffer = #{handshakes_after_change_cipher_spec := Buffer0, next_sequence := Seq} = Flight0} = State) -> @@ -319,7 +324,7 @@ queue_handshake(Handshake0, #state{tls_handshake_history = Hist0, Hist = update_handshake_history(Handshake0, Handshake, Hist0), State#state{flight_buffer = Flight0#{handshakes_after_change_cipher_spec => [Handshake | Buffer0], next_sequence => Seq +1}, - tls_handshake_history = Hist}. + handshake_env = HsEnv#handshake_env{tls_handshake_history = Hist}}. queue_change_cipher(ChangeCipher, #state{flight_buffer = Flight, connection_states = ConnectionStates0} = State) -> @@ -331,10 +336,11 @@ queue_change_cipher(ChangeCipher, #state{flight_buffer = Flight, reinit(State) -> %% To be API compatible with TLS NOOP here reinit_handshake_data(State). -reinit_handshake_data(#state{protocol_buffers = Buffers} = State) -> +reinit_handshake_data(#state{protocol_buffers = Buffers, + handshake_env = HsEnv} = State) -> State#state{premaster_secret = undefined, public_key_info = undefined, - tls_handshake_history = ssl_handshake:init_handshake_history(), + handshake_env = HsEnv#handshake_env{tls_handshake_history = ssl_handshake:init_handshake_history()}, flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}, flight_buffer = new_flight(), protocol_buffers = @@ -418,10 +424,10 @@ init({call, From}, {start, Timeout}, role = client, session_cache = Cache, session_cache_cb = CacheCb}, + handshake_env = #handshake_env{renegotiation = {Renegotiation, _}}, ssl_options = SslOpts, session = #session{own_certificate = Cert} = Session0, - connection_states = ConnectionStates0, - renegotiation = {Renegotiation, _} + connection_states = ConnectionStates0 } = State0) -> Timer = ssl_connection:start_or_recv_cancel_timer(Timeout, From), Hello = dtls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, @@ -488,6 +494,7 @@ hello(internal, #client_hello{cookie = <<>>, #state{static_env = #static_env{role = server, transport_cb = Transport, socket = Socket}, + handshake_env = HsEnv, protocol_specific = #{current_cookie_secret := Secret}} = State0) -> {ok, {IP, Port}} = dtls_socket:peername(Transport, Socket), Cookie = dtls_handshake:cookie(Secret, IP, Port, Hello), @@ -501,24 +508,30 @@ hello(internal, #client_hello{cookie = <<>>, State1 = prepare_flight(State0#state{negotiated_version = Version}), {State2, Actions} = send_handshake(VerifyRequest, State1), {Record, State} = next_record(State2), - next_event(?FUNCTION_NAME, Record, State#state{tls_handshake_history = ssl_handshake:init_handshake_history()}, Actions); + next_event(?FUNCTION_NAME, Record, + State#state{handshake_env = HsEnv#handshake_env{ + tls_handshake_history = + ssl_handshake:init_handshake_history()}}, + Actions); hello(internal, #hello_verify_request{cookie = Cookie}, #state{static_env = #static_env{role = client, host = Host, port = Port, session_cache = Cache, session_cache_cb = CacheCb}, + handshake_env = #handshake_env{renegotiation = {Renegotiation, _}} = HsEnv, ssl_options = SslOpts, session = #session{own_certificate = OwnCert} = Session0, - connection_states = ConnectionStates0, - renegotiation = {Renegotiation, _} + connection_states = ConnectionStates0 } = State0) -> Hello = dtls_handshake:client_hello(Host, Port, Cookie, ConnectionStates0, SslOpts, Cache, CacheCb, Renegotiation, OwnCert), Version = Hello#client_hello.client_version, - State1 = prepare_flight(State0#state{tls_handshake_history = ssl_handshake:init_handshake_history()}), + State1 = prepare_flight(State0#state{handshake_env = + HsEnv#handshake_env{tls_handshake_history + = ssl_handshake:init_handshake_history()}}), {State2, Actions} = send_handshake(Hello, State1), State = State2#state{negotiated_version = Version, %% Requested version @@ -559,9 +572,9 @@ hello(internal, #client_hello{cookie = Cookie} = Hello, #state{static_env = #sta hello(internal, #server_hello{} = Hello, #state{ static_env = #static_env{role = client}, + handshake_env = #handshake_env{renegotiation = {Renegotiation, _}}, connection_states = ConnectionStates0, negotiated_version = ReqVersion, - renegotiation = {Renegotiation, _}, ssl_options = SslOptions} = State) -> case dtls_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of #alert{} = Alert -> @@ -675,11 +688,12 @@ connection(internal, #hello_request{}, #state{static_env = #static_env{host = Ho session_cache = Cache, session_cache_cb = CacheCb }, + handshake_env = #handshake_env{ renegotiation = {Renegotiation, _}}, session = #session{own_certificate = Cert} = Session0, ssl_options = SslOpts, - connection_states = ConnectionStates0, - renegotiation = {Renegotiation, _}} = State0) -> + connection_states = ConnectionStates0 + } = State0) -> Hello = dtls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, Cache, CacheCb, Renegotiation, Cert), @@ -701,7 +715,8 @@ connection(internal, #client_hello{} = Hello, #state{static_env = #static_env{ro %% initiated renegotiation we will disallow many client initiated %% renegotiations immediately after each other. erlang:send_after(?WAIT_TO_ALLOW_RENEGOTIATION, self(), allow_renegotiate), - {next_state, hello, State#state{allow_renegotiate = false, renegotiation = {true, peer}}, + {next_state, hello, State#state{allow_renegotiate = false, + handshake_env = #handshake_env{renegotiation = {true, peer}}}, [{next_event, internal, Hello}]}; connection(internal, #client_hello{}, #state{static_env = #static_env{role = server}, allow_renegotiate = false} = State0) -> @@ -773,6 +788,10 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, }, #state{static_env = InitStatEnv, + handshake_env = #handshake_env{ + tls_handshake_history = ssl_handshake:init_handshake_history(), + renegotiation = {false, first} + }, socket_options = SocketOptions, %% We do not want to save the password in the state so that %% could be written in the clear into error logs. @@ -782,7 +801,6 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, protocol_buffers = #protocol_buffers{}, user_application = {Monitor, User}, user_data_buffer = <<>>, - renegotiation = {false, first}, allow_renegotiate = SSLOptions#ssl_options.client_renegotiation, start_or_recv_from = undefined, flight_buffer = new_flight(), @@ -835,9 +853,8 @@ handle_client_hello(#client_hello{client_version = ClientVersion} = Hello, static_env = #static_env{port = Port, session_cache = Cache, session_cache_cb = CacheCb}, + handshake_env = #handshake_env{renegotiation = {Renegotiation, _}} = HsEnv, session = #session{own_certificate = Cert} = Session0, - renegotiation = {Renegotiation, _}, - negotiated_protocol = CurrentProtocol, key_algorithm = KeyExAlg, ssl_options = SslOpts} = State0) -> @@ -856,7 +873,7 @@ handle_client_hello(#client_hello{client_version = ClientVersion} = Hello, State = prepare_flight(State0#state{connection_states = ConnectionStates, negotiated_version = Version, hashsign_algorithm = HashSign, - client_hello_version = ClientVersion, + handshake_env = HsEnv#handshake_env{client_hello_version = ClientVersion}, session = Session, negotiated_protocol = Protocol}), @@ -1145,13 +1162,14 @@ send_application_data(Data, From, _StateName, #state{static_env = #static_env{socket = Socket, protocol_cb = Connection, transport_cb = Transport}, + handshake_env = HsEnv, negotiated_version = Version, connection_states = ConnectionStates0, ssl_options = #ssl_options{renegotiate_at = RenegotiateAt}} = State0) -> case time_to_renegotiate(Data, ConnectionStates0, RenegotiateAt) of true -> - renegotiate(State0#state{renegotiation = {true, internal}}, + renegotiate(State0#state{handshake_env = HsEnv#handshake_env{renegotiation = {true, internal}}}, [{next_event, {call, From}, {application_data, Data}}]); false -> {Msgs, ConnectionStates} = diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index 36c4b540b6..eb0f742e70 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -340,8 +340,9 @@ decode_handshake(Version, ?CLIENT_HELLO, <<?UINT24(_), ?UINT16(_), ?BYTE(Cm_length), Comp_methods:Cm_length/binary, Extensions/binary>>) -> TLSVersion = dtls_v1:corresponding_tls_version(Version), + LegacyVersion = dtls_v1:corresponding_tls_version({Major, Minor}), Exts = ssl_handshake:decode_vector(Extensions), - DecodedExtensions = ssl_handshake:decode_hello_extensions(Exts, TLSVersion, client), + DecodedExtensions = ssl_handshake:decode_hello_extensions(Exts, TLSVersion, LegacyVersion, client), #client_hello{ client_version = {Major,Minor}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 2c3f8bc20f..616e9e26e7 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -942,8 +942,6 @@ handle_options(Opts0, Role, Host) -> {list, [{mode, list}]}], Opts0), assert_proplist(Opts), RecordCb = record_cb(Opts), - - ReuseSessionFun = fun(_, _, _, _) -> true end, CaCerts = handle_option(cacerts, Opts, undefined), {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun, PartialChainHanlder, VerifyClientOnce} = @@ -1014,9 +1012,8 @@ handle_options(Opts0, Role, Host) -> Opts, undefined), %% Do not send by default tls_version(HighestVersion)), - %% Server side option - reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), - reuse_sessions = handle_option(reuse_sessions, Opts, true), + reuse_sessions = handle_reuse_sessions_option(reuse_sessions, Opts, Role), + reuse_session = handle_reuse_session_option(reuse_session, Opts, Role), secure_renegotiate = handle_option(secure_renegotiate, Opts, true), client_renegotiation = handle_option(client_renegotiation, Opts, default_option_role(server, true, Role), @@ -1211,11 +1208,16 @@ validate_option(srp_identity, {Username, Password}) {unicode:characters_to_binary(Username), unicode:characters_to_binary(Password)}; +validate_option(reuse_session, undefined) -> + undefined; validate_option(reuse_session, Value) when is_function(Value) -> Value; +validate_option(reuse_session, Value) when is_binary(Value) -> + Value; validate_option(reuse_sessions, Value) when is_boolean(Value) -> Value; - +validate_option(reuse_sessions, save = Value) -> + Value; validate_option(secure_renegotiate, Value) when is_boolean(Value) -> Value; validate_option(client_renegotiation, Value) when is_boolean(Value) -> @@ -1374,6 +1376,26 @@ handle_signature_algorithms_option(Value, Version) when is_list(Value) handle_signature_algorithms_option(_, _Version) -> undefined. +handle_reuse_sessions_option(Key, Opts, client) -> + Value = proplists:get_value(Key, Opts, true), + validate_option(Key, Value), + Value; +handle_reuse_sessions_option(Key, Opts0, server) -> + Opts = proplists:delete({Key, save}, Opts0), + Value = proplists:get_value(Key, Opts, true), + validate_option(Key, Value), + Value. + +handle_reuse_session_option(Key, Opts, client) -> + Value = proplists:get_value(Key, Opts, undefined), + validate_option(Key, Value), + Value; +handle_reuse_session_option(Key, Opts, server) -> + ReuseSessionFun = fun(_, _, _, _) -> true end, + Value = proplists:get_value(Key, Opts, ReuseSessionFun), + validate_option(Key, Value), + Value. + validate_options([]) -> []; validate_options([{Opt, Value} | Tail]) -> diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 1b6072dbcc..d08b2cc7ad 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -34,7 +34,7 @@ -include("tls_handshake_1_3.hrl"). -include_lib("public_key/include/public_key.hrl"). --export([security_parameters/2, security_parameters/3, security_parameters_1_3/3, +-export([security_parameters/2, security_parameters/3, security_parameters_1_3/2, cipher_init/3, nonce_seed/2, decipher/6, cipher/5, aead_encrypt/5, aead_decrypt/6, suites/1, all_suites/1, crypto_support_filters/0, chacha_suites/1, anonymous_suites/1, psk_suites/1, psk_suites_anon/1, @@ -44,10 +44,11 @@ hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1, random_bytes/1, calc_mac_hash/4, is_stream_ciphersuite/1, signature_scheme/1, - scheme_to_components/1, hash_size/1]). + scheme_to_components/1, hash_size/1, effective_key_bits/1, + key_material/1]). %% RFC 8446 TLS 1.3 --export([generate_client_shares/1, generate_server_share/1]). +-export([generate_client_shares/1, generate_server_share/1, add_zero_padding/2]). -compile(inline). @@ -88,23 +89,14 @@ security_parameters(Version, CipherSuite, SecParams) -> prf_algorithm = prf_algorithm(PrfHashAlg, Version), hash_size = hash_size(Hash)}. -security_parameters_1_3(SecParams, ClientRandom, CipherSuite) -> - #{cipher := Cipher, - mac := Hash, - prf := PrfHashAlg} = ssl_cipher_format:suite_definition(CipherSuite), +security_parameters_1_3(SecParams, CipherSuite) -> + #{cipher := Cipher, prf := PrfHashAlg} = + ssl_cipher_format:suite_definition(CipherSuite), SecParams#security_parameters{ - client_random = ClientRandom, cipher_suite = CipherSuite, bulk_cipher_algorithm = bulk_cipher_algorithm(Cipher), - cipher_type = type(Cipher), - key_size = effective_key_bits(Cipher), - expanded_key_material_length = expanded_key_material(Cipher), - key_material_length = key_material(Cipher), - iv_size = iv_size(Cipher), - mac_algorithm = mac_algorithm(Hash), - prf_algorithm =prf_algorithm(PrfHashAlg, {3,4}), - hash_size = hash_size(Hash), - compression_algorithm = 0}. + prf_algorithm = PrfHashAlg, %% HKDF hash algorithm + cipher_type = ?AEAD}. %%-------------------------------------------------------------------- -spec cipher_init(cipher_enum(), binary(), binary()) -> #cipher_state{}. @@ -578,7 +570,8 @@ crypto_support_filters() -> end]}. is_acceptable_keyexchange(KeyExchange, _Algos) when KeyExchange == psk; - KeyExchange == null -> + KeyExchange == null; + KeyExchange == any -> true; is_acceptable_keyexchange(KeyExchange, Algos) when KeyExchange == dh_anon; KeyExchange == dhe_psk -> @@ -621,7 +614,7 @@ is_acceptable_cipher(rc4_128, Algos) -> is_acceptable_cipher(des_cbc, Algos) -> proplists:get_bool(des_cbc, Algos); is_acceptable_cipher('3des_ede_cbc', Algos) -> - proplists:get_bool(des3_cbc, Algos); + proplists:get_bool(des_ede3, Algos); is_acceptable_cipher(aes_128_cbc, Algos) -> proplists:get_bool(aes_cbc128, Algos); is_acceptable_cipher(aes_256_cbc, Algos) -> @@ -690,10 +683,9 @@ hash_size(sha) -> hash_size(sha256) -> 32; hash_size(sha384) -> - 48. -%% Uncomment when adding cipher suite that needs it -%hash_size(sha512) -> -% 64. + 48; +hash_size(sha512) -> + 64. %%-------------------------------------------------------------------- %%% Internal functions @@ -897,8 +889,8 @@ scheme_to_components(ecdsa_secp521r1_sha512) -> {sha512, ecdsa, secp521r1}; scheme_to_components(rsa_pss_rsae_sha256) -> {sha256, rsa_pss_rsae, undefined}; scheme_to_components(rsa_pss_rsae_sha384) -> {sha384, rsa_pss_rsae, undefined}; scheme_to_components(rsa_pss_rsae_sha512) -> {sha512, rsa_pss_rsae, undefined}; -%% scheme_to_components(ed25519) -> {undefined, undefined, undefined}; -%% scheme_to_components(ed448) -> {undefined, undefined, undefined}; +scheme_to_components(ed25519) -> {undefined, undefined, undefined}; +scheme_to_components(ed448) -> {undefined, undefined, undefined}; scheme_to_components(rsa_pss_pss_sha256) -> {sha256, rsa_pss_pss, undefined}; scheme_to_components(rsa_pss_pss_sha384) -> {sha384, rsa_pss_pss, undefined}; scheme_to_components(rsa_pss_pss_sha512) -> {sha512, rsa_pss_pss, undefined}; @@ -1240,5 +1232,24 @@ generate_key_exchange(secp384r1) -> public_key:generate_key({namedCurve, secp384r1}); generate_key_exchange(secp521r1) -> public_key:generate_key({namedCurve, secp521r1}); +generate_key_exchange(x25519) -> + crypto:generate_key(ecdh, x25519); +generate_key_exchange(x448) -> + crypto:generate_key(ecdh, x448); generate_key_exchange(FFDHE) -> public_key:generate_key(ssl_dh_groups:dh_params(FFDHE)). + + +%% TODO: Move this functionality to crypto! +%% 7.4.1. Finite Field Diffie-Hellman +%% +%% For finite field groups, a conventional Diffie-Hellman [DH76] +%% computation is performed. The negotiated key (Z) is converted to a +%% byte string by encoding in big-endian form and left-padded with zeros +%% up to the size of the prime. This byte string is used as the shared +%% secret in the key schedule as specified above. +add_zero_padding(Bin, PrimeSize) + when byte_size (Bin) =:= PrimeSize -> + Bin; +add_zero_padding(Bin, PrimeSize) -> + add_zero_padding(<<0, Bin/binary>>, PrimeSize). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 19186336cb..af18ceb322 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -359,8 +359,8 @@ handle_normal_shutdown(Alert, _, #state{static_env = #static_env{role = Role, transport_cb = Transport, protocol_cb = Connection, tracker = Tracker}, - start_or_recv_from = StartFrom, - renegotiation = {false, first}} = State) -> + handshake_env = #handshake_env{renegotiation = {false, first}}, + start_or_recv_from = StartFrom} = State) -> Pids = Connection:pids(State), alert_user(Pids, Transport, Tracker,Socket, StartFrom, Alert, Role, Connection); @@ -404,8 +404,8 @@ handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, #state{static_env = #static_env{role = Role, protocol_cb = Connection}, - ssl_options = SslOpts, - renegotiation = {true, internal}} = State) -> + handshake_env = #handshake_env{renegotiation = {true, internal}}, + ssl_options = SslOpts} = State) -> log_alert(SslOpts#ssl_options.log_level, Role, Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), handle_normal_shutdown(Alert, StateName, State), @@ -414,27 +414,26 @@ handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, connection = StateName, #state{static_env = #static_env{role = Role, protocol_cb = Connection}, - ssl_options = SslOpts, - renegotiation = {true, From} + handshake_env = #handshake_env{renegotiation = {true, From}} = HsEnv, + ssl_options = SslOpts } = State0) -> log_alert(SslOpts#ssl_options.log_level, Role, Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), gen_statem:reply(From, {error, renegotiation_rejected}), State = Connection:reinit_handshake_data(State0), - Connection:next_event(connection, no_record, State#state{renegotiation = undefined}); + Connection:next_event(connection, no_record, State#state{handshake_env = HsEnv#handshake_env{renegotiation = undefined}}); handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, #state{static_env = #static_env{role = Role, protocol_cb = Connection}, - ssl_options = SslOpts, - renegotiation = {true, From} + handshake_env = #handshake_env{renegotiation = {true, From}} = HsEnv, + ssl_options = SslOpts } = State0) -> - log_alert(SslOpts#ssl_options.log_level, Role, - Connection:protocol_name(), StateName, - Alert#alert{role = opposite_role(Role)}), + log_alert(SslOpts#ssl_options.log_level, Role, + Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), gen_statem:reply(From, {error, renegotiation_rejected}), %% Go back to connection! - State = Connection:reinit(State0#state{renegotiation = undefined}), + State = Connection:reinit(State0#state{handshake_env = HsEnv#handshake_env{renegotiation = undefined}}), Connection:next_event(connection, no_record, State); %% Gracefully log and ignore all other warning alerts @@ -612,7 +611,8 @@ handle_session(#server_hello{cipher_suite = CipherSuite, ssl_config(Opts, Role, State) -> ssl_config(Opts, Role, State, new). -ssl_config(Opts, Role, #state{static_env = InitStatEnv0} =State0, Type) -> +ssl_config(Opts, Role, #state{static_env = InitStatEnv0, + handshake_env = HsEnv} = State0, Type) -> {ok, #{cert_db_ref := Ref, cert_db_handle := CertDbHandle, fileref_db_handle := FileRefHandle, @@ -639,8 +639,8 @@ ssl_config(Opts, Role, #state{static_env = InitStatEnv0} =State0, Type) -> ssl_options = Opts}, case Type of new -> - Handshake = ssl_handshake:init_handshake_history(), - State#state{tls_handshake_history = Handshake}; + Hist = ssl_handshake:init_handshake_history(), + State#state{handshake_env = HsEnv#handshake_env{tls_handshake_history = Hist}}; continue -> State end. @@ -733,15 +733,15 @@ abbreviated({call, From}, Msg, State, Connection) -> handle_call(Msg, From, ?FUNCTION_NAME, State, Connection); abbreviated(internal, #finished{verify_data = Data} = Finished, #state{static_env = #static_env{role = server}, + handshake_env = #handshake_env{tls_handshake_history = Hist}, negotiated_version = Version, expecting_finished = true, - tls_handshake_history = Handshake, session = #session{master_secret = MasterSecret}, connection_states = ConnectionStates0} = State0, Connection) -> case ssl_handshake:verify_connection(ssl:tls_version(Version), Finished, client, get_current_prf(ConnectionStates0, write), - MasterSecret, Handshake) of + MasterSecret, Hist) of verified -> ConnectionStates = ssl_record:set_client_verify_data(current_both, Data, ConnectionStates0), @@ -753,13 +753,13 @@ abbreviated(internal, #finished{verify_data = Data} = Finished, end; abbreviated(internal, #finished{verify_data = Data} = Finished, #state{static_env = #static_env{role = client}, - tls_handshake_history = Handshake0, + handshake_env = #handshake_env{tls_handshake_history = Hist0}, session = #session{master_secret = MasterSecret}, negotiated_version = Version, connection_states = ConnectionStates0} = State0, Connection) -> case ssl_handshake:verify_connection(ssl:tls_version(Version), Finished, server, get_pending_prf(ConnectionStates0, write), - MasterSecret, Handshake0) of + MasterSecret, Hist0) of verified -> ConnectionStates1 = ssl_record:set_server_verify_data(current_read, Data, ConnectionStates0), @@ -1009,18 +1009,18 @@ cipher(info, Msg, State, _) -> cipher(internal, #certificate_verify{signature = Signature, hashsign_algorithm = CertHashSign}, #state{static_env = #static_env{role = server}, + handshake_env = #handshake_env{tls_handshake_history = Hist}, key_algorithm = KexAlg, public_key_info = PublicKeyInfo, negotiated_version = Version, - session = #session{master_secret = MasterSecret}, - tls_handshake_history = Handshake + session = #session{master_secret = MasterSecret} } = State, Connection) -> TLSVersion = ssl:tls_version(Version), %% Use negotiated value if TLS-1.2 otherwhise return default HashSign = negotiated_hashsign(CertHashSign, KexAlg, PublicKeyInfo, TLSVersion), case ssl_handshake:certificate_verify(Signature, PublicKeyInfo, - TLSVersion, HashSign, MasterSecret, Handshake) of + TLSVersion, HashSign, MasterSecret, Hist) of valid -> Connection:next_event(?FUNCTION_NAME, no_record, State#state{cert_hashsign_algorithm = HashSign}); @@ -1044,13 +1044,13 @@ cipher(internal, #finished{verify_data = Data} = Finished, = Session0, ssl_options = SslOpts, connection_states = ConnectionStates0, - tls_handshake_history = Handshake0} = State, Connection) -> + handshake_env = #handshake_env{tls_handshake_history = Hist}} = State, Connection) -> case ssl_handshake:verify_connection(ssl:tls_version(Version), Finished, opposite_role(Role), get_current_prf(ConnectionStates0, read), - MasterSecret, Handshake0) of + MasterSecret, Hist) of verified -> - Session = register_session(Role, host_id(Role, Host, SslOpts), Port, Session0), + Session = handle_session(Role, SslOpts, Host, Port, Session0), cipher_role(Role, Data, Session, State#state{expecting_finished = false}, Connection); #alert{} = Alert -> @@ -1090,9 +1090,10 @@ connection({call, RecvFrom}, {recv, N, Timeout}, start_or_recv_from = RecvFrom, timer = Timer}, ?FUNCTION_NAME, Connection); -connection({call, From}, renegotiate, #state{static_env = #static_env{protocol_cb = Connection}} = State, +connection({call, From}, renegotiate, #state{static_env = #static_env{protocol_cb = Connection}, + handshake_env = HsEnv} = State, Connection) -> - Connection:renegotiate(State#state{renegotiation = {true, From}}, []); + Connection:renegotiate(State#state{handshake_env = HsEnv#handshake_env{renegotiation = {true, From}}}, []); connection({call, From}, peer_certificate, #state{session = #session{peer_certificate = Cert}} = State, _) -> hibernate_after(?FUNCTION_NAME, State, [{reply, From, {ok, Cert}}]); @@ -1112,9 +1113,10 @@ connection({call, From}, negotiated_protocol, connection({call, From}, Msg, State, Connection) -> handle_call(Msg, From, ?FUNCTION_NAME, State, Connection); connection(cast, {internal_renegotiate, WriteState}, #state{static_env = #static_env{protocol_cb = Connection}, + handshake_env = HsEnv, connection_states = ConnectionStates} = State, Connection) -> - Connection:renegotiate(State#state{renegotiation = {true, internal}, + Connection:renegotiate(State#state{handshake_env = HsEnv#handshake_env{renegotiation = {true, internal}}, connection_states = ConnectionStates#{current_write => WriteState}}, []); connection(cast, {dist_handshake_complete, DHandle}, #state{ssl_options = #ssl_options{erl_dist = true}, @@ -1147,15 +1149,17 @@ downgrade(Type, Event, State, Connection) -> %% common or unexpected events for the state. %%-------------------------------------------------------------------- handle_common_event(internal, {handshake, {#hello_request{} = Handshake, _}}, connection = StateName, - #state{static_env = #static_env{role = client}} = State, _) -> + #state{static_env = #static_env{role = client}, + handshake_env = HsEnv} = State, _) -> %% Should not be included in handshake history - {next_state, StateName, State#state{renegotiation = {true, peer}}, [{next_event, internal, Handshake}]}; + {next_state, StateName, State#state{handshake_env = HsEnv#handshake_env{renegotiation = {true, peer}}}, + [{next_event, internal, Handshake}]}; handle_common_event(internal, {handshake, {#hello_request{}, _}}, StateName, #state{static_env = #static_env{role = client}}, _) when StateName =/= connection -> keep_state_and_data; handle_common_event(internal, {handshake, {Handshake, Raw}}, StateName, - #state{tls_handshake_history = Hs0} = State0, + #state{handshake_env = #handshake_env{tls_handshake_history = Hist0} = HsEnv} = State0, Connection) -> PossibleSNI = Connection:select_sni_extension(Handshake), @@ -1163,8 +1167,9 @@ handle_common_event(internal, {handshake, {Handshake, Raw}}, StateName, %% a client_hello, which needs to be determined by the connection callback. %% In other cases this is a noop State = handle_sni_extension(PossibleSNI, State0), - HsHist = ssl_handshake:update_handshake_history(Hs0, iolist_to_binary(Raw)), - {next_state, StateName, State#state{tls_handshake_history = HsHist}, + + Hist = ssl_handshake:update_handshake_history(Hist0, Raw), + {next_state, StateName, State#state{handshake_env = HsEnv#handshake_env{tls_handshake_history = Hist}}, [{next_event, internal, Handshake}]}; handle_common_event(internal, {protocol_record, TLSorDTLSRecord}, StateName, State, Connection) -> Connection:handle_protocol_record(TLSorDTLSRecord, StateName, State); @@ -1199,7 +1204,7 @@ handle_call({shutdown, read_write = How}, From, StateName, ok -> {next_state, StateName, State#state{terminated = true}, [{reply, From, ok}]}; Error -> - {stop, StateName, State#state{terminated = true}, [{reply, From, Error}]} + {stop_and_reply, {shutdown, normal}, {reply, From, Error}, State#state{terminated = true}} end catch throw:Return -> @@ -1212,7 +1217,7 @@ handle_call({shutdown, How0}, From, StateName, ok -> {next_state, StateName, State, [{reply, From, ok}]}; Error -> - {stop, StateName, State, [{reply, From, Error}]} + {stop_and_reply, {shutdown, normal}, {reply, From, Error}, State} end; handle_call({recv, _N, _Timeout}, From, _, #state{socket_options = @@ -1327,7 +1332,7 @@ handle_info(allow_renegotiate, StateName, State) -> {next_state, StateName, State#state{allow_renegotiate = true}}; handle_info({cancel_start_or_recv, StartFrom}, StateName, - #state{renegotiation = {false, first}} = State) when StateName =/= connection -> + #state{handshake_env = #handshake_env{renegotiation = {false, first}}} = State) when StateName =/= connection -> {stop_and_reply, {shutdown, user_timeout}, {reply, StartFrom, {error, timeout}}, @@ -1412,7 +1417,7 @@ format_status(terminate, [_, StateName, State]) -> [{data, [{"State", {StateName, State#state{connection_states = ?SECRET_PRINTOUT, protocol_buffers = ?SECRET_PRINTOUT, user_data_buffer = ?SECRET_PRINTOUT, - tls_handshake_history = ?SECRET_PRINTOUT, + handshake_env = ?SECRET_PRINTOUT, session = ?SECRET_PRINTOUT, private_key = ?SECRET_PRINTOUT, diffie_hellman_params = ?SECRET_PRINTOUT, @@ -1627,16 +1632,16 @@ certify_client(#state{client_certificate_requested = false} = State, _) -> State. verify_client_cert(#state{static_env = #static_env{role = client}, + handshake_env = #handshake_env{tls_handshake_history = Hist}, client_certificate_requested = true, negotiated_version = Version, private_key = PrivateKey, session = #session{master_secret = MasterSecret, own_certificate = OwnCert}, - cert_hashsign_algorithm = HashSign, - tls_handshake_history = Handshake0} = State, Connection) -> + cert_hashsign_algorithm = HashSign} = State, Connection) -> case ssl_handshake:client_certificate_verify(OwnCert, MasterSecret, - ssl:tls_version(Version), HashSign, PrivateKey, Handshake0) of + ssl:tls_version(Version), HashSign, PrivateKey, Hist) of #certificate_verify{} = Verified -> Connection:queue_handshake(Verified, State); ignore -> @@ -1672,7 +1677,9 @@ server_certify_and_key_exchange(State0, Connection) -> request_client_cert(State2, Connection). certify_client_key_exchange(#encrypted_premaster_secret{premaster_secret= EncPMS}, - #state{private_key = Key, client_hello_version = {Major, Minor} = Version} = State, Connection) -> + #state{private_key = Key, + handshake_env = #handshake_env{client_hello_version = {Major, Minor} = Version}} + = State, Connection) -> FakeSecret = make_premaster_secret(Version, rsa), %% Countermeasure for Bleichenbacher attack always provide some kind of premaster secret %% and fail handshake later.RFC 5246 section 7.4.7.1. @@ -2099,14 +2106,15 @@ cipher_protocol(State, Connection) -> Connection:queue_change_cipher(#change_cipher_spec{}, State). finished(#state{static_env = #static_env{role = Role}, + handshake_env = #handshake_env{tls_handshake_history = Hist}, negotiated_version = Version, session = Session, - connection_states = ConnectionStates0, - tls_handshake_history = Handshake0} = State0, StateName, Connection) -> + connection_states = ConnectionStates0} = State0, + StateName, Connection) -> MasterSecret = Session#session.master_secret, Finished = ssl_handshake:finished(ssl:tls_version(Version), Role, get_current_prf(ConnectionStates0, write), - MasterSecret, Handshake0), + MasterSecret, Hist), ConnectionStates = save_verify_data(Role, Finished, ConnectionStates0, StateName), Connection:send_handshake(Finished, State0#state{connection_states = ConnectionStates}). @@ -2418,7 +2426,7 @@ handle_trusted_certs_db(#state{static_env = #static_env{cert_db_ref = Ref, ok end. -prepare_connection(#state{renegotiation = Renegotiate, +prepare_connection(#state{handshake_env = #handshake_env{renegotiation = Renegotiate}, start_or_recv_from = RecvFrom} = State0, Connection) when Renegotiate =/= {false, first}, RecvFrom =/= undefined -> @@ -2428,18 +2436,18 @@ prepare_connection(State0, Connection) -> State = Connection:reinit(State0), {no_record, ack_connection(State)}. -ack_connection(#state{renegotiation = {true, Initiater}} = State) when Initiater == peer; - Initiater == internal -> - State#state{renegotiation = undefined}; -ack_connection(#state{renegotiation = {true, From}} = State) -> +ack_connection(#state{handshake_env = #handshake_env{renegotiation = {true, Initiater}} = HsEnv} = State) when Initiater == peer; + Initiater == internal -> + State#state{handshake_env = HsEnv#handshake_env{renegotiation = undefined}}; +ack_connection(#state{handshake_env = #handshake_env{renegotiation = {true, From}} = HsEnv} = State) -> gen_statem:reply(From, ok), - State#state{renegotiation = undefined}; -ack_connection(#state{renegotiation = {false, first}, + State#state{handshake_env = HsEnv#handshake_env{renegotiation = undefined}}; +ack_connection(#state{handshake_env = #handshake_env{renegotiation = {false, first}} = HsEnv, start_or_recv_from = StartFrom, timer = Timer} = State) when StartFrom =/= undefined -> gen_statem:reply(StartFrom, connected), cancel_timer(Timer), - State#state{renegotiation = undefined, + State#state{handshake_env = HsEnv#handshake_env{renegotiation = undefined}, start_or_recv_from = undefined, timer = undefined}; ack_connection(State) -> State. @@ -2455,15 +2463,35 @@ session_handle_params(#server_ecdh_params{curve = ECCurve}, Session) -> session_handle_params(_, Session) -> Session. -register_session(client, Host, Port, #session{is_resumable = new} = Session0) -> +handle_session(Role = server, #ssl_options{reuse_sessions = true} = SslOpts, + Host, Port, Session0) -> + register_session(Role, host_id(Role, Host, SslOpts), Port, Session0, true); +handle_session(Role = client, #ssl_options{verify = verify_peer, + reuse_sessions = Reuse} = SslOpts, + Host, Port, Session0) when Reuse =/= false -> + register_session(Role, host_id(Role, Host, SslOpts), Port, Session0, reg_type(Reuse)); +handle_session(server, _, Host, Port, Session) -> + %% Remove "session of type new" entry from session DB + ssl_manager:invalidate_session(Host, Port, Session), + Session; +handle_session(client, _,_,_, Session) -> + %% In client case there is no entry yet, so nothing to remove + Session. + +reg_type(save) -> + true; +reg_type(true) -> + unique. + +register_session(client, Host, Port, #session{is_resumable = new} = Session0, Save) -> Session = Session0#session{is_resumable = true}, - ssl_manager:register_session(Host, Port, Session), + ssl_manager:register_session(Host, Port, Session, Save), Session; -register_session(server, _, Port, #session{is_resumable = new} = Session0) -> +register_session(server, _, Port, #session{is_resumable = new} = Session0, _) -> Session = Session0#session{is_resumable = true}, ssl_manager:register_session(Port, Session), Session; -register_session(_, _, _, Session) -> +register_session(_, _, _, Session, _) -> Session. %% Already registered host_id(client, _Host, #ssl_options{server_name_indication = Hostname}) when is_list(Hostname) -> diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index 6e08445798..dd3bdd7478 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -51,8 +51,18 @@ cert_db_ref :: certdb_ref() | 'undefined', tracker :: pid() | 'undefined' %% Tracker process for listen socket }). + +-record(handshake_env, { + client_hello_version :: ssl_record:ssl_version() | 'undefined', + unprocessed_handshake_events = 0 :: integer(), + tls_handshake_history :: ssl_handshake:ssl_handshake_history() | secret_printout() + | 'undefined', + renegotiation :: undefined | {boolean(), From::term() | internal | peer} + }). + -record(state, { static_env :: #static_env{}, + handshake_env :: #handshake_env{} | secret_printout(), %% Change seldome user_application :: {Monitor::reference(), User::pid()}, ssl_options :: #ssl_options{}, @@ -68,12 +78,9 @@ connection_states :: ssl_record:connection_states() | secret_printout(), protocol_buffers :: term() | secret_printout() , %% #protocol_buffers{} from tls_record.hrl or dtls_recor.hr user_data_buffer :: undefined | binary() | secret_printout(), - + %% Used only in HS - unprocessed_handshake_events = 0 :: integer(), - tls_handshake_history :: ssl_handshake:ssl_handshake_history() | secret_printout() - | 'undefined', - client_hello_version :: ssl_record:ssl_version() | 'undefined', + client_certificate_requested = false :: boolean(), key_algorithm :: ssl_cipher_format:key_algo(), hashsign_algorithm = {undefined, undefined}, @@ -86,7 +93,6 @@ srp_params :: #srp_user{} | secret_printout() | 'undefined', srp_keys ::{PublicKey :: binary(), PrivateKey :: binary()} | secret_printout() | 'undefined', premaster_secret :: binary() | secret_printout() | 'undefined', - renegotiation :: undefined | {boolean(), From::term() | internal | peer}, start_or_recv_from :: term(), timer :: undefined | reference(), % start_or_recive_timer hello, %%:: #client_hello{} | #server_hello{}, @@ -111,4 +117,61 @@ base = ?DEFAULT_DIFFIE_HELLMAN_GENERATOR}). -define(WAIT_TO_ALLOW_RENEGOTIATION, 12000). + +%%---------------------------------------------------------------------- +%% TLS 1.3 +%%---------------------------------------------------------------------- + +%% TLS 1.3 uses the same state record with the following differences: +%% +%% state :: record() +%% +%% session_cache - not implemented +%% session_cache_cb - not implemented +%% crl_db - not implemented +%% client_hello_version - Bleichenbacher mitigation in TLS 1.2 +%% client_certificate_requested - Built into TLS 1.3 state machine +%% key_algorithm - not used +%% diffie_hellman_params - used in TLS 1.2 ECDH key exchange +%% diffie_hellman_keys - used in TLS 1.2 ECDH key exchange +%% psk_identity - not used +%% srp_params - not used, no srp extension in TLS 1.3 +%% srp_keys - not used, no srp extension in TLS 1.3 +%% premaster_secret - not used +%% renegotiation - TLS 1.3 forbids renegotiation +%% hello - used in user_hello, handshake continue +%% allow_renegotiate - TLS 1.3 forbids renegotiation +%% expecting_next_protocol_negotiation - ALPN replaced NPN, depricated in TLS 1.3 +%% expecting_finished - not implemented, used by abbreviated +%% next_protocol - ALPN replaced NPN, depricated in TLS 1.3 +%% +%% connection_state :: map() +%% +%% compression_state - not used +%% mac_secret - not used +%% sequence_number - not used +%% secure_renegotiation - not used, no renegotiation_info in TLS 1.3 +%% client_verify_data - not used, no renegotiation_info in TLS 1.3 +%% server_verify_data - not used, no renegotiation_info in TLS 1.3 +%% beast_mitigation - not used +%% +%% security_parameters :: map() +%% +%% cipher_type - TLS 1.3 uses only AEAD ciphers +%% iv_size - not used +%% key_size - not used +%% key_material_length - not used +%% expanded_key_material_length - used in SSL 3.0 +%% mac_algorithm - not used +%% prf_algorithm - not used +%% hash_size - not used +%% compression_algorithm - not used +%% master_secret - used for multiple secret types in TLS 1.3 +%% client_random - not used +%% server_random - not used +%% exportable - not used +%% +%% cipher_state :: record() +%% nonce - used for sequence_number + -endif. % -ifdef(ssl_connection). diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index f8bc700d7f..a28f4add1b 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -61,7 +61,7 @@ -export([encode_handshake/2, encode_hello_extensions/1, encode_extensions/1, encode_extensions/2, encode_client_protocol_negotiation/2, encode_protocols_advertised_on_server/1]). %% Decode --export([decode_handshake/3, decode_vector/1, decode_hello_extensions/3, decode_extensions/3, +-export([decode_handshake/3, decode_vector/1, decode_hello_extensions/4, decode_extensions/3, decode_server_key/3, decode_client_key/3, decode_suites/2 ]). @@ -592,7 +592,7 @@ encode_extensions(Exts) -> encode_extensions(Exts, <<>>). encode_extensions([], <<>>) -> - <<>>; + <<?UINT16(0)>>; encode_extensions([], Acc) -> Size = byte_size(Acc), <<?UINT16(Size), Acc/binary>>; @@ -639,7 +639,7 @@ encode_extensions([#ec_point_formats{ec_point_format_list = ECPointFormats} | Re ?UINT16(Len), ?BYTE(ListLen), ECPointFormatList/binary, Acc/binary>>); encode_extensions([#srp{username = UserName} | Rest], Acc) -> SRPLen = byte_size(UserName), - Len = SRPLen + 2, + Len = SRPLen + 1, encode_extensions(Rest, <<?UINT16(?SRP_EXT), ?UINT16(Len), ?BYTE(SRPLen), UserName/binary, Acc/binary>>); encode_extensions([#hash_sign_algos{hash_sign_algos = HashSignAlgos} | Rest], Acc) -> @@ -680,9 +680,9 @@ encode_extensions([#sni{hostname = Hostname} | Rest], Acc) -> encode_extensions([#client_hello_versions{versions = Versions0} | Rest], Acc) -> Versions = encode_versions(Versions0), VerLen = byte_size(Versions), - Len = VerLen + 2, + Len = VerLen + 1, encode_extensions(Rest, <<?UINT16(?SUPPORTED_VERSIONS_EXT), - ?UINT16(Len), ?UINT16(VerLen), Versions/binary, Acc/binary>>); + ?UINT16(Len), ?BYTE(VerLen), Versions/binary, Acc/binary>>); encode_extensions([#server_hello_selected_version{selected_version = Version0} | Rest], Acc) -> Version = encode_versions([Version0]), Len = byte_size(Version), %% 2 @@ -745,8 +745,7 @@ decode_handshake(Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32 ?BYTE(SID_length), Session_ID:SID_length/binary, Cipher_suite:2/binary, ?BYTE(Comp_method), ?UINT16(ExtLen), Extensions:ExtLen/binary>>) -> - - HelloExtensions = decode_hello_extensions(Extensions, Version, server_hello), + HelloExtensions = decode_hello_extensions(Extensions, Version, {Major, Minor}, server_hello), #server_hello{ server_version = {Major,Minor}, @@ -803,11 +802,12 @@ decode_vector(<<?UINT16(Len), Vector:Len/binary>>) -> Vector. %%-------------------------------------------------------------------- --spec decode_hello_extensions(binary(), ssl_record:ssl_version(), atom()) -> map(). +-spec decode_hello_extensions(binary(), ssl_record:ssl_version(), + ssl_record:ssl_version(), atom()) -> map(). %% %% Description: Decodes TLS hello extensions %%-------------------------------------------------------------------- -decode_hello_extensions(Extensions, Version, MessageType0) -> +decode_hello_extensions(Extensions, LocalVersion, LegacyVersion, MessageType0) -> %% Convert legacy atoms MessageType = case MessageType0 of @@ -815,6 +815,13 @@ decode_hello_extensions(Extensions, Version, MessageType0) -> server -> server_hello; T -> T end, + %% RFC 8446 - 4.2.1 + %% Servers MUST be prepared to receive ClientHellos that include this extension but + %% do not include 0x0304 in the list of versions. + %% Clients MUST check for this extension prior to processing the rest of the + %% ServerHello (although they will have to parse the ServerHello in order to read + %% the extension). + Version = process_supported_versions_extension(Extensions, LocalVersion, LegacyVersion), decode_extensions(Extensions, Version, MessageType, empty_extensions(Version, MessageType)). %%-------------------------------------------------------------------- @@ -1167,7 +1174,12 @@ kse_remove_private_key(#key_share_entry{ signature_algs_ext(undefined) -> undefined; -signature_algs_ext(SignatureSchemes) -> +signature_algs_ext(SignatureSchemes0) -> + %% The SSL option signature_algs contains both hash-sign algorithms (tuples) and + %% signature schemes (atoms) if TLS 1.3 is configured. + %% Filter out all hash-sign tuples when creating the signature_algs extension. + %% (TLS 1.3 specific record type) + SignatureSchemes = lists:filter(fun is_atom/1, SignatureSchemes0), #signature_algorithms{signature_scheme_list = SignatureSchemes}. signature_algs_cert(undefined) -> @@ -2195,6 +2207,47 @@ dec_server_key_signature(Params, <<?UINT16(Len), Signature:Len/binary>>, _) -> dec_server_key_signature(_, _, _) -> throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, failed_to_decrypt_server_key_sign)). +%% Processes a ClientHello/ServerHello message and returns the version to be used +%% in the decoding functions. The following rules apply: +%% - IF supported_versions extension is absent: +%% RETURN the lowest of (LocalVersion and LegacyVersion) +%% - IF supported_versions estension is present: +%% RETURN the lowest of (LocalVersion and first element of supported versions) +process_supported_versions_extension(<<>>, LocalVersion, LegacyVersion) + when LegacyVersion =< LocalVersion -> + LegacyVersion; +process_supported_versions_extension(<<>>, LocalVersion, _LegacyVersion) -> + LocalVersion; +process_supported_versions_extension(<<?UINT16(?SUPPORTED_VERSIONS_EXT), ?UINT16(Len), + ExtData:Len/binary, _Rest/binary>>, + LocalVersion, _LegacyVersion) when Len > 2 -> + <<?BYTE(_),Versions0/binary>> = ExtData, + [Highest|_] = decode_versions(Versions0), + if Highest =< LocalVersion -> + Highest; + true -> + LocalVersion + end; +process_supported_versions_extension(<<?UINT16(?SUPPORTED_VERSIONS_EXT), ?UINT16(Len), + ?BYTE(Major),?BYTE(Minor), _Rest/binary>>, + LocalVersion, _LegacyVersion) when Len =:= 2 -> + SelectedVersion = {Major, Minor}, + if SelectedVersion =< LocalVersion -> + SelectedVersion; + true -> + LocalVersion + end; +process_supported_versions_extension(<<?UINT16(_), ?UINT16(Len), + _ExtData:Len/binary, Rest/binary>>, + LocalVersion, LegacyVersion) -> + process_supported_versions_extension(Rest, LocalVersion, LegacyVersion); +%% Tolerate protocol encoding errors and skip parsing the rest of the extension. +process_supported_versions_extension(_, LocalVersion, LegacyVersion) + when LegacyVersion =< LocalVersion -> + LegacyVersion; +process_supported_versions_extension(_, LocalVersion, _) -> + LocalVersion. + decode_extensions(<<>>, _Version, _MessageType, Acc) -> Acc; decode_extensions(<<?UINT16(?ALPN_EXT), ?UINT16(ExtLen), ?UINT16(Len), @@ -2223,7 +2276,7 @@ decode_extensions(<<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), decode_extensions(<<?UINT16(?SRP_EXT), ?UINT16(Len), ?BYTE(SRPLen), SRP:SRPLen/binary, Rest/binary>>, Version, MessageType, Acc) - when Len == SRPLen + 2 -> + when Len == SRPLen + 1 -> decode_extensions(Rest, Version, MessageType, Acc#{srp => #srp{username = SRP}}); decode_extensions(<<?UINT16(?SIGNATURE_ALGORITHMS_EXT), ?UINT16(Len), @@ -2321,7 +2374,7 @@ decode_extensions(<<?UINT16(?SNI_EXT), ?UINT16(Len), decode_extensions(<<?UINT16(?SUPPORTED_VERSIONS_EXT), ?UINT16(Len), ExtData:Len/binary, Rest/binary>>, Version, MessageType, Acc) when Len > 2 -> - <<?UINT16(_),Versions/binary>> = ExtData, + <<?BYTE(_),Versions/binary>> = ExtData, decode_extensions(Rest, Version, MessageType, Acc#{client_hello_versions => #client_hello_versions{ diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index a079c6a796..57b72366d3 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -137,10 +137,10 @@ %% Local policy for the server if it want's to reuse the session %% or not. Defaluts to allways returning true. %% fun(SessionId, PeerCert, Compression, CipherSuite) -> boolean() - reuse_session, + reuse_session :: fun() | binary() | undefined, %% Server side is a fun() %% If false sessions will never be reused, if true they %% will be reused if possible. - reuse_sessions :: boolean(), + reuse_sessions :: boolean() | save, %% Only client side can use value save renegotiate_at, secure_renegotiate, client_renegotiation, @@ -176,6 +176,8 @@ max_handshake_size :: integer(), handshake, customize_hostname_check + %% , + %% save_session :: boolean() }). -record(socket_options, diff --git a/lib/ssl/src/ssl_logger.erl b/lib/ssl/src/ssl_logger.erl index 35c8dcfd48..c4dd2dad60 100644 --- a/lib/ssl/src/ssl_logger.erl +++ b/lib/ssl/src/ssl_logger.erl @@ -20,7 +20,7 @@ -module(ssl_logger). --export([debug/3, +-export([debug/4, format/2, notice/2]). @@ -32,8 +32,10 @@ -define(rec_info(T,R),lists:zip(record_info(fields,T),tl(tuple_to_list(R)))). -include("tls_record.hrl"). +-include("ssl_cipher.hrl"). -include("ssl_internal.hrl"). -include("tls_handshake.hrl"). +-include("tls_handshake_1_3.hrl"). -include_lib("kernel/include/logger.hrl"). %%------------------------------------------------------------------------- @@ -56,12 +58,20 @@ format(#{level:= _Level, msg:= {report, Msg}, meta:= _Meta}, _Config0) -> end. %% Stateful logging -debug(Level, Report, Meta) -> +debug(Level, Direction, Protocol, Message) + when (Direction =:= inbound orelse Direction =:= outbound) andalso + (Protocol =:= 'tls_record' orelse Protocol =:= 'handshake') -> case logger:compare_levels(Level, debug) of lt -> - ?LOG_DEBUG(Report, Meta); + ?LOG_DEBUG(#{direction => Direction, + protocol => Protocol, + message => Message}, + #{domain => [otp,ssl,Protocol]}); eq -> - ?LOG_DEBUG(Report, Meta); + ?LOG_DEBUG(#{direction => Direction, + protocol => Protocol, + message => Message}, + #{domain => [otp,ssl,Protocol]}); _ -> ok end. @@ -87,20 +97,32 @@ format_handshake(Direction, BinMsg) -> parse_handshake(Direction, #client_hello{ - client_version = Version + client_version = Version0, + cipher_suites = CipherSuites0, + extensions = Extensions } = ClientHello) -> + Version = get_client_version(Version0, Extensions), Header = io_lib:format("~s ~s Handshake, ClientHello", [header_prefix(Direction), version(Version)]), - Message = io_lib:format("~p", [?rec_info(client_hello, ClientHello)]), + CipherSuites = parse_cipher_suites(CipherSuites0), + Message = io_lib:format("~p", + [?rec_info(client_hello, + ClientHello#client_hello{cipher_suites = CipherSuites})]), {Header, Message}; parse_handshake(Direction, #server_hello{ - server_version = Version + server_version = Version0, + cipher_suite = CipherSuite0, + extensions = Extensions } = ServerHello) -> + Version = get_server_version(Version0, Extensions), Header = io_lib:format("~s ~s Handshake, ServerHello", [header_prefix(Direction), version(Version)]), - Message = io_lib:format("~p", [?rec_info(server_hello, ServerHello)]), + CipherSuite = format_cipher(CipherSuite0), + Message = io_lib:format("~p", + [?rec_info(server_hello, + ServerHello#server_hello{cipher_suite = CipherSuite})]), {Header, Message}; parse_handshake(Direction, #certificate{} = Certificate) -> Header = io_lib:format("~s Handshake, Certificate", @@ -146,9 +168,52 @@ parse_handshake(Direction, #hello_request{} = HelloRequest) -> Header = io_lib:format("~s Handshake, HelloRequest", [header_prefix(Direction)]), Message = io_lib:format("~p", [?rec_info(hello_request, HelloRequest)]), + {Header, Message}; +parse_handshake(Direction, #certificate_1_3{} = Certificate) -> + Header = io_lib:format("~s Handshake, Certificate", + [header_prefix(Direction)]), + Message = io_lib:format("~p", [?rec_info(certificate_1_3, Certificate)]), + {Header, Message}; +parse_handshake(Direction, #certificate_verify_1_3{} = CertificateVerify) -> + Header = io_lib:format("~s Handshake, CertificateVerify", + [header_prefix(Direction)]), + Message = io_lib:format("~p", [?rec_info(certificate_verify_1_3, CertificateVerify)]), + {Header, Message}; +parse_handshake(Direction, #encrypted_extensions{} = EncryptedExtensions) -> + Header = io_lib:format("~s Handshake, EncryptedExtensions", + [header_prefix(Direction)]), + Message = io_lib:format("~p", [?rec_info(encrypted_extensions, EncryptedExtensions)]), {Header, Message}. +parse_cipher_suites([_|_] = Ciphers) -> + [format_cipher(C) || C <- Ciphers]. + +format_cipher(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV) -> + 'TLS_EMPTY_RENEGOTIATION_INFO_SCSV'; +format_cipher(C0) -> + list_to_atom(ssl_cipher_format:openssl_suite_name(C0)). + +get_client_version(Version, Extensions) -> + CHVersions = maps:get(client_hello_versions, Extensions, undefined), + case CHVersions of + #client_hello_versions{versions = [Highest|_]} -> + Highest; + undefined -> + Version + end. + +get_server_version(Version, Extensions) -> + SHVersion = maps:get(server_hello_selected_version, Extensions, undefined), + case SHVersion of + #server_hello_selected_version{selected_version = SelectedVersion} -> + SelectedVersion; + undefined -> + Version + end. + +version({3,4}) -> + "TLS 1.3"; version({3,3}) -> "TLS 1.2"; version({3,2}) -> diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index c938772bc1..b1f080b0fe 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -30,7 +30,7 @@ connection_init/3, cache_pem_file/2, lookup_trusted_cert/4, new_session_id/1, clean_cert_db/2, - register_session/2, register_session/3, invalidate_session/2, + register_session/2, register_session/4, invalidate_session/2, insert_crls/2, insert_crls/3, delete_crls/1, delete_crls/2, invalidate_session/3, name/1]). @@ -170,9 +170,11 @@ clean_cert_db(Ref, File) -> %% %% Description: Make the session available for reuse. %%-------------------------------------------------------------------- --spec register_session(host(), inet:port_number(), #session{}) -> ok. -register_session(Host, Port, Session) -> - cast({register_session, Host, Port, Session}). +-spec register_session(host(), inet:port_number(), #session{}, unique | true) -> ok. +register_session(Host, Port, Session, true) -> + call({register_session, Host, Port, Session}); +register_session(Host, Port, Session, unique = Save) -> + cast({register_session, Host, Port, Session, Save}). -spec register_session(inet:port_number(), #session{}) -> ok. register_session(Port, Session) -> @@ -301,7 +303,10 @@ handle_call({{new_session_id, Port}, _}, _, #state{session_cache_cb = CacheCb, session_cache_server = Cache} = State) -> Id = new_id(Port, ?GEN_UNIQUE_ID_MAX_TRIES, Cache, CacheCb), - {reply, Id, State}. + {reply, Id, State}; +handle_call({{register_session, Host, Port, Session},_}, _, State0) -> + State = client_register_session(Host, Port, Session, State0), + {reply, ok, State}. %%-------------------------------------------------------------------- -spec handle_cast(msg(), #state{}) -> {noreply, #state{}}. @@ -311,8 +316,12 @@ handle_call({{new_session_id, Port}, _}, %% %% Description: Handling cast messages %%-------------------------------------------------------------------- -handle_cast({register_session, Host, Port, Session}, State0) -> - State = ssl_client_register_session(Host, Port, Session, State0), +handle_cast({register_session, Host, Port, Session, unique}, State0) -> + State = client_register_unique_session(Host, Port, Session, State0), + {noreply, State}; + +handle_cast({register_session, Host, Port, Session, true}, State0) -> + State = client_register_session(Host, Port, Session, State0), {noreply, State}; handle_cast({register_session, Port, Session}, State0) -> @@ -540,10 +549,10 @@ clean_cert_db(Ref, CertDb, RefDb, FileMapDb, File) -> ok end. -ssl_client_register_session(Host, Port, Session, #state{session_cache_client = Cache, - session_cache_cb = CacheCb, - session_cache_client_max = Max, - session_client_invalidator = Pid0} = State) -> +client_register_unique_session(Host, Port, Session, #state{session_cache_client = Cache, + session_cache_cb = CacheCb, + session_cache_client_max = Max, + session_client_invalidator = Pid0} = State) -> TimeStamp = erlang:monotonic_time(), NewSession = Session#session{time_stamp = TimeStamp}, @@ -557,6 +566,17 @@ ssl_client_register_session(Host, Port, Session, #state{session_cache_client = C register_unique_session(Sessions, NewSession, {Host, Port}, State) end. +client_register_session(Host, Port, Session, #state{session_cache_client = Cache, + session_cache_cb = CacheCb, + session_cache_client_max = Max, + session_client_invalidator = Pid0} = State) -> + TimeStamp = erlang:monotonic_time(), + NewSession = Session#session{time_stamp = TimeStamp}, + Pid = do_register_session({{Host, Port}, + NewSession#session.session_id}, + NewSession, Max, Pid0, Cache, CacheCb), + State#state{session_client_invalidator = Pid}. + server_register_session(Port, Session, #state{session_cache_server_max = Max, session_cache_server = Cache, session_cache_cb = CacheCb, diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index ddc83821b4..d0a72ce51f 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -25,6 +25,7 @@ -module(ssl_record). -include("ssl_record.hrl"). +-include("ssl_connection.hrl"). -include("ssl_internal.hrl"). -include("ssl_cipher.hrl"). -include("ssl_alert.hrl"). @@ -39,7 +40,8 @@ set_renegotiation_flag/2, set_client_verify_data/3, set_server_verify_data/3, - empty_connection_state/2, initial_connection_state/2, record_protocol_role/1]). + empty_connection_state/2, initial_connection_state/2, record_protocol_role/1, + step_encryption_state/1]). %% Compression -export([compress/3, uncompress/3, compressions/0]). @@ -118,6 +120,22 @@ activate_pending_connection_state(#{current_write := Current, }. %%-------------------------------------------------------------------- +-spec step_encryption_state(connection_states()) -> connection_states(). +%% +%% Description: Activates the next encyrption state (e.g. handshake +%% encryption). +%%-------------------------------------------------------------------- +step_encryption_state(#state{connection_states = + #{pending_read := PendingRead, + pending_write := PendingWrite} = ConnStates} = State) -> + NewRead = PendingRead#{sequence_number => 0}, + NewWrite = PendingWrite#{sequence_number => 0}, + State#state{connection_states = + ConnStates#{current_read => NewRead, + current_write => NewWrite}}. + + +%%-------------------------------------------------------------------- -spec set_security_params(#security_parameters{}, #security_parameters{}, connection_states()) -> connection_states(). %% diff --git a/lib/ssl/src/ssl_session.erl b/lib/ssl/src/ssl_session.erl index c9607489e9..a9759c9b43 100644 --- a/lib/ssl/src/ssl_session.erl +++ b/lib/ssl/src/ssl_session.erl @@ -53,6 +53,13 @@ is_new(_ClientSuggestion, _ServerDecision) -> %% Description: Should be called by the client side to get an id %% for the client hello message. %%-------------------------------------------------------------------- +client_id({Host, Port, #ssl_options{reuse_session = SessionId}}, Cache, CacheCb, _) when is_binary(SessionId)-> + case CacheCb:lookup(Cache, {{Host, Port}, SessionId}) of + undefined -> + <<>>; + #session{} -> + SessionId + end; client_id(ClientInfo, Cache, CacheCb, OwnCert) -> case select_session(ClientInfo, Cache, CacheCb, OwnCert) of no_session -> @@ -91,7 +98,8 @@ server_id(Port, SuggestedId, Options, Cert, Cache, CacheCb) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -select_session({_, _, #ssl_options{reuse_sessions=false}}, _Cache, _CacheCb, _OwnCert) -> +select_session({_, _, #ssl_options{reuse_sessions = Reuse}}, _Cache, _CacheCb, _OwnCert) when Reuse =/= true -> + %% If reuse_sessions == true | save a new session should be created no_session; select_session({HostIP, Port, SslOpts}, Cache, CacheCb, OwnCert) -> Sessions = CacheCb:select_session(Cache, {HostIP, Port}), @@ -132,7 +140,7 @@ is_resumable(SuggestedSessionId, Port, #ssl_options{reuse_session = ReuseFun} = false -> {false, undefined} end; undefined -> - {false, undefined} + {false, undefined} end. resumable(new) -> diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index b042baebcb..01e378702c 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -161,24 +161,25 @@ pids(#state{protocol_specific = #{sender := Sender}}) -> %%==================================================================== %% State transition handling %%==================================================================== -next_record(#state{unprocessed_handshake_events = N} = State) when N > 0 -> - {no_record, State#state{unprocessed_handshake_events = N-1}}; - +next_record(#state{handshake_env = + #handshake_env{unprocessed_handshake_events = N} = HsEnv} + = State) when N > 0 -> + {no_record, State#state{handshake_env = + HsEnv#handshake_env{unprocessed_handshake_events = N-1}}}; next_record(#state{protocol_buffers = - #protocol_buffers{tls_packets = [], tls_cipher_texts = [CT | Rest]} - = Buffers, - connection_states = ConnStates0, + #protocol_buffers{tls_packets = [], tls_cipher_texts = [#ssl_tls{type = Type}| _] = CipherTexts0} + = Buffers, + connection_states = ConnectionStates0, negotiated_version = Version, - ssl_options = #ssl_options{padding_check = Check}} = State) -> - - case tls_record:decode_cipher_text(Version, CT, ConnStates0, Check) of - {Plain, ConnStates} -> - {Plain, State#state{protocol_buffers = - Buffers#protocol_buffers{tls_cipher_texts = Rest}, - connection_states = ConnStates}}; - #alert{} = Alert -> - {Alert, State} - end; + ssl_options = #ssl_options{padding_check = Check}} = State) -> + case decode_cipher_texts(Version, Type, CipherTexts0, ConnectionStates0, Check, <<>>) of + {#ssl_tls{} = Record, ConnectionStates, CipherTexts} -> + {Record, State#state{protocol_buffers = Buffers#protocol_buffers{tls_cipher_texts = CipherTexts}, + connection_states = ConnectionStates}}; + {#alert{} = Alert, ConnectionStates, CipherTexts} -> + {Alert, State#state{protocol_buffers = Buffers#protocol_buffers{tls_cipher_texts = CipherTexts}, + connection_states = ConnectionStates}} + end; next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = []}, protocol_specific = #{active_n_toggle := true, active_n := N} = ProtocolSpec, static_env = #static_env{socket = Socket, @@ -216,6 +217,22 @@ next_event(StateName, Record, State, Actions) -> {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} end. +decode_cipher_texts(_, Type, [] = CipherTexts, ConnectionStates, _, Acc) -> + {#ssl_tls{type = Type, fragment = Acc}, ConnectionStates, CipherTexts}; +decode_cipher_texts(Version, Type, + [#ssl_tls{type = Type} = CT | CipherTexts], ConnectionStates0, Check, Acc) -> + case tls_record:decode_cipher_text(Version, CT, ConnectionStates0, Check) of + {#ssl_tls{type = ?APPLICATION_DATA, fragment = Plain}, ConnectionStates} -> + decode_cipher_texts(Version, Type, CipherTexts, + ConnectionStates, Check, <<Acc/binary, Plain/binary>>); + {#ssl_tls{type = Type, fragment = Plain}, ConnectionStates} -> + {#ssl_tls{type = Type, fragment = Plain}, ConnectionStates, CipherTexts}; + #alert{} = Alert -> + {Alert, ConnectionStates0, CipherTexts} + end; +decode_cipher_texts(_, Type, CipherTexts, ConnectionStates, _, Acc) -> + {#ssl_tls{type = Type, fragment = Acc}, ConnectionStates, CipherTexts}. + %%% TLS record protocol level application data messages handle_protocol_record(#ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State0) -> @@ -248,8 +265,12 @@ handle_protocol_record(#ssl_tls{type = ?HANDSHAKE, fragment = Data}, connection -> ssl_connection:hibernate_after(StateName, State, Events); _ -> + HsEnv = State#state.handshake_env, {next_state, StateName, - State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} + State#state{protocol_buffers = Buffers, + handshake_env = + HsEnv#handshake_env{unprocessed_handshake_events + = unprocessed_events(Events)}}, Events} end end catch throw:#alert{} = Alert -> @@ -284,15 +305,17 @@ handle_protocol_record(#ssl_tls{type = _Unknown}, StateName, State) -> renegotiation(Pid, WriteState) -> gen_statem:call(Pid, {user_renegotiate, WriteState}). -renegotiate(#state{static_env = #static_env{role = client}} = State, Actions) -> +renegotiate(#state{static_env = #static_env{role = client}, + handshake_env = HsEnv} = State, Actions) -> %% Handle same way as if server requested %% the renegotiation Hs0 = ssl_handshake:init_handshake_history(), - {next_state, connection, State#state{tls_handshake_history = Hs0}, + {next_state, connection, State#state{handshake_env = HsEnv#handshake_env{tls_handshake_history = Hs0}}, [{next_event, internal, #hello_request{}} | Actions]}; renegotiate(#state{static_env = #static_env{role = server, socket = Socket, transport_cb = Transport}, + handshake_env = HsEnv, negotiated_version = Version, connection_states = ConnectionStates0} = State0, Actions) -> HelloRequest = ssl_handshake:hello_request(), @@ -303,30 +326,24 @@ renegotiate(#state{static_env = #static_env{role = server, send(Transport, Socket, BinMsg), State = State0#state{connection_states = ConnectionStates, - tls_handshake_history = Hs0}, + handshake_env = HsEnv#handshake_env{tls_handshake_history = Hs0}}, next_event(hello, no_record, State, Actions). send_handshake(Handshake, State) -> send_handshake_flight(queue_handshake(Handshake, State)). queue_handshake(Handshake, #state{negotiated_version = Version, - tls_handshake_history = Hist0, + handshake_env = #handshake_env{tls_handshake_history = Hist0} = HsEnv, flight_buffer = Flight0, connection_states = ConnectionStates0, ssl_options = SslOpts} = State0) -> {BinHandshake, ConnectionStates, Hist} = encode_handshake(Handshake, Version, ConnectionStates0, Hist0), - Report = #{direction => outbound, - protocol => 'tls_record', - message => BinHandshake}, - HandshakeMsg = #{direction => outbound, - protocol => 'handshake', - message => Handshake}, - ssl_logger:debug(SslOpts#ssl_options.log_level, HandshakeMsg, #{domain => [otp,ssl,handshake]}), - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'handshake', Handshake), + ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'tls_record', BinHandshake), State0#state{connection_states = ConnectionStates, - tls_handshake_history = Hist, + handshake_env = HsEnv#handshake_env{tls_handshake_history = Hist}, flight_buffer = Flight0 ++ [BinHandshake]}. send_handshake_flight(#state{static_env = #static_env{socket = Socket, @@ -341,10 +358,7 @@ queue_change_cipher(Msg, #state{negotiated_version = Version, ssl_options = SslOpts} = State0) -> {BinChangeCipher, ConnectionStates} = encode_change_cipher(Msg, Version, ConnectionStates0), - Report = #{direction => outbound, - protocol => 'tls_record', - message => BinChangeCipher}, - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'tls_record', BinChangeCipher), State0#state{connection_states = ConnectionStates, flight_buffer = Flight0 ++ [BinChangeCipher]}. @@ -354,14 +368,14 @@ reinit(#state{protocol_specific = #{sender := Sender}, tls_sender:update_connection_state(Sender, Write, Version), reinit_handshake_data(State). -reinit_handshake_data(State) -> +reinit_handshake_data(#state{handshake_env = HsEnv} =State) -> %% premaster_secret, public_key_info and tls_handshake_info %% are only needed during the handshake phase. %% To reduce memory foot print of a connection reinitialize them. State#state{ premaster_secret = undefined, public_key_info = undefined, - tls_handshake_history = ssl_handshake:init_handshake_history() + handshake_env = HsEnv#handshake_env{tls_handshake_history = ssl_handshake:init_handshake_history()} }. select_sni_extension(#client_hello{extensions = #{sni := SNI}}) -> @@ -393,10 +407,7 @@ send_alert(Alert, #state{negotiated_version = Version, {BinMsg, ConnectionStates} = encode_alert(Alert, Version, ConnectionStates0), send(Transport, Socket, BinMsg), - Report = #{direction => outbound, - protocol => 'tls_record', - message => BinMsg}, - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'tls_record', BinMsg), StateData0#state{connection_states = ConnectionStates}. %% If an ALERT sent in the connection state, should cause the TLS @@ -482,10 +493,10 @@ init({call, From}, {start, Timeout}, socket = Socket, session_cache = Cache, session_cache_cb = CacheCb}, + handshake_env = #handshake_env{renegotiation = {Renegotiation, _}} = HsEnv, ssl_options = SslOpts, session = #session{own_certificate = Cert} = Session0, - connection_states = ConnectionStates0, - renegotiation = {Renegotiation, _} + connection_states = ConnectionStates0 } = State0) -> KeyShare = maybe_generate_client_shares(SslOpts), Timer = ssl_connection:start_or_recv_cancel_timer(Timeout, From), @@ -497,19 +508,14 @@ init({call, From}, {start, Timeout}, {BinMsg, ConnectionStates, Handshake} = encode_handshake(Hello, HelloVersion, ConnectionStates0, Handshake0), send(Transport, Socket, BinMsg), - Report = #{direction => outbound, - protocol => 'tls_record', - message => BinMsg}, - HelloMsg = #{direction => outbound, - protocol => 'handshake', - message => Hello}, - ssl_logger:debug(SslOpts#ssl_options.log_level, HelloMsg, #{domain => [otp,ssl,handshake]}), - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'handshake', Hello), + ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'tls_record', BinMsg), + State = State0#state{connection_states = ConnectionStates, negotiated_version = HelloVersion, %% Requested version session = Session0#session{session_id = Hello#client_hello.session_id}, - tls_handshake_history = Handshake, + handshake_env = HsEnv#handshake_env{tls_handshake_history = Handshake}, start_or_recv_from = From, timer = Timer, key_share = KeyShare}, @@ -557,11 +563,12 @@ hello(internal, #client_hello{client_version = ClientVersion} = Hello, port = Port, session_cache = Cache, session_cache_cb = CacheCb}, + handshake_env = #handshake_env{renegotiation = {Renegotiation, _}} = HsEnv, session = #session{own_certificate = Cert} = Session0, - renegotiation = {Renegotiation, _}, negotiated_protocol = CurrentProtocol, key_algorithm = KeyExAlg, ssl_options = SslOpts} = State) -> + case choose_tls_version(SslOpts, Hello) of 'tls_v1.3' -> %% Continue in TLS 1.3 'start' state @@ -588,7 +595,8 @@ hello(internal, #client_hello{client_version = ClientVersion} = Hello, State#state{connection_states = ConnectionStates, negotiated_version = Version, hashsign_algorithm = HashSign, - client_hello_version = ClientVersion, + handshake_env = HsEnv#handshake_env{client_hello_version = + ClientVersion}, session = Session, negotiated_protocol = Protocol}) end @@ -597,7 +605,7 @@ hello(internal, #server_hello{} = Hello, #state{connection_states = ConnectionStates0, negotiated_version = ReqVersion, static_env = #static_env{role = client}, - renegotiation = {Renegotiation, _}, + handshake_env = #handshake_env{renegotiation = {Renegotiation, _}}, ssl_options = SslOptions} = State) -> case tls_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of #alert{} = Alert -> @@ -683,7 +691,7 @@ connection(internal, #hello_request{}, port = Port, session_cache = Cache, session_cache_cb = CacheCb}, - renegotiation = {Renegotiation, peer}, + handshake_env = #handshake_env{renegotiation = {Renegotiation, peer}}, session = #session{own_certificate = Cert} = Session0, ssl_options = SslOpts, protocol_specific = #{sender := Pid}, @@ -705,7 +713,7 @@ connection(internal, #hello_request{}, port = Port, session_cache = Cache, session_cache_cb = CacheCb}, - renegotiation = {Renegotiation, _}, + handshake_env = #handshake_env{renegotiation = {Renegotiation, _}}, session = #session{own_certificate = Cert} = Session0, ssl_options = SslOpts, connection_states = ConnectionStates} = State0) -> @@ -717,6 +725,7 @@ connection(internal, #hello_request{}, = Hello#client_hello.session_id}}, Actions); connection(internal, #client_hello{} = Hello, #state{static_env = #static_env{role = server}, + handshake_env = HsEnv, allow_renegotiate = true, connection_states = CS, protocol_specific = #{sender := Sender} @@ -730,7 +739,7 @@ connection(internal, #client_hello{} = Hello, {ok, Write} = tls_sender:renegotiate(Sender), next_event(hello, no_record, State#state{connection_states = CS#{current_write => Write}, allow_renegotiate = false, - renegotiation = {true, peer} + handshake_env = HsEnv#handshake_env{renegotiation = {true, peer}} }, [{next_event, internal, Hello}]); connection(internal, #client_hello{}, @@ -937,6 +946,10 @@ initial_state(Role, Sender, Host, Port, Socket, {SSLOptions, SocketOptions, Trac }, #state{ static_env = InitStatEnv, + handshake_env = #handshake_env{ + tls_handshake_history = ssl_handshake:init_handshake_history(), + renegotiation = {false, first} + }, socket_options = SocketOptions, ssl_options = SSLOptions, session = #session{is_resumable = new}, @@ -944,7 +957,6 @@ initial_state(Role, Sender, Host, Port, Socket, {SSLOptions, SocketOptions, Trac protocol_buffers = #protocol_buffers{}, user_application = {UserMonitor, User}, user_data_buffer = <<>>, - renegotiation = {false, first}, allow_renegotiate = SSLOptions#ssl_options.client_renegotiation, start_or_recv_from = undefined, flight_buffer = [], @@ -1073,6 +1085,13 @@ handle_alerts([], Result) -> Result; handle_alerts(_, {stop, _, _} = Stop) -> Stop; +handle_alerts([#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} | _Alerts], + {next_state, connection = StateName, #state{user_data_buffer = Buffer, + socket_options = #socket_options{active = false}, + protocol_buffers = #protocol_buffers{tls_cipher_texts = CTs}} = + State}) when (Buffer =/= <<>>) orelse + (CTs =/= []) -> + {next_state, StateName, State#state{terminated = true}}; handle_alerts([Alert | Alerts], {next_state, StateName, State}) -> handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)); handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) -> diff --git a/lib/ssl/src/tls_connection_1_3.erl b/lib/ssl/src/tls_connection_1_3.erl index 9ff84c703b..48b3ff0d97 100644 --- a/lib/ssl/src/tls_connection_1_3.erl +++ b/lib/ssl/src/tls_connection_1_3.erl @@ -134,67 +134,36 @@ start(internal, end. -%% TODO: move these functions + +%% TODO: remove suppression when function implemented! +-dialyzer([{nowarn_function, [negotiated/4]}, no_match]). +negotiated(internal, Map, State0, _Module) -> + case tls_handshake_1_3:do_negotiated(Map, State0) of + #alert{} = Alert -> + ssl_connection:handle_own_alert(Alert, {3,4}, negotiated, State0); + M -> + %% TODO: implement update_state + %% State = update_state(State0, M), + {next_state, wait_flight2, State0, [{next_event, internal, M}]} + + end. + + update_state(#state{connection_states = ConnectionStates0, session = Session} = State, - #{client_random := ClientRandom, - cipher := Cipher, + #{cipher := Cipher, key_share := KeyShare, session_id := SessionId}) -> #{security_parameters := SecParamsR0} = PendingRead = maps:get(pending_read, ConnectionStates0), #{security_parameters := SecParamsW0} = PendingWrite = maps:get(pending_write, ConnectionStates0), - SecParamsR = ssl_cipher:security_parameters_1_3(SecParamsR0, ClientRandom, Cipher), - SecParamsW = ssl_cipher:security_parameters_1_3(SecParamsW0, ClientRandom, Cipher), + SecParamsR = ssl_cipher:security_parameters_1_3(SecParamsR0, Cipher), + SecParamsW = ssl_cipher:security_parameters_1_3(SecParamsW0, Cipher), ConnectionStates = ConnectionStates0#{pending_read => PendingRead#{security_parameters => SecParamsR}, pending_write => PendingWrite#{security_parameters => SecParamsW}}, State#state{connection_states = ConnectionStates, key_share = KeyShare, - session = Session#session{session_id = SessionId}}. - - -negotiated(internal, - Map, - #state{connection_states = ConnectionStates0, - session = #session{session_id = SessionId}, - ssl_options = #ssl_options{} = SslOpts, - key_share = KeyShare, - tls_handshake_history = HHistory0, - static_env = #static_env{socket = Socket, - transport_cb = Transport}}, _Module) -> - - %% Create server_hello - %% Extensions: supported_versions, key_share, (pre_shared_key) - ServerHello = tls_handshake_1_3:server_hello(SessionId, KeyShare, - ConnectionStates0, Map), - - %% Update handshake_history (done in encode!) - %% Encode handshake - {BinMsg, _ConnectionStates, _HHistory} = - tls_connection:encode_handshake(ServerHello, {3,4}, ConnectionStates0, HHistory0), - %% Send server_hello - tls_connection:send(Transport, Socket, BinMsg), - Report = #{direction => outbound, - protocol => 'tls_record', - message => BinMsg}, - Msg = #{direction => outbound, - protocol => 'handshake', - message => ServerHello}, - ssl_logger:debug(SslOpts#ssl_options.log_level, Msg, #{domain => [otp,ssl,handshake]}), - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), - ok. - - %% K_send = handshake ??? - %% (Send EncryptedExtensions) - %% ([Send CertificateRequest]) - %% [Send Certificate + CertificateVerify] - %% Send Finished - %% K_send = application ??? - - %% Will be called implicitly - %% {Record, State} = Connection:next_record(State2#state{session = Session}), - %% Connection:next_event(wait_flight2, Record, State, Actions), - %% OR - %% Connection:next_event(WAIT_EOED, Record, State, Actions) + session = Session#session{session_id = SessionId}, + negotiated_version = {3,4}}. diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index 644763651f..eee2437bfd 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -232,7 +232,8 @@ hello(#client_hello{client_version = ClientVersion, %%-------------------------------------------------------------------- %%-------------------------------------------------------------------- --spec encode_handshake(tls_handshake(), tls_record:tls_version()) -> iolist(). +-spec encode_handshake(tls_handshake() | tls_handshake_1_3:tls_handshake_1_3(), + tls_record:tls_version()) -> iolist(). %% %% Description: Encode a handshake packet %%-------------------------------------------------------------------- @@ -387,10 +388,7 @@ get_tls_handshake_aux(Version, <<?BYTE(Type), ?UINT24(Length), Raw = <<?BYTE(Type), ?UINT24(Length), Body/binary>>, try decode_handshake(Version, Type, Body) of Handshake -> - Report = #{direction => inbound, - protocol => 'handshake', - message => Handshake}, - ssl_logger:debug(Opts#ssl_options.log_level, Report, #{domain => [otp,ssl,handshake]}), + ssl_logger:debug(Opts#ssl_options.log_level, inbound, 'handshake', Handshake), get_tls_handshake_aux(Version, Rest, Opts, [{Handshake,Raw} | Acc]) catch _:_ -> @@ -401,14 +399,15 @@ get_tls_handshake_aux(_Version, Data, _, Acc) -> decode_handshake({3, N}, ?HELLO_REQUEST, <<>>) when N < 4 -> #hello_request{}; -decode_handshake(Version, ?CLIENT_HELLO, +decode_handshake(Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SID_length), Session_ID:SID_length/binary, ?UINT16(Cs_length), CipherSuites:Cs_length/binary, ?BYTE(Cm_length), Comp_methods:Cm_length/binary, Extensions/binary>>) -> Exts = ssl_handshake:decode_vector(Extensions), - DecodedExtensions = ssl_handshake:decode_hello_extensions(Exts, Version, client_hello), + DecodedExtensions = ssl_handshake:decode_hello_extensions(Exts, Version, {Major, Minor}, + client_hello), #client_hello{ client_version = {Major,Minor}, random = Random, diff --git a/lib/ssl/src/tls_handshake_1_3.erl b/lib/ssl/src/tls_handshake_1_3.erl index f381e038cf..f92c54dc53 100644 --- a/lib/ssl/src/tls_handshake_1_3.erl +++ b/lib/ssl/src/tls_handshake_1_3.erl @@ -27,6 +27,8 @@ -include("tls_handshake_1_3.hrl"). -include("ssl_alert.hrl"). +-include("ssl_cipher.hrl"). +-include("ssl_connection.hrl"). -include("ssl_internal.hrl"). -include("ssl_record.hrl"). -include_lib("public_key/include/public_key.hrl"). @@ -38,7 +40,12 @@ -export([handle_client_hello/3]). %% Create handshake messages --export([server_hello/4]). +-export([certificate/5, + certificate_verify/4, + encrypted_extensions/0, + server_hello/4]). + +-export([do_negotiated/2]). %%==================================================================== %% Create handshake messages @@ -50,8 +57,7 @@ server_hello(SessionId, KeyShare, ConnectionStates, _Map) -> Extensions = server_hello_extensions(KeyShare), #server_hello{server_version = {3,3}, %% legacy_version cipher_suite = SecParams#security_parameters.cipher_suite, - compression_method = - SecParams#security_parameters.compression_algorithm, + compression_method = 0, %% legacy attribute random = SecParams#security_parameters.server_random, session_id = SessionId, extensions = Extensions @@ -62,6 +68,97 @@ server_hello_extensions(KeyShare) -> Extensions = #{server_hello_selected_version => SupportedVersions}, ssl_handshake:add_server_share(Extensions, KeyShare). +%% TODO: implement support for encrypted_extensions +encrypted_extensions() -> + #encrypted_extensions{ + extensions = #{} + }. + +%% TODO: use maybe monad for error handling! +%% enum { +%% X509(0), +%% RawPublicKey(2), +%% (255) +%% } CertificateType; +%% +%% struct { +%% select (certificate_type) { +%% case RawPublicKey: +%% /* From RFC 7250 ASN.1_subjectPublicKeyInfo */ +%% opaque ASN1_subjectPublicKeyInfo<1..2^24-1>; +%% +%% case X509: +%% opaque cert_data<1..2^24-1>; +%% }; +%% Extension extensions<0..2^16-1>; +%% } CertificateEntry; +%% +%% struct { +%% opaque certificate_request_context<0..2^8-1>; +%% CertificateEntry certificate_list<0..2^24-1>; +%% } Certificate; +certificate(OwnCert, CertDbHandle, CertDbRef, _CRContext, server) -> + case ssl_certificate:certificate_chain(OwnCert, CertDbHandle, CertDbRef) of + {ok, _, Chain} -> + CertList = chain_to_cert_list(Chain), + %% If this message is in response to a CertificateRequest, the value of + %% certificate_request_context in that message. Otherwise (in the case + %%of server authentication), this field SHALL be zero length. + #certificate_1_3{ + certificate_request_context = <<>>, + certificate_list = CertList}; + {error, Error} -> + ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {server_has_no_suitable_certificates, Error}) + end. + + +certificate_verify(PrivateKey, SignatureScheme, + #state{connection_states = ConnectionStates, + handshake_env = + #handshake_env{ + tls_handshake_history = {Messages, _}}}, server) -> + #{security_parameters := SecParamsR} = + ssl_record:pending_connection_state(ConnectionStates, write), + #security_parameters{prf_algorithm = HKDFAlgo} = SecParamsR, + + {HashAlgo, _, _} = + ssl_cipher:scheme_to_components(SignatureScheme), + + Context = lists:reverse(Messages), + + %% Transcript-Hash uses the HKDF hash function defined by the cipher suite. + THash = tls_v1:transcript_hash(Context, HKDFAlgo), + + %% Digital signatures use the hash function defined by the selected signature + %% scheme. + case digitally_sign(THash, <<"TLS 1.3, server CertificateVerify">>, + HashAlgo, PrivateKey) of + {ok, Signature} -> + {ok, #certificate_verify_1_3{ + algorithm = SignatureScheme, + signature = Signature + }}; + {error, badarg} -> + {error, badarg} + + end. + + +finished(#state{connection_states = ConnectionStates, + handshake_env = + #handshake_env{ + tls_handshake_history = {Messages, _}}}) -> + #{security_parameters := SecParamsR} = + ssl_record:current_connection_state(ConnectionStates, write), + #security_parameters{prf_algorithm = HKDFAlgo, + master_secret = SHTS} = SecParamsR, + + FinishedKey = tls_v1:finished_key(SHTS, HKDFAlgo), + VerifyData = tls_v1:finished_verify_data(FinishedKey, HKDFAlgo, Messages), + + #finished{ + verify_data = VerifyData + }. %%==================================================================== @@ -76,10 +173,16 @@ encode_handshake(#certificate_request_1_3{ {?CERTIFICATE_REQUEST, <<EncContext/binary, BinExts/binary>>}; encode_handshake(#certificate_1_3{ certificate_request_context = Context, - entries = Entries}) -> + certificate_list = Entries}) -> EncContext = encode_cert_req_context(Context), EncEntries = encode_cert_entries(Entries), {?CERTIFICATE, <<EncContext/binary, EncEntries/binary>>}; +encode_handshake(#certificate_verify_1_3{ + algorithm = Algorithm, + signature = Signature}) -> + EncAlgo = encode_algorithm(Algorithm), + EncSign = encode_signature(Signature), + {?CERTIFICATE_VERIFY, <<EncAlgo/binary, EncSign/binary>>}; encode_handshake(#encrypted_extensions{extensions = Exts})-> {?ENCRYPTED_EXTENSIONS, encode_extensions(Exts)}; encode_handshake(#new_session_ticket{ @@ -120,15 +223,20 @@ decode_handshake(?CERTIFICATE, <<?BYTE(0), ?UINT24(Size), Certs:Size/binary>>) - CertList = decode_cert_entries(Certs), #certificate_1_3{ certificate_request_context = <<>>, - entries = CertList + certificate_list = CertList }; decode_handshake(?CERTIFICATE, <<?BYTE(CSize), Context:CSize/binary, ?UINT24(Size), Certs:Size/binary>>) -> CertList = decode_cert_entries(Certs), #certificate_1_3{ certificate_request_context = Context, - entries = CertList + certificate_list = CertList }; +decode_handshake(?CERTIFICATE_VERIFY, <<?UINT16(EncAlgo), ?UINT16(Size), Signature:Size/binary>>) -> + Algorithm = ssl_cipher:signature_scheme(EncAlgo), + #certificate_verify_1_3{ + algorithm = Algorithm, + signature = Signature}; decode_handshake(?ENCRYPTED_EXTENSIONS, <<?UINT16(Size), EncExts:Size/binary>>) -> #encrypted_extensions{ extensions = decode_extensions(EncExts, encrypted_extensions) @@ -169,9 +277,16 @@ encode_cert_entries([#certificate_entry{data = Data, extensions = Exts} | Rest], Acc) -> DSize = byte_size(Data), BinExts = encode_extensions(Exts), - ExtSize = byte_size(BinExts), encode_cert_entries(Rest, - [<<?UINT24(DSize), Data/binary, ?UINT16(ExtSize), BinExts/binary>> | Acc]). + [<<?UINT24(DSize), Data/binary, BinExts/binary>> | Acc]). + +encode_algorithm(Algo) -> + Scheme = ssl_cipher:signature_scheme(Algo), + <<?UINT16(Scheme)>>. + +encode_signature(Signature) -> + Size = byte_size(Signature), + <<?UINT16(Size), Signature/binary>>. decode_cert_entries(Entries) -> decode_cert_entries(Entries, []). @@ -193,12 +308,64 @@ extensions_list(HelloExtensions) -> [Ext || {_, Ext} <- maps:to_list(HelloExtensions)]. +%% TODO: add extensions! +chain_to_cert_list(L) -> + chain_to_cert_list(L, []). +%% +chain_to_cert_list([], Acc) -> + lists:reverse(Acc); +chain_to_cert_list([H|T], Acc) -> + chain_to_cert_list(T, [certificate_entry(H)|Acc]). + + +certificate_entry(DER) -> + #certificate_entry{ + data = DER, + extensions = #{} %% Extensions not supported. + }. + +%% The digital signature is then computed over the concatenation of: +%% - A string that consists of octet 32 (0x20) repeated 64 times +%% - The context string +%% - A single 0 byte which serves as the separator +%% - The content to be signed +%% +%% For example, if the transcript hash was 32 bytes of 01 (this length +%% would make sense for SHA-256), the content covered by the digital +%% signature for a server CertificateVerify would be: +%% +%% 2020202020202020202020202020202020202020202020202020202020202020 +%% 2020202020202020202020202020202020202020202020202020202020202020 +%% 544c5320312e332c207365727665722043657274696669636174655665726966 +%% 79 +%% 00 +%% 0101010101010101010101010101010101010101010101010101010101010101 +digitally_sign(THash, Context, HashAlgo, PrivateKey) -> + Content = build_content(Context, THash), + + %% The length of the Salt MUST be equal to the length of the output + %% of the digest algorithm: rsa_pss_saltlen = -1 + try public_key:sign(Content, HashAlgo, PrivateKey, + [{rsa_padding, rsa_pkcs1_pss_padding}, + {rsa_pss_saltlen, -1}, + {rsa_mgf1_md, HashAlgo}]) of + Signature -> + {ok, Signature} + catch + error:badarg -> + {error, badarg} + end. + + +build_content(Context, THash) -> + Prefix = binary:copy(<<32>>, 64), + <<Prefix/binary,Context/binary,?BYTE(0),THash/binary>>. + %%==================================================================== %% Handle handshake messages %%==================================================================== handle_client_hello(#client_hello{cipher_suites = ClientCiphers, - random = Random, session_id = SessionId, extensions = Extensions} = _Hello, #ssl_options{ciphers = ServerCiphers, @@ -233,26 +400,24 @@ handle_client_hello(#client_hello{cipher_suites = ClientCiphers, Cipher = Maybe(select_cipher_suite(ClientCiphers, ServerCiphers)), Group = Maybe(select_server_group(ServerGroups, ClientGroups)), Maybe(validate_key_share(ClientGroups, ClientShares)), - _ClientPubKey = Maybe(get_client_public_key(Group, ClientShares)), - %% Handle certificate - {PublicKeyAlgo, SignAlgo} = get_certificate_params(Cert), + ClientPubKey = Maybe(get_client_public_key(Group, ClientShares)), + + {PublicKeyAlgo, SignAlgo, SignHash} = get_certificate_params(Cert), %% Check if client supports signature algorithm of server certificate - Maybe(check_cert_sign_algo(SignAlgo, ClientSignAlgs, ClientSignAlgsCert)), + Maybe(check_cert_sign_algo(SignAlgo, SignHash, ClientSignAlgs, ClientSignAlgsCert)), - %% Check if server supports + %% Select signature algorithm (used in CertificateVerify message). SelectedSignAlg = Maybe(select_sign_algo(PublicKeyAlgo, ClientSignAlgs, ServerSignAlgs)), %% Generate server_share KeyShare = ssl_cipher:generate_server_share(Group), - _Ret = #{cipher => Cipher, group => Group, sign_alg => SelectedSignAlg, - %% client_share => ClientPubKey, + client_share => ClientPubKey, key_share => KeyShare, - client_random => Random, session_id => SessionId} %% TODO: @@ -265,9 +430,9 @@ handle_client_hello(#client_hello{cipher_suites = ClientCiphers, ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_groups); {Ref, illegal_parameter} -> ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER); - {Ref, {client_hello_retry_request, _Group0}} -> + {Ref, {hello_retry_request, _Group0}} -> %% TODO - exit({client_hello_retry_request, not_implemented}); + ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, "hello_retry_request not implemented"); {Ref, no_suitable_cipher} -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_cipher); {Ref, {insufficient_security, no_suitable_signature_algorithm}} -> @@ -277,6 +442,186 @@ handle_client_hello(#client_hello{cipher_suites = ClientCiphers, end. +do_negotiated(#{client_share := ClientKey, + group := SelectedGroup, + sign_alg := SignatureScheme + } = Map, + #state{connection_states = ConnectionStates0, + session = #session{session_id = SessionId, + own_certificate = OwnCert}, + ssl_options = #ssl_options{} = _SslOpts, + key_share = KeyShare, + handshake_env = #handshake_env{tls_handshake_history = _HHistory0}, + private_key = CertPrivateKey, + static_env = #static_env{ + cert_db = CertDbHandle, + cert_db_ref = CertDbRef, + socket = _Socket, + transport_cb = _Transport} + } = State0) -> + {Ref,Maybe} = maybe(), + + try + %% Create server_hello + %% Extensions: supported_versions, key_share, (pre_shared_key) + ServerHello = server_hello(SessionId, KeyShare, ConnectionStates0, Map), + + {State1, _} = tls_connection:send_handshake(ServerHello, State0), + + {HandshakeSecret, ReadKey, ReadIV, WriteKey, WriteIV} = + calculate_security_parameters(ClientKey, SelectedGroup, KeyShare, State1), + + State2 = + update_pending_connection_states(State1, HandshakeSecret, + ReadKey, ReadIV, WriteKey, WriteIV), + + State3 = ssl_record:step_encryption_state(State2), + + %% Create EncryptedExtensions + EncryptedExtensions = encrypted_extensions(), + + %% Encode EncryptedExtensions + State4 = tls_connection:queue_handshake(EncryptedExtensions, State3), + + %% Create Certificate + Certificate = certificate(OwnCert, CertDbHandle, CertDbRef, <<>>, server), + + %% Encode Certificate + State5 = tls_connection:queue_handshake(Certificate, State4), + + %% Create CertificateVerify + CertificateVerify = Maybe(certificate_verify(CertPrivateKey, SignatureScheme, + State5, server)), + %% Encode CertificateVerify + State6 = tls_connection:queue_handshake(CertificateVerify, State5), + + %% Create Finished + Finished = finished(State6), + + %% Encode Certificate, CertifricateVerify + {_State7, _} = tls_connection:send_handshake(Finished, State6), + + %% Send finished + + %% Next record/Next event + + Maybe(not_implemented(negotiated)) + + + catch + {Ref, {state_not_implemented, State}} -> + %% TODO + ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {state_not_implemented, State}) + end. + + +%% TODO: Remove this function! +not_implemented(State) -> + {error, {state_not_implemented, State}}. + + +calculate_security_parameters(ClientKey, SelectedGroup, KeyShare, + #state{connection_states = ConnectionStates, + handshake_env = + #handshake_env{ + tls_handshake_history = HHistory}}) -> + #{security_parameters := SecParamsR} = + ssl_record:pending_connection_state(ConnectionStates, read), + #security_parameters{prf_algorithm = HKDFAlgo, + cipher_suite = CipherSuite} = SecParamsR, + + %% Calculate handshake_secret + PSK = binary:copy(<<0>>, ssl_cipher:hash_size(HKDFAlgo)), + EarlySecret = tls_v1:key_schedule(early_secret, HKDFAlgo , {psk, PSK}), + PrivateKey = get_server_private_key(KeyShare), %% #'ECPrivateKey'{} + + IKM = calculate_shared_secret(ClientKey, PrivateKey, SelectedGroup), + HandshakeSecret = tls_v1:key_schedule(handshake_secret, HKDFAlgo, IKM, EarlySecret), + + %% Calculate [sender]_handshake_traffic_secret + {Messages, _} = HHistory, + ClientHSTrafficSecret = + tls_v1:client_handshake_traffic_secret(HKDFAlgo, HandshakeSecret, lists:reverse(Messages)), + ServerHSTrafficSecret = + tls_v1:server_handshake_traffic_secret(HKDFAlgo, HandshakeSecret, lists:reverse(Messages)), + + %% Calculate traffic keys + #{cipher := Cipher} = ssl_cipher_format:suite_definition(CipherSuite), + {ReadKey, ReadIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ClientHSTrafficSecret), + {WriteKey, WriteIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ServerHSTrafficSecret), + + %% TODO: store all relevant secrets in state! + {ServerHSTrafficSecret, ReadKey, ReadIV, WriteKey, WriteIV}. + + %% %% Update pending connection state + %% PendingRead0 = ssl_record:pending_connection_state(ConnectionStates, read), + %% PendingWrite0 = ssl_record:pending_connection_state(ConnectionStates, write), + + %% PendingRead = update_conn_state(PendingRead0, HandshakeSecret, ReadKey, ReadIV), + %% PendingWrite = update_conn_state(PendingWrite0, HandshakeSecret, WriteKey, WriteIV), + + %% %% Update pending and copy to current (activate) + %% %% All subsequent handshake messages are encrypted + %% %% ([sender]_handshake_traffic_secret) + %% #{current_read => PendingRead, + %% current_write => PendingWrite, + %% pending_read => PendingRead, + %% pending_write => PendingWrite}. + + +get_server_private_key(#key_share_server_hello{server_share = ServerShare}) -> + get_private_key(ServerShare). + +get_private_key(#key_share_entry{ + key_exchange = #'ECPrivateKey'{} = PrivateKey}) -> + PrivateKey; +get_private_key(#key_share_entry{ + key_exchange = + {_, PrivateKey}}) -> + PrivateKey. + +%% X25519, X448 +calculate_shared_secret(OthersKey, MyKey, Group) + when is_binary(OthersKey) andalso is_binary(MyKey) andalso + (Group =:= x25519 orelse Group =:= x448)-> + crypto:compute_key(ecdh, OthersKey, MyKey, Group); +%% FFDHE +calculate_shared_secret(OthersKey, MyKey, Group) + when is_binary(OthersKey) andalso is_binary(MyKey) -> + Params = #'DHParameter'{prime = P} = ssl_dh_groups:dh_params(Group), + S = public_key:compute_key(OthersKey, MyKey, Params), + Size = byte_size(binary:encode_unsigned(P)), + ssl_cipher:add_zero_padding(S, Size); +%% ECDHE +calculate_shared_secret(OthersKey, MyKey = #'ECPrivateKey'{}, _Group) + when is_binary(OthersKey) -> + Point = #'ECPoint'{point = OthersKey}, + public_key:compute_key(Point, MyKey). + + +update_pending_connection_states(#state{connection_states = + CS = #{pending_read := PendingRead0, + pending_write := PendingWrite0}} = State, + HandshakeSecret, ReadKey, ReadIV, WriteKey, WriteIV) -> + PendingRead = update_connection_state(PendingRead0, HandshakeSecret, ReadKey, ReadIV), + PendingWrite = update_connection_state(PendingWrite0, HandshakeSecret, WriteKey, WriteIV), + State#state{connection_states = CS#{pending_read => PendingRead, + pending_write => PendingWrite}}. + +update_connection_state(ConnectionState = #{security_parameters := SecurityParameters0}, + HandshakeSecret, Key, IV) -> + %% Store secret + SecurityParameters = SecurityParameters0#security_parameters{ + master_secret = HandshakeSecret}, + ConnectionState#{security_parameters => SecurityParameters, + cipher_state => cipher_init(Key, IV)}. + + + +cipher_init(Key, IV) -> + #cipher_state{key = Key, iv = IV, tag_len = 16}. + + %% If there is no overlap between the received %% "supported_groups" and the groups supported by the server, then the %% server MUST abort the handshake with a "handshake_failure" or an @@ -324,14 +669,20 @@ get_client_public_key(Group, ClientShares) -> {value, {_, _, ClientPublicKey}} -> {ok, ClientPublicKey}; false -> - %% ClientHelloRetryRequest - {error, {client_hello_retry_request, Group}} + %% 4.1.4. Hello Retry Request + %% + %% The server will send this message in response to a ClientHello + %% message if it is able to find an acceptable set of parameters but the + %% ClientHello does not contain sufficient information to proceed with + %% the handshake. + {error, {hello_retry_request, Group}} end. select_cipher_suite([], _) -> {error, no_suitable_cipher}; select_cipher_suite([Cipher|ClientCiphers], ServerCiphers) -> - case lists:member(Cipher, ServerCiphers) of + case lists:member(Cipher, tls_v1:suites('TLS_v1.3')) andalso + lists:member(Cipher, ServerCiphers) of true -> {ok, Cipher}; false -> @@ -349,22 +700,28 @@ select_cipher_suite([Cipher|ClientCiphers], ServerCiphers) -> %% If no "signature_algorithms_cert" extension is %% present, then the "signature_algorithms" extension also applies to %% signatures appearing in certificates. -check_cert_sign_algo(SignAlgo, ClientSignAlgs, undefined) -> - maybe_lists_member(SignAlgo, ClientSignAlgs, - {insufficient_security, no_suitable_signature_algorithm}); -check_cert_sign_algo(SignAlgo, _, ClientSignAlgsCert) -> - maybe_lists_member(SignAlgo, ClientSignAlgsCert, - {insufficient_security, no_suitable_signature_algorithm}). + +%% Check if the signature algorithm of the server certificate is supported +%% by the client. +check_cert_sign_algo(SignAlgo, SignHash, ClientSignAlgs, undefined) -> + do_check_cert_sign_algo(SignAlgo, SignHash, ClientSignAlgs); +check_cert_sign_algo(SignAlgo, SignHash, _, ClientSignAlgsCert) -> + do_check_cert_sign_algo(SignAlgo, SignHash, ClientSignAlgsCert). %% DSA keys are not supported by TLS 1.3 select_sign_algo(dsa, _ClientSignAlgs, _ServerSignAlgs) -> {error, {insufficient_security, no_suitable_public_key}}; -%% TODO: Implement check for ellipctic curves! +%% TODO: Implement support for ECDSA keys! +select_sign_algo(_, [], _) -> + {error, {insufficient_security, no_suitable_signature_algorithm}}; select_sign_algo(PublicKeyAlgo, [C|ClientSignAlgs], ServerSignAlgs) -> {_, S, _} = ssl_cipher:scheme_to_components(C), - case PublicKeyAlgo =:= rsa andalso - ((S =:= rsa_pkcs1) orelse (S =:= rsa_pss_rsae) orelse (S =:= rsa_pss_pss)) andalso + %% RSASSA-PKCS1-v1_5 and Legacy algorithms are not defined for use in signed + %% TLS handshake messages: filter sha-1 and rsa_pkcs1. + case ((PublicKeyAlgo =:= rsa andalso S =:= rsa_pss_rsae) + orelse (PublicKeyAlgo =:= rsa_pss andalso S =:= rsa_pss_rsae)) + andalso lists:member(C, ServerSignAlgs) of true -> {ok, C}; @@ -373,51 +730,51 @@ select_sign_algo(PublicKeyAlgo, [C|ClientSignAlgs], ServerSignAlgs) -> end. -maybe_lists_member(Elem, List, Error) -> - case lists:member(Elem, List) of +do_check_cert_sign_algo(_, _, []) -> + {error, {insufficient_security, no_suitable_signature_algorithm}}; +do_check_cert_sign_algo(SignAlgo, SignHash, [Scheme|T]) -> + {Hash, Sign, _Curve} = ssl_cipher:scheme_to_components(Scheme), + case compare_sign_algos(SignAlgo, SignHash, Sign, Hash) of true -> ok; - false -> - {error, Error} + _Else -> + do_check_cert_sign_algo(SignAlgo, SignHash, T) end. -%% TODO: test with ecdsa, rsa_pss_rsae, rsa_pss_pss + +%% id-RSASSA-PSS (rsa_pss) indicates that the key may only be used for PSS signatures. +%% TODO: Uncomment when rsa_pss signatures are supported in certificates +%% compare_sign_algos(rsa_pss, Hash, Algo, Hash) +%% when Algo =:= rsa_pss_pss -> +%% true; +%% rsaEncryption (rsa) allows the key to be used for any of the standard encryption or +%% signature schemes. +compare_sign_algos(rsa, Hash, Algo, Hash) + when Algo =:= rsa_pss_rsae orelse + Algo =:= rsa_pkcs1 -> + true; +compare_sign_algos(Algo, Hash, Algo, Hash) -> + true; +compare_sign_algos(_, _, _, _) -> + false. + + get_certificate_params(Cert) -> {SignAlgo0, _Param, PublicKeyAlgo0} = ssl_handshake:get_cert_params(Cert), - SignAlgo = public_key:pkix_sign_types(SignAlgo0), + {SignHash0, SignAlgo} = public_key:pkix_sign_types(SignAlgo0), + %% Convert hash to new format + SignHash = case SignHash0 of + sha -> + sha1; + H -> H + end, PublicKeyAlgo = public_key_algo(PublicKeyAlgo0), - Scheme = sign_algo_to_scheme(SignAlgo), - {PublicKeyAlgo, Scheme}. - -sign_algo_to_scheme({Hash0, Sign0}) -> - SupportedSchemes = tls_v1:default_signature_schemes({3,4}), - Hash = case Hash0 of - sha -> - sha1; - H -> - H - end, - Sign = case Sign0 of - rsa -> - rsa_pkcs1; - S -> - S - end, - sign_algo_to_scheme(Hash, Sign, SupportedSchemes). -%% -sign_algo_to_scheme(_, _, []) -> - not_found; -sign_algo_to_scheme(H, S, [Scheme|T]) -> - {Hash, Sign, _Curve} = ssl_cipher:scheme_to_components(Scheme), - case H =:= Hash andalso S =:= Sign of - true -> - Scheme; - false -> - sign_algo_to_scheme(H, S, T) - end. + {PublicKeyAlgo, SignAlgo, SignHash}. %% Note: copied from ssl_handshake +public_key_algo(?'id-RSASSA-PSS') -> + rsa_pss; public_key_algo(?rsaEncryption) -> rsa; public_key_algo(?'id-ecPublicKey') -> diff --git a/lib/ssl/src/tls_handshake_1_3.hrl b/lib/ssl/src/tls_handshake_1_3.hrl index 6ef5364399..7ae1b93e1c 100644 --- a/lib/ssl/src/tls_handshake_1_3.hrl +++ b/lib/ssl/src/tls_handshake_1_3.hrl @@ -191,7 +191,7 @@ %% case RawPublicKey: %% /* From RFC 7250 ASN.1_subjectPublicKeyInfo */ %% opaque ASN1_subjectPublicKeyInfo<1..2^24-1>; - + %% %% case X509: %% opaque cert_data<1..2^24-1>; %% }; @@ -200,9 +200,14 @@ -record(certificate_1_3, { certificate_request_context, % opaque certificate_request_context<0..2^8-1>; - entries % CertificateEntry certificate_list<0..2^24-1>; + certificate_list % CertificateEntry certificate_list<0..2^24-1>; }). +-record(certificate_verify_1_3, { + algorithm, % SignatureScheme + signature % signature<0..2^16-1> + }). + %% RFC 8446 B.3.4. Ticket Establishment -record(new_session_ticket, { ticket_lifetime, %unit32 @@ -223,4 +228,11 @@ request_update }). +-type tls_handshake_1_3() :: #encrypted_extensions{} | + #certificate_request_1_3{} | + #certificate_1_3{} | + #certificate_verify_1_3{}. + +-export_type([tls_handshake_1_3/0]). + -endif. % -ifdef(tls_handshake_1_3). diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index b8bf4603dd..ad2bfb7a5c 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -404,10 +404,7 @@ get_tls_records_aux({MajVer, MinVer} = Version, <<?BYTE(Type),?BYTE(MajVer),?BYT Type == ?HANDSHAKE; Type == ?ALERT; Type == ?CHANGE_CIPHER_SPEC -> - Report = #{direction => inbound, - protocol => 'tls_record', - message => [RawTLSRecord]}, - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(SslOpts#ssl_options.log_level, inbound, 'tls_record', [RawTLSRecord]), get_tls_records_aux(Version, Rest, [#ssl_tls{type = Type, version = Version, fragment = Data} | Acc], SslOpts); @@ -423,10 +420,7 @@ get_tls_records_aux(Versions, <<?BYTE(Type),?BYTE(MajVer),?BYTE(MinVer), (Type == ?CHANGE_CIPHER_SPEC)) -> case is_acceptable_version({MajVer, MinVer}, Versions) of true -> - Report = #{direction => inbound, - protocol => 'tls_record', - message => [RawTLSRecord]}, - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(SslOpts#ssl_options.log_level, inbound, 'tls_record', [RawTLSRecord]), get_tls_records_aux(Versions, Rest, [#ssl_tls{type = Type, version = {MajVer, MinVer}, fragment = Data} | Acc], SslOpts); diff --git a/lib/ssl/src/tls_record_1_3.erl b/lib/ssl/src/tls_record_1_3.erl index d424336187..1681babed9 100644 --- a/lib/ssl/src/tls_record_1_3.erl +++ b/lib/ssl/src/tls_record_1_3.erl @@ -76,8 +76,8 @@ encode_data(Frag, ConnectionStates) -> encode_plain_text(Type, Data0, #{current_write := Write0} = ConnectionStates) -> PadLen = 0, %% TODO where to specify PadLen? Data = inner_plaintext(Type, Data0, PadLen), - {CipherFragment, Write1} = encode_plain_text(Data, Write0), - {CipherText, Write} = encode_tls_cipher_text(CipherFragment, Write1), + CipherFragment = encode_plain_text(Data, Write0), + {CipherText, Write} = encode_tls_cipher_text(CipherFragment, Write0), {CipherText, ConnectionStates#{current_write => Write}}. encode_iolist(Type, Data, ConnectionStates0) -> @@ -105,24 +105,23 @@ decode_cipher_text(#ssl_tls{type = ?OPAQUE_TYPE, fragment = CipherFragment}, #{current_read := #{sequence_number := Seq, - cipher_state := CipherS0, + cipher_state := #cipher_state{key = Key, + iv = IV, + tag_len = TagLen}, security_parameters := #security_parameters{ cipher_type = ?AEAD, bulk_cipher_algorithm = BulkCipherAlgo} } = ReadState0} = ConnectionStates0) -> - AAD = start_additional_data(), - CipherS1 = ssl_cipher:nonce_seed(<<?UINT64(Seq)>>, CipherS0), - case decipher_aead(BulkCipherAlgo, CipherS1, AAD, CipherFragment) of - {PlainFragment, CipherS1} -> + case decipher_aead(CipherFragment, BulkCipherAlgo, Key, Seq, IV, TagLen) of + #alert{} = Alert -> + Alert; + PlainFragment -> ConnectionStates = ConnectionStates0#{current_read => - ReadState0#{cipher_state => CipherS1, - sequence_number => Seq + 1}}, - decode_inner_plaintext(PlainFragment, ConnectionStates); - #alert{} = Alert -> - Alert + ReadState0#{sequence_number => Seq + 1}}, + {decode_inner_plaintext(PlainFragment), ConnectionStates} end; decode_cipher_text(#ssl_tls{type = Type, version = ?LEGACY_VERSION, @@ -137,7 +136,7 @@ decode_cipher_text(#ssl_tls{type = Type, fragment = CipherFragment}, ConnnectionStates0}; decode_cipher_text(#ssl_tls{type = Type}, _) -> %% Version mismatch is already asserted - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, {record_typ_mismatch, Type}). + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, {record_type_mismatch, Type}). %%-------------------------------------------------------------------- %%% Internal functions @@ -170,62 +169,61 @@ encode_plain_text(#inner_plaintext{ content = Data, type = Type, zeros = Zeros - }, #{cipher_state := CipherS0, + }, #{cipher_state := #cipher_state{key= Key, + iv = IV, + tag_len = TagLen}, sequence_number := Seq, security_parameters := #security_parameters{ - cipher_type = ?AEAD} - } = WriteState0) -> - PlainText = <<Data/binary, ?BYTE(Type), Zeros/binary>>, - AAD = start_additional_data(), - CipherS1 = ssl_cipher:nonce_seed(<<?UINT64(Seq)>>, CipherS0), - {Encoded, WriteState} = cipher_aead(PlainText, WriteState0#{cipher_state => CipherS1}, AAD), - {#tls_cipher_text{opaque_type = Type, - legacy_version = {3,3}, - encoded_record = Encoded}, WriteState}; + cipher_type = ?AEAD, + bulk_cipher_algorithm = BulkCipherAlgo} + }) -> + PlainText = [Data, Type, Zeros], + Encoded = cipher_aead(PlainText, BulkCipherAlgo, Key, Seq, IV, TagLen), + #tls_cipher_text{opaque_type = 23, %% 23 (application_data) for outward compatibility + legacy_version = {3,3}, + encoded_record = Encoded}; encode_plain_text(#inner_plaintext{ content = Data, type = Type }, #{security_parameters := #security_parameters{ cipher_suite = ?TLS_NULL_WITH_NULL_NULL} - } = WriteState0) -> + }) -> %% RFC8446 - 5.1. Record Layer %% When record protection has not yet been engaged, TLSPlaintext %% structures are written directly onto the wire. - {#tls_cipher_text{opaque_type = Type, + #tls_cipher_text{opaque_type = Type, legacy_version = {3,3}, - encoded_record = Data}, WriteState0}; + encoded_record = Data}; encode_plain_text(_, CS) -> exit({cs, CS}). -start_additional_data() -> - {MajVer, MinVer} = ?LEGACY_VERSION, - <<?BYTE(?OPAQUE_TYPE), ?BYTE(MajVer), ?BYTE(MinVer)>>. - -end_additional_data(AAD, Len) -> - <<AAD/binary, ?UINT16(Len)>>. - -nonce(#cipher_state{nonce = Nonce, iv = IV}) -> - Len = size(IV), - crypto:exor(<<Nonce:Len/bytes>>, IV). +additional_data(Length) -> + <<?BYTE(?OPAQUE_TYPE), ?BYTE(3), ?BYTE(3),?UINT16(Length)>>. -cipher_aead(Fragment, - #{cipher_state := CipherS0, - security_parameters := - #security_parameters{bulk_cipher_algorithm = - BulkCipherAlgo} - } = WriteState0, AAD) -> - {CipherFragment, CipherS1} = - cipher_aead(BulkCipherAlgo, CipherS0, AAD, Fragment), - {CipherFragment, WriteState0#{cipher_state => CipherS1}}. +%% The per-record nonce for the AEAD construction is formed as +%% follows: +%% +%% 1. The 64-bit record sequence number is encoded in network byte +%% order and padded to the left with zeros to iv_length. +%% +%% 2. The padded sequence number is XORed with either the static +%% client_write_iv or server_write_iv (depending on the role). +%% +%% The resulting quantity (of length iv_length) is used as the +%% per-record nonce. +nonce(Seq, IV) -> + Padding = binary:copy(<<0>>, byte_size(IV) - 8), + crypto:exor(<<Padding/binary,?UINT64(Seq)>>, IV). -cipher_aead(Type, #cipher_state{key=Key} = CipherState, AAD0, Fragment) -> - AAD = end_additional_data(AAD0, erlang:iolist_size(Fragment)), - Nonce = nonce(CipherState), - {Content, CipherTag} = ssl_cipher:aead_encrypt(Type, Key, Nonce, Fragment, AAD), - {<<Content/binary, CipherTag/binary>>, CipherState}. +cipher_aead(Fragment, BulkCipherAlgo, Key, Seq, IV, TagLen) -> + AAD = additional_data(erlang:iolist_size(Fragment) + TagLen), + Nonce = nonce(Seq, IV), + {Content, CipherTag} = + ssl_cipher:aead_encrypt(BulkCipherAlgo, Key, Nonce, Fragment, AAD), + <<Content/binary, CipherTag/binary>>. encode_tls_cipher_text(#tls_cipher_text{opaque_type = Type, legacy_version = {MajVer, MinVer}, @@ -234,13 +232,14 @@ encode_tls_cipher_text(#tls_cipher_text{opaque_type = Type, {[<<?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer), ?UINT16(Length)>>, Encoded], Write#{sequence_number => Seq +1}}. -decipher_aead(Type, #cipher_state{key = Key} = CipherState, AAD0, CipherFragment) -> +decipher_aead(CipherFragment, BulkCipherAlgo, Key, Seq, IV, TagLen) -> try - Nonce = nonce(CipherState), - {AAD, CipherText, CipherTag} = aead_ciphertext_split(CipherState, CipherFragment, AAD0), - case ssl_cipher:aead_decrypt(Type, Key, Nonce, CipherText, CipherTag, AAD) of + AAD = additional_data(erlang:iolist_size(CipherFragment)), + Nonce = nonce(Seq, IV), + {CipherText, CipherTag} = aead_ciphertext_split(CipherFragment, TagLen), + case ssl_cipher:aead_decrypt(BulkCipherAlgo, Key, Nonce, CipherText, CipherTag, AAD) of Content when is_binary(Content) -> - {Content, CipherState}; + Content; _ -> ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, decryption_failed) end @@ -249,39 +248,34 @@ decipher_aead(Type, #cipher_state{key = Key} = CipherState, AAD0, CipherFragment ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, decryption_failed) end. -aead_ciphertext_split(#cipher_state{tag_len = Len}, CipherTextFragment, AAD) -> - CipherLen = size(CipherTextFragment) - Len, - <<CipherText:CipherLen/bytes, CipherTag:Len/bytes>> = CipherTextFragment, - {end_additional_data(AAD, CipherLen), CipherText, CipherTag}. -decode_inner_plaintext(PlainText, ConnnectionStates) -> - case remove_padding(PlainText) of - #alert{} = Alert -> - Alert; - {Data, Type} -> - {#ssl_tls{type = Type, - version = {3,4}, %% Internally use real version - fragment = Data}, ConnnectionStates} - end. +aead_ciphertext_split(CipherTextFragment, TagLen) + when is_binary(CipherTextFragment) -> + CipherLen = erlang:byte_size(CipherTextFragment) - TagLen, + <<CipherText:CipherLen/bytes, CipherTag:TagLen/bytes>> = CipherTextFragment, + {CipherText, CipherTag}; +aead_ciphertext_split(CipherTextFragment, TagLen) + when is_list(CipherTextFragment) -> + CipherLen = erlang:iolist_size(CipherTextFragment) - TagLen, + <<CipherText:CipherLen/bytes, CipherTag:TagLen/bytes>> = + erlang:iolist_to_binary(CipherTextFragment), + {CipherText, CipherTag}. -remove_padding(PlainText)-> - case binary:split(PlainText, <<0>>, [global, trim]) of - [] -> - ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE, padding_error); - [Content] -> - Type = binary:last(Content), - split_content(Type, Content, erlang:byte_size(Content) - 1) +decode_inner_plaintext(PlainText) -> + case binary:last(PlainText) of + 0 -> + decode_inner_plaintext(init_binary(PlainText)); + Type when Type =:= ?APPLICATION_DATA orelse + Type =:= ?HANDSHAKE orelse + Type =:= ?ALERT -> + #ssl_tls{type = Type, + version = {3,4}, %% Internally use real version + fragment = init_binary(PlainText)}; + _Else -> + ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE, empty_alert) end. -split_content(?HANDSHAKE, _, 0) -> - ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE, empty_handshake); -split_content(?ALERT, _, 0) -> - ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE, empty_alert); -%% For special middlebox compatible case! -split_content(?CHANGE_CIPHER_SPEC, _, 0) -> - ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE, empty_change_cipher_spec); -split_content(?APPLICATION_DATA = Type, _, 0) -> - {Type, <<>>}; -split_content(Type, Content, N) -> - <<Data:N/bytes, ?BYTE(Type)>> = Content, - {Type, Data}. +init_binary(B) -> + {Init, _} = + split_binary(B, byte_size(B) - 1), + Init. diff --git a/lib/ssl/src/tls_sender.erl b/lib/ssl/src/tls_sender.erl index 1559fcbb37..1f34f9a420 100644 --- a/lib/ssl/src/tls_sender.erl +++ b/lib/ssl/src/tls_sender.erl @@ -386,10 +386,7 @@ send_tls_alert(Alert, #data{negotiated_version = Version, {BinMsg, ConnectionStates} = Connection:encode_alert(Alert, Version, ConnectionStates0), Connection:send(Transport, Socket, BinMsg), - Report = #{direction => outbound, - protocol => 'tls_record', - message => BinMsg}, - ssl_logger:debug(LogLevel, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(LogLevel, outbound, 'tls_record', BinMsg), StateData0#data{connection_states = ConnectionStates}. send_application_data(Data, From, StateName, @@ -414,18 +411,12 @@ send_application_data(Data, From, StateName, StateData = StateData0#data{connection_states = ConnectionStates}, case Connection:send(Transport, Socket, Msgs) of ok when DistHandle =/= undefined -> - Report = #{direction => outbound, - protocol => 'tls_record', - message => Msgs}, - ssl_logger:debug(LogLevel, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(LogLevel, outbound, 'tls_record', Msgs), {next_state, StateName, StateData, []}; Reason when DistHandle =/= undefined -> {next_state, death_row, StateData, [{state_timeout, 5000, Reason}]}; ok -> - Report = #{direction => outbound, - protocol => 'tls_record', - message => Msgs}, - ssl_logger:debug(LogLevel, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(LogLevel, outbound, 'tls_record', Msgs), {next_state, StateName, StateData, [{reply, From, ok}]}; Result -> {next_state, StateName, StateData, [{reply, From, Result}]} diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index 83dd7585dd..5c023bd2d8 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -36,7 +36,15 @@ default_signature_schemes/1, signature_schemes/2, groups/1, groups/2, group_to_enum/1, enum_to_group/1, default_groups/1]). --export([derive_secret/4, hkdf_expand_label/5, hkdf_extract/3, hkdf_expand/4]). +-export([derive_secret/4, hkdf_expand_label/5, hkdf_extract/3, hkdf_expand/4, + key_schedule/3, key_schedule/4, create_info/3, + external_binder_key/2, resumption_binder_key/2, + client_early_traffic_secret/3, early_exporter_master_secret/3, + client_handshake_traffic_secret/3, server_handshake_traffic_secret/3, + client_application_traffic_secret_0/3, server_application_traffic_secret_0/3, + exporter_master_secret/3, resumption_master_secret/3, + update_traffic_secret/2, calculate_traffic_keys/3, + transcript_hash/2, finished_key/2, finished_verify_data/3]). -type named_curve() :: sect571r1 | sect571k1 | secp521r1 | brainpoolP512r1 | sect409k1 | sect409r1 | brainpoolP384r1 | secp384r1 | @@ -56,7 +64,7 @@ %% TLS 1.3 --------------------------------------------------- -spec derive_secret(Secret::binary(), Label::binary(), - Messages::binary(), Algo::ssl_cipher_format:hash()) -> Key::binary(). + Messages::iodata(), Algo::ssl_cipher_format:hash()) -> Key::binary(). derive_secret(Secret, Label, Messages, Algo) -> Hash = crypto:hash(mac_algo(Algo), Messages), hkdf_expand_label(Secret, Label, @@ -66,16 +74,25 @@ derive_secret(Secret, Label, Messages, Algo) -> Context::binary(), Length::integer(), Algo::ssl_cipher_format:hash()) -> KeyingMaterial::binary(). hkdf_expand_label(Secret, Label0, Context, Length, Algo) -> + HkdfLabel = create_info(Label0, Context, Length), + hkdf_expand(Secret, HkdfLabel, Length, Algo). + +%% Create info parameter for HKDF-Expand: +%% HKDF-Expand(PRK, info, L) -> OKM +create_info(Label0, Context0, Length) -> %% struct { %% uint16 length = Length; %% opaque label<7..255> = "tls13 " + Label; %% opaque context<0..255> = Context; %% } HkdfLabel; - Content = << <<"tls13">>/binary, Label0/binary, Context/binary>>, - Len = size(Content), - HkdfLabel = <<?UINT16(Len), Content/binary>>, - hkdf_expand(Secret, HkdfLabel, Length, Algo). - + Label1 = << <<"tls13 ">>/binary, Label0/binary>>, + LabelLen = size(Label1), + Label = <<?BYTE(LabelLen), Label1/binary>>, + ContextLen = size(Context0), + Context = <<?BYTE(ContextLen),Context0/binary>>, + Content = <<Label/binary, Context/binary>>, + <<?UINT16(Length), Content/binary>>. + -spec hkdf_extract(MacAlg::ssl_cipher_format:hash(), Salt::binary(), KeyingMaterial::binary()) -> PseudoRandKey::binary(). @@ -89,6 +106,12 @@ hkdf_extract(MacAlg, Salt, KeyingMaterial) -> hkdf_expand(PseudoRandKey, ContextInfo, Length, Algo) -> Iterations = erlang:ceil(Length / ssl_cipher:hash_size(Algo)), hkdf_expand(Algo, PseudoRandKey, ContextInfo, Length, 1, Iterations, <<>>, <<>>). + + +-spec transcript_hash(Messages::iodata(), Algo::ssl_cipher_format:hash()) -> Hash::binary(). + +transcript_hash(Messages, Algo) -> + crypto:hash(mac_algo(Algo), Messages). %% TLS 1.3 --------------------------------------------------- %% TLS 1.0 -1.2 --------------------------------------------------- @@ -235,6 +258,173 @@ setup_keys(Version, PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize, ServerWriteKey, ClientIV, ServerIV}. %% TLS v1.2 --------------------------------------------------- +%% TLS v1.3 --------------------------------------------------- +%% RFC 8446 - 7.1. Key Schedule +%% +%% 0 +%% | +%% v +%% PSK -> HKDF-Extract = Early Secret +%% | +%% +-----> Derive-Secret(., "ext binder" | "res binder", "") +%% | = binder_key +%% | +%% +-----> Derive-Secret(., "c e traffic", ClientHello) +%% | = client_early_traffic_secret +%% | +%% +-----> Derive-Secret(., "e exp master", ClientHello) +%% | = early_exporter_master_secret +%% v +%% Derive-Secret(., "derived", "") +%% | +%% v +%% (EC)DHE -> HKDF-Extract = Handshake Secret +%% | +%% +-----> Derive-Secret(., "c hs traffic", +%% | ClientHello...ServerHello) +%% | = client_handshake_traffic_secret +%% | +%% +-----> Derive-Secret(., "s hs traffic", +%% | ClientHello...ServerHello) +%% | = server_handshake_traffic_secret +%% v +%% Derive-Secret(., "derived", "") +%% | +%% v +%% 0 -> HKDF-Extract = Master Secret +%% | +%% +-----> Derive-Secret(., "c ap traffic", +%% | ClientHello...server Finished) +%% | = client_application_traffic_secret_0 +%% | +%% +-----> Derive-Secret(., "s ap traffic", +%% | ClientHello...server Finished) +%% | = server_application_traffic_secret_0 +%% | +%% +-----> Derive-Secret(., "exp master", +%% | ClientHello...server Finished) +%% | = exporter_master_secret +%% | +%% +-----> Derive-Secret(., "res master", +%% ClientHello...client Finished) +%% = resumption_master_secret +-spec key_schedule(early_secret | handshake_secret | master_secret, + atom(), {psk | early_secret | handshake_secret, binary()}) -> + {early_secret | handshake_secret | master_secret, binary()}. + +key_schedule(early_secret, Algo, {psk, PSK}) -> + Len = ssl_cipher:hash_size(Algo), + Salt = binary:copy(<<?BYTE(0)>>, Len), + {early_secret, hkdf_extract(Algo, Salt, PSK)}; +key_schedule(master_secret, Algo, {handshake_secret, Secret}) -> + Len = ssl_cipher:hash_size(Algo), + IKM = binary:copy(<<?BYTE(0)>>, Len), + Salt = derive_secret(Secret, <<"derived">>, <<>>, Algo), + {master_secret, hkdf_extract(Algo, Salt, IKM)}. +%% +key_schedule(handshake_secret, Algo, IKM, {early_secret, Secret}) -> + Salt = derive_secret(Secret, <<"derived">>, <<>>, Algo), + {handshake_secret, hkdf_extract(Algo, Salt, IKM)}. + +-spec external_binder_key(atom(), {early_secret, binary()}) -> binary(). +external_binder_key(Algo, {early_secret, Secret}) -> + derive_secret(Secret, <<"ext binder">>, <<>>, Algo). + +-spec resumption_binder_key(atom(), {early_secret, binary()}) -> binary(). +resumption_binder_key(Algo, {early_secret, Secret}) -> + derive_secret(Secret, <<"res binder">>, <<>>, Algo). + +-spec client_early_traffic_secret(atom(), {early_secret, binary()}, iodata()) -> binary(). +%% M = ClientHello +client_early_traffic_secret(Algo, {early_secret, Secret}, M) -> + derive_secret(Secret, <<"c e traffic">>, M, Algo). + +-spec early_exporter_master_secret(atom(), {early_secret, binary()}, iodata()) -> binary(). +%% M = ClientHello +early_exporter_master_secret(Algo, {early_secret, Secret}, M) -> + derive_secret(Secret, <<"e exp master">>, M, Algo). + +-spec client_handshake_traffic_secret(atom(), {handshake_secret, binary()}, iodata()) -> binary(). +%% M = ClientHello...ServerHello +client_handshake_traffic_secret(Algo, {handshake_secret, Secret}, M) -> + derive_secret(Secret, <<"c hs traffic">>, M, Algo). + +-spec server_handshake_traffic_secret(atom(), {handshake_secret, binary()}, iodata()) -> binary(). +%% M = ClientHello...ServerHello +server_handshake_traffic_secret(Algo, {handshake_secret, Secret}, M) -> + derive_secret(Secret, <<"s hs traffic">>, M, Algo). + +-spec client_application_traffic_secret_0(atom(), {master_secret, binary()}, iodata()) -> binary(). +%% M = ClientHello...server Finished +client_application_traffic_secret_0(Algo, {master_secret, Secret}, M) -> + derive_secret(Secret, <<"c ap traffic">>, M, Algo). + +-spec server_application_traffic_secret_0(atom(), {master_secret, binary()}, iodata()) -> binary(). +%% M = ClientHello...server Finished +server_application_traffic_secret_0(Algo, {master_secret, Secret}, M) -> + derive_secret(Secret, <<"s ap traffic">>, M, Algo). + +-spec exporter_master_secret(atom(), {master_secret, binary()}, iodata()) -> binary(). +%% M = ClientHello...server Finished +exporter_master_secret(Algo, {master_secret, Secret}, M) -> + derive_secret(Secret, <<"exp master">>, M, Algo). + +-spec resumption_master_secret(atom(), {master_secret, binary()}, iodata()) -> binary(). +%% M = ClientHello...client Finished +resumption_master_secret(Algo, {master_secret, Secret}, M) -> + derive_secret(Secret, <<"res master">>, M, Algo). + +-spec finished_key(binary(), atom()) -> binary(). +finished_key(BaseKey, Algo) -> + %% finished_key = + %% HKDF-Expand-Label(BaseKey, "finished", "", Hash.length) + ssl_cipher:hash_size(Algo), + hkdf_expand_label(BaseKey, <<"finished">>, <<>>, ssl_cipher:hash_size(Algo), Algo). + +-spec finished_verify_data(binary(), atom(), iodata()) -> binary(). +finished_verify_data(FinishedKey, HKDFAlgo, Messages) -> + %% The verify_data value is computed as follows: + %% + %% verify_data = + %% HMAC(finished_key, + %% Transcript-Hash(Handshake Context, + %% Certificate*, CertificateVerify*)) + Context = lists:reverse(Messages), + THash = tls_v1:transcript_hash(Context, HKDFAlgo), + tls_v1:hmac_hash(HKDFAlgo, FinishedKey, THash). + +%% The next-generation application_traffic_secret is computed as: +%% +%% application_traffic_secret_N+1 = +%% HKDF-Expand-Label(application_traffic_secret_N, +%% "traffic upd", "", Hash.length) +-spec update_traffic_secret(atom(), binary()) -> binary(). +update_traffic_secret(Algo, Secret) -> + hkdf_expand_label(Secret, <<"traffic upd">>, <<>>, ssl_cipher:hash_size(Algo), Algo). + +%% The traffic keying material is generated from the following input +%% values: +%% +%% - A secret value +%% +%% - A purpose value indicating the specific value being generated +%% +%% - The length of the key being generated +%% +%% The traffic keying material is generated from an input traffic secret +%% value using: +%% +%% [sender]_write_key = HKDF-Expand-Label(Secret, "key", "", key_length) +%% [sender]_write_iv = HKDF-Expand-Label(Secret, "iv", "", iv_length) +-spec calculate_traffic_keys(atom(), atom(), binary()) -> {binary(), binary()}. +calculate_traffic_keys(HKDFAlgo, Cipher, Secret) -> + Key = hkdf_expand_label(Secret, <<"key">>, <<>>, ssl_cipher:key_material(Cipher), HKDFAlgo), + %% TODO: remove hard coded IV size + IV = hkdf_expand_label(Secret, <<"iv">>, <<>>, 12, HKDFAlgo), + {Key, IV}. + +%% TLS v1.3 --------------------------------------------------- + %% TLS 1.0 -1.2 --------------------------------------------------- -spec mac_hash(integer() | atom(), binary(), integer(), integer(), tls_record:tls_version(), integer(), binary()) -> binary(). @@ -254,7 +444,7 @@ mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor}, %% TODO 1.3 same as above? --spec suites(1|2|3|4) -> [ssl_cipher_format:cipher_suite()]. +-spec suites(1|2|3|4|'TLS_v1.3') -> [ssl_cipher_format:cipher_suite()]. suites(Minor) when Minor == 1; Minor == 2 -> [ @@ -315,7 +505,17 @@ suites(4) -> %% Not supported %% ?TLS_AES_128_CCM_SHA256, %% ?TLS_AES_128_CCM_8_SHA256 - ] ++ suites(3). + ] ++ suites(3); + +suites('TLS_v1.3') -> + [?TLS_AES_256_GCM_SHA384, + ?TLS_AES_128_GCM_SHA256, + ?TLS_CHACHA20_POLY1305_SHA256 + %% Not supported + %% ?TLS_AES_128_CCM_SHA256, + %% ?TLS_AES_128_CCM_8_SHA256 + ]. + signature_algs({3, 4}, HashSigns) -> signature_algs({3, 3}, HashSigns); @@ -347,7 +547,9 @@ signature_algs({3, 3}, HashSigns) -> lists:reverse(Supported). default_signature_algs({3, 4} = Version) -> - default_signature_schemes(Version); + %% TLS 1.3 servers shall be prepared to process TLS 1.2 ClientHellos + %% containing legacy hash-sign tuples. + default_signature_schemes(Version) ++ default_signature_algs({3,3}); default_signature_algs({3, 3} = Version) -> Default = [%% SHA2 {sha512, ecdsa}, @@ -373,15 +575,23 @@ signature_schemes(Version, SignatureSchemes) when is_tuple(Version) Hashes = proplists:get_value(hashs, CryptoSupports), PubKeys = proplists:get_value(public_keys, CryptoSupports), Curves = proplists:get_value(curves, CryptoSupports), - Fun = fun (Scheme, Acc) -> + RSAPSSSupported = lists:member(rsa_pkcs1_pss_padding, + proplists:get_value(rsa_opts, CryptoSupports)), + Fun = fun (Scheme, Acc) when is_atom(Scheme) -> {Hash0, Sign0, Curve} = ssl_cipher:scheme_to_components(Scheme), Sign = case Sign0 of - rsa_pkcs1 -> rsa; + rsa_pkcs1 -> + rsa; + rsa_pss_rsae when RSAPSSSupported -> + rsa; + rsa_pss_pss when RSAPSSSupported -> + rsa; S -> S end, Hash = case Hash0 of - sha1 -> sha; + sha1 -> + sha; H -> H end, case proplists:get_bool(Sign, PubKeys) @@ -394,7 +604,10 @@ signature_schemes(Version, SignatureSchemes) when is_tuple(Version) [Scheme | Acc]; false -> Acc - end + end; + %% Special clause for filtering out the legacy hash-sign tuples. + (_ , Acc) -> + Acc end, Supported = lists:foldl(Fun, [], SignatureSchemes), lists:reverse(Supported); @@ -403,22 +616,29 @@ signature_schemes(_, _) -> default_signature_schemes(Version) -> Default = [ - rsa_pkcs1_sha256, - rsa_pkcs1_sha384, - rsa_pkcs1_sha512, - ecdsa_secp256r1_sha256, - ecdsa_secp384r1_sha384, ecdsa_secp521r1_sha512, - rsa_pss_rsae_sha256, - rsa_pss_rsae_sha384, + ecdsa_secp384r1_sha384, + ecdsa_secp256r1_sha256, + rsa_pss_pss_sha512, + rsa_pss_pss_sha384, + rsa_pss_pss_sha256, rsa_pss_rsae_sha512, + rsa_pss_rsae_sha384, + rsa_pss_rsae_sha256, %% ed25519, %% ed448, - rsa_pss_pss_sha256, - rsa_pss_pss_sha384, - rsa_pss_pss_sha512, - rsa_pkcs1_sha1, - ecdsa_sha1 + + %% These values refer solely to signatures + %% which appear in certificates (see Section 4.4.2.2) and are not + %% defined for use in signed TLS handshake messages, although they + %% MAY appear in "signature_algorithms" and + %% "signature_algorithms_cert" for backward compatibility with + %% TLS 1.2. + rsa_pkcs1_sha512, + rsa_pkcs1_sha384, + rsa_pkcs1_sha256, + ecdsa_sha1, + rsa_pkcs1_sha1 ], signature_schemes(Version, Default). @@ -553,7 +773,9 @@ ecc_curves(_Minor, TLSCurves) -> -spec groups(4 | all | default) -> [group()]. groups(all) -> - [secp256r1, + [x25519, + x448, + secp256r1, secp384r1, secp521r1, ffdhe2048, @@ -562,27 +784,33 @@ groups(all) -> ffdhe6144, ffdhe8192]; groups(default) -> - [secp256r1, - secp384r1, - secp521r1, - ffdhe2048]; + [x25519, + x448, + secp256r1, + secp384r1]; groups(Minor) -> TLSGroups = groups(all), groups(Minor, TLSGroups). %% -spec groups(4, [group()]) -> [group()]. groups(_Minor, TLSGroups) -> - %% TODO: Adding FFDHE groups to crypto? - CryptoGroups = crypto:ec_curves() ++ [ffdhe2048,ffdhe3072,ffdhe4096,ffdhe6144,ffdhe8192], + CryptoGroups = supported_groups(), lists:filter(fun(Group) -> proplists:get_bool(Group, CryptoGroups) end, TLSGroups). default_groups(Minor) -> TLSGroups = groups(default), groups(Minor, TLSGroups). +supported_groups() -> + %% TODO: Add new function to crypto? + proplists:get_value(curves, crypto:supports()) ++ + [ffdhe2048,ffdhe3072,ffdhe4096,ffdhe6144,ffdhe8192]. + group_to_enum(secp256r1) -> 23; group_to_enum(secp384r1) -> 24; group_to_enum(secp521r1) -> 25; +group_to_enum(x25519) -> 29; +group_to_enum(x448) -> 30; group_to_enum(ffdhe2048) -> 256; group_to_enum(ffdhe3072) -> 257; group_to_enum(ffdhe4096) -> 258; @@ -592,6 +820,8 @@ group_to_enum(ffdhe8192) -> 260. enum_to_group(23) -> secp256r1; enum_to_group(24) -> secp384r1; enum_to_group(25) -> secp521r1; +enum_to_group(29) -> x25519; +enum_to_group(30) -> x448; enum_to_group(256) -> ffdhe2048; enum_to_group(257) -> ffdhe3072; enum_to_group(258) -> ffdhe4096; diff --git a/lib/ssl/test/make_certs.erl b/lib/ssl/test/make_certs.erl index 578f6a731a..76bf0fa895 100644 --- a/lib/ssl/test/make_certs.erl +++ b/lib/ssl/test/make_certs.erl @@ -189,6 +189,18 @@ gencrl(Root, CA, C, CrlHours) -> Env = [{"ROOTDIR", filename:absname(Root)}], cmd(Cmd, Env). +%% This function sets the number of seconds until the next CRL is due. +gencrl_sec(Root, CA, C, CrlSecs) -> + CACnfFile = filename:join([Root, CA, "ca.cnf"]), + CACRLFile = filename:join([Root, CA, "crl.pem"]), + Cmd = [C#config.openssl_cmd, " ca" + " -gencrl ", + " -crlsec ", integer_to_list(CrlSecs), + " -out ", CACRLFile, + " -config ", CACnfFile], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env). + can_generate_expired_crls(C) -> %% OpenSSL can generate CRLs with an expiration date in the past, %% if we pass a negative number for -crlhours. However, LibreSSL diff --git a/lib/ssl/test/property_test/ssl_eqc_handshake.erl b/lib/ssl/test/property_test/ssl_eqc_handshake.erl index 6ffb6d311f..38a4b7fb11 100644 --- a/lib/ssl/test/property_test/ssl_eqc_handshake.erl +++ b/lib/ssl/test/property_test/ssl_eqc_handshake.erl @@ -96,7 +96,7 @@ tls_msg(?'TLS_v1.3'= Version) -> encrypted_extensions(), certificate_1_3(), %%certificate_request_1_3, - %%certificate_verify() + certificate_verify_1_3(), finished(), key_update() ]); @@ -160,7 +160,14 @@ certificate_1_3() -> ?LET(Certs, certificate_chain(), #certificate_1_3{ certificate_request_context = certificate_request_context(), - entries = certificate_entries(Certs, []) + certificate_list = certificate_entries(Certs, []) + }). + +certificate_verify_1_3() -> + ?LET(Certs, certificate_chain(), + #certificate_verify_1_3{ + algorithm = sig_scheme(), + signature = signature() }). finished() -> @@ -326,7 +333,7 @@ extensions(?'TLS_v1.3' = Version, client_hello) -> %% oneof([psk_key_exchange_modes(), undefined]), %% oneof([early_data(), undefined]), %% oneof([cookie(), undefined]), - oneof([client_hello_versions(Version), undefined]), + oneof([client_hello_versions(Version)]), %% oneof([cert_authorities(), undefined]), %% oneof([post_handshake_auth(), undefined]), oneof([signature_algs_cert(), undefined]) @@ -403,7 +410,7 @@ extensions(?'TLS_v1.3' = Version, server_hello) -> { oneof([key_share(server_hello), undefined]), %% oneof([pre_shared_keys(), undefined]), - oneof([server_hello_selected_version(), undefined]) + oneof([server_hello_selected_version()]) }, maps:filter(fun(_, undefined) -> false; @@ -511,10 +518,48 @@ sig_scheme_list() -> ecdsa_sha1] ]). +sig_scheme() -> + oneof([rsa_pkcs1_sha256, + rsa_pkcs1_sha384, + rsa_pkcs1_sha512, + ecdsa_secp256r1_sha256, + ecdsa_secp384r1_sha384, + ecdsa_secp521r1_sha512, + rsa_pss_rsae_sha256, + rsa_pss_rsae_sha384, + rsa_pss_rsae_sha512, + rsa_pss_pss_sha256, + rsa_pss_pss_sha384, + rsa_pss_pss_sha512, + rsa_pkcs1_sha1, + ecdsa_sha1]). + +signature() -> + <<44,119,215,137,54,84,156,26,121,212,64,173,189,226, + 191,46,76,89,204,2,78,79,163,228,90,21,89,179,4,198, + 109,14,52,26,230,22,56,8,170,129,86,0,7,132,245,81, + 181,131,62,70,79,167,112,85,14,171,175,162,110,29, + 212,198,45,188,83,176,251,197,224,104,95,74,89,59, + 26,60,63,79,238,196,137,65,23,199,127,145,176,184, + 216,3,48,116,172,106,97,83,227,172,246,137,91,79, + 173,119,169,60,67,1,177,117,9,93,38,86,232,253,73, + 140,17,147,130,110,136,245,73,10,91,70,105,53,225, + 158,107,60,190,30,14,26,92,147,221,60,117,104,53,70, + 142,204,7,131,11,183,192,120,246,243,68,99,147,183, + 49,149,48,188,8,218,17,150,220,121,2,99,194,140,35, + 13,249,201,37,216,68,45,87,58,18,10,106,11,132,241, + 71,170,225,216,197,212,29,107,36,80,189,184,202,56, + 86,213,45,70,34,74,71,48,137,79,212,194,172,151,57, + 57,30,126,24,157,198,101,220,84,162,89,105,185,245, + 76,105,212,176,25,6,148,49,194,106,253,241,212,200, + 37,154,227,53,49,216,72,82,163>>. + client_hello_versions(?'TLS_v1.3') -> ?LET(SupportedVersions, oneof([[{3,4}], - [{3,3},{3,4}], + %% This list breaks the property but can be used for negative tests + %% [{3,3},{3,4}], + [{3,4},{3,3}], [{3,4},{3,3},{3,2},{3,1},{3,0}] ]), #client_hello_versions{versions = SupportedVersions}); @@ -543,7 +588,10 @@ choose_certificate_chain(#{server_config := ServerConf, oneof([certificate_chain(ServerConf), certificate_chain(ClientConf)]). certificate_request_context() -> - <<>>. + oneof([<<>>, + <<1>>, + <<"foobar">> + ]). certificate_entries([], Acc) -> lists:reverse(Acc); certificate_entries([Cert | Rest], Acc) -> @@ -734,10 +782,13 @@ key_share_entry_list(N, Pool, Acc) -> key_exchange = P}, key_share_entry_list(N - 1, Pool -- [G], [KeyShareEntry|Acc]). +%% TODO: fix curve generation generate_public_key(Group) when Group =:= secp256r1 orelse Group =:= secp384r1 orelse - Group =:= secp521r1 -> + Group =:= secp521r1 orelse + Group =:= x448 orelse + Group =:= x25519 -> #'ECPrivateKey'{publicKey = PublicKey} = public_key:generate_key({namedCurve, secp256r1}), PublicKey; diff --git a/lib/ssl/test/ssl.spec b/lib/ssl/test/ssl.spec index 5e65bfcfe6..24272327c3 100644 --- a/lib/ssl/test/ssl.spec +++ b/lib/ssl/test/ssl.spec @@ -3,6 +3,7 @@ {suites,dir,all}. {skip_groups,dir,ssl_bench_SUITE,setup,"Benchmarks run separately"}. +{skip_groups,dir,ssl_bench_SUITE,payload,"Benchmarks run separately"}. {skip_groups,dir,ssl_bench_SUITE,pem_cache,"Benchmarks run separately"}. {skip_groups,dir,ssl_dist_bench_SUITE,setup,"Benchmarks run separately"}. {skip_groups,dir,ssl_dist_bench_SUITE,throughput,"Benchmarks run separately"}. diff --git a/lib/ssl/test/ssl_ECC_SUITE.erl b/lib/ssl/test/ssl_ECC_SUITE.erl index a5309e866b..ca8d0ec70c 100644 --- a/lib/ssl/test/ssl_ECC_SUITE.erl +++ b/lib/ssl/test/ssl_ECC_SUITE.erl @@ -212,53 +212,61 @@ client_ecdsa_server_ecdsa_with_raw_key(Config) when is_list(Config) -> ecc_default_order(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], - ecdhe_ecdsa, ecdhe_ecdsa, Config), + ecdhe_ecdsa, ecdhe_ecdsa, + Config, DefaultCurve), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), ECCOpts = [], - case ssl_test_lib:supported_eccs([{eccs, [sect571r1]}]) of - true -> ssl_test_lib:ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config); + case ssl_test_lib:supported_eccs([{eccs, [DefaultCurve]}]) of + true -> ssl_test_lib:ecc_test(DefaultCurve, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} end. ecc_default_order_custom_curves(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], - ecdhe_ecdsa, ecdhe_ecdsa, Config), + ecdhe_ecdsa, ecdhe_ecdsa, + Config, DefaultCurve), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{eccs, [secp256r1, sect571r1]}], + ECCOpts = [{eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of - true -> ssl_test_lib:ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config); + true -> ssl_test_lib:ecc_test(DefaultCurve, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} end. ecc_client_order(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], - ecdhe_ecdsa, ecdhe_ecdsa, Config), + ecdhe_ecdsa, ecdhe_ecdsa, + Config, DefaultCurve), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), ECCOpts = [{honor_ecc_order, false}], - case ssl_test_lib:supported_eccs([{eccs, [sect571r1]}]) of - true -> ssl_test_lib:ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config); + case ssl_test_lib:supported_eccs([{eccs, [DefaultCurve]}]) of + true -> ssl_test_lib:ecc_test(DefaultCurve, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} end. ecc_client_order_custom_curves(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], - ecdhe_ecdsa, ecdhe_ecdsa, Config), + ecdhe_ecdsa, ecdhe_ecdsa, + Config, DefaultCurve), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{honor_ecc_order, false}, {eccs, [secp256r1, sect571r1]}], + ECCOpts = [{honor_ecc_order, false}, {eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of - true -> ssl_test_lib:ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config); + true -> ssl_test_lib:ecc_test(DefaultCurve, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} end. @@ -274,12 +282,13 @@ ecc_unknown_curve(Config) -> client_ecdh_rsa_server_ecdhe_ecdsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdh_rsa, ecdhe_ecdsa, Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} @@ -287,12 +296,13 @@ client_ecdh_rsa_server_ecdhe_ecdsa_server_custom(Config) -> client_ecdh_rsa_server_ecdhe_rsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdh_rsa, ecdhe_rsa, Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config); @@ -301,12 +311,13 @@ client_ecdh_rsa_server_ecdhe_rsa_server_custom(Config) -> client_ecdhe_rsa_server_ecdhe_ecdsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_rsa, ecdhe_ecdsa, Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} @@ -314,19 +325,21 @@ client_ecdhe_rsa_server_ecdhe_ecdsa_server_custom(Config) -> client_ecdhe_rsa_server_ecdhe_rsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_rsa, ecdhe_rsa, Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} end. client_ecdhe_rsa_server_ecdh_rsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), Ext = x509_test:extensions([{key_usage, [keyEncipherment]}]), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, [[], [], [{extensions, Ext}]]}, {client_chain, Default}], @@ -334,8 +347,8 @@ client_ecdhe_rsa_server_ecdh_rsa_server_custom(Config) -> COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], - Expected = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), %% The certificate curve + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}], + Expected = secp256r1, %% The certificate curve case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(Expected, COpts, SOpts, [], ECCOpts, Config); @@ -344,12 +357,13 @@ client_ecdhe_rsa_server_ecdh_rsa_server_custom(Config) -> client_ecdhe_ecdsa_server_ecdhe_ecdsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_ecdsa, Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} @@ -357,12 +371,13 @@ client_ecdhe_ecdsa_server_ecdhe_ecdsa_server_custom(Config) -> client_ecdhe_ecdsa_server_ecdhe_rsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_rsa, Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} @@ -370,12 +385,13 @@ client_ecdhe_ecdsa_server_ecdhe_rsa_server_custom(Config) -> client_ecdhe_ecdsa_server_ecdhe_ecdsa_client_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_ecdsa, Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{eccs, [secp256r1, sect571r1]}], + ECCOpts = [{eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, ECCOpts, [], Config); false -> {skip, "unsupported named curves"} @@ -383,12 +399,13 @@ client_ecdhe_ecdsa_server_ecdhe_ecdsa_client_custom(Config) -> client_ecdhe_rsa_server_ecdhe_ecdsa_client_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_rsa, ecdhe_ecdsa, Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{eccs, [secp256r1, sect571r1]}], + ECCOpts = [{eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, ECCOpts, [], Config); false -> {skip, "unsupported named curves"} diff --git a/lib/ssl/test/ssl_alpn_handshake_SUITE.erl b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl index 04c4b257d9..7f7c3da5ab 100644 --- a/lib/ssl/test/ssl_alpn_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl @@ -262,52 +262,12 @@ client_renegotiate(Config) when is_list(Config) -> %-------------------------------------------------------------------------------- session_reused(Config) when is_list(Config)-> - ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), ClientOpts = [{alpn_advertised_protocols, [<<"http/1.0">>]}] ++ ClientOpts0, ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}] ++ ServerOpts0, - {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, - {from, self()}, - {mfa, {ssl_test_lib, session_info_result, []}}, - {options, ServerOpts}]), - - Port = ssl_test_lib:inet_port(Server), - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {mfa, {ssl_test_lib, no_result_msg, []}}, - {options, ClientOpts}]), - - SessionInfo = - receive - {Server, Info} -> - Info - end, - - Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, - - %% Make sure session is registered - ct:sleep(?SLEEP), - - Client1 = - ssl_test_lib:start_client([{node, ClientNode}, - {port, Port}, {host, Hostname}, - {mfa, {ssl_test_lib, session_info_result, []}}, - {from, self()}, {options, ClientOpts}]), - - receive - {Client1, SessionInfo} -> - ok; - {Client1, Other} -> - ct:fail(Other) - end, - - ssl_test_lib:close(Server), - ssl_test_lib:close(Client), - ssl_test_lib:close(Client1). - + ssl_test_lib:reuse_session(ClientOpts, ServerOpts, Config). %-------------------------------------------------------------------------------- alpn_not_supported_client(Config) when is_list(Config) -> diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 8d2c0c7e87..f4ecc4dc33 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -53,7 +53,8 @@ all() -> {group, options_tls}, {group, session}, {group, 'dtlsv1.2'}, - {group, 'dtlsv1'}, + {group, 'dtlsv1'}, + {group, 'tlsv1.3'}, {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, @@ -67,6 +68,7 @@ groups() -> {options_tls, [], options_tests_tls()}, {'dtlsv1.2', [], all_versions_groups()}, {'dtlsv1', [], all_versions_groups()}, + {'tlsv1.3', [], tls13_test_group()}, {'tlsv1.2', [], all_versions_groups() ++ tls_versions_groups() ++ [conf_signature_algs, no_common_signature_algs]}, {'tlsv1.1', [], all_versions_groups() ++ tls_versions_groups()}, {'tlsv1', [], all_versions_groups() ++ tls_versions_groups() ++ rizzo_tests()}, @@ -266,6 +268,14 @@ rizzo_tests() -> rizzo_zero_n, rizzo_disabled]. +%% For testing TLS 1.3 features and possible regressions +tls13_test_group() -> + [tls13_enable_client_side, + tls13_enable_server_side, + tls_record_1_3_encode_decode, + tls13_finished_verify_data, + tls13_1_RTT_handshake]. + %%-------------------------------------------------------------------- init_per_suite(Config0) -> catch crypto:stop(), @@ -295,7 +305,8 @@ init_per_group(GroupName, Config) when GroupName == basic_tls; GroupName == options; GroupName == basic; GroupName == session; - GroupName == error_handling_tests_tls + GroupName == error_handling_tests_tls; + GroupName == tls13_test_group -> ssl_test_lib:clean_tls_version(Config); init_per_group(GroupName, Config) -> @@ -654,8 +665,8 @@ new_options_in_accept(Config) when is_list(Config) -> handshake_continue() -> [{doc, "Test API function ssl:handshake_continue/3"}]. handshake_continue(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -714,7 +725,7 @@ hello_client_cancel(Config) when is_list(Config) -> hello_server_cancel() -> [{doc, "Test API function ssl:handshake_cancel/1 on the server side"}]. hello_server_cancel(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -756,8 +767,8 @@ prf(Config) when is_list(Config) -> secret_connection_info() -> [{doc,"Test the API function ssl:connection_information/2"}]. secret_connection_info(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -1446,8 +1457,8 @@ cipher_suites_mix() -> cipher_suites_mix(Config) when is_list(Config) -> CipherSuites = [{dhe_rsa,aes_128_cbc,sha256,sha256}, {dhe_rsa,aes_128_cbc,sha}], - ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -2358,8 +2369,8 @@ invalid_options() -> [{doc,"Test what happens when we give invalid options"}]. invalid_options(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Check = fun(Client, Server, {versions, [sslv2, sslv3]} = Option) -> @@ -2374,27 +2385,28 @@ invalid_options(Config) when is_list(Config) -> {error, {options, Option}}) end, - TestOpts = [{versions, [sslv2, sslv3]}, - {verify, 4}, - {verify_fun, function}, - {fail_if_no_peer_cert, 0}, - {verify_client_once, 1}, - {depth, four}, - {certfile, 'cert.pem'}, - {keyfile,'key.pem' }, - {password, foo}, - {cacertfile, ""}, - {dhfile,'dh.pem' }, - {ciphers, [{foo, bar, sha, ignore}]}, - {reuse_session, foo}, - {reuse_sessions, 0}, - {renegotiate_at, "10"}, - {mode, depech}, - {packet, 8.0}, - {packet_size, "2"}, - {header, a}, - {active, trice}, - {key, 'key.pem' }], + TestOpts = + [{versions, [sslv2, sslv3]}, + {verify, 4}, + {verify_fun, function}, + {fail_if_no_peer_cert, 0}, + {verify_client_once, 1}, + {depth, four}, + {certfile, 'cert.pem'}, + {keyfile,'key.pem' }, + {password, foo}, + {cacertfile, ""}, + {dhfile,'dh.pem' }, + {ciphers, [{foo, bar, sha, ignore}]}, + {reuse_session, foo}, + {reuse_sessions, 0}, + {renegotiate_at, "10"}, + {mode, depech}, + {packet, 8.0}, + {packet_size, "2"}, + {header, a}, + {active, trice}, + {key, 'key.pem' }], [begin Server = @@ -2687,175 +2699,69 @@ ciphers_ecdh_rsa_signed_certs_openssl_names(Config) when is_list(Config) -> reuse_session() -> [{doc,"Test reuse of sessions (short handshake)"}]. reuse_session(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), - {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - - Server = - ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, - {from, self()}, - {mfa, {ssl_test_lib, session_info_result, []}}, - {options, ServerOpts}]), - Port = ssl_test_lib:inet_port(Server), - Client0 = - ssl_test_lib:start_client([{node, ClientNode}, - {port, Port}, {host, Hostname}, - {mfa, {ssl_test_lib, no_result, []}}, - {from, self()}, {options, ClientOpts}]), - SessionInfo = - receive - {Server, Info} -> - Info - end, - - Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, - - %% Make sure session is registered - ct:sleep(?SLEEP), - - Client1 = - ssl_test_lib:start_client([{node, ClientNode}, - {port, Port}, {host, Hostname}, - {mfa, {ssl_test_lib, session_info_result, []}}, - {from, self()}, {options, ClientOpts}]), - receive - {Client1, SessionInfo} -> - ok; - {Client1, Other} -> - ct:log("Expected: ~p, Unexpected: ~p~n", - [SessionInfo, Other]), - ct:fail(session_not_reused) - end, - - Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), - Client2 = - ssl_test_lib:start_client([{node, ClientNode}, - {port, Port}, {host, Hostname}, - {mfa, {ssl_test_lib, session_info_result, []}}, - {from, self()}, {options, [{reuse_sessions, false} - | ClientOpts]}]), - receive - {Client2, SessionInfo} -> - ct:fail( - session_reused_when_session_reuse_disabled_by_client); - {Client2, _} -> - ok - end, - - ssl_test_lib:close(Server), - - Server1 = - ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, - {from, self()}, - {mfa, {ssl_test_lib, session_info_result, []}}, - {options, [{reuse_sessions, false} | ServerOpts]}]), - - Port1 = ssl_test_lib:inet_port(Server1), - Client3 = - ssl_test_lib:start_client([{node, ClientNode}, - {port, Port1}, {host, Hostname}, - {mfa, {ssl_test_lib, no_result, []}}, - {from, self()}, {options, ClientOpts}]), - - SessionInfo1 = - receive - {Server1, Info1} -> - Info1 - end, - - Server1 ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, - - %% Make sure session is registered - ct:sleep(?SLEEP), - - Client4 = - ssl_test_lib:start_client([{node, ClientNode}, - {port, Port1}, {host, Hostname}, - {mfa, {ssl_test_lib, session_info_result, []}}, - {from, self()}, {options, ClientOpts}]), - - receive - {Client4, SessionInfo1} -> - ct:fail( - session_reused_when_session_reuse_disabled_by_server); - {Client4, _Other} -> - ct:log("OTHER: ~p ~n", [_Other]), - ok - end, - - ssl_test_lib:close(Server1), - ssl_test_lib:close(Client0), - ssl_test_lib:close(Client1), - ssl_test_lib:close(Client2), - ssl_test_lib:close(Client3), - ssl_test_lib:close(Client4). - + ssl_test_lib:reuse_session(ClientOpts, ServerOpts, Config). %%-------------------------------------------------------------------- reuse_session_expired() -> [{doc,"Test sessions is not reused when it has expired"}]. reuse_session_expired(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - - Server = - ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + + Server0 = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {ssl_test_lib, session_info_result, []}}, - {options, ServerOpts}]), - Port = ssl_test_lib:inet_port(Server), - Client0 = - ssl_test_lib:start_client([{node, ClientNode}, - {port, Port}, {host, Hostname}, - {mfa, {ssl_test_lib, no_result, []}}, - {from, self()}, {options, ClientOpts}]), - SessionInfo = - receive - {Server, Info} -> - Info - end, - - Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, + {mfa, {ssl_test_lib, no_result, []}}, + {tcp_options, [{active, false}]}, + {options, ServerOpts}]), + Port0 = ssl_test_lib:inet_port(Server0), - %% Make sure session is registered - ct:sleep(?SLEEP), - - Client1 = - ssl_test_lib:start_client([{node, ClientNode}, - {port, Port}, {host, Hostname}, - {mfa, {ssl_test_lib, session_info_result, []}}, - {from, self()}, {options, ClientOpts}]), + Client0 = ssl_test_lib:start_client([{node, ClientNode}, + {port, Port0}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, [{reuse_sessions, save} | ClientOpts]}]), + Server0 ! listen, + + Client1 = ssl_test_lib:start_client([{node, ClientNode}, + {port, Port0}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, ClientOpts}]), + + SID = receive + {Client0, Id0} -> + Id0 + end, + receive - {Client1, SessionInfo} -> - ok; - {Client1, Other} -> - ct:log("Expected: ~p, Unexpected: ~p~n", - [SessionInfo, Other]), - ct:fail(session_not_reused) + {Client1, SID} -> + ok + after ?SLEEP -> + ct:fail(session_not_reused) end, - Server ! listen, - + Server0 ! listen, + %% Make sure session is unregistered due to expiration - ct:sleep((?EXPIRE+1)), - [{session_id, Id} |_] = SessionInfo, + ct:sleep((?EXPIRE*2)), - make_sure_expired(Hostname, Port, Id), + make_sure_expired(Hostname, Port0, SID), Client2 = ssl_test_lib:start_client([{node, ClientNode}, - {port, Port}, {host, Hostname}, - {mfa, {ssl_test_lib, session_info_result, []}}, + {port, Port0}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, {from, self()}, {options, ClientOpts}]), receive - {Client2, SessionInfo} -> + {Client2, SID} -> ct:fail(session_reused_when_session_expired); {Client2, _} -> ok end, process_flag(trap_exit, false), - ssl_test_lib:close(Server), + ssl_test_lib:close(Server0), ssl_test_lib:close(Client0), ssl_test_lib:close(Client1), ssl_test_lib:close(Client2). @@ -2864,16 +2770,16 @@ make_sure_expired(Host, Port, Id) -> {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), [_, _,_, _, Prop] = StatusInfo, State = ssl_test_lib:state(Prop), - Cache = element(2, State), + ClientCache = element(2, State), - case ssl_session_cache:lookup(Cache, {{Host, Port}, Id}) of + case ssl_session_cache:lookup(ClientCache, {{Host, Port}, Id}) of undefined -> - ok; + ok; #session{is_resumable = false} -> - ok; + ok; _ -> ct:sleep(?SLEEP), - make_sure_expired(Host, Port, Id) + make_sure_expired(Host, Port, Id) end. %%-------------------------------------------------------------------- @@ -4472,6 +4378,789 @@ accept_pool(Config) when is_list(Config) -> ssl_test_lib:close(Client1), ssl_test_lib:close(Client2). +%%-------------------------------------------------------------------- +%% TLS 1.3 +%%-------------------------------------------------------------------- + +tls13_enable_client_side() -> + [{doc,"Test that a TLS 1.3 client can connect to a TLS 1.2 server."}]. + +tls13_enable_client_side(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, protocol_info_result, []}}, + {options, [{versions, + ['tlsv1.1', 'tlsv1.2']} | ServerOpts] }]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, protocol_info_result, []}}, + {options, [{versions, + ['tlsv1.2', 'tlsv1.3']} | ClientOpts]}]), + + ServerMsg = ClientMsg = {ok, 'tlsv1.2'}, + ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg). + +tls13_enable_server_side() -> + [{doc,"Test that a TLS 1.2 client can connect to a TLS 1.3 server."}]. + +tls13_enable_server_side(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, protocol_info_result, []}}, + {options, [{versions, + ['tlsv1.2', 'tlsv1.3']} | ServerOpts] }]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, protocol_info_result, []}}, + {options, [{versions, + ['tlsv1.2', 'tlsv1.1']} | ClientOpts]}]), + + ServerMsg = ClientMsg = {ok, 'tlsv1.2'}, + ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg). + +tls_record_1_3_encode_decode() -> + [{doc,"Test TLS 1.3 record encode/decode functions"}]. + +tls_record_1_3_encode_decode(_Config) -> + ConnectionStates = + #{current_read => + #{beast_mitigation => one_n_minus_one, + cipher_state => + {cipher_state, + <<14,172,111,243,199,170,242,203,126,205,34,93,122,115,226,14, + 15,117,155,48,24,112,61,15,113,208,127,51,179,227,194,232>>, + <<197,54,168,218,54,91,157,58,30,201,197,142,51,58,53,231,228, + 131,57,122,170,78,82,196,30,48,23,16,95,255,185,236>>, + undefined,undefined,16}, + client_verify_data => undefined,compression_state => undefined, + mac_secret => undefined,secure_renegotiation => undefined, + security_parameters => + {security_parameters, + <<19,2>>, + 0,8,2,undefined,undefined,undefined,undefined,undefined, + sha384,undefined,undefined, + {handshake_secret, + <<128,229,186,211,62,127,182,20,62,166,233,23,135,64,121, + 3,104,251,214,161,253,31,3,2,232,37,8,221,189,72,64,218, + 121,41,112,148,254,34,68,164,228,60,161,201,132,55,56, + 157>>}, + undefined, + <<92,24,205,75,244,60,136,212,250,32,214,20,37,3,213,87,61,207, + 147,61,168,145,177,118,160,153,33,53,48,108,191,174>>, + undefined}, + sequence_number => 0,server_verify_data => undefined}, + current_write => + #{beast_mitigation => one_n_minus_one, + cipher_state => + {cipher_state, + <<14,172,111,243,199,170,242,203,126,205,34,93,122,115,226,14, + 15,117,155,48,24,112,61,15,113,208,127,51,179,227,194,232>>, + <<197,54,168,218,54,91,157,58,30,201,197,142,51,58,53,231,228, + 131,57,122,170,78,82,196,30,48,23,16,95,255,185,236>>, + undefined,undefined,16}, + client_verify_data => undefined,compression_state => undefined, + mac_secret => undefined,secure_renegotiation => undefined, + security_parameters => + {security_parameters, + <<19,2>>, + 0,8,2,undefined,undefined,undefined,undefined,undefined, + sha384,undefined,undefined, + {handshake_secret, + <<128,229,186,211,62,127,182,20,62,166,233,23,135,64,121, + 3,104,251,214,161,253,31,3,2,232,37,8,221,189,72,64,218, + 121,41,112,148,254,34,68,164,228,60,161,201,132,55,56, + 157>>}, + undefined, + <<92,24,205,75,244,60,136,212,250,32,214,20,37,3,213,87,61,207, + 147,61,168,145,177,118,160,153,33,53,48,108,191,174>>, + undefined}, + sequence_number => 0,server_verify_data => undefined}}, + + PlainText = [11, + <<0,2,175>>, + <<0,0,2,171,0,2,166,48,130,2,162,48,130,1,138,2,9,0,186,57,220,137,88,255, + 191,235,48,13,6,9,42,134,72,134,247,13,1,1,11,5,0,48,18,49,16,48,14,6,3,85, + 4,3,12,7,84,101,115,116,32,67,65,48,30,23,13,49,56,48,53,48,52,49,52,49,50, + 51,56,90,23,13,50,56,48,50,48,52,49,52,49,50,51,56,90,48,20,49,18,48,16,6, + 3,85,4,3,12,9,108,111,99,97,108,104,111,115,116,48,130,1,34,48,13,6,9,42, + 134,72,134,247,13,1,1,1,5,0,3,130,1,15,0,48,130,1,10,2,130,1,1,0,169,40, + 144,176,121,63,134,97,144,126,243,183,225,157,37,131,183,225,87,243,23,88, + 230,70,9,134,32,147,7,27,167,98,51,81,224,75,199,12,229,251,195,207,75,179, + 181,78,128,3,255,44,58,39,43,172,142,45,186,58,51,65,187,199,154,153,245, + 70,133,137,1,27,87,42,116,65,251,129,109,145,233,97,171,71,54,213,185,74, + 209,166,11,218,189,119,206,86,170,60,212,213,85,189,30,50,215,23,185,53, + 132,238,132,176,198,250,139,251,198,221,225,128,109,113,23,220,39,143,71, + 30,59,189,51,244,61,158,214,146,180,196,103,169,189,221,136,78,129,216,148, + 2,9,8,65,37,224,215,233,13,209,21,235,20,143,33,74,59,53,208,90,152,94,251, + 54,114,171,39,88,230,227,158,211,135,37,182,67,205,161,59,20,138,58,253,15, + 53,48,8,157,9,95,197,9,177,116,21,54,9,125,78,109,182,83,20,16,234,223,116, + 41,155,123,87,77,17,120,153,246,239,124,130,105,219,166,146,242,151,66,198, + 75,72,63,28,246,86,16,244,223,22,36,50,15,247,222,98,6,152,136,154,72,150, + 73,127,2,3,1,0,1,48,13,6,9,42,134,72,134,247,13,1,1,11,5,0,3,130,1,1,0,76, + 33,54,160,229,219,219,193,150,116,245,252,18,39,235,145,86,12,167,171,52, + 117,166,30,83,5,216,245,177,217,247,95,1,136,94,246,212,108,248,230,111, + 225,202,189,6,129,8,70,128,245,18,204,215,87,82,129,253,227,122,66,182,184, + 189,30,193,169,144,218,216,109,105,110,215,144,60,104,162,178,101,164,218, + 122,60,37,41,143,57,150,52,59,51,112,238,113,239,168,114,69,183,143,154,73, + 61,58,80,247,172,95,251,55,28,186,28,200,206,230,118,243,92,202,189,49,76, + 124,252,76,0,247,112,85,194,69,59,222,163,228,103,49,110,104,109,251,155, + 138,9,37,167,49,189,48,134,52,158,185,129,24,96,153,196,251,90,206,76,239, + 175,119,174,165,133,108,222,125,237,125,187,149,152,83,190,16,202,94,202, + 201,40,218,22,254,63,189,41,174,97,140,203,70,18,196,118,237,175,134,79,78, + 246,2,61,54,77,186,112,32,17,193,192,188,217,252,215,200,7,245,180,179,132, + 183,212,229,155,15,152,206,135,56,81,88,3,123,244,149,110,182,72,109,70,62, + 146,152,146,151,107,126,216,210,9,93,0,0>>], + + {[_Header|Encoded], _} = tls_record_1_3:encode_plain_text(22, PlainText, ConnectionStates), + CipherText = #ssl_tls{type = 23, version = {3,3}, fragment = Encoded}, + + {#ssl_tls{type = 22, version = {3,4}, fragment = DecodedText}, _} = + tls_record_1_3:decode_cipher_text(CipherText, ConnectionStates), + + DecodedText = iolist_to_binary(PlainText), + ct:log("Decoded: ~p ~n", [DecodedText]), + ok. + +tls13_1_RTT_handshake() -> + [{doc,"Test TLS 1.3 1-RTT Handshake"}]. + +tls13_1_RTT_handshake(_Config) -> + %% ConnectionStates with NULL cipher + ConnStatesNull = + #{current_write => + #{security_parameters => + #security_parameters{cipher_suite = ?TLS_NULL_WITH_NULL_NULL}, + sequence_number => 0 + } + }, + + %% {client} construct a ClientHello handshake message: + %% + %% ClientHello (196 octets): 01 00 00 c0 03 03 cb 34 ec b1 e7 81 63 + %% ba 1c 38 c6 da cb 19 6a 6d ff a2 1a 8d 99 12 ec 18 a2 ef 62 83 + %% 02 4d ec e7 00 00 06 13 01 13 03 13 02 01 00 00 91 00 00 00 0b + %% 00 09 00 00 06 73 65 72 76 65 72 ff 01 00 01 00 00 0a 00 14 00 + %% 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 01 03 01 04 00 23 + %% 00 00 00 33 00 26 00 24 00 1d 00 20 99 38 1d e5 60 e4 bd 43 d2 + %% 3d 8e 43 5a 7d ba fe b3 c0 6e 51 c1 3c ae 4d 54 13 69 1e 52 9a + %% af 2c 00 2b 00 03 02 03 04 00 0d 00 20 00 1e 04 03 05 03 06 03 + %% 02 03 08 04 08 05 08 06 04 01 05 01 06 01 02 01 04 02 05 02 06 + %% 02 02 02 00 2d 00 02 01 01 00 1c 00 02 40 01 + %% + %% {client} send handshake record: + %% + %% payload (196 octets): 01 00 00 c0 03 03 cb 34 ec b1 e7 81 63 ba + %% 1c 38 c6 da cb 19 6a 6d ff a2 1a 8d 99 12 ec 18 a2 ef 62 83 02 + %% 4d ec e7 00 00 06 13 01 13 03 13 02 01 00 00 91 00 00 00 0b 00 + %% 09 00 00 06 73 65 72 76 65 72 ff 01 00 01 00 00 0a 00 14 00 12 + %% 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 01 03 01 04 00 23 00 + %% 00 00 33 00 26 00 24 00 1d 00 20 99 38 1d e5 60 e4 bd 43 d2 3d + %% 8e 43 5a 7d ba fe b3 c0 6e 51 c1 3c ae 4d 54 13 69 1e 52 9a af + %% 2c 00 2b 00 03 02 03 04 00 0d 00 20 00 1e 04 03 05 03 06 03 02 + %% 03 08 04 08 05 08 06 04 01 05 01 06 01 02 01 04 02 05 02 06 02 + %% 02 02 00 2d 00 02 01 01 00 1c 00 02 40 01 + %% + %% complete record (201 octets): 16 03 01 00 c4 01 00 00 c0 03 03 cb + %% 34 ec b1 e7 81 63 ba 1c 38 c6 da cb 19 6a 6d ff a2 1a 8d 99 12 + %% ec 18 a2 ef 62 83 02 4d ec e7 00 00 06 13 01 13 03 13 02 01 00 + %% 00 91 00 00 00 0b 00 09 00 00 06 73 65 72 76 65 72 ff 01 00 01 + %% 00 00 0a 00 14 00 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 + %% 01 03 01 04 00 23 00 00 00 33 00 26 00 24 00 1d 00 20 99 38 1d + %% e5 60 e4 bd 43 d2 3d 8e 43 5a 7d ba fe b3 c0 6e 51 c1 3c ae 4d + %% 54 13 69 1e 52 9a af 2c 00 2b 00 03 02 03 04 00 0d 00 20 00 1e + %% 04 03 05 03 06 03 02 03 08 04 08 05 08 06 04 01 05 01 06 01 02 + %% 01 04 02 05 02 06 02 02 02 00 2d 00 02 01 01 00 1c 00 02 40 01 + ClientHello = + hexstr2bin("01 00 00 c0 03 03 cb 34 ec b1 e7 81 63 + ba 1c 38 c6 da cb 19 6a 6d ff a2 1a 8d 99 12 ec 18 a2 ef 62 83 + 02 4d ec e7 00 00 06 13 01 13 03 13 02 01 00 00 91 00 00 00 0b + 00 09 00 00 06 73 65 72 76 65 72 ff 01 00 01 00 00 0a 00 14 00 + 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 01 03 01 04 00 23 + 00 00 00 33 00 26 00 24 00 1d 00 20 99 38 1d e5 60 e4 bd 43 d2 + 3d 8e 43 5a 7d ba fe b3 c0 6e 51 c1 3c ae 4d 54 13 69 1e 52 9a + af 2c 00 2b 00 03 02 03 04 00 0d 00 20 00 1e 04 03 05 03 06 03 + 02 03 08 04 08 05 08 06 04 01 05 01 06 01 02 01 04 02 05 02 06 + 02 02 02 00 2d 00 02 01 01 00 1c 00 02 40 01"), + + ClientHelloRecord = + %% Current implementation always sets + %% legacy_record_version to Ox0303 + hexstr2bin("16 03 03 00 c4 01 00 00 c0 03 03 cb + 34 ec b1 e7 81 63 ba 1c 38 c6 da cb 19 6a 6d ff a2 1a 8d 99 12 + ec 18 a2 ef 62 83 02 4d ec e7 00 00 06 13 01 13 03 13 02 01 00 + 00 91 00 00 00 0b 00 09 00 00 06 73 65 72 76 65 72 ff 01 00 01 + 00 00 0a 00 14 00 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 + 01 03 01 04 00 23 00 00 00 33 00 26 00 24 00 1d 00 20 99 38 1d + e5 60 e4 bd 43 d2 3d 8e 43 5a 7d ba fe b3 c0 6e 51 c1 3c ae 4d + 54 13 69 1e 52 9a af 2c 00 2b 00 03 02 03 04 00 0d 00 20 00 1e + 04 03 05 03 06 03 02 03 08 04 08 05 08 06 04 01 05 01 06 01 02 + 01 04 02 05 02 06 02 02 02 00 2d 00 02 01 01 00 1c 00 02 40 01"), + + {CHEncrypted, _} = + tls_record:encode_handshake(ClientHello, {3,4}, ConnStatesNull), + ClientHelloRecord = iolist_to_binary(CHEncrypted), + + %% {server} extract secret "early": + %% + %% salt: 0 (all zero octets) + %% + %% IKM (32 octets): 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 + %% 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 + %% + %% secret (32 octets): 33 ad 0a 1c 60 7e c0 3b 09 e6 cd 98 93 68 0c + %% e2 10 ad f3 00 aa 1f 26 60 e1 b2 2e 10 f1 70 f9 2a + HKDFAlgo = sha256, + Salt = binary:copy(<<?BYTE(0)>>, 32), + IKM = binary:copy(<<?BYTE(0)>>, 32), + EarlySecret = + hexstr2bin("33 ad 0a 1c 60 7e c0 3b 09 e6 cd 98 93 68 0c + e2 10 ad f3 00 aa 1f 26 60 e1 b2 2e 10 f1 70 f9 2a"), + + {early_secret, EarlySecret} = tls_v1:key_schedule(early_secret, HKDFAlgo, {psk, Salt}), + + %% {client} create an ephemeral x25519 key pair: + %% + %% private key (32 octets): 49 af 42 ba 7f 79 94 85 2d 71 3e f2 78 + %% 4b cb ca a7 91 1d e2 6a dc 56 42 cb 63 45 40 e7 ea 50 05 + %% + %% public key (32 octets): 99 38 1d e5 60 e4 bd 43 d2 3d 8e 43 5a 7d + %% ba fe b3 c0 6e 51 c1 3c ae 4d 54 13 69 1e 52 9a af 2c + CPublicKey = + hexstr2bin("99 38 1d e5 60 e4 bd 43 d2 3d 8e 43 5a 7d + ba fe b3 c0 6e 51 c1 3c ae 4d 54 13 69 1e 52 9a af 2c"), + + %% {server} create an ephemeral x25519 key pair: + %% + %% private key (32 octets): b1 58 0e ea df 6d d5 89 b8 ef 4f 2d 56 + %% 52 57 8c c8 10 e9 98 01 91 ec 8d 05 83 08 ce a2 16 a2 1e + %% + %% public key (32 octets): c9 82 88 76 11 20 95 fe 66 76 2b db f7 c6 + %% 72 e1 56 d6 cc 25 3b 83 3d f1 dd 69 b1 b0 4e 75 1f 0f + SPrivateKey = + hexstr2bin("b1 58 0e ea df 6d d5 89 b8 ef 4f 2d 56 + 52 57 8c c8 10 e9 98 01 91 ec 8d 05 83 08 ce a2 16 a2 1e"), + + SPublicKey = + hexstr2bin("c9 82 88 76 11 20 95 fe 66 76 2b db f7 c6 + 72 e1 56 d6 cc 25 3b 83 3d f1 dd 69 b1 b0 4e 75 1f 0f"), + + %% {server} construct a ServerHello handshake message: + %% + %% ServerHello (90 octets): 02 00 00 56 03 03 a6 af 06 a4 12 18 60 + %% dc 5e 6e 60 24 9c d3 4c 95 93 0c 8a c5 cb 14 34 da c1 55 77 2e + %% d3 e2 69 28 00 13 01 00 00 2e 00 33 00 24 00 1d 00 20 c9 82 88 + %% 76 11 20 95 fe 66 76 2b db f7 c6 72 e1 56 d6 cc 25 3b 83 3d f1 + %% dd 69 b1 b0 4e 75 1f 0f 00 2b 00 02 03 04 + ServerHello = + hexstr2bin("02 00 00 56 03 03 a6 af 06 a4 12 18 60 + dc 5e 6e 60 24 9c d3 4c 95 93 0c 8a c5 cb 14 34 da c1 55 77 2e + d3 e2 69 28 00 13 01 00 00 2e 00 33 00 24 00 1d 00 20 c9 82 88 + 76 11 20 95 fe 66 76 2b db f7 c6 72 e1 56 d6 cc 25 3b 83 3d f1 + dd 69 b1 b0 4e 75 1f 0f 00 2b 00 02 03 04"), + + %% {server} derive secret for handshake "tls13 derived": + %% + %% PRK (32 octets): 33 ad 0a 1c 60 7e c0 3b 09 e6 cd 98 93 68 0c e2 + %% 10 ad f3 00 aa 1f 26 60 e1 b2 2e 10 f1 70 f9 2a + %% + %% hash (32 octets): e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24 + %% 27 ae 41 e4 64 9b 93 4c a4 95 99 1b 78 52 b8 55 + %% + %% info (49 octets): 00 20 0d 74 6c 73 31 33 20 64 65 72 69 76 65 64 + %% 20 e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24 27 ae 41 e4 + %% 64 9b 93 4c a4 95 99 1b 78 52 b8 55 + %% + %% expanded (32 octets): 6f 26 15 a1 08 c7 02 c5 67 8f 54 fc 9d ba + %% b6 97 16 c0 76 18 9c 48 25 0c eb ea c3 57 6c 36 11 ba + Hash = + hexstr2bin("e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24 + 27 ae 41 e4 64 9b 93 4c a4 95 99 1b 78 52 b8 55"), + + Hash = crypto:hash(HKDFAlgo, <<>>), + + Info = + hexstr2bin("00 20 0d 74 6c 73 31 33 20 64 65 72 69 76 65 64 + 20 e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24 27 ae 41 e4 + 64 9b 93 4c a4 95 99 1b 78 52 b8 55"), + + Info = tls_v1:create_info(<<"derived">>, Hash, ssl_cipher:hash_size(HKDFAlgo)), + + Expanded = + hexstr2bin("6f 26 15 a1 08 c7 02 c5 67 8f 54 fc 9d ba + b6 97 16 c0 76 18 9c 48 25 0c eb ea c3 57 6c 36 11 ba"), + + Expanded = tls_v1:derive_secret(EarlySecret, <<"derived">>, <<>>, HKDFAlgo), + + %% {server} extract secret "handshake": + %% + %% salt (32 octets): 6f 26 15 a1 08 c7 02 c5 67 8f 54 fc 9d ba b6 97 + %% 16 c0 76 18 9c 48 25 0c eb ea c3 57 6c 36 11 ba + %% + %% IKM (32 octets): 8b d4 05 4f b5 5b 9d 63 fd fb ac f9 f0 4b 9f 0d + %% 35 e6 d6 3f 53 75 63 ef d4 62 72 90 0f 89 49 2d + %% + %% secret (32 octets): 1d c8 26 e9 36 06 aa 6f dc 0a ad c1 2f 74 1b + %% 01 04 6a a6 b9 9f 69 1e d2 21 a9 f0 ca 04 3f be ac + + %% salt = Expanded + HandshakeIKM = + hexstr2bin("8b d4 05 4f b5 5b 9d 63 fd fb ac f9 f0 4b 9f 0d + 35 e6 d6 3f 53 75 63 ef d4 62 72 90 0f 89 49 2d"), + + HandshakeSecret = + hexstr2bin("1d c8 26 e9 36 06 aa 6f dc 0a ad c1 2f 74 1b + 01 04 6a a6 b9 9f 69 1e d2 21 a9 f0 ca 04 3f be ac"), + + HandshakeIKM = crypto:compute_key(ecdh, CPublicKey, SPrivateKey, x25519), + + {handshake_secret, HandshakeSecret} = + tls_v1:key_schedule(handshake_secret, HKDFAlgo, HandshakeIKM, + {early_secret, EarlySecret}), + + %% {server} derive secret "tls13 c hs traffic": + %% + %% PRK (32 octets): 1d c8 26 e9 36 06 aa 6f dc 0a ad c1 2f 74 1b 01 + %% 04 6a a6 b9 9f 69 1e d2 21 a9 f0 ca 04 3f be ac + %% + %% hash (32 octets): 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58 ed + %% d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8 + %% + %% info (54 octets): 00 20 12 74 6c 73 31 33 20 63 20 68 73 20 74 72 + %% 61 66 66 69 63 20 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58 + %% ed d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8 + %% + %% expanded (32 octets): b3 ed db 12 6e 06 7f 35 a7 80 b3 ab f4 5e + %% 2d 8f 3b 1a 95 07 38 f5 2e 96 00 74 6a 0e 27 a5 5a 21 + + %% PRK = HandshakeSecret + CHSTHash = + hexstr2bin("86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58 ed + d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8"), + + CHSTInfo = + hexstr2bin("00 20 12 74 6c 73 31 33 20 63 20 68 73 20 74 72 + 61 66 66 69 63 20 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58 + ed d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8"), + + CHSTrafficSecret = + hexstr2bin(" b3 ed db 12 6e 06 7f 35 a7 80 b3 ab f4 5e + 2d 8f 3b 1a 95 07 38 f5 2e 96 00 74 6a 0e 27 a5 5a 21"), + + CHSH = <<ClientHello/binary,ServerHello/binary>>, + CHSTHash = crypto:hash(HKDFAlgo, CHSH), + CHSTInfo = tls_v1:create_info(<<"c hs traffic">>, CHSTHash, ssl_cipher:hash_size(HKDFAlgo)), + + CHSTrafficSecret = + tls_v1:client_handshake_traffic_secret(HKDFAlgo, {handshake_secret, HandshakeSecret}, CHSH), + + %% {server} derive secret "tls13 s hs traffic": + %% + %% PRK (32 octets): 1d c8 26 e9 36 06 aa 6f dc 0a ad c1 2f 74 1b 01 + %% 04 6a a6 b9 9f 69 1e d2 21 a9 f0 ca 04 3f be ac + %% + %% hash (32 octets): 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58 ed + %% d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8 + %% + %% info (54 octets): 00 20 12 74 6c 73 31 33 20 73 20 68 73 20 74 72 + %% 61 66 66 69 63 20 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58 + %% ed d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8 + %% + %% expanded (32 octets): b6 7b 7d 69 0c c1 6c 4e 75 e5 42 13 cb 2d + %% 37 b4 e9 c9 12 bc de d9 10 5d 42 be fd 59 d3 91 ad 38 + + %% PRK = HandshakeSecret + %% hash = CHSTHash + SHSTInfo = + hexstr2bin("00 20 12 74 6c 73 31 33 20 73 20 68 73 20 74 72 + 61 66 66 69 63 20 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58 + ed d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8"), + + SHSTrafficSecret = + hexstr2bin("b6 7b 7d 69 0c c1 6c 4e 75 e5 42 13 cb 2d + 37 b4 e9 c9 12 bc de d9 10 5d 42 be fd 59 d3 91 ad 38"), + + SHSTInfo = tls_v1:create_info(<<"s hs traffic">>, CHSTHash, ssl_cipher:hash_size(HKDFAlgo)), + + SHSTrafficSecret = + tls_v1:server_handshake_traffic_secret(HKDFAlgo, {handshake_secret, HandshakeSecret}, CHSH), + + + %% {server} derive secret for master "tls13 derived": + %% + %% PRK (32 octets): 1d c8 26 e9 36 06 aa 6f dc 0a ad c1 2f 74 1b 01 + %% 04 6a a6 b9 9f 69 1e d2 21 a9 f0 ca 04 3f be ac + %% + %% hash (32 octets): e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24 + %% 27 ae 41 e4 64 9b 93 4c a4 95 99 1b 78 52 b8 55 + %% + %% info (49 octets): 00 20 0d 74 6c 73 31 33 20 64 65 72 69 76 65 64 + %% 20 e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24 27 ae 41 e4 + %% 64 9b 93 4c a4 95 99 1b 78 52 b8 55 + %% + %% expanded (32 octets): 43 de 77 e0 c7 77 13 85 9a 94 4d b9 db 25 + %% 90 b5 31 90 a6 5b 3e e2 e4 f1 2d d7 a0 bb 7c e2 54 b4 + + %% PRK = HandshakeSecret + %% hash = Hash + %% info = Info + MasterDeriveSecret = + hexstr2bin("43 de 77 e0 c7 77 13 85 9a 94 4d b9 db 25 + 90 b5 31 90 a6 5b 3e e2 e4 f1 2d d7 a0 bb 7c e2 54 b4"), + + MasterDeriveSecret = tls_v1:derive_secret(HandshakeSecret, <<"derived">>, <<>>, HKDFAlgo), + + %% {server} extract secret "master": + %% + %% salt (32 octets): 43 de 77 e0 c7 77 13 85 9a 94 4d b9 db 25 90 b5 + %% 31 90 a6 5b 3e e2 e4 f1 2d d7 a0 bb 7c e2 54 b4 + %% + %% IKM (32 octets): 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 + %% 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 + %% + %% secret (32 octets): 18 df 06 84 3d 13 a0 8b f2 a4 49 84 4c 5f 8a + %% 47 80 01 bc 4d 4c 62 79 84 d5 a4 1d a8 d0 40 29 19 + + %% salt = MasterDeriveSecret + %% IKM = IKM + MasterSecret = + hexstr2bin("18 df 06 84 3d 13 a0 8b f2 a4 49 84 4c 5f 8a + 47 80 01 bc 4d 4c 62 79 84 d5 a4 1d a8 d0 40 29 19"), + + {master_secret, MasterSecret} = + tls_v1:key_schedule(master_secret, HKDFAlgo, {handshake_secret, HandshakeSecret}), + + %% {server} send handshake record: + %% + %% payload (90 octets): 02 00 00 56 03 03 a6 af 06 a4 12 18 60 dc 5e + %% 6e 60 24 9c d3 4c 95 93 0c 8a c5 cb 14 34 da c1 55 77 2e d3 e2 + %% 69 28 00 13 01 00 00 2e 00 33 00 24 00 1d 00 20 c9 82 88 76 11 + %% 20 95 fe 66 76 2b db f7 c6 72 e1 56 d6 cc 25 3b 83 3d f1 dd 69 + %% b1 b0 4e 75 1f 0f 00 2b 00 02 03 04 + %% + %% complete record (95 octets): 16 03 03 00 5a 02 00 00 56 03 03 a6 + %% af 06 a4 12 18 60 dc 5e 6e 60 24 9c d3 4c 95 93 0c 8a c5 cb 14 + %% 34 da c1 55 77 2e d3 e2 69 28 00 13 01 00 00 2e 00 33 00 24 00 + %% 1d 00 20 c9 82 88 76 11 20 95 fe 66 76 2b db f7 c6 72 e1 56 d6 + %% cc 25 3b 83 3d f1 dd 69 b1 b0 4e 75 1f 0f 00 2b 00 02 03 04 + + %% payload = ServerHello + ServerHelloRecord = + hexstr2bin("16 03 03 00 5a 02 00 00 56 03 03 a6 + af 06 a4 12 18 60 dc 5e 6e 60 24 9c d3 4c 95 93 0c 8a c5 cb 14 + 34 da c1 55 77 2e d3 e2 69 28 00 13 01 00 00 2e 00 33 00 24 00 + 1d 00 20 c9 82 88 76 11 20 95 fe 66 76 2b db f7 c6 72 e1 56 d6 + cc 25 3b 83 3d f1 dd 69 b1 b0 4e 75 1f 0f 00 2b 00 02 03 04"), + + {SHEncrypted, _} = + tls_record:encode_handshake(ServerHello, {3,4}, ConnStatesNull), + ServerHelloRecord = iolist_to_binary(SHEncrypted), + + %% {server} derive write traffic keys for handshake data: + %% + %% PRK (32 octets): b6 7b 7d 69 0c c1 6c 4e 75 e5 42 13 cb 2d 37 b4 + %% e9 c9 12 bc de d9 10 5d 42 be fd 59 d3 91 ad 38 + %% + %% key info (13 octets): 00 10 09 74 6c 73 31 33 20 6b 65 79 00 + %% + %% key expanded (16 octets): 3f ce 51 60 09 c2 17 27 d0 f2 e4 e8 6e + %% e4 03 bc + %% + %% iv info (12 octets): 00 0c 08 74 6c 73 31 33 20 69 76 00 + %% + %% iv expanded (12 octets): 5d 31 3e b2 67 12 76 ee 13 00 0b 30 + + %% PRK = SHSTrafficSecret + WriteKeyInfo = + hexstr2bin("00 10 09 74 6c 73 31 33 20 6b 65 79 00"), + + WriteKey = + hexstr2bin("3f ce 51 60 09 c2 17 27 d0 f2 e4 e8 6e e4 03 bc"), + + WriteIVInfo = + hexstr2bin("00 0c 08 74 6c 73 31 33 20 69 76 00"), + + WriteIV = + hexstr2bin(" 5d 31 3e b2 67 12 76 ee 13 00 0b 30"), + + Cipher = aes_128_gcm, %% TODO: get from ServerHello + + WriteKeyInfo = tls_v1:create_info(<<"key">>, <<>>, ssl_cipher:key_material(Cipher)), + %% TODO: remove hardcoded IV size + WriteIVInfo = tls_v1:create_info(<<"iv">>, <<>>, 12), + + {WriteKey, WriteIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, SHSTrafficSecret), + + %% {server} construct an EncryptedExtensions handshake message: + %% + %% EncryptedExtensions (40 octets): 08 00 00 24 00 22 00 0a 00 14 00 + %% 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 01 03 01 04 00 1c + %% 00 02 40 01 00 00 00 00 + %% + %% {server} construct a Certificate handshake message: + %% + %% Certificate (445 octets): 0b 00 01 b9 00 00 01 b5 00 01 b0 30 82 + %% 01 ac 30 82 01 15 a0 03 02 01 02 02 01 02 30 0d 06 09 2a 86 48 + %% 86 f7 0d 01 01 0b 05 00 30 0e 31 0c 30 0a 06 03 55 04 03 13 03 + %% 72 73 61 30 1e 17 0d 31 36 30 37 33 30 30 31 32 33 35 39 5a 17 + %% 0d 32 36 30 37 33 30 30 31 32 33 35 39 5a 30 0e 31 0c 30 0a 06 + %% 03 55 04 03 13 03 72 73 61 30 81 9f 30 0d 06 09 2a 86 48 86 f7 + %% 0d 01 01 01 05 00 03 81 8d 00 30 81 89 02 81 81 00 b4 bb 49 8f + %% 82 79 30 3d 98 08 36 39 9b 36 c6 98 8c 0c 68 de 55 e1 bd b8 26 + %% d3 90 1a 24 61 ea fd 2d e4 9a 91 d0 15 ab bc 9a 95 13 7a ce 6c + %% 1a f1 9e aa 6a f9 8c 7c ed 43 12 09 98 e1 87 a8 0e e0 cc b0 52 + %% 4b 1b 01 8c 3e 0b 63 26 4d 44 9a 6d 38 e2 2a 5f da 43 08 46 74 + %% 80 30 53 0e f0 46 1c 8c a9 d9 ef bf ae 8e a6 d1 d0 3e 2b d1 93 + %% ef f0 ab 9a 80 02 c4 74 28 a6 d3 5a 8d 88 d7 9f 7f 1e 3f 02 03 + %% 01 00 01 a3 1a 30 18 30 09 06 03 55 1d 13 04 02 30 00 30 0b 06 + %% 03 55 1d 0f 04 04 03 02 05 a0 30 0d 06 09 2a 86 48 86 f7 0d 01 + %% 01 0b 05 00 03 81 81 00 85 aa d2 a0 e5 b9 27 6b 90 8c 65 f7 3a + %% 72 67 17 06 18 a5 4c 5f 8a 7b 33 7d 2d f7 a5 94 36 54 17 f2 ea + %% e8 f8 a5 8c 8f 81 72 f9 31 9c f3 6b 7f d6 c5 5b 80 f2 1a 03 01 + %% 51 56 72 60 96 fd 33 5e 5e 67 f2 db f1 02 70 2e 60 8c ca e6 be + %% c1 fc 63 a4 2a 99 be 5c 3e b7 10 7c 3c 54 e9 b9 eb 2b d5 20 3b + %% 1c 3b 84 e0 a8 b2 f7 59 40 9b a3 ea c9 d9 1d 40 2d cc 0c c8 f8 + %% 96 12 29 ac 91 87 b4 2b 4d e1 00 00 + %% + %% {server} construct a CertificateVerify handshake message: + %% + %% CertificateVerify (136 octets): 0f 00 00 84 08 04 00 80 5a 74 7c + %% 5d 88 fa 9b d2 e5 5a b0 85 a6 10 15 b7 21 1f 82 4c d4 84 14 5a + %% b3 ff 52 f1 fd a8 47 7b 0b 7a bc 90 db 78 e2 d3 3a 5c 14 1a 07 + %% 86 53 fa 6b ef 78 0c 5e a2 48 ee aa a7 85 c4 f3 94 ca b6 d3 0b + %% be 8d 48 59 ee 51 1f 60 29 57 b1 54 11 ac 02 76 71 45 9e 46 44 + %% 5c 9e a5 8c 18 1e 81 8e 95 b8 c3 fb 0b f3 27 84 09 d3 be 15 2a + %% 3d a5 04 3e 06 3d da 65 cd f5 ae a2 0d 53 df ac d4 2f 74 f3 + EncryptedExtensions = + hexstr2bin("08 00 00 24 00 22 00 0a 00 14 00 + 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 01 03 01 04 00 1c + 00 02 40 01 00 00 00 00"), + + Certificate = + hexstr2bin("0b 00 01 b9 00 00 01 b5 00 01 b0 30 82 + 01 ac 30 82 01 15 a0 03 02 01 02 02 01 02 30 0d 06 09 2a 86 48 + 86 f7 0d 01 01 0b 05 00 30 0e 31 0c 30 0a 06 03 55 04 03 13 03 + 72 73 61 30 1e 17 0d 31 36 30 37 33 30 30 31 32 33 35 39 5a 17 + 0d 32 36 30 37 33 30 30 31 32 33 35 39 5a 30 0e 31 0c 30 0a 06 + 03 55 04 03 13 03 72 73 61 30 81 9f 30 0d 06 09 2a 86 48 86 f7 + 0d 01 01 01 05 00 03 81 8d 00 30 81 89 02 81 81 00 b4 bb 49 8f + 82 79 30 3d 98 08 36 39 9b 36 c6 98 8c 0c 68 de 55 e1 bd b8 26 + d3 90 1a 24 61 ea fd 2d e4 9a 91 d0 15 ab bc 9a 95 13 7a ce 6c + 1a f1 9e aa 6a f9 8c 7c ed 43 12 09 98 e1 87 a8 0e e0 cc b0 52 + 4b 1b 01 8c 3e 0b 63 26 4d 44 9a 6d 38 e2 2a 5f da 43 08 46 74 + 80 30 53 0e f0 46 1c 8c a9 d9 ef bf ae 8e a6 d1 d0 3e 2b d1 93 + ef f0 ab 9a 80 02 c4 74 28 a6 d3 5a 8d 88 d7 9f 7f 1e 3f 02 03 + 01 00 01 a3 1a 30 18 30 09 06 03 55 1d 13 04 02 30 00 30 0b 06 + 03 55 1d 0f 04 04 03 02 05 a0 30 0d 06 09 2a 86 48 86 f7 0d 01 + 01 0b 05 00 03 81 81 00 85 aa d2 a0 e5 b9 27 6b 90 8c 65 f7 3a + 72 67 17 06 18 a5 4c 5f 8a 7b 33 7d 2d f7 a5 94 36 54 17 f2 ea + e8 f8 a5 8c 8f 81 72 f9 31 9c f3 6b 7f d6 c5 5b 80 f2 1a 03 01 + 51 56 72 60 96 fd 33 5e 5e 67 f2 db f1 02 70 2e 60 8c ca e6 be + c1 fc 63 a4 2a 99 be 5c 3e b7 10 7c 3c 54 e9 b9 eb 2b d5 20 3b + 1c 3b 84 e0 a8 b2 f7 59 40 9b a3 ea c9 d9 1d 40 2d cc 0c c8 f8 + 96 12 29 ac 91 87 b4 2b 4d e1 00 00"), + + CertificateVerify = + hexstr2bin("0f 00 00 84 08 04 00 80 5a 74 7c + 5d 88 fa 9b d2 e5 5a b0 85 a6 10 15 b7 21 1f 82 4c d4 84 14 5a + b3 ff 52 f1 fd a8 47 7b 0b 7a bc 90 db 78 e2 d3 3a 5c 14 1a 07 + 86 53 fa 6b ef 78 0c 5e a2 48 ee aa a7 85 c4 f3 94 ca b6 d3 0b + be 8d 48 59 ee 51 1f 60 29 57 b1 54 11 ac 02 76 71 45 9e 46 44 + 5c 9e a5 8c 18 1e 81 8e 95 b8 c3 fb 0b f3 27 84 09 d3 be 15 2a + 3d a5 04 3e 06 3d da 65 cd f5 ae a2 0d 53 df ac d4 2f 74 f3"), + + %% {server} calculate finished "tls13 finished": + %% + %% PRK (32 octets): b6 7b 7d 69 0c c1 6c 4e 75 e5 42 13 cb 2d 37 b4 + %% e9 c9 12 bc de d9 10 5d 42 be fd 59 d3 91 ad 38 + %% + %% hash (0 octets): (empty) + %% + %% info (18 octets): 00 20 0e 74 6c 73 31 33 20 66 69 6e 69 73 68 65 + %% 64 00 + %% + %% expanded (32 octets): 00 8d 3b 66 f8 16 ea 55 9f 96 b5 37 e8 85 + %% c3 1f c0 68 bf 49 2c 65 2f 01 f2 88 a1 d8 cd c1 9f c8 + %% + %% finished (32 octets): 9b 9b 14 1d 90 63 37 fb d2 cb dc e7 1d f4 + %% de da 4a b4 2c 30 95 72 cb 7f ff ee 54 54 b7 8f 07 18 + + %% PRK = SHSTrafficSecret + FInfo = + hexstr2bin("00 20 0e 74 6c 73 31 33 20 66 69 6e 69 73 68 65 + 64 00"), + + FExpanded = + hexstr2bin("00 8d 3b 66 f8 16 ea 55 9f 96 b5 37 e8 85 + c3 1f c0 68 bf 49 2c 65 2f 01 f2 88 a1 d8 cd c1 9f c8"), + + FinishedVerifyData = + hexstr2bin("9b 9b 14 1d 90 63 37 fb d2 cb dc e7 1d f4 + de da 4a b4 2c 30 95 72 cb 7f ff ee 54 54 b7 8f 07 18"), + + FInfo = tls_v1:create_info(<<"finished">>, <<>>, ssl_cipher:hash_size(HKDFAlgo)), + + FExpanded = tls_v1:finished_key(SHSTrafficSecret, HKDFAlgo), + + MessageHistory0 = [CertificateVerify, + Certificate, + EncryptedExtensions, + ServerHello, + ClientHello], + + FinishedVerifyData = tls_v1:finished_verify_data(FExpanded, HKDFAlgo, MessageHistory0), + + %% {server} construct a Finished handshake message: + %% + %% Finished (36 octets): 14 00 00 20 9b 9b 14 1d 90 63 37 fb d2 cb + %% dc e7 1d f4 de da 4a b4 2c 30 95 72 cb 7f ff ee 54 54 b7 8f 07 + %% 18 + FinishedHSBin = + hexstr2bin("14 00 00 20 9b 9b 14 1d 90 63 37 fb d2 cb + dc e7 1d f4 de da 4a b4 2c 30 95 72 cb 7f ff ee 54 54 b7 8f 07 + 18"), + + FinishedHS = #finished{verify_data = FinishedVerifyData}, + + FinishedIOList = tls_handshake:encode_handshake(FinishedHS, {3,4}), + FinishedHSBin = iolist_to_binary(FinishedIOList). + + +tls13_finished_verify_data() -> + [{doc,"Test TLS 1.3 Finished message handling"}]. + +tls13_finished_verify_data(_Config) -> + ClientHello = + hexstr2bin("01 00 00 c6 03 03 00 01 02 03 04 05 06 07 08 09 + 0a 0b 0c 0d 0e 0f 10 11 12 13 14 15 16 17 18 19 + 1a 1b 1c 1d 1e 1f 20 e0 e1 e2 e3 e4 e5 e6 e7 e8 + e9 ea eb ec ed ee ef f0 f1 f2 f3 f4 f5 f6 f7 f8 + f9 fa fb fc fd fe ff 00 06 13 01 13 02 13 03 01 + 00 00 77 00 00 00 18 00 16 00 00 13 65 78 61 6d + 70 6c 65 2e 75 6c 66 68 65 69 6d 2e 6e 65 74 00 + 0a 00 08 00 06 00 1d 00 17 00 18 00 0d 00 14 00 + 12 04 03 08 04 04 01 05 03 08 05 05 01 08 06 06 + 01 02 01 00 33 00 26 00 24 00 1d 00 20 35 80 72 + d6 36 58 80 d1 ae ea 32 9a df 91 21 38 38 51 ed + 21 a2 8e 3b 75 e9 65 d0 d2 cd 16 62 54 00 2d 00 + 02 01 01 00 2b 00 03 02 03 04"), + + ServerHello = + hexstr2bin("02 00 00 76 03 03 70 71 72 73 74 75 76 77 78 79 + 7a 7b 7c 7d 7e 7f 80 81 82 83 84 85 86 87 88 89 + 8a 8b 8c 8d 8e 8f 20 e0 e1 e2 e3 e4 e5 e6 e7 e8 + e9 ea eb ec ed ee ef f0 f1 f2 f3 f4 f5 f6 f7 f8 + f9 fa fb fc fd fe ff 13 01 00 00 2e 00 33 00 24 + 00 1d 00 20 9f d7 ad 6d cf f4 29 8d d3 f9 6d 5b + 1b 2a f9 10 a0 53 5b 14 88 d7 f8 fa bb 34 9a 98 + 28 80 b6 15 00 2b 00 02 03 04"), + + EncryptedExtensions = + hexstr2bin("08 00 00 02 00 00"), + + Certificate = + hexstr2bin("0b 00 03 2e 00 00 03 2a 00 03 25 30 82 03 21 30 + 82 02 09 a0 03 02 01 02 02 08 15 5a 92 ad c2 04 + 8f 90 30 0d 06 09 2a 86 48 86 f7 0d 01 01 0b 05 + 00 30 22 31 0b 30 09 06 03 55 04 06 13 02 55 53 + 31 13 30 11 06 03 55 04 0a 13 0a 45 78 61 6d 70 + 6c 65 20 43 41 30 1e 17 0d 31 38 31 30 30 35 30 + 31 33 38 31 37 5a 17 0d 31 39 31 30 30 35 30 31 + 33 38 31 37 5a 30 2b 31 0b 30 09 06 03 55 04 06 + 13 02 55 53 31 1c 30 1a 06 03 55 04 03 13 13 65 + 78 61 6d 70 6c 65 2e 75 6c 66 68 65 69 6d 2e 6e + 65 74 30 82 01 22 30 0d 06 09 2a 86 48 86 f7 0d + 01 01 01 05 00 03 82 01 0f 00 30 82 01 0a 02 82 + 01 01 00 c4 80 36 06 ba e7 47 6b 08 94 04 ec a7 + b6 91 04 3f f7 92 bc 19 ee fb 7d 74 d7 a8 0d 00 + 1e 7b 4b 3a 4a e6 0f e8 c0 71 fc 73 e7 02 4c 0d + bc f4 bd d1 1d 39 6b ba 70 46 4a 13 e9 4a f8 3d + f3 e1 09 59 54 7b c9 55 fb 41 2d a3 76 52 11 e1 + f3 dc 77 6c aa 53 37 6e ca 3a ec be c3 aa b7 3b + 31 d5 6c b6 52 9c 80 98 bc c9 e0 28 18 e2 0b f7 + f8 a0 3a fd 17 04 50 9e ce 79 bd 9f 39 f1 ea 69 + ec 47 97 2e 83 0f b5 ca 95 de 95 a1 e6 04 22 d5 + ee be 52 79 54 a1 e7 bf 8a 86 f6 46 6d 0d 9f 16 + 95 1a 4c f7 a0 46 92 59 5c 13 52 f2 54 9e 5a fb + 4e bf d7 7a 37 95 01 44 e4 c0 26 87 4c 65 3e 40 + 7d 7d 23 07 44 01 f4 84 ff d0 8f 7a 1f a0 52 10 + d1 f4 f0 d5 ce 79 70 29 32 e2 ca be 70 1f df ad + 6b 4b b7 11 01 f4 4b ad 66 6a 11 13 0f e2 ee 82 + 9e 4d 02 9d c9 1c dd 67 16 db b9 06 18 86 ed c1 + ba 94 21 02 03 01 00 01 a3 52 30 50 30 0e 06 03 + 55 1d 0f 01 01 ff 04 04 03 02 05 a0 30 1d 06 03 + 55 1d 25 04 16 30 14 06 08 2b 06 01 05 05 07 03 + 02 06 08 2b 06 01 05 05 07 03 01 30 1f 06 03 55 + 1d 23 04 18 30 16 80 14 89 4f de 5b cc 69 e2 52 + cf 3e a3 00 df b1 97 b8 1d e1 c1 46 30 0d 06 09 + 2a 86 48 86 f7 0d 01 01 0b 05 00 03 82 01 01 00 + 59 16 45 a6 9a 2e 37 79 e4 f6 dd 27 1a ba 1c 0b + fd 6c d7 55 99 b5 e7 c3 6e 53 3e ff 36 59 08 43 + 24 c9 e7 a5 04 07 9d 39 e0 d4 29 87 ff e3 eb dd + 09 c1 cf 1d 91 44 55 87 0b 57 1d d1 9b df 1d 24 + f8 bb 9a 11 fe 80 fd 59 2b a0 39 8c de 11 e2 65 + 1e 61 8c e5 98 fa 96 e5 37 2e ef 3d 24 8a fd e1 + 74 63 eb bf ab b8 e4 d1 ab 50 2a 54 ec 00 64 e9 + 2f 78 19 66 0d 3f 27 cf 20 9e 66 7f ce 5a e2 e4 + ac 99 c7 c9 38 18 f8 b2 51 07 22 df ed 97 f3 2e + 3e 93 49 d4 c6 6c 9e a6 39 6d 74 44 62 a0 6b 42 + c6 d5 ba 68 8e ac 3a 01 7b dd fc 8e 2c fc ad 27 + cb 69 d3 cc dc a2 80 41 44 65 d3 ae 34 8c e0 f3 + 4a b2 fb 9c 61 83 71 31 2b 19 10 41 64 1c 23 7f + 11 a5 d6 5c 84 4f 04 04 84 99 38 71 2b 95 9e d6 + 85 bc 5c 5d d6 45 ed 19 90 94 73 40 29 26 dc b4 + 0e 34 69 a1 59 41 e8 e2 cc a8 4b b6 08 46 36 a0 + 00 00"), + + CertificateVerify = + hexstr2bin("0f 00 01 04 08 04 01 00 17 fe b5 33 ca 6d 00 7d + 00 58 25 79 68 42 4b bc 3a a6 90 9e 9d 49 55 75 + 76 a5 20 e0 4a 5e f0 5f 0e 86 d2 4f f4 3f 8e b8 + 61 ee f5 95 22 8d 70 32 aa 36 0f 71 4e 66 74 13 + 92 6e f4 f8 b5 80 3b 69 e3 55 19 e3 b2 3f 43 73 + df ac 67 87 06 6d cb 47 56 b5 45 60 e0 88 6e 9b + 96 2c 4a d2 8d ab 26 ba d1 ab c2 59 16 b0 9a f2 + 86 53 7f 68 4f 80 8a ef ee 73 04 6c b7 df 0a 84 + fb b5 96 7a ca 13 1f 4b 1c f3 89 79 94 03 a3 0c + 02 d2 9c bd ad b7 25 12 db 9c ec 2e 5e 1d 00 e5 + 0c af cf 6f 21 09 1e bc 4f 25 3c 5e ab 01 a6 79 + ba ea be ed b9 c9 61 8f 66 00 6b 82 44 d6 62 2a + aa 56 88 7c cf c6 6a 0f 38 51 df a1 3a 78 cf f7 + 99 1e 03 cb 2c 3a 0e d8 7d 73 67 36 2e b7 80 5b + 00 b2 52 4f f2 98 a4 da 48 7c ac de af 8a 23 36 + c5 63 1b 3e fa 93 5b b4 11 e7 53 ca 13 b0 15 fe + c7 e4 a7 30 f1 36 9f 9e"), + + BaseKey = + hexstr2bin("a2 06 72 65 e7 f0 65 2a 92 3d 5d 72 ab 04 67 c4 + 61 32 ee b9 68 b6 a3 2d 31 1c 80 58 68 54 88 14"), + + VerifyData = + hexstr2bin("ea 6e e1 76 dc cc 4a f1 85 9e 9e 4e 93 f7 97 ea + c9 a7 8c e4 39 30 1e 35 27 5a d4 3f 3c dd bd e3"), + + Messages = [CertificateVerify, + Certificate, + EncryptedExtensions, + ServerHello, + ClientHello], + + FinishedKey = tls_v1:finished_key(BaseKey, sha256), + VerifyData = tls_v1:finished_verify_data(FinishedKey, sha256, Messages). + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ @@ -4486,8 +5175,8 @@ tcp_send_recv_result(Socket) -> ok. basic_verify_test_no_close(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -4962,16 +5651,16 @@ run_suites(Ciphers, Config, Type) -> {ClientOpts, ServerOpts} = case Type of rsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_verification_opts, Config)]}; + ssl_test_lib:ssl_options(server_rsa_opts, Config)]}; dsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_dsa_verify_opts, Config), [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_dsa_opts, Config)]}; anonymous -> %% No certs in opts! - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), [{ciphers, Ciphers} | ssl_test_lib:ssl_options([], Config)]}; psk -> @@ -4993,46 +5682,50 @@ run_suites(Ciphers, Config, Type) -> ssl_test_lib:ssl_options(server_psk_anon_hint, Config)]}; srp -> {ssl_test_lib:ssl_options(client_srp, Config), - ssl_test_lib:ssl_options(server_srp, Config)}; + [{ciphers, Ciphers} | + ssl_test_lib:ssl_options(server_srp, Config)]}; srp_anon -> {ssl_test_lib:ssl_options(client_srp, Config), - ssl_test_lib:ssl_options(server_srp_anon, Config)}; + [{ciphers, Ciphers} | + ssl_test_lib:ssl_options(server_srp_anon, Config)]}; srp_dsa -> {ssl_test_lib:ssl_options(client_srp_dsa, Config), - ssl_test_lib:ssl_options(server_srp_dsa, Config)}; + [{ciphers, Ciphers} | + ssl_test_lib:ssl_options(server_srp_dsa, Config)]}; ecdsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_ecdsa_opts, Config), [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]}; ecdh_rsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), - ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)}; + {ssl_test_lib:ssl_options(client_ecdh_rsa_opts, Config), + [{ciphers, Ciphers} | + ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)]}; rc4_rsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_verification_opts, Config)]}; + ssl_test_lib:ssl_options(server_rsa_verify_opts, Config)]}; rc4_ecdh_rsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_ecdh_rsa_opts, Config), [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)]}; rc4_ecdsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]}; des_dhe_rsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_verification_opts, Config)]}; des_rsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_verification_opts, Config)]}; + ssl_test_lib:ssl_options(server_rsa_verify_opts, Config)]}; chacha_rsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_verification_opts, Config)]}; + ssl_test_lib:ssl_options(server_rsa_verify_opts, Config)]}; chacha_ecdsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_ecdsa_opts, Config), [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]} end, @@ -5256,3 +5949,31 @@ tls_or_dtls('dtlsv1.2') -> dtls; tls_or_dtls(_) -> tls. + +hexstr2int(S) -> + B = hexstr2bin(S), + Bits = size(B) * 8, + <<Integer:Bits/integer>> = B, + Integer. + +hexstr2bin(S) when is_binary(S) -> + hexstr2bin(S, <<>>); +hexstr2bin(S) -> + hexstr2bin(list_to_binary(S), <<>>). +%% +hexstr2bin(<<>>, Acc) -> + Acc; +hexstr2bin(<<C,T/binary>>, Acc) when C =:= 32; %% SPACE + C =:= 10; %% LF + C =:= 13 -> %% CR + hexstr2bin(T, Acc); +hexstr2bin(<<X,Y,T/binary>>, Acc) -> + I = hex2int(X) * 16 + hex2int(Y), + hexstr2bin(T, <<Acc/binary,I>>). + +hex2int(C) when $0 =< C, C =< $9 -> + C - $0; +hex2int(C) when $A =< C, C =< $F -> + C - $A + 10; +hex2int(C) when $a =< C, C =< $f -> + C - $a + 10. diff --git a/lib/ssl/test/ssl_bench.spec b/lib/ssl/test/ssl_bench.spec index 8b746c5ca9..217cc6fc83 100644 --- a/lib/ssl/test/ssl_bench.spec +++ b/lib/ssl/test/ssl_bench.spec @@ -1 +1,2 @@ {suites,"../ssl_test",[ssl_bench_SUITE, ssl_dist_bench_SUITE]}. +{skip_groups,"../ssl_test",ssl_bench_SUITE,basic,"Benchmarks run separately"}. diff --git a/lib/ssl/test/ssl_bench_SUITE.erl b/lib/ssl/test/ssl_bench_SUITE.erl index 13097b08b6..0b2011a627 100644 --- a/lib/ssl/test/ssl_bench_SUITE.erl +++ b/lib/ssl/test/ssl_bench_SUITE.erl @@ -25,10 +25,11 @@ suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}]. -all() -> [{group, setup}, {group, payload}, {group, pem_cache}]. +all() -> [{group, basic}, {group, setup}, {group, payload}, {group, pem_cache}]. groups() -> - [{setup, [{repeat, 3}], [setup_sequential, setup_concurrent]}, + [{basic, [], [basic_pem_cache]}, + {setup, [{repeat, 3}], [setup_sequential, setup_concurrent]}, {payload, [{repeat, 3}], [payload_simple]}, {pem_cache, [{repeat, 3}], [use_pem_cache, bypass_pem_cache]} ]. @@ -51,29 +52,21 @@ init_per_suite(Config) -> end_per_suite(_Config) -> ok. -init_per_testcase(use_pem_cache, Conf) -> +init_per_testcase(TC, Conf) when TC =:= use_pem_cache; + TC =:= bypass_pem_cache; + TC =:= basic_pem_cache -> case bypass_pem_cache_supported() of false -> {skipped, "PEM cache bypass support required"}; true -> application:set_env(ssl, bypass_pem_cache, false), Conf end; -init_per_testcase(bypass_pem_cache, Conf) -> - case bypass_pem_cache_supported() of - false -> {skipped, "PEM cache bypass support required"}; - true -> - application:set_env(ssl, bypass_pem_cache, true), - Conf - end; init_per_testcase(_Func, Conf) -> Conf. -end_per_testcase(use_pem_cache, _Config) -> - case bypass_pem_cache_supported() of - false -> ok; - true -> application:set_env(ssl, bypass_pem_cache, false) - end; -end_per_testcase(bypass_pem_cache, _Config) -> +end_per_testcase(TC, _Config) when TC =:= use_pem_cache; + TC =:= bypass_pem_cache; + TC =:= basic_pem_cache -> case bypass_pem_cache_supported() of false -> ok; true -> application:set_env(ssl, bypass_pem_cache, false) @@ -119,6 +112,9 @@ payload_simple(Config) -> {suite, "ssl"}, {name, "Payload simple"}]}), ok. +basic_pem_cache(_Config) -> + do_test(ssl, pem_cache, 10, 5, node()). + use_pem_cache(_Config) -> {ok, Result} = do_test(ssl, pem_cache, 100, 500, node()), ct_event:notify(#event{name = benchmark_data, diff --git a/lib/ssl/test/ssl_crl_SUITE.erl b/lib/ssl/test/ssl_crl_SUITE.erl index 23c5eaf84d..c61039b5da 100644 --- a/lib/ssl/test/ssl_crl_SUITE.erl +++ b/lib/ssl/test/ssl_crl_SUITE.erl @@ -383,8 +383,11 @@ crl_hash_dir_expired(Config) when is_list(Config) -> {verify, verify_peer}], {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - %% First make a CRL that expired yesterday. - make_certs:gencrl(PrivDir, CA, CertsConfig, -24), + %% First make a CRL that will expire in one second. + make_certs:gencrl_sec(PrivDir, CA, CertsConfig, 1), + %% Sleep until the next CRL is due + ct:sleep({seconds, 1}), + CrlDir = filename:join(PrivDir, "crls"), populate_crl_hash_dir(PrivDir, CrlDir, [{CA, "1627b4b0"}], diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl index e39313e5cd..1b432970b6 100644 --- a/lib/ssl/test/ssl_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_handshake_SUITE.erl @@ -26,6 +26,7 @@ -include_lib("common_test/include/ct.hrl"). -include("ssl_alert.hrl"). +-include("ssl_handshake.hrl"). -include("ssl_internal.hrl"). -include("tls_handshake.hrl"). -include_lib("public_key/include/public_key.hrl"). @@ -42,7 +43,8 @@ all() -> [decode_hello_handshake, decode_empty_server_sni_correctly, select_proper_tls_1_2_rsa_default_hashsign, ignore_hassign_extension_pre_tls_1_2, - unorded_chain, signature_algorithms]. + unorded_chain, signature_algorithms, + encode_decode_srp]. %%-------------------------------------------------------------------- init_per_suite(Config) -> @@ -124,13 +126,13 @@ decode_supported_elliptic_curves_hello_extension_correctly(_Config) -> Len = ListLen + 2, Extension = <<?UINT16(?ELLIPTIC_CURVES_EXT), ?UINT16(Len), ?UINT16(ListLen), EllipticCurveList/binary>>, % after decoding we should see only valid curves - Extensions = ssl_handshake:decode_hello_extensions(Extension, {3,2}, client), + Extensions = ssl_handshake:decode_hello_extensions(Extension, {3,2}, {3,2}, client), #{elliptic_curves := #elliptic_curves{elliptic_curve_list = [?sect233k1, ?sect193r2]}} = Extensions. decode_unknown_hello_extension_correctly(_Config) -> FourByteUnknown = <<16#CA,16#FE, ?UINT16(4), 3, 0, 1, 2>>, Renegotiation = <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(1), 0>>, - Extensions = ssl_handshake:decode_hello_extensions(<<FourByteUnknown/binary, Renegotiation/binary>>, {3,2}, client), + Extensions = ssl_handshake:decode_hello_extensions(<<FourByteUnknown/binary, Renegotiation/binary>>, {3,2}, {3,2}, client), #{renegotiation_info := #renegotiation_info{renegotiated_connection = <<0>>}} = Extensions. @@ -145,12 +147,12 @@ encode_single_hello_sni_extension_correctly(_Config) -> decode_single_hello_sni_extension_correctly(_Config) -> SNI = <<16#00, 16#00, 16#00, 16#0d, 16#00, 16#0b, 16#00, 16#00, 16#08, $t, $e, $s, $t, $., $c, $o, $m>>, - Decoded = ssl_handshake:decode_hello_extensions(SNI, {3,3}, client), + Decoded = ssl_handshake:decode_hello_extensions(SNI, {3,3}, {3,3}, client), #{sni := #sni{hostname = "test.com"}} = Decoded. decode_empty_server_sni_correctly(_Config) -> SNI = <<?UINT16(?SNI_EXT),?UINT16(0)>>, - Decoded = ssl_handshake:decode_hello_extensions(SNI, {3,3}, server), + Decoded = ssl_handshake:decode_hello_extensions(SNI, {3,3}, {3,3}, server), #{sni := #sni{hostname = ""}} = Decoded. @@ -190,6 +192,30 @@ unorded_chain(Config) when is_list(Config) -> {ok, _, OrderedChain} = ssl_certificate:certificate_chain(PeerCert, ets:new(foo, []), ExtractedCerts, UnordedChain). +encode_decode_srp(_Config) -> + Exts = #{srp => #srp{username = <<"foo">>}, + sni => #sni{hostname = "bar"}, + renegotiation_info => undefined, + signature_algs => undefined, + alpn => undefined, + next_protocol_negotiation => undefined, + ec_point_formats => undefined, + elliptic_curves => undefined + }, + EncodedExts0 = <<0,20, % Length + 0,12, % SRP extension + 0,4, % Length + 3, % srp_I length + 102,111,111, % username = "foo" + 0,0, % SNI extension + 0,8, % Length + 0,6, % ServerNameLength + 0, % NameType (host_name) + 0,3, % HostNameLength + 98,97,114>>, % hostname = "bar" + EncodedExts0 = <<?UINT16(_),EncodedExts/binary>> = + ssl_handshake:encode_hello_extensions(Exts), + Exts = ssl_handshake:decode_hello_extensions(EncodedExts, {3,3}, {3,3}, client). signature_algorithms(Config) -> Opts = proplists:get_value(server_opts, Config), diff --git a/lib/ssl/test/ssl_npn_handshake_SUITE.erl b/lib/ssl/test/ssl_npn_handshake_SUITE.erl index 1c7d6b5f9f..878e983bb9 100644 --- a/lib/ssl/test/ssl_npn_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_npn_handshake_SUITE.erl @@ -64,13 +64,12 @@ next_protocol_not_supported() -> npn_not_supported_server ]. -init_per_suite(Config) -> +init_per_suite(Config0) -> catch crypto:stop(), try crypto:start() of ok -> ssl_test_lib:clean_start(), - {ok, _} = make_certs:all(proplists:get_value(data_dir, Config), - proplists:get_value(priv_dir, Config)), + Config = ssl_test_lib:make_rsa_cert(Config0), ssl_test_lib:cert_options(Config) catch _:_ -> {skip, "Crypto did not start"} @@ -196,10 +195,10 @@ client_negotiate_server_does_not_support(Config) when is_list(Config) -> renegotiate_from_client_after_npn_handshake(Config) when is_list(Config) -> Data = "hello world", - ClientOpts0 = ssl_test_lib:ssl_options(client_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), ClientOpts = [{client_preferred_next_protocols, {client, [<<"http/1.0">>], <<"http/1.1">>}}] ++ ClientOpts0, - ServerOpts0 = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), ServerOpts = [{next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}] ++ ServerOpts0, ExpectedProtocol = {ok, <<"http/1.0">>}, @@ -221,7 +220,7 @@ renegotiate_from_client_after_npn_handshake(Config) when is_list(Config) -> %-------------------------------------------------------------------------------- npn_not_supported_client(Config) when is_list(Config) -> - ClientOpts0 = ssl_test_lib:ssl_options(client_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), PrefProtocols = {client_preferred_next_protocols, {client, [<<"http/1.0">>], <<"http/1.1">>}}, ClientOpts = [PrefProtocols] ++ ClientOpts0, @@ -236,7 +235,7 @@ npn_not_supported_client(Config) when is_list(Config) -> %-------------------------------------------------------------------------------- npn_not_supported_server(Config) when is_list(Config)-> - ServerOpts0 = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), AdvProtocols = {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}, ServerOpts = [AdvProtocols] ++ ServerOpts0, @@ -244,63 +243,24 @@ npn_not_supported_server(Config) when is_list(Config)-> %-------------------------------------------------------------------------------- npn_handshake_session_reused(Config) when is_list(Config)-> - ClientOpts0 = ssl_test_lib:ssl_options(client_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), ClientOpts = [{client_preferred_next_protocols, {client, [<<"http/1.0">>], <<"http/1.1">>}}] ++ ClientOpts0, - ServerOpts0 = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), ServerOpts =[{next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}] ++ ServerOpts0, - {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, - {from, self()}, - {mfa, {ssl_test_lib, session_info_result, []}}, - {options, ServerOpts}]), - - Port = ssl_test_lib:inet_port(Server), - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {mfa, {ssl_test_lib, no_result_msg, []}}, - {options, ClientOpts}]), - - SessionInfo = - receive - {Server, Info} -> - Info - end, - - Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, - - %% Make sure session is registered - ct:sleep(?SLEEP), - - Client1 = - ssl_test_lib:start_client([{node, ClientNode}, - {port, Port}, {host, Hostname}, - {mfa, {ssl_test_lib, session_info_result, []}}, - {from, self()}, {options, ClientOpts}]), - - receive - {Client1, SessionInfo} -> - ok; - {Client1, Other} -> - ct:fail(Other) - end, + ssl_test_lib:reuse_session(ClientOpts, ServerOpts, Config). - ssl_test_lib:close(Server), - ssl_test_lib:close(Client), - ssl_test_lib:close(Client1). - %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- run_npn_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedProtocol) -> Data = "hello world", - ClientOpts0 = ssl_test_lib:ssl_options(client_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), ClientOpts = ClientExtraOpts ++ ClientOpts0, - ServerOpts0 = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), ServerOpts = ServerExtraOpts ++ ServerOpts0, {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), diff --git a/lib/ssl/test/ssl_payload_SUITE.erl b/lib/ssl/test/ssl_payload_SUITE.erl index 1f9b6a5772..27b9c258a0 100644 --- a/lib/ssl/test/ssl_payload_SUITE.erl +++ b/lib/ssl/test/ssl_payload_SUITE.erl @@ -64,7 +64,8 @@ payload_tests() -> server_echos_active_huge, client_echos_passive_huge, client_echos_active_once_huge, - client_echos_active_huge]. + client_echos_active_huge, + client_active_once_server_close]. init_per_suite(Config) -> catch crypto:stop(), @@ -397,6 +398,23 @@ client_echos_active_huge(Config) when is_list(Config) -> client_echos_active( Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname). + +%%-------------------------------------------------------------------- +client_active_once_server_close() -> + [{doc, "Server sends 500000 bytes and immediately after closes the connection" + "Make sure client recives all data if possible"}]. + +client_active_once_server_close(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + %% + Data = binary:copy(<<"1234567890">>, 50000), + client_active_once_server_close( + Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname). + + + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- @@ -541,42 +559,57 @@ client_echos_active( ssl_test_lib:close(Server), ssl_test_lib:close(Client). +client_active_once_server_close( + Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname) -> + Length = byte_size(Data), + Server = + ssl_test_lib:start_server( + [{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_close, [Data]}}, + {options, [{active, once}, {mode, binary} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = + ssl_test_lib:start_client( + [{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, active_once_recv, [Length]}}, + {options,[{active, once}, {mode, binary} | ClientOpts]}]), + %% + ssl_test_lib:check_result(Server, ok, Client, ok). + +send(_Socket, _Data, 0, _) -> + ok; +send(Socket, Data, Count, RecvEcho) -> + ok = ssl:send(Socket, Data), + RecvEcho(), + send(Socket, Data, Count - 1, RecvEcho). -send(Socket, Data, Count, Verify) -> - send(Socket, Data, Count, <<>>, Verify). -%% -send(_Socket, _Data, 0, Acc, _Verify) -> - Acc; -send(Socket, Data, Count, Acc, Verify) -> +send_close(Socket, Data) -> ok = ssl:send(Socket, Data), - NewAcc = Verify(Acc), - send(Socket, Data, Count - 1, NewAcc, Verify). + ssl:close(Socket). - sender(Socket, Data) -> ct:log("Sender recv: ~p~n", [ssl:getopts(Socket, [active])]), - <<>> = - send( - Socket, Data, 100, - fun(Acc) -> verify_recv(Socket, Data, Acc) end), - ok. + send(Socket, Data, 100, + fun() -> + ssl_test_lib:recv_disregard(Socket, byte_size(Data)) + end). sender_active_once(Socket, Data) -> ct:log("Sender active once: ~p~n", [ssl:getopts(Socket, [active])]), - <<>> = - send( - Socket, Data, 100, - fun(Acc) -> verify_active_once(Socket, Data, Acc) end), - ok. + send(Socket, Data, 100, + fun() -> + ssl_test_lib:active_once_disregard(Socket, byte_size(Data)) + end). sender_active(Socket, Data) -> ct:log("Sender active: ~p~n", [ssl:getopts(Socket, [active])]), - <<>> = - send( - Socket, Data, 100, - fun(Acc) -> verify_active(Socket, Data, Acc) end), - ok. - + send(Socket, Data, 100, + fun() -> + ssl_test_lib:active_disregard(Socket, byte_size(Data)) + end). echoer(Socket, Size) -> ct:log("Echoer recv: ~p~n", [ssl:getopts(Socket, [active])]), @@ -592,99 +625,32 @@ echoer_active(Socket, Size) -> %% Receive Size bytes +echo_recv(_Socket, 0) -> + ok; echo_recv(Socket, Size) -> {ok, Data} = ssl:recv(Socket, 0), ok = ssl:send(Socket, Data), - NewSize = Size - byte_size(Data), - if - 0 < NewSize -> - echo_recv(Socket, NewSize); - 0 == NewSize -> - ok - end. - -%% Verify that received data is SentData, return any superflous data -verify_recv(Socket, SentData, Acc) -> - {ok, NewData} = ssl:recv(Socket, 0), - SentSize = byte_size(SentData), - NewAcc = <<Acc/binary, NewData/binary>>, - NewSize = byte_size(NewAcc), - if - SentSize < NewSize -> - {SentData,Rest} = split_binary(NewAcc, SentSize), - Rest; - NewSize < SentSize -> - verify_recv(Socket, SentData, NewAcc); - true -> - SentData = NewAcc, - <<>> - end. + echo_recv(Socket, Size - byte_size(Data)). %% Receive Size bytes +echo_active_once(_Socket, 0) -> + ok; echo_active_once(Socket, Size) -> receive {ssl, Socket, Data} -> ok = ssl:send(Socket, Data), NewSize = Size - byte_size(Data), ssl:setopts(Socket, [{active, once}]), - if - 0 < NewSize -> - echo_active_once(Socket, NewSize); - 0 == NewSize -> - ok - end + echo_active_once(Socket, NewSize) end. -%% Verify that received data is SentData, return any superflous data -verify_active_once(Socket, SentData, Acc) -> - receive - {ssl, Socket, Data} -> - SentSize = byte_size(SentData), - NewAcc = <<Acc/binary, Data/binary>>, - NewSize = byte_size(NewAcc), - ssl:setopts(Socket, [{active, once}]), - if - SentSize < NewSize -> - {SentData,Rest} = split_binary(NewAcc, SentSize), - Rest; - NewSize < SentSize -> - verify_active_once(Socket, SentData, NewAcc); - true -> - SentData = NewAcc, - <<>> - end - end. - - %% Receive Size bytes +echo_active(_Socket, 0) -> + ok; echo_active(Socket, Size) -> receive {ssl, Socket, Data} -> ok = ssl:send(Socket, Data), - NewSize = Size - byte_size(Data), - if - 0 < NewSize -> - echo_active(Socket, NewSize); - 0 == NewSize -> - ok - end - end. - -%% Verify that received data is SentData, return any superflous data -verify_active(Socket, SentData, Acc) -> - receive - {ssl, Socket, Data} -> - SentSize = byte_size(SentData), - NewAcc = <<Acc/binary, Data/binary>>, - NewSize = byte_size(NewAcc), - if - SentSize < NewSize -> - {SentData,Rest} = split_binary(NewAcc, SentSize), - Rest; - NewSize < SentSize -> - verify_active(Socket, SentData, NewAcc); - true -> - SentData = NewAcc, - <<>> - end - end. + echo_active(Socket, Size - byte_size(Data)) + end. + diff --git a/lib/ssl/test/ssl_pem_cache_SUITE.erl b/lib/ssl/test/ssl_pem_cache_SUITE.erl index 25d2cb300d..6f11e2bbe8 100644 --- a/lib/ssl/test/ssl_pem_cache_SUITE.erl +++ b/lib/ssl/test/ssl_pem_cache_SUITE.erl @@ -44,11 +44,8 @@ init_per_suite(Config0) -> try crypto:start() of ok -> ssl_test_lib:clean_start(), - %% make rsa certs using oppenssl - {ok, _} = make_certs:all(proplists:get_value(data_dir, Config0), - proplists:get_value(priv_dir, Config0)), - Config1 = ssl_test_lib:make_dsa_cert(Config0), - ssl_test_lib:cert_options(Config1) + %% make rsa certs + ssl_test_lib:make_rsa_cert(Config0) catch _:_ -> {skip, "Crypto did not start"} end. @@ -86,8 +83,8 @@ pem_cleanup() -> [{doc, "Test pem cache invalidate mechanism"}]. pem_cleanup(Config)when is_list(Config) -> process_flag(trap_exit, true), - ClientOpts = proplists:get_value(client_verification_opts, Config), - ServerOpts = proplists:get_value(server_verification_opts, Config), + ClientOpts = proplists:get_value(client_rsa_verify_opts, Config), + ServerOpts = proplists:get_value(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = @@ -118,8 +115,8 @@ invalid_insert() -> invalid_insert(Config)when is_list(Config) -> process_flag(trap_exit, true), - ClientOpts = proplists:get_value(client_verification_opts, Config), - ServerOpts = proplists:get_value(server_verification_opts, Config), + ClientOpts = proplists:get_value(client_rsa_verify_opts, Config), + ServerOpts = proplists:get_value(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), BadClientOpts = [{cacertfile, "tmp/does_not_exist.pem"} | proplists:delete(cacertfile, ClientOpts)], Server = diff --git a/lib/ssl/test/ssl_session_cache_SUITE.erl b/lib/ssl/test/ssl_session_cache_SUITE.erl index a0fab58b9d..7f33fe3204 100644 --- a/lib/ssl/test/ssl_session_cache_SUITE.erl +++ b/lib/ssl/test/ssl_session_cache_SUITE.erl @@ -48,7 +48,8 @@ all() -> session_cache_process_list, session_cache_process_mnesia, client_unique_session, - max_table_size + max_table_size, + save_specific_session ]. groups() -> @@ -60,10 +61,7 @@ init_per_suite(Config0) -> ok -> ssl_test_lib:clean_start(), %% make rsa certs using - {ok, _} = make_certs:all(proplists:get_value(data_dir, Config0), - proplists:get_value(priv_dir, Config0)), - Config = ssl_test_lib:make_dsa_cert(Config0), - ssl_test_lib:cert_options(Config) + ssl_test_lib:make_rsa_cert(Config0) catch _:_ -> {skip, "Crypto did not start"} end. @@ -97,7 +95,10 @@ init_per_testcase(session_cleanup, Config) -> init_per_testcase(client_unique_session, Config) -> ct:timetrap({seconds, 40}), Config; - +init_per_testcase(save_specific_session, Config) -> + ssl_test_lib:clean_start(), + ct:timetrap({seconds, 5}), + Config; init_per_testcase(max_table_size, Config) -> ssl:stop(), application:load(ssl), @@ -141,7 +142,7 @@ end_per_testcase(max_table_size, Config) -> end_per_testcase(default_action, Config); end_per_testcase(Case, Config) when Case == session_cache_process_list; Case == session_cache_process_mnesia -> - ets:delete(ssl_test), + catch ets:delete(ssl_test), Config; end_per_testcase(_, Config) -> Config. @@ -154,8 +155,8 @@ client_unique_session() -> "sets up many connections"}]. client_unique_session(Config) when is_list(Config) -> process_flag(trap_exit, true), - ClientOpts = proplists:get_value(client_opts, Config), - ServerOpts = proplists:get_value(server_opts, Config), + ClientOpts = proplists:get_value(client_rsa_verify_opts, Config), + ServerOpts = proplists:get_value(server_rsa_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -164,8 +165,7 @@ client_unique_session(Config) when is_list(Config) -> {tcp_options, [{active, false}]}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - LastClient = clients_start(Server, - ClientNode, Hostname, Port, ClientOpts, client_unique_session, 20), + LastClient = clients_start(Server, ClientNode, Hostname, Port, ClientOpts, 20), receive {LastClient, {ok, _}} -> ok @@ -185,8 +185,8 @@ session_cleanup() -> "does not grow and grow ..."}]. session_cleanup(Config) when is_list(Config) -> process_flag(trap_exit, true), - ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = @@ -254,13 +254,75 @@ session_cache_process_mnesia(Config) when is_list(Config) -> session_cache_process(mnesia,Config). %%-------------------------------------------------------------------- +save_specific_session() -> + [{doc, "Test that we can save a specific client session" + }]. +save_specific_session(Config) when is_list(Config) -> + process_flag(trap_exit, true), + ClientOpts = proplists:get_value(client_rsa_verify_opts, Config), + ServerOpts = proplists:get_value(server_rsa_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {tcp_options, [{active, false}]}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client1 = ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, ClientOpts}]), + Server ! listen, + + Client2 = ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, [{reuse_sessions, save} | ClientOpts]}]), + SessionID1 = + receive + {Client1, S1} -> + S1 + end, + + SessionID2 = + receive + {Client2, S2} -> + S2 + end, + + true = SessionID1 =/= SessionID2, + + {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), + [_, _,_, _, Prop] = StatusInfo, + State = ssl_test_lib:state(Prop), + ClientCache = element(2, State), + 2 = ssl_session_cache:size(ClientCache), + + Server ! listen, + + Client3 = ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, [{reuse_session, SessionID2} | ClientOpts]}]), + receive + {Client3, SessionID2} -> + ok; + {Client3, SessionID3}-> + ct:fail({got, SessionID3, expected, SessionID2}); + Other -> + ct:fail({got,Other}) + end. + +%%-------------------------------------------------------------------- max_table_size() -> [{doc,"Test max limit on session table"}]. max_table_size(Config) when is_list(Config) -> process_flag(trap_exit, true), - ClientOpts = proplists:get_value(client_verification_opts, Config), - ServerOpts = proplists:get_value(server_verification_opts, Config), + ClientOpts = proplists:get_value(client_rsa_verify_opts, Config), + ServerOpts = proplists:get_value(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -270,7 +332,7 @@ max_table_size(Config) when is_list(Config) -> {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), LastClient = clients_start(Server, - ClientNode, Hostname, Port, ClientOpts, max_table_size, 20), + ClientNode, Hostname, Port, ClientOpts, 20), receive {LastClient, {ok, _}} -> ok @@ -426,25 +488,27 @@ session_loop(Sess) -> %%-------------------------------------------------------------------- session_cache_process(_Type,Config) when is_list(Config) -> - ssl_basic_SUITE:reuse_session(Config). + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + ssl_test_lib:reuse_session(ClientOpts, ServerOpts, Config). -clients_start(_Server, ClientNode, Hostname, Port, ClientOpts, Test, 0) -> +clients_start(_Server, ClientNode, Hostname, Port, ClientOpts, 0) -> %% Make sure session is registered ct:sleep(?SLEEP * 2), ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {mfa, {?MODULE, connection_info_result, []}}, - {from, self()}, {options, test_copts(Test, 0, ClientOpts)}]); -clients_start(Server, ClientNode, Hostname, Port, ClientOpts, Test, N) -> + {from, self()}, {options, ClientOpts}]); +clients_start(Server, ClientNode, Hostname, Port, ClientOpts, N) -> spawn_link(ssl_test_lib, start_client, [[{node, ClientNode}, {port, Port}, {host, Hostname}, {mfa, {ssl_test_lib, no_result, []}}, - {from, self()}, {options, test_copts(Test, N, ClientOpts)}]]), + {from, self()}, {options, ClientOpts}]]), Server ! listen, wait_for_server(), - clients_start(Server, ClientNode, Hostname, Port, ClientOpts, Test, N-1). + clients_start(Server, ClientNode, Hostname, Port, ClientOpts, N-1). connection_info_result(Socket) -> ssl:connection_information(Socket, [protocol, cipher_suite]). @@ -481,21 +545,3 @@ get_delay_timers() -> wait_for_server() -> ct:sleep(100). - - -test_copts(_, 0, ClientOpts) -> - ClientOpts; -test_copts(max_table_size, N, ClientOpts) -> - Version = tls_record:highest_protocol_version([]), - CipherSuites = %%lists:map(fun(X) -> ssl_cipher_format:suite_definition(X) end, ssl_cipher:filter_suites(ssl_cipher:suites(Version))), -[ Y|| Y = {Alg,_, _, _} <- lists:map(fun(X) -> ssl_cipher_format:suite_definition(X) end, ssl_cipher:filter_suites(ssl_cipher:suites(Version))), Alg =/= ecdhe_ecdsa, Alg =/= ecdh_ecdsa, Alg =/= ecdh_rsa, Alg =/= ecdhe_rsa, Alg =/= dhe_dss, Alg =/= dss], - case length(CipherSuites) of - M when M >= N -> - Cipher = lists:nth(N, CipherSuites), - ct:pal("~p",[Cipher]), - [{ciphers, [Cipher]} | ClientOpts]; - _ -> - ClientOpts - end; -test_copts(_, _, ClientOpts) -> - ClientOpts. diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 7767d76a0d..fdbd39d016 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -30,6 +30,7 @@ -record(sslsocket, { fd = nil, pid = nil}). -define(SLEEP, 1000). +-define(DEFAULT_CURVE, secp256r1). %% For now always run locally run_where(_) -> @@ -523,7 +524,7 @@ cert_options(Config) -> {client_verification_opts, [{cacertfile, ServerCaCertFile}, {certfile, ClientCertFile}, {keyfile, ClientKeyFile}, - {ssl_imp, new}]}, + {verify, verify_peer}]}, {client_verification_opts_digital_signature_only, [{cacertfile, ServerCaCertFile}, {certfile, ClientCertFileDigitalSignatureOnly}, {keyfile, ClientKeyFile}, @@ -618,9 +619,12 @@ make_rsa_cert_chains(UserConf, Config, Suffix) -> }. make_ec_cert_chains(UserConf, ClientChainType, ServerChainType, Config) -> + make_ec_cert_chains(UserConf, ClientChainType, ServerChainType, Config, ?DEFAULT_CURVE). +%% +make_ec_cert_chains(UserConf, ClientChainType, ServerChainType, Config, Curve) -> ClientChain = proplists:get_value(client_chain, UserConf, default_cert_chain_conf()), ServerChain = proplists:get_value(server_chain, UserConf, default_cert_chain_conf()), - CertChainConf = gen_conf(ClientChainType, ServerChainType, ClientChain, ServerChain), + CertChainConf = gen_conf(ClientChainType, ServerChainType, ClientChain, ServerChain, Curve), 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 = public_key:pkix_test_data(CertChainConf), @@ -635,7 +639,11 @@ default_cert_chain_conf() -> %% Use only default options [[],[],[]]. -gen_conf(mix, mix, UserClient, UserServer) -> + +gen_conf(ClientChainType, ServerChainType, UserClient, UserServer) -> + gen_conf(ClientChainType, ServerChainType, UserClient, UserServer, ?DEFAULT_CURVE). +%% +gen_conf(mix, mix, UserClient, UserServer, _) -> ClientTag = conf_tag("client"), ServerTag = conf_tag("server"), @@ -646,12 +654,12 @@ gen_conf(mix, mix, UserClient, UserServer) -> ServerConf = merge_chain_spec(UserServer, DefaultServer, []), new_format([{ClientTag, ClientConf}, {ServerTag, ServerConf}]); -gen_conf(ClientChainType, ServerChainType, UserClient, UserServer) -> +gen_conf(ClientChainType, ServerChainType, UserClient, UserServer, Curve) -> ClientTag = conf_tag("client"), ServerTag = conf_tag("server"), - DefaultClient = chain_spec(client, ClientChainType), - DefaultServer = chain_spec(server, ServerChainType), + DefaultClient = chain_spec(client, ClientChainType, Curve), + DefaultServer = chain_spec(server, ServerChainType, Curve), ClientConf = merge_chain_spec(UserClient, DefaultClient, []), ServerConf = merge_chain_spec(UserServer, DefaultServer, []), @@ -673,43 +681,43 @@ proplist_to_map([Head | Rest]) -> conf_tag(Role) -> list_to_atom(Role ++ "_chain"). -chain_spec(_Role, ecdh_rsa) -> +chain_spec(_Role, ecdh_rsa, Curve) -> Digest = {digest, appropriate_sha(crypto:supports())}, - CurveOid = hd(tls_v1:ecc_curves(0)), + CurveOid = pubkey_cert_records:namedCurves(Curve), [[Digest, {key, {namedCurve, CurveOid}}], [Digest, {key, hardcode_rsa_key(1)}], [Digest, {key, {namedCurve, CurveOid}}]]; -chain_spec(_Role, ecdhe_ecdsa) -> +chain_spec(_Role, ecdhe_ecdsa, Curve) -> Digest = {digest, appropriate_sha(crypto:supports())}, - CurveOid = hd(tls_v1:ecc_curves(0)), + CurveOid = pubkey_cert_records:namedCurves(Curve), [[Digest, {key, {namedCurve, CurveOid}}], [Digest, {key, {namedCurve, CurveOid}}], [Digest, {key, {namedCurve, CurveOid}}]]; -chain_spec(_Role, ecdh_ecdsa) -> +chain_spec(_Role, ecdh_ecdsa, Curve) -> Digest = {digest, appropriate_sha(crypto:supports())}, - CurveOid = hd(tls_v1:ecc_curves(0)), + CurveOid = pubkey_cert_records:namedCurves(Curve), [[Digest, {key, {namedCurve, CurveOid}}], [Digest, {key, {namedCurve, CurveOid}}], [Digest, {key, {namedCurve, CurveOid}}]]; -chain_spec(_Role, ecdhe_rsa) -> +chain_spec(_Role, ecdhe_rsa, _) -> Digest = {digest, appropriate_sha(crypto:supports())}, [[Digest, {key, hardcode_rsa_key(1)}], [Digest, {key, hardcode_rsa_key(2)}], [Digest, {key, hardcode_rsa_key(3)}]]; -chain_spec(_Role, ecdsa) -> +chain_spec(_Role, ecdsa, Curve) -> Digest = {digest, appropriate_sha(crypto:supports())}, - CurveOid = hd(tls_v1:ecc_curves(0)), + CurveOid = pubkey_cert_records:namedCurves(Curve), [[Digest, {key, {namedCurve, CurveOid}}], [Digest, {key, {namedCurve, CurveOid}}], [Digest, {key, {namedCurve, CurveOid}}]]; -chain_spec(_Role, rsa) -> +chain_spec(_Role, rsa, _) -> Digest = {digest, appropriate_sha(crypto:supports())}, [[Digest, {key, hardcode_rsa_key(1)}], [Digest, {key, hardcode_rsa_key(2)}], [Digest, {key, hardcode_rsa_key(3)}]]; -chain_spec(_Role, dsa) -> +chain_spec(_Role, dsa, _) -> Digest = {digest, appropriate_sha(crypto:supports())}, [[Digest, {key, hardcode_dsa_key(1)}], [Digest, {key, hardcode_dsa_key(2)}], @@ -742,7 +750,7 @@ merge_spec(User, Default, [Conf | Rest], Acc) -> make_mix_cert(Config) -> Ext = x509_test:extensions([{key_usage, [digitalSignature]}]), Digest = {digest, appropriate_sha(crypto:supports())}, - CurveOid = hd(tls_v1:ecc_curves(0)), + CurveOid = pubkey_cert_records:namedCurves(?DEFAULT_CURVE), Mix = proplists:get_value(mix, Config, peer_ecc), ClientChainType =ServerChainType = mix, {ClientChain, ServerChain} = mix(Mix, Digest, CurveOid, Ext), @@ -1537,7 +1545,12 @@ init_tls_version(Version, Config) -> clean_tls_version(Config) -> proplists:delete(protocol_opts, proplists:delete(protocol, Config)). - + +sufficient_crypto_support(Version) + when Version == 'tlsv1.3' -> + CryptoSupport = crypto:supports(), + lists:member(rsa_pkcs1_pss_padding, proplists:get_value(rsa_opts, CryptoSupport)) andalso + lists:member(x448, proplists:get_value(curves, CryptoSupport)); sufficient_crypto_support(Version) when Version == 'tlsv1.2'; Version == 'dtlsv1.2' -> CryptoSupport = crypto:supports(), @@ -1583,35 +1596,22 @@ v_1_2_check(ecdh_rsa, ecdh_ecdsa) -> v_1_2_check(_, _) -> false. -send_recv_result_active(Socket) -> - ssl:send(Socket, "Hello world"), - receive - {ssl, Socket, "H"} -> - receive - {ssl, Socket, "ello world"} -> - ok - end; - {ssl, Socket, "Hello world"} -> - ok - end. - send_recv_result(Socket) -> - ssl:send(Socket, "Hello world"), - {ok,"Hello world"} = ssl:recv(Socket, 11), + Data = "Hello world", + ssl:send(Socket, Data), + {ok, Data} = ssl:recv(Socket, length(Data)), + ok. + +send_recv_result_active(Socket) -> + Data = "Hello world", + ssl:send(Socket, Data), + Data = active_recv(Socket, length(Data)), ok. send_recv_result_active_once(Socket) -> - ssl:send(Socket, "Hello world"), - receive - {ssl, Socket, "H"} -> - ssl:setopts(Socket, [{active, once}]), - receive - {ssl, Socket, "ello world"} -> - ok - end; - {ssl, Socket, "Hello world"} -> - ok - end. + Data = "Hello world", + ssl:send(Socket, Data), + active_once_recv_list(Socket, length(Data)). active_recv(Socket, N) -> active_recv(Socket, N, []). @@ -1624,6 +1624,44 @@ active_recv(Socket, N, Acc) -> active_recv(Socket, N-length(Bytes), Acc ++ Bytes) end. +active_once_recv(_Socket, 0) -> + ok; +active_once_recv(Socket, N) -> + receive + {ssl, Socket, Bytes} -> + ssl:setopts(Socket, [{active, once}]), + active_once_recv(Socket, N-byte_size(Bytes)) + end. + +active_once_recv_list(_Socket, 0) -> + ok; +active_once_recv_list(Socket, N) -> + receive + {ssl, Socket, Bytes} -> + ssl:setopts(Socket, [{active, once}]), + active_once_recv_list(Socket, N-length(Bytes)) + end. +recv_disregard(_Socket, 0) -> + ok; +recv_disregard(Socket, N) -> + {ok, Bytes} = ssl:recv(Socket, 0), + recv_disregard(Socket, N-byte_size(Bytes)). + +active_disregard(_Socket, 0) -> + ok; +active_disregard(Socket, N) -> + receive + {ssl, Socket, Bytes} -> + active_disregard(Socket, N-byte_size(Bytes)) + end. +active_once_disregard(_Socket, 0) -> + ok; +active_once_disregard(Socket, N) -> + receive + {ssl, Socket, Bytes} -> + ssl:setopts(Socket, [{active, once}]), + active_once_disregard(Socket, N-byte_size(Bytes)) + end. is_sane_ecc(openssl) -> case os:cmd("openssl version") of "OpenSSL 1.0.0a" ++ _ -> % Known bug in openssl @@ -2161,3 +2199,98 @@ server_msg(Server, ServerMsg) -> Unexpected -> ct:fail(Unexpected) end. + +session_id(Socket) -> + {ok, [{session_id, ID}]} = ssl:connection_information(Socket, [session_id]), + ID. + +reuse_session(ClientOpts, ServerOpts, Config) -> + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server0 = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {tcp_options, [{active, false}]}, + {options, ServerOpts}]), + Port0 = ssl_test_lib:inet_port(Server0), + + Client0 = ssl_test_lib:start_client([{node, ClientNode}, + {port, Port0}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, [{reuse_sessions, save} | ClientOpts]}]), + Server0 ! listen, + + Client1 = ssl_test_lib:start_client([{node, ClientNode}, + {port, Port0}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, ClientOpts}]), + + SID = receive + {Client0, Id0} -> + Id0 + end, + + receive + {Client1, SID} -> + ok + after ?SLEEP -> + ct:fail(session_not_reused) + end, + + Server0 ! listen, + + Client2 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port0}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, [{reuse_sessions, false} + | ClientOpts]}]), + receive + {Client2, SID} -> + ct:fail(session_reused_when_session_reuse_disabled_by_client); + {Client2, _} -> + ok + end, + + ssl_test_lib:close(Server0), + ssl_test_lib:close(Client0), + ssl_test_lib:close(Client1), + ssl_test_lib:close(Client2), + + Server1 = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {tcp_options, [{active, false}]}, + {options, [{reuse_sessions, false} |ServerOpts]}]), + Port1 = ssl_test_lib:inet_port(Server1), + + Client3 = ssl_test_lib:start_client([{node, ClientNode}, + {port, Port1}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, [{reuse_sessions, save} | ClientOpts]}]), + SID1 = receive + {Client3, Id3} -> + Id3 + end, + + Server1 ! listen, + + Client4 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port1}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, ClientOpts}]), + + receive + {Client4, SID1} -> + ct:fail(session_reused_when_session_reuse_disabled_by_server); + {Client4, _} -> + ok + end, + + ssl_test_lib:close(Server1), + ssl_test_lib:close(Client3), + ssl_test_lib:close(Client4). + diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 3c8b25b912..d180021439 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -260,8 +260,9 @@ special_init(TestCase, Config) when Config; special_init(TestCase, Config) when TestCase == erlang_client_openssl_server_renegotiate; - TestCase == erlang_client_openssl_server_nowrap_seqnum; - TestCase == erlang_server_openssl_client_nowrap_seqnum + TestCase == erlang_client_openssl_server_nowrap_seqnum; + TestCase == erlang_server_openssl_client_nowrap_seqnum; + TestCase == erlang_client_openssl_server_renegotiate_after_client_data -> {ok, Version} = application:get_env(ssl, protocol_version), check_sane_openssl_renegotaite(Config, Version); @@ -761,8 +762,8 @@ erlang_client_openssl_server_renegotiate() -> [{doc,"Test erlang client when openssl server issuses a renegotiate"}]. erlang_client_openssl_server_renegotiate(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), - ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -771,12 +772,14 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) -> Port = ssl_test_lib:inet_port(node()), CertFile = proplists:get_value(certfile, ServerOpts), + CaCertFile = proplists:get_value(cacertfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = ssl_test_lib:protocol_version(Config), Exe = "openssl", Args = ["s_server", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-CAfile", CaCertFile, "-cert", CertFile, "-key", KeyFile, "-msg"], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), @@ -806,8 +809,8 @@ erlang_client_openssl_server_renegotiate_after_client_data() -> [{doc,"Test erlang client when openssl server issuses a renegotiate after reading client data"}]. erlang_client_openssl_server_renegotiate_after_client_data(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), - ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -815,6 +818,7 @@ erlang_client_openssl_server_renegotiate_after_client_data(Config) when is_list( OpenSslData = "From openssl to erlang", Port = ssl_test_lib:inet_port(node()), + CaCertFile = proplists:get_value(cacertfile, ServerOpts), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = ssl_test_lib:protocol_version(Config), @@ -822,6 +826,7 @@ erlang_client_openssl_server_renegotiate_after_client_data(Config) when is_list( Exe = "openssl", Args = ["s_server", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-CAfile", CaCertFile, "-cert", CertFile, "-key", KeyFile, "-msg"], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), @@ -856,7 +861,7 @@ erlang_client_openssl_server_nowrap_seqnum() -> " to lower treashold substantially."}]. erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -865,12 +870,14 @@ erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) -> N = 10, Port = ssl_test_lib:inet_port(node()), + CaCertFile = proplists:get_value(cacertfile, ServerOpts), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = ssl_test_lib:protocol_version(Config), Exe = "openssl", Args = ["s_server", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-CAfile", CaCertFile, "-cert", CertFile, "-key", KeyFile, "-msg"], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), @@ -899,7 +906,7 @@ erlang_server_openssl_client_nowrap_seqnum() -> " to lower treashold substantially."}]. erlang_server_openssl_client_nowrap_seqnum(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1648,8 +1655,8 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, OpensslServerOpts, Data, Callback) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), - ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), ClientOpts = ErlangClientOpts ++ ClientOpts0, {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -1657,6 +1664,7 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens Data = "From openssl to erlang", Port = ssl_test_lib:inet_port(node()), + CaCertFile = proplists:get_value(cacertfile, ServerOpts), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = ssl_test_lib:protocol_version(Config), @@ -1666,10 +1674,12 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens [] -> ["s_server", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-CAfile", CaCertFile, "-cert", CertFile,"-key", KeyFile]; [Opt, Value] -> ["s_server", Opt, Value, "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-CAfile", CaCertFile, "-cert", CertFile,"-key", KeyFile] end, @@ -1694,8 +1704,8 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callback) -> process_flag(trap_exit, true), - ServerOpts = proplists:get_value(server_rsa_opts, Config), - ClientOpts0 = proplists:get_value(client_rsa_opts, Config), + ServerOpts = proplists:get_value(server_rsa_verify_opts, Config), + ClientOpts0 = proplists:get_value(client_rsa_verify_opts, Config), ClientOpts = [{alpn_advertised_protocols, [<<"spdy/2">>]} | ClientOpts0], {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -1703,12 +1713,14 @@ start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callba Data = "From openssl to erlang", Port = ssl_test_lib:inet_port(node()), + CaCertFile = proplists:get_value(cacertfile, ServerOpts), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = ssl_test_lib:protocol_version(Config), Exe = "openssl", Args = ["s_server", "-msg", "-alpn", "http/1.1,spdy/2", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-CAfile", CaCertFile, "-cert", CertFile, "-key", KeyFile], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), @@ -1826,8 +1838,8 @@ start_erlang_server_and_openssl_client_for_alpn_npn_negotiation(Config, Data, Ca start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callback) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), - ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), ClientOpts = [{client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"http/1.1">>}} | ClientOpts0], {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -1835,6 +1847,7 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac Data = "From openssl to erlang", Port = ssl_test_lib:inet_port(node()), + CaCertFile = proplists:get_value(cacertfile, ServerOpts), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = ssl_test_lib:protocol_version(Config), @@ -1842,6 +1855,7 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac Exe = "openssl", Args = ["s_server", "-msg", "-nextprotoneg", "http/1.1,spdy/2", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-CAfile", CaCertFile, "-cert", CertFile, "-key", KeyFile], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 3501622f5a..3527062a8a 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 9.1.1 +SSL_VSN = 9.1.2 diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 3e53c60bc1..7594514b29 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -138,23 +138,81 @@ operation. In database terms the isolation level can be seen as "serializable", as if all isolated operations are carried out serially, one after the other in a strict order.</p> + </section> - <p>No other support is available within this module that would guarantee - consistency between objects. However, function - <seealso marker="#safe_fixtable/2"><c>safe_fixtable/2</c></seealso> - can be used to guarantee that a sequence of - <seealso marker="#first/1"><c>first/1</c></seealso> and - <seealso marker="#next/2"><c>next/2</c></seealso> calls traverse the - table without errors and that each existing object in the table is - visited exactly once, even if another (or the same) process - simultaneously deletes or inserts objects into the table. - Nothing else is guaranteed; in particular objects that are inserted - or deleted during such a traversal can be visited once or not at all. - Functions that internally traverse over a table, like - <seealso marker="#select/1"><c>select</c></seealso> and - <seealso marker="#match/1"><c>match</c></seealso>, - give the same guarantee as - <seealso marker="#safe_fixtable/2"><c>safe_fixtable</c></seealso>.</p> + <section><marker id="traversal"></marker> + <title>Table traversal</title> + <p>There are different ways to traverse through the objects of a table.</p> + <list type="bulleted"> + <item><p><em>Single-step</em> traversal one key at at time, using + <seealso marker="#first/1"><c>first/1</c></seealso>, + <seealso marker="#next/2"><c>next/2</c></seealso>, + <seealso marker="#last/1"><c>last/1</c></seealso> and + <seealso marker="#prev/2"><c>prev/2</c></seealso>.</p> + </item> + <item><p>Search with simple <em>match patterns</em>, using + <seealso marker="#match/1"><c>match/1/2/3</c></seealso>, + <seealso marker="#match_delete/2"><c>match_delete/2</c></seealso> and + <seealso marker="#match_object/1"><c>match_object/1/2/3</c></seealso>.</p> + </item> + <item><p>Search with more powerful <em>match specifications</em>, using + <seealso marker="#select/1"><c>select/1/2/3</c></seealso>, + <seealso marker="#select_count/2"><c>select_count/2</c></seealso>, + <seealso marker="#select_delete/2"><c>select_delete/2</c></seealso>, + <seealso marker="#select_replace/2"><c>select_replace/2</c></seealso> and + <seealso marker="#select_reverse/1"><c>select_reverse/1/2/3</c></seealso>.</p> + </item> + <item><p><em>Table conversions</em>, using + <seealso marker="#tab2file/2"><c>tab2file/2/3</c></seealso> and + <seealso marker="#tab2list/1"><c>tab2list/1</c></seealso>.</p> + </item> + </list> + <p>None of these ways of table traversal will guarantee a consistent table snapshot + if the table is also updated during the traversal. Moreover, traversals not + done in a <em>safe</em> way, on tables where keys are inserted or deleted + during the traversal, may yield the following undesired effects:</p> + <list type="bulleted"> + <item><p>Any key may be missed.</p></item> + <item><p>Any key may be found more than once.</p></item> + <item><p>The traversal may fail with <c>badarg</c> exception if keys are deleted.</p> + </item> + </list> + <p>A table traversal is <em>safe</em> if either</p> + <list type="bulleted"> + <item><p>the table is of type <c>ordered_set</c>.</p> + </item> + <item><p>the entire table traversal is done within one ETS function + call.</p> + </item> + <item><p>function <seealso marker="#safe_fixtable/2"><c>safe_fixtable/2</c></seealso> + is used to keep the table fixated during the entire traversal.</p> + </item> + </list> + <note> + <p>Even though the access of a single object is always guaranteed to be + <seealso marker="#concurrency">atomic and isolated</seealso>, each traversal + through a table to find the next key is not done with such guarantees. This is often + not a problem, but may cause rare subtle "unexpected" effects if a concurrent + process inserts objects during a traversal. For example, consider one + process doing</p> +<pre> +ets:new(t, [ordered_set, named_table]), +ets:insert(t, {1}), +ets:insert(t, {2}), +ets:insert(t, {3}), +</pre> + <p>A concurrent call to <c>ets:first(t)</c>, done by another + process, may then in rare cases return <c>2</c> even though + <c>2</c> has never existed in the table ordered as the first key. In + the same way, a concurrent call to <c>ets:next(t, 1)</c> may return + <c>3</c> even though <c>3</c> never existed in the table + ordered directly after <c>1</c>.</p> + <p>Effects like this are improbable but possible. The probability will + further be reduced (if not vanish) if table option + <seealso marker="#new_2_write_concurrency"><c>write_concurrency</c></seealso> + is not enabled. This can also only be a potential concern for + <c>ordered_set</c> where the traversal order is defined.</p> + </note> </section> <section> @@ -870,6 +928,9 @@ ets:is_compiled_ms(Broken).</code> <seealso marker="#first/1"><c>first/1</c></seealso> and <seealso marker="#next/2"><c>next/2</c></seealso>.</p> <p>If the table is empty, <c>'$end_of_table'</c> is returned.</p> + <p>Use <seealso marker="#safe_fixtable/2"><c>safe_fixtable/2</c></seealso> + to guarantee <seealso marker="#traversal">safe traversal</seealso> + for subsequent calls to <seealso marker="#match/1"><c>match/1</c></seealso>.</p> </desc> </func> @@ -935,6 +996,10 @@ ets:is_compiled_ms(Broken).</code> <seealso marker="#first/1"><c>first/1</c></seealso> and <seealso marker="#next/2"><c>next/2</c></seealso>.</p> <p>If the table is empty, <c>'$end_of_table'</c> is returned.</p> + <p>Use <seealso marker="#safe_fixtable/2"><c>safe_fixtable/2</c></seealso> + to guarantee <seealso marker="#traversal">safe traversal</seealso> + for subsequent calls to <seealso marker="#match_object/1"> + <c>match_object/1</c></seealso>.</p> </desc> </func> @@ -1197,12 +1262,13 @@ ets:select(Table, MatchSpec),</code> <p>To find the first key in the table, use <seealso marker="#first/1"><c>first/1</c></seealso>.</p> <p>Unless a table of type <c>set</c>, <c>bag</c>, or - <c>duplicate_bag</c> is protected using + <c>duplicate_bag</c> is fixated using <seealso marker="#safe_fixtable/2"><c>safe_fixtable/2</c></seealso>, - a traversal can fail if - concurrent updates are made to the table. For table - type <c>ordered_set</c>, the function returns the next key in - order, even if the object does no longer exist.</p> + a call to <c>next/2</c> will fail if <c><anno>Key1</anno></c> no longer + exists in the table. For table type <c>ordered_set</c>, the function + always returns the next key after <c><anno>Key1</anno></c> in term + order, regardless whether <c><anno>Key1</anno></c> ever existed in the + table.</p> </desc> </func> @@ -1217,7 +1283,7 @@ ets:select(Table, MatchSpec),</code> table types, the function is synonymous to <seealso marker="#next/2"><c>next/2</c></seealso>. If no previous key exists, <c>'$end_of_table'</c> is returned.</p> - <p>To find the last key in the table, use + <p>To find the last key in an <c>ordered_set</c> table, use <seealso marker="#last/1"><c>last/1</c></seealso>.</p> </desc> </func> @@ -1292,7 +1358,16 @@ ets:select(ets:repair_continuation(Broken,MS)).</code> <fsummary>Fix an ETS table for safe traversal.</fsummary> <desc> <p>Fixes a table of type <c>set</c>, <c>bag</c>, or - <c>duplicate_bag</c> for safe traversal.</p> + <c>duplicate_bag</c> for <seealso marker="#traversal"> + safe traversal</seealso> using + <seealso marker="#first/1"><c>first/1</c></seealso> & + <seealso marker="#next/2"><c>next/2</c></seealso>, + <seealso marker="#match/3"><c>match/3</c></seealso> & + <seealso marker="#match/1"><c>match/1</c></seealso>, + <seealso marker="#match_object/3"><c>match_object/3</c></seealso> & + <seealso marker="#match_object/1"><c>match_object/1</c></seealso>, or + <seealso marker="#select/3"><c>select/3</c></seealso> & + <seealso marker="#select/1"><c>select/1</c></seealso>.</p> <p>A process fixes a table by calling <c>safe_fixtable(<anno>Tab</anno>, true)</c>. The table remains fixed until the process releases it by calling @@ -1305,11 +1380,11 @@ ets:select(ets:repair_continuation(Broken,MS)).</code> <p>When a table is fixed, a sequence of <seealso marker="#first/1"><c>first/1</c></seealso> and <seealso marker="#next/2"><c>next/2</c></seealso> calls are - guaranteed to succeed, and each object in - the table is returned only once, even if objects - are removed or inserted during the traversal. The keys for new - objects inserted during the traversal <em>can</em> be returned by - <c>next/2</c> (it depends on the internal ordering of the keys).</p> + guaranteed to succeed even if keys are removed during the + traversal. The keys for objects inserted or deleted during a + traversal may or may not be returned by <c>next/2</c> depending on + the ordering of keys within the table and if the key exists at the time + <c>next/2</c> is called.</p> <p><em>Example:</em></p> <code type="none"> clean_all_with_value(Tab,X) -> @@ -1327,7 +1402,7 @@ clean_all_with_value(Tab,X,Key) -> true end, clean_all_with_value(Tab,X,ets:next(Tab,Key)).</code> - <p>Notice that no deleted objects are removed from a + <p>Notice that deleted objects are not freed from a fixed table until it has been released. If a process fixes a table but never releases it, the memory used by the deleted objects is never freed. The performance of operations on @@ -1337,9 +1412,9 @@ clean_all_with_value(Tab,X,Key) -> <c>info(Tab, safe_fixed_monotonic_time)</c></seealso>. A system with many processes fixing tables can need a monitor that sends alarms when tables have been fixed for too long.</p> - <p>Notice that for table type <c>ordered_set</c>, - <c>safe_fixtable/2</c> is not necessary, as calls to - <c>first/1</c> and <c>next/2</c> always succeed.</p> + <p>Notice that <c>safe_fixtable/2</c> is not necessary for table type + <c>ordered_set</c> and for traversals done by a single ETS function call, + like <seealso marker="#select/2"><c>select/2</c></seealso>.</p> </desc> </func> @@ -1467,7 +1542,10 @@ is_integer(X), is_integer(Y), X + Y < 4711]]></code> table, which is still faster than traversing the table object by object using <seealso marker="#first/1"><c>first/1</c></seealso> and <seealso marker="#next/2"><c>next/2</c></seealso>.</p> - <p>If the table is empty, <c>'$end_of_table'</c> is returned.</p> + <p>If the table is empty, <c>'$end_of_table'</c> is returned.</p> + <p>Use <seealso marker="#safe_fixtable/2"><c>safe_fixtable/2</c></seealso> + to guarantee <seealso marker="#traversal">safe traversal</seealso> + for subsequent calls to <seealso marker="#select/1"><c>select/1</c></seealso>.</p> </desc> </func> @@ -1524,7 +1602,7 @@ is_integer(X), is_integer(Y), X + Y < 4711]]></code> the match specification result.</p> <p>The match-and-replace operation for each individual object is guaranteed to be <seealso marker="#concurrency">atomic and isolated</seealso>. The - <c>select_replace</c> table iteration as a whole, like all other select functions, + <c>select_replace</c> table traversal as a whole, like all other select functions, does not give such guarantees.</p> <p>The match specifiction must be guaranteed to <em>retain the key</em> of any matched object. If not, <c>select_replace</c> will fail with <c>badarg</c> diff --git a/lib/stdlib/doc/src/io_lib.xml b/lib/stdlib/doc/src/io_lib.xml index cd4ca0a3a7..4d527f8ed3 100644 --- a/lib/stdlib/doc/src/io_lib.xml +++ b/lib/stdlib/doc/src/io_lib.xml @@ -385,7 +385,7 @@ <func> <name name="write" arity="1" since=""/> <name name="write" arity="2" clause_i="1" since=""/> - <name name="write" arity="2" clause_i="2" since=""/> + <name name="write" arity="2" clause_i="2" since="OTP 20.0"/> <fsummary>Write a term.</fsummary> <desc> <p>Returns a character list that represents <c><anno>Term</anno></c>. diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml index 66146e9258..2755fb3dce 100644 --- a/lib/stdlib/doc/src/lists.xml +++ b/lib/stdlib/doc/src/lists.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2018</year> + <year>1996</year><year>2019</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -689,6 +689,18 @@ c</pre> </func> <func> + <name name="search" arity="2" since="OTP 21.0"/> + <fsummary>Find the first element that satisfies a predicate.</fsummary> + <desc> + <p>If there is a <c><anno>Value</anno></c> in <c><anno>List</anno></c> + such that <c><anno>Pred</anno>(<anno>Value</anno>)</c> returns + <c>true</c>, returns <c>{value, <anno>Value</anno>}</c> + for the first such <c><anno>Value</anno></c>, + otherwise returns <c>false</c>.</p> + </desc> + </func> + + <func> <name name="seq" arity="2" since=""/> <name name="seq" arity="3" since=""/> <fsummary>Generate a sequence of integers.</fsummary> @@ -771,18 +783,6 @@ length(lists:seq(From, To, Incr)) =:= (To - From + Incr) div Incr</code> </func> <func> - <name name="search" arity="2" since="OTP 21.0"/> - <fsummary>Find the first element that satisfies a predicate.</fsummary> - <desc> - <p>If there is a <c><anno>Value</anno></c> in <c><anno>List</anno></c> - such that <c><anno>Pred</anno>(<anno>Value</anno>)</c> returns - <c>true</c>, returns <c>{value, <anno>Value</anno>}</c> - for the first such <c><anno>Value</anno></c>, - otherwise returns <c>false</c>.</p> - </desc> - </func> - - <func> <name name="splitwith" arity="2" since=""/> <fsummary>Split a list into two lists based on a predicate.</fsummary> <desc> diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 9602f0bcd9..4ad94f2507 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -841,7 +841,7 @@ Erlang code. -type af_record_field(T) :: {'record_field', anno(), af_field_name(), T}. -type af_map_pattern() :: - {'map', anno(), [af_assoc_exact(abstract_expr)]}. + {'map', anno(), [af_assoc_exact(abstract_expr())]}. -type abstract_type() :: af_annotated_type() | af_atom() @@ -872,7 +872,7 @@ Erlang code. -type af_fun_type() :: {'type', anno(), 'fun', []} | {'type', anno(), 'fun', [{'type', anno(), 'any'} | abstract_type()]} - | {'type', anno(), 'fun', af_function_type()}. + | af_function_type(). -type af_integer_range_type() :: {'type', anno(), 'range', [af_singleton_integer_type()]}. @@ -924,10 +924,11 @@ Erlang code. -type af_function_constraint() :: [af_constraint()]. -type af_constraint() :: {'type', anno(), 'constraint', - af_lit_atom('is_subtype'), - [af_type_variable() | abstract_type()]}. % [V, T] + [af_lit_atom('is_subtype') | + [af_type_variable() | abstract_type()]]}. % [IsSubtype, [V, T]] -type af_singleton_integer_type() :: af_integer() + | af_character() | af_unary_op(af_singleton_integer_type()) | af_binary_op(af_singleton_integer_type()). diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 6f1f6a0228..513118a874 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2016-2018. All Rights Reserved. +%% Copyright Ericsson AB 2016-2019. 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. @@ -374,50 +374,51 @@ timeout_event_type(Type) -> -define( + relative_timeout(T), + ((is_integer(T) andalso 0 =< (T)) orelse (T) =:= infinity)). + +-define( + absolute_timeout(T), + (is_integer(T) orelse (T) =:= infinity)). + +-define( STACKTRACE(), element(2, erlang:process_info(self(), current_stacktrace))). -define(not_sys_debug, []). %% %% This is a macro to only evaluate arguments if Debug =/= []. -%% Debug is evaluated multiple times. +%% Debug is evaluated 2 times. -define( - sys_debug(Debug, NameState, Entry), + sys_debug(Debug, Extra, SystemEvent), case begin Debug end of ?not_sys_debug -> begin Debug end; _ -> - sys_debug(begin Debug end, begin NameState end, begin Entry end) + sys_debug( + begin Debug end, begin Extra end, begin SystemEvent end) end). --record(state, +-record(params, {callback_mode = undefined :: callback_mode() | undefined, state_enter = false :: boolean(), + parent :: pid(), module :: atom(), - name :: atom(), - state :: term(), - data :: term(), + name :: atom() | pid(), + hibernate_after = infinity :: timeout() + }). + +-record(state, + {state_data = {undefined,undefined} :: + {State :: term(),Data :: term()}, postponed = [] :: [{event_type(),term()}], - %% - timer_refs = #{} :: % timer ref => the timer's event type - #{reference() => timeout_event_type()}, - timer_types = #{} :: % timer's event type => timer ref - #{timeout_event_type() => reference()}, - cancel_timers = 0 :: non_neg_integer(), - %% We add a timer to both timer_refs and timer_types - %% when we start it. When we request an asynchronous - %% timer cancel we remove it from timer_types. When - %% the timer cancel message arrives we remove it from - %% timer_refs. - %% - hibernate = false :: boolean(), - hibernate_after = infinity :: timeout()}). - --record(trans_opts, - {hibernate = false, - postpone = false, - timeouts_r = [], - next_events_r = []}). + timers = {#{},#{}} :: + {%% TimerRef => TimeoutType + TimerRefs :: #{reference() => timeout_event_type()}, + %% TimeoutType => TimerRef + TimeoutTypes :: #{timeout_event_type() => reference()}}, + hibernate = false :: boolean() + }). %%%========================================================================== %%% API @@ -667,31 +668,25 @@ enter( Parent, Debug, Module, Name, HibernateAfterTimeout, State, Data, Actions) -> %% The values should already have been type checked - Events = [], - Event = {internal,init_state}, + Q = [{internal,init_state}], %% We enforce {postpone,false} to ensure that %% our fake Event gets discarded, thought it might get logged - NewActions = listify(Actions) ++ [{postpone,false}], - S = - #state{ + Actions_1 = listify(Actions) ++ [{postpone,false}], + P = + #params{ + parent = Parent, module = Module, name = Name, - state = State, - data = Data, hibernate_after = HibernateAfterTimeout}, - CallEnter = true, - NewDebug = ?sys_debug(Debug, Name, {enter,State}), - case call_callback_mode(S) of - #state{} = NewS -> - loop_event_actions_list( - Parent, NewDebug, NewS, - Events, Event, State, Data, false, - NewActions, CallEnter); - [Class,Reason,Stacktrace] -> - terminate( - Class, Reason, Stacktrace, NewDebug, - S, [Event|Events]) - end. + S = #state{state_data = {State,Data}}, + Debug_1 = ?sys_debug(Debug, Name, {enter,State}), + loop_callback_mode( + P, Debug_1, S, Q, {State,Data}, + %% Tunneling Actions through CallbackEvent here... + %% Special path to go to action handling, after first + %% finding out the callback mode. CallbackEvent is + %% a 2-tuple and Actions a list, which achieves this distinction. + Actions_1). %%%========================================================================== %%% gen callbacks @@ -717,8 +712,8 @@ init_it(Starter, Parent, ServerRef, Module, Args, Opts) -> proc_lib:init_ack(Starter, {error,Reason}), error_info( Class, Reason, Stacktrace, Debug, - #state{name = Name}, - []), + #params{parent = Parent, name = Name, module = Module}, + #state{}, []), erlang:raise(Class, Reason, Stacktrace) end. @@ -753,25 +748,29 @@ init_result( proc_lib:init_ack(Starter, {error,Error}), error_info( error, Error, ?STACKTRACE(), Debug, - #state{name = Name}, - []), + #params{parent = Parent, name = Name, module = Module}, + #state{}, []), exit(Error) end. %%%========================================================================== %%% sys callbacks +%%% +%%% We use {P,S} as state (Misc) for the sys module, +%%% wrap/unwrap it for the server loop* and update +%%% P#params{parent = Parent}. -system_continue(Parent, Debug, S) -> - loop(Parent, Debug, S). +system_continue(Parent, Debug, {P,S}) -> + loop(update_parent(P, Parent), Debug, S). -system_terminate(Reason, _Parent, Debug, S) -> - terminate(exit, Reason, ?STACKTRACE(), Debug, S, []). +system_terminate(Reason, Parent, Debug, {P,S}) -> + terminate( + exit, Reason, ?STACKTRACE(), + update_parent(P, Parent), Debug, S, []). system_code_change( - #state{ - module = Module, - state = State, - data = Data} = S, + {#params{module = Module} = P, + #state{state_data = {State,Data}} = S}, _Mod, OldVsn, Extra) -> case try Module:code_change(OldVsn, State, Data, Extra) @@ -781,31 +780,28 @@ system_code_change( of {ok,NewState,NewData} -> {ok, - S#state{ - callback_mode = undefined, - state = NewState, - data = NewData}}; + {P#params{callback_mode = undefined}, + S#state{state_data = {NewState,NewData}}}}; {ok,_} = Error -> error({case_clause,Error}); Error -> Error end. -system_get_state(#state{state = State, data = Data}) -> - {ok,{State,Data}}. +system_get_state({_P,#state{state_data = State_Data}}) -> + {ok,State_Data}. system_replace_state( - StateFun, - #state{ - state = State, - data = Data} = S) -> - {NewState,NewData} = Result = StateFun({State,Data}), - {ok,Result,S#state{state = NewState, data = NewData}}. + StateFun, {P,#state{state_data = State_Data} = S}) -> + %% + NewState_NewData = StateFun(State_Data), + {ok,NewState_NewData,{P,S#state{state_data = NewState_NewData}}}. format_status( Opt, [PDict,SysState,Parent,Debug, - #state{name = Name, postponed = P} = S]) -> + {#params{name = Name} = P, + #state{postponed = Postponed} = S}]) -> Header = gen:format_status_header("Status for state machine", Name), Log = sys:get_log(Debug), [{header,Header}, @@ -813,12 +809,25 @@ format_status( [{"Status",SysState}, {"Parent",Parent}, {"Logged Events",Log}, - {"Postponed",P}]} | - case format_status(Opt, PDict, S) of + {"Postponed",Postponed}]} | + case format_status(Opt, PDict, update_parent(P, Parent), S) of L when is_list(L) -> L; T -> [T] end]. +%% Update #params.parent only if it differs. This should not +%% be possible today (OTP-22.0), but could happen for example +%% if someone implements changing a server's parent +%% in a new sys call. +-compile({inline, update_parent/2}). +update_parent(P, Parent) -> + case P of + #params{parent = Parent} -> + P; + #params{} -> + P#params{parent = Parent} + end. + %%--------------------------------------------------------------------------- %% Format debug messages. Print them as the call-back module sees %% them, not as the real erlang messages. Use trace for that. @@ -874,143 +883,112 @@ event_string(Event) -> %%%========================================================================== %%% Internal callbacks -wakeup_from_hibernate(Parent, Debug, S) -> +wakeup_from_hibernate(P, Debug, S) -> %% It is a new message that woke us up so we have to receive it now - loop_receive(Parent, Debug, S). + loop_receive(P, Debug, S). %%%========================================================================== -%%% State Machine engine implementation of proc_lib/gen server +%%% State Machine engine implementation on proc_lib/gen %% Server loop, consists of all loop* functions %% and detours through sys:handle_system_message/7 and proc_lib:hibernate/3 +%% +%% The loop tries to keep all temporary values in arguments +%% and takes shortcuts for ?not_sys_debug, empty lists, etc. +%% The engine state #state{} is picked apart during the loop, +%% new values are kept in arguments, and a new #state{} is +%% composed at the end of the loop. #params{} collect engine +%% state fields that rarely changes. +%% +%% The loop is optimized a bit for staying in the loop, assuming that +%% system events are rare. So a detour to sys requires re-packing +%% of the engine state. %% Entry point for system_continue/3 -loop(Parent, Debug, #state{hibernate = true, cancel_timers = 0} = S) -> - loop_hibernate(Parent, Debug, S); -loop(Parent, Debug, S) -> - loop_receive(Parent, Debug, S). +%% +loop(P, Debug, #state{hibernate = true} = S) -> + loop_hibernate(P, Debug, S); +loop(P, Debug, S) -> + loop_receive(P, Debug, S). -loop_hibernate(Parent, Debug, S) -> +%% Go to hibernation +%% +loop_hibernate(P, Debug, S) -> %% %% Does not return but restarts process at %% wakeup_from_hibernate/3 that jumps to loop_receive/3 %% - proc_lib:hibernate( - ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]), + proc_lib:hibernate(?MODULE, wakeup_from_hibernate, [P, Debug, S]), error( {should_not_have_arrived_here_but_instead_in, - {wakeup_from_hibernate,3}}). + {?MODULE,wakeup_from_hibernate,3}}). + %% Entry point for wakeup_from_hibernate/3 +%% +%% Receive a new process message +%% loop_receive( - Parent, Debug, #state{hibernate_after = HibernateAfterTimeout} = S) -> + #params{hibernate_after = HibernateAfterTimeout} = P, Debug, S) -> %% receive Msg -> case Msg of + {'$gen_call',From,Request} -> + loop_receive_result(P, Debug, S, {{call,From},Request}); + {'$gen_cast',Cast} -> + loop_receive_result(P, Debug, S, {cast,Cast}); + %% + {timeout,TimerRef,TimeoutMsg} -> + {TimerRefs,TimeoutTypes} = S#state.timers, + case TimerRefs of + #{TimerRef := TimeoutType} -> + %% Our timer + Timers = + {maps:remove(TimerRef, TimerRefs), + maps:remove(TimeoutType, TimeoutTypes)}, + S_1 = S#state{timers = Timers}, + loop_receive_result( + P, Debug, S_1, {TimeoutType,TimeoutMsg}); + #{} -> + loop_receive_result(P, Debug, S, {info,Msg}) + end; + %% {system,Pid,Req} -> %% Does not return but tail recursively calls %% system_continue/3 that jumps to loop/3 sys:handle_system_msg( - Req, Pid, Parent, ?MODULE, Debug, S, + Req, Pid, P#params.parent, ?MODULE, Debug, + {P,S}, S#state.hibernate); - {'EXIT',Parent,Reason} = EXIT -> - %% EXIT is not a 2-tuple therefore - %% not an event but this will stand out - %% in the crash report... - Q = [EXIT], - terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q); - {timeout,TimerRef,TimerMsg} -> - #state{ - timer_refs = TimerRefs, - timer_types = TimerTypes} = S, - case TimerRefs of - #{TimerRef := TimerType} -> - %% We know of this timer; is it a running - %% timer or a timer being cancelled that - %% managed to send a late timeout message? - case TimerTypes of - #{TimerType := TimerRef} -> - %% The timer type maps back to this - %% timer ref, so it was a running timer - %% Unregister the triggered timeout - NewTimerRefs = - maps:remove(TimerRef, TimerRefs), - NewTimerTypes = - maps:remove(TimerType, TimerTypes), - loop_receive_result( - Parent, Debug, - S#state{ - timer_refs = NewTimerRefs, - timer_types = NewTimerTypes}, - TimerType, TimerMsg); - _ -> - %% This was a late timeout message - %% from timer being cancelled, so - %% ignore it and expect a cancel_timer - %% msg shortly - loop_receive(Parent, Debug, S) - end; - _ -> - %% Not our timer; present it as an event - loop_receive_result(Parent, Debug, S, info, Msg) - end; - {cancel_timer,TimerRef,_} -> - #state{ - timer_refs = TimerRefs, - cancel_timers = CancelTimers, - hibernate = Hibernate} = S, - case TimerRefs of - #{TimerRef := _} -> - %% We must have requested a cancel - %% of this timer so it is already - %% removed from TimerTypes - NewTimerRefs = - maps:remove(TimerRef, TimerRefs), - NewCancelTimers = CancelTimers - 1, - NewS = - S#state{ - timer_refs = NewTimerRefs, - cancel_timers = NewCancelTimers}, - if - Hibernate =:= true, NewCancelTimers =:= 0 -> - %% No more cancel_timer msgs to expect; - %% we can hibernate - loop_hibernate(Parent, Debug, NewS); - NewCancelTimers >= 0 -> % Assert - loop_receive(Parent, Debug, NewS) - end; - _ -> - %% Not our cancel_timer msg; - %% present it as an event - loop_receive_result(Parent, Debug, S, info, Msg) - end; - _ -> - %% External msg - case Msg of - {'$gen_call',From,Request} -> - loop_receive_result( - Parent, Debug, S, {call,From}, Request); - {'$gen_cast',Cast} -> - loop_receive_result(Parent, Debug, S, cast, Cast); + {'EXIT',Pid,Reason} -> + case P#params.parent of + Pid -> + terminate( + exit, Reason, ?STACKTRACE(), P, Debug, S, []); _ -> - loop_receive_result(Parent, Debug, S, info, Msg) - end + loop_receive_result(P, Debug, S, {info,Msg}) + end; + %% + _ -> + loop_receive_result(P, Debug, S, {info,Msg}) end after - HibernateAfterTimeout -> - loop_hibernate(Parent, Debug, S) + HibernateAfterTimeout -> + loop_hibernate(P, Debug, S) end. -loop_receive_result(Parent, ?not_sys_debug, S, Type, Content) -> +%% We have received an event +%% +loop_receive_result(P, ?not_sys_debug = Debug, S, Event) -> %% Here is the queue of not yet handled events created Events = [], - loop_event(Parent, ?not_sys_debug, S, Events, Type, Content); + loop_event(P, Debug, S, Event, Events); loop_receive_result( - Parent, Debug, #state{name = Name, state = State} = S, Type, Content) -> - Event = {Type,Content}, - NewDebug = - case S#state.callback_mode of + #params{name = Name, callback_mode = CallbackMode} = P, Debug, + #state{state_data = {State,_Data}} = S, Event) -> + Debug_1 = + case CallbackMode of undefined -> sys_debug(Debug, Name, {code_change,Event,State}); _ -> @@ -1018,829 +996,1056 @@ loop_receive_result( end, %% Here is the queue of not yet handled events created Events = [], - loop_event(Parent, NewDebug, S, Events, Type, Content). + loop_event(P, Debug_1, S, Event, Events). -%% Entry point for handling an event, received or enqueued +%% Handle one event; received or enqueued +%% loop_event( - Parent, Debug, #state{hibernate = Hibernate} = S, - Events, Type, Content) -> + P, Debug, #state{hibernate = true} = S, Event, Events) -> %% - case Hibernate of - true -> - %% - %% If (this old) Hibernate is true here it can only be - %% because it was set from an event action - %% and we did not go into hibernation since there were - %% events in queue, so we do what the user - %% might rely on i.e collect garbage which - %% would have happened if we actually hibernated - %% and immediately was awakened. - %% - _ = garbage_collect(), - loop_event_state_function( - Parent, Debug, S, Events, Type, Content); - false -> - loop_event_state_function( - Parent, Debug, S, Events, Type, Content) - end. + %% If (this old) Hibernate is true here it can only be + %% because it was set from an event action + %% and we did not go into hibernation since there were + %% events in queue, so we do what the user + %% might rely on i.e collect garbage which + %% would have happened if we actually hibernated + %% and immediately was awakened. + %% + _ = garbage_collect(), + loop_event_handler(P, Debug, S, Event, Events); +loop_event(P, Debug, S, Event, Events) -> + loop_event_handler(P, Debug, S, Event, Events). -%% Call the state function -loop_event_state_function( - Parent, Debug, - #state{state = State, data = Data} = S, - Events, Type, Content) -> +%% Call the state function, eventually +%% +-compile({inline, [loop_event_handler/5]}). +loop_event_handler( + P, Debug, #state{state_data = State_Data} = S, Event, Events) -> %% %% The field 'hibernate' in S is now invalid and will be - %% restored when looping back to loop/3 or loop_event/6. + %% restored when looping back to loop/3 or loop_event/5. %% - Event = {Type,Content}, - TransOpts = false, - case call_state_function(S, Type, Content, State, Data) of - {Result, NewS} -> - loop_event_result( - Parent, Debug, NewS, - Events, Event, State, Data, TransOpts, Result); - [Class,Reason,Stacktrace] -> - terminate( - Class, Reason, Stacktrace, Debug, S, [Event|Events]) - end. + Q = [Event|Events], + loop_callback_mode(P, Debug, S, Q, State_Data, Event). -%% Make a state enter call to the state function -loop_event_state_enter( - Parent, Debug, #state{state = PrevState} = S, - Events, Event, NextState, NewData, TransOpts) -> +%% Figure out the callback mode +%% +loop_callback_mode( + #params{callback_mode = undefined} = P, Debug, S, + Q, State_Data, CallbackEvent) -> %% - case call_state_function(S, enter, PrevState, NextState, NewData) of - {Result, NewS} -> - loop_event_result( - Parent, Debug, NewS, - Events, Event, NextState, NewData, TransOpts, Result); - [Class,Reason,Stacktrace] -> + Module = P#params.module, + try Module:callback_mode() of + CallbackMode -> + loop_callback_mode_result( + P, Debug, S, + Q, State_Data, CallbackEvent, + CallbackMode, listify(CallbackMode), undefined, false) + catch + CallbackMode -> + loop_callback_mode_result( + P, Debug, S, + Q, State_Data, CallbackEvent, + CallbackMode, listify(CallbackMode), undefined, false); + Class:Reason:Stacktrace -> terminate( - Class, Reason, Stacktrace, Debug, S, [Event|Events]) + Class, Reason, Stacktrace, P, Debug, S, Q) + end; +loop_callback_mode(P, Debug, S, Q, State_Data, CallbackEvent) -> + loop_state_callback(P, Debug, S, Q, State_Data, CallbackEvent). + +%% Check the result of Module:callback_mode() +%% +loop_callback_mode_result( + P, Debug, S, Q, State_Data, CallbackEvent, + CallbackMode, [H|T], NewCallbackMode, NewStateEnter) -> + %% + case callback_mode(H) of + true -> + loop_callback_mode_result( + P, Debug, S, Q, State_Data, CallbackEvent, + CallbackMode, T, H, NewStateEnter); + false -> + case state_enter(H) of + true -> + loop_callback_mode_result( + P, Debug, S, Q, State_Data, CallbackEvent, + CallbackMode, T, NewCallbackMode, true); + false -> + terminate( + error, + {bad_return_from_callback_mode,CallbackMode}, + ?STACKTRACE(), + P, Debug, S, Q) + end + end; +loop_callback_mode_result( + P, Debug, S, Q, State_Data, CallbackEvent, + CallbackMode, [], NewCallbackMode, NewStateEnter) -> + %% + case NewCallbackMode of + undefined -> + terminate( + error, + {bad_return_from_callback_mode,CallbackMode}, + ?STACKTRACE(), + P, Debug, S, Q); + _ -> + P_1 = + P#params{ + callback_mode = NewCallbackMode, + state_enter = NewStateEnter}, + loop_state_callback( + P_1, Debug, S, Q, State_Data, CallbackEvent) end. -%% Process the result from the state function. -%% When TransOpts =:= false it was a state function call, -%% otherwise it is an option tuple and it was a state enter call. + +%% Make a state enter call to the state function, we loop back here +%% from further down if state enter calls are enabled +%% +loop_state_enter( + P, Debug, #state{state_data = {PrevState,_PrevData}} = S, + Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone) -> + %% + StateCall = false, + CallbackEvent = {enter,PrevState}, + loop_state_callback( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone, + StateCall, CallbackEvent). + +%% Make a state call (not state enter call) to the state function +%% +loop_state_callback(P, Debug, S, Q, State_Data, CallbackEvent) -> + NextEventsR = [], + Hibernate = false, + TimeoutsR = [], + Postpone = false, + StateCall = true, + loop_state_callback( + P, Debug, S, Q, State_Data, + NextEventsR, Hibernate, TimeoutsR, Postpone, + StateCall, CallbackEvent). +%% +loop_state_callback( + #params{callback_mode = CallbackMode, module = Module} = P, + Debug, S, Q, {State,Data} = State_Data, + NextEventsR, Hibernate, TimeoutsR, Postpone, + StateCall, {Type,Content}) -> + try + case CallbackMode of + state_functions -> + Module:State(Type, Content, Data); + handle_event_function -> + Module:handle_event(Type, Content, State, Data) + end + of + Result -> + loop_state_callback_result( + P, Debug, S, Q, State_Data, + NextEventsR, Hibernate, TimeoutsR, Postpone, + StateCall, Result) + catch + Result -> + loop_state_callback_result( + P, Debug, S, Q, State_Data, + NextEventsR, Hibernate, TimeoutsR, Postpone, + StateCall, Result); + Class:Reason:Stacktrace -> + terminate(Class, Reason, Stacktrace, P, Debug, S, Q) + end; +loop_state_callback( + P, Debug, S, Q, State_Data, + NextEventsR, Hibernate, TimeoutsR, Postpone, + StateCall, Actions) when is_list(Actions) -> + %% Tunneled actions from enter/8 + CallEnter = true, + loop_actions_list( + P, Debug, S, Q, State_Data, + NextEventsR, Hibernate, TimeoutsR, Postpone, + CallEnter, StateCall, Actions). + +%% Process the result from the state function %% -loop_event_result( - Parent, Debug, S, - Events, Event, State, Data, TransOpts, Result) -> +loop_state_callback_result( + P, Debug, S, Q, {State,_Data} = State_Data, + NextEventsR, Hibernate, TimeoutsR, Postpone, + StateCall, Result) -> %% case Result of {next_state,State,NewData} -> - loop_event_actions( - Parent, Debug, S, - Events, Event, State, NewData, TransOpts, - [], false); + loop_actions( + P, Debug, S, Q, {State,NewData}, + NextEventsR, Hibernate, TimeoutsR, Postpone, + false); {next_state,NextState,NewData} - when TransOpts =:= false -> - loop_event_actions( - Parent, Debug, S, - Events, Event, NextState, NewData, TransOpts, - [], true); + when StateCall -> + loop_actions( + P, Debug, S, Q, {NextState,NewData}, + NextEventsR, Hibernate, TimeoutsR, Postpone, + true); {next_state,_NextState,_NewData} -> terminate( error, {bad_state_enter_return_from_state_function,Result}, - ?STACKTRACE(), Debug, + ?STACKTRACE(), P, Debug, S#state{ - state = State, data = Data, - hibernate = hibernate_in_trans_opts(TransOpts)}, - [Event|Events]); + state_data = State_Data, + hibernate = Hibernate}, + Q); {next_state,State,NewData,Actions} -> - loop_event_actions( - Parent, Debug, S, - Events, Event, State, NewData, TransOpts, - Actions, false); + loop_actions( + P, Debug, S, Q, {State,NewData}, + NextEventsR, Hibernate, TimeoutsR, Postpone, + false, StateCall, Actions); {next_state,NextState,NewData,Actions} - when TransOpts =:= false -> - loop_event_actions( - Parent, Debug, S, - Events, Event, NextState, NewData, TransOpts, - Actions, true); + when StateCall -> + loop_actions( + P, Debug, S, Q, {NextState,NewData}, + NextEventsR, Hibernate, TimeoutsR, Postpone, + true, StateCall, Actions); {next_state,_NextState,_NewData,_Actions} -> terminate( error, {bad_state_enter_return_from_state_function,Result}, - ?STACKTRACE(), Debug, + ?STACKTRACE(), P, Debug, S#state{ - state = State, data = Data, - hibernate = hibernate_in_trans_opts(TransOpts)}, - [Event|Events]); + state_data = State_Data, + hibernate = Hibernate}, + Q); %% {keep_state,NewData} -> - loop_event_actions( - Parent, Debug, S, - Events, Event, State, NewData, TransOpts, - [], false); + loop_actions( + P, Debug, S, Q, {State,NewData}, + NextEventsR, Hibernate, TimeoutsR, Postpone, + false); {keep_state,NewData,Actions} -> - loop_event_actions( - Parent, Debug, S, - Events, Event, State, NewData, TransOpts, - Actions, false); + loop_actions( + P, Debug, S, Q, {State,NewData}, + NextEventsR, Hibernate, TimeoutsR, Postpone, + false, StateCall, Actions); %% keep_state_and_data -> - loop_event_actions( - Parent, Debug, S, - Events, Event, State, Data, TransOpts, - [], false); + loop_actions( + P, Debug, S, Q, State_Data, + NextEventsR, Hibernate, TimeoutsR, Postpone, + false); {keep_state_and_data,Actions} -> - loop_event_actions( - Parent, Debug, S, - Events, Event, State, Data, TransOpts, - Actions, false); + loop_actions( + P, Debug, S, Q, State_Data, + NextEventsR, Hibernate, TimeoutsR, Postpone, + false, StateCall, Actions); %% {repeat_state,NewData} -> - loop_event_actions( - Parent, Debug, S, - Events, Event, State, NewData, TransOpts, - [], true); + loop_actions( + P, Debug, S, Q, {State,NewData}, + NextEventsR, Hibernate, TimeoutsR, Postpone, + true); {repeat_state,NewData,Actions} -> - loop_event_actions( - Parent, Debug, S, - Events, Event, State, NewData, TransOpts, - Actions, true); + loop_actions( + P, Debug, S, Q, {State,NewData}, + NextEventsR, Hibernate, TimeoutsR, Postpone, + true, StateCall, Actions); %% repeat_state_and_data -> - loop_event_actions( - Parent, Debug, S, - Events, Event, State, Data, TransOpts, - [], true); + loop_actions( + P, Debug, S, Q, State_Data, + NextEventsR, Hibernate, TimeoutsR, Postpone, + true); {repeat_state_and_data,Actions} -> - loop_event_actions( - Parent, Debug, S, - Events, Event, State, Data, TransOpts, - Actions, true); + loop_actions( + P, Debug, S, Q, State_Data, + NextEventsR, Hibernate, TimeoutsR, Postpone, + true, StateCall, Actions); %% stop -> terminate( - exit, normal, ?STACKTRACE(), Debug, + exit, normal, ?STACKTRACE(), P, Debug, S#state{ - state = State, data = Data, - hibernate = hibernate_in_trans_opts(TransOpts)}, - [Event|Events]); + state_data = State_Data, + hibernate = Hibernate}, + Q); {stop,Reason} -> terminate( - exit, Reason, ?STACKTRACE(), Debug, + exit, Reason, ?STACKTRACE(), P, Debug, S#state{ - state = State, data = Data, - hibernate = hibernate_in_trans_opts(TransOpts)}, - [Event|Events]); + state_data = State_Data, + hibernate = Hibernate}, + Q); {stop,Reason,NewData} -> terminate( - exit, Reason, ?STACKTRACE(), Debug, + exit, Reason, ?STACKTRACE(), P, Debug, S#state{ - state = State, data = NewData, - hibernate = hibernate_in_trans_opts(TransOpts)}, - [Event|Events]); + state_data = {State,NewData}, + hibernate = Hibernate}, + Q); %% {stop_and_reply,Reason,Replies} -> reply_then_terminate( - exit, Reason, ?STACKTRACE(), Debug, + exit, Reason, ?STACKTRACE(), P, Debug, S#state{ - state = State, data = Data, - hibernate = hibernate_in_trans_opts(TransOpts)}, - [Event|Events], Replies); + state_data = State_Data, + hibernate = Hibernate}, + Q, Replies); {stop_and_reply,Reason,Replies,NewData} -> reply_then_terminate( - exit, Reason, ?STACKTRACE(), Debug, + exit, Reason, ?STACKTRACE(), P, Debug, S#state{ - state = State, data = NewData, - hibernate = hibernate_in_trans_opts(TransOpts)}, - [Event|Events], Replies); + state_data = {State,NewData}, + hibernate = Hibernate}, + Q, Replies); %% _ -> terminate( error, {bad_return_from_state_function,Result}, - ?STACKTRACE(), Debug, + ?STACKTRACE(), P, Debug, S#state{ - state = State, data = Data, - hibernate = hibernate_in_trans_opts(TransOpts)}, - [Event|Events]) + state_data = State_Data, + hibernate = Hibernate}, + Q) end. %% Ensure that Actions are a list -loop_event_actions( - Parent, Debug, S, - Events, Event, NextState, NewerData, TransOpts, - Actions, CallEnter) -> - loop_event_actions_list( - Parent, Debug, S, - Events, Event, NextState, NewerData, TransOpts, - listify(Actions), CallEnter). - -%% Process actions from the state function -loop_event_actions_list( - Parent, Debug, #state{state_enter = StateEnter} = S, - Events, Event, NextState, NewerData, TransOpts, - Actions, CallEnter) -> +%% +loop_actions( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone, + CallEnter, _StateCall, []) -> + loop_actions( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone, + CallEnter); +loop_actions( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone, + CallEnter, StateCall, Actions) -> %% - case parse_actions(TransOpts, Debug, S, Actions) of - {NewDebug,NewTransOpts} - when StateEnter, CallEnter -> - loop_event_state_enter( - Parent, NewDebug, S, - Events, Event, NextState, NewerData, NewTransOpts); - {NewDebug,NewTransOpts} -> - loop_event_done( - Parent, NewDebug, S, - Events, Event, NextState, NewerData, NewTransOpts); - [Class,Reason,Stacktrace,NewDebug] -> - terminate( - Class, Reason, Stacktrace, NewDebug, - S#state{ - state = NextState, - data = NewerData, - hibernate = hibernate_in_trans_opts(TransOpts)}, - [Event|Events]) + loop_actions_list( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone, + CallEnter, StateCall, listify(Actions)). +%% +%% Shortcut for no actions +-compile({inline, [loop_actions/10]}). +loop_actions( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone, + CallEnter) -> + %% + %% Shortcut for no actions + case CallEnter andalso P#params.state_enter of + true -> + loop_state_enter( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone); + false -> + loop_state_transition( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone) end. --compile({inline, [hibernate_in_trans_opts/1]}). -hibernate_in_trans_opts(false) -> - (#trans_opts{})#trans_opts.hibernate; -hibernate_in_trans_opts(#trans_opts{hibernate = Hibernate}) -> - Hibernate. - -parse_actions(false, Debug, S, Actions) -> - parse_actions(true, Debug, S, Actions, #trans_opts{}); -parse_actions(TransOpts, Debug, S, Actions) -> - parse_actions(false, Debug, S, Actions, TransOpts). +%% Process the returned actions %% -parse_actions(_StateCall, Debug, _S, [], TransOpts) -> - {Debug,TransOpts}; -parse_actions(StateCall, Debug, S, [Action|Actions], TransOpts) -> +loop_actions_list( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone, + CallEnter, _StateCall, []) -> + %% + case P#params.state_enter of + true when CallEnter -> + loop_state_enter( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone); + _ -> + loop_state_transition( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone) + end; +loop_actions_list( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone, + CallEnter, StateCall, [Action|Actions]) -> + %% case Action of %% Actual actions {reply,From,Reply} -> - parse_actions_reply( - StateCall, Debug, S, Actions, TransOpts, From, Reply); + loop_actions_reply( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone, + CallEnter, StateCall, Actions, + From, Reply); %% %% Actions that set options - {hibernate,NewHibernate} when is_boolean(NewHibernate) -> - parse_actions( - StateCall, Debug, S, Actions, - TransOpts#trans_opts{hibernate = NewHibernate}); + {hibernate,Hibernate_1} when is_boolean(Hibernate_1) -> + loop_actions_list( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate_1, TimeoutsR, Postpone, + CallEnter, StateCall, Actions); hibernate -> - parse_actions( - StateCall, Debug, S, Actions, - TransOpts#trans_opts{hibernate = true}); + loop_actions_list( + P, Debug, S, Q, NextState_NewData, + NextEventsR, true, TimeoutsR, Postpone, + CallEnter, StateCall, Actions); %% - {postpone,NewPostpone} when not NewPostpone orelse StateCall -> - parse_actions( - StateCall, Debug, S, Actions, - TransOpts#trans_opts{postpone = NewPostpone}); + {postpone,Postpone_1} when not Postpone_1 orelse StateCall -> + loop_actions_list( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone_1, + CallEnter, StateCall, Actions); postpone when StateCall -> - parse_actions( - StateCall, Debug, S, Actions, - TransOpts#trans_opts{postpone = true}); + loop_actions_list( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, true, + CallEnter, StateCall, Actions); postpone -> - [error, - {bad_state_enter_action_from_state_function,Action}, - ?STACKTRACE(), - Debug]; + terminate( + error, + {bad_state_enter_action_from_state_function,Action}, + ?STACKTRACE(), P, Debug, + S#state{ + state_data = NextState_NewData, + hibernate = Hibernate}, + Q); %% {next_event,Type,Content} -> - parse_actions_next_event( - StateCall, Debug, S, Actions, TransOpts, Type, Content); + loop_actions_next_event( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone, + CallEnter, StateCall, Actions, Type, Content); %% - _ -> - parse_actions_timeout( - StateCall, Debug, S, Actions, TransOpts, Action) + Timeout -> + loop_actions_timeout( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone, + CallEnter, StateCall, Actions, Timeout) end. -parse_actions_reply( - StateCall, ?not_sys_debug = Debug, S, Actions, TransOpts, +%% Process a reply action +%% +loop_actions_reply( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone, + CallEnter, StateCall, Actions, From, Reply) -> %% case from(From) of true -> + %% No need for a separate ?not_sys_debug clause here + %% since the external call to erlang:'!'/2 in reply/2 + %% will cause swap out of all live registers anyway reply(From, Reply), - parse_actions(StateCall, ?not_sys_debug, S, Actions, TransOpts); + Debug_1 = ?sys_debug(Debug, P#params.name, {out,Reply,From}), + loop_actions_list( + P, Debug_1, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone, + CallEnter, StateCall, Actions); false -> - [error, - {bad_action_from_state_function,{reply,From,Reply}}, - ?STACKTRACE(), Debug] - end; -parse_actions_reply( - StateCall, Debug, #state{name = Name} = S, - Actions, TransOpts, From, Reply) -> - %% - case from(From) of - true -> - reply(From, Reply), - NewDebug = sys_debug(Debug, Name, {out,Reply,From}), - parse_actions(StateCall, NewDebug, S, Actions, TransOpts); - false -> - [error, - {bad_action_from_state_function,{reply,From,Reply}}, - ?STACKTRACE(), Debug] + terminate( + error, + {bad_action_from_state_function,{reply,From,Reply}}, + ?STACKTRACE(), P, Debug, + S#state{ + state_data = NextState_NewData, + hibernate = Hibernate}, + Q) end. -parse_actions_next_event( - StateCall, ?not_sys_debug = Debug, S, - Actions, TransOpts, Type, Content) -> - case event_type(Type) of - true when StateCall -> - NextEventsR = TransOpts#trans_opts.next_events_r, - parse_actions( - StateCall, ?not_sys_debug, S, Actions, - TransOpts#trans_opts{ - next_events_r = [{Type,Content}|NextEventsR]}); - _ -> - [error, - {bad_state_enter_action_from_state_function, - {next_event,Type,Content}}, - ?STACKTRACE(), Debug] - end; -parse_actions_next_event( - StateCall, Debug, #state{name = Name, state = State} = S, - Actions, TransOpts, Type, Content) -> +%% Process a next_event action +%% +loop_actions_next_event( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone, + CallEnter, StateCall, Actions, Type, Content) -> case event_type(Type) of true when StateCall -> - NewDebug = sys_debug(Debug, Name, {in,{Type,Content},State}), - NextEventsR = TransOpts#trans_opts.next_events_r, - parse_actions( - StateCall, NewDebug, S, Actions, - TransOpts#trans_opts{ - next_events_r = [{Type,Content}|NextEventsR]}); + NextEvent = {Type,Content}, + case Debug of + ?not_sys_debug -> + loop_actions_list( + P, Debug, S, Q, NextState_NewData, + [NextEvent|NextEventsR], + Hibernate, TimeoutsR, Postpone, + CallEnter, StateCall, Actions); + _ -> + Name = P#params.name, + {State,_Data} = S#state.state_data, + Debug_1 = + sys_debug(Debug, Name, {in,{Type,Content},State}), + loop_actions_list( + P, Debug_1, S, Q, NextState_NewData, + [NextEvent|NextEventsR], + Hibernate, TimeoutsR, Postpone, + CallEnter, StateCall, Actions) + end; _ -> - [error, - {bad_state_enter_action_from_state_function, - {next_event,Type,Content}}, - ?STACKTRACE(), - Debug] + terminate( + error, + {if + StateCall -> + bad_action_from_state_function; + true -> + bad_state_enter_action_from_state_function + end, + {next_event,Type,Content}}, + ?STACKTRACE(), P, Debug, + S#state{ + state_data = NextState_NewData, + hibernate = Hibernate}, + Q) end. -parse_actions_timeout( - StateCall, Debug, S, Actions, TransOpts, - {TimeoutType,Time,TimerMsg,TimerOpts} = AbsoluteTimeout) -> +%% Process a timeout action, or also any unrecognized action +%% +loop_actions_timeout( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone, + CallEnter, StateCall, Actions, + {TimeoutType,Time,TimeoutMsg,TimeoutOpts} = Timeout) -> %% - case classify_timeout(TimeoutType, Time, listify(TimerOpts)) of - absolute -> - parse_actions_timeout_add( - StateCall, Debug, S, Actions, - TransOpts, AbsoluteTimeout); - relative -> - RelativeTimeout = {TimeoutType,Time,TimerMsg}, - parse_actions_timeout_add( - StateCall, Debug, S, Actions, - TransOpts, RelativeTimeout); - badarg -> - [error, - {bad_action_from_state_function,AbsoluteTimeout}, - ?STACKTRACE(), - Debug] + case timeout_event_type(TimeoutType) of + true -> + case listify(TimeoutOpts) of + %% Optimization cases + [] when ?relative_timeout(Time) -> + RelativeTimeout = {TimeoutType,Time,TimeoutMsg}, + loop_actions_list( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, + [RelativeTimeout|TimeoutsR], Postpone, + CallEnter, StateCall, Actions); + [{abs,true}] when ?absolute_timeout(Time) -> + loop_actions_list( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, + [Timeout|TimeoutsR], Postpone, + CallEnter, StateCall, Actions); + [{abs,false}] when ?relative_timeout(Time) -> + RelativeTimeout = {TimeoutType,Time,TimeoutMsg}, + loop_actions_list( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, + [RelativeTimeout|TimeoutsR], Postpone, + CallEnter, StateCall, Actions); + %% Generic case + TimeoutOptsList -> + case parse_timeout_opts_abs(TimeoutOptsList) of + true when ?absolute_timeout(Time) -> + loop_actions_list( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, + [Timeout|TimeoutsR], Postpone, + CallEnter, StateCall, Actions); + false when ?relative_timeout(Time) -> + RelativeTimeout = + {TimeoutType,Time,TimeoutMsg}, + loop_actions_list( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, + [RelativeTimeout|TimeoutsR], Postpone, + CallEnter, StateCall, Actions); + badarg -> + terminate( + error, + {bad_action_from_state_function,Timeout}, + ?STACKTRACE(), P, Debug, + S#state{ + state_data = NextState_NewData, + hibernate = Hibernate}, + Q) + end + end; + false -> + terminate( + error, + {bad_action_from_state_function,Timeout}, + ?STACKTRACE(), P, Debug, + S#state{ + state_data = NextState_NewData, + hibernate = Hibernate}, + Q) end; -parse_actions_timeout( - StateCall, Debug, S, Actions, TransOpts, - {TimeoutType,Time,_} = RelativeTimeout) -> - case classify_timeout(TimeoutType, Time, []) of - relative -> - parse_actions_timeout_add( - StateCall, Debug, S, Actions, - TransOpts, RelativeTimeout); - badarg -> - [error, - {bad_action_from_state_function,RelativeTimeout}, - ?STACKTRACE(), - Debug] +loop_actions_timeout( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone, + CallEnter, StateCall, Actions, + {TimeoutType,Time,_} = Timeout) -> + %% + case timeout_event_type(TimeoutType) of + true when ?relative_timeout(Time) -> + loop_actions_list( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, + [Timeout|TimeoutsR], Postpone, + CallEnter, StateCall, Actions); + _ -> + terminate( + error, + {bad_action_from_state_function,Timeout}, + ?STACKTRACE(), P, Debug, + S#state{ + state_data = NextState_NewData, + hibernate = Hibernate}, + Q) end; -parse_actions_timeout( - StateCall, Debug, S, Actions, TransOpts, - Time) -> - case classify_timeout(timeout, Time, []) of - relative -> +loop_actions_timeout( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone, + CallEnter, StateCall, Actions, Time) -> + %% + if + ?relative_timeout(Time) -> RelativeTimeout = {timeout,Time,Time}, - parse_actions_timeout_add( - StateCall, Debug, S, Actions, - TransOpts, RelativeTimeout); - badarg -> - [error, - {bad_action_from_state_function,Time}, - ?STACKTRACE(), - Debug] + loop_actions_list( + P, Debug, S, Q, NextState_NewData, + NextEventsR, Hibernate, + [RelativeTimeout|TimeoutsR], Postpone, + CallEnter, StateCall, Actions); + true -> + terminate( + error, + {bad_action_from_state_function,Time}, + ?STACKTRACE(), P, Debug, + S#state{ + state_data = NextState_NewData, + hibernate = Hibernate}, + Q) end. -parse_actions_timeout_add( - StateCall, Debug, S, Actions, - #trans_opts{timeouts_r = TimeoutsR} = TransOpts, Timeout) -> - parse_actions( - StateCall, Debug, S, Actions, - TransOpts#trans_opts{timeouts_r = [Timeout|TimeoutsR]}). - %% Do the state transition -loop_event_done( - Parent, ?not_sys_debug, - #state{postponed = P} = S, -%% #state{postponed = will_not_happen = P} = S, - Events, Event, NextState, NewData, - #trans_opts{ - postpone = Postpone, hibernate = Hibernate, - timeouts_r = [], next_events_r = NextEventsR}) -> - %% - %% Optimize the simple cases i.e no debug and no timer changes, - %% by duplicate stripped down code - %% - %% Fast path - %% - case Postpone of - true -> - loop_event_done_fast( - Parent, Hibernate, S, - Events, [Event|P], NextState, NewData, NextEventsR); - false -> - loop_event_done_fast( - Parent, Hibernate, S, - Events, P, NextState, NewData, NextEventsR) - end; -loop_event_done( - Parent, Debug_0, - #state{ - state = State, postponed = P_0, - timer_refs = TimerRefs_0, timer_types = TimerTypes_0, - cancel_timers = CancelTimers_0} = S, - Events_0, Event_0, NextState, NewData, - #trans_opts{ - hibernate = Hibernate, timeouts_r = TimeoutsR, - postpone = Postpone, next_events_r = NextEventsR}) -> +%% +loop_state_transition( + P, Debug, #state{state_data = {State,_Data}, postponed = Postponed} = S, + [Event|Events], {NextState,_NewData} = NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postpone) -> %% %% All options have been collected and next_events are buffered. %% Do the actual state transition. %% - %% Full feature path - %% - [Debug_1|P_1] = % Move current event to postponed if Postpone + Postponed_1 = % Move current event to postponed if Postpone case Postpone of true -> - [?sys_debug( - Debug_0, - S#state.name, - {postpone,Event_0,State,NextState}), - Event_0|P_0]; + [Event|Postponed]; false -> - [?sys_debug( - Debug_0, - S#state.name, - {consume,Event_0,State,NextState})|P_0] + Postponed end, - {Events_2,P_2, - Timers_2} = - %% Cancel the event timeout - if - NextState =:= State -> - {Events_0,P_1, - cancel_timer_by_type( - timeout, {TimerTypes_0,CancelTimers_0})}; - true -> - %% Move all postponed events to queue - %% and cancel the state timeout - {lists:reverse(P_1, Events_0),[], - cancel_timer_by_type( - state_timeout, - cancel_timer_by_type( - timeout, {TimerTypes_0,CancelTimers_0}))} - end, - {TimerRefs_3,{TimerTypes_3,CancelTimers_3},TimeoutEvents} = - %% Stop and start timers - parse_timers(TimerRefs_0, Timers_2, TimeoutsR), - %% Place next events last in reversed queue - Events_3R = lists:reverse(Events_2, NextEventsR), - %% Enqueue immediate timeout events - [Debug_2|Events_4R] = - prepend_timeout_events( - NextState, Debug_1, S, TimeoutEvents, Events_3R), - loop_event_done( - Parent, Debug_2, - S#state{ - state = NextState, - data = NewData, - postponed = P_2, - timer_refs = TimerRefs_3, - timer_types = TimerTypes_3, - cancel_timers = CancelTimers_3, - hibernate = Hibernate}, - lists:reverse(Events_4R)). - -loop_event_done(Parent, Debug, S, Q) -> -%% io:format( -%% "loop_event_done:~n" -%% " state = ~p, data = ~p, postponed = ~p~n " -%% " timer_refs = ~p, timer_types = ~p, cancel_timers = ~p.~n" -%% " Q = ~p.~n", -%% [S#state.state,S#state.data,S#state.postponed, -%% S#state.timer_refs,S#state.timer_types,S#state.cancel_timers, -%% Q]), - case Q of - [] -> - %% Get a new event - loop(Parent, Debug, S); - [{Type,Content}|Events] -> - %% Loop until out of enqueued events - loop_event(Parent, Debug, S, Events, Type, Content) + case Debug of + ?not_sys_debug -> + %% Optimization for no sys_debug + %% - avoid calling sys_debug/3 + if + NextState =:= State -> + loop_keep_state( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed_1); + true -> + loop_state_change( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed_1) + end; + _ -> + %% With sys_debug + Name = P#params.name, + Debug_1 = + case Postpone of + true -> + sys_debug( + Debug, Name, + {postpone,Event,State,NextState}); + false -> + sys_debug( + Debug, Name, + {consume,Event,State,NextState}) + end, + if + NextState =:= State -> + loop_keep_state( + P, Debug_1, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed_1); + true -> + loop_state_change( + P, Debug_1, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed_1) + end end. +%% State transition to the same state +%% +loop_keep_state( + P, Debug, #state{timers = {TimerRefs,TimeoutTypes} = Timers} = S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed) -> + %% + %% Cancel event timeout + %% + case TimeoutTypes of + %% Optimization + %% - only cancel timer when there is a timer to cancel + #{timeout := TimerRef} -> + %% Event timeout active + loop_next_events( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed, + cancel_timer_by_ref_and_type( + TimerRef, timeout, TimerRefs, TimeoutTypes)); + _ -> + %% No event timeout active + loop_next_events( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed, + Timers) + end. -%% Fast path -%% -%% Cancel event timer and state timer only if running -loop_event_done_fast( - Parent, Hibernate, - #state{ - state = NextState, - timer_types = TimerTypes, - cancel_timers = CancelTimers} = S, - Events, P, NextState, NewData, NextEventsR) -> - %% Same state - case TimerTypes of - #{timeout := _} -> - %% Event timeout active - loop_event_done_fast_2( - Parent, Hibernate, S, - Events, P, NextState, NewData, NextEventsR, - cancel_timer_by_type( - timeout, {TimerTypes,CancelTimers})); - _ -> - %% No event timeout active - loop_event_done_fast_2( - Parent, Hibernate, S, - Events, P, NextState, NewData, NextEventsR, - {TimerTypes,CancelTimers}) - end; -loop_event_done_fast( - Parent, Hibernate, - #state{ - timer_types = TimerTypes, - cancel_timers = CancelTimers} = S, - Events, P, NextState, NewData, NextEventsR) -> - %% State change - case TimerTypes of - #{timeout := _} -> - %% Event timeout active - %% - cancel state_timeout too since it is faster than inspecting - loop_event_done_fast( - Parent, Hibernate, S, - Events, P, NextState, NewData, NextEventsR, - cancel_timer_by_type( - state_timeout, - cancel_timer_by_type( - timeout, {TimerTypes,CancelTimers}))); - #{state_timeout := _} -> - %% State_timeout active but not event timeout - loop_event_done_fast( - Parent, Hibernate, S, - Events, P, NextState, NewData, NextEventsR, - cancel_timer_by_type( - state_timeout, {TimerTypes,CancelTimers})); +%% State transition to a different state +%% +loop_state_change( + P, Debug, S, Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed) -> + %% + %% Retry postponed events + %% + case Postponed of + [] -> + loop_state_change( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR); + [E1] -> + loop_state_change( + P, Debug, S, + [E1|Events], NextState_NewData, + NextEventsR, Hibernate, TimeoutsR); + [E2,E1] -> + loop_state_change( + P, Debug, S, + [E1,E2|Events], NextState_NewData, + NextEventsR, Hibernate, TimeoutsR); _ -> - %% No event nor state_timeout active - loop_event_done_fast( - Parent, Hibernate, S, - Events, P, NextState, NewData, NextEventsR, - {TimerTypes,CancelTimers}) + loop_state_change( + P, Debug, S, + lists:reverse(Postponed, Events), NextState_NewData, + NextEventsR, Hibernate, TimeoutsR) end. %% -%% Retry postponed events -loop_event_done_fast( - Parent, Hibernate, S, - Events, P, NextState, NewData, NextEventsR, TimerTypes_CancelTimers) -> - case P of - %% Handle 0..2 postponed events without list reversal since - %% that will move out all live registers and back again - [] -> - loop_event_done_fast_2( - Parent, Hibernate, S, - Events, [], NextState, NewData, NextEventsR, - TimerTypes_CancelTimers); - [E] -> - loop_event_done_fast_2( - Parent, Hibernate, S, - [E|Events], [], NextState, NewData, NextEventsR, - TimerTypes_CancelTimers); - [E1,E2] -> - loop_event_done_fast_2( - Parent, Hibernate, S, - [E2,E1|Events], [], NextState, NewData, NextEventsR, - TimerTypes_CancelTimers); +loop_state_change( + P, Debug, #state{timers = {TimerRefs,TimeoutTypes} = Timers} = S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR) -> + %% + %% Cancel state and event timeout + %% + case TimeoutTypes of + %% Optimization + %% - only cancel timeout when there is an active timeout + %% + #{state_timeout := TimerRef} -> + %% State timeout active + %% - cancel event timeout too since it is faster than inspecting + loop_next_events( + P, Debug, S, Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, [], + cancel_timer_by_type( + timeout, + cancel_timer_by_ref_and_type( + TimerRef, state_timeout, TimerRefs, TimeoutTypes))); + #{timeout := TimerRef} -> + %% Event timeout active but not state timeout + %% - cancel event timeout only + loop_next_events( + P, Debug, S, Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, [], + cancel_timer_by_ref_and_type( + TimerRef, timeout, TimerRefs, TimeoutTypes)); _ -> - %% A bit slower path - loop_event_done_fast_2( - Parent, Hibernate, S, - lists:reverse(P, Events), [], NextState, NewData, NextEventsR, - TimerTypes_CancelTimers) + %% No state nor event timeout active. + loop_next_events( + P, Debug, S, Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, [], + Timers) end. + +%% Continue state transition with processing of +%% inserted events and timeout events %% -%% Fast path +loop_next_events( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, [], Postponed, + Timers) -> + %% + %% Optimization when there are no timeout actions + %% hence no timeout zero events to append to Events + %% - avoid loop_timeouts + loop_done( + P, Debug, + S#state{ + state_data = NextState_NewData, + postponed = Postponed, + timers = Timers, + hibernate = Hibernate}, + NextEventsR, Events); +loop_next_events( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed, + Timers) -> + %% + Seen = #{}, + TimeoutEvents = [], + loop_timeouts( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed, + Timers, Seen, TimeoutEvents). + +%% Continue state transition with processing of timeout events %% -loop_event_done_fast_2( - Parent, Hibernate, S, - Events, P, NextState, NewData, NextEventsR, - {TimerTypes,CancelTimers}) -> +loop_timeouts( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, [], Postponed, + Timers, _Seen, TimeoutEvents) -> %% - NewS = + S_1 = S#state{ - state = NextState, - data = NewData, - postponed = P, - timer_types = TimerTypes, - cancel_timers = CancelTimers, + state_data = NextState_NewData, + postponed = Postponed, + timers = Timers, hibernate = Hibernate}, - case NextEventsR of - %% Handle 0..2 next events without list reversal since - %% that will move out all live registers and back again + case TimeoutEvents of [] -> - loop_event_done(Parent, ?not_sys_debug, NewS, Events); - [E] -> - loop_event_done(Parent, ?not_sys_debug, NewS, [E|Events]); - [E2,E1] -> - loop_event_done(Parent, ?not_sys_debug, NewS, [E1,E2|Events]); + loop_done(P, Debug, S_1, NextEventsR, Events); _ -> - %% A bit slower path - loop_event_done( - Parent, ?not_sys_debug, NewS, lists:reverse(NextEventsR, Events)) + case Events of + [] -> + loop_prepend_timeout_events( + P, Debug, S_1, TimeoutEvents, + NextEventsR); + [E1] -> + loop_prepend_timeout_events( + P, Debug, S_1, TimeoutEvents, + [E1|NextEventsR]); + [E2,E1] -> + loop_prepend_timeout_events( + P, Debug, S_1, TimeoutEvents, + [E1,E2|NextEventsR]); + _ -> + loop_prepend_timeout_events( + P, Debug, S_1, TimeoutEvents, + lists:reverse(Events, NextEventsR)) + end + end; +loop_timeouts( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, [Timeout|TimeoutsR], Postponed, + Timers, Seen, TimeoutEvents) -> + %% + case Timeout of + {TimeoutType,Time,TimeoutMsg} -> + %% Relative timeout + case Seen of + #{TimeoutType := _} -> + %% Type seen before - ignore + loop_timeouts( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed, + Timers, Seen, TimeoutEvents); + #{} -> + loop_timeouts( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed, + Timers, Seen, TimeoutEvents, + TimeoutType, Time, TimeoutMsg, []) + end; + {TimeoutType,Time,TimeoutMsg,TimeoutOpts} -> + %% Absolute timeout + case Seen of + #{TimeoutType := _} -> + %% Type seen before - ignore + loop_timeouts( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed, + Timers, Seen, TimeoutEvents); + #{} -> + loop_timeouts( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed, + Timers, Seen, TimeoutEvents, + TimeoutType, Time, TimeoutMsg, listify(TimeoutOpts)) + end end. - -%%--------------------------------------------------------------------------- -%% Server loop helpers - -call_callback_mode(#state{module = Module} = S) -> - try Module:callback_mode() of - CallbackMode -> - callback_mode_result(S, CallbackMode) - catch - CallbackMode -> - callback_mode_result(S, CallbackMode); - Class:Reason:Stacktrace -> - [Class,Reason,Stacktrace] +%% +loop_timeouts( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed, + Timers, Seen, TimeoutEvents, + TimeoutType, Time, TimeoutMsg, TimeoutOpts) -> + %% + case Time of + infinity -> + %% Cancel any running timer + loop_timeouts_cancel( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed, + Timers, Seen, TimeoutEvents, + TimeoutType); + 0 when TimeoutOpts =:= [] -> + %% Relative timeout zero + %% - cancel any running timer + %% handle timeout zero events later + %% + loop_timeouts_cancel( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed, + Timers, Seen, [{TimeoutType,TimeoutMsg}|TimeoutEvents], + TimeoutType); + _ -> + %% (Re)start the timer + TimerRef = + erlang:start_timer(Time, self(), TimeoutMsg, TimeoutOpts), + {TimerRefs,TimeoutTypes} = Timers, + case TimeoutTypes of + #{TimeoutType := OldTimerRef} -> + %% Cancel the running timer, + %% update the timeout type, + %% insert the new timer ref, + %% and remove the old timer ref + Timers_1 = + {maps:remove( + OldTimerRef, + TimerRefs#{TimerRef => TimeoutType}), + TimeoutTypes#{TimeoutType := TimerRef}}, + cancel_timer(OldTimerRef), + loop_timeouts( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed, + Timers_1, Seen#{TimeoutType => true}, TimeoutEvents); + #{} -> + %% Insert the new timer type and ref + Timers_1 = + {TimerRefs#{TimerRef => TimeoutType}, + TimeoutTypes#{TimeoutType => TimerRef}}, + loop_timeouts( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed, + Timers_1, Seen#{TimeoutType => true}, TimeoutEvents) + end end. -callback_mode_result(S, CallbackMode) -> - callback_mode_result( - S, CallbackMode, listify(CallbackMode), undefined, false). -%% -callback_mode_result(_S, CallbackMode, [], undefined, _StateEnter) -> - [error, - {bad_return_from_callback_mode,CallbackMode}, - ?STACKTRACE()]; -callback_mode_result(S, _CallbackMode, [], CBMode, StateEnter) -> - S#state{callback_mode = CBMode, state_enter = StateEnter}; -callback_mode_result(S, CallbackMode, [H|T], CBMode, StateEnter) -> - case callback_mode(H) of - true -> - callback_mode_result(S, CallbackMode, T, H, StateEnter); - false -> - case state_enter(H) of - true -> - callback_mode_result(S, CallbackMode, T, CBMode, true); - false -> - [error, - {bad_return_from_callback_mode,CallbackMode}, - ?STACKTRACE()] - end +%% Loop helper to cancel a timeout +%% +loop_timeouts_cancel( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed, + {TimerRefs,TimeoutTypes} = Timers, Seen, TimeoutEvents, + TimeoutType) -> + %% This function body should have been: + %% Timers_1 = cancel_timer_by_type(TimeoutType, Timers), + %% loop_timeouts( + %% P, Debug, S, + %% Events, NextState_NewData, + %% NextEventsR, Hibernate, TimeoutsR, Postponed, + %% Timers_1, Seen#{TimeoutType => true}, TimeoutEvents). + %% + %% Explicitly separate cases to get separate code paths for when + %% the map key exists vs. not, since otherwise the external call + %% to erlang:cancel_timer/1 and to map:remove/2 within + %% cancel_timer_by_type/2 would cause all live registers + %% to be saved to and restored from the stack also for + %% the case when the map key TimeoutType does not exist + case TimeoutTypes of + #{TimeoutType := TimerRef} -> + Timers_1 = + cancel_timer_by_ref_and_type( + TimerRef, TimeoutType, TimerRefs, TimeoutTypes), + loop_timeouts( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed, + Timers_1, Seen#{TimeoutType => true}, TimeoutEvents); + #{} -> + loop_timeouts( + P, Debug, S, + Events, NextState_NewData, + NextEventsR, Hibernate, TimeoutsR, Postponed, + Timers, Seen#{TimeoutType => true}, TimeoutEvents) end. +%% Continue state transition with prepending timeout zero events +%% before event queue reversal i.e appending timeout zero events +%% +loop_prepend_timeout_events(P, Debug, S, TimeoutEvents, EventsR) -> + {Debug_1,Events_1R} = + prepend_timeout_events(P, Debug, S, TimeoutEvents, EventsR), + loop_done(P, Debug_1, S, Events_1R, []). -call_state_function( - #state{callback_mode = undefined} = S, Type, Content, State, Data) -> - case call_callback_mode(S) of - #state{} = NewS -> - call_state_function(NewS, Type, Content, State, Data); - Error -> - Error - end; -call_state_function( - #state{callback_mode = CallbackMode, module = Module} = S, - Type, Content, State, Data) -> - try - case CallbackMode of - state_functions -> - Module:State(Type, Content, Data); - handle_event_function -> - Module:handle_event(Type, Content, State, Data) - end - of - Result -> - {Result,S} - catch - Result -> - {Result,S}; - Class:Reason:Stacktrace -> - [Class,Reason,Stacktrace] +%% Place inserted events first in the event queue +%% +loop_done(P, Debug, S, NextEventsR, Events) -> + case NextEventsR of + [] -> + loop_done(P, Debug, S, Events); + [E1] -> + loop_done(P, Debug, S, [E1|Events]); + [E2,E1] -> + loop_done(P, Debug, S, [E1,E2|Events]); + _ -> + loop_done(P, Debug, S, lists:reverse(NextEventsR, Events)) end. - - -%% -> absolute | relative | badarg -classify_timeout(TimeoutType, Time, Opts) -> - case timeout_event_type(TimeoutType) of - true -> - classify_time(false, Time, Opts); - false -> - badarg +%% +%% State transition is done, keep looping if there are +%% enqueued events, otherwise get a new event +%% +loop_done(P, Debug, S, Q) -> +%%% io:format( +%%% "loop_done: state_data = ~p,~n" +%%% " postponed = ~p, Q = ~p,~n", +%%% " timers = ~p.~n" +%%% [S#state.state_data,,S#state.postponed,Q,S#state.timers]), + case Q of + [] -> + %% Get a new event + loop(P, Debug, S); + [Event|Events] -> + %% Loop until out of enqueued events + loop_event(P, Debug, S, Event, Events) end. -classify_time(Abs, Time, []) -> - case Abs of - true when - is_integer(Time); - Time =:= infinity -> - absolute; - false when - is_integer(Time), 0 =< Time; - Time =:= infinity -> - relative; - _ -> - badarg - end; -classify_time(_, Time, [{abs,Abs}|Opts]) when is_boolean(Abs) -> - classify_time(Abs, Time, Opts); -classify_time(_, _, Opts) when is_list(Opts) -> - badarg. +%%--------------------------------------------------------------------------- +%% Server loop helpers -%% Stop and start timers as well as create timeout zero events -%% and pending event timer +%% Parse an option list for erlang:start_timer/4 to figure out +%% if the timeout will be absolute or relative %% -%% Stop and start timers non-event timers -parse_timers(TimerRefs, Timers, TimeoutsR) -> - parse_timers(TimerRefs, Timers, TimeoutsR, #{}, []). +parse_timeout_opts_abs(Opts) -> + parse_timeout_opts_abs(Opts, false). %% -parse_timers( - TimerRefs, Timers, [], _Seen, TimeoutEvents) -> - %% - {TimerRefs,Timers,TimeoutEvents}; -parse_timers( - TimerRefs, Timers, [Timeout|TimeoutsR], Seen, TimeoutEvents) -> - %% - case Timeout of - {TimerType,Time,TimerMsg,TimerOpts} -> - %% Absolute timer - parse_timers( - TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, - TimerType, Time, TimerMsg, listify(TimerOpts)); - %% Relative timers below - {TimerType,0,TimerMsg} -> - parse_timers( - TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, - TimerType, zero, TimerMsg, []); - {TimerType,Time,TimerMsg} -> - parse_timers( - TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, - TimerType, Time, TimerMsg, []) - end. - -parse_timers( - TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, - TimerType, Time, TimerMsg, TimerOpts) -> - case Seen of - #{TimerType := _} -> - %% Type seen before - ignore - parse_timers( - TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents); - #{} -> - %% Unseen type - handle - NewSeen = Seen#{TimerType => true}, - case Time of - infinity -> - %% Cancel any running timer - parse_timers( - TimerRefs, cancel_timer_by_type(TimerType, Timers), - TimeoutsR, NewSeen, TimeoutEvents); - zero -> - %% Cancel any running timer - %% Handle zero time timeouts later - parse_timers( - TimerRefs, cancel_timer_by_type(TimerType, Timers), - TimeoutsR, NewSeen, - [{TimerType,TimerMsg}|TimeoutEvents]); - _ -> - %% (Re)start the timer - TimerRef = - erlang:start_timer( - Time, self(), TimerMsg, TimerOpts), - case Timers of - {#{TimerType := OldTimerRef} = TimerTypes, - CancelTimers} -> - %% Cancel the running timer - cancel_timer(OldTimerRef), - NewCancelTimers = CancelTimers + 1, - %% Insert the new timer into - %% both TimerRefs and TimerTypes - parse_timers( - TimerRefs#{TimerRef => TimerType}, - {TimerTypes#{TimerType => TimerRef}, - NewCancelTimers}, - TimeoutsR, NewSeen, TimeoutEvents); - {#{} = TimerTypes,CancelTimers} -> - %% Insert the new timer into - %% both TimerRefs and TimerTypes - parse_timers( - TimerRefs#{TimerRef => TimerType}, - {TimerTypes#{TimerType => TimerRef}, - CancelTimers}, - TimeoutsR, NewSeen, TimeoutEvents) - end - end +parse_timeout_opts_abs(Opts, Abs) -> + case Opts of + [] -> + Abs; + [{abs,Abs_1}|Opts] when is_boolean(Abs_1) -> + parse_timeout_opts_abs(Opts, Abs_1); + _ -> + badarg end. %% Enqueue immediate timeout events (timeout 0 events) @@ -1855,72 +2060,89 @@ parse_timers( %% belong to timers that were started after the event timer %% timeout 0 event fired, so they do not cancel the event timer. %% -prepend_timeout_events(_NextState, Debug, _S, [], EventsR) -> - [Debug|EventsR]; +prepend_timeout_events(_P, Debug, _S, [], EventsR) -> + {Debug,EventsR}; prepend_timeout_events( - NextState, Debug, S, [{timeout,_} = TimeoutEvent|TimeoutEvents], []) -> - prepend_timeout_events( - NextState, - sys_debug(Debug, S#state.name, {in,TimeoutEvent,NextState}), - S, TimeoutEvents, [TimeoutEvent]); + P, Debug, S, [{timeout,_} = TimeoutEvent|TimeoutEvents], []) -> + %% Prepend this since there are no other events in queue + case Debug of + ?not_sys_debug -> + prepend_timeout_events( + P, Debug, S, TimeoutEvents, [TimeoutEvent]); + _ -> + {State,_Data} = S#state.state_data, + Debug_1 = + sys_debug( + Debug, P#params.name, {in,TimeoutEvent,State}), + prepend_timeout_events( + P, Debug_1, S, TimeoutEvents, [TimeoutEvent]) + end; prepend_timeout_events( - NextState, Debug, S, [{timeout,_}|TimeoutEvents], EventsR) -> + P, Debug, S, [{timeout,_}|TimeoutEvents], EventsR) -> %% Ignore since there are other events in queue %% so they have cancelled the event timeout 0. - prepend_timeout_events(NextState, Debug, S, TimeoutEvents, EventsR); + prepend_timeout_events(P, Debug, S, TimeoutEvents, EventsR); prepend_timeout_events( - NextState, Debug, S, [TimeoutEvent|TimeoutEvents], EventsR) -> + P, Debug, S, [TimeoutEvent|TimeoutEvents], EventsR) -> %% Just prepend all others - prepend_timeout_events( - NextState, - sys_debug(Debug, S#state.name, {in,TimeoutEvent,NextState}), - S, TimeoutEvents, [TimeoutEvent|EventsR]). + case Debug of + ?not_sys_debug -> + prepend_timeout_events( + P, Debug, S, TimeoutEvents, [TimeoutEvent|EventsR]); + _ -> + {State,_Data} = S#state.state_data, + Debug_1 = + sys_debug( + Debug, P#params.name, {in,TimeoutEvent,State}), + prepend_timeout_events( + P, Debug_1, S, TimeoutEvents, [TimeoutEvent|EventsR]) + end. %%--------------------------------------------------------------------------- %% Server helpers -reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, Replies) -> +reply_then_terminate(Class, Reason, Stacktrace, P, Debug, S, Q, Replies) -> do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, listify(Replies)). + Class, Reason, Stacktrace, P, Debug, S, Q, listify(Replies)). %% do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, []) -> - terminate(Class, Reason, Stacktrace, Debug, S, Q); + Class, Reason, Stacktrace, P, Debug, S, Q, []) -> + terminate(Class, Reason, Stacktrace, P, Debug, S, Q); do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, [R|Rs]) -> + Class, Reason, Stacktrace, P, Debug, S, Q, [R|Rs]) -> case R of {reply,From,Reply} -> case from(From) of true -> reply(From, Reply), - NewDebug = + Debug_1 = ?sys_debug( Debug, - S#state.name, + P#params.name, {out,Reply,From}), do_reply_then_terminate( - Class, Reason, Stacktrace, NewDebug, S, Q, Rs); + Class, Reason, Stacktrace, P, Debug_1, S, Q, Rs); false -> terminate( error, {bad_reply_action_from_state_function,R}, ?STACKTRACE(), - Debug, S, Q) + P, Debug, S, Q) end; _ -> terminate( error, {bad_reply_action_from_state_function,R}, ?STACKTRACE(), - Debug, S, Q) + P, Debug, S, Q) end. terminate( - Class, Reason, Stacktrace, Debug, - #state{module = Module, state = State, data = Data} = S, - Q) -> + Class, Reason, Stacktrace, + #params{module = Module} = P, Debug, + #state{state_data = {State,Data}} = S, Q) -> case erlang:function_exported(Module, terminate, 3) of true -> try Module:terminate(Reason, State, Data) of @@ -1928,7 +2150,7 @@ terminate( catch _ -> ok; C:R:ST -> - error_info(C, R, ST, Debug, S, Q), + error_info(C, R, ST, Debug, P, S, Q), erlang:raise(C, R, ST) end; false -> @@ -1937,13 +2159,13 @@ terminate( _ = case Reason of normal -> - terminate_sys_debug(Debug, S, State, Reason); + terminate_sys_debug(Debug, P, State, Reason); shutdown -> - terminate_sys_debug(Debug, S, State, Reason); + terminate_sys_debug(Debug, P, State, Reason); {shutdown,_} -> - terminate_sys_debug(Debug, S, State, Reason); + terminate_sys_debug(Debug, P, State, Reason); _ -> - error_info(Class, Reason, Stacktrace, Debug, S, Q) + error_info(Class, Reason, Stacktrace, Debug, P, S, Q) end, case Stacktrace of [] -> @@ -1952,26 +2174,26 @@ terminate( erlang:raise(Class, Reason, Stacktrace) end. -terminate_sys_debug(Debug, S, State, Reason) -> - ?sys_debug(Debug, S#state.name, {terminate,Reason,State}). +terminate_sys_debug(Debug, P, State, Reason) -> + ?sys_debug(Debug, P#params.name, {terminate,Reason,State}). error_info( Class, Reason, Stacktrace, Debug, - #state{ + #params{ name = Name, callback_mode = CallbackMode, - state_enter = StateEnter, - postponed = P} = S, + state_enter = StateEnter} = P, + #state{postponed = Postponed} = S, Q) -> Log = sys:get_log(Debug), ?LOG_ERROR(#{label=>{gen_statem,terminate}, name=>Name, queue=>Q, - postponed=>P, + postponed=>Postponed, callback_mode=>CallbackMode, state_enter=>StateEnter, - state=>format_status(terminate, get(), S), + state=>format_status(terminate, get(), P, S), log=>Log, reason=>{Class,Reason,Stacktrace}, client_info=>client_stacktrace(Q)}, @@ -2006,7 +2228,7 @@ client_stacktrace([_|_]) -> format_log(#{label:={gen_statem,terminate}, name:=Name, queue:=Q, - postponed:=P, + postponed:=Postponed, callback_mode:=CallbackMode, state_enter:=StateEnter, state:=FmtData, @@ -2057,7 +2279,7 @@ format_log(#{label:={gen_statem,terminate}, [_,_|_] -> "** Queued = ~tp~n"; _ -> "" end ++ - case P of + case Postponed of [] -> ""; _ -> "** Postponed = ~tp~n" end ++ @@ -2081,9 +2303,9 @@ format_log(#{label:={gen_statem,terminate}, [_|[_|_] = Events] -> [error_logger:limit_term(Events)]; _ -> [] end ++ - case P of + case Postponed of [] -> []; - _ -> [error_logger:limit_term(P)] + _ -> [error_logger:limit_term(Postponed)] end ++ case FixedStacktrace of [] -> []; @@ -2109,7 +2331,8 @@ format_client_log({_Pid,{Name,Stacktrace}}) -> %% Call Module:format_status/2 or return a default value format_status( Opt, PDict, - #state{module = Module, state = State, data = Data}) -> + #params{module = Module}, + #state{state_data = {State,Data} = State_Data}) -> case erlang:function_exported(Module, format_status, 2) of true -> try Module:format_status(Opt, [PDict,State,Data]) @@ -2117,21 +2340,21 @@ format_status( Result -> Result; _:_ -> format_status_default( - Opt, State, - atom_to_list(Module) ++ ":format_status/2 crashed") + Opt, + {State, + atom_to_list(Module) ++ ":format_status/2 crashed"}) end; false -> - format_status_default(Opt, State, Data) + format_status_default(Opt, State_Data) end. -%% The default Module:format_status/2 -format_status_default(Opt, State, Data) -> - StateData = {State,Data}, +%% The default Module:format_status/3 +format_status_default(Opt, State_Data) -> case Opt of terminate -> - StateData; + State_Data; _ -> - [{data,[{"State",StateData}]}] + [{data,[{"State",State_Data}]}] end. -compile({inline, [listify/1]}). @@ -2140,24 +2363,41 @@ listify(Item) when is_list(Item) -> listify(Item) -> [Item]. + +-define(cancel_timer(TimerRef), + case erlang:cancel_timer(TimerRef) of + false -> + %% No timer found and we have not seen the timeout message + receive + {timeout,(TimerRef),_} -> + ok + end; + _ -> + %% Timer was running + ok + end). + +-compile({inline, [cancel_timer/1]}). +cancel_timer(TimerRef) -> + ?cancel_timer(TimerRef). + %% Cancel timer if running, otherwise no op %% -%% This is an asynchronous cancel so the timer is not really cancelled -%% until we get a cancel_timer msg i.e {cancel_timer,TimerRef,_}. -%% In the mean time we might get a timeout message. -%% -%% Remove the timer from TimerTypes. -%% When we get the cancel_timer msg we remove it from TimerRefs. +%% Remove the timer from Timers -compile({inline, [cancel_timer_by_type/2]}). -cancel_timer_by_type(TimerType, {TimerTypes,CancelTimers} = TT_CT) -> - case TimerTypes of - #{TimerType := TimerRef} -> - ok = erlang:cancel_timer(TimerRef, [{async,true}]), - {maps:remove(TimerType, TimerTypes),CancelTimers + 1}; - #{} -> - TT_CT +cancel_timer_by_type(TimeoutType, {TimerRefs,TimeoutTypes} = Timers) -> + case TimeoutTypes of + #{TimeoutType := TimerRef} -> + ?cancel_timer(TimerRef), + {maps:remove(TimerRef, TimerRefs), + maps:remove(TimeoutType, TimeoutTypes)}; + #{} -> + Timers end. --compile({inline, [cancel_timer/1]}). -cancel_timer(TimerRef) -> - ok = erlang:cancel_timer(TimerRef, [{async,true}]). +-compile({inline, [cancel_timer_by_ref_and_type/4]}). +cancel_timer_by_ref_and_type( + TimerRef, TimeoutType, TimerRefs, TimeoutTypes) -> + ?cancel_timer(TimerRef), + {maps:remove(TimerRef, TimerRefs), + maps:remove(TimeoutType, TimeoutTypes)}. diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 6d243e1bec..97ec785c62 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -556,8 +556,8 @@ tg({call, Line, {remote,_,{atom,_,erlang},{atom, Line2, FunName}},ParaList}, FunName,length(ParaList)}}) end; tg({call, Line, {remote,_,{atom,_,ModuleName}, - {atom, _, FunName}},_ParaList},B) -> - throw({error,Line,{?ERR_GENREMOTECALL+B#tgd.eb,ModuleName,FunName}}); + {atom, _, FunName}},ParaList},B) -> + throw({error,Line,{?ERR_GENREMOTECALL+B#tgd.eb,ModuleName,FunName,length(ParaList)}}); tg({cons,Line, H, T},B) -> {cons, Line, tg(H,B), tg(T,B)}; tg({nil, Line},_B) -> diff --git a/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem.erl index cfeb974abd..b106619568 100644 --- a/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem.erl +++ b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem.erl @@ -52,7 +52,9 @@ init(Data) -> state1({call, From}, {reply, M}, Data) -> {keep_state, Data, {reply, From, M}}; state1({call, From}, {transit, M}, Data) -> - {next_state, state2, Data, {reply, From, M}}. + {next_state, state2, Data, + [{reply, From, M},{state_timeout,5000,5000}]}. state2({call, From}, {transit, M}, Data) -> - {next_state, state1, Data, {reply, From, M}}. + {next_state, state1, Data, + [{reply, From, M},{state_timeout,5000,5000}]}. diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl index 6906ef1553..6ad9bec2e6 100644 --- a/lib/syntax_tools/src/erl_prettypr.erl +++ b/lib/syntax_tools/src/erl_prettypr.erl @@ -1101,8 +1101,9 @@ lay_2(Node, Ctxt) -> Ctxt1 = reset_prec(Ctxt), D1 = lay(erl_syntax:constrained_function_type_body(Node), Ctxt1), + Ctxt2 = Ctxt1#ctxt{clause = undefined}, D2 = lay(erl_syntax:constrained_function_type_argument(Node), - Ctxt1), + Ctxt2), beside(D1, beside(floating(text(" when ")), D2)); @@ -1113,7 +1114,7 @@ lay_2(Node, Ctxt) -> _ -> {"fun(", ")"} end, - Ctxt1 = reset_prec(Ctxt), + Ctxt1 = (reset_prec(Ctxt))#ctxt{clause = undefined}, D1 = case erl_syntax:function_type_arguments(Node) of any_arity -> text("(...)"); diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl index 9dbd0e302a..6b42f7a0a1 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl @@ -26,14 +26,14 @@ -export([app_test/1,appup_test/1,smoke_test/1,revert/1,revert_map/1, revert_map_type/1, t_abstract_type/1,t_erl_parse_type/1,t_type/1, t_epp_dodger/1, - t_comment_scan/1,t_igor/1,t_erl_tidy/1]). + t_comment_scan/1,t_igor/1,t_erl_tidy/1,t_prettypr/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [app_test,appup_test,smoke_test,revert,revert_map,revert_map_type, t_abstract_type,t_erl_parse_type,t_type,t_epp_dodger, - t_comment_scan,t_igor,t_erl_tidy]. + t_comment_scan,t_igor,t_erl_tidy,t_prettypr]. groups() -> []. @@ -300,6 +300,14 @@ t_comment_scan(Config) when is_list(Config) -> ok = test_comment_scan(Filenames,DataDir), ok. +t_prettypr(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + Filenames = ["type_specs.erl", + "specs_and_funs.erl"], + ok = test_prettypr(Filenames,DataDir,PrivDir), + ok. + test_files(Config) -> DataDir = ?config(data_dir, Config), [ filename:join(DataDir,Filename) || Filename <- test_files() ]. @@ -307,7 +315,8 @@ test_files(Config) -> test_files() -> ["syntax_tools_SUITE_test_module.erl", "syntax_tools_test.erl", - "type_specs.erl"]. + "type_specs.erl", + "specs_and_funs.erl"]. t_igor(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), @@ -359,6 +368,27 @@ test_comment_scan([File|Files],DataDir) -> test_comment_scan(Files,DataDir). +test_prettypr([],_,_) -> ok; +test_prettypr([File|Files],DataDir,PrivDir) -> + Filename = filename:join(DataDir,File), + io:format("Parsing ~p~n", [Filename]), + {ok, Fs0} = epp:parse_file(Filename, [], []), + Fs = erl_syntax:form_list(Fs0), + PP = erl_prettypr:format(Fs, [{paper, 120}, {ribbon, 110}]), + io:put_chars(PP), + OutFile = filename:join(PrivDir, File), + ok = file:write_file(OutFile,iolist_to_binary(PP)), + io:format("Parsing OutFile: ~s~n", [OutFile]), + {ok, Fs2} = epp:parse_file(OutFile, [], []), + case [Error || {error, _} = Error <- Fs2] of + [] -> + ok; + Errors -> + ?t:fail(Errors) + end, + test_prettypr(Files,DataDir,PrivDir). + + test_epp_dodger([], _, _) -> ok; test_epp_dodger([Filename|Files],DataDir,PrivDir) -> io:format("Parsing ~p~n", [Filename]), diff --git a/lib/syntax_tools/test/syntax_tools_SUITE_data/specs_and_funs.erl b/lib/syntax_tools/test/syntax_tools_SUITE_data/specs_and_funs.erl new file mode 100644 index 0000000000..8dfeaf5a6b --- /dev/null +++ b/lib/syntax_tools/test/syntax_tools_SUITE_data/specs_and_funs.erl @@ -0,0 +1,18 @@ +-module(specs_and_funs). + +-export([my_apply/3, two/1]). + +%% OTP-15519, ERL-815 + +-spec my_apply(Fun, Arg, fun((A) -> A)) -> Result when + Fun :: fun((Arg) -> Result), + Arg :: any(), + Result :: any(). + +my_apply(Fun, Arg, _) -> + Fun(Arg). + +-spec two(fun((A) -> A)) -> fun((B) -> B). + +two(F) -> + F(fun(X) -> X end). diff --git a/lib/tools/priv/styles.css b/lib/tools/priv/styles.css index e10e94e3ad..84f00be9fd 100644 --- a/lib/tools/priv/styles.css +++ b/lib/tools/priv/styles.css @@ -53,21 +53,25 @@ table thead { display: none; } table td.line, +table td.line a, table td.hits { width: 20px; background: #eaeaea; text-align: center; + text-decoration: none; font-size: 11px; padding: 0 10px; color: #949494; } table td.hits { width: 10px; + text-align: right; padding: 2px 5px; color: rgba(0, 0, 0, 0.6); background-color: #f0f0f0; } tr.miss td.line, +tr.miss td.line a, tr.miss td.hits { background-color: #ffdce0; border-color: #fdaeb7; @@ -76,6 +80,7 @@ tr.miss td { background-color: #ffeef0; } tr.hit td.line, +tr.hit td.line a, tr.hit td.hits { background-color: #cdffd8; border-color: #bef5cb; diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index d7269e3f27..8d4561ca9e 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -2563,11 +2563,13 @@ table_row(Line, L) -> table_data(Line, L, N) -> LineNoNL = Line -- "\n", ["<td class=\"line\" id=\"L",integer_to_list(L),"\">", + "<a href=\"#L",integer_to_list(L),"\">", integer_to_list(L), - "</td>\n", + "</a></td>\n", "<td class=\"hits\">",maybe_integer_to_list(N),"</td>\n", "<td class=\"source\"><code>",LineNoNL,"</code></td>\n</tr>\n"]. +maybe_integer_to_list(0) -> "<pre style=\"display: inline;\">:-(</pre>"; maybe_integer_to_list(N) when is_integer(N) -> integer_to_list(N); maybe_integer_to_list(_) -> "". diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src index f8c6aa22cb..f0e0fc4bec 100644 --- a/lib/tools/src/tools.app.src +++ b/lib/tools/src/tools.app.src @@ -21,11 +21,13 @@ [{description, "DEVTOOLS CXC 138 16"}, {vsn, "%VSN%"}, {modules, [cover, + cprof, eprof, fprof, instrument, lcnt, make, + tags, xref, xref_base, xref_compiler, diff --git a/lib/wx/c_src/Makefile.in b/lib/wx/c_src/Makefile.in index daa8afce83..8ec64bea7e 100644 --- a/lib/wx/c_src/Makefile.in +++ b/lib/wx/c_src/Makefile.in @@ -181,6 +181,7 @@ release_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)/priv" $(INSTALL_DATA) ../priv/erlang-logo32.png "$(RELSYSDIR)/priv/" $(INSTALL_DATA) ../priv/erlang-logo64.png "$(RELSYSDIR)/priv/" + $(INSTALL_DATA) ../priv/erlang-logo128.png "$(RELSYSDIR)/priv/" $(INSTALL_PROGRAM) $(TARGET_DIR)/wxe_driver$(SO_EXT) "$(RELSYSDIR)/priv/" $(INSTALL_PROGRAM) $(TARGET_DIR)/erl_gl$(SO_EXT) "$(RELSYSDIR)/priv/" diff --git a/lib/wx/c_src/wxe_ps_init.c b/lib/wx/c_src/wxe_ps_init.c index 4b3b47a80b..62c7c51c13 100644 --- a/lib/wx/c_src/wxe_ps_init.c +++ b/lib/wx/c_src/wxe_ps_init.c @@ -64,6 +64,10 @@ void * wxe_ps_init2() { size_t app_len = 127; char app_title_buf[128]; char * app_title; + size_t app_icon_len = 1023; + char app_icon_buf[1024]; + char * app_icon; + // Setup and enable gui pool = [[NSAutoreleasePool alloc] init]; @@ -78,9 +82,15 @@ void * wxe_ps_init2() { if(!GetCurrentProcess(&psn)) { CPSSetProcessName(&psn, app_title?app_title:"Erlang"); } - // Load and set icon + // Enable setting custom application icon for Mac OS X + res = erl_drv_getenv("WX_APP_ICON", app_icon_buf, &app_icon_len); NSMutableString *file = [[NSMutableString alloc] init]; - [file appendFormat:@"%s/%s", erl_wx_privdir, "erlang-logo64.png"]; + if (res >= 0) { + [file appendFormat:@"%s", app_icon_buf]; + } else { + [file appendFormat:@"%s/%s", erl_wx_privdir, "erlang-logo128.png"]; + } + // Load and set icon NSImage *icon = [[NSImage alloc] initWithContentsOfFile: file]; [NSApp setApplicationIconImage: icon]; }; diff --git a/lib/xmerl/doc/src/notes.xml b/lib/xmerl/doc/src/notes.xml index a97036127e..7f6874e36b 100644 --- a/lib/xmerl/doc/src/notes.xml +++ b/lib/xmerl/doc/src/notes.xml @@ -32,6 +32,21 @@ <p>This document describes the changes made to the Xmerl application.</p> +<section><title>Xmerl 1.3.19</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>The charset detection parsing crash in some cases when + the XML directive is not syntactic correct.</p> + <p> + Own Id: OTP-15492 Aux Id: ERIERL-283 </p> + </item> + </list> + </section> + +</section> + <section><title>Xmerl 1.3.18</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -62,6 +77,21 @@ </section> +<section><title>Xmerl 1.3.16.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>The charset detection parsing crash in some cases when + the XML directive is not syntactic correct.</p> + <p> + Own Id: OTP-15492 Aux Id: ERIERL-283 </p> + </item> + </list> + </section> + +</section> + <section><title>Xmerl 1.3.16</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -1412,4 +1442,3 @@ </section> </section> </chapter> - diff --git a/lib/xmerl/src/xmerl_sax_parser.erl b/lib/xmerl/src/xmerl_sax_parser.erl index e383c4c349..fe836fd8cd 100644 --- a/lib/xmerl/src/xmerl_sax_parser.erl +++ b/lib/xmerl/src/xmerl_sax_parser.erl @@ -1,8 +1,8 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-2017. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2008-2018. 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 @@ -14,13 +14,13 @@ %% 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% %%---------------------------------------------------------------------- %% File : xmerl_sax_parser.erl %% Description : XML SAX parse API module. %% -%% Created : 4 Jun 2008 +%% Created : 4 Jun 2008 %%---------------------------------------------------------------------- -module(xmerl_sax_parser). @@ -72,9 +72,9 @@ file(Name,Options) -> CL = filename:absname(Dir), File = filename:basename(Name), ContinuationFun = fun default_continuation_cb/1, - Res = stream(<<>>, + Res = stream(<<>>, [{continuation_fun, ContinuationFun}, - {continuation_state, FD}, + {continuation_state, FD}, {current_location, CL}, {entity, File} |Options], @@ -101,39 +101,39 @@ stream(Xml, Options, InputType) when is_list(Xml), is_list(Options) -> State = parse_options(Options, initial_state()), case State#xmerl_sax_parser_state.file_type of dtd -> - xmerl_sax_parser_list:parse_dtd(Xml, + xmerl_sax_parser_list:parse_dtd(Xml, State#xmerl_sax_parser_state{encoding = list, input_type = InputType}); normal -> - xmerl_sax_parser_list:parse(Xml, + xmerl_sax_parser_list:parse(Xml, State#xmerl_sax_parser_state{encoding = list, input_type = InputType}) end; stream(Xml, Options, InputType) when is_binary(Xml), is_list(Options) -> - case parse_options(Options, initial_state()) of + case parse_options(Options, initial_state()) of {error, Reason} -> {error, Reason}; State -> - ParseFunction = + ParseFunction = case State#xmerl_sax_parser_state.file_type of dtd -> parse_dtd; normal -> parse end, - try + try {Xml1, State1} = detect_charset(Xml, State), parse_binary(Xml1, State1#xmerl_sax_parser_state{input_type = InputType}, ParseFunction) catch throw:{fatal_error, {State2, Reason}} -> - {fatal_error, + {fatal_error, { State2#xmerl_sax_parser_state.current_location, - State2#xmerl_sax_parser_state.entity, + State2#xmerl_sax_parser_state.entity, 1 }, - Reason, [], + Reason, [], State2#xmerl_sax_parser_state.event_state} end end. @@ -157,7 +157,7 @@ parse_binary(Xml, #xmerl_sax_parser_state{encoding={utf16,big}}=State, F) -> xmerl_sax_parser_utf16be:F(Xml, State); parse_binary(Xml, #xmerl_sax_parser_state{encoding=latin1}=State, F) -> xmerl_sax_parser_latin1:F(Xml, State); -parse_binary(_, #xmerl_sax_parser_state{encoding=Enc}, State) -> +parse_binary(_, #xmerl_sax_parser_state{encoding=Enc}, State) -> ?fatal_error(State, lists:flatten(io_lib:format("Charcter set ~p not supported", [Enc]))). %%---------------------------------------------------------------------- @@ -177,9 +177,9 @@ initial_state() -> %%---------------------------------------------------------------------- %% Function: parse_options(Options, State) %% Input: Options = [Option] -%% Option = {event_state, term()} | {event_fun, fun()} | +%% Option = {event_state, term()} | {event_fun, fun()} | %% {continuation_state, term()} | {continuation_fun, fun()} | -%% {encoding, Encoding} | {file_type, FT} +%% {encoding, Encoding} | {file_type, FT} %% FT = normal | dtd %% Encoding = utf8 | utf16le | utf16be | list | iso8859 %% State = #xmerl_sax_parser_state{} @@ -200,7 +200,7 @@ parse_options([{file_type, FT} |Options], State) when FT==normal; FT==dtd -> parse_options(Options, State#xmerl_sax_parser_state{file_type = FT}); parse_options([{encoding, E} |Options], State) -> case check_encoding_option(E) of - {error, Reason} -> + {error, Reason} -> {error, Reason}; Enc -> parse_options(Options, State#xmerl_sax_parser_state{encoding = Enc}) @@ -231,7 +231,7 @@ check_encoding_option(E) -> %% Description: Detects which character set is used in a binary stream. %%---------------------------------------------------------------------- detect_charset(<<>>, #xmerl_sax_parser_state{continuation_fun = undefined} = State) -> - ?fatal_error(State, "Can't detect character encoding due to lack of indata"); + ?fatal_error(State, "Can't detect character encoding due to lack of indata"); detect_charset(<<>>, State) -> cf(<<>>, State, fun detect_charset/2); detect_charset(Bytes, State) -> @@ -269,22 +269,14 @@ detect_charset_1(<<16#3C, 16#3F, 16#78, 16#6D>> = Xml, State) -> cf(Xml, State, fun detect_charset_1/2); detect_charset_1(<<16#3C, 16#3F, 16#78, 16#6D, 16#6C, Xml2/binary>>, State) -> {Xml3, State1} = read_until_end_of_xml_directive(Xml2, State), - case parse_xml_directive(Xml3) of - {error, Reason} -> - ?fatal_error(State, Reason); - AttrList -> - case lists:keysearch("encoding", 1, AttrList) of - {value, {_, E}} -> - case convert_encoding(E) of - {error, Reason} -> - ?fatal_error(State, Reason); - Enc -> - {<<16#3C, 16#3F, 16#78, 16#6D, 16#6C, Xml3/binary>>, - State1#xmerl_sax_parser_state{encoding=Enc}} - end; - _ -> - {<<16#3C, 16#3F, 16#78, 16#6D, 16#6C, Xml3/binary>>, State1} - end + AttrList = parse_xml_directive(Xml3, State), + case lists:keysearch("encoding", 1, AttrList) of + {value, {_, E}} -> + Enc = convert_encoding(E, State), + {<<16#3C, 16#3F, 16#78, 16#6D, 16#6C, Xml3/binary>>, + State1#xmerl_sax_parser_state{encoding=Enc}}; + _ -> + {<<16#3C, 16#3F, 16#78, 16#6D, 16#6C, Xml3/binary>>, State1} end; detect_charset_1(Xml, State) -> {Xml, State}. @@ -295,7 +287,7 @@ detect_charset_1(Xml, State) -> %% Output: utf8 | iso8859 %% Description: Converting 7,8 bit and utf8 encoding strings to internal format. %%---------------------------------------------------------------------- -convert_encoding(Enc) -> %% Just for 7,8 bit + utf8 +convert_encoding(Enc, State) -> %% Just for 7,8 bit + utf8 case string:to_lower(Enc) of "utf-8" -> utf8; "us-ascii" -> utf8; @@ -309,19 +301,19 @@ convert_encoding(Enc) -> %% Just for 7,8 bit + utf8 "iso-8859-7" -> latin1; "iso-8859-8" -> latin1; "iso-8859-9" -> latin1; - _ -> {error, "Unknown encoding: " ++ Enc} + _ -> ?fatal_error(State, "Unknown encoding: " ++ Enc) end. %%---------------------------------------------------------------------- %% Function: parse_xml_directive(Xml) %% Input: Xml = binary() %% Acc = list() -%% Output: +%% Output: %% Description: Parsing the xml declaration from the input stream. %%---------------------------------------------------------------------- -parse_xml_directive(<<C, Rest/binary>>) when ?is_whitespace(C) -> - parse_xml_directive_1(Rest, []). - +parse_xml_directive(<<C, Rest/binary>>, State) when ?is_whitespace(C) -> + parse_xml_directive_1(Rest, [], State). + %%---------------------------------------------------------------------- %% Function: parse_xml_directive_1(Xml, Acc) -> [{Name, Value}] %% Input: Xml = binary() @@ -331,20 +323,20 @@ parse_xml_directive(<<C, Rest/binary>>) when ?is_whitespace(C) -> %% Output: see above %% Description: Parsing the xml declaration from the input stream. %%---------------------------------------------------------------------- -parse_xml_directive_1(<<C, Rest/binary>>, Acc) when ?is_whitespace(C) -> - parse_xml_directive_1(Rest, Acc); -parse_xml_directive_1(<<"?>", _/binary>>, Acc) -> +parse_xml_directive_1(<<C, Rest/binary>>, Acc, State) when ?is_whitespace(C) -> + parse_xml_directive_1(Rest, Acc, State); +parse_xml_directive_1(<<"?>", _/binary>>, Acc, _State) -> Acc; -parse_xml_directive_1(<<C, Rest/binary>>, Acc) when 97 =< C, C =< 122 -> +parse_xml_directive_1(<<C, Rest/binary>>, Acc, State) when 97 =< C, C =< 122 -> {Name, Rest1} = parse_name(Rest, [C]), - Rest2 = parse_eq(Rest1), - {Value, Rest3} = parse_value(Rest2), - parse_xml_directive_1(Rest3, [{Name, Value} |Acc]); -parse_xml_directive_1(_, _) -> - {error, "Unknown attribute in xml directive"}. + Rest2 = parse_eq(Rest1, State), + {Value, Rest3} = parse_value(Rest2, State), + parse_xml_directive_1(Rest3, [{Name, Value} |Acc], State); +parse_xml_directive_1(_, _, State) -> + ?fatal_error(State, "Unknown attribute in xml directive"). %%---------------------------------------------------------------------- -%% Function: parse_xml_directive_1(Xml, Acc) -> Name +%% Function: parse_name(Xml, Acc) -> Name %% Input: Xml = binary() %% Acc = string() %% Output: Name = string() @@ -361,10 +353,12 @@ parse_name(Rest, Acc) -> %% Output: Rest = binary() %% Description: Reads an '=' from the stream. %%---------------------------------------------------------------------- -parse_eq(<<C, Rest/binary>>) when ?is_whitespace(C) -> - parse_eq(Rest); -parse_eq(<<"=", Rest/binary>>) -> - Rest. +parse_eq(<<C, Rest/binary>>, State) when ?is_whitespace(C) -> + parse_eq(Rest, State); +parse_eq(<<"=", Rest/binary>>, _State) -> + Rest; +parse_eq(_, State) -> + ?fatal_error(State, "expecting = or whitespace"). %%---------------------------------------------------------------------- %% Function: parse_value(Xml) -> {Value, Rest} @@ -373,10 +367,12 @@ parse_eq(<<"=", Rest/binary>>) -> %% Rest = binary() %% Description: Parsing an attribute value from the stream. %%---------------------------------------------------------------------- -parse_value(<<C, Rest/binary>>) when ?is_whitespace(C) -> - parse_value(Rest); -parse_value(<<C, Rest/binary>>) when C == $'; C == $" -> - parse_value_1(Rest, C, []). +parse_value(<<C, Rest/binary>>, State) when ?is_whitespace(C) -> + parse_value(Rest, State); +parse_value(<<C, Rest/binary>>, _State) when C == $'; C == $" -> + parse_value_1(Rest, C, []); +parse_value(_, State) -> + ?fatal_error(State, "\', \" or whitespace expected"). %%---------------------------------------------------------------------- %% Function: parse_value_1(Xml, Stop, Acc) -> {Value, Rest} @@ -431,7 +427,7 @@ read_until_end_of_xml_directive(Rest, State) -> nomatch -> case cf(Rest, State) of {<<>>, _} -> - ?fatal_error(State, "Can't detect character encoding due to lack of indata"); + ?fatal_error(State, "Can't detect character encoding due to lack of indata"); {NewBytes, NewState} -> read_until_end_of_xml_directive(NewBytes, NewState) end; @@ -450,9 +446,9 @@ read_until_end_of_xml_directive(Rest, State) -> %% input stream and calls the fun in NextCall. %%---------------------------------------------------------------------- cf(_Rest, #xmerl_sax_parser_state{continuation_fun = undefined} = State) -> - ?fatal_error(State, "Continuation function undefined"); + ?fatal_error(State, "Continuation function undefined"); cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = CState} = State) -> - Result = + Result = try CFun(CState) catch @@ -463,9 +459,9 @@ cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = C end, case Result of {<<>>, _} -> - ?fatal_error(State, "Can't detect character encoding due to lack of indata"); + ?fatal_error(State, "Can't detect character encoding due to lack of indata"); {NewBytes, NewContState} -> - {<<Rest/binary, NewBytes/binary>>, + {<<Rest/binary, NewBytes/binary>>, State#xmerl_sax_parser_state{continuation_state = NewContState}} end. @@ -479,10 +475,10 @@ cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = C %% input stream and calls the fun in NextCall. %%---------------------------------------------------------------------- cf(_Rest, #xmerl_sax_parser_state{continuation_fun = undefined} = State, _) -> - ?fatal_error(State, "Continuation function undefined"); -cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = CState} = State, + ?fatal_error(State, "Continuation function undefined"); +cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = CState} = State, NextCall) -> - Result = + Result = try CFun(CState) catch @@ -493,8 +489,8 @@ cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = C end, case Result of {<<>>, _} -> - ?fatal_error(State, "Can't detect character encoding due to lack of indata"); + ?fatal_error(State, "Can't detect character encoding due to lack of indata"); {NewBytes, NewContState} -> - NextCall(<<Rest/binary, NewBytes/binary>>, + NextCall(<<Rest/binary, NewBytes/binary>>, State#xmerl_sax_parser_state{continuation_state = NewContState}) end. diff --git a/lib/xmerl/test/xmerl_xsd_lib.erl b/lib/xmerl/test/xmerl_xsd_lib.erl index 6006cf500f..39300cd6cb 100644 --- a/lib/xmerl/test/xmerl_xsd_lib.erl +++ b/lib/xmerl/test/xmerl_xsd_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2016. All Rights Reserved. +%% Copyright Ericsson AB 2006-2019. 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. @@ -94,8 +94,9 @@ return_results2({NewFail, NewSuccess, NewMal, NewNotMal}, NumSucc, SkippedN, Tot _ -> io_lib:format("These ~p skipped tests were malicious, but succeeds now: ~p~n", [length(NewNotMal), NewNotMal]) end, - ct:comment(io_lib:format("~p successful tests, ~p skipped tests of totally ~p test cases. ~n" ++ - NFComm ++ NSComm ++ NMComm ++ NNMComm, [NumSucc, SkippedN, TotN])), + ct:comment(io_lib:format("~p successful tests, ~p skipped tests of totally ~p test cases. ~n~ts", + [NumSucc, SkippedN, TotN, + NFComm ++ NSComm ++ NMComm ++ NNMComm])), [] = NewFail. %% return_results2(Diff,{STErrs,STOther},{ITErrs,ITOther},TotN) -> diff --git a/lib/xmerl/vsn.mk b/lib/xmerl/vsn.mk index 3a266a56bd..b6486681c2 100644 --- a/lib/xmerl/vsn.mk +++ b/lib/xmerl/vsn.mk @@ -1 +1 @@ -XMERL_VSN = 1.3.18 +XMERL_VSN = 1.3.19 |