Merge pull request #4600 from dgud/dgud/ssl/windows-test-cuddle

Increase cert chain duplicates

3 files changed, 145 insertions, 65 deletions

diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl
index 674870dd15..424bf05791 100644
--- a/lib/ssl/src/ssl_certificate.erl
+++ b/lib/ssl/src/ssl_certificate.erl
@@ -75,7 +75,7 @@ trusted_cert_and_paths(Chain,  CertDbHandle, CertDbRef, PartialChainHandler) ->
     %% If the chain contains extraneous certificates there could be
     %% more than one possible path such chains might be used to phase out 
     %% an old certificate. 
-    Paths = paths(Chain, CertDbHandle, CertDbRef),
+    Paths = paths(Chain, CertDbHandle),
     lists:map(fun(Path) ->
                       case handle_partial_chain(Path, PartialChainHandler, CertDbHandle, CertDbRef) of
                           {unknown_ca, _} = Result ->
@@ -439,38 +439,38 @@ pre_1_3_hash(sha1) ->
 pre_1_3_hash(Hash) ->
     Hash.
 
-paths(Chain, CertDbHandle, CertDbRef) ->
-    paths(Chain, Chain, CertDbHandle, CertDbRef, []).
+paths(Chain, CertDbHandle) ->
+    paths(Chain, Chain, CertDbHandle, []).
 
-paths([Root], _, _, _, Path) ->
-    [[Root | Path]]; 
-paths([Cert1, Cert2 | Rest], Chain, CertDbHandle, CertDbRef, Path) ->
+paths([Root], _, _, Path) ->
+    [[Root | Path]];
+paths([Cert1, Cert2 | Rest], Chain, CertDbHandle, Path) ->
     case public_key:pkix_is_issuer(Cert1, Cert2) of
         true ->
             %% Chain orded so far
-            paths([Cert2 | Rest], Chain, CertDbHandle, CertDbRef, [Cert1 | Path]);
+            paths([Cert2 | Rest], Chain, CertDbHandle, [Cert1 | Path]);
         false ->
             %% Chain is unorded and/or contains extraneous certificates
-            unorded_or_extraneous(Chain, CertDbHandle, CertDbRef)
+            unorded_or_extraneous(Chain, CertDbHandle)
     end.
-        
-unorded_or_extraneous([Peer | FalseChain], CertDbHandle, CertDbRef) ->
-    ChainCandidates = extraneous_chains(FalseChain),
-    lists:map(fun(Candidate) -> 
-                      path_candidate(Peer, Candidate, CertDbHandle, CertDbRef)
-              end, 
+
+unorded_or_extraneous([Peer | UnorderedChain], CertDbHandle) ->
+    ChainCandidates = extraneous_chains(UnorderedChain),
+    lists:map(fun(Candidate) ->
+                      path_candidate(Peer, Candidate, CertDbHandle)
+              end,
               ChainCandidates).
 
-path_candidate(Peer, ChainCandidateCAs, CertDbHandle, _CertDbRef) ->
+path_candidate(Peer, ChainCandidateCAs, CertDbHandle) ->
     {ok,  ExtractedCerts} = ssl_pkix_db:extract_trusted_certs({der, ChainCandidateCAs}),
-    %% certificate_chain/4 will make sure the chain is ordered 
-    case certificate_chain(Peer, CertDbHandle, ExtractedCerts, []) of        
+    %% certificate_chain/4 will make sure the chain is ordered
+    case certificate_chain(Peer, CertDbHandle, ExtractedCerts, []) of
         {ok, undefined, Chain} ->
             lists:reverse(Chain);
         {ok, Root, Chain} ->
             [Root | lists:reverse(Chain)]
-    end.            
-   
+    end.
+
 handle_partial_chain([IssuerCert| Rest] = Path, PartialChainHandler, CertDbHandle, CertDbRef) ->
     case public_key:pkix_is_self_signed(IssuerCert) of
         true -> %% IssuerCert = ROOT (That is ROOT was included in chain)
@@ -546,8 +546,8 @@ extraneous_chains(Certs) ->
     Subjects = [{subject(Cert), Cert} || Cert <- Certs],
     Duplicates = find_duplicates(Subjects),
     %% Number of certs with duplicates (same subject) has been limited
-    %% to two and the maximum number of combinations is limited to 4.
-    build_candidates(Duplicates, 2, 4).
+    %% to 4 and the maximum number of combinations is limited to 16.
+    build_candidates(Duplicates, 4, 16).
 
 build_candidates(Map, Duplicates, Combinations) ->
     Subjects = maps:keys(Map),
@@ -568,7 +568,7 @@ build_candidates([H|T], Map, Duplicates, Combinations, Max, Acc0) ->
 		    Acc = [[Cert|L] || Cert <- Certs, L <- Acc0],
 		    build_candidates(T, Map, Duplicates - 1, Combinations * Counter, Max, Acc)
 		end;
-	{[Cert|_], _} ->
+	{[Cert|_Throw], _Counter} ->
 	    case Acc0 of
 		[] ->
 		    Acc = [[Cert]],
diff --git a/lib/ssl/test/ssl_cert_SUITE.erl b/lib/ssl/test/ssl_cert_SUITE.erl
index efa01fda76..a142115b55 100644
--- a/lib/ssl/test/ssl_cert_SUITE.erl
+++ b/lib/ssl/test/ssl_cert_SUITE.erl
@@ -98,6 +98,8 @@
          unsupported_sign_algo_cert_client_auth/1,
          longer_chain/0,
          longer_chain/1,
+         duplicate_chain/0,
+         duplicate_chain/1,
          key_auth_ext_sign_only/0,
          key_auth_ext_sign_only/1,
          hello_retry_request/0,
@@ -870,6 +872,62 @@ longer_chain(Config) when is_list(Config) ->
                                            proplists:delete(cacerts, ClientOpts0)], Config),
     ssl_test_lib:basic_test(ClientOpts, ServerOpts, Config).
 
+duplicate_chain() ->
+    [{doc, "Manual test of chain with duplicate entries"}].
+duplicate_chain(Config)
+  when is_list(Config) ->
+    Key1 = ssl_test_lib:hardcode_rsa_key(1),
+    Key2 = ssl_test_lib:hardcode_rsa_key(2),
+    Key3 = ssl_test_lib:hardcode_rsa_key(3),
+    Key4 = ssl_test_lib:hardcode_rsa_key(4),
+    Key5 = ssl_test_lib:hardcode_rsa_key(5),
+
+    #{server_config := ServerOpts0, client_config := ClientOpts0} =
+        public_key:pkix_test_data(#{server_chain => #{root => [{key, Key1}],
+                                                      peer => [{key, Key5}]},
+                                    client_chain => #{root => [{key, Key3}],
+                                                      intermediates => [[{key, Key2}], [{key, Key3}]],
+                                                      peer => [{key, Key1}]}}),
+
+    #{client_config := ClientOptsNew} =
+        public_key:pkix_test_data(#{server_chain => #{root => [{key, Key1}],
+                                                      peer => [{key, Key5}]},
+                                    client_chain => #{root => [{key, Key4}],
+                                                      intermediates => [[{key, Key2}], [{key, Key1}]],
+                                                      peer => [{key, Key1}]}}),
+
+    ServerCas0 = proplists:get_value(cacerts, ServerOpts0),
+    ClientCas0 = proplists:get_value(cacerts, ClientOpts0),
+
+    {[Peer,CI1,CI2,CROld], CROld} = chain_and_root(ClientOpts0),
+    {[_Peer,CI1New,CI2New,CRNew], CRNew} = chain_and_root(ClientOptsNew),
+
+    ServerCas = [CRNew|ServerCas0 -- [CROld]],
+    ServerOpts = ssl_test_lib:ssl_options([{verify, verify_peer} |
+                                           lists:keyreplace(cacerts, 1, ServerOpts0, {cacerts, ServerCas})],
+                                          Config),
+    ClientOpts = ssl_test_lib:ssl_options([{verify, verify_peer} |
+                                           lists:keyreplace(cacerts, 1,
+                                                            lists:keyreplace(cert, 1, ClientOpts0,
+                                                                             {cert, [Peer,CI1New,CI2New,CI1,CI2,CRNew,CROld]}),
+                                                            {cacerts, ClientCas0})],
+                                          Config),
+    ssl_test_lib:basic_test(ClientOpts, ServerOpts, Config),
+    ClientOpts2 = ssl_test_lib:ssl_options([{verify, verify_peer} |
+                                            lists:keyreplace(cacerts, 1,
+                                                             lists:keyreplace(cert, 1, ClientOpts0,
+                                                                              {cert, [Peer,CI1,CI1New,CI2,CI2New,CROld,CRNew]}),
+                                                             {cacerts, ClientCas0})],
+                                           Config),
+    ssl_test_lib:basic_test(ClientOpts2, ServerOpts, Config),
+    ok.
+
+chain_and_root(Config) ->
+    OwnCert = proplists:get_value(cert, Config),
+    {ok, ExtractedCAs} = ssl_pkix_db:extract_trusted_certs({der, proplists:get_value(cacerts, Config)}),
+    {ok, Root, Chain} = ssl_certificate:certificate_chain(OwnCert, ets:new(foo, []), ExtractedCAs, []),
+    {Chain, Root}.
+
 %%--------------------------------------------------------------------
 %% TLS 1.3 Test cases  -----------------------------------------------
 %%--------------------------------------------------------------------
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index ddaba06bca..012eb9217e 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -176,7 +176,9 @@
          ecdsa_suites/1,
          der_to_pem/2,
          pem_to_der/1,
-         appropriate_sha/1
+         appropriate_sha/1,
+         format_certs/1,
+         format_cert/1
         ]).
 
 -export([maybe_force_ipv4/1,
@@ -206,6 +208,7 @@
 -record(sslsocket, { fd = nil, pid = nil}).
 -define(SLEEP, 1000).
 -define(DEFAULT_CURVE, secp256r1).
+-define(PRINT_DEPTH, 100).
 
 %%====================================================================
 %% API
@@ -418,7 +421,7 @@ run_server(Opts) ->
     Options = proplists:get_value(options, Opts),
     Pid = proplists:get_value(from, Opts),
     Transport =  proplists:get_value(transport, Opts, ssl),
-    ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, Options]),
+    ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, format_options(Options)]),
     %% {ok, ListenSocket} = Transport:listen(Port, Options),
     case Transport:listen(Port, Options) of
         {ok, ListenSocket} ->
@@ -542,9 +545,9 @@ connect(ListenSocket, _Opts) ->
 connect(_, _, 0, AcceptSocket, _, _, _) ->
     AcceptSocket;
 connect(ListenSocket, Node, _N, _, Timeout, SslOpts, cancel) ->
-    ct:log("ssl:transport_accept(~p)~n", [ListenSocket]),
+    ct:log("ssl:transport_accept(~P)~n", [ListenSocket, ?PRINT_DEPTH]),
     {ok, AcceptSocket} = ssl:transport_accept(ListenSocket),    
-    ct:log("~p:~p~nssl:handshake(~p,~p,~p)~n", [?MODULE,?LINE, AcceptSocket, SslOpts,Timeout]),
+    ct:log("~p:~p~nssl:handshake(~p,~p,~p)~n", [?MODULE,?LINE, AcceptSocket, format_options(SslOpts),Timeout]),
 
     case ssl:handshake(AcceptSocket, SslOpts, Timeout) of
 	{ok, Socket0, Ext} ->
@@ -556,7 +559,7 @@ connect(ListenSocket, Node, _N, _, Timeout, SslOpts, cancel) ->
 	    Result
     end;
 connect(ListenSocket, Node, N, _, Timeout, SslOpts, [_|_] =ContOpts0) ->
-    ct:log("ssl:transport_accept(~p)~n", [ListenSocket]),
+    ct:log("ssl:transport_accept(~P)~n", [ListenSocket, ?PRINT_DEPTH]),
     {ok, AcceptSocket} = ssl:transport_accept(ListenSocket),    
     ct:log("~p:~p~nssl:handshake(~p,~p,~p)~n", [?MODULE,?LINE, AcceptSocket, SslOpts,Timeout]),
 
@@ -588,7 +591,7 @@ connect(ListenSocket, Node, N, _, Timeout, SslOpts, [_|_] =ContOpts0) ->
 	    Result
     end;
 connect(ListenSocket, Node, N, _, Timeout, [], ContOpts) ->
-    ct:log("ssl:transport_accept(~p)~n", [ListenSocket]),
+    ct:log("ssl:transport_accept(~P)~n", [ListenSocket, ?PRINT_DEPTH]),
     {ok, AcceptSocket} = ssl:transport_accept(ListenSocket),    
     ct:log("~p:~p~nssl:ssl_accept(~p, ~p)~n", [?MODULE,?LINE, AcceptSocket, Timeout]),
 
@@ -600,7 +603,7 @@ connect(ListenSocket, Node, N, _, Timeout, [], ContOpts) ->
 	    Result
     end;
 connect(ListenSocket, _Node, _, _, Timeout, Opts, _) ->
-    ct:log("ssl:transport_accept(~p)~n", [ListenSocket]),
+    ct:log("ssl:transport_accept(~P)~n", [ListenSocket, ?PRINT_DEPTH]),
     {ok, AcceptSocket} = ssl:transport_accept(ListenSocket),    
     ct:log("ssl:handshake(~p,~p, ~p)~n", [AcceptSocket, Opts, Timeout]),
     ssl:handshake(AcceptSocket, Opts, Timeout),
@@ -915,7 +918,7 @@ run_client(Opts) ->
     Options = proplists:get_value(options, Opts),
     ContOpts = proplists:get_value(continue_options, Opts, []),
     ct:log("~p:~p~n~p:connect(~p, ~p)@~p~n", [?MODULE,?LINE, Transport, Host, Port, Node]),
-    ct:log("SSLOpts: ~p", [Options]),
+    ct:log("SSLOpts: ~p", [format_options(Options)]),
     case ContOpts of
         [] ->
             client_loop(Node, Host, Port, Pid, Transport, Options, Opts);
@@ -1243,6 +1246,44 @@ wait_for_result(Pid, Msg) ->
 	%%     Unexpected
     end.
 
+format_options([{cacerts, Certs}|R]) ->
+    [{cacerts, format_certs(Certs)} | format_options(R)];
+format_options([{cert, Certs}|R]) ->
+    [{cert, format_certs(Certs)} | format_options(R)];
+format_options([{key, Key}|R]) ->
+    [{key, lists:flatten(io_lib:format("~W",[Key, ?PRINT_DEPTH]))} | format_options(R)];
+format_options([Opt|R]) ->
+    [Opt | format_options(R)];
+format_options([]) ->
+    [].
+
+format_certs(Certs) when is_list(Certs) ->
+    [lists:flatten(format_cert(C)) || C <- Certs];
+format_certs(Cert) when is_binary(Cert) ->
+    lists:flatten(format_cert(Cert)).
+
+format_cert(BinCert) when is_binary(BinCert) ->
+    OtpCert = #'OTPCertificate'{tbsCertificate = Cert} = public_key:pkix_decode_cert(BinCert, otp),
+    #'OTPTBSCertificate'{subject = Subject, serialNumber = Nr, issuer = Issuer} = Cert,
+    case public_key:pkix_is_self_signed(OtpCert) of
+        true ->
+            io_lib:format("~.3w: ~s ->   selfsigned", [Nr, format_subject(Subject)]);
+        false ->
+            case public_key:pkix_issuer_id(OtpCert, other) of
+                {ok, {IsNr, Issuer0}} ->
+                    io_lib:format("~.3w:~s -> ~.3w:~s", [Nr, format_subject(Subject), IsNr, format_subject(Issuer0)]);
+                {error, _} ->
+                    io_lib:format("~.3w:~s ->    :~s", [Nr, format_subject(Subject), format_subject(Issuer)])
+            end
+    end.
+
+format_subject({rdnSequence, Seq}) ->
+    format_subject(Seq);
+format_subject([[{'AttributeTypeAndValue', ?'id-at-commonName', {_, String}}]|_]) ->
+    String;
+format_subject([_|R]) ->
+    format_subject(R).
+
 cert_options(Config) ->
     ClientCaCertFile = filename:join([proplists:get_value(priv_dir, Config), 
 				      "client", "cacerts.pem"]),
@@ -1909,8 +1950,8 @@ accepters(Acc, N) ->
 
 
 basic_test(COpts, SOpts, Config) ->
-    SType = proplists:get_value(server_type, Config),
-    CType = proplists:get_value(client_type, Config),
+    SType = proplists:get_value(server_type, Config, erlang),
+    CType = proplists:get_value(client_type, Config, erlang),
     {Server, Port} = start_server(SType, COpts, SOpts, Config),
     Client = start_client(CType, Port, COpts, Config),
     gen_check_result(Server, SType, Client, CType),
@@ -3075,19 +3116,23 @@ close_loop(Port, Time, SentClose) ->
     end.
 
 portable_open_port("openssl" = Exe, Args0) ->
-    case os:getenv("WSLENV") of
-	false ->
-	    AbsPath = os:find_executable(Exe),
-	    ct:pal("open_port({spawn_executable, ~p}, [{args, ~p}, stderr_to_stdout]).",
-		   [AbsPath, Args0]),
-	    open_port({spawn_executable, AbsPath},
-		      [{args, Args0}, stderr_to_stdout]);
+    IsWindows = case os:type() of
+                    {win32, _} -> true;
+                    _ -> false
+                end,
+    case IsWindows andalso os:getenv("WSLENV") of
+        false ->
+            AbsPath = os:find_executable(Exe),
+            ct:pal("open_port({spawn_executable, ~p}, [{args, ~p}, stderr_to_stdout]).",
+                   [AbsPath, Args0]),
+            open_port({spawn_executable, AbsPath},
+                      [{args, Args0}, stderr_to_stdout]);
 	_ ->
 	    %% I can't get the new windows version of openssl.exe to be stable
 	    %% certain server tests are failing for no reason.
 	    %% This is using "linux" openssl via wslenv
 
-	    Translate = fun("c:/" ++ _ = Path) ->
+	    Translate = fun([_Drive|":/" ++ _ ]= Path) ->
 				string:trim(os:cmd("wsl wslpath -u " ++ Path));
 			   (Arg) ->
 				Arg
@@ -3102,8 +3147,8 @@ portable_open_port("openssl" = Exe, Args0) ->
 portable_open_port(Exe, Args) ->
     AbsPath = os:find_executable(Exe),
     ct:pal("open_port({spawn_executable, ~p}, [{args, ~p}, stderr_to_stdout]).", [AbsPath, Args]),
-    open_port({spawn_executable, AbsPath}, 
-	      [{args, Args}, stderr_to_stdout]). 
+    open_port({spawn_executable, AbsPath},
+	      [{args, Args}, stderr_to_stdout]).
 
 portable_cmd(Exe, Args) ->
     Port = portable_open_port(Exe, Args),
@@ -3211,14 +3256,6 @@ protocol_version(Config, atom) ->
            tls_record:protocol_version(protocol_version(Config, tuple))	
    end.
 
-protocol_versions(Config) ->
-    Version = protocol_version(Config),
-    case Version of
-        'tlsv1.3' -> %% TLS-1.3 servers shall also support 1.2
-            ['tlsv1.3', 'tlsv1.2'];
-        _ ->
-            [Version]
-    end.
 protocol_options(Config, Options) ->
     Protocol = proplists:get_value(protocol, Config, tls),
     {Protocol, Opts} = lists:keyfind(Protocol, 1, Options),
@@ -3268,21 +3305,6 @@ clean_start(keep_version) ->
     clean_env(keep_version),
     ssl:start().
 
-is_psk_anon_suite({psk, _,_}) ->
-    true;
-is_psk_anon_suite({dhe_psk,_,_}) ->
-    true;
-is_psk_anon_suite({ecdhe_psk,_,_}) ->
-    true;
-is_psk_anon_suite({psk, _,_,_}) ->
-    true;
-is_psk_anon_suite({dhe_psk, _,_,_}) ->
-    true;
-is_psk_anon_suite({ecdhe_psk, _,_,_}) ->
-    true;
-is_psk_anon_suite(_) ->
-    false.
-
 
 tls_version('dtlsv1' = Atom) ->
     dtls_v1:corresponding_tls_version(dtls_record:protocol_version(Atom));