ssl: Add new API functions for cipher suite handling

2 files changed, 164 insertions, 35 deletions

diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 656ed94ea5..49634ad3a5 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -39,7 +39,9 @@
 	]).
 %% SSL/TLS protocol handling
 
--export([cipher_suites/0, cipher_suites/1, eccs/0, eccs/1, versions/0, 
+-export([cipher_suites/0, cipher_suites/1, cipher_suites/2, filter_cipher_suites/2,
+         prepend_cipher_suites/2, append_cipher_suites/2,
+         eccs/0, eccs/1, versions/0, 
          format_error/1, renegotiate/1, prf/5, negotiated_protocol/1, 
 	 connection_information/1, connection_information/2]).
 %% Misc
@@ -379,19 +381,93 @@ negotiated_protocol(#sslsocket{pid = Pid}) ->
 cipher_suites() ->
     cipher_suites(erlang).
 %%--------------------------------------------------------------------
--spec cipher_suites(erlang | openssl | all) -> [ssl_cipher:old_erl_cipher_suite() | string()].
+-spec cipher_suites(erlang | openssl | all) -> 
+                           [ssl_cipher:old_erl_cipher_suite() | string()].
 %% Description: Returns all supported cipher suites.
 %%--------------------------------------------------------------------
 cipher_suites(erlang) ->
     [ssl_cipher:erl_suite_definition(Suite) || Suite <- available_suites(default)];
 
 cipher_suites(openssl) ->
-    [ssl_cipher:openssl_suite_name(Suite) || Suite <- available_suites(default)];
+    [ssl_cipher:openssl_suite_name(Suite) ||
+        Suite <- available_suites(default)];
 
 cipher_suites(all) ->
     [ssl_cipher:erl_suite_definition(Suite) || Suite <- available_suites(all)].
 
 %%--------------------------------------------------------------------
+-spec cipher_suites(default | all, tls_record:tls_version() | dtls_record:dtls_version() |
+                    tls_record:tls_atom_version() |  dtls_record:dtls_atom_version()) -> 
+                           [ssl_cipher:erl_cipher_suite()].
+%% Description: Returns all default and all supported cipher suites for a
+%% TLS/DTLS version
+%%--------------------------------------------------------------------
+cipher_suites(Base, Version) when Version == 'tlsv1.2';
+                                  Version == 'tlsv1.1';
+                                  Version == tlsv1;
+                                  Version == sslv3 ->
+    cipher_suites(Base, tls_record:protocol_version(Version));
+cipher_suites(Base, Version)  when Version == 'dtlsv1.2';
+                                   Version == 'dtlsv1'->
+    cipher_suites(Base, dtls_record:protocol_version(Version));                   
+cipher_suites(Base, Version) ->
+    [ssl_cipher:suite_definition(Suite) || Suite <- supported_suites(Base, Version)].
+
+%%--------------------------------------------------------------------
+-spec filter_cipher_suites([ssl_cipher:erl_cipher_suite()], 
+                           [{key_exchange | cipher | mac | prf, fun()}] | []) -> 
+                                  [ssl_cipher:erl_cipher_suite()].
+%% Description: Removes cipher suites if any of the filter functions returns false
+%% for any part of the cipher suite. This function also calls default filter functions
+%% to make sure the cipher suite are supported by crypto.
+%%--------------------------------------------------------------------
+filter_cipher_suites(Suites, Filters0) ->
+    #{key_exchange_filters := KexF,
+      cipher_filters := CipherF,
+      mac_filters := MacF,
+      prf_filters := PrfF}
+        = ssl_cipher:crypto_support_filters(),
+    Filters = #{key_exchange_filters => add_filter(proplists:get_value(key_exchange, Filters0), KexF),
+                cipher_filters => add_filter(proplists:get_value(cipher, Filters0), CipherF),
+                mac_filters => add_filter(proplists:get_value(mac, Filters0), MacF),
+                prf_filters => add_filter(proplists:get_value(prf, Filters0), PrfF)},
+    ssl_cipher:filter_suites(Suites, Filters).
+%%--------------------------------------------------------------------
+-spec prepend_cipher_suites([ssl_cipher:erl_cipher_suite()] | 
+                            [{key_exchange | cipher | mac | prf, fun()}],
+                            [ssl_cipher:erl_cipher_suite()]) -> 
+                                   [ssl_cipher:erl_cipher_suite()].
+%% Description: Make <Preferred> suites become the most prefered
+%%      suites that is put them at the head of the cipher suite list
+%%      and remove them from <Suites> if present. <Preferred> may be a
+%%      list of cipher suits or a list of filters in which case the
+%%      filters are use on Suites to extract the the preferred
+%%      cipher list.
+%% --------------------------------------------------------------------
+prepend_cipher_suites([First | _] = Preferred, Suites0) when is_map(First) ->
+    Suites = Preferred ++ (Suites0 -- Preferred),
+    Suites;
+prepend_cipher_suites(Filters, Suites) ->
+    Preferred = filter_cipher_suites(Suites, Filters), 
+    Preferred ++ (Suites -- Preferred).
+%%--------------------------------------------------------------------
+-spec append_cipher_suites(Deferred :: [ssl_cipher:erl_cipher_suite()] | 
+                                       [{key_exchange | cipher | mac | prf, fun()}],
+                           [ssl_cipher:erl_cipher_suite()]) -> 
+                                  [ssl_cipher:erl_cipher_suite()].
+%% Description: Make <Deferred> suites suites become the 
+%% least prefered suites that is put them at the end of the cipher suite list
+%% and removed them from <Suites> if present.
+%%
+%%--------------------------------------------------------------------
+append_cipher_suites([First | _] = Deferred, Suites0) when is_map(First)->
+    Suites = (Suites0 -- Deferred) ++ Deferred,
+    Suites;
+append_cipher_suites(Filters, Suites) ->
+    Deferred = filter_cipher_suites(Suites, Filters), 
+    (Suites -- Deferred) ++  Deferred.
+
+%%--------------------------------------------------------------------
 -spec eccs() -> tls_v1:curves().
 %% Description: returns all supported curves across all versions
 %%--------------------------------------------------------------------
@@ -636,11 +712,16 @@ tls_version({254, _} = Version) ->
 available_suites(default) ->  
     Version = tls_record:highest_protocol_version([]),			  
     ssl_cipher:filter_suites(ssl_cipher:suites(Version));
-
 available_suites(all) ->  
     Version = tls_record:highest_protocol_version([]),			  
     ssl_cipher:filter_suites(ssl_cipher:all_suites(Version)).
 
+supported_suites(default, Version) ->  
+    ssl_cipher:suites(Version);
+
+supported_suites(all, Version) ->  
+    ssl_cipher:all_suites(Version).
+
 do_listen(Port, #config{transport_info = {Transport, _, _, _}} = Config, tls_connection) ->
     tls_socket:listen(Transport, Port, Config);
 
@@ -1150,7 +1231,10 @@ handle_cipher_option(Value, Version)  when is_list(Value) ->
 binary_cipher_suites(Version, []) -> 
     %% Defaults to all supported suites that does
     %% not require explicit configuration
-    ssl_cipher:filter_suites(ssl_cipher:suites(tls_version(Version)));
+    default_binary_suites(Version);
+binary_cipher_suites(Version, [Map|_] = Ciphers0) when is_map(Map) ->
+    Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0],
+    binary_cipher_suites(Version, Ciphers);
 binary_cipher_suites(Version, [Tuple|_] = Ciphers0) when is_tuple(Tuple) ->
     Ciphers = [ssl_cipher:suite(tuple_to_map(C)) || C <- Ciphers0],
     binary_cipher_suites(Version, Ciphers);
@@ -1160,7 +1244,7 @@ binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0)
 	[] ->
 	    %% Defaults to all supported suites that does
 	    %% not require explicit configuration
-	    ssl_cipher:filter_suites(ssl_cipher:suites(tls_version(Version)));
+	    default_binary_suites(Version);
 	Ciphers ->
 	    Ciphers
     end;
@@ -1173,6 +1257,9 @@ binary_cipher_suites(Version, Ciphers0)  ->
     Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:lexemes(Ciphers0, ":")],
     binary_cipher_suites(Version, Ciphers).
 
+default_binary_suites(Version) ->
+    ssl_cipher:filter_suites(ssl_cipher:suites(tls_version(Version))).
+
 tuple_to_map({Kex, Cipher, Mac}) ->
     #{key_exchange => Kex,
       cipher => Cipher,
@@ -1462,3 +1549,8 @@ reject_alpn_next_prot_options([Opt| AlpnNextOpts], Opts) ->
         false ->
             reject_alpn_next_prot_options(AlpnNextOpts, Opts)
     end.
+
+add_filter(undefined, Filters) ->
+    Filters;
+add_filter(Filter, Filters) ->
+    [Filter | Filters].
diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl
index 2c46de29e2..78fa9ee753 100644
--- a/lib/ssl/src/ssl_cipher.erl
+++ b/lib/ssl/src/ssl_cipher.erl
@@ -36,9 +36,10 @@
 -export([security_parameters/2, security_parameters/3, suite_definition/1,
 	 erl_suite_definition/1,
 	 cipher_init/3, decipher/6, cipher/5, decipher_aead/6, cipher_aead/6,
-	 suite/1, suites/1, all_suites/1, 
+	 suite/1, suites/1, all_suites/1, crypto_support_filters/0,
 	 ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, srp_suites/0,
-	 rc4_suites/1, des_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1,
+	 rc4_suites/1, des_suites/1, openssl_suite/1, openssl_suite_name/1, 
+         filter/2, filter_suites/1, filter_suites/2,  
 	 hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1,
 	 random_bytes/1, calc_mac_hash/4,
          is_stream_ciphersuite/1]).
@@ -1817,9 +1818,9 @@ openssl_suite("ECDH-RSA-AES256-GCM-SHA384") ->
     ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384.
 
 %%--------------------------------------------------------------------
--spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite().
+-spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite() | erl_cipher_suite().
 %%
-%% Description: Return openssl cipher suite name.
+%% Description: Return openssl cipher suite name if possible
 %%-------------------------------------------------------------------
 openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) ->
     "DHE-RSA-AES256-SHA";
@@ -2029,38 +2030,74 @@ filter(DerCert, Ciphers) ->
 	{_, ecdsa} ->
 	    Ciphers1 -- rsa_signed_suites()
     end.
-	
 %%--------------------------------------------------------------------
--spec filter_suites([cipher_suite()]) -> [cipher_suite()].
+-spec filter_suites([erl_cipher_suite()] | [cipher_suite()], map()) ->
+                           [erl_cipher_suite()] |  [cipher_suite()].
+%%
+%% Description: Filter suites using supplied filter funs
+%%-------------------------------------------------------------------	
+filter_suites(Suites, Filters) ->
+    ApplyFilters = fun(Suite) ->
+                           filter_suite(Suite, Filters)
+                   end,
+    lists:filter(ApplyFilters, Suites).
+    
+filter_suite(#{key_exchange := KeyExchange, 
+               cipher := Cipher, 
+               mac := Hash,
+               prf := Prf}, 
+             #{key_exchange_filters := KeyFilters,
+               cipher_filters := CipherFilters, 
+               mac_filters := HashFilters,
+               prf_filters := PrfFilters}) ->
+    all_filters(KeyExchange, KeyFilters) andalso
+        all_filters(Cipher, CipherFilters) andalso
+        all_filters(Hash, HashFilters) andalso
+        all_filters(Prf, PrfFilters);
+filter_suite(Suite, Filters) ->
+    filter_suite(suite_definition(Suite), Filters).
+
+%%--------------------------------------------------------------------
+-spec filter_suites([erl_cipher_suite()] | [cipher_suite()]) -> 
+                           [erl_cipher_suite()] | [cipher_suite()].
 %%
 %% Description: Filter suites for algorithms supported by crypto.
 %%-------------------------------------------------------------------
-filter_suites(Suites = [Value|_]) when is_map(Value) ->
-    Algos = crypto:supports(),
-    Hashs =  proplists:get_value(hashs, Algos),
-    lists:filter(fun(#{key_exchange := KeyExchange, 
-                       cipher := Cipher, 
-                       mac := Hash,
-                       prf := Prf}) ->
-			 is_acceptable_keyexchange(KeyExchange, proplists:get_value(public_keys, Algos)) andalso
-			     is_acceptable_cipher(Cipher, proplists:get_value(ciphers, Algos)) andalso
-			     is_acceptable_hash(Hash, Hashs) andalso
-			     is_acceptable_prf(Prf, Hashs)
-		 end, Suites);
-
 filter_suites(Suites) ->
+    Filters = crypto_support_filters(),
+    filter_suites(Suites, Filters).
+
+all_filters(_, []) ->
+    true;
+all_filters(Value, [Filter| Rest]) ->
+    case Filter(Value) of
+        true ->
+            all_filters(Value, Rest);
+        false ->
+            false
+    end.
+crypto_support_filters() ->
     Algos = crypto:supports(),
     Hashs =  proplists:get_value(hashs, Algos),
-    lists:filter(fun(Suite) ->
-			 #{key_exchange := KeyExchange, 
-                           cipher := Cipher, 
-                           mac := Hash,
-                           prf := Prf} = suite_definition(Suite),
-			 is_acceptable_keyexchange(KeyExchange, proplists:get_value(public_keys, Algos)) andalso
-			     is_acceptable_cipher(Cipher, proplists:get_value(ciphers, Algos)) andalso
-			     is_acceptable_hash(Hash, Hashs) andalso
-			     is_acceptable_prf(Prf, Hashs)
-		 end, Suites).
+    #{key_exchange_filters => 
+          [fun(KeyExchange) ->
+                  is_acceptable_keyexchange(KeyExchange,  
+                                            proplists:get_value(public_keys, Algos))
+           end],
+      cipher_filters => 
+          [fun(Cipher) ->
+                  is_acceptable_cipher(Cipher,  
+                                       proplists:get_value(ciphers, Algos))
+           end],
+      mac_filters => 
+          [fun(Hash) ->
+                  is_acceptable_hash(Hash, Hashs)
+          end],
+      prf_filters => 
+          [fun(Prf) ->
+                  is_acceptable_prf(Prf,  
+                                    proplists:get_value(hashs, Algos))
+          end]}.
 
 is_acceptable_keyexchange(KeyExchange, _Algos) when KeyExchange == psk;
                                                     KeyExchange == null ->