Merge branch 'ia/Vagabond/adt-honor-cipher-order/OTP-11621'

* ia/Vagabond/adt-honor-cipher-order/OTP-11621:
  Implement 'honor_cipher_order' SSL server-side option

5 files changed, 71 insertions, 6 deletions

diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index 80ef419fb7..910dca3889 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -460,6 +460,10 @@ fun(srp, Username :: string(), UserState :: term()) ->
       </item>
       <tag>{log_alert, boolean()}</tag>
       <item>If false, error reports will not be displayed.</item>
+      <tag>{honor_cipher_order, boolean()}</tag>
+      <item>If true, use the server's preference for cipher selection. If false
+      (the default), use the client's preference.
+      </item>
     </taglist>
   </section>
   
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index a7fd9f5f81..4646468cb6 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -640,7 +640,8 @@ handle_options(Opts0, _Role) ->
 			make_next_protocol_selector(
 			  handle_option(client_preferred_next_protocols, Opts, undefined)),
 		    log_alert = handle_option(log_alert, Opts, true),
-		    server_name_indication = handle_option(server_name_indication, Opts, undefined)
+		    server_name_indication = handle_option(server_name_indication, Opts, undefined),
+		    honor_cipher_order = handle_option(honor_cipher_order, Opts, false)
 		   },
 
     CbInfo  = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}),
@@ -652,7 +653,8 @@ handle_options(Opts0, _Role) ->
 		  reuse_session, reuse_sessions, ssl_imp,
 		  cb_info, renegotiate_at, secure_renegotiate, hibernate_after,
 		  erl_dist, next_protocols_advertised,
-		  client_preferred_next_protocols, log_alert, server_name_indication],
+		  client_preferred_next_protocols, log_alert,
+		  server_name_indication, honor_cipher_order],
 
     SockOpts = lists:foldl(fun(Key, PropList) ->
 				   proplists:delete(Key, PropList)
@@ -840,6 +842,8 @@ validate_option(server_name_indication, disable) ->
     disable;
 validate_option(server_name_indication, undefined) ->
     undefined;
+validate_option(honor_cipher_order, Value) when is_boolean(Value) ->
+    Value;
 validate_option(Opt, Value) ->
     throw({error, {options, {Opt, Value}}}).
 
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index 2b9bae6e80..487dfc01d9 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -1029,14 +1029,15 @@ cipher_suites(Suites, true) ->
 
 select_session(SuggestedSessionId, CipherSuites, Compressions, Port, #session{ecc = ECCCurve} = 
 		   Session, Version,
-	       #ssl_options{ciphers = UserSuites} = SslOpts, Cache, CacheCb, Cert) ->
+	       #ssl_options{ciphers = UserSuites, honor_cipher_order = HCO} = 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),
+	    CipherSuite = select_cipher_suite(CipherSuites, Suites, HCO),
 	    Compression = select_compression(Compressions),
 	    {new, Session#session{session_id = SessionId,
 				  cipher_suite = CipherSuite,
@@ -1796,6 +1797,11 @@ handle_srp_extension(#srp{username = Username}, Session) ->
 
 %%-------------Misc --------------------------------
 
+select_cipher_suite(CipherSuites, Suites, false) ->
+    select_cipher_suite(CipherSuites, Suites);
+select_cipher_suite(CipherSuites, Suites, true) ->
+    select_cipher_suite(Suites, CipherSuites).
+
 select_cipher_suite([], _) ->
    no_suite;
 select_cipher_suite([Suite | ClientSuites], SupportedSuites) ->
diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index 0186f9fca2..5a823ec8a4 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -114,7 +114,10 @@
 	  next_protocols_advertised = undefined, %% [binary()],
 	  next_protocol_selector = undefined,  %% fun([binary()]) -> binary())
 	  log_alert             :: boolean(),
-	  server_name_indication = undefined
+	  server_name_indication = undefined,
+	  %% Should the server prefer its own cipher order over the one provided by
+	  %% the client?
+	  honor_cipher_order = false
 	  }).
 
 -record(config, {ssl,               %% SSL parameters
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 1006b23a30..ddc511c652 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -110,7 +110,10 @@ options_tests() ->
      empty_protocol_versions,
      ipv6,
      reuseaddr,
-     tcp_reuseaddr].
+     tcp_reuseaddr,
+     honor_server_cipher_order,
+     honor_client_cipher_order
+].
 
 api_tests() ->
     [connection_info,
@@ -2443,6 +2446,51 @@ tcp_reuseaddr(Config) when is_list(Config) ->
 
 %%--------------------------------------------------------------------
 
+honor_server_cipher_order() ->
+    [{doc,"Test API honor server cipher order."}].
+honor_server_cipher_order(Config) when is_list(Config) ->
+    ClientCiphers = [{rsa, aes_128_cbc, sha}, {rsa, aes_256_cbc, sha}],
+    ServerCiphers = [{rsa, aes_256_cbc, sha}, {rsa, aes_128_cbc, sha}],
+honor_cipher_order(Config, true, ServerCiphers, ClientCiphers, {rsa, aes_256_cbc, sha}).
+
+honor_client_cipher_order() ->
+    [{doc,"Test API honor server cipher order."}].
+honor_client_cipher_order(Config) when is_list(Config) ->
+    ClientCiphers = [{rsa, aes_128_cbc, sha}, {rsa, aes_256_cbc, sha}],
+    ServerCiphers = [{rsa, aes_256_cbc, sha}, {rsa, aes_128_cbc, sha}],
+honor_cipher_order(Config, false, ServerCiphers, ClientCiphers, {rsa, aes_128_cbc, sha}).
+
+honor_cipher_order(Config, Honor, ServerCiphers, ClientCiphers, Expected) ->
+    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, {?MODULE, connection_info_result, []}},
+					{options, [{ciphers, ServerCiphers}, {honor_cipher_order, Honor}
+						   | ServerOpts]}]),
+    Port = ssl_test_lib:inet_port(Server),
+    Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+					{host, Hostname},
+					{from, self()},
+					{mfa, {?MODULE, connection_info_result, []}},
+					{options, [{ciphers, ClientCiphers}, {honor_cipher_order, Honor}
+						   | ClientOpts]}]),
+
+    Version =
+	tls_record:protocol_version(tls_record:highest_protocol_version([])),
+
+    ServerMsg = ClientMsg = {ok, {Version, Expected}},
+
+    ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg),
+
+    ssl_test_lib:close(Server),
+    ssl_test_lib:close(Client).
+
+%%--------------------------------------------------------------------
+
 hibernate() ->
     [{doc,"Check that an SSL connection that is started with option "
       "{hibernate_after, 1000} indeed hibernates after 1000ms of "