User defined verify_fun is now called correctly

Background from erlang-questions:

> We use this test suite to verify our PKIX-path-validation code,
> granted we do not yet support CRL-handling but that is on its
> way. Our verify_fun will let you work around the problem that it
> is not yet supported. (Not so fun for you perhaps but a possible
> solution for now).

this is unfortunately not the case since for versions that contain
commit 4dbf3c9e4ae7cfd19b247353369166d31b8f15e5 (it is in R14B04 and
R15B) the documented behaviour (verify_fun will be called for every
certificate) is broken: the verify_fun will only be called, if the
certificate contains unknown extensions.
it is therefore not useful as a CRL workaround (anymore).

best regards

Stefan Grundmann

2 files changed, 112 insertions, 8 deletions

diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index 371f475c85..542033e6ce 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2007-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2012. All Rights Reserved.
 %%
 %% The contents of this file are subject to the Erlang Public License,
 %% Version 1.1, (the "License"); you may not use this file except in
@@ -188,14 +188,14 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef,
     ValidationFunAndState =
 	case VerifyFunAndState of
 	    undefined ->
-		{fun(OtpCert, ExtensionOrError, SslState) ->
+		{fun(OtpCert, ExtensionOrVerifyResult, SslState) ->
 			 ssl_certificate:validate_extension(OtpCert,
-							    ExtensionOrError, SslState)
+							    ExtensionOrVerifyResult, SslState)
 		 end, Role};
 	    {Fun, UserState0} ->
-		{fun(OtpCert, ExtensionOrError, {SslState, UserState}) ->
+		{fun(OtpCert, {extension, _} = Extension, {SslState, UserState}) ->
 			 case ssl_certificate:validate_extension(OtpCert,
-								 ExtensionOrError,
+								 Extension,
 								 SslState) of
 			     {valid, NewSslState} ->
 				 {valid, {NewSslState, UserState}};
@@ -204,8 +204,11 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef,
 						SslState);
 			     {unknown, _} ->
 				 apply_user_fun(Fun, OtpCert,
-						ExtensionOrError, UserState, SslState)
-			 end
+						Extension, UserState, SslState)
+			 end;
+		    (OtpCert, VerifyResult, {SslState, UserState}) ->
+			 apply_user_fun(Fun, OtpCert, VerifyResult, UserState,
+					SslState)
 		 end, {Role, UserState0}}
 	end,
 
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 527263363c..0059a1e1ec 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2007-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2012. All Rights Reserved.
 %%
 %% The contents of this file are subject to the Erlang Public License,
 %% Version 1.1, (the "License"); you may not use this file except in
@@ -250,6 +250,8 @@ all() ->
      no_authority_key_identifier, invalid_signature_client,
      invalid_signature_server, cert_expired,
      client_with_cert_cipher_suites_handshake,
+     verify_fun_always_run_client,
+     verify_fun_always_run_server,
      unknown_server_ca_fail, der_input,
      unknown_server_ca_accept_verify_none,
      unknown_server_ca_accept_verify_peer,
@@ -3217,6 +3219,105 @@ client_with_cert_cipher_suites_handshake(Config) when is_list(Config) ->
     ssl_test_lib:check_result(Server, ok, Client, ok),
     ssl_test_lib:close(Server),
     ssl_test_lib:close(Client).
+
+%%--------------------------------------------------------------------
+verify_fun_always_run_client(doc) ->
+    ["Verify that user verify_fun is always run (for valid and valid_peer not only unknown_extension)"];
+verify_fun_always_run_client(suite) ->
+    [];
+verify_fun_always_run_client(Config) when is_list(Config) ->
+    ClientOpts =  ?config(client_verification_opts, Config),
+    ServerOpts =  ?config(server_verification_opts, Config),
+    {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+    Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
+					      {from, self()},
+					      {mfa, {ssl_test_lib,
+						     no_result, []}},
+					      {options, ServerOpts}]),
+    Port  = ssl_test_lib:inet_port(Server),
+
+    %% If user verify fun is called correctly we fail the connection.
+    %% otherwise we can not tell this case apart form where we miss
+    %% to call users verify fun
+    FunAndState =  {fun(_,{extension, _}, UserState) ->
+			    {unknown, UserState};
+		       (_, valid, [ChainLen]) ->
+			    {valid, [ChainLen + 1]};
+		       (_, valid_peer, [2]) ->
+			    {fail, "verify_fun_was_always_run"};
+		       (_, valid_peer, UserState) ->
+			    {valid, UserState}
+		    end, [0]},
+
+    Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port},
+					      {host, Hostname},
+					      {from, self()},
+					      {mfa, {ssl_test_lib,
+						     no_result, []}},
+					      {options,
+					       [{verify, verify_peer},
+						{verify_fun, FunAndState}
+						| ClientOpts]}]),
+    %% Server error may be esslaccept or closed depending on timing
+    %% this is not a bug it is a circumstance of how tcp works!
+    receive
+	{Server, ServerError} ->
+	    test_server:format("Server Error ~p~n", [ServerError])
+    end,
+
+    ssl_test_lib:check_result(Client, {error, esslconnect}).
+
+%%--------------------------------------------------------------------
+verify_fun_always_run_server(doc) ->
+    ["Verify that user verify_fun is always run (for valid and valid_peer not only unknown_extension)"];
+verify_fun_always_run_server(suite) ->
+    [];
+verify_fun_always_run_server(Config) when is_list(Config) ->
+    ClientOpts =  ?config(client_verification_opts, Config),
+    ServerOpts =  ?config(server_verification_opts, Config),
+    {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
+    %% If user verify fun is called correctly we fail the connection.
+    %% otherwise we can not tell this case apart form where we miss
+    %% to call users verify fun
+    FunAndState =  {fun(_,{extension, _}, UserState) ->
+			    {unknown, UserState};
+		       (_, valid, [ChainLen]) ->
+			    {valid, [ChainLen + 1]};
+		       (_, valid_peer, [2]) ->
+			    {fail, "verify_fun_was_always_run"};
+		       (_, valid_peer, UserState) ->
+			    {valid, UserState}
+		    end, [0]},
+
+    Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
+					      {from, self()},
+					      {mfa, {ssl_test_lib,
+						     no_result, []}},
+					      {options,
+					       [{verify, verify_peer},
+						{verify_fun, FunAndState} |
+						ServerOpts]}]),
+    Port  = ssl_test_lib:inet_port(Server),
+
+    Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port},
+					      {host, Hostname},
+					      {from, self()},
+					      {mfa, {ssl_test_lib,
+						     no_result, []}},
+					      {options,
+					       [{verify, verify_peer}
+						| ClientOpts]}]),
+
+    %% Client error may be esslconnect or closed depending on timing
+    %% this is not a bug it is a circumstance of how tcp works!
+    receive
+	{Client, ClientError} ->
+	    test_server:format("Client Error ~p~n", [ClientError])
+    end,
+
+    ssl_test_lib:check_result(Server, {error, esslaccept}).
+
 %%--------------------------------------------------------------------
 unknown_server_ca_fail(doc) ->
     ["Test that the client fails if the ca is unknown in verify_peer mode"];