Handling of path validation errors by the application

Changed the behavior of the verify_fun option so that
the application can be responsible for handling path validation
errors even on the server side. Also replaced the not yet
documented validate_extensions_fun to be handled by the
verify_fun instead.

If the verify callback fun returns {fail, Reason}, the verification process is
immediately stopped and an alert is sent to the peer and the TLS/SSL
handshake is terminated. If the verify callback fun returns {valid,
UserState}, the verification process is continued.  If the verify callback
fun always returns {valid, UserState}, the TLS/SSL handshake will not be
terminated with respect to verification failures and the connection
will be established. The verify callback fun will also be
able to verify application specific extensions.

5 files changed, 125 insertions, 128 deletions

diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 90bb50fdcb..dbc5faff14 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -523,55 +523,55 @@ old_listen(Port, Options) ->
     {ok, Pid} = ssl_broker:start_broker(listener),
     ssl_broker:listen(Pid, Port, Options).
 
-handle_options(Opts0, Role) ->
+handle_options(Opts0, _Role) ->
     Opts = proplists:expand([{binary, [{mode, binary}]},
 			     {list, [{mode, list}]}], Opts0),
     
     ReuseSessionFun = fun(_, _, _, _) -> true end,
 
-    AcceptBadCa = fun({bad_cert,unknown_ca}, Acc) ->  Acc;
-		     (Other, Acc) -> [Other | Acc]
-		  end,
-    
-    VerifyFun =
-	fun(ErrorList) ->
-		case lists:foldl(AcceptBadCa, [], ErrorList) of
-		    [] ->    true;
-		    [_|_] -> false
-		end
-	end,
-
-    UserFailIfNoPeerCert = validate_option(fail_if_no_peer_cert, 
-					   proplists:get_value(fail_if_no_peer_cert, Opts, false)),
+    VerifyNoneFun =
+	{fun(_,{bad_cert, unknown_ca}, UserState) ->
+		 {valid, UserState};
+	    (_,{bad_cert, _} = Reason, _) ->
+		 {fail, Reason};
+	    (_,{extension, _}, UserState) ->
+		 {unknown, UserState}
+	 end, []},
+
+    UserFailIfNoPeerCert = handle_option(fail_if_no_peer_cert, Opts, false),
+    UserVerifyFun = handle_option(verify_fun, Opts, undefined),
     CaCerts = handle_option(cacerts, Opts, undefined),
 
-    {Verify, FailIfNoPeerCert, CaCertDefault} = 
+    {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun} =
 	%% Handle 0, 1, 2 for backwards compatibility
 	case proplists:get_value(verify, Opts, verify_none) of
 	    0 ->
-		{verify_none, false, ca_cert_default(verify_none, Role, CaCerts)};
+		{verify_none, false,
+		 ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun};
 	    1  ->
-		{verify_peer, false, ca_cert_default(verify_peer, Role, CaCerts)};
+		{verify_peer, false,
+		 ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun};
 	    2 ->
-		{verify_peer, true,  ca_cert_default(verify_peer, Role, CaCerts)};
+		{verify_peer, true,
+		 ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun};
 	    verify_none ->
-		{verify_none, false, ca_cert_default(verify_none, Role, CaCerts)};
+		{verify_none, false,
+		 ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun};
 	    verify_peer ->
 		{verify_peer, UserFailIfNoPeerCert,
-		 ca_cert_default(verify_peer, Role, CaCerts)};
+		 ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun};
 	    Value ->
 		throw({error, {eoptions, {verify, Value}}})
-	end,   
+	end,
 
     CertFile = handle_option(certfile, Opts, ""),
     
     SSLOptions = #ssl_options{
       versions   = handle_option(versions, Opts, []),
       verify     = validate_option(verify, Verify),
-      verify_fun = handle_option(verify_fun, Opts, VerifyFun),
+      verify_fun = VerifyFun,
       fail_if_no_peer_cert = FailIfNoPeerCert,
       verify_client_once =  handle_option(verify_client_once, Opts, false),
-      validate_extensions_fun = handle_option(validate_extensions_fun, Opts, undefined),
       depth      = handle_option(depth,  Opts, 1),
       cert       = handle_option(cert, Opts, undefined),
       certfile   = CertFile,
@@ -591,7 +591,7 @@ handle_options(Opts0, Role) ->
      },
 
     CbInfo  = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}),    
-    SslOptions = [versions, verify, verify_fun, validate_extensions_fun, 
+    SslOptions = [versions, verify, verify_fun,
 		  fail_if_no_peer_cert, verify_client_once,
 		  depth, cert, certfile, key, keyfile,
 		  password, cacerts, cacertfile, dhfile, ciphers,
@@ -618,7 +618,21 @@ validate_option(ssl_imp, Value) when Value == new; Value == old ->
 validate_option(verify, Value) 
   when Value == verify_none; Value == verify_peer ->
     Value;
-validate_option(verify_fun, Value) when is_function(Value) ->
+validate_option(verify_fun, undefined)  ->
+    undefined;
+%% Backwards compatibility
+validate_option(verify_fun, Fun) when is_function(Fun) ->
+    {fun(_,{bad_cert, _} = Reason, OldFun) ->
+	     case OldFun([Reason]) of
+		 true ->
+		     {valid, OldFun};
+		 false ->
+		     {fail, Reason}
+	     end;
+	(_,{extension, _}, UserState) ->
+	     {unknown, UserState}
+     end, Fun};
+validate_option(verify_fun, {Fun, _} = Value) when is_function(Fun) ->
    Value;
 validate_option(fail_if_no_peer_cert, Value) 
   when Value == true; Value == false ->
@@ -626,9 +640,6 @@ validate_option(fail_if_no_peer_cert, Value)
 validate_option(verify_client_once, Value) 
   when Value == true; Value == false ->
     Value;
-
-validate_option(validate_extensions_fun, Value) when Value == undefined; is_function(Value) ->
-    Value;
 validate_option(depth, Value) when is_integer(Value), 
                                    Value >= 0, Value =< 255->
     Value;
@@ -720,12 +731,11 @@ ca_cert_default(_,_, [_|_]) ->
     undefined;
 ca_cert_default(verify_none, _, _) ->
     undefined;
-%% Client may leave verification up to the user
-ca_cert_default(verify_peer, client,_) ->
+ca_cert_default(verify_peer, {Fun,_}, _) when is_function(Fun) ->
     undefined;
-%% Server that wants to verify_peer must have
+%% Server that wants to verify_peer and has no verify_fun must have
 %% some trusted certs.
-ca_cert_default(verify_peer, server, _) ->
+ca_cert_default(verify_peer, undefined, _) ->
     "".
 
 emulated_options() ->
diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl
index 5026c760bd..6cf57ced81 100644
--- a/lib/ssl/src/ssl_certificate.erl
+++ b/lib/ssl/src/ssl_certificate.erl
@@ -34,7 +34,8 @@
 -export([trusted_cert_and_path/2,
 	 certificate_chain/2, 
 	 file_to_certificats/1,
-	 validate_extensions/6,
+	 %validate_extensions/6,
+	 validate_extension/3,
 	 is_valid_extkey_usage/2,
 	 is_valid_key_usage/2,
 	 select_extension/2,
@@ -110,32 +111,25 @@ file_to_certificats(File) ->
     {ok, List} = ssl_manager:cache_pem_file(File),
     [Bin || {'Certificate', Bin, not_encrypted} <- List].
 %%--------------------------------------------------------------------
--spec validate_extensions([#'Extension'{}], term(), [#'Extension'{}],
-			  boolean(), list(), client | server) -> {[#'Extension'{}], term(), list()}.
+-spec validate_extension(term(), #'Extension'{}, term()) -> {valid, term()} |
+							    {fail, tuple()} |
+							    {unknown, term()}.
 %%
 %% Description:  Validates ssl/tls specific extensions
 %%--------------------------------------------------------------------
-validate_extensions([], ValidationState, UnknownExtensions, _, AccErr, _) -> 
-    {UnknownExtensions, ValidationState, AccErr};
-
-validate_extensions([#'Extension'{extnID = ?'id-ce-extKeyUsage',
-				  extnValue = KeyUse,
-				  critical = true} | Rest], 
-		    ValidationState, UnknownExtensions, Verify, AccErr0, Role) ->
+validate_extension(_,{extension, #'Extension'{extnID = ?'id-ce-extKeyUsage',
+					      extnValue = KeyUse,
+					      critical = true}}, Role) ->
     case is_valid_extkey_usage(KeyUse, Role) of
 	true ->
-	    validate_extensions(Rest, ValidationState, UnknownExtensions, 
-				Verify, AccErr0, Role);
+	    {valid, Role};
 	false ->
-	    AccErr = 
-		not_valid_extension({bad_cert, invalid_ext_key_usage}, Verify, AccErr0),
-	    validate_extensions(Rest, ValidationState, UnknownExtensions, Verify, AccErr, Role)
+	    {fail, {bad_cert, invalid_ext_key_usage}}
     end;
-
-validate_extensions([Extension | Rest],  ValidationState, UnknownExtensions, 
-		    Verify, AccErr, Role) ->
-    validate_extensions(Rest, ValidationState, [Extension | UnknownExtensions],
-		       Verify, AccErr, Role).
+validate_extension(_, {bad_cert, _} = Reason, _) ->
+    {fail, Reason};
+validate_extension(_, _, Role) ->
+    {unknown, Role}.
 
 %%--------------------------------------------------------------------
 -spec is_valid_key_usage(list(), term()) -> boolean().
@@ -248,8 +242,3 @@ is_valid_extkey_usage(KeyUse, client) ->
 is_valid_extkey_usage(KeyUse, server) ->
     %% Server wants to verify client
     is_valid_key_usage(KeyUse, ?'id-kp-clientAuth').
-
-not_valid_extension(Error, true, _) ->
-    throw(Error);
-not_valid_extension(Error, false, AccErrors) ->
-    [Error | AccErrors].
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index c004effb85..7689976ff6 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -500,8 +500,7 @@ certify(#certificate{} = Cert,
 	       ssl_options = Opts} = State) ->
     case ssl_handshake:certify(Cert, CertDbRef, Opts#ssl_options.depth, 
 			       Opts#ssl_options.verify,
-			       Opts#ssl_options.verify_fun,
-			       Opts#ssl_options.validate_extensions_fun, Role) of
+			       Opts#ssl_options.verify_fun, Role) of
         {PeerCert, PublicKeyInfo} ->
 	    handle_peer_cert(PeerCert, PublicKeyInfo, 
 			     State#state{client_certificate_requested = false});
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index add5147fb4..99bc47f04b 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -32,15 +32,13 @@
 -include_lib("public_key/include/public_key.hrl").
 
 -export([master_secret/4, client_hello/5, server_hello/4, hello/4,
-	 hello_request/0, certify/7, certificate/3, 
-	 client_certificate_verify/6, 
-	 certificate_verify/6, certificate_request/2,
-	 key_exchange/2, server_key_exchange_hash/2,  finished/4,
-	 verify_connection/5, 
-	 get_tls_handshake/2, decode_client_key/3,
-	 server_hello_done/0, sig_alg/1,
-         encode_handshake/3, init_hashes/0, 
-         update_hashes/2, decrypt_premaster_secret/2]).
+	 hello_request/0, certify/6, certificate/3,
+	 client_certificate_verify/6, certificate_verify/6,
+	 certificate_request/2, key_exchange/2, server_key_exchange_hash/2,
+	 finished/4, verify_connection/5, get_tls_handshake/2,
+	 decode_client_key/3, server_hello_done/0, sig_alg/1,
+	 encode_handshake/3, init_hashes/0, update_hashes/2,
+	 decrypt_premaster_secret/2]).
 
 -type tls_handshake() :: #client_hello{} | #server_hello{} |
 			 #server_hello_done{} | #certificate{} | #certificate_request{} |
@@ -177,59 +175,55 @@ hello(#client_hello{client_version = ClientVersion, random = Random,
 
 %%--------------------------------------------------------------------
 -spec certify(#certificate{}, term(), integer() | nolimit,
-	      verify_peer | verify_none, fun(), fun(), 
+	      verify_peer | verify_none, {fun(), term},
 	      client | server) ->  {der_cert(), public_key_info()} | #alert{}.
 %%
 %% Description: Handles a certificate handshake message
 %%--------------------------------------------------------------------
-certify(#certificate{asn1_certificates = ASN1Certs}, CertDbRef, 
-	MaxPathLen, Verify, VerifyFun, ValidateFun, Role) -> 
+certify(#certificate{asn1_certificates = ASN1Certs}, CertDbRef,
+	MaxPathLen, _Verify, VerifyFunAndState, Role) ->
     [PeerCert | _] = ASN1Certs,
-    VerifyBool =  verify_bool(Verify),
       
-    ValidateExtensionFun = 
-	case ValidateFun of
+    ValidationFunAndState =
+	case VerifyFunAndState of
 	    undefined ->
-		fun(Extensions, ValidationState, Verify0, AccError) ->
-			ssl_certificate:validate_extensions(Extensions, ValidationState,
-							   [], Verify0, AccError, Role)
-		end;
-	    Fun ->
-		fun(Extensions, ValidationState, Verify0, AccError) ->
-		 {NewExtensions, NewValidationState, NewAccError} 
-			    = ssl_certificate:validate_extensions(Extensions, ValidationState,
-								  [], Verify0, AccError, Role),
-			Fun(NewExtensions, NewValidationState, Verify0, NewAccError)
-		end
+		{fun(OtpCert, ExtensionOrError, SslState) ->
+			 ssl_certificate:validate_extension(OtpCert,
+							    ExtensionOrError, SslState)
+		 end, Role};
+	    {Fun, UserState0} ->
+		{fun(OtpCert, ExtensionOrError, {SslState, UserState}) ->
+			 case ssl_certificate:validate_extension(OtpCert,
+								 ExtensionOrError,
+								SslState) of
+			    {valid, _} ->
+				apply_user_fun(Fun, OtpCert,
+					       ExtensionOrError, UserState,
+					       SslState);
+			    {fail, Reason} ->
+				apply_user_fun(Fun, OtpCert, Reason, UserState,
+					       SslState);
+			     {unknown, _} ->
+				 apply_user_fun(Fun, OtpCert,
+						ExtensionOrError, UserState, SslState)
+			 end
+		 end, {Role, UserState0}}
 	end,
-    try
-	ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbRef) of
-	{TrustedErlCert, CertPath} ->
-	    Result = public_key:pkix_path_validation(TrustedErlCert, 
-						     CertPath, 
-						     [{max_path_length, 
-						       MaxPathLen},
-						      {verify, VerifyBool},
-						      {validate_extensions_fun, 
-						       ValidateExtensionFun}]),
-	    case Result of
-		{error, Reason} ->
-		    path_validation_alert(Reason, Verify);
-		{ok, {PublicKeyInfo,_, []}} ->
-		    {PeerCert, PublicKeyInfo};
-		{ok, {PublicKeyInfo,_, AccErrors = [Error | _]}} ->
-		    case VerifyFun(AccErrors) of
-			true ->
-			    {PeerCert, PublicKeyInfo};
-			false ->
-			    path_validation_alert(Error, Verify)
-		    end
-	    end
-    catch 
-	throw:Alert ->
-	    Alert
+
+    {TrustedErlCert, CertPath}  =
+	ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbRef),
+
+    case public_key:pkix_path_validation(TrustedErlCert,
+					 CertPath,
+					 [{max_path_length,
+					   MaxPathLen},
+					  {verify_fun, ValidationFunAndState}]) of
+	{ok, {PublicKeyInfo,_}} ->
+	    {PeerCert, PublicKeyInfo};
+	{error, Reason} ->
+	    path_validation_alert(Reason)
     end.
-	    
+
 %%--------------------------------------------------------------------
 -spec certificate(der_cert(), term(), client | server) -> #certificate{} | #alert{}. 
 %%
@@ -490,26 +484,21 @@ get_tls_handshake_aux(<<?BYTE(Type), ?UINT24(Length),
 get_tls_handshake_aux(Data, Acc) ->
     {lists:reverse(Acc), Data}.
 
-verify_bool(verify_peer) ->
-    true;
-verify_bool(verify_none) ->
-    false.
-
-path_validation_alert({bad_cert, cert_expired}, _) ->
+path_validation_alert({bad_cert, cert_expired}) ->
     ?ALERT_REC(?FATAL, ?CERTIFICATE_EXPIRED);
-path_validation_alert({bad_cert, invalid_issuer}, _) ->
+path_validation_alert({bad_cert, invalid_issuer}) ->
     ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE);
-path_validation_alert({bad_cert, invalid_signature} , _) ->
+path_validation_alert({bad_cert, invalid_signature}) ->
     ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE);
-path_validation_alert({bad_cert, name_not_permitted}, _) ->
+path_validation_alert({bad_cert, name_not_permitted}) ->
     ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE);
-path_validation_alert({bad_cert, unknown_critical_extension}, _) ->
+path_validation_alert({bad_cert, unknown_critical_extension}) ->
     ?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE);
-path_validation_alert({bad_cert, cert_revoked}, _) ->
+path_validation_alert({bad_cert, cert_revoked}) ->
     ?ALERT_REC(?FATAL, ?CERTIFICATE_REVOKED);
-path_validation_alert({bad_cert, unknown_ca}, _) ->
+path_validation_alert({bad_cert, unknown_ca}) ->
      ?ALERT_REC(?FATAL, ?UNKNOWN_CA);
-path_validation_alert(_, _) ->
+path_validation_alert(_) ->
     ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE).
 
 select_session(Hello, Port, Session, Version, 
@@ -1132,3 +1121,13 @@ key_exchange_alg(Alg) when Alg == dhe_rsa; Alg == dhe_dss;
     ?KEY_EXCHANGE_DIFFIE_HELLMAN;
 key_exchange_alg(_) ->
     ?NULL.
+
+apply_user_fun(Fun, OtpCert, ExtensionOrError, UserState0, SslState) ->
+    case Fun(OtpCert, ExtensionOrError, UserState0) of
+	{valid, UserState} ->
+	    {valid, {SslState, UserState}};
+	{fail, _} = Fail ->
+	    Fail;
+	{unknown, UserState} ->
+	    {unknown, {SslState, UserState}}
+    end.
diff --git a/lib/ssl/src/ssl_session.erl b/lib/ssl/src/ssl_session.erl
index 6db13e5b7a..25e7445180 100644
--- a/lib/ssl/src/ssl_session.erl
+++ b/lib/ssl/src/ssl_session.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %% 
-%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2010. 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
@@ -113,7 +113,7 @@ select_session(Sessions, #ssl_options{ciphers = Ciphers,
  	List ->
  	    hd(List)
     end.
-	    
+
 %% If we can not generate a not allready in use session ID in
 %% ?GEN_UNIQUE_ID_MAX_TRIES we make the new session uncacheable The
 %% value of ?GEN_UNIQUE_ID_MAX_TRIES is stolen from open SSL which