diff options
Diffstat (limited to 'lib')
65 files changed, 1950 insertions, 453 deletions
diff --git a/lib/common_test/doc/src/ct.xml b/lib/common_test/doc/src/ct.xml index a87be21d73..b6c862c233 100644 --- a/lib/common_test/doc/src/ct.xml +++ b/lib/common_test/doc/src/ct.xml @@ -601,18 +601,21 @@ </func> <func> - <name>get_timetrap_info() -> {Time, Scale}</name> + <name>get_timetrap_info() -> {Time, {Scaling,ScaleVal}}</name> <fsummary>Reads information about the timetrap set for the current test case.</fsummary> <type> <v>Time = integer() | infinity</v> - <v>Scale = true | false</v> + <v>Scaling = true | false</v> + <v>ScaleVal = integer()</v> </type> <desc><marker id="get_timetrap_info-0"/> <p>Reads information about the timetrap set for the current test - case. <c>Scale</c> indicates if <c>Common Test</c> will attempt + case. <c>Scaling</c> indicates if <c>Common Test</c> will attempt to compensate timetraps automatically for runtime delays - introduced by, for example, tools like cover.</p> + introduced by, for example, tools like cover. <c>ScaleVal</c> is + the value of the current scaling multipler (always 1 if scaling is + disabled). Note the <c>Time</c> is not the scaled result.</p> </desc> </func> @@ -1136,7 +1139,7 @@ Opts.</fsummary> <type> <v>Opts = [OptTuples]</v> - <v>OptTuples = {dir, TestDirs} | {suite, Suites} | {group, Groups} | {testcase, Cases} | {spec, TestSpecs} | {join_specs, Bool} | {label, Label} | {config, CfgFiles} | {userconfig, UserConfig} | {allow_user_terms, Bool} | {logdir, LogDir} | {silent_connections, Conns} | {stylesheet, CSSFile} | {cover, CoverSpecFile} | {cover_stop, Bool} | {step, StepOpts} | {event_handler, EventHandlers} | {include, InclDirs} | {auto_compile, Bool} | {abort_if_missing_suites, Bool} | {create_priv_dir, CreatePrivDir} | {multiply_timetraps, M} | {scale_timetraps, Bool} | {repeat, N} | {duration, DurTime} | {until, StopTime} | {force_stop, ForceStop} | {decrypt, DecryptKeyOrFile} | {refresh_logs, LogDir} | {logopts, LogOpts} | {verbosity, VLevels} | {basic_html, Bool} | {ct_hooks, CTHs} | {enable_builtin_hooks, Bool} | {release_shell, Bool}</v> + <v>OptTuples = {dir, TestDirs} | {suite, Suites} | {group, Groups} | {testcase, Cases} | {spec, TestSpecs} | {join_specs, Bool} | {label, Label} | {config, CfgFiles} | {userconfig, UserConfig} | {allow_user_terms, Bool} | {logdir, LogDir} | {silent_connections, Conns} | {stylesheet, CSSFile} | {cover, CoverSpecFile} | {cover_stop, Bool} | {step, StepOpts} | {event_handler, EventHandlers} | {include, InclDirs} | {auto_compile, Bool} | {abort_if_missing_suites, Bool} | {create_priv_dir, CreatePrivDir} | {multiply_timetraps, M} | {scale_timetraps, Bool} | {repeat, N} | {duration, DurTime} | {until, StopTime} | {force_stop, ForceStop} | {decrypt, DecryptKeyOrFile} | {refresh_logs, LogDir} | {logopts, LogOpts} | {verbosity, VLevels} | {basic_html, Bool} | {esc_chars, Bool} | {ct_hooks, CTHs} | {enable_builtin_hooks, Bool} | {release_shell, Bool}</v> <v>TestDirs = [string()] | string()</v> <v>Suites = [string()] | [atom()] | string() | atom()</v> <v>Cases = [atom()] | atom()</v> diff --git a/lib/common_test/doc/src/ct_run.xml b/lib/common_test/doc/src/ct_run.xml index d0ecc38564..2552938346 100644 --- a/lib/common_test/doc/src/ct_run.xml +++ b/lib/common_test/doc/src/ct_run.xml @@ -124,6 +124,7 @@ [-duration HHMMSS [-force_stop [skip_rest]]] | [-until [YYMoMoDD]HHMMSS [-force_stop [skip_rest]]] [-basic_html] + [-no_esc_chars] [-ct_hooks CTHModule1 CTHOpts1 and CTHModule2 CTHOpts2 and .. CTHModuleN CTHOptsN] [-exit_status ignore_config] @@ -162,6 +163,7 @@ [-duration HHMMSS [-force_stop [skip_rest]]] | [-until [YYMoMoDD]HHMMSS [-force_stop [skip_rest]]] [-basic_html] + [-no_esc_chars] [-ct_hooks CTHModule1 CTHOpts1 and CTHModule2 CTHOpts2 and .. CTHModuleN CTHOptsN] [-exit_status ignore_config]</pre> @@ -186,7 +188,8 @@ [-muliply_timetraps Multiplier] [-scale_timetraps] [-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc] - [-basic_html]</pre> + [-basic_html] + [-no_esc_chars]</pre> </section> <section> diff --git a/lib/common_test/doc/src/ct_telnet.xml b/lib/common_test/doc/src/ct_telnet.xml index b7ba352104..1de278d30c 100644 --- a/lib/common_test/doc/src/ct_telnet.xml +++ b/lib/common_test/doc/src/ct_telnet.xml @@ -64,6 +64,8 @@ remaining string terminated) = 0</p></item> <item><p>Polling interval (sleep time between polls) = 1 second</p> </item> + <item><p>The TCP_NODELAY option for the telnet socket + is disabled (set to <c>false</c>) per default</p></item> </list> <p>These parameters can be modified by the user with the following @@ -76,7 +78,8 @@ {reconnection_interval,Millisec}, {keep_alive,Bool}, {poll_limit,N}, - {poll_interval,Millisec}]}.</pre> + {poll_interval,Millisec}, + {tcp_nodelay,Bool}]}.</pre> <p><c>Millisec = integer(), N = integer()</c></p> diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index ff51b101cc..791be61066 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -33,6 +33,68 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.12.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The <c>nodelay</c> option used to be enabled + (<c>true</c>) by default for sockets opened by the Common + Test telnet client. This appeared to cause communication + problems with telnet servers on some systems, and + therefore the option is no longer used. Its value may + instead be specified in the telnet connection settings. + See the man page for <c>ct_telnet</c> for details. Please + note that the interface function <c>connect</c> in + <c>unix_telnet</c> has been updated with an extra + argument and is now <c>unix_telnet:connect/7</c>.</p> + <p> + Own Id: OTP-13462 Aux Id: seq13077 </p> + </item> + <item> + <p> + Fix bug in cth_surefire: When a pre_init_per_suite hook + fails before reaching the + cth_surefire:pre_init_per_suite, cth_surefire produced + incorrect XML.</p> + <p> + Own Id: OTP-13513</p> + </item> + <item> + <p> + The <c>ct:get_timetrap_info/0</c> function has been + updated to return more information about timetrap + scaling.</p> + <p> + Own Id: OTP-13535</p> + </item> + <item> + <p> + A problem with stylesheet HTML tags getting incorrectly + escaped by Common Test has been corrected.</p> + <p> + Own Id: OTP-13536</p> + </item> + <item> + <p> + The <c>ct_run</c> start flag <c>-no_esc_chars</c> and + <c>ct:run_test/1</c> start option <c>{esc_chars,Bool}</c> + have been introduced to make it possible to disable + automatic escaping of characters. Automatic escaping of + special HTML characters printed with <c>io:format/1,2</c> + and <c>ct:pal/1,2,3,4</c> was introduced in Common Test + 1.12. The new flag/option may be used to disable this + feature for backwards compatibility reasons. (The option + is also supported in test specifications).</p> + <p> + Own Id: OTP-13537</p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.12</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/common_test/doc/src/run_test_chapter.xml b/lib/common_test/doc/src/run_test_chapter.xml index e04bb3e208..e5e217ca1d 100644 --- a/lib/common_test/doc/src/run_test_chapter.xml +++ b/lib/common_test/doc/src/run_test_chapter.xml @@ -266,6 +266,10 @@ <tag><c><![CDATA[-verbosity <levels>]]></c></tag> <item><p>Sets <seealso marker="write_test_chapter#logging">verbosity levels for printouts</seealso>.</p></item> + + <tag><c><![CDATA[-no_esc_chars]]></c></tag> + <item><p>Disables automatic escaping of special HTML characters. + See the <seealso marker="write_test_chapter#logging">Logging chapter</seealso>.</p></item> </taglist> <note><p>Directories passed to <c>Common Test</c> can have either relative or absolute paths.</p></note> @@ -802,7 +806,7 @@ program</seealso> for an overview of available start flags (as most flags have a corresponding configuration term)</item> <item><seealso marker="write_test_chapter#logging">Logging</seealso> - (for terms <c>verbosity</c>, <c>stylesheet</c> and <c>basic_html</c>)</item> + (for terms <c>verbosity</c>, <c>stylesheet</c>, <c>basic_html</c> and <c>esc_chars</c>)</item> <item><seealso marker="config_file_chapter#top">External Configuration Data</seealso> (for terms <c>config</c> and <c>userconfig</c>)</item> <item><seealso marker="event_handler_chapter#event_handling">Event @@ -887,6 +891,9 @@ {basic_html, Bool}. {basic_html, NodeRefs, Bool}. + {esc_chars, Bool}. + {esc_chars, NodeRefs, Bool}. + {release_shell, Bool}.</pre> <p><em>Test terms:</em></p> diff --git a/lib/common_test/doc/src/unix_telnet.xml b/lib/common_test/doc/src/unix_telnet.xml index 189379c39a..a064a222d6 100644 --- a/lib/common_test/doc/src/unix_telnet.xml +++ b/lib/common_test/doc/src/unix_telnet.xml @@ -80,7 +80,7 @@ <funcs> <func> - <name>connect(ConnName, Ip, Port, Timeout, KeepAlive, Extra) -> {ok, Handle} | {error, Reason}</name> + <name>connect(ConnName, Ip, Port, Timeout, KeepAlive, TCPNoDelay, Extra) -> {ok, Handle} | {error, Reason}</name> <fsummary>Callback for ct_telnet.erl.</fsummary> <type> <v>ConnName = target_name()</v> @@ -88,6 +88,7 @@ <v>Port = integer()</v> <v>Timeout = integer()</v> <v>KeepAlive = bool()</v> + <v>TCPNoDelay = bool()</v> <v>Extra = target_name() | {Username, Password}</v> <v>Username = string()</v> <v>Password = string()</v> diff --git a/lib/common_test/doc/src/write_test_chapter.xml b/lib/common_test/doc/src/write_test_chapter.xml index e3811ec4cf..a7a652d506 100644 --- a/lib/common_test/doc/src/write_test_chapter.xml +++ b/lib/common_test/doc/src/write_test_chapter.xml @@ -1047,9 +1047,15 @@ <p>Common Test will escape special HTML characters (<, > and &) in printouts to the log file made with <c>ct:pal/4</c> and <c>io:format/2</c>. In order to print - strings with HTML tags to the log, use the <c>ct:log/5</c> function. The character escaping - feature is per default disabled for <c>ct:log/5</c>, but can be enabled with the - <c>esc_chars</c> option.</p> + strings with HTML tags to the log, use the <c>ct:log/3,4,5</c> function. The character + escaping feature is per default disabled for <c>ct:log/3,4,5</c> but can be enabled with + the <c>esc_chars</c> option in the <c>Opts</c> list, see <seealso marker="ct#log-5"> + <c>ct:log/3,4,5</c></seealso>.</p> + + <p>If the character escaping feature needs to be disabled (typically for backwards + compatibility reasons), use the <c>ct_run</c> start flag <c>-no_esc_chars</c>, or the + <c>ct:run_test/1</c> start option <c>{esc_chars,Bool}</c> (this start option is also + supported in test specifications).</p> <p>For more information about log files, see section <seealso marker="run_test_chapter#log_files">Log Files</seealso> diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index 538be514d6..22941668f2 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -161,9 +161,9 @@ run(TestDirs) -> %%% {repeat,N} | {duration,DurTime} | {until,StopTime} | %%% {force_stop,ForceStop} | {decrypt,DecryptKeyOrFile} | %%% {refresh_logs,LogDir} | {logopts,LogOpts} | -%%% {verbosity,VLevels} | {basic_html,Bool} | -%%% {ct_hooks, CTHs} | {enable_builtin_hooks,Bool} | -%%% {release_shell,Bool} +%%% {verbosity,VLevels} | {basic_html,Bool} | +%%% {esc_chars,Bool} | {ct_hooks, CTHs} | +%%% {enable_builtin_hooks,Bool} | {release_shell,Bool} %%% TestDirs = [string()] | string() %%% Suites = [string()] | [atom()] | string() | atom() %%% Cases = [atom()] | atom() diff --git a/lib/common_test/src/ct_groups.erl b/lib/common_test/src/ct_groups.erl index 92640cf323..899d2bfb5a 100644 --- a/lib/common_test/src/ct_groups.erl +++ b/lib/common_test/src/ct_groups.erl @@ -325,7 +325,7 @@ modify_tc_list1(GrSpecTs, TSCs) -> true -> {[TC|TSCs1],lists:delete(TC,GrSpecTs2)}; false -> - case lists:keymember(TC, 2, GrSpecTs) of + case lists:keysearch(TC, 2, GrSpecTs) of {value,Test} -> {[Test|TSCs1], lists:keydelete(TC, 2, GrSpecTs2)}; diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index 83ad33fdd8..90f36cbdc2 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -67,6 +67,8 @@ terminate(Hooks) -> %% tests. -spec init_tc(Mod :: atom(), FuncSpec :: atom() | + {ConfigFunc :: init_per_testcase | end_per_testcase, + TestCase :: atom()} | {ConfigFunc :: init_per_group | end_per_group, GroupName :: atom(), Properties :: list()}, @@ -103,7 +105,9 @@ init_tc(_Mod, TC = error_in_suite, Config) -> %% @doc Called as each test case is completed. This includes all configuration %% tests. -spec end_tc(Mod :: atom(), - FuncSpec :: atom() | + FuncSpec :: atom() | + {ConfigFunc :: init_per_testcase | end_per_testcase, + TestCase :: atom()} | {ConfigFunc :: init_per_group | end_per_group, GroupName :: atom(), Properties :: list()}, diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 4920383f39..a9ad571bfc 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -609,7 +609,8 @@ log_timestamp({MS,S,US}) -> ct_log_fd, tc_groupleaders, stylesheet, - async_print_jobs}). + async_print_jobs, + tc_esc_chars}). logger(Parent, Mode, Verbosity) -> register(?MODULE,self()), @@ -728,14 +729,18 @@ logger(Parent, Mode, Verbosity) -> end end || {Cat,VLvl} <- Verbosity], io:nl(CtLogFd), - + TcEscChars = case application:get_env(common_test, esc_chars) of + {ok,ECBool} -> ECBool; + _ -> true + end, logger_loop(#logger_state{parent=Parent, log_dir=AbsDir, start_time=Time, orig_GL=group_leader(), ct_log_fd=CtLogFd, tc_groupleaders=[], - async_print_jobs=[]}). + async_print_jobs=[], + tc_esc_chars=TcEscChars}). copy_priv_files([SrcF | SrcFs], [DestF | DestFs]) -> case file:copy(SrcF, DestF) of @@ -761,20 +766,21 @@ logger_loop(State) -> end, if Importance >= (100-VLvl) -> CtLogFd = State#logger_state.ct_log_fd, + DoEscChars = State#logger_state.tc_esc_chars and EscChars, case get_groupleader(Pid, GL, State) of {tc_log,TCGL,TCGLs} -> case erlang:is_process_alive(TCGL) of true -> State1 = print_to_log(SyncOrAsync, Pid, Category, TCGL, Content, - EscChars, State), + DoEscChars, State), logger_loop(State1#logger_state{ tc_groupleaders = TCGLs}); false -> %% Group leader is dead, so write to the %% CtLog or unexpected_io log instead unexpected_io(Pid, Category, Importance, - Content, CtLogFd, EscChars), + Content, CtLogFd, DoEscChars), logger_loop(State) end; @@ -783,7 +789,7 @@ logger_loop(State) -> %% to ct_log, else write to unexpected_io %% log unexpected_io(Pid, Category, Importance, Content, - CtLogFd, EscChars), + CtLogFd, DoEscChars), logger_loop(State#logger_state{ tc_groupleaders = TCGLs}) end; @@ -794,7 +800,7 @@ logger_loop(State) -> %% make sure no IO for this test case from the %% CT logger gets rejected test_server:permit_io(GL, self()), - print_style(GL, State#logger_state.stylesheet), + print_style(GL,GL,State#logger_state.stylesheet), set_evmgr_gl(GL), TCGLs = add_tc_gl(TCPid,GL,State), if not RefreshLog -> @@ -882,7 +888,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(Str, Args) of IoStr when Escapable, EscChars, IoList == [] -> escape_chars(IoStr); IoStr when Escapable, EscChars -> @@ -925,7 +931,12 @@ print_to_log(sync, FromPid, Category, TCGL, Content, EscChars, State) -> if FromPid /= TCGL -> IoFun = create_io_fun(FromPid, CtLogFd, EscChars), IoList = lists:foldl(IoFun, [], Content), - io:format(TCGL,["$tc_html","~ts"], [IoList]); + try io:format(TCGL,["$tc_html","~ts"], [IoList]) of + ok -> ok + catch + _:_ -> + io:format(TCGL,"~ts", [IoList]) + end; true -> unexpected_io(FromPid, Category, ?MAX_IMPORTANCE, Content, CtLogFd, EscChars) @@ -958,7 +969,10 @@ print_to_log(async, FromPid, Category, TCGL, Content, EscChars, State) -> _:terminated -> unexpected_io(FromPid, Category, ?MAX_IMPORTANCE, - Content, CtLogFd, EscChars) + Content, CtLogFd, EscChars); + _:_ -> + io:format(TCGL, "~ts", + [lists:foldl(IoFun,[],Content)]) end; false -> unexpected_io(FromPid, Category, @@ -1099,26 +1113,27 @@ open_ctlog(MiscIoName) -> "View I/O logged after the test run</a></li>\n</ul>\n", [MiscIoName,MiscIoName]), - print_style(Fd,undefined), + print_style(Fd,group_leader(),undefined), io:format(Fd, xhtml("<br><h2>Progress Log</h2>\n<pre>\n", "<br />\n<h4>PROGRESS LOG</h4>\n<pre>\n"), []), Fd. -print_style(Fd,undefined) -> +print_style(Fd,GL,undefined) -> case basic_html() of true -> - io:format(Fd, - "<style>\n" - "div.ct_internal { background:lightgrey; color:black; }\n" - "div.default { background:lightgreen; color:black; }\n" - "</style>\n", - []); + Style = "<style>\n + div.ct_internal { background:lightgrey; color:black; }\n + div.default { background:lightgreen; color:black; }\n + </style>\n", + if Fd == GL -> io:format(["$tc_html",Style], []); + true -> io:format(Fd, Style, []) + end; _ -> ok end; -print_style(Fd,StyleSheet) -> +print_style(Fd,GL,StyleSheet) -> case file:read_file(StyleSheet) of {ok,Bin} -> Str = b2s(Bin,encoding(StyleSheet)), @@ -1131,23 +1146,30 @@ print_style(Fd,StyleSheet) -> N1 -> N1 end, if (Pos0 == 0) and (Pos1 /= 0) -> - print_style_error(Fd,StyleSheet,missing_style_start_tag); + print_style_error(Fd,GL,StyleSheet,missing_style_start_tag); (Pos0 /= 0) and (Pos1 == 0) -> - print_style_error(Fd,StyleSheet,missing_style_end_tag); + print_style_error(Fd,GL,StyleSheet,missing_style_end_tag); Pos0 /= 0 -> Style = string:sub_string(Str,Pos0,Pos1+7), - io:format(Fd,"~ts\n",[Style]); + if Fd == GL -> io:format(Fd,["$tc_html","~ts\n"],[Style]); + true -> io:format(Fd,"~ts\n",[Style]) + end; Pos0 == 0 -> - io:format(Fd,"<style>~ts</style>\n",[Str]) + if Fd == GL -> io:format(Fd,["$tc_html","<style>\n~ts</style>\n"],[Str]); + true -> io:format(Fd,"<style>\n~ts</style>\n",[Str]) + end end; {error,Reason} -> - print_style_error(Fd,StyleSheet,Reason) + print_style_error(Fd,GL,StyleSheet,Reason) end. -print_style_error(Fd,StyleSheet,Reason) -> - io:format(Fd,"\n<!-- Failed to load stylesheet ~ts: ~p -->\n", - [StyleSheet,Reason]), - print_style(Fd,undefined). +print_style_error(Fd,GL,StyleSheet,Reason) -> + IO = io_lib:format("\n<!-- Failed to load stylesheet ~ts: ~p -->\n", + [StyleSheet,Reason]), + if Fd == GL -> io:format(Fd,["$tc_html",IO],[]); + true -> io:format(Fd,IO,[]) + end, + print_style(Fd,GL,undefined). close_ctlog(Fd) -> io:format(Fd, "\n</pre>\n", []), diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index 228daf459b..d24edad2eb 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -27,7 +27,7 @@ -export([run_on_node/2,run_on_node/3]). -export([run_test/1,run_test/2]). -export([get_event_mgr_ref/0]). --export([basic_html/1]). +-export([basic_html/1,esc_chars/1]). -export([abort/0,abort/1,progress/0]). @@ -317,6 +317,16 @@ basic_html(Bool) -> ok. %%%----------------------------------------------------------------- +%%% @spec esc_chars(Bool) -> ok +%%% Bool = true | false +%%% +%%% @doc If set to false, the ct_master logs will be written without +%%% special characters being escaped in the HTML logs. +esc_chars(Bool) -> + application:set_env(common_test_master, esc_chars, Bool), + ok. + +%%%----------------------------------------------------------------- %%% MASTER, runs on central controlling node. %%%----------------------------------------------------------------- start_master(NodeOptsList) -> diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index ceb94ceee5..a0f9f47b41 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -65,6 +65,7 @@ logdir, logopts = [], basic_html, + esc_chars = true, verbosity = [], config = [], event_handlers = [], @@ -346,6 +347,15 @@ script_start1(Parent, Args) -> application:set_env(common_test, basic_html, true), true end, + %% esc_chars - used by ct_logs + EscChars = case proplists:get_value(no_esc_chars, Args) of + undefined -> + application:set_env(common_test, esc_chars, true), + undefined; + _ -> + application:set_env(common_test, esc_chars, false), + false + end, %% disable_log_cache - used by ct_logs case proplists:get_value(disable_log_cache, Args) of undefined -> @@ -359,6 +369,7 @@ script_start1(Parent, Args) -> cover = Cover, cover_stop = CoverStop, logdir = LogDir, logopts = LogOpts, basic_html = BasicHtml, + esc_chars = EscChars, verbosity = Verbosity, event_handlers = EvHandlers, ct_hooks = CTHooks, @@ -587,6 +598,17 @@ combine_test_opts(TS, Specs, Opts) -> BHBool end, + EscChars = + case choose_val(Opts#opts.esc_chars, + TSOpts#opts.esc_chars) of + undefined -> + true; + ECBool -> + application:set_env(common_test, esc_chars, + ECBool), + ECBool + end, + Opts#opts{label = Label, profile = Profile, testspec_files = Specs, @@ -595,6 +617,7 @@ combine_test_opts(TS, Specs, Opts) -> logdir = which(logdir, LogDir), logopts = AllLogOpts, basic_html = BasicHtml, + esc_chars = EscChars, verbosity = AllVerbosity, silent_connections = AllSilentConns, config = TSOpts#opts.config, @@ -795,6 +818,7 @@ script_usage() -> "\n\t [-scale_timetraps]" "\n\t [-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]" "\n\t [-basic_html]" + "\n\t [-no_esc_chars]" "\n\t [-repeat N] |" "\n\t [-duration HHMMSS [-force_stop [skip_rest]]] |" "\n\t [-until [YYMoMoDD]HHMMSS [-force_stop [skip_rest]]]" @@ -822,6 +846,7 @@ script_usage() -> "\n\t [-scale_timetraps]" "\n\t [-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]" "\n\t [-basic_html]" + "\n\t [-no_esc_chars]" "\n\t [-repeat N] |" "\n\t [-duration HHMMSS [-force_stop [skip_rest]]] |" "\n\t [-until [YYMoMoDD]HHMMSS [-force_stop [skip_rest]]]\n\n"), @@ -847,7 +872,8 @@ script_usage() -> "\n\t [-multiply_timetraps N]" "\n\t [-scale_timetraps]" "\n\t [-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]" - "\n\t [-basic_html]\n\n"). + "\n\t [-basic_html]" + "\n\t [-no_esc_chars]\n\n"). %%%----------------------------------------------------------------- %%% @hidden @@ -1089,7 +1115,17 @@ run_test2(StartOpts) -> application:set_env(common_test, basic_html, BasicHtmlBool), BasicHtmlBool end, - + %% esc_chars - used by ct_logs + EscChars = + case proplists:get_value(esc_chars, StartOpts) of + undefined -> + application:set_env(common_test, esc_chars, true), + undefined; + EscCharsBool -> + application:set_env(common_test, esc_chars, EscCharsBool), + EscCharsBool + end, + %% disable_log_cache - used by ct_logs case proplists:get_value(disable_log_cache, StartOpts) of undefined -> application:set_env(common_test, disable_log_cache, false); @@ -1104,6 +1140,7 @@ run_test2(StartOpts) -> cover = Cover, cover_stop = CoverStop, step = Step, logdir = LogDir, logopts = LogOpts, basic_html = BasicHtml, + esc_chars = EscChars, config = CfgFiles, verbosity = Verbosity, event_handlers = EvHandlers, @@ -1445,6 +1482,7 @@ get_data_for_node(#testspec{label = Labels, logdir = LogDirs, logopts = LogOptsList, basic_html = BHs, + esc_chars = EscChs, stylesheet = SSs, verbosity = VLvls, silent_connections = SilentConnsList, @@ -1472,6 +1510,7 @@ get_data_for_node(#testspec{label = Labels, LOs -> LOs end, BasicHtml = proplists:get_value(Node, BHs), + EscChars = proplists:get_value(Node, EscChs), Stylesheet = proplists:get_value(Node, SSs), Verbosity = case proplists:get_value(Node, VLvls) of undefined -> []; @@ -1498,6 +1537,7 @@ get_data_for_node(#testspec{label = Labels, logdir = LogDir, logopts = LogOpts, basic_html = BasicHtml, + esc_chars = EscChars, stylesheet = Stylesheet, verbosity = Verbosity, silent_connections = SilentConns, @@ -2182,10 +2222,18 @@ do_run_test(Tests, Skip, Opts0) -> %% test_server needs to know the include path too InclPath = case application:get_env(common_test, include) of {ok,Incls} -> Incls; - _ -> [] + _ -> [] end, application:set_env(test_server, include, InclPath), + %% copy the escape characters setting to test_server + EscChars = + case application:get_env(common_test, esc_chars) of + {ok,ECBool} -> ECBool; + _ -> true + end, + application:set_env(test_server, esc_chars, EscChars), + test_server_ctrl:start_link(local), %% let test_server expand the test tuples and count no of cases @@ -3071,6 +3119,10 @@ opts2args(EnvStartOpts) -> [{basic_html,[]}]; ({basic_html,false}) -> []; + ({esc_chars,false}) -> + [{no_esc_chars,[]}]; + ({esc_chars,true}) -> + []; ({event_handler,EH}) when is_atom(EH) -> [{event_handler,[atom_to_list(EH)]}]; ({event_handler,EHs}) when is_list(EHs) -> diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl index 4d3fd2d094..f5f4f648f4 100644 --- a/lib/common_test/src/ct_telnet.erl +++ b/lib/common_test/src/ct_telnet.erl @@ -42,7 +42,8 @@ %% {reconnection_interval,Millisec}, %% {keep_alive,Bool}, %% {poll_limit,N}, -%% {poll_interval,Millisec}]}.</pre> +%% {poll_interval,Millisec}, +%% {tcp_nodelay,Bool}]}.</pre> %% <p><code>Millisec = integer(), N = integer()</code></p> %% <p>Enter the <code>telnet_settings</code> term in a configuration %% file included in the test and ct_telnet will retrieve the information @@ -182,7 +183,8 @@ conn_to=?DEFAULT_TIMEOUT, com_to=?DEFAULT_TIMEOUT, reconns=?RECONNS, - reconn_int=?RECONN_TIMEOUT}). + reconn_int=?RECONN_TIMEOUT, + tcp_nodelay=false}). %%%----------------------------------------------------------------- %%% @spec open(Name) -> {ok,Handle} | {error,Reason} @@ -602,8 +604,18 @@ init(Name,{Ip,Port,Type},{TargetMod,KeepAlive,Extra}) -> Settings -> set_telnet_defaults(Settings,#state{}) end, - case catch TargetMod:connect(Name,Ip,Port,S0#state.conn_to, - KeepAlive,Extra) of + %% Handle old user versions of TargetMod + code:ensure_loaded(TargetMod), + try + case erlang:function_exported(TargetMod,connect,7) of + true -> + TargetMod:connect(Name,Ip,Port,S0#state.conn_to, + KeepAlive,S0#state.tcp_nodelay,Extra); + false -> + TargetMod:connect(Name,Ip,Port,S0#state.conn_to, + KeepAlive,Extra) + end + of {ok,TelnPid} -> put({ct_telnet_pid2name,TelnPid},Name), S1 = S0#state{host=Ip, @@ -625,15 +637,18 @@ init(Name,{Ip,Port,Type},{TargetMod,KeepAlive,Extra}) -> "Connection timeout: ~p\n" "Keep alive: ~w\n" "Poll limit: ~w\n" - "Poll interval: ~w", + "Poll interval: ~w\n" + "TCP nodelay: ~w", [Ip,Port,S1#state.com_to,S1#state.reconns, S1#state.reconn_int,S1#state.conn_to,KeepAlive, - S1#state.poll_limit,S1#state.poll_interval]), + S1#state.poll_limit,S1#state.poll_interval, + S1#state.tcp_nodelay]), {ok,TelnPid,S1}; - {'EXIT',Reason} -> - {error,Reason}; Error -> Error + catch + _:Reason -> + {error,Reason} end. type(telnet) -> ip; @@ -653,6 +668,8 @@ set_telnet_defaults([{poll_limit,PL}|Ss],S) -> set_telnet_defaults(Ss,S#state{poll_limit=PL}); set_telnet_defaults([{poll_interval,PI}|Ss],S) -> set_telnet_defaults(Ss,S#state{poll_interval=PI}); +set_telnet_defaults([{tcp_nodelay,NoDelay}|Ss],S) -> + set_telnet_defaults(Ss,S#state{tcp_nodelay=NoDelay}); set_telnet_defaults([Unknown|Ss],S) -> force_log(S,error, "Bad element in telnet_settings: ~p",[Unknown]), @@ -794,8 +811,17 @@ reconnect(Ip,Port,N,State=#state{name=Name, keep_alive=KeepAlive, extra=Extra, conn_to=ConnTo, - reconn_int=ReconnInt}) -> - case TargetMod:connect(Name,Ip,Port,ConnTo,KeepAlive,Extra) of + reconn_int=ReconnInt, + tcp_nodelay=NoDelay}) -> + %% Handle old user versions of TargetMod + ConnResult = + case erlang:function_exported(TargetMod,connect,7) of + true -> + TargetMod:connect(Name,Ip,Port,ConnTo,KeepAlive,NoDelay,Extra); + false -> + TargetMod:connect(Name,Ip,Port,ConnTo,KeepAlive,Extra) + end, + case ConnResult of {ok,NewPid} -> put({ct_telnet_pid2name,NewPid},Name), {ok, NewPid, State#state{teln_pid=NewPid}}; diff --git a/lib/common_test/src/ct_telnet_client.erl b/lib/common_test/src/ct_telnet_client.erl index 99d683244c..bdab456cfa 100644 --- a/lib/common_test/src/ct_telnet_client.erl +++ b/lib/common_test/src/ct_telnet_client.erl @@ -35,7 +35,7 @@ %%-define(debug, true). --export([open/2, open/3, open/4, open/5, close/1]). +-export([open/2, open/3, open/4, open/5, open/6, close/1]). -export([send_data/2, send_data/3, get_data/1]). -define(TELNET_PORT, 23). @@ -70,19 +70,22 @@ -record(state,{conn_name, get_data, keep_alive=true, log_pos=1}). open(Server, ConnName) -> - open(Server, ?TELNET_PORT, ?OPEN_TIMEOUT, true, ConnName). + open(Server, ?TELNET_PORT, ?OPEN_TIMEOUT, true, false, ConnName). open(Server, Port, ConnName) -> - open(Server, Port, ?OPEN_TIMEOUT, true, ConnName). + open(Server, Port, ?OPEN_TIMEOUT, true, false, ConnName). open(Server, Port, Timeout, ConnName) -> - open(Server, Port, Timeout, true, ConnName). + open(Server, Port, Timeout, true, false, ConnName). open(Server, Port, Timeout, KeepAlive, ConnName) -> + open(Server, Port, Timeout, KeepAlive, false, ConnName). + +open(Server, Port, Timeout, KeepAlive, NoDelay, ConnName) -> Self = self(), Pid = spawn(fun() -> init(Self, Server, Port, Timeout, - KeepAlive, ConnName) + KeepAlive, NoDelay, ConnName) end), receive {open,Pid} -> @@ -114,8 +117,8 @@ get_data(Pid) -> %%%----------------------------------------------------------------- %%% Internal functions -init(Parent, Server, Port, Timeout, KeepAlive, ConnName) -> - case gen_tcp:connect(Server, Port, [list,{packet,0},{nodelay,true}], Timeout) of +init(Parent, Server, Port, Timeout, KeepAlive, NoDelay, ConnName) -> + case gen_tcp:connect(Server, Port, [list,{packet,0},{nodelay,NoDelay}], Timeout) of {ok,Sock} -> dbg("~p connected to: ~p (port: ~w, keep_alive: ~w)\n", [ConnName,Server,Port,KeepAlive]), diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index 5cd52bd042..61d8f49dcc 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -1146,8 +1146,9 @@ should_be_added(Tag,Node,_Data,Spec) -> if %% list terms *without* possible duplicates here Tag == logdir; Tag == logopts; - Tag == basic_html; Tag == label; - Tag == auto_compile; Tag == abort_if_missing_suites; + Tag == basic_html; Tag == esc_chars; + Tag == label; Tag == auto_compile; + Tag == abort_if_missing_suites; Tag == stylesheet; Tag == verbosity; Tag == silent_connections -> lists:keymember(ref2node(Node,Spec#testspec.nodes),1, @@ -1544,6 +1545,8 @@ valid_terms() -> {logopts,3}, {basic_html,2}, {basic_html,3}, + {esc_chars,2}, + {esc_chars,3}, {verbosity,2}, {verbosity,3}, {silent_connections,2}, diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index b7fa7947e2..3561a0a2d3 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -459,6 +459,7 @@ loop(Mode,TestData,StartDir) -> error:badarg -> [] end, ct_hooks:terminate(Callbacks), + close_connections(ets:tab2list(?conn_table)), ets:delete(?conn_table), ets:delete(?board_table), diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index 2c1954c2b3..bdfe2041a5 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -37,6 +37,7 @@ logdir=["."], logopts=[], basic_html=[], + esc_chars=[], verbosity=[], silent_connections=[], cover=[], diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl index a8c4a455e1..780fbea79a 100644 --- a/lib/common_test/src/cth_log_redirect.erl +++ b/lib/common_test/src/cth_log_redirect.erl @@ -130,7 +130,14 @@ handle_event(Event, #eh_state{log_func = LogFunc} = State) -> tag_event(Event)), if is_list(SReport) -> SaslHeader = format_header(State), - ct_logs:LogFunc(sasl, ?STD_IMPORTANCE, SaslHeader, SReport, []); + case LogFunc of + tc_log -> + ct_logs:tc_log(sasl, ?STD_IMPORTANCE, + SaslHeader, SReport, [], []); + tc_log_async -> + ct_logs:tc_log_async(sasl, ?STD_IMPORTANCE, + SaslHeader, SReport, []) + end; true -> %% Report is an atom if no logging is to be done ignore end @@ -139,7 +146,14 @@ handle_event(Event, #eh_state{log_func = LogFunc} = State) -> tag_event(Event),io_lib), if is_list(EReport) -> ErrHeader = format_header(State), - ct_logs:LogFunc(error_logger, ?STD_IMPORTANCE, ErrHeader, EReport, []); + case LogFunc of + tc_log -> + ct_logs:tc_log(error_logger, ?STD_IMPORTANCE, + ErrHeader, EReport, [], []); + tc_log_async -> + ct_logs:tc_log_async(error_logger, ?STD_IMPORTANCE, + ErrHeader, EReport, []) + end; true -> %% Report is an atom if no logging is to be done ignore end, diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl index 31a8e1c076..d6e855c02c 100644 --- a/lib/common_test/src/cth_surefire.erl +++ b/lib/common_test/src/cth_surefire.erl @@ -82,7 +82,8 @@ init(Path, Opts) -> url_base = proplists:get_value(url_base,Opts), timer = ?now }. -pre_init_per_suite(Suite,SkipOrFail,State) when is_tuple(SkipOrFail) -> +pre_init_per_suite(Suite,SkipOrFail,#state{ test_cases = [] } = State) + when is_tuple(SkipOrFail) -> {SkipOrFail, init_tc(State#state{curr_suite = Suite, curr_suite_ts = ?now}, SkipOrFail) }; diff --git a/lib/common_test/src/unix_telnet.erl b/lib/common_test/src/unix_telnet.erl index e5b3058999..2fc585735d 100644 --- a/lib/common_test/src/unix_telnet.erl +++ b/lib/common_test/src/unix_telnet.erl @@ -27,7 +27,8 @@ %%% {port,PortNum}, % optional %%% {username,UserName}, %%% {password,Password}, -%%% {keep_alive,Bool}]}. % optional</pre> +%%% {keep_alive,Bool}, % optional +%%% {tcp_nodely,Bool}]} % optional</pre> %%% %%% <p>To communicate via telnet to the host specified by %%% <code>HostNameOrIpAddress</code>, use the interface functions in @@ -55,7 +56,7 @@ -compile(export_all). %% Callbacks for ct_telnet.erl --export([connect/6,get_prompt_regexp/0]). +-export([connect/7,get_prompt_regexp/0]). -import(ct_telnet,[start_gen_log/1,log/4,end_gen_log/0]). -define(username,"login: "). @@ -82,6 +83,7 @@ get_prompt_regexp() -> %%% Port = integer() %%% Timeout = integer() %%% KeepAlive = bool() +%%% TCPNoDelay = bool() %%% Extra = ct:target_name() | {Username,Password} %%% Username = string() %%% Password = string() @@ -91,25 +93,25 @@ get_prompt_regexp() -> %%% @doc Callback for ct_telnet.erl. %%% %%% <p>Setup telnet connection to a unix host.</p> -connect(ConnName,Ip,Port,Timeout,KeepAlive,Extra) -> +connect(ConnName,Ip,Port,Timeout,KeepAlive,TCPNoDelay,Extra) -> case Extra of {Username,Password} -> - connect1(ConnName,Ip,Port,Timeout,KeepAlive, + connect1(ConnName,Ip,Port,Timeout,KeepAlive,TCPNoDelay, Username,Password); KeyOrName -> case get_username_and_password(KeyOrName) of {ok,{Username,Password}} -> - connect1(ConnName,Ip,Port,Timeout,KeepAlive, + connect1(ConnName,Ip,Port,Timeout,KeepAlive,TCPNoDelay, Username,Password); Error -> Error end end. -connect1(Name,Ip,Port,Timeout,KeepAlive,Username,Password) -> +connect1(Name,Ip,Port,Timeout,KeepAlive,TCPNoDelay,Username,Password) -> start_gen_log("unix_telnet connect"), Result = - case ct_telnet_client:open(Ip,Port,Timeout,KeepAlive,Name) of + case ct_telnet_client:open(Ip,Port,Timeout,KeepAlive,TCPNoDelay,Name) of {ok,Pid} -> case ct_telnet:silent_teln_expect(Name,Pid,[], [prompt],?prx,[]) of diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_update_config_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_update_config_SUITE.erl index 9a924a66ac..5e4df0b3c2 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_update_config_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_update_config_SUITE.erl @@ -1,8 +1,8 @@ -%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
-%%
+%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. 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,46 +14,46 @@ %% 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(ct_update_config_SUITE).
-
--suite_defaults([{timetrap, {minutes, 10}}]).
-
-%% Note: This directive should only be used in test suites.
--compile(export_all).
-
--include("ct.hrl").
-
--define(now, os:timestamp()).
-
-%% Test server callback functions
-init_per_suite(Config) ->
- [{init_per_suite,?now}|Config].
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_testcase(_TestCase, Config) ->
- [{init_per_testcase,?now}|Config].
-
-end_per_testcase(_TestCase, _Config) ->
- ok.
-
-init_per_group(GroupName, Config) ->
- [{init_per_group,?now}|Config].
-
-end_per_group(GroupName, Config) ->
- ok.
-
-all() ->
- [{group,group1}].
-
-groups() ->
- [{group1,[],[test_case]}].
-
-%% Test cases starts here.
-test_case(Config) when is_list(Config) ->
- ok.
+%% +%% %CopyrightEnd% +%% + +-module(ct_update_config_SUITE). + +-suite_defaults([{timetrap, {minutes, 10}}]). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include("ct.hrl"). + +-define(now, ct_test_support:unique_timestamp()). + +%% Test server callback functions +init_per_suite(Config) -> + [{init_per_suite,?now}|Config]. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_TestCase, Config) -> + [{init_per_testcase,?now}|Config]. + +end_per_testcase(_TestCase, _Config) -> + ok. + +init_per_group(GroupName, Config) -> + [{init_per_group,?now}|Config]. + +end_per_group(GroupName, Config) -> + ok. + +all() -> + [{group,group1}]. + +groups() -> + [{group1,[],[test_case]}]. + +%% Test cases starts here. +test_case(Config) when is_list(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl index e5bb4f3ef6..8b64ff8060 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl @@ -90,7 +90,7 @@ id(Opts) -> gen_event:notify(?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, id, [Opts]}}), ct:log("~w:id called", [?MODULE]), - os:timestamp(). + ct_test_support:unique_timestamp(). %% @doc Called before init_per_suite is called. Note that this callback is %% only called if the CTH is added before init_per_suite is run (eg. in a test diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl index 5503bf85ae..928bedfed1 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl @@ -25,7 +25,7 @@ -include_lib("common_test/src/ct_util.hrl"). -include_lib("common_test/include/ct_event.hrl"). --define(now, os:timestamp()). +-define(now, ct_test_support:unique_timestamp()). %% CT Hooks -compile(export_all). diff --git a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl index 2994ce4a96..bf3eeee328 100644 --- a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl +++ b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl @@ -44,13 +44,29 @@ %% instance, the tests need to be performed on a separate node (or %% there will be clashes with logging processes etc). %%-------------------------------------------------------------------- +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{seconds,120}}]. + +all() -> + [ + pre_post_io + ]. + init_per_suite(Config) -> - DataDir = ?config(data_dir, Config), - CTH = filename:join(DataDir, "cth_ctrl.erl"), - ct:pal("Compiling ~p: ~p", - [CTH,compile:file(CTH,[{outdir,DataDir},debug_info])]), - ct_test_support:init_per_suite([{path_dirs,[DataDir]}, - {start_sasl,true} | Config]). + TTInfo = {_T,{_Scaled,ScaleVal}} = ct:get_timetrap_info(), + ct:pal("Timetrap info = ~w", [TTInfo]), + if ScaleVal > 1 -> + {skip,"Skip on systems running e.g. cover or debug!"}; + ScaleVal =< 1 -> + DataDir = ?config(data_dir, Config), + CTH = filename:join(DataDir, "cth_ctrl.erl"), + ct:pal("Compiling ~p: ~p", + [CTH,compile:file(CTH,[{outdir,DataDir}, + debug_info])]), + ct_test_support:init_per_suite([{path_dirs,[DataDir]}, + {start_sasl,true} | Config]) + end. end_per_suite(Config) -> ct_test_support:end_per_suite(Config). @@ -61,13 +77,6 @@ init_per_testcase(TestCase, Config) -> end_per_testcase(TestCase, Config) -> ct_test_support:end_per_testcase(TestCase, Config). -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [ - pre_post_io - ]. - %%-------------------------------------------------------------------- %% TEST CASES %%-------------------------------------------------------------------- @@ -90,31 +99,50 @@ pre_post_io(Config) -> %%!-------------------------------------------------------------------- spawn(fun() -> - ct:pal("CONTROLLER: Started!", []), + ct:pal("CONTROLLER: Starting test run #1...", []), %% --- test run 1 --- - ct:sleep(3000), - ct:pal("CONTROLLER: Handle remote events = true", []), - ok = ct_test_support:ct_rpc({cth_log_redirect, - handle_remote_events, - [true]}, Config), - ct:sleep(2000), - ct:pal("CONTROLLER: Proceeding with test run #1!", []), + try_loop(ct_test_support, ct_rpc, [{cth_log_redirect, + handle_remote_events, + [true]}, Config], 3000), + CTLoggerPid1 = ct_test_support:ct_rpc({erlang,whereis, + [ct_logs]}, Config), + ct:pal("CONTROLLER: Logger = ~w~nHandle remote events = true", + [CTLoggerPid1]), + ct:sleep(5000), + ct:pal("CONTROLLER: Proceeding with test run #1...", []), ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), ct:sleep(6000), - ct:pal("CONTROLLER: Proceeding with shutdown #1!", []), + ct:pal("CONTROLLER: Proceeding with shutdown #1...", []), ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), + try_loop(fun() -> + false = ct_test_support:ct_rpc({erlang, + is_process_alive, + [CTLoggerPid1]}, + Config) + end, 3000), + ct:pal("CONTROLLER: Shutdown #1 complete!", []), + ct:pal("CONTROLLER: Starting test run #2...", []), %% --- test run 2 --- - ct:sleep(3000), - ct:pal("CONTROLLER: Handle remote events = true", []), - ok = ct_test_support:ct_rpc({cth_log_redirect, - handle_remote_events, - [true]}, Config), - ct:sleep(2000), - ct:pal("CONTROLLER: Proceeding with test run #2!", []), + try_loop(ct_test_support, ct_rpc, [{cth_log_redirect, + handle_remote_events, + [true]}, Config], 3000), + CTLoggerPid2 = ct_test_support:ct_rpc({erlang,whereis, + [ct_logs]}, Config), + ct:pal("CONTROLLER: Logger = ~w~nHandle remote events = true", + [CTLoggerPid2]), + ct:sleep(5000), + ct:pal("CONTROLLER: Proceeding with test run #2...", []), ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), ct:sleep(6000), - ct:pal("CONTROLLER: Proceeding with shutdown #2!", []), - ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config) + ct:pal("CONTROLLER: Proceeding with shutdown #2...", []), + ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), + try_loop(fun() -> + false = ct_test_support:ct_rpc({erlang, + is_process_alive, + [CTLoggerPid2]}, + Config) + end, 3000), + ct:pal("CONTROLLER: Shutdown #2 complete!", []) end), ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), @@ -157,7 +185,7 @@ pre_post_io(Config) -> Counters end, {pre,0,0,0,0}, Ts), [_|Counters] = tuple_to_list(PrePostIOEntries), - ct:log("Entries in the Pre/Post Test IO Log: ~p", [Counters]), + ct:pal("Entries in the Pre/Post Test IO Log: ~w", [Counters]), case [C || C <- Counters, C < 2] of [] -> ok; @@ -183,7 +211,7 @@ pre_post_io(Config) -> [LogN,ErrN+1]; (_, Counters) -> Counters end, [0,0], Ts), - ct:log("Entries in the Unexpected IO Log: ~p", [UnexpIOEntries]), + ct:log("Entries in the Unexpected IO Log: ~w", [UnexpIOEntries]), case [N || N <- UnexpIOEntries, N < 2] of [] -> ok; @@ -208,6 +236,38 @@ setup(Test, Config) -> reformat(Events, EH) -> ct_test_support:reformat(Events, EH). +try_loop(_Fun, 0) -> + ct:pal("WARNING! Fun never succeeded!", []), + gave_up; +try_loop(Fun, N) -> + try Fun() of + {error,_} -> + timer:sleep(10), + try_loop(Fun, N-1); + Result -> + Result + catch + _:_What -> + timer:sleep(10), + try_loop(Fun, N-1) + end. + +try_loop(M, F, _A, 0) -> + ct:pal("WARNING! ~w:~w never succeeded!", [M,F]), + gave_up; +try_loop(M, F, A, N) -> + try apply(M, F, A) of + {error,_} -> + timer:sleep(10), + try_loop(M, F, A, N-1); + Result -> + Result + catch + _:_ -> + timer:sleep(10), + try_loop(M, F, A, N-1) + end. + %%%----------------------------------------------------------------- %%% TEST EVENTS %%%----------------------------------------------------------------- diff --git a/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl index b8595b40b9..66a950c178 100644 --- a/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl +++ b/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl @@ -53,8 +53,7 @@ init(_Id, _Opts) -> receive {?MODULE,proceed} -> ok after - 10000 -> - ok + 10000 -> ok end, {ok,[],ct_last}. @@ -66,8 +65,7 @@ terminate(_State) -> receive {?MODULE,proceed} -> ok after - 10000 -> - ok + 10000 -> ok end, stop_external_logger(cth_logger), stop_dispatcher(), @@ -94,7 +92,7 @@ init_logger(Name) -> logger_loop(N) -> ct:log("Logger iteration: ~p", [N]), error_logger:error_report(N), - timer:sleep(250), + timer:sleep(100), logger_loop(N+1). %%%----------------------------------------------------------------- diff --git a/lib/common_test/test/ct_surefire_SUITE.erl b/lib/common_test/test/ct_surefire_SUITE.erl index 82ab1c19bb..922978fc4b 100644 --- a/lib/common_test/test/ct_surefire_SUITE.erl +++ b/lib/common_test/test/ct_surefire_SUITE.erl @@ -49,8 +49,11 @@ %% there will be clashes with logging processes etc). %%-------------------------------------------------------------------- init_per_suite(Config) -> - Config1 = ct_test_support:init_per_suite(Config), - Config1. + DataDir = ?config(data_dir,Config), + Hook = "fail_pre_init_per_suite.erl", + io:format("Compiling ~p: ~p~n", + [Hook, compile:file(Hook,[{outdir,DataDir},debug_info])]), + ct_test_support:init_per_suite([{path_dirs,[DataDir]}|Config]). end_per_suite(Config) -> ct_test_support:end_per_suite(Config). @@ -69,7 +72,8 @@ all() -> absolute_path, relative_path, url, - logdir + logdir, + fail_pre_init_per_suite ]. %%-------------------------------------------------------------------- @@ -107,6 +111,14 @@ logdir(Config) when is_list(Config) -> Path = "logdir.xml", run(logdir,[{cth_surefire,[{path,Path}]}],Path,Config,[{logdir,MyLogDir}]). +fail_pre_init_per_suite(Config) when is_list(Config) -> + DataDir = ?config(data_dir,Config), + Suites = [filename:join(DataDir,"pass_SUITE"), + filename:join(DataDir,"fail_SUITE")], + Path = "fail_pre_init_per_suite.xml", + run(fail_pre_init_per_suite,[fail_pre_init_per_suite, + {cth_surefire,[{path,Path}]}],Path,Config,[],Suites). + %%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -115,6 +127,8 @@ run(Case,CTHs,Report,Config) -> run(Case,CTHs,Report,Config,ExtraOpts) -> DataDir = ?config(data_dir, Config), Suite = filename:join(DataDir, "surefire_SUITE"), + run(Case,CTHs,Report,Config,ExtraOpts,Suite). +run(Case,CTHs,Report,Config,ExtraOpts,Suite) -> {Opts,ERPid} = setup([{suite,Suite},{ct_hooks,CTHs},{label,Case}|ExtraOpts], Config), ok = execute(Case, Opts, ERPid, Config), @@ -142,7 +156,6 @@ setup(Test, Config) -> execute(Name, Opts, ERPid, Config) -> ok = ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), - ct_test_support:log_events(Name, reformat(Events, ?eh), ?config(priv_dir, Config), @@ -166,10 +179,30 @@ events_to_check(_, 0) -> events_to_check(Test, N) -> test_events(Test) ++ events_to_check(Test, N-1). -test_events(_) -> - [{?eh,start_logging,'_'}, - {?eh,start_info,{1,1,9}}, - {?eh,tc_start,{surefire_SUITE,init_per_suite}}, +test_suite_events(fail_SUITE, TestStat) -> + [{?eh,tc_start,{ct_framework,init_per_suite}}, + {?eh,tc_done,{ct_framework,init_per_suite, + {failed,{error,pre_init_per_suite}}}}, + {?eh,tc_auto_skip, + {fail_SUITE,test_case, + {failed,{ct_framework,init_per_suite,{failed,pre_init_per_suite}}}}}, + {?eh,test_stats,TestStat}, + {?eh,tc_auto_skip, + {ct_framework,end_per_suite, + {failed,{ct_framework,init_per_suite,{failed,pre_init_per_suite}}}}}]. + +test_suite_events(fail_SUITE) -> + test_suite_events(fail_SUITE, {0,0,{0,1}}); +test_suite_events(pass_SUITE) -> + [{?eh,tc_start,{ct_framework,init_per_suite}}, + {?eh,tc_done,{ct_framework,init_per_suite,ok}}, + {?eh,tc_start,{pass_SUITE,test_case}}, + {?eh,tc_done,{pass_SUITE,test_case,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{ct_framework,end_per_suite}}, + {?eh,tc_done,{ct_framework,end_per_suite,ok}}]; +test_suite_events(_) -> + [{?eh,tc_start,{surefire_SUITE,init_per_suite}}, {?eh,tc_done,{surefire_SUITE,init_per_suite,ok}}, {?eh,tc_start,{surefire_SUITE,tc_ok}}, {?eh,tc_done,{surefire_SUITE,tc_ok,ok}}, @@ -216,9 +249,18 @@ test_events(_) -> {surefire_SUITE,init_per_group, {'EXIT',all_cases_should_be_skipped}}}}}], {?eh,tc_start,{surefire_SUITE,end_per_suite}}, - {?eh,tc_done,{surefire_SUITE,end_per_suite,ok}}, - {?eh,stop_logging,[]}]. - + {?eh,tc_done,{surefire_SUITE,end_per_suite,ok}}]. + +test_events(fail_pre_init_per_suite) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,start_info,{2,2,2}}] ++ + test_suite_events(pass_SUITE) ++ + test_suite_events(fail_SUITE, {1,0,{0,1}}) ++ + [{?eh,stop_logging,[]}]; +test_events(Test) -> + [{?eh,start_logging,'_'}, {?eh,start_info,{1,1,9}}] ++ + test_suite_events(Test) ++ + [{?eh,stop_logging,[]}]. %%%----------------------------------------------------------------- %%% Check generated xml log files @@ -251,9 +293,9 @@ do_check_xml(Case,[Xml|Xmls]) -> {E,_} = xmerl_scan:file(Xml), Expected = events_to_result(lists:flatten(test_events(Case))), ParseResult = testsuites(Case,E), - ct:log("Expecting: ~p~n",[[Expected]]), + ct:log("Expecting: ~p~n",[Expected]), ct:log("Actual : ~p~n",[ParseResult]), - [Expected] = ParseResult, + Expected = ParseResult, do_check_xml(Case,Xmls); do_check_xml(_,[]) -> ok. @@ -265,7 +307,8 @@ testsuites(Case,#xmlElement{name=testsuites,content=TS}) -> testsuite(Case,TS). testsuite(Case,[#xmlElement{name=testsuite,content=TC,attributes=A}|TS]) -> - {ET,EF,ES} = events_to_numbers(lists:flatten(test_events(Case))), + TestSuiteEvents = test_suite_events(get_ts_name(A)), + {ET,EF,ES} = events_to_numbers(lists:flatten(TestSuiteEvents)), {T,E,F,S} = get_numbers_from_attrs(A,false,false,false,false), ct:log("Expecting total:~p, error:~p, failure:~p, skipped:~p~n",[ET,0,EF,ES]), ct:log("Actual total:~p, error:~p, failure:~p, skipped:~p~n",[T,E,F,S]), @@ -318,14 +361,32 @@ failed_or_skipped([]) -> %% Testsuites = [Testsuite] %% Testsuite = [Testcase] %% Testcase = [] | [f] | [s], indicating ok, failed and skipped respectively -events_to_result([{?eh,tc_done,{_Suite,_Case,R}}|E]) -> - [result(R)|events_to_result(E)]; -events_to_result([{?eh,tc_auto_skip,_}|E]) -> - [[s]|events_to_result(E)]; -events_to_result([_|E]) -> - events_to_result(E); -events_to_result([]) -> - []. +events_to_result(E) -> + events_to_result(E, []). + +events_to_result([{?eh,tc_auto_skip,{_Suite,init_per_suite,_}}|E], Result) -> + {Suite,Rest} = events_to_result1(E), + events_to_result(Rest, [[[s]|Suite]|Result]); +events_to_result([{?eh,tc_done,{_Suite,init_per_suite,R}}|E], Result) -> + {Suite,Rest} = events_to_result1(E), + events_to_result(Rest, [[result(R)|Suite]|Result]); +events_to_result([_|E], Result) -> + events_to_result(E, Result); +events_to_result([], Result) -> + Result. + +events_to_result1([{?eh,tc_auto_skip,{_Suite, end_per_suite,_}}|E]) -> + {[[s]],E}; +events_to_result1([{?eh,tc_done,{_Suite, end_per_suite,R}}|E]) -> + {[result(R)],E}; +events_to_result1([{?eh,tc_done,{_Suite,_Case,R}}|E]) -> + {Suite,Rest} = events_to_result1(E), + {[result(R)|Suite],Rest}; +events_to_result1([{?eh,tc_auto_skip,_}|E]) -> + {Suite,Rest} = events_to_result1(E), + {[[s]|Suite],Rest}; +events_to_result1([_|E]) -> + events_to_result1(E). result(ok) ->[]; result({skipped,_}) -> [s]; @@ -374,3 +435,7 @@ del_files(Dir,[F0|Fs] ) -> end; del_files(_,[]) -> ok. + +get_ts_name(Attributes) -> + {_,name,_,_,_,_,_,_,Name,_} = lists:keyfind(name, 2, Attributes), + list_to_atom(Name). diff --git a/lib/common_test/test/ct_surefire_SUITE_data/fail_SUITE.erl b/lib/common_test/test/ct_surefire_SUITE_data/fail_SUITE.erl new file mode 100644 index 0000000000..3f5f42c054 --- /dev/null +++ b/lib/common_test/test/ct_surefire_SUITE_data/fail_SUITE.erl @@ -0,0 +1,28 @@ +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. 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(fail_SUITE). +-include_lib("common_test/include/ct.hrl"). + +-export([all/0, test_case/1]). + +all() -> + [test_case]. + +test_case(_Config) -> + ok. diff --git a/lib/common_test/test/ct_surefire_SUITE_data/fail_pre_init_per_suite.erl b/lib/common_test/test/ct_surefire_SUITE_data/fail_pre_init_per_suite.erl new file mode 100644 index 0000000000..ff278db378 --- /dev/null +++ b/lib/common_test/test/ct_surefire_SUITE_data/fail_pre_init_per_suite.erl @@ -0,0 +1,47 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. 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% +%% + +%%% This tests that the correct XML is produced when pre_init_per_suite +%%% fails in a hook +-module(fail_pre_init_per_suite). + +%% CT Hooks +-export([init/2, pre_init_per_suite/3]). + +-type config() :: proplists:proplist(). +-type reason() :: term(). +-type skip_or_fail() :: skip | auto_skip | fail | 'EXIT'. + +-record(state, {}). + +-spec init(Id :: term(), Opts :: proplists:proplist()) -> + {ok, proplists:proplist()}. +init(_Id, Opts) -> + {ok, Opts}. + +-spec pre_init_per_suite(Suite :: atom(), + Config :: config(), + State :: #state{}) -> + {config() | {skip_or_fail(), reason()}, NewState :: #state{}}. +pre_init_per_suite(fail_SUITE, _Config, State) -> + {{fail, pre_init_per_suite}, State}; +pre_init_per_suite(_Suite, Config, State) -> + {Config, State}. + diff --git a/lib/common_test/test/ct_surefire_SUITE_data/pass_SUITE.erl b/lib/common_test/test/ct_surefire_SUITE_data/pass_SUITE.erl new file mode 100644 index 0000000000..74ed5b730e --- /dev/null +++ b/lib/common_test/test/ct_surefire_SUITE_data/pass_SUITE.erl @@ -0,0 +1,28 @@ +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. 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(pass_SUITE). +-include_lib("common_test/include/ct.hrl"). + +-export([all/0, test_case/1]). + +all() -> + [test_case]. + +test_case(_Config) -> + ok. diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index 8e7ac9395c..493fa82c79 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -43,6 +43,8 @@ -export([random_error/1]). +-export([unique_timestamp/0]). + -include_lib("kernel/include/file.hrl"). %%%----------------------------------------------------------------- @@ -110,7 +112,8 @@ start_slave(NodeName, Config, Level) -> undefined -> []; Ds -> Ds end, - PathDirs = [PrivDir,TSDir | AddPathDirs], + TestSupDir = filename:dirname(code:which(?MODULE)), + PathDirs = [PrivDir,TSDir,TestSupDir | AddPathDirs], [true = rpc:call(CTNode, code, add_patha, [D]) || D <- PathDirs], test_server:format(Level, "Dirs added to code path (on ~w):~n", [CTNode]), @@ -1430,7 +1433,21 @@ rm_files([F | Fs]) -> end; rm_files([]) -> ok. - + +unique_timestamp() -> + unique_timestamp(os:timestamp(), 100000). + +unique_timestamp(TS, 0) -> + TS; +unique_timestamp(TS0, N) -> + case os:timestamp() of + TS0 -> + timer:sleep(1), + unique_timestamp(TS0, N-1); + TS1 -> + TS1 + end. + %%%----------------------------------------------------------------- %%% slave_stop(Node) -> diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index bcd31293fb..f33fd658e8 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.12 +COMMON_TEST_VSN = 1.12.1 diff --git a/lib/inets/doc/src/mod_esi.xml b/lib/inets/doc/src/mod_esi.xml index 66c59a0c60..c2fb60c416 100644 --- a/lib/inets/doc/src/mod_esi.xml +++ b/lib/inets/doc/src/mod_esi.xml @@ -23,10 +23,6 @@ </legalnotice> <title>mod_esi</title> - <prepared>Joakim Grebenö</prepared> - <docno></docno> - <date>1997-10-14</date> - <rev>2.2</rev> <file>mod_esi.sgml</file> </header> <module>mod_esi</module> @@ -39,6 +35,56 @@ <marker id="deliver"></marker> </description> + <section> + <title>DATA TYPES</title> + <p>The following data types are used in the functions for mod_esi:</p> + + <taglist> + <tag><c>env() = </c></tag> + <item> <p><c>{EnvKey()::atom(), Value::term()}</c></p> + </item> + + <p>Currently supported key value pairs</p> + <taglist> + + <tag><c>{server_software, string()}</c></tag> + <item><p>Indicates the inets version.</p></item> + + <tag><c>{server_name, string()}</c></tag> + <item><p>The local hostname. </p></item> + + <tag><c>{gateway_interface, string()}</c></tag> + <item><p>Legacy string used in CGI, just ignore.</p> </item> + + <tag><c>{server_protocol, string()}</c></tag> + <item><p> HTTP version, currently "HTTP/1.1"</p></item> + + <tag>{server_port, integer()}</tag> + <item><p>Servers port number.</p></item> + + <tag><c>{request_method, "GET | "PUT" | "DELETE | "POST" | "PATCH"}</c></tag> + + <tag><c>{remote_adress, inet:ip_address()} </c></tag> + <item><p>The clients ip address.</p></item> + + <tag><c>{peer_cert, undefined | no_peercert | DER:binary()</c></tag> + <item> + <p>For TLS connections where client certificates are used this will + be an ASN.1 DER-encoded X509-certificate as an Erlang binary. + If client certificates are not used the value will be <c>no_peercert</c>, + and if TLS is not used (HTTP or connection is lost due to network failure) + the value will be <c>undefined</c>. + </p></item> + + <tag><c>{script_name, string()}</c></tag> + <item><p>Request URI</p></item> + + <tag><c>{http_LowerCaseHTTPHeaderName, string()}</c></tag> + <item><p>example: {http_content_type, "text/html"}</p></item> + </taglist> + + </taglist> + <funcs> <func> <name>deliver(SessionID, Data) -> ok | {error, Reason}</name> @@ -63,11 +109,11 @@ overhead. Do not assume anything about the data type of <c>SessionID</c>. <c>SessionID</c> must be the value given as input to the ESI callback function that you implemented.</p> - </note> + </note> </desc> </func> </funcs> - + </section> <section> <title>ESI Callback Functions</title> </section> @@ -78,9 +124,7 @@ to the server process by calling <c>mod_esi:deliver/2</c>.</fsummary> <type> <v>SessionID = term()</v> - <v>Env = [EnvironmentDirectives] ++ ParsedHeader</v> - <v>EnvironmentDirectives = {Key,Value}</v> - <v>Key = query_string | content_length | server_software | gateway_interface | server_protocol | server_port | request_method | remote_addr | script_name</v> + <v>Env = env()</v> <v>Input = string()</v> </type> <desc> @@ -111,9 +155,7 @@ <fsummary>Creates a dynamic web page and returns it as a list. This function is deprecated and is only kept for backwards compatibility.</fsummary> <type> - <v>Env = [EnvironmentDirectives] ++ ParsedHeader</v> - <v>EnvironmentDirectives = {Key,Value}</v> - <v>Key = query_string | content_length | server_software | gateway_interface | server_protocol | server_port | request_method | remote_addr | script_name.</v> + <v>Env = env()</v> <v>Input = string()</v> <v>Response = string()</v> </type> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 25b427a036..00311c57ff 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,55 @@ <file>notes.xml</file> </header> - <section><title>Inets 6.2</title> + <section><title>Inets 6.2.3</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Put back unused module inets_regexp and remove it in OTP + 19 instead as it is an incompatibility, although it is an + undocumented module and should not affect other + applications.</p> + <p> + Own Id: OTP-13533</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.2.2</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add environment information item peer_cert to mod_esi</p> + <p> + Own Id: OTP-13510</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Mend ipv6_host_with_brackets option in httpc</p> + <p> + Own Id: OTP-13417</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.2</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index 85663b5ded..4554881d79 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -556,7 +556,7 @@ handle_request(Method, Url, Request = #request{from = Receiver, scheme = Scheme, - address = {Host, Port}, + address = {host_address(Host, BracketedHost), Port}, path = MaybeEscPath, pquery = MaybeEscQuery, method = Method, @@ -1268,3 +1268,7 @@ child_name(Pid, [_ | Children]) -> %% d(_, _, _) -> %% ok. +host_address(Host, false) -> + Host; +host_address(Host, true) -> + string:strip(string:strip(Host, right, $]), left, $[). diff --git a/lib/inets/src/http_server/httpd_example.erl b/lib/inets/src/http_server/httpd_example.erl index 0222487a4b..ad29b5b29a 100644 --- a/lib/inets/src/http_server/httpd_example.erl +++ b/lib/inets/src/http_server/httpd_example.erl @@ -20,7 +20,7 @@ %% -module(httpd_example). -export([print/1]). --export([get/2, post/2, yahoo/2, test1/2, get_bin/2]). +-export([get/2, post/2, yahoo/2, test1/2, get_bin/2, peer/2]). -export([newformat/3]). %% These are used by the inets test-suite @@ -94,10 +94,26 @@ default(Env,Input) -> io_lib:format("~p",[httpd:parse_query(Input)]),"\n", footer()]. +peer(Env, Input) -> + Header = + case proplists:get_value(peer_cert, Env) of + undefined -> + header("text/html", "Peer-Cert-Exist:false"); + _ -> + header("text/html", "Peer-Cert-Exist:true") + end, + [Header, + top("Test peer_cert environment option"), + "<B>Peer cert:</B> ", + io_lib:format("~p",[proplists:get_value(peer_cert, Env)]),"\n", + footer()]. + header() -> header("text/html"). header(MimeType) -> "Content-type: " ++ MimeType ++ "\r\n\r\n". +header(MimeType, Other) -> + "Content-type: " ++ MimeType ++ "\r\n" ++ Other ++ "\r\n\r\n". top(Title) -> "<HTML> diff --git a/lib/inets/src/http_server/httpd_script_env.erl b/lib/inets/src/http_server/httpd_script_env.erl index 232bf96bd4..1c5d828b46 100644 --- a/lib/inets/src/http_server/httpd_script_env.erl +++ b/lib/inets/src/http_server/httpd_script_env.erl @@ -61,6 +61,19 @@ which_port(#mod{config_db = ConfigDb}) -> which_peername(#mod{init_data = #init_data{peername = {_, RemoteAddr}}}) -> RemoteAddr. +which_peercert(#mod{socket_type = {Type, _}, socket = Socket}) when Type == essl; + Type == ssl -> + case ssl:peercert(Socket) of + {ok, Cert} -> + Cert; + {error, no_peercert} -> + no_peercert; + _ -> + undefined + end; +which_peercert(_) -> %% Not an ssl connection + undefined. + which_resolve(#mod{init_data = #init_data{resolve = Resolve}}) -> Resolve. @@ -78,6 +91,7 @@ create_basic_elements(esi, ModData) -> {server_port, which_port(ModData)}, {request_method, which_method(ModData)}, {remote_addr, which_peername(ModData)}, + {peer_cert, which_peercert(ModData)}, {script_name, which_request_uri(ModData)}]; create_basic_elements(cgi, ModData) -> diff --git a/lib/inets/src/inets_app/Makefile b/lib/inets/src/inets_app/Makefile index 0a4b625b6a..7f51676dc5 100644 --- a/lib/inets/src/inets_app/Makefile +++ b/lib/inets/src/inets_app/Makefile @@ -49,7 +49,8 @@ MODULES = \ inets_sup \ inets_trace \ inets_lib \ - inets_time_compat + inets_time_compat \ + inets_regexp INTERNAL_HRL_FILES = inets_internal.hrl EXTERNAL_HRL_FILES = ../../include/httpd.hrl \ diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src index 2f213794a3..c09139872f 100644 --- a/lib/inets/src/inets_app/inets.app.src +++ b/lib/inets/src/inets_app/inets.app.src @@ -29,6 +29,7 @@ inets_trace, inets_lib, inets_time_compat, + inets_regexp, %% FTP ftp, diff --git a/lib/inets/src/inets_app/inets_regexp.erl b/lib/inets/src/inets_app/inets_regexp.erl new file mode 100644 index 0000000000..fc1608bc5a --- /dev/null +++ b/lib/inets/src/inets_app/inets_regexp.erl @@ -0,0 +1,414 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009. 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(inets_regexp). + +-export([parse/1, match/2, first_match/2, split/2, sub/3, gsub/3]). + + +%%%========================================================================= +%%% API +%%%========================================================================= + +%% parse(RegExp) -> {ok, RE} | {error, E}. +%% Parse the regexp described in the string RegExp. + +parse(S) -> + case (catch reg(S)) of + {R, []} -> + {ok, R}; + {_R, [C|_]} -> + {error, {illegal, [C]}}; + {error, E} -> + {error, E} + end. + + +%% Find the longest match of RegExp in String. + +match(S, RegExp) when is_list(RegExp) -> + case parse(RegExp) of + {ok,RE} -> match(S, RE); + {error,E} -> {error,E} + end; +match(S, RE) -> + case match(RE, S, 1, 0, -1) of + {Start,Len} when Len >= 0 -> + {match, Start, Len}; + {_Start,_Len} -> + nomatch + end. + +%% Find the first match of RegExp in String. + +first_match(S, RegExp) when is_list(RegExp) -> + case parse(RegExp) of + {ok, RE} -> + first_match(S, RE); + {error, E} -> + {error, E} + end; +first_match(S, RE) -> + case first_match(RE, S, 1) of + {Start,Len} when Len >= 0 -> + {match, Start,Len}; + nomatch -> + nomatch + end. + +first_match(RE, S, St) when S =/= [] -> + case re_apply(S, St, RE) of + {match, P, _Rest} -> + {St, P-St}; + nomatch -> + first_match(RE, tl(S), St+1) + end; +first_match(_RE, [], _St) -> + nomatch. + + +match(RE, S, St, Pos, L) -> + case first_match(RE, S, St) of + {St1, L1} -> + Nst = St1 + 1, + if L1 > L -> + match(RE, lists:nthtail(Nst-St, S), Nst, St1, L1); + true -> + match(RE, lists:nthtail(Nst-St, S), Nst, Pos, L) + end; + nomatch -> + {Pos, L} + end. + + +%% Split a string into substrings where the RegExp describes the +%% field seperator. The RegExp " " is specially treated. + +split(String, " ") -> %This is really special + {ok, RE} = parse("[ \t]+"), + case split_apply(String, RE, true) of + [[]|Ss] -> + {ok,Ss}; + Ss -> + {ok,Ss} + end; +split(String, RegExp) when is_list(RegExp) -> + case parse(RegExp) of + {ok, RE} -> + {ok, split_apply(String, RE, false)}; + {error, E} -> + {error,E} + end; +split(String, RE) -> + {ok, split_apply(String, RE, false)}. + + +%% Substitute the first match of the regular expression RegExp +%% with the string Replace in String. Accept pre-parsed regular +%% expressions. + +sub(String, RegExp, Rep) when is_list(RegExp) -> + case parse(RegExp) of + {ok, RE} -> + sub(String, RE, Rep); + {error, E} -> + {error, E} + end; +sub(String, RE, Rep) -> + Ss = sub_match(String, RE, 1), + {ok, sub_repl(Ss, Rep, String, 1), length(Ss)}. + + +%% Substitute every match of the regular expression RegExp with +%% the string New in String. Accept pre-parsed regular expressions. + +gsub(String, RegExp, Rep) when is_list(RegExp) -> + case parse(RegExp) of + {ok, RE} -> + gsub(String, RE, Rep); + {error, E} -> + {error, E} + end; +gsub(String, RE, Rep) -> + Ss = matches(String, RE, 1), + {ok, sub_repl(Ss, Rep, String, 1), length(Ss)}. + + +%%%======================================================================== +%%% Internal functions +%%%======================================================================== + +%% This is the regular expression grammar used. It is equivalent to the +%% one used in AWK, except that we allow ^ $ to be used anywhere and fail +%% in the matching. +%% +%% reg -> reg1 : '$1'. +%% reg1 -> reg1 "|" reg2 : {'or','$1','$2'}. +%% reg1 -> reg2 : '$1'. +%% reg2 -> reg2 reg3 : {concat,'$1','$2'}. +%% reg2 -> reg3 : '$1'. +%% reg3 -> reg3 "*" : {kclosure,'$1'}. +%% reg3 -> reg3 "+" : {pclosure,'$1'}. +%% reg3 -> reg3 "?" : {optional,'$1'}. +%% reg3 -> reg4 : '$1'. +%% reg4 -> "(" reg ")" : '$2'. +%% reg4 -> "\\" char : '$2'. +%% reg4 -> "^" : bos. +%% reg4 -> "$" : eos. +%% reg4 -> "." : char. +%% reg4 -> "[" class "]" : {char_class,char_class('$2')} +%% reg4 -> "[" "^" class "]" : {comp_class,char_class('$3')} +%% reg4 -> "\"" chars "\"" : char_string('$2') +%% reg4 -> char : '$1'. +%% reg4 -> empty : epsilon. +%% The grammar of the current regular expressions. The actual parser +%% is a recursive descent implementation of the grammar. + +reg(S) -> reg1(S). + +%% reg1 -> reg2 reg1' +%% reg1' -> "|" reg2 +%% reg1' -> empty + +reg1(S0) -> + {L,S1} = reg2(S0), + reg1p(S1, L). + +reg1p([$||S0], L) -> + {R,S1} = reg2(S0), + reg1p(S1, {'or',L,R}); +reg1p(S, L) -> {L,S}. + +%% reg2 -> reg3 reg2' +%% reg2' -> reg3 +%% reg2' -> empty + +reg2(S0) -> + {L,S1} = reg3(S0), + reg2p(S1, L). + +reg2p([C|S0], L) when (C =/= $|) andalso (C =/= $)) -> + {R,S1} = reg3([C|S0]), + reg2p(S1, {concat,L,R}); +reg2p(S, L) -> {L,S}. + +%% reg3 -> reg4 reg3' +%% reg3' -> "*" reg3' +%% reg3' -> "+" reg3' +%% reg3' -> "?" reg3' +%% reg3' -> empty + +reg3(S0) -> + {L,S1} = reg4(S0), + reg3p(S1, L). + +reg3p([$*|S], L) -> reg3p(S, {kclosure,L}); +reg3p([$+|S], L) -> reg3p(S, {pclosure,L}); +reg3p([$?|S], L) -> reg3p(S, {optional,L}); +reg3p(S, L) -> {L,S}. + +reg4([$(|S0]) -> + case reg(S0) of + {R,[$)|S1]} -> {R,S1}; + {_R,_S} -> throw({error,{unterminated,"("}}) + end; +reg4([$\\,O1,O2,O3|S]) + when ((O1 >= $0) andalso + (O1 =< $7) andalso + (O2 >= $0) andalso + (O2 =< $7) andalso + (O3 >= $0) andalso + (O3 =< $7)) -> + {(O1*8 + O2)*8 + O3 - 73*$0,S}; +reg4([$\\,C|S]) -> + {escape_char(C),S}; +reg4([$\\]) -> + throw({error, {unterminated,"\\"}}); +reg4([$^|S]) -> + {bos,S}; +reg4([$$|S]) -> + {eos,S}; +reg4([$.|S]) -> + {{comp_class,"\n"},S}; +reg4("[^" ++ S0) -> + case char_class(S0) of + {Cc,[$]|S1]} -> {{comp_class,Cc},S1}; + {_Cc,_S} -> throw({error,{unterminated,"["}}) + end; +reg4([$[|S0]) -> + case char_class(S0) of + {Cc,[$]|S1]} -> {{char_class,Cc},S1}; + {_Cc,_S1} -> throw({error,{unterminated,"["}}) + end; +reg4([C|S]) + when (C =/= $*) andalso (C =/= $+) andalso (C =/= $?) andalso (C =/= $]) -> + {C, S}; +reg4([C|_S]) -> + throw({error,{illegal,[C]}}); +reg4([]) -> + {epsilon,[]}. + +escape_char($n) -> $\n; %\n = LF +escape_char($r) -> $\r; %\r = CR +escape_char($t) -> $\t; %\t = TAB +escape_char($v) -> $\v; %\v = VT +escape_char($b) -> $\b; %\b = BS +escape_char($f) -> $\f; %\f = FF +escape_char($e) -> $\e; %\e = ESC +escape_char($s) -> $\s; %\s = SPACE +escape_char($d) -> $\d; %\d = DEL +escape_char(C) -> C. + +char_class([$]|S]) -> char_class(S, [$]]); +char_class(S) -> char_class(S, []). + +char($\\, [O1,O2,O3|S]) when + O1 >= $0, O1 =< $7, O2 >= $0, O2 =< $7, O3 >= $0, O3 =< $7 -> + {(O1*8 + O2)*8 + O3 - 73*$0,S}; +char($\\, [C|S]) -> {escape_char(C),S}; +char(C, S) -> {C,S}. + +char_class([C1|S0], Cc) when C1 =/= $] -> + case char(C1, S0) of + {Cf,[$-,C2|S1]} when C2 =/= $] -> + case char(C2, S1) of + {Cl,S2} when Cf < Cl -> char_class(S2, [{Cf,Cl}|Cc]); + {Cl,_S2} -> throw({error,{char_class,[Cf,$-,Cl]}}) + end; + {C,S1} -> char_class(S1, [C|Cc]) + end; +char_class(S, Cc) -> {Cc,S}. + + +%% re_apply(String, StartPos, RegExp) -> re_app_res(). +%% +%% Apply the (parse of the) regular expression RegExp to String. If +%% there is a match return the position of the remaining string and +%% the string if else return 'nomatch'. BestMatch specifies if we want +%% the longest match, or just a match. +%% +%% StartPos should be the real start position as it is used to decide +%% if we ae at the beginning of the string. +%% +%% Pass two functions to re_apply_or so it can decide, on the basis +%% of BestMatch, whether to just any take any match or try both to +%% find the longest. This is slower but saves duplicatng code. + +re_apply(S, St, RE) -> re_apply(RE, [], S, St). + +re_apply(epsilon, More, S, P) -> %This always matches + re_apply_more(More, S, P); +re_apply({'or',RE1,RE2}, More, S, P) -> + re_apply_or(re_apply(RE1, More, S, P), + re_apply(RE2, More, S, P)); +re_apply({concat,RE1,RE2}, More, S0, P) -> + re_apply(RE1, [RE2|More], S0, P); +re_apply({kclosure,CE}, More, S, P) -> + %% Be careful with the recursion, explicitly do one call before + %% looping. + re_apply_or(re_apply_more(More, S, P), + re_apply(CE, [{kclosure,CE}|More], S, P)); +re_apply({pclosure,CE}, More, S, P) -> + re_apply(CE, [{kclosure,CE}|More], S, P); +re_apply({optional,CE}, More, S, P) -> + re_apply_or(re_apply_more(More, S, P), + re_apply(CE, More, S, P)); +re_apply(bos, More, S, 1) -> re_apply_more(More, S, 1); +re_apply(eos, More, [$\n|S], P) -> re_apply_more(More, S, P); +re_apply(eos, More, [], P) -> re_apply_more(More, [], P); +re_apply({char_class,Cc}, More, [C|S], P) -> + case in_char_class(C, Cc) of + true -> re_apply_more(More, S, P+1); + false -> nomatch + end; +re_apply({comp_class,Cc}, More, [C|S], P) -> + case in_char_class(C, Cc) of + true -> nomatch; + false -> re_apply_more(More, S, P+1) + end; +re_apply(C, More, [C|S], P) when is_integer(C) -> + re_apply_more(More, S, P+1); +re_apply(_RE, _More, _S, _P) -> nomatch. + +%% re_apply_more([RegExp], String, Length) -> re_app_res(). + +re_apply_more([RE|More], S, P) -> re_apply(RE, More, S, P); +re_apply_more([], S, P) -> {match,P,S}. + +%% in_char_class(Char, Class) -> bool(). + +in_char_class(C, [{C1,C2}|_Cc]) when C >= C1, C =< C2 -> true; +in_char_class(C, [C|_Cc]) -> true; +in_char_class(C, [_|Cc]) -> in_char_class(C, Cc); +in_char_class(_C, []) -> false. + +%% re_apply_or(Match1, Match2) -> re_app_res(). +%% If we want the best match then choose the longest match, else just +%% choose one by trying sequentially. + +re_apply_or({match,P1,S1}, {match,P2,_S2}) when P1 >= P2 -> {match,P1,S1}; +re_apply_or({match,_P1,_S1}, {match,P2,S2}) -> {match,P2,S2}; +re_apply_or(nomatch, R2) -> R2; +re_apply_or(R1, nomatch) -> R1. + + +matches(S, RE, St) -> + case first_match(RE, S, St) of + {St1,0} -> + [{St1,0}|matches(string:substr(S, St1+2-St), RE, St1+1)]; + {St1,L1} -> + [{St1,L1}|matches(string:substr(S, St1+L1+1-St), RE, St1+L1)]; + nomatch -> + [] + end. + +sub_match(S, RE, St) -> + case first_match(RE, S, St) of + {St1,L1} -> [{St1,L1}]; + nomatch -> [] + end. + +sub_repl([{St,L}|Ss], Rep, S, Pos) -> + Rs = sub_repl(Ss, Rep, S, St+L), + string:substr(S, Pos, St-Pos) ++ + sub_repl(Rep, string:substr(S, St, L), Rs); +sub_repl([], _Rep, S, Pos) -> + string:substr(S, Pos). + +sub_repl([$&|Rep], M, Rest) -> M ++ sub_repl(Rep, M, Rest); +sub_repl("\\&" ++ Rep, M, Rest) -> [$&|sub_repl(Rep, M, Rest)]; +sub_repl([C|Rep], M, Rest) -> [C|sub_repl(Rep, M, Rest)]; +sub_repl([], _M, Rest) -> Rest. + +split_apply(S, RE, Trim) -> split_apply(S, 1, RE, Trim, []). + +split_apply([], _P, _RE, true, []) -> + []; +split_apply([], _P, _RE, _T, Sub) -> + [lists:reverse(Sub)]; +split_apply(S, P, RE, T, Sub) -> + case re_apply(S, P, RE) of + {match,P,_Rest} -> + split_apply(tl(S), P+1, RE, T, [hd(S)|Sub]); + {match,P1,Rest} -> + [lists:reverse(Sub)|split_apply(Rest, P1, RE, T, [])]; + nomatch -> + split_apply(tl(S), P+1, RE, T, [hd(S)|Sub]) + end. diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 1d8a603981..93520c1cb4 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -755,7 +755,11 @@ esi(Config) when is_list(Config) -> %% Check "ErlScriptNoCache" directive (default: false) ok = http_status("GET /cgi-bin/erl/httpd_example:get ", Config, [{statuscode, 200}, - {no_header, "cache-control"}]). + {no_header, "cache-control"}]), + ok = http_status("GET /cgi-bin/erl/httpd_example:peer ", + Config, [{statuscode, 200}, + {header, "peer-cert-exist", peer(Config)}]). + %%------------------------------------------------------------------------- mod_esi_chunk_timeout(Config) when is_list(Config) -> ok = httpd_1_1:mod_esi_chunk_timeout(?config(type, Config), @@ -2065,3 +2069,11 @@ response_default_headers() -> {"X-Frame-Options", "SAMEORIGIN"}, %% Override built-in default {"Date", "Override-date"}]. + +peer(Config) -> + case proplists:get_value(type, Config) of + ssl -> + "true"; + _ -> + "false" + end.
\ No newline at end of file diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 3d25b328af..a0cf2a9c3f 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.2 +INETS_VSN = 6.2.3 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml index 149cd69559..18bb110104 100644 --- a/lib/mnesia/doc/src/notes.xml +++ b/lib/mnesia/doc/src/notes.xml @@ -39,7 +39,23 @@ thus constitutes one section in this document. The title of each section is the version number of Mnesia.</p> - <section><title>Mnesia 4.13.3</title> + <section><title>Mnesia 4.13.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Mnesia transactions could hang while waiting on a + response from a node who had stopped.</p> + <p> + Own Id: OTP-13423</p> + </item> + </list> + </section> + +</section> + +<section><title>Mnesia 4.13.3</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/mnesia/src/mnesia_tm.erl b/lib/mnesia/src/mnesia_tm.erl index e7ee938312..1d3eb87036 100644 --- a/lib/mnesia/src/mnesia_tm.erl +++ b/lib/mnesia/src/mnesia_tm.erl @@ -1692,13 +1692,10 @@ commit_participant(Coord, Tid, Bin, C0, DiscNs, _RamNs) -> ?eval_debug_fun({?MODULE, commit_participant, undo_prepare}, [{tid, Tid}]); - {'EXIT', _, _} -> + {'EXIT', _MnesiaTM, Reason} -> + reply(Coord, {do_abort, Tid, self(), {bad_commit,Reason}}), mnesia_recover:log_decision(D#decision{outcome = aborted}), - ?eval_debug_fun({?MODULE, commit_participant, exit_log_abort}, - [{tid, Tid}]), - mnesia_schema:undo_prepare_commit(Tid, C0), - ?eval_debug_fun({?MODULE, commit_participant, exit_undo_prepare}, - [{tid, Tid}]); + mnesia_schema:undo_prepare_commit(Tid, C0); Msg -> verbose("** ERROR ** commit_participant ~p, got unexpected msg: ~p~n", @@ -2210,8 +2207,6 @@ reconfigure_coordinators(N, [{Tid, [Store | _]} | Coordinators]) -> true -> send_mnesia_down(Tid, Store, N) end; - aborted -> - ignore; % avoid spurious mnesia_down messages _ -> %% Tell the coordinator about the mnesia_down send_mnesia_down(Tid, Store, N) diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk index 843d9d18d4..194bc439a0 100644 --- a/lib/mnesia/vsn.mk +++ b/lib/mnesia/vsn.mk @@ -1 +1 @@ -MNESIA_VSN = 4.13.3 +MNESIA_VSN = 4.13.4 diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index e5070bc247..1d6da17785 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -28,6 +28,53 @@ <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 7.3.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Correct cipher suites conversion and gaurd expression. + Caused problems with GCM cipher suites and client side + option to set signature_algorithms extention values.</p> + <p> + Own Id: OTP-13525</p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 7.3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Corrections to cipher suite handling using the 3 and 4 + tuple format in addition to commit + 89d7e21cf4ae988c57c8ef047bfe85127875c70c</p> + <p> + Own Id: OTP-13511</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Make values for the TLS-1.2 signature_algorithms + extension configurable</p> + <p> + Own Id: OTP-13261</p> + </item> + </list> + </section> + +</section> + <section><title>SSL 7.3</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 a76d46ee9b..e831f73530 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -421,7 +421,6 @@ fun(srp, Username :: string(), UserState :: term()) -> <warning><p>Using <c>{padding_check, boolean()}</c> makes TLS vulnerable to the Poodle attack.</p></warning> - </section> <section> @@ -522,9 +521,45 @@ fun(srp, Username :: string(), UserState :: term()) -> be supported by the server for the prevention to work. </p></warning> </item> - </taglist> + <tag><marker id="client_signature_algs"/><c>{signature_algs, [{hash(), ecdsa | rsa | dsa}]}</c></tag> + <item> + <p>In addition to the algorithms negotiated by the cipher + suite used for key exchange, payload encryption, message + authentication and pseudo random calculation, the TLS signature + algorithm extension <url + href="http://www.ietf.org/rfc/rfc5246.txt">Section 7.4.1.4.1 in RFC 5246</url> may be + used, from TLS 1.2, to negotiate which signature algorithm to use during the + TLS handshake. If no lower TLS versions than 1.2 are supported, + the client will send a TLS signature algorithm extension + with the algorithms specified by this option. + Defaults to + + <code>[ +%% SHA2 +{sha512, ecdsa}, +{sha512, rsa}, +{sha384, ecdsa}, +{sha384, rsa}, +{sha256, ecdsa}, +{sha256, rsa}, +{sha224, ecdsa}, +{sha224, rsa}, +%% SHA +{sha, ecdsa}, +{sha, rsa}, +{sha, dsa}, +%% MD5 +{md5, rsa} +]</code> + + The algorithms should be in the preferred order. + Selected signature algorithm can restrict which hash functions + that may be selected. + </p> + </item> + </taglist> </section> - + <section> <title>SSL OPTION DESCRIPTIONS - SERVER SIDE</title> @@ -651,6 +686,14 @@ fun(srp, Username :: string(), UserState :: term()) -> <item>If true, use the server's preference for cipher selection. If false (the default), use the client's preference. </item> + + <tag><c>{signature_algs, [{hash(), ecdsa | rsa | dsa}]}</c></tag> + <item><p> The algorithms specified by + this option will be the ones accepted by the server in a signature algorithm + negotiation, introduced in TLS-1.2. The algorithms will also be offered to the client if a + client certificate is requested. For more details see the <seealso marker="#client_signature_algs">corresponding client option</seealso>. + </p> </item> + </taglist> </section> diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 153d3fef48..e490de7eeb 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -196,8 +196,7 @@ hello(start, #state{host = Host, port = Port, role = client, {Record, State} = next_record(State1), next_state(hello, hello, Record, State); -hello(Hello = #client_hello{client_version = ClientVersion, - extensions = #hello_extensions{hash_signs = HashSigns}}, +hello(Hello = #client_hello{client_version = ClientVersion}, State = #state{connection_states = ConnectionStates0, port = Port, session = #session{own_certificate = Cert} = Session0, renegotiation = {Renegotiation, _}, @@ -209,9 +208,7 @@ hello(Hello = #client_hello{client_version = ClientVersion, {Version, {Type, Session}, ConnectionStates, #hello_extensions{ec_point_formats = EcPointFormats, - elliptic_curves = EllipticCurves} = ServerHelloExt} -> - HashSign = ssl_handshake:select_hashsign(HashSigns, Cert, - dtls_v1:corresponding_tls_version(Version)), + elliptic_curves = EllipticCurves} = ServerHelloExt, HashSign} -> ssl_connection:hello({common_client_hello, Type, ServerHelloExt, HashSign}, State#state{connection_states = ConnectionStates, negotiated_version = Version, diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index 22c0ce7a13..50c84b712f 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -94,7 +94,10 @@ hello(#server_hello{server_version = Version, random = Random, hello(#client_hello{client_version = ClientVersion}, _Options, {_,_,_,_,ConnectionStates,_}, _Renegotiation) -> %% Return correct typ to make dialyzer happy until we have time to make the real imp. - {ClientVersion, {new, #session{}}, ConnectionStates, #hello_extensions{}}. + HashSigns = tls_v1:default_signature_algs(dtls_v1:corresponding_tls_version(ClientVersion)), + {ClientVersion, {new, #session{}}, ConnectionStates, #hello_extensions{}, + %% Placeholder for real hasign handling + hd(HashSigns)}. %% hello(Address, Port, %% #ssl_tls{epoch = _Epoch, sequence_number = _Seq, diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 057906bcb3..11728128c4 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,9 +1,6 @@ %% -*- erlang -*- {"%VSN%", [ - {<<"7\\.2">>, [{load_module, tls_connection, soft_purge, soft_purge, []}, - {load_module, ssl_tls_dist_proxy, soft_purge, soft_purge, []} - ]}, {<<"7\\..*">>, [{restart_application, ssl}]}, {<<"6\\..*">>, [{restart_application, ssl}]}, {<<"5\\..*">>, [{restart_application, ssl}]}, @@ -11,9 +8,6 @@ {<<"3\\..*">>, [{restart_application, ssl}]} ], [ - {<<"7\\.2">>, [{load_module, tls_connection, soft_purge, soft_purge, []}, - {load_module, ssl_tls_dist_proxy, soft_purge, soft_purge, []} - ]}, {<<"7\\..*">>, [{restart_application, ssl}]}, {<<"6\\..*">>, [{restart_application, ssl}]}, {<<"5\\..*">>, [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 780bef5877..97a1e2b5a8 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -97,7 +97,7 @@ connect(Socket, SslOptions) when is_port(Socket) -> connect(Socket, SslOptions, infinity). connect(Socket, SslOptions0, Timeout) when is_port(Socket), - (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) -> + (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions0, {gen_tcp, tcp, tcp_closed, tcp_error}), EmulatedOptions = ssl_socket:emulated_options(), @@ -123,7 +123,7 @@ connect(Socket, SslOptions0, Timeout) when is_port(Socket), connect(Host, Port, Options) -> connect(Host, Port, Options, infinity). -connect(Host, Port, Options, Timeout) when (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) -> +connect(Host, Port, Options, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> try handle_options(Options, client) of {ok, Config} -> do_connect(Host,Port,Config,Timeout) @@ -173,7 +173,7 @@ transport_accept(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_, _} =CbInfo, connection_cb = ConnectionCb, ssl = SslOpts, - emulated = Tracker}}}, Timeout) when (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) -> + emulated = Tracker}}}, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> case Transport:accept(ListenSocket, Timeout) of {ok, Socket} -> {ok, EmOpts} = ssl_socket:get_emulated_opts(Tracker), @@ -206,25 +206,25 @@ transport_accept(#sslsocket{pid = {ListenSocket, ssl_accept(ListenSocket) -> ssl_accept(ListenSocket, infinity). -ssl_accept(#sslsocket{} = Socket, Timeout) when (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) -> +ssl_accept(#sslsocket{} = Socket, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> ssl_connection:handshake(Socket, Timeout); - -ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> + +ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> ssl_accept(ListenSocket, SslOptions, infinity). -ssl_accept(#sslsocket{} = Socket, [], Timeout) when (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity)-> +ssl_accept(#sslsocket{} = Socket, [], Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> ssl_accept(#sslsocket{} = Socket, Timeout); -ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts0, Timeout) when - (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity)-> - try - {ok, EmOpts, InheritedSslOpts} = ssl_socket:get_all_opts(Tracker), +ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts0, Timeout) when + (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> + try + {ok, EmOpts, InheritedSslOpts} = ssl_socket:get_all_opts(Tracker), SslOpts = handle_options(SslOpts0, InheritedSslOpts), ssl_connection:handshake(Socket, {SslOpts, emulated_socket_options(EmOpts, #socket_options{})}, Timeout) catch Error = {error, _Reason} -> Error end; ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket), - (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) -> + (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions, {gen_tcp, tcp, tcp_closed, tcp_error}), EmulatedOptions = ssl_socket:emulated_options(), @@ -252,17 +252,17 @@ close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _} Transport:close(ListenSocket). %%-------------------------------------------------------------------- --spec close(#sslsocket{}, integer() | {pid(), integer()}) -> term(). +-spec close(#sslsocket{}, timeout() | {pid(), integer()}) -> term(). %% %% Description: Close an ssl connection %%-------------------------------------------------------------------- -close(#sslsocket{pid = TLSPid}, - {Pid, Timeout} = DownGrade) when is_pid(TLSPid), - is_pid(Pid), - (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) -> +close(#sslsocket{pid = TLSPid}, + {Pid, Timeout} = DownGrade) when is_pid(TLSPid), + is_pid(Pid), + (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> ssl_connection:close(TLSPid, {close, DownGrade}); -close(#sslsocket{pid = TLSPid}, Timeout) when is_pid(TLSPid), - (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) -> +close(#sslsocket{pid = TLSPid}, Timeout) when is_pid(TLSPid), + (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> ssl_connection:close(TLSPid, {close, Timeout}); close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _}}}}, _) -> Transport:close(ListenSocket). @@ -286,7 +286,7 @@ send(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport, _, _, _} recv(Socket, Length) -> recv(Socket, Length, infinity). recv(#sslsocket{pid = Pid}, Length, Timeout) when is_pid(Pid), - (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity)-> + (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> ssl_connection:recv(Pid, Length, Timeout); recv(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _}}}}, _,_) when is_port(Listen)-> @@ -700,6 +700,10 @@ handle_options(Opts0, Role) -> srp_identity = handle_option(srp_identity, Opts, undefined), ciphers = handle_cipher_option(proplists:get_value(ciphers, Opts, []), RecordCb:highest_protocol_version(Versions)), + signature_algs = handle_hashsigns_option(proplists:get_value(signature_algs, Opts, + default_option_role(server, + tls_v1:default_signature_algs(Versions), Role)), + RecordCb:highest_protocol_version(Versions)), %% Server side option reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), reuse_sessions = handle_option(reuse_sessions, Opts, true), @@ -749,7 +753,7 @@ handle_options(Opts0, Role) -> alpn_preferred_protocols, next_protocols_advertised, client_preferred_next_protocols, log_alert, server_name_indication, honor_cipher_order, padding_check, crl_check, crl_cache, - fallback], + fallback, signature_algs], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) @@ -989,6 +993,18 @@ validate_option(crl_cache, {Cb, {_Handle, Options}} = Value) when is_atom(Cb) an validate_option(Opt, Value) -> throw({error, {options, {Opt, Value}}}). +handle_hashsigns_option(Value, {Major, Minor} = Version) when is_list(Value) + andalso Major >= 3 andalso Minor >= 3-> + case tls_v1:signature_algs(Version, Value) of + [] -> + throw({error, {options, no_supported_algorithms, {signature_algs, Value}}}); + _ -> + Value + end; +handle_hashsigns_option(_, {Major, Minor} = Version) when Major >= 3 andalso Minor >= 3-> + handle_hashsigns_option(tls_v1:default_signature_algs(Version), Version); +handle_hashsigns_option(_, _Version) -> + undefined. validate_options([]) -> []; @@ -1089,10 +1105,7 @@ binary_cipher_suites(Version, []) -> %% Defaults to all supported suites that does %% not require explicit configuration ssl_cipher:filter_suites(ssl_cipher:suites(Version)); -binary_cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> %% Backwards compatibility - Ciphers = [{KeyExchange, Cipher, Hash} || {KeyExchange, Cipher, Hash, _} <- Ciphers0], - binary_cipher_suites(Version, Ciphers); -binary_cipher_suites(Version, [{_,_,_}| _] = Ciphers0) -> +binary_cipher_suites(Version, [Tuple|_] = Ciphers0) when is_tuple(Tuple) -> Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0], binary_cipher_suites(Version, Ciphers); @@ -1285,6 +1298,13 @@ new_ssl_options([{server_name_indication, Value} | Rest], #ssl_options{} = Opts, new_ssl_options(Rest, Opts#ssl_options{server_name_indication = validate_option(server_name_indication, Value)}, RecordCB); new_ssl_options([{honor_cipher_order, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> new_ssl_options(Rest, Opts#ssl_options{honor_cipher_order = validate_option(honor_cipher_order, Value)}, RecordCB); +new_ssl_options([{signature_algs, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, + Opts#ssl_options{signature_algs = + handle_hashsigns_option(Value, + RecordCB:highest_protocol_version())}, + RecordCB); + new_ssl_options([{Key, Value} | _Rest], #ssl_options{}, _) -> throw({error, {options, {Key, Value}}}). diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 974a6ec6b5..af53d4abf9 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -43,11 +43,12 @@ -export_type([cipher_suite/0, erl_cipher_suite/0, openssl_cipher_suite/0, - key_algo/0]). + hash/0, key_algo/0, sign_algo/0]). -type cipher() :: null |rc4_128 | idea_cbc | des40_cbc | des_cbc | '3des_ede_cbc' | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm | chacha20_poly1305. -type hash() :: null | sha | md5 | sha224 | sha256 | sha384 | sha512. +-type sign_algo() :: rsa | dsa | ecdsa. -type key_algo() :: null | rsa | dhe_rsa | dhe_dss | ecdhe_ecdsa| ecdh_ecdsa | ecdh_rsa| srp_rsa| srp_dss | psk | dhe_psk | rsa_psk | dh_anon | ecdh_anon | srp_anon. -type erl_cipher_suite() :: {key_algo(), cipher(), hash()} % Pre TLS 1.2 %% TLS 1.2, internally PRE TLS 1.2 will use default_prf @@ -841,17 +842,17 @@ suite({rsa_psk, aes_256_cbc,sha}) -> %%% TLS 1.2 PSK Cipher Suites RFC 5487 -suite({psk, aes_128_gcm, null}) -> +suite({psk, aes_128_gcm, null, sha256}) -> ?TLS_PSK_WITH_AES_128_GCM_SHA256; -suite({psk, aes_256_gcm, null}) -> +suite({psk, aes_256_gcm, null, sha384}) -> ?TLS_PSK_WITH_AES_256_GCM_SHA384; -suite({dhe_psk, aes_128_gcm, null}) -> +suite({dhe_psk, aes_128_gcm, null, sha256}) -> ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256; -suite({dhe_psk, aes_256_gcm, null}) -> +suite({dhe_psk, aes_256_gcm, null, sha384}) -> ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384; -suite({rsa_psk, aes_128_gcm, null}) -> +suite({rsa_psk, aes_128_gcm, null, sha256}) -> ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256; -suite({rsa_psk, aes_256_gcm, null}) -> +suite({rsa_psk, aes_256_gcm, null, sha384}) -> ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384; suite({psk, aes_128_cbc, sha256}) -> @@ -958,74 +959,74 @@ suite({ecdh_anon, aes_256_cbc, sha}) -> ?TLS_ECDH_anon_WITH_AES_256_CBC_SHA; %%% RFC 5289 EC TLS suites -suite({ecdhe_ecdsa, aes_128_cbc, sha256}) -> +suite({ecdhe_ecdsa, aes_128_cbc, sha256, sha256}) -> ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256; -suite({ecdhe_ecdsa, aes_256_cbc, sha384}) -> +suite({ecdhe_ecdsa, aes_256_cbc, sha384, sha384}) -> ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384; -suite({ecdh_ecdsa, aes_128_cbc, sha256}) -> +suite({ecdh_ecdsa, aes_128_cbc, sha256, sha256}) -> ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256; -suite({ecdh_ecdsa, aes_256_cbc, sha384}) -> +suite({ecdh_ecdsa, aes_256_cbc, sha384, sha384}) -> ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384; -suite({ecdhe_rsa, aes_128_cbc, sha256}) -> +suite({ecdhe_rsa, aes_128_cbc, sha256, sha256}) -> ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256; -suite({ecdhe_rsa, aes_256_cbc, sha384}) -> +suite({ecdhe_rsa, aes_256_cbc, sha384, sha384}) -> ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384; -suite({ecdh_rsa, aes_128_cbc, sha256}) -> +suite({ecdh_rsa, aes_128_cbc, sha256, sha256}) -> ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256; -suite({ecdh_rsa, aes_256_cbc, sha384}) -> +suite({ecdh_rsa, aes_256_cbc, sha384, sha384}) -> ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384; %% RFC 5288 AES-GCM Cipher Suites -suite({rsa, aes_128_gcm, null}) -> +suite({rsa, aes_128_gcm, null, sha256}) -> ?TLS_RSA_WITH_AES_128_GCM_SHA256; -suite({rsa, aes_256_gcm, null}) -> +suite({rsa, aes_256_gcm, null, sha384}) -> ?TLS_RSA_WITH_AES_256_GCM_SHA384; -suite({dhe_rsa, aes_128_gcm, null}) -> +suite({dhe_rsa, aes_128_gcm, null, sha256}) -> ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; -suite({dhe_rsa, aes_256_gcm, null}) -> +suite({dhe_rsa, aes_256_gcm, null, sha384}) -> ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; -suite({dh_rsa, aes_128_gcm, null}) -> +suite({dh_rsa, aes_128_gcm, null, sha256}) -> ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; -suite({dh_rsa, aes_256_gcm, null}) -> +suite({dh_rsa, aes_256_gcm, null, sha384}) -> ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; -suite({dhe_dss, aes_128_gcm, null}) -> +suite({dhe_dss, aes_128_gcm, null, sha256}) -> ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; -suite({dhe_dss, aes_256_gcm, null}) -> +suite({dhe_dss, aes_256_gcm, null, sha384}) -> ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; -suite({dh_dss, aes_128_gcm, null}) -> +suite({dh_dss, aes_128_gcm, null, sha256}) -> ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; -suite({dh_dss, aes_256_gcm, null}) -> +suite({dh_dss, aes_256_gcm, null, sha384}) -> ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; -suite({dh_anon, aes_128_gcm, null}) -> +suite({dh_anon, aes_128_gcm, null, sha256}) -> ?TLS_DH_anon_WITH_AES_128_GCM_SHA256; -suite({dh_anon, aes_256_gcm, null}) -> +suite({dh_anon, aes_256_gcm, null, sha384}) -> ?TLS_DH_anon_WITH_AES_256_GCM_SHA384; %% RFC 5289 ECC AES-GCM Cipher Suites -suite({ecdhe_ecdsa, aes_128_gcm, null}) -> +suite({ecdhe_ecdsa, aes_128_gcm, null, sha256}) -> ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256; -suite({ecdhe_ecdsa, aes_256_gcm, null}) -> +suite({ecdhe_ecdsa, aes_256_gcm, null, sha384}) -> ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384; -suite({ecdh_ecdsa, aes_128_gcm, null}) -> +suite({ecdh_ecdsa, aes_128_gcm, null, sha256}) -> ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256; -suite({ecdh_ecdsa, aes_256_gcm, null}) -> +suite({ecdh_ecdsa, aes_256_gcm, null, sha384}) -> ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384; -suite({ecdhe_rsa, aes_128_gcm, null}) -> +suite({ecdhe_rsa, aes_128_gcm, null, sha256}) -> ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256; -suite({ecdhe_rsa, aes_256_gcm, null}) -> +suite({ecdhe_rsa, aes_256_gcm, null, sha384}) -> ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384; -suite({ecdh_rsa, aes_128_gcm, null}) -> +suite({ecdh_rsa, aes_128_gcm, null, sha256}) -> ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256; -suite({ecdh_rsa, aes_256_gcm, null}) -> +suite({ecdh_rsa, aes_256_gcm, null, sha384}) -> ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384; %% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites -suite({ecdhe_rsa, chacha20_poly1305, null}) -> +suite({ecdhe_rsa, chacha20_poly1305, null, sha256}) -> ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256; -suite({ecdhe_ecdsa, chacha20_poly1305, null}) -> +suite({ecdhe_ecdsa, chacha20_poly1305, null, sha256}) -> ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256; -suite({dhe_rsa, chacha20_poly1305, null}) -> +suite({dhe_rsa, chacha20_poly1305, null, sha256}) -> ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256. %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index ec7d086934..0f0072ba34 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -304,13 +304,9 @@ hello(#hello_request{}, #state{role = client} = State0, Connection) -> {Record, State} = Connection:next_record(State0), Connection:next_state(hello, hello, Record, State); -hello({common_client_hello, Type, ServerHelloExt, NegotiatedHashSign}, +hello({common_client_hello, Type, ServerHelloExt}, State, Connection) -> - do_server_hello(Type, ServerHelloExt, - %% Note NegotiatedHashSign is only negotiated for real if - %% if TLS version is at least TLS-1.2 - State#state{hashsign_algorithm = NegotiatedHashSign}, Connection); - + do_server_hello(Type, ServerHelloExt, State, Connection); hello(timeout, State, _) -> {next_state, hello, State, hibernate}; @@ -442,7 +438,8 @@ certify(#server_key_exchange{exchange_keys = Keys}, Alg == srp_dss; Alg == srp_rsa; Alg == srp_anon -> Params = ssl_handshake:decode_server_key(Keys, Alg, Version), - HashSign = negotiated_hashsign(Params#server_key_params.hashsign, Alg, Version), + %% Use negotiated value if TLS-1.2 otherwhise return default + HashSign = negotiated_hashsign(Params#server_key_params.hashsign, Alg, PubKeyInfo, Version), case is_anonymous(Alg) of true -> calculate_secret(Params#server_key_params.params, @@ -464,11 +461,18 @@ certify(#server_key_exchange{} = Msg, certify(#certificate_request{hashsign_algorithms = HashSigns}, #state{session = #session{own_certificate = Cert}, - negotiated_version = Version} = State0, Connection) -> - HashSign = ssl_handshake:select_hashsign(HashSigns, Cert, Version), - {Record, State} = Connection:next_record(State0#state{client_certificate_requested = true}), - Connection:next_state(certify, certify, Record, - State#state{cert_hashsign_algorithm = HashSign}); + key_algorithm = KeyExAlg, + ssl_options = #ssl_options{signature_algs = SupportedHashSigns}, + negotiated_version = Version} = State0, Connection) -> + + case ssl_handshake:select_hashsign(HashSigns, Cert, KeyExAlg, SupportedHashSigns, Version) of + #alert {} = Alert -> + Connection:handle_own_alert(Alert, Version, certify, State0); + NegotiatedHashSign -> + {Record, State} = Connection:next_record(State0#state{client_certificate_requested = true}), + Connection:next_state(certify, certify, Record, + State#state{cert_hashsign_algorithm = NegotiatedHashSign}) + end; %% PSK and RSA_PSK might bypass the Server-Key-Exchange certify(#server_hello_done{}, @@ -576,13 +580,15 @@ cipher(#hello_request{}, State0, Connection) -> cipher(#certificate_verify{signature = Signature, hashsign_algorithm = CertHashSign}, #state{role = server, - public_key_info = {Algo, _, _} =PublicKeyInfo, + key_algorithm = KexAlg, + public_key_info = PublicKeyInfo, negotiated_version = Version, session = #session{master_secret = MasterSecret}, tls_handshake_history = Handshake } = State0, Connection) -> - - HashSign = ssl_handshake:select_hashsign_algs(CertHashSign, Algo, Version), + + %% Use negotiated value if TLS-1.2 otherwhise return default + HashSign = negotiated_hashsign(CertHashSign, KexAlg, PublicKeyInfo, Version), case ssl_handshake:certificate_verify(Signature, PublicKeyInfo, Version, HashSign, MasterSecret, Handshake) of valid -> @@ -815,7 +821,8 @@ handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName, SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{master_secret = MasterSecret, client_random = ClientRandom, - server_random = ServerRandom} = SecParams, + server_random = ServerRandom, + prf_algorithm = PRFAlgorithm} = SecParams, Reply = try SecretToUse = case Secret of _ when is_binary(Secret) -> Secret; @@ -826,7 +833,7 @@ handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName, (client_random, Acc) -> [ClientRandom|Acc]; (server_random, Acc) -> [ServerRandom|Acc] end, [], Seed)), - ssl_handshake:prf(Version, SecretToUse, Label, SeedToUse, WantedLength) + ssl_handshake:prf(Version, PRFAlgorithm, SecretToUse, Label, SeedToUse, WantedLength) catch exit:_ -> {error, badarg}; error:Reason -> {error, Reason} @@ -1448,7 +1455,8 @@ rsa_psk_key_exchange(Version, PskIdentity, PremasterSecret, PublicKeyInfo = {Alg rsa_psk_key_exchange(_, _, _, _) -> throw (?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE)). -request_client_cert(#state{ssl_options = #ssl_options{verify = verify_peer}, +request_client_cert(#state{ssl_options = #ssl_options{verify = verify_peer, + signature_algs = SupportedHashSigns}, connection_states = ConnectionStates0, cert_db = CertDbHandle, cert_db_ref = CertDbRef, @@ -1456,7 +1464,9 @@ request_client_cert(#state{ssl_options = #ssl_options{verify = verify_peer}, #connection_state{security_parameters = #security_parameters{cipher_suite = CipherSuite}} = ssl_record:pending_connection_state(ConnectionStates0, read), - Msg = ssl_handshake:certificate_request(CipherSuite, CertDbHandle, CertDbRef, Version), + HashSigns = ssl_handshake:available_signature_algs(SupportedHashSigns, Version, [Version]), + Msg = ssl_handshake:certificate_request(CipherSuite, CertDbHandle, CertDbRef, + HashSigns, Version), State = Connection:send_handshake(Msg, State0), State#state{client_certificate_requested = true}; @@ -1881,15 +1891,16 @@ make_premaster_secret({MajVer, MinVer}, rsa) -> make_premaster_secret(_, _) -> undefined. -negotiated_hashsign(undefined, Alg, Version) -> +negotiated_hashsign(undefined, KexAlg, PubKeyInfo, Version) -> %% Not negotiated choose default - case is_anonymous(Alg) of + case is_anonymous(KexAlg) of true -> {null, anon}; false -> - ssl_handshake:select_hashsign_algs(Alg, Version) + {PubAlg, _, _} = PubKeyInfo, + ssl_handshake:select_hashsign_algs(undefined, PubAlg, Version) end; -negotiated_hashsign(HashSign = {_, _}, _, _) -> +negotiated_hashsign(HashSign = {_, _}, _, _, _) -> HashSign. ssl_options_list(SslOptions) -> diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index e98073080a..235d6efbb6 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -46,7 +46,7 @@ %% Handshake messages -export([hello_request/0, server_hello/4, server_hello_done/0, - certificate/4, certificate_request/4, key_exchange/3, + certificate/4, certificate_request/5, key_exchange/3, finished/5, next_protocol/1]). %% Handle handshake messages @@ -64,8 +64,8 @@ ]). %% Cipher suites handling --export([available_suites/2, cipher_suites/2, - select_session/10, supported_ecc/1]). +-export([available_suites/2, available_signature_algs/3, cipher_suites/2, + select_session/11, supported_ecc/1]). %% Extensions handling -export([client_hello_extensions/6, @@ -74,8 +74,8 @@ ]). %% MISC --export([select_version/3, prf/5, select_hashsign/3, - select_hashsign_algs/2, select_hashsign_algs/3, +-export([select_version/3, prf/6, select_hashsign/5, + select_hashsign_algs/3, premaster_secret/2, premaster_secret/3, premaster_secret/4]). %%==================================================================== @@ -120,7 +120,8 @@ server_hello(SessionId, Version, ConnectionStates, Extensions) -> server_hello_done() -> #server_hello_done{}. -client_hello_extensions(Host, Version, CipherSuites, SslOpts, ConnectionStates, Renegotiation) -> +client_hello_extensions(Host, Version, CipherSuites, + #ssl_options{signature_algs = SupportedHashSigns, versions = AllVersions} = SslOpts, ConnectionStates, Renegotiation) -> {EcPointFormats, EllipticCurves} = case advertises_ec_ciphers(lists:map(fun ssl_cipher:suite_definition/1, CipherSuites)) of true -> @@ -134,7 +135,7 @@ client_hello_extensions(Host, Version, CipherSuites, SslOpts, ConnectionStates, renegotiation_info = renegotiation_info(tls_record, client, ConnectionStates, Renegotiation), srp = SRP, - hash_signs = advertised_hash_signs(Version), + signature_algs = available_signature_algs(SupportedHashSigns, Version, AllVersions), ec_point_formats = EcPointFormats, elliptic_curves = EllipticCurves, alpn = encode_alpn(SslOpts#ssl_options.alpn_advertised_protocols, Renegotiation), @@ -203,14 +204,14 @@ client_certificate_verify(OwnCert, MasterSecret, Version, end. %%-------------------------------------------------------------------- --spec certificate_request(ssl_cipher:cipher_suite(), db_handle(), certdb_ref(), ssl_record:ssl_version()) -> - #certificate_request{}. +-spec certificate_request(ssl_cipher:cipher_suite(), db_handle(), + certdb_ref(), #hash_sign_algos{}, ssl_record:ssl_version()) -> + #certificate_request{}. %% %% Description: Creates a certificate_request message, called by the server. %%-------------------------------------------------------------------- -certificate_request(CipherSuite, CertDbHandle, CertDbRef, Version) -> +certificate_request(CipherSuite, CertDbHandle, CertDbRef, HashSigns, Version) -> Types = certificate_types(ssl_cipher:suite_definition(CipherSuite), Version), - HashSigns = advertised_hash_signs(Version), Authorities = certificate_authorities(CertDbHandle, CertDbRef), #certificate_request{ certificate_types = Types, @@ -351,6 +352,9 @@ verify_server_key(#server_key_params{params_bin = EncParams, %% %% Description: Checks that the certificate_verify message is valid. %%-------------------------------------------------------------------- +certificate_verify(_, _, _, undefined, _, _) -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); + certificate_verify(Signature, PublicKeyInfo, Version, HashSign = {HashAlgo, _}, MasterSecret, {_, Handshake}) -> Hash = calc_certificate_verify(Version, HashAlgo, MasterSecret, Handshake), @@ -379,10 +383,11 @@ verify_signature(_Version, Hash, _HashAlgo, Signature, {?rsaEncryption, PubKey, end; verify_signature(_Version, Hash, {HashAlgo, dsa}, Signature, {?'id-dsa', PublicKey, PublicKeyParams}) -> public_key:verify({digest, Hash}, HashAlgo, Signature, {PublicKey, PublicKeyParams}); -verify_signature(_Version, Hash, {HashAlgo, ecdsa}, Signature, +verify_signature(_, Hash, {HashAlgo, _SignAlg}, Signature, {?'id-ecPublicKey', PublicKey, PublicKeyParams}) -> public_key:verify({digest, Hash}, HashAlgo, Signature, {PublicKey, PublicKeyParams}). + %%-------------------------------------------------------------------- -spec certify(#certificate{}, db_handle(), certdb_ref(), integer() | nolimit, verify_peer | verify_none, {fun(), term}, fun(), term(), term(), @@ -559,57 +564,58 @@ server_key_exchange_hash(md5sha, Value) -> server_key_exchange_hash(Hash, Value) -> crypto:hash(Hash, Value). %%-------------------------------------------------------------------- --spec prf(ssl_record:ssl_version(), binary(), binary(), [binary()], non_neg_integer()) -> +-spec prf(ssl_record:ssl_version(), non_neg_integer(), binary(), binary(), [binary()], non_neg_integer()) -> {ok, binary()} | {error, undefined}. %% %% Description: use the TLS PRF to generate key material %%-------------------------------------------------------------------- -prf({3,0}, _, _, _, _) -> +prf({3,0}, _, _, _, _, _) -> {error, undefined}; -prf({3,1}, Secret, Label, Seed, WantedLength) -> - {ok, tls_v1:prf(?MD5SHA, Secret, Label, Seed, WantedLength)}; -prf({3,_N}, Secret, Label, Seed, WantedLength) -> - {ok, tls_v1:prf(?SHA256, Secret, Label, Seed, WantedLength)}. +prf({3,_N}, PRFAlgo, Secret, Label, Seed, WantedLength) -> + {ok, tls_v1:prf(PRFAlgo, Secret, Label, Seed, WantedLength)}. %%-------------------------------------------------------------------- --spec select_hashsign(#hash_sign_algos{}| undefined, undefined | binary(), ssl_record:ssl_version()) -> - {atom(), atom()} | undefined. +-spec select_hashsign(#hash_sign_algos{} | undefined, undefined | binary(), + atom(), [atom()], ssl_record:ssl_version()) -> + {atom(), atom()} | undefined | #alert{}. %% -%% Description: +%% Description: Handles signature_algorithms extension %%-------------------------------------------------------------------- -select_hashsign(_, undefined, _Version) -> +select_hashsign(_, undefined, _, _, _Version) -> {null, anon}; %% The signature_algorithms extension was introduced with TLS 1.2. Ignore it if we have %% negotiated a lower version. -select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert, {Major, Minor} = Version) - when Major >= 3 andalso Minor >= 3 -> - #'OTPCertificate'{tbsCertificate = TBSCert} =public_key:pkix_decode_cert(Cert, otp), +select_hashsign(HashSigns, Cert, KeyExAlgo, + undefined, {Major, Minor} = Version) when Major >= 3 andalso Minor >= 3-> + select_hashsign(HashSigns, Cert, KeyExAlgo, tls_v1:default_signature_algs(Version), Version); +select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert, KeyExAlgo, SupportedHashSigns, + {Major, Minor}) when Major >= 3 andalso Minor >= 3 -> + #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp), #'OTPSubjectPublicKeyInfo'{algorithm = {_,Algo, _}} = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, - DefaultHashSign = {_, Sign} = select_hashsign_algs(undefined, Algo, Version), - case lists:filter(fun({sha, dsa}) -> + Sign = cert_sign(Algo), + case lists:filter(fun({sha, dsa = S}) when S == Sign -> true; ({_, dsa}) -> false; - ({Hash, S}) when S == Sign -> - ssl_cipher:is_acceptable_hash(Hash, - proplists:get_value(hashs, crypto:supports())); + ({_, _} = Algos) -> + is_acceptable_hash_sign(Algos, Sign, KeyExAlgo, SupportedHashSigns); (_) -> false end, HashSigns) of [] -> - DefaultHashSign; - [HashSign| _] -> + ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY); + [HashSign | _] -> HashSign end; -select_hashsign(_, Cert, Version) -> +select_hashsign(_, Cert, _, _, Version) -> #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp), #'OTPSubjectPublicKeyInfo'{algorithm = {_,Algo, _}} = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, select_hashsign_algs(undefined, Algo, Version). %%-------------------------------------------------------------------- --spec select_hashsign_algs(#hash_sign_algos{}| undefined, oid(), ssl_record:ssl_version()) -> +-spec select_hashsign_algs({atom(), atom()}| undefined, oid(), ssl_record:ssl_version()) -> {atom(), atom()}. %% Description: For TLS 1.2 hash function and signature algorithm pairs can be @@ -642,24 +648,6 @@ select_hashsign_algs(undefined, ?rsaEncryption, _) -> select_hashsign_algs(undefined, ?'id-dsa', _) -> {sha, dsa}. --spec select_hashsign_algs(atom(), ssl_record:ssl_version()) -> {atom(), atom()}. -%% Wrap function to keep the knowledge of the default values in -%% one place only -select_hashsign_algs(Alg, Version) when (Alg == rsa orelse - Alg == dhe_rsa orelse - Alg == dh_rsa orelse - Alg == ecdhe_rsa orelse - Alg == ecdh_rsa orelse - Alg == srp_rsa) -> - select_hashsign_algs(undefined, ?rsaEncryption, Version); -select_hashsign_algs(Alg, Version) when (Alg == dhe_dss orelse - Alg == dh_dss orelse - Alg == srp_dss) -> - select_hashsign_algs(undefined, ?'id-dsa', Version); -select_hashsign_algs(Alg, Version) when (Alg == ecdhe_ecdsa orelse - Alg == ecdh_ecdsa) -> - select_hashsign_algs(undefined, ?'id-ecPublicKey', Version). - %%-------------------------------------------------------------------- -spec master_secret(atom(), ssl_record:ssl_version(), #session{} | binary(), #connection_states{}, client | server) -> {binary(), #connection_states{}} | #alert{}. @@ -1063,9 +1051,56 @@ available_suites(UserSuites, Version) -> lists:member(Suite, ssl_cipher:all_suites(Version)) end, UserSuites). -available_suites(ServerCert, UserSuites, Version, Curve) -> +available_suites(ServerCert, UserSuites, Version, undefined, Curve) -> ssl_cipher:filter(ServerCert, available_suites(UserSuites, Version)) - -- unavailable_ecc_suites(Curve). + -- unavailable_ecc_suites(Curve); +available_suites(ServerCert, UserSuites, Version, HashSigns, Curve) -> + Suites = available_suites(ServerCert, UserSuites, Version, undefined, Curve), + filter_hashsigns(Suites, [ssl_cipher:suite_definition(Suite) || Suite <- Suites], HashSigns, []). +filter_hashsigns([], [], _, Acc) -> + lists:reverse(Acc); +filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns, + Acc) when KeyExchange == dhe_ecdsa; + KeyExchange == ecdhe_ecdsa -> + do_filter_hashsigns(ecdsa, Suite, Suites, Algos, HashSigns, Acc); + +filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns, + Acc) when KeyExchange == rsa; + KeyExchange == dhe_rsa; + KeyExchange == ecdhe_rsa; + KeyExchange == srp_rsa; + KeyExchange == rsa_psk -> + do_filter_hashsigns(rsa, Suite, Suites, Algos, HashSigns, Acc); +filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns, Acc) when + KeyExchange == dhe_dss; + KeyExchange == srp_dss -> + do_filter_hashsigns(dsa, Suite, Suites, Algos, HashSigns, Acc); +filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns, Acc) when + KeyExchange == dh_dss; + KeyExchange == dh_rsa; + KeyExchange == dh_ecdsa; + KeyExchange == ecdh_rsa; + KeyExchange == ecdh_ecdsa -> + %% Fixed DH certificates MAY be signed with any hash/signature + %% algorithm pair appearing in the hash_sign extension. The names + %% DH_DSS, DH_RSA, ECDH_ECDSA, and ECDH_RSA are historical. + filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]); +filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns, Acc) when + KeyExchange == dh_anon; + KeyExchange == ecdh_anon; + KeyExchange == srp_anon; + KeyExchange == psk; + KeyExchange == dhe_psk -> + %% In this case hashsigns is not used as the kexchange is anonaymous + filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]). + +do_filter_hashsigns(SignAlgo, Suite, Suites, Algos, HashSigns, Acc) -> + case lists:keymember(SignAlgo, 2, HashSigns) of + true -> + filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]); + false -> + filter_hashsigns(Suites, Algos, HashSigns, Acc) + end. unavailable_ecc_suites(no_curve) -> ssl_cipher:ec_keyed_suites(); @@ -1077,17 +1112,17 @@ cipher_suites(Suites, false) -> cipher_suites(Suites, true) -> Suites. -select_session(SuggestedSessionId, CipherSuites, Compressions, Port, #session{ecc = ECCCurve} = +select_session(SuggestedSessionId, CipherSuites, HashSigns, Compressions, Port, #session{ecc = ECCCurve} = Session, Version, - #ssl_options{ciphers = UserSuites, honor_cipher_order = HCO} = SslOpts, + #ssl_options{ciphers = UserSuites, honor_cipher_order = HonorCipherOrder} = SslOpts, Cache, CacheCb, Cert) -> {SessionId, Resumed} = ssl_session:server_id(Port, SuggestedSessionId, SslOpts, Cert, Cache, CacheCb), case Resumed of undefined -> - Suites = available_suites(Cert, UserSuites, Version, ECCCurve), - CipherSuite = select_cipher_suite(CipherSuites, Suites, HCO), + Suites = available_suites(Cert, UserSuites, Version, HashSigns, ECCCurve), + CipherSuite = select_cipher_suite(CipherSuites, Suites, HonorCipherOrder), Compression = select_compression(Compressions), {new, Session#session{session_id = SessionId, cipher_suite = CipherSuite, @@ -1155,7 +1190,7 @@ handle_client_hello_extensions(RecordCB, Random, ClientCipherSuites, #hello_extensions{renegotiation_info = Info, srp = SRP, ec_point_formats = ECCFormat, - alpn = ALPN, + alpn = ALPN, next_protocol_negotiation = NextProtocolNegotiation}, Version, #ssl_options{secure_renegotiate = SecureRenegotation, alpn_preferred_protocols = ALPNPreferredProtocols} = Opts, @@ -1324,7 +1359,7 @@ handle_renegotiation_info(_RecordCB, ConnectionStates, SecureRenegotation) -> hello_extensions_list(#hello_extensions{renegotiation_info = RenegotiationInfo, srp = SRP, - hash_signs = HashSigns, + signature_algs = HashSigns, ec_point_formats = EcPointFormats, elliptic_curves = EllipticCurves, alpn = ALPN, @@ -1799,7 +1834,7 @@ dec_hello_extensions(<<?UINT16(?SIGNATURE_ALGORITHMS_EXT), ?UINT16(Len), <<?UINT16(SignAlgoListLen), SignAlgoList/binary>> = ExtData, HashSignAlgos = [{ssl_cipher:hash_algorithm(Hash), ssl_cipher:sign_algorithm(Sign)} || <<?BYTE(Hash), ?BYTE(Sign)>> <= SignAlgoList], - dec_hello_extensions(Rest, Acc#hello_extensions{hash_signs = + dec_hello_extensions(Rest, Acc#hello_extensions{signature_algs = #hash_sign_algos{hash_sign_algos = HashSignAlgos}}); dec_hello_extensions(<<?UINT16(?ELLIPTIC_CURVES_EXT), ?UINT16(Len), @@ -1899,7 +1934,7 @@ from_2bytes(<<?UINT16(N), Rest/binary>>, Acc) -> key_exchange_alg(rsa) -> ?KEY_EXCHANGE_RSA; key_exchange_alg(Alg) when Alg == dhe_rsa; Alg == dhe_dss; - Alg == dh_dss; Alg == dh_rsa; Alg == dh_anon -> + Alg == dh_dss; Alg == dh_rsa; Alg == dh_anon -> ?KEY_EXCHANGE_DIFFIE_HELLMAN; key_exchange_alg(Alg) when Alg == ecdhe_rsa; Alg == ecdh_rsa; Alg == ecdhe_ecdsa; Alg == ecdh_ecdsa; @@ -2008,27 +2043,16 @@ is_member(Suite, SupportedSuites) -> select_compression(_CompressionMetodes) -> ?NULL. --define(TLSEXT_SIGALG_RSA(MD), {MD, rsa}). --define(TLSEXT_SIGALG_DSA(MD), {MD, dsa}). --define(TLSEXT_SIGALG_ECDSA(MD), {MD, ecdsa}). - --define(TLSEXT_SIGALG(MD), ?TLSEXT_SIGALG_ECDSA(MD), ?TLSEXT_SIGALG_RSA(MD)). - -advertised_hash_signs({Major, Minor}) when Major >= 3 andalso Minor >= 3 -> - HashSigns = [?TLSEXT_SIGALG(sha512), - ?TLSEXT_SIGALG(sha384), - ?TLSEXT_SIGALG(sha256), - ?TLSEXT_SIGALG(sha224), - ?TLSEXT_SIGALG(sha), - ?TLSEXT_SIGALG_DSA(sha), - ?TLSEXT_SIGALG_RSA(md5)], - CryptoSupport = crypto:supports(), - HasECC = proplists:get_bool(ecdsa, proplists:get_value(public_keys, CryptoSupport)), - Hashs = proplists:get_value(hashs, CryptoSupport), - #hash_sign_algos{hash_sign_algos = - lists:filter(fun({Hash, ecdsa}) -> HasECC andalso proplists:get_bool(Hash, Hashs); - ({Hash, _}) -> proplists:get_bool(Hash, Hashs) end, HashSigns)}; -advertised_hash_signs(_) -> +available_signature_algs(undefined, _, _) -> + undefined; +available_signature_algs(SupportedHashSigns, {Major, Minor}, AllVersions) when Major >= 3 andalso Minor >= 3 -> + case tls_record:lowest_protocol_version(AllVersions) of + {3, 3} -> + #hash_sign_algos{hash_sign_algos = SupportedHashSigns}; + _ -> + undefined + end; +available_signature_algs(_, _, _) -> undefined. psk_secret(PSKIdentity, PSKLookup) -> @@ -2123,3 +2147,25 @@ distpoints_lookup([DistPoint | Rest], Callback, CRLDbHandle) -> CRLs -> [{DistPoint, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs] end. + +cert_sign(?rsaEncryption) -> + rsa; +cert_sign(?'id-ecPublicKey') -> + ecdsa; +cert_sign(?'id-dsa') -> + dsa; +cert_sign(Alg) -> + {_, Sign} =public_key:pkix_sign_types(Alg), + Sign. + +is_acceptable_hash_sign({_, Sign} = Algos, Sign, _, SupportedHashSigns) -> + is_acceptable_hash_sign(Algos, SupportedHashSigns); +is_acceptable_hash_sign(Algos,_, KeyExAlgo, SupportedHashSigns) when KeyExAlgo == dh_ecdsa; + KeyExAlgo == ecdh_rsa; + KeyExAlgo == ecdh_ecdsa -> + is_acceptable_hash_sign(Algos, SupportedHashSigns); +is_acceptable_hash_sign(_,_,_,_) -> + false. +is_acceptable_hash_sign(Algos, SupportedHashSigns) -> + lists:member(Algos, SupportedHashSigns). + diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index 58b4d5a23d..b74a65939b 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -95,7 +95,7 @@ -record(hello_extensions, { renegotiation_info, - hash_signs, % supported combinations of hashes/signature algos + signature_algs, % supported combinations of hashes/signature algos alpn, next_protocol_negotiation = undefined, % [binary()] srp, diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 8c7ed9c0d1..20f0b7d0da 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -135,7 +135,8 @@ padding_check = true :: boolean(), fallback = false :: boolean(), crl_check :: boolean() | peer | best_effort, - crl_cache + crl_cache, + signature_algs }). -record(socket_options, diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index c3f0206d25..93716d31b8 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -182,8 +182,7 @@ hello(start, #state{host = Host, port = Port, role = client, next_state(hello, hello, Record, State); hello(Hello = #client_hello{client_version = ClientVersion, - extensions = #hello_extensions{hash_signs = HashSigns, - ec_point_formats = EcPointFormats, + extensions = #hello_extensions{ec_point_formats = EcPointFormats, elliptic_curves = EllipticCurves}}, State = #state{connection_states = ConnectionStates0, port = Port, session = #session{own_certificate = Cert} = Session0, @@ -191,27 +190,28 @@ hello(Hello = #client_hello{client_version = ClientVersion, session_cache = Cache, session_cache_cb = CacheCb, negotiated_protocol = CurrentProtocol, + key_algorithm = KeyExAlg, ssl_options = SslOpts}) -> + case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, - ConnectionStates0, Cert}, Renegotiation) of + ConnectionStates0, Cert, KeyExAlg}, Renegotiation) of #alert{} = Alert -> handle_own_alert(Alert, ClientVersion, hello, State); {Version, {Type, Session}, - ConnectionStates, Protocol0, ServerHelloExt} -> - + ConnectionStates, Protocol0, ServerHelloExt, HashSign} -> Protocol = case Protocol0 of - undefined -> CurrentProtocol; - _ -> Protocol0 - end, - - HashSign = ssl_handshake:select_hashsign(HashSigns, Cert, Version), - ssl_connection:hello({common_client_hello, Type, ServerHelloExt, HashSign}, + undefined -> CurrentProtocol; + _ -> Protocol0 + end, + ssl_connection:hello({common_client_hello, Type, ServerHelloExt}, State#state{connection_states = ConnectionStates, negotiated_version = Version, + hashsign_algorithm = HashSign, session = Session, client_ecc = {EllipticCurves, EcPointFormats}, negotiated_protocol = Protocol}, ?MODULE) end; + hello(Hello = #server_hello{}, #state{connection_states = ConnectionStates0, negotiated_version = ReqVersion, @@ -1069,3 +1069,4 @@ handle_sni_extension(#client_hello{extensions = HelloExtensions}, State0) -> end; handle_sni_extension(_, State0) -> State0. + diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index 0a6cb9f92d..f34eebb0e4 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -56,7 +56,7 @@ client_hello(Host, Port, ConnectionStates, Version = tls_record:highest_protocol_version(Versions), Pending = ssl_record:pending_connection_state(ConnectionStates, read), SecParams = Pending#connection_state.security_parameters, - AvailableCipherSuites = ssl_handshake:available_suites(UserSuites, Version), + AvailableCipherSuites = ssl_handshake:available_suites(UserSuites, Version), Extensions = ssl_handshake:client_hello_extensions(Host, Version, AvailableCipherSuites, SslOpts, ConnectionStates, Renegotiation), @@ -80,13 +80,13 @@ client_hello(Host, Port, ConnectionStates, -spec hello(#server_hello{} | #client_hello{}, #ssl_options{}, #connection_states{} | {inet:port_number(), #session{}, db_handle(), atom(), #connection_states{}, - binary() | undefined}, + binary() | undefined, ssl_cipher:key_algo()}, boolean()) -> {tls_record:tls_version(), session_id(), #connection_states{}, alpn | npn, binary() | undefined}| {tls_record:tls_version(), {resumed | new, #session{}}, #connection_states{}, binary() | undefined, - #hello_extensions{}} | + #hello_extensions{}, {ssl_cipher:hash(), ssl_cipher:sign_algo()} | undefined} | #alert{}. %% %% Description: Handles a recieved hello message @@ -149,26 +149,35 @@ get_tls_handshake(Version, Data, Buffer) -> %%% Internal functions %%-------------------------------------------------------------------- handle_client_hello(Version, #client_hello{session_id = SugesstedId, - cipher_suites = CipherSuites, - compression_methods = Compressions, - random = Random, - extensions = #hello_extensions{elliptic_curves = Curves} = HelloExt}, - #ssl_options{versions = Versions} = SslOpts, - {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) -> + cipher_suites = CipherSuites, + compression_methods = Compressions, + random = Random, + extensions = #hello_extensions{elliptic_curves = Curves, + signature_algs = ClientHashSigns} = HelloExt}, + #ssl_options{versions = Versions, + signature_algs = SupportedHashSigns} = SslOpts, + {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert, _}, Renegotiation) -> case tls_record:is_acceptable_version(Version, Versions) of true -> + AvailableHashSigns = available_signature_algs(ClientHashSigns, SupportedHashSigns, Cert, Version), ECCCurve = ssl_handshake:select_curve(Curves, ssl_handshake:supported_ecc(Version)), {Type, #session{cipher_suite = CipherSuite} = Session1} - = ssl_handshake:select_session(SugesstedId, CipherSuites, Compressions, + = ssl_handshake:select_session(SugesstedId, CipherSuites, AvailableHashSigns, Compressions, Port, Session0#session{ecc = ECCCurve}, Version, SslOpts, Cache, CacheCb, Cert), case CipherSuite of no_suite -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY); _ -> - handle_client_hello_extensions(Version, Type, Random, CipherSuites, HelloExt, - SslOpts, Session1, ConnectionStates0, - Renegotiation) + {KeyExAlg,_,_,_} = ssl_cipher:suite_definition(CipherSuite), + case ssl_handshake:select_hashsign(ClientHashSigns, Cert, KeyExAlg, SupportedHashSigns, Version) of + #alert{} = Alert -> + Alert; + HashSign -> + handle_client_hello_extensions(Version, Type, Random, CipherSuites, HelloExt, + SslOpts, Session1, ConnectionStates0, + Renegotiation, HashSign) + end end; false -> ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION) @@ -245,14 +254,14 @@ enc_handshake(HandshakeMsg, Version) -> handle_client_hello_extensions(Version, Type, Random, CipherSuites, - HelloExt, SslOpts, Session0, ConnectionStates0, Renegotiation) -> + HelloExt, SslOpts, Session0, ConnectionStates0, Renegotiation, HashSign) -> try ssl_handshake:handle_client_hello_extensions(tls_record, Random, CipherSuites, HelloExt, Version, SslOpts, Session0, ConnectionStates0, Renegotiation) of #alert{} = Alert -> Alert; {Session, ConnectionStates, Protocol, ServerHelloExt} -> - {Version, {Type, Session}, ConnectionStates, Protocol, ServerHelloExt} + {Version, {Type, Session}, ConnectionStates, Protocol, ServerHelloExt, HashSign} catch throw:Alert -> Alert end. @@ -269,3 +278,14 @@ handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, {Version, SessionId, ConnectionStates, ProtoExt, Protocol} end. +available_signature_algs(undefined, SupportedHashSigns, _, {Major, Minor}) when + (Major >= 3) andalso (Minor >= 3) -> + SupportedHashSigns; +available_signature_algs(#hash_sign_algos{hash_sign_algos = ClientHashSigns}, SupportedHashSigns, + _, {Major, Minor}) when (Major >= 3) andalso (Minor >= 3) -> + sets:to_list(sets:intersection(sets:from_list(ClientHashSigns), + sets:from_list(SupportedHashSigns))); +available_signature_algs(_, _, _, _) -> + undefined. + + diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index 71e5f349dd..543bd33833 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -31,7 +31,8 @@ -export([master_secret/4, finished/5, certificate_verify/3, mac_hash/7, setup_keys/8, suites/1, prf/5, - ecc_curves/1, oid_to_enum/1, enum_to_oid/1]). + ecc_curves/1, oid_to_enum/1, enum_to_oid/1, + default_signature_algs/1, signature_algs/2]). %%==================================================================== %% Internal application API @@ -258,6 +259,54 @@ suites(3) -> ] ++ suites(2). + +signature_algs({3, 3}, HashSigns) -> + CryptoSupports = crypto:supports(), + Hashes = proplists:get_value(hashs, CryptoSupports), + PubKeys = proplists:get_value(public_keys, CryptoSupports), + Supported = lists:foldl(fun({Hash, dsa = Sign} = Alg, Acc) -> + case proplists:get_bool(dss, PubKeys) + andalso proplists:get_bool(Hash, Hashes) + andalso is_pair(Hash, Sign, Hashes) + of + true -> + [Alg | Acc]; + false -> + Acc + end; + ({Hash, Sign} = Alg, Acc) -> + case proplists:get_bool(Sign, PubKeys) + andalso proplists:get_bool(Hash, Hashes) + andalso is_pair(Hash, Sign, Hashes) + of + true -> + [Alg | Acc]; + false -> + Acc + end + end, [], HashSigns), + lists:reverse(Supported). + +default_signature_algs({3, 3} = Version) -> + Default = [%% SHA2 + {sha512, ecdsa}, + {sha512, rsa}, + {sha384, ecdsa}, + {sha384, rsa}, + {sha256, ecdsa}, + {sha256, rsa}, + {sha224, ecdsa}, + {sha224, rsa}, + %% SHA + {sha, ecdsa}, + {sha, rsa}, + {sha, dsa}, + %% MD5 + {md5, rsa}], + signature_algs(Version, Default); +default_signature_algs(_) -> + undefined. + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -342,6 +391,17 @@ finished_label(client) -> finished_label(server) -> <<"server finished">>. +is_pair(sha, dsa, _) -> + true; +is_pair(_, dsa, _) -> + false; +is_pair(Hash, ecdsa, Hashs) -> + AtLeastSha = Hashs -- [md2,md4,md5], + lists:member(Hash, AtLeastSha); +is_pair(Hash, rsa, Hashs) -> + AtLeastMd5 = Hashs -- [md2,md4], + lists:member(Hash, AtLeastMd5). + %% list ECC curves in prefered order ecc_curves(_Minor) -> TLSCurves = [sect571r1,sect571k1,secp521r1,brainpoolP512r1, diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 1a864edb8b..a07739d3de 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -58,7 +58,7 @@ all() -> groups() -> [{basic, [], basic_tests()}, {options, [], options_tests()}, - {'tlsv1.2', [], all_versions_groups()}, + {'tlsv1.2', [], all_versions_groups() ++ [conf_signature_algs, no_common_signature_algs]}, {'tlsv1.1', [], all_versions_groups()}, {'tlsv1', [], all_versions_groups() ++ rizzo_tests()}, {'sslv3', [], all_versions_groups() ++ rizzo_tests() ++ [ciphersuite_vs_version]}, @@ -88,7 +88,8 @@ basic_tests() -> connect_dist, clear_pem_cache, defaults, - fallback + fallback, + cipher_format ]. options_tests() -> @@ -144,7 +145,8 @@ api_tests() -> versions_option, server_name_indication_option, accept_pool, - new_options_in_accept + new_options_in_accept, + prf ]. session_tests() -> @@ -168,6 +170,7 @@ renegotiate_tests() -> cipher_tests() -> [cipher_suites, + cipher_suites_mix, ciphers_rsa_signed_certs, ciphers_rsa_signed_certs_openssl_names, ciphers_dsa_signed_certs, @@ -322,6 +325,31 @@ init_per_testcase(rizzo, Config) -> ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]), ct:timetrap({seconds, 40}), Config; +init_per_testcase(prf, Config) -> + ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]), + ct:timetrap({seconds, 40}), + case ?config(tc_group_path, Config) of + [] -> Prop = []; + [Prop] -> Prop + end, + case ?config(name, Prop) of + undefined -> TlsVersions = [sslv3, tlsv1, 'tlsv1.1', 'tlsv1.2']; + TlsVersion when is_atom(TlsVersion) -> + TlsVersions = [TlsVersion] + end, + PRFS=[md5, sha, sha256, sha384, sha512], + %All are the result of running tls_v1:prf(PrfAlgo, <<>>, <<>>, <<>>, 16) + %with the specified PRF algorithm + ExpectedPrfResults= + [{md5, <<96,139,180,171,236,210,13,10,28,32,2,23,88,224,235,199>>}, + {sha, <<95,3,183,114,33,169,197,187,231,243,19,242,220,228,70,151>>}, + {sha256, <<166,249,145,171,43,95,158,232,6,60,17,90,183,180,0,155>>}, + {sha384, <<153,182,217,96,186,130,105,85,65,103,123,247,146,91,47,106>>}, + {sha512, <<145,8,98,38,243,96,42,94,163,33,53,49,241,4,127,28>>}, + %TLS 1.0 and 1.1 PRF: + {md5sha, <<63,136,3,217,205,123,200,177,251,211,17,229,132,4,173,80>>}], + TestPlan = prf_create_plan(TlsVersions, PRFS, ExpectedPrfResults), + [{prf_test_plan, TestPlan} | Config]; init_per_testcase(TestCase, Config) when TestCase == ssl_accept_timeout; TestCase == client_closes_socket; @@ -427,6 +455,25 @@ new_options_in_accept(Config) when is_list(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client). %%-------------------------------------------------------------------- +prf() -> + [{doc,"Test that ssl:prf/5 uses the negotiated PRF."}]. +prf(Config) when is_list(Config) -> + TestPlan = ?config(prf_test_plan, Config), + case TestPlan of + [] -> ct:fail({error, empty_prf_test_plan}); + _ -> lists:foreach(fun(Suite) -> + lists:foreach( + fun(Test) -> + V = ?config(tls_ver, Test), + C = ?config(ciphers, Test), + E = ?config(expected, Test), + P = ?config(prf, Test), + prf_run_test(Config, V, C, E, P) + end, Suite) + end, TestPlan) + end. + +%%-------------------------------------------------------------------- connection_info() -> [{doc,"Test the API function ssl:connection_information/1"}]. @@ -445,7 +492,7 @@ connection_info(Config) when is_list(Config) -> {from, self()}, {mfa, {?MODULE, connection_info_result, []}}, {options, - [{ciphers,[{rsa,des_cbc,sha,no_export}]} | + [{ciphers,[{rsa,des_cbc,sha}]} | ClientOpts]}]), ct:log("Testcase ~p, Client ~p Server ~p ~n", @@ -761,6 +808,14 @@ fallback(Config) when is_list(Config) -> Client, {error,{tls_alert,"inappropriate fallback"}}). %%-------------------------------------------------------------------- +cipher_format() -> + [{doc, "Test that cipher conversion from tuples to binarys works"}]. +cipher_format(Config) when is_list(Config) -> + {ok, Socket} = ssl:listen(0, [{ciphers, ssl:cipher_suites()}]), + ssl:close(Socket). + +%%-------------------------------------------------------------------- + peername() -> [{doc,"Test API function peername/1"}]. @@ -911,6 +966,31 @@ cipher_suites(Config) when is_list(Config) -> [_|_] =ssl:cipher_suites(openssl). %%-------------------------------------------------------------------- +cipher_suites_mix() -> + [{doc,"Test to have old and new cipher suites at the same time"}]. + +cipher_suites_mix(Config) when is_list(Config) -> + CipherSuites = [{ecdh_rsa,aes_128_cbc,sha256,sha256}, {rsa,aes_128_cbc,sha}], + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(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, send_recv_result_active, []}}, + {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, send_recv_result_active, []}}, + {options, [{ciphers, CipherSuites} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). +%%-------------------------------------------------------------------- socket_options() -> [{doc,"Test API function getopts/2 and setopts/2"}]. @@ -2876,7 +2956,61 @@ ciphersuite_vs_version(Config) when is_list(Config) -> _ -> ct:fail({unexpected_server_hello, ServerHello}) end. - + +%%-------------------------------------------------------------------- +conf_signature_algs() -> + [{doc,"Test to set the signature_algs option on both client and server"}]. +conf_signature_algs(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(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, send_recv_result, []}}, + {options, [{active, false}, {signature_algs, [{sha256, rsa}]} | 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, send_recv_result, []}}, + {options, [{active, false}, {signature_algs, [{sha256, rsa}]} | ClientOpts]}]), + + ct:log("Testcase ~p, Client ~p Server ~p ~n", + [self(), Client, Server]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + +%%-------------------------------------------------------------------- +no_common_signature_algs() -> + [{doc,"Set the signature_algs option so that there client and server does not share any hash sign algorithms"}]. +no_common_signature_algs(Config) when is_list(Config) -> + + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, [{signature_algs, [{sha256, rsa}]} + | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {options, [{signature_algs, [{sha384, rsa}]} + | ClientOpts]}]), + + ssl_test_lib:check_result(Server, {error, {tls_alert, "insufficient security"}}, + Client, {error, {tls_alert, "insufficient security"}}). + %%-------------------------------------------------------------------- dont_crash_on_handshake_garbage() -> @@ -3573,8 +3707,84 @@ basic_test(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client). +prf_create_plan(TlsVersions, PRFs, Results) -> + lists:foldl(fun(Ver, Acc) -> + A = prf_ciphers_and_expected(Ver, PRFs, Results), + [A|Acc] + end, [], TlsVersions). +prf_ciphers_and_expected(TlsVer, PRFs, Results) -> + case TlsVer of + TlsVer when TlsVer == sslv3 orelse TlsVer == tlsv1 + orelse TlsVer == 'tlsv1.1' -> + Ciphers = ssl:cipher_suites(), + {_, Expected} = lists:keyfind(md5sha, 1, Results), + [[{tls_ver, TlsVer}, {ciphers, Ciphers}, {expected, Expected}, {prf, md5sha}]]; + 'tlsv1.2' -> + lists:foldl( + fun(PRF, Acc) -> + Ciphers = prf_get_ciphers(TlsVer, PRF), + case Ciphers of + [] -> + ct:log("No ciphers for PRF algorithm ~p. Skipping.", [PRF]), + Acc; + Ciphers -> + {_, Expected} = lists:keyfind(PRF, 1, Results), + [[{tls_ver, TlsVer}, {ciphers, Ciphers}, {expected, Expected}, + {prf, PRF}] | Acc] + end + end, [], PRFs) + end. +prf_get_ciphers(TlsVer, PRF) -> + case TlsVer of + 'tlsv1.2' -> + lists:filter( + fun(C) when tuple_size(C) == 4 andalso + element(4, C) == PRF -> + true; + (_) -> false + end, ssl:cipher_suites()) + end. +prf_run_test(_, TlsVer, [], _, Prf) -> + ct:fail({error, cipher_list_empty, TlsVer, Prf}); +prf_run_test(Config, TlsVer, Ciphers, Expected, Prf) -> + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + BaseOpts = [{active, true}, {versions, [TlsVer]}, {ciphers, Ciphers}], + ServerOpts = BaseOpts ++ ?config(server_opts, Config), + ClientOpts = BaseOpts ++ ?config(client_opts, Config), + Server = ssl_test_lib:start_server( + [{node, ServerNode}, {port, 0}, {from, self()}, + {mfa, {?MODULE, prf_verify_value, [TlsVer, Expected, Prf]}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client( + [{node, ClientNode}, {port, Port}, + {host, Hostname}, {from, self()}, + {mfa, {?MODULE, prf_verify_value, [TlsVer, Expected, Prf]}}, + {options, ClientOpts}]), + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). +prf_verify_value(Socket, TlsVer, Expected, Algo) -> + Ret = ssl:prf(Socket, <<>>, <<>>, [<<>>], 16), + case TlsVer of + sslv3 -> + case Ret of + {error, undefined} -> ok; + _ -> + {error, {expected, {error, undefined}, + got, Ret, tls_ver, TlsVer, prf_algorithm, Algo}} + end; + _ -> + case Ret of + {ok, Expected} -> ok; + {ok, Val} -> {error, {expected, Expected, got, Val, tls_ver, TlsVer, + prf_algorithm, Algo}} + end + end. + send_recv_result_timeout_client(Socket) -> {error, timeout} = ssl:recv(Socket, 11, 500), + {error, timeout} = ssl:recv(Socket, 11, 0), ssl:send(Socket, "Hello world"), receive Msg -> diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl index b0bb77c598..d050812208 100644 --- a/lib/ssl/test/ssl_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_handshake_SUITE.erl @@ -166,10 +166,10 @@ ignore_hassign_extension_pre_tls_1_2(Config) -> CertFile = proplists:get_value(certfile, Opts), [{_, Cert, _}] = ssl_test_lib:pem_to_der(CertFile), HashSigns = #hash_sign_algos{hash_sign_algos = [{sha512, rsa}, {sha, dsa}]}, - {sha512, rsa} = ssl_handshake:select_hashsign(HashSigns, Cert, {3,3}), + {sha512, rsa} = ssl_handshake:select_hashsign(HashSigns, Cert, ecdhe_rsa, tls_v1:default_signature_algs({3,3}), {3,3}), %%% Ignore - {md5sha, rsa} = ssl_handshake:select_hashsign(HashSigns, Cert, {3,2}), - {md5sha, rsa} = ssl_handshake:select_hashsign(HashSigns, Cert, {3,0}). + {md5sha, rsa} = ssl_handshake:select_hashsign(HashSigns, Cert, ecdhe_rsa, tls_v1:default_signature_algs({3,2}), {3,2}), + {md5sha, rsa} = ssl_handshake:select_hashsign(HashSigns, Cert, ecdhe_rsa, tls_v1:default_signature_algs({3,0}), {3,0}). is_supported(Hash) -> Algos = crypto:supports(), diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 90fcd193cc..ed4bd86665 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -905,8 +905,8 @@ anonymous_suites() -> {dh_anon, '3des_ede_cbc', sha}, {dh_anon, aes_128_cbc, sha}, {dh_anon, aes_256_cbc, sha}, - {dh_anon, aes_128_gcm, null}, - {dh_anon, aes_256_gcm, null}, + {dh_anon, aes_128_gcm, null, sha256}, + {dh_anon, aes_256_gcm, null, sha384}, {ecdh_anon,rc4_128,sha}, {ecdh_anon,'3des_ede_cbc',sha}, {ecdh_anon,aes_128_cbc,sha}, @@ -933,12 +933,12 @@ psk_suites() -> {rsa_psk, aes_256_cbc, sha}, {rsa_psk, aes_128_cbc, sha256}, {rsa_psk, aes_256_cbc, sha384}, - {psk, aes_128_gcm, null}, - {psk, aes_256_gcm, null}, - {dhe_psk, aes_128_gcm, null}, - {dhe_psk, aes_256_gcm, null}, - {rsa_psk, aes_128_gcm, null}, - {rsa_psk, aes_256_gcm, null}], + {psk, aes_128_gcm, null, sha256}, + {psk, aes_256_gcm, null, sha384}, + {dhe_psk, aes_128_gcm, null, sha256}, + {dhe_psk, aes_256_gcm, null, sha384}, + {rsa_psk, aes_128_gcm, null, sha256}, + {rsa_psk, aes_256_gcm, null, sha384}], ssl_cipher:filter_suites(Suites). psk_anon_suites() -> diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 47cb2909fb..bd6ecebbd4 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 7.3 +SSL_VSN = 7.3.3 diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 34acad6fd1..919526c5d7 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -2165,10 +2165,19 @@ get_timetrap_info(TCPid, SendToServer) -> Timers -> case [Info || {Handle,Pid,Info} <- Timers, Pid == TCPid, Handle /= infinity] of - [I|_] -> - I; + [{TVal,true}|_] -> + {TVal,{true,test_server:timetrap_scale_factor()}}; + [{TVal,false}|_] -> + {TVal,{false,1}}; [] when SendToServer == true -> - tc_supervisor_req({get_timetrap_info,TCPid}); + case tc_supervisor_req({get_timetrap_info,TCPid}) of + {TVal,true} -> + {TVal,{true,test_server:timetrap_scale_factor()}}; + {TVal,false} -> + {TVal,{false,1}}; + Error -> + Error + end; [] -> undefined end diff --git a/lib/test_server/src/test_server_gl.erl b/lib/test_server/src/test_server_gl.erl index 0acc73047c..444cfa595f 100644 --- a/lib/test_server/src/test_server_gl.erl +++ b/lib/test_server/src/test_server_gl.erl @@ -131,6 +131,10 @@ set_props(GL, PropList) -> %%% Internal functions. init([]) -> + EscChars = case application:get_env(test_server, esc_chars) of + {ok,ECBool} -> ECBool; + _ -> true + end, {ok,#st{tc_supervisor=none, minor=none, minor_monitor=none, @@ -139,7 +143,7 @@ init([]) -> permit_io=gb_sets:empty(), auto_nl=true, levels={1,19,10}, - escape_chars=true + escape_chars=EscChars }}. req(GL, Req) -> |