From 0df6ffddaa8d1e495ee994d006ad465b1bfaa13c Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Thu, 7 Jul 2022 15:34:18 +0200 Subject: [PATCH 1/7] ssl: Refactor handle_options Split clauses to be seperate functions. --- lib/ssl/src/ssl.erl | 26 +++++++++++--------------- lib/ssl/src/ssl_gen_statem.erl | 4 ++-- lib/ssl/src/tls_connection_1_3.erl | 4 ++-- lib/ssl/src/tls_dtls_connection.erl | 2 +- lib/ssl/test/dtls_api_SUITE.erl | 2 +- 5 files changed, 17 insertions(+), 21 deletions(-) diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index c16c076afd8a..e263f839abc9 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -94,8 +94,8 @@ connection_information/1, connection_information/2]). %% Misc --export([handle_options/2, - handle_options/3, +-export([handle_options/3, + update_options/3, tls_version/1, suite_to_str/1, suite_to_openssl_str/1, @@ -640,7 +640,7 @@ listen(_Port, []) -> {error, nooptions}; listen(Port, Options0) -> try - {ok, Config} = handle_options(Options0, server), + {ok, Config} = handle_options(Options0, server, undefined), do_listen(Port, Config, Config#config.connection_cb) catch Error = {error, _} -> @@ -1513,20 +1513,16 @@ do_listen(Port, #config{transport_info = {Transport, _, _, _,_}} = Config, tls_g do_listen(Port, Config, dtls_gen_connection) -> dtls_socket:listen(Port, Config). --spec handle_options([any()], client | server) -> {ok, #config{}}; - ([any()], ssl_options()) -> ssl_options(). - -handle_options(Opts, Role) -> - handle_options(undefined, undefined, Opts, Role, undefined). +%% Handle ssl options at handshake, handshake_continue +-spec update_options([any()], client | server, map()) -> map(). +update_options(Opts, Role, InheritedSslOpts) when is_map(InheritedSslOpts) -> + {SslOpts, _} = expand_options(Opts, ?RULES), + process_options(SslOpts, InheritedSslOpts, #{role => Role, rules => ?RULES}). -handle_options(Opts, Role, InheritedSslOpts) -> - handle_options(undefined, undefined, Opts, Role, InheritedSslOpts). +-spec handle_options([any()], client | server, undefined|host()) -> {ok, #config{}}. +handle_options(Opts, Role, Host) -> + handle_options(undefined, undefined, Opts, Role, Host). -%% Handle ssl options at handshake, handshake_continue -handle_options(_, _, Opts0, Role, InheritedSslOpts) when is_map(InheritedSslOpts) -> - {SslOpts, _} = expand_options(Opts0, ?RULES), - process_options(SslOpts, InheritedSslOpts, #{role => Role, - rules => ?RULES}); %% Handle all options in listen, connect and handshake handle_options(Transport, Socket, Opts0, Role, Host) -> {SslOpts0, SockOpts0} = expand_options(Opts0, ?RULES), diff --git a/lib/ssl/src/ssl_gen_statem.erl b/lib/ssl/src/ssl_gen_statem.erl index 0b4d032f780a..82fed511b5fe 100644 --- a/lib/ssl/src/ssl_gen_statem.erl +++ b/lib/ssl/src/ssl_gen_statem.erl @@ -546,7 +546,7 @@ initial_hello({call, From}, {start, {Opts, EmOpts}, Timeout}, ssl_options = OrigSSLOptions, socket_options = SockOpts} = State0) -> try - SslOpts = ssl:handle_options(Opts, Role, OrigSSLOptions), + SslOpts = ssl:update_options(Opts, Role, OrigSSLOptions), State = ssl_config(SslOpts, Role, State0), initial_hello({call, From}, {start, Timeout}, State#state{ssl_options = SslOpts, @@ -1325,7 +1325,7 @@ update_ssl_options_from_sni(#{sni_fun := SNIFun, _ -> VersionsOpt = proplists:get_value(versions, SSLOptions, []), FallBackOptions = filter_for_versions(VersionsOpt, OrigSSLOptions), - ssl:handle_options(SSLOptions, server, FallBackOptions) + ssl:update_options(SSLOptions, server, FallBackOptions) end. filter_for_versions([], OrigSSLOptions) -> diff --git a/lib/ssl/src/tls_connection_1_3.erl b/lib/ssl/src/tls_connection_1_3.erl index 90eb9f2474bf..50a5ed8ad839 100644 --- a/lib/ssl/src/tls_connection_1_3.erl +++ b/lib/ssl/src/tls_connection_1_3.erl @@ -240,7 +240,7 @@ user_hello({call, From}, {handshake_continue, NewOptions, Timeout}, #state{static_env = #static_env{role = client = Role}, handshake_env = HSEnv, ssl_options = Options0} = State0) -> - Options = ssl:handle_options(NewOptions, Role, Options0), + Options = ssl:update_options(NewOptions, Role, Options0), State = ssl_gen_statem:ssl_config(Options, Role, State0), {next_state, wait_sh, State#state{start_or_recv_from = From, handshake_env = HSEnv#handshake_env{continue_status = continue}}, @@ -249,7 +249,7 @@ user_hello({call, From}, {handshake_continue, NewOptions, Timeout}, #state{static_env = #static_env{role = server = Role}, handshake_env = #handshake_env{continue_status = {pause, ClientVersions}} = HSEnv, ssl_options = Options0} = State0) -> - Options = #{versions := Versions} = ssl:handle_options(NewOptions, Role, Options0), + Options = #{versions := Versions} = ssl:update_options(NewOptions, Role, Options0), State = ssl_gen_statem:ssl_config(Options, Role, State0), case ssl_handshake:select_supported_version(ClientVersions, Versions) of {3,4} -> diff --git a/lib/ssl/src/tls_dtls_connection.erl b/lib/ssl/src/tls_dtls_connection.erl index 5f27d944c77e..096975276bf9 100644 --- a/lib/ssl/src/tls_dtls_connection.erl +++ b/lib/ssl/src/tls_dtls_connection.erl @@ -171,7 +171,7 @@ user_hello({call, From}, {handshake_continue, NewOptions, Timeout}, #state{static_env = #static_env{role = Role}, handshake_env = HSEnv, ssl_options = Options0} = State0) -> - Options = ssl:handle_options(NewOptions, Role, Options0), + Options = ssl:update_options(NewOptions, Role, Options0), State = ssl_gen_statem:ssl_config(Options, Role, State0), {next_state, hello, State#state{start_or_recv_from = From, handshake_env = HSEnv#handshake_env{continue_status = continue} diff --git a/lib/ssl/test/dtls_api_SUITE.erl b/lib/ssl/test/dtls_api_SUITE.erl index f6dab82bd080..d01ff6404813 100644 --- a/lib/ssl/test/dtls_api_SUITE.erl +++ b/lib/ssl/test/dtls_api_SUITE.erl @@ -377,7 +377,7 @@ client_restarts(Config) -> ct:log("Info: ~p~n", [inet:info(UDPSocket)]), {ok, #config{transport_info = CbInfo, connection_cb = ConnectionCb, - ssl = SslOpts0}} = ssl:handle_options(ClientOpts, client, Address), + ssl = SslOpts0}} = ssl:update_options(ClientOpts, client, Address), SslOpts = {SslOpts0, #socket_options{}, undefined}, ct:sleep(250), From 4daa0482f9c2b5c7fd335d20ca8329bda0babd3b Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Tue, 9 Aug 2022 17:02:45 +0200 Subject: [PATCH 2/7] Refactor option handling Rename expand_options/2 to split_options/2 which is more what it does. Remove some already removed (deprecated) options which is handled earlier. Let process_options/3 have multiple arguments, remove bookkeeping data from its input data and keep that as arguments. --- lib/ssl/src/ssl.erl | 73 +++++++++++++++++++++------------------------ 1 file changed, 34 insertions(+), 39 deletions(-) diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index e263f839abc9..8ca6137b81eb 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -1516,7 +1516,7 @@ do_listen(Port, Config, dtls_gen_connection) -> %% Handle ssl options at handshake, handshake_continue -spec update_options([any()], client | server, map()) -> map(). update_options(Opts, Role, InheritedSslOpts) when is_map(InheritedSslOpts) -> - {SslOpts, _} = expand_options(Opts, ?RULES), + {SslOpts, _} = split_options(Opts, ?RULES), process_options(SslOpts, InheritedSslOpts, #{role => Role, rules => ?RULES}). -spec handle_options([any()], client | server, undefined|host()) -> {ok, #config{}}. @@ -1525,20 +1525,19 @@ handle_options(Opts, Role, Host) -> %% Handle all options in listen, connect and handshake handle_options(Transport, Socket, Opts0, Role, Host) -> - {SslOpts0, SockOpts0} = expand_options(Opts0, ?RULES), - + {SslOpts0, SockOpts0} = split_options(Opts0, ?RULES), + %% Ensure all options are evaluated at startup SslOpts1 = add_missing_options(SslOpts0, ?RULES), - SslOpts2 = #{protocol := Protocol} - = process_options(SslOpts1, - #{}, - #{role => Role, - host => Host, - rules => ?RULES}), - + + Env = #{role => Role, host => Host, rules => ?RULES}, + SslOpts2 = process_options(SslOpts1, #{}, Env), + maybe_client_warn_no_verify(SslOpts2, Role), SslOpts = maps:without([warn_verify_none], SslOpts2), + %% Handle special options + #{protocol := Protocol} = SslOpts2, {Sock, Emulated} = emulated_options(Transport, Socket, Protocol, SockOpts0), ConnetionCb = connection_cb(Protocol), CbInfo = handle_option_cb_info(Opts0, Protocol), @@ -1566,23 +1565,29 @@ handle_options(Transport, Socket, Opts0, Role, Host) -> %% after each successful pass. %% If the value of the counter is unchanged at the end of a pass, %% the processing stops due to faulty input data. -process_options({[], [], _}, OptionsMap, _Env) -> - OptionsMap; -process_options({[], [_|_] = Skipped, Counter}, OptionsMap, Env) - when length(Skipped) < Counter -> - %% Continue handling options if current pass was successful - process_options({Skipped, [], length(Skipped)}, OptionsMap, Env); -process_options({[], [_|_], _Counter}, _OptionsMap, _Env) -> - throw({error, faulty_configuration}); -process_options({[{K0,V} = E|T], S, Counter}, OptionsMap0, Env) -> + +process_options(Opts, Map, Env) -> + process_options(Opts, [], length(Opts), Map, Env). + +process_options([{K0,V} = E|T], S, Counter, OptionsMap0, Env) -> K = maybe_map_key_internal(K0), case check_dependencies(K, OptionsMap0, Env) of true -> OptionsMap = handle_option(K, V, OptionsMap0, Env), - process_options({T, S, Counter}, OptionsMap, Env); + process_options(T, S, Counter, OptionsMap, Env); false -> %% Skip option for next pass - process_options({T, [E|S], Counter}, OptionsMap0, Env) + process_options(T, [E|S], Counter, OptionsMap0, Env) + end; +process_options([], [], _, OptionsMap, _Env) -> + OptionsMap; +process_options([], Skipped, Counter, OptionsMap, Env) -> + case length(Skipped) < Counter of + true -> + %% Continue handling options if current pass was successful + process_options(Skipped, [], length(Skipped), OptionsMap, Env); + false -> + throw({error, faulty_configuration}) end. handle_option(anti_replay = Option, unbound, OptionsMap, #{rules := Rules}) -> @@ -1971,28 +1976,19 @@ dependecies_already_defined(L, OptionsMap) -> lists:all(Fun, L). -expand_options(Opts0, Rules) -> +split_options(Opts0, Rules) -> Opts1 = proplists:expand([{binary, [{mode, binary}]}, - {list, [{mode, list}]}], Opts0), + {list, [{mode, list}]}], Opts0), Opts2 = handle_option_format(Opts1, []), - %% Remove deprecated ssl_imp option Opts = proplists:delete(ssl_imp, Opts2), - AllOpts = maps:keys(Rules), - SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) end, - Opts, - AllOpts ++ - [ssl_imp, %% TODO: remove ssl_imp - cb_info, - client_preferred_next_protocols, %% next_protocol_selector - log_alert]), %% obsoleted by log_level - - SslOpts0 = Opts -- SockOpts, - SslOpts = {SslOpts0, [], length(SslOpts0)}, - {SslOpts, SockOpts}. + DeleteSSLOpts = fun(Key, PropList) -> proplists:delete(Key, PropList) end, + AllOpts = [cb_info, client_preferred_next_protocols] ++ maps:keys(Rules), + SockOpts = lists:foldl(DeleteSSLOpts, Opts, AllOpts), + {Opts -- SockOpts, SockOpts}. -add_missing_options({L0, S, _C}, Rules) -> +add_missing_options(L0, Rules) -> Fun = fun(K0, Acc) -> K = maybe_map_key_external(K0), case proplists:is_defined(K, Acc) of @@ -2004,8 +2000,7 @@ add_missing_options({L0, S, _C}, Rules) -> end end, AllOpts = maps:keys(Rules), - L = lists:foldl(Fun, L0, AllOpts), - {L, S, length(L)}. + lists:foldl(Fun, L0, AllOpts). default_value(Key, Rules) -> {Default, _} = maps:get(Key, Rules, {undefined, []}), From 5aace4ce601326a9c8f47e5ab29f43bc0bf4b39c Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Wed, 10 Aug 2022 14:22:56 +0200 Subject: [PATCH 3/7] fixup! ssl: Refactor handle_options --- lib/ssl/test/dtls_api_SUITE.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/ssl/test/dtls_api_SUITE.erl b/lib/ssl/test/dtls_api_SUITE.erl index d01ff6404813..f6dab82bd080 100644 --- a/lib/ssl/test/dtls_api_SUITE.erl +++ b/lib/ssl/test/dtls_api_SUITE.erl @@ -377,7 +377,7 @@ client_restarts(Config) -> ct:log("Info: ~p~n", [inet:info(UDPSocket)]), {ok, #config{transport_info = CbInfo, connection_cb = ConnectionCb, - ssl = SslOpts0}} = ssl:update_options(ClientOpts, client, Address), + ssl = SslOpts0}} = ssl:handle_options(ClientOpts, client, Address), SslOpts = {SslOpts0, #socket_options{}, undefined}, ct:sleep(250), From 664c5a81effa84ea524f349c91889bf3c20385e7 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Wed, 10 Aug 2022 16:23:50 +0200 Subject: [PATCH 4/7] Refactor option rules Move from header file to ssl.erl, to make it easier to change. --- lib/ssl/src/ssl.erl | 117 +++++++++++++++++++++++++-- lib/ssl/src/ssl_internal.hrl | 103 ----------------------- lib/ssl/test/ssl_handshake_SUITE.erl | 2 +- lib/ssl/test/ssl_npn_hello_SUITE.erl | 2 +- 4 files changed, 113 insertions(+), 111 deletions(-) diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 8ca6137b81eb..5437ead9e46a 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -96,6 +96,7 @@ %% Misc -export([handle_options/3, update_options/3, + option_rules/0, tls_version/1, suite_to_str/1, suite_to_openssl_str/1, @@ -1516,8 +1517,8 @@ do_listen(Port, Config, dtls_gen_connection) -> %% Handle ssl options at handshake, handshake_continue -spec update_options([any()], client | server, map()) -> map(). update_options(Opts, Role, InheritedSslOpts) when is_map(InheritedSslOpts) -> - {SslOpts, _} = split_options(Opts, ?RULES), - process_options(SslOpts, InheritedSslOpts, #{role => Role, rules => ?RULES}). + {SslOpts, _} = split_options(Opts, option_rules()), + process_options(SslOpts, InheritedSslOpts, #{role => Role, rules => option_rules()}). -spec handle_options([any()], client | server, undefined|host()) -> {ok, #config{}}. handle_options(Opts, Role, Host) -> @@ -1525,12 +1526,12 @@ handle_options(Opts, Role, Host) -> %% Handle all options in listen, connect and handshake handle_options(Transport, Socket, Opts0, Role, Host) -> - {SslOpts0, SockOpts0} = split_options(Opts0, ?RULES), + {SslOpts0, SockOpts0} = split_options(Opts0, option_rules()), %% Ensure all options are evaluated at startup - SslOpts1 = add_missing_options(SslOpts0, ?RULES), + SslOpts1 = add_missing_options(SslOpts0, option_rules()), - Env = #{role => Role, host => Host, rules => ?RULES}, + Env = #{role => Role, host => Host, rules => option_rules()}, SslOpts2 = process_options(SslOpts1, #{}, Env), maybe_client_warn_no_verify(SslOpts2, Role), @@ -1552,6 +1553,110 @@ handle_options(Transport, Socket, Opts0, Role, Host) -> }}. +%% This map stores all supported options with default values and +%% list of dependencies: +%% #{