diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index f15d541692e6..a43995b4ab83 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -175,16 +175,20 @@ handle_client_hello(Version, random = Random, extensions = HelloExt}, #{versions := Versions, - signature_algs := SupportedHashSigns, eccs := SupportedECCs, honor_ecc_order := ECCOrder} = SslOpts, {SessIdTracker, Session0, ConnectionStates0, CertKeyPairs, _}, Renegotiation) -> case dtls_record:is_acceptable_version(Version, Versions) of true -> + TLSVersion = dtls_v1:corresponding_tls_version(Version), + SupportedHashSigns = + ssl_handshake:supported_hashsigns(maps:get(signature_algs, SslOpts, undefined)), Curves = maps:get(elliptic_curves, HelloExt, undefined), ClientHashSigns = maps:get(signature_algs, HelloExt, undefined), - TLSVersion = dtls_v1:corresponding_tls_version(Version), + ClientSignatureSchemes = + tls_handshake:get_signature_ext(signature_algs_cert, HelloExt, + TLSVersion), AvailableHashSigns = ssl_handshake:available_signature_algs( ClientHashSigns, SupportedHashSigns, TLSVersion), ECCCurve = ssl_handshake:select_curve(Curves, SupportedECCs, ECCOrder), @@ -199,7 +203,7 @@ handle_client_hello(Version, throw(?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY)); _ -> #{key_exchange := KeyExAlg} = ssl_cipher_format:suite_bin_to_map(CipherSuite), - case ssl_handshake:select_hashsign({ClientHashSigns, undefined}, OwnCert, KeyExAlg, + case ssl_handshake:select_hashsign({ClientHashSigns, ClientSignatureSchemes}, OwnCert, KeyExAlg, SupportedHashSigns, TLSVersion) of #alert{} = Alert -> throw(Alert); diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index b6d501833675..9ed84263aba8 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -405,10 +405,16 @@ requirements on the signatures used in the certificates that differs from the requirements on digital signatures as a whole. If this is not required this extension is not need. -The client will send a `signature_algorithms_cert` extension (in the client -hello message), if TLS version 1.2 (back-ported to TLS 1.2 in 24.1) or later is -used, and the signature_algs_cert option is explicitly specified. By default, -only the [signature_algs](`t:signature_algs/0`) extension is sent. +The client will send a `signature_algorithms_cert` extension (in the +client hello message), if TLS version 1.2 (back-ported to TLS 1.2 in +24.1) or later is used, and the signature_algs_cert option is +explicitly specified. By default, only the +[signature_algs](`t:signature_algs/0`) extension is sent with the +exception of when signature_algs option is not explicitly specified, +in which case it will append the rsa_pkcs1_sha1 algorithm to the +default value of signature_algs and use it as value for +signature_algs_cert to allow certificates to have this signature but +still disallow sha1 use in the TLS protocol, since @OTP-19152@. > #### Note {: .info } > @@ -4121,29 +4127,80 @@ server_name_indication_default(_) -> opt_signature_algs(UserOpts, #{versions := Versions} = Opts, _Env) -> [TlsVersion|_] = TlsVsns = [tls_version(V) || V <- Versions], - SA = case get_opt_list(signature_algs, undefined, UserOpts, Opts) of - {default, undefined} when ?TLS_GTE(TlsVersion, ?TLS_1_2) -> - DefAlgs = tls_v1:default_signature_algs(TlsVsns), - handle_hashsigns_option(DefAlgs, TlsVersion); - {new, Algs} -> - assert_version_dep(signature_algs, Versions, ['tlsv1.2', 'tlsv1.3']), - SA0 = handle_hashsigns_option(Algs, TlsVersion), - option_error(SA0 =:= [], no_supported_algorithms, {signature_algs, Algs}), - SA0; - {_, Algs} -> - Algs - end, - SAC = case get_opt_list(signature_algs_cert, undefined, UserOpts, Opts) of - {new, Schemes} -> - %% Do not send by default - assert_version_dep(signature_algs_cert, Versions, ['tlsv1.2', 'tlsv1.3']), - SAC0 = handle_signature_algorithms_option(Schemes, TlsVersion), - option_error(SAC0 =:= [], no_supported_signature_schemes, {signature_algs_cert, Schemes}), - SAC0; - {_, Schemes} -> - Schemes - end, - Opts#{signature_algs => SA, signature_algs_cert => SAC}. + case ?TLS_GTE(TlsVersion, ?TLS_1_2) of + true -> + opt_signature_algs_valid(UserOpts, Opts, TlsVsns); + false -> + opt_signature_algs_not_valid(UserOpts, Opts) + end. + +opt_signature_algs_valid(UserOpts, #{versions := Versions} = Opts, [TlsVersion|_] = TlsVsns)-> + SAC1 = case get_opt_list(signature_algs_cert, undefined, UserOpts, Opts) of + {new, Schemes} -> + assert_version_dep(signature_algs_cert, Versions, ['tlsv1.2', 'tlsv1.3']), + SAC0 = handle_signature_algorithms_option(Schemes, TlsVersion), + option_error(SAC0 =:= [], no_supported_signature_schemes, + {signature_algs_cert, Schemes}), + SAC0; + {_, Schemes} -> + Schemes + end, + + {SA, SAC2} = + case get_opt_list(signature_algs, undefined, UserOpts, Opts) of + {default, undefined} -> + %% Smooth upgrade path allow rsa_pkcs1_sha1 for signatures_algs_cert + %% by default as long as signature_algs is set to default + DefAlgs0 = tls_v1:default_signature_algs(TlsVsns), + DefAlgs = handle_hashsigns_option(DefAlgs0, TlsVersion), + DSAC0 = case SAC1 of + undefined -> + [default | DefAlgs ++ sha_rsa(TlsVersion)]; + _ -> + SAC1 + end, + {DefAlgs, DSAC0}; + {new, Algs} -> + assert_version_dep(signature_algs, Versions, ['tlsv1.2', 'tlsv1.3']), + SA0 = handle_hashsigns_option(Algs, TlsVersion), + option_error(SA0 =:= [], no_supported_algorithms, {signature_algs, Algs}), + DSAC0 = case SAC1 of + %% If user sets signature_algs, signature_algs_cert default should + %% be undefined. + [default |_] -> + undefined; + SAC1 -> + SAC1 + end, + {SA0, DSAC0}; + {old, Algs} -> + {Algs, SAC1} + end, + Opts#{signature_algs => SA, signature_algs_cert => SAC2}. + +opt_signature_algs_not_valid(UserOpts, #{versions := Versions} = Opts0)-> + Opts = + case get_opt_list(signature_algs, undefined, UserOpts, Opts0) of + {default, undefined} -> + Opts0#{signature_algs => undefined}; + {old, _} -> + Opts0; + _ -> + option_incompatible([signature_algs, {versions, Versions}]) + end, + case get_opt_list(signature_algs_cert, undefined, UserOpts, Opts) of + {default, undefined} -> + Opts#{signature_algs_cert => undefined}; + {old, _} -> + Opts; + _ -> + option_incompatible([signature_algs_cert, {versions, Versions}]) + end. + +sha_rsa(?TLS_1_2) -> + [{sha, rsa}]; +sha_rsa(?TLS_1_3) -> + [rsa_pkcs1_sha1]. opt_alpn(UserOpts, #{versions := Versions} = Opts, #{role := server}) -> {_, APP} = get_opt_list(alpn_preferred_protocols, undefined, UserOpts, Opts), diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 0f9039a9f4ac..0d320ba4a131 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -126,6 +126,7 @@ add_alpn/2, add_selected_version/1, decode_alpn/1, + supported_hashsigns/1, max_frag_enum/1 ]). @@ -1481,10 +1482,11 @@ signature_algs_ext(SignatureSchemes0) -> signature_algs_cert(undefined) -> undefined; +signature_algs_cert([default | SignatureSchemes]) -> + #signature_algorithms_cert{signature_scheme_list = SignatureSchemes}; signature_algs_cert(SignatureSchemes) -> #signature_algorithms_cert{signature_scheme_list = SignatureSchemes}. - use_srtp_ext(#{use_srtp := #{protection_profiles := Profiles, mki := MKI}}) -> #use_srtp{protection_profiles = Profiles, mki = MKI}; use_srtp_ext(#{}) -> @@ -1739,10 +1741,12 @@ do_select_hashsign(HashSigns, PublicKeyAlgo, SupportedHashSigns) -> is_acceptable_hash_sign(Scheme, SupportedHashSigns); rsa_pss_pss when PublicKeyAlgo == rsa_pss_pss -> %% Backported is_acceptable_hash_sign(Scheme, SupportedHashSigns); - ecdsa when (PublicKeyAlgo == ecdsa) andalso (H == sha) -> + ecdsa when (PublicKeyAlgo == ecdsa) andalso (H == sha) -> is_acceptable_hash_sign({H, S}, SupportedHashSigns) orelse %% TLS-1.2 name is_acceptable_hash_sign(Scheme, SupportedHashSigns); %% TLS-1.3 legacy name - _ -> + ecdsa when (PublicKeyAlgo == ecdsa) -> + is_acceptable_hash_sign({H, S}, SupportedHashSigns); + _ -> false end end, @@ -3666,6 +3670,12 @@ sni(SslOpts) -> disable -> undefined; Hostname -> #sni{hostname = Hostname} end. +supported_hashsigns(undefined) -> + undefined; +supported_hashsigns([default | SigAlgs]) -> + supported_hashsigns(SigAlgs); +supported_hashsigns(SigAlgs) -> + ssl_cipher:signature_schemes_1_2(SigAlgs). %% convert max_fragment_length (in bytes) to the RFC 6066 ENUM max_frag_enum(?MAX_FRAGMENT_LENGTH_BYTES_1) -> @@ -3892,7 +3902,7 @@ path_validation(TrustedCert, Path, ServerName, Role, CertDbHandle, CertDbRef, CR #{cert_ext := CertExt, stapling_state := StaplingState}) -> SignAlgos = maps:get(signature_algs, Opts, undefined), - SignAlgosCert = maps:get(signature_algs_cert, Opts, undefined), + SignAlgosCert = supported_cert_signs(maps:get(signature_algs_cert, Opts, undefined)), ValidationFunAndState = validation_fun_and_state(VerifyFun, #{role => Role, certdb => CertDbHandle, @@ -3924,6 +3934,13 @@ path_validation_cb(?TLS_1_3) -> path_validation_cb(_) -> ?MODULE. +supported_cert_signs(undefined) -> + undefined; +supported_cert_signs([default|Signs]) -> + Signs; +supported_cert_signs(Signs) -> + Signs. + %%%################################################################ %%%# %%%# Tracing diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index e9b95867d0e9..d95a3850f313 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -46,7 +46,7 @@ -export([get_tls_handshakes/4, decode_handshake/3]). %% Handshake helper --export([ocsp_nonce/1]). +-export([ocsp_nonce/1, get_signature_ext/3]). -type tls_handshake() :: #client_hello{} | ssl_handshake:ssl_handshake(). @@ -335,7 +335,8 @@ handle_client_hello(Version, Renegotiation) -> case tls_record:is_acceptable_version(Version, Versions) of true -> - SupportedHashSigns = supported_hashsigns(maps:get(signature_algs, SslOpts, undefined)), + SupportedHashSigns = + ssl_handshake:supported_hashsigns(maps:get(signature_algs, SslOpts, undefined)), Curves = maps:get(elliptic_curves, HelloExt, undefined), ClientHashSigns = get_signature_ext(signature_algs, HelloExt, Version), ClientSignatureSchemes = get_signature_ext(signature_algs_cert, HelloExt, Version), @@ -371,11 +372,6 @@ handle_client_hello(Version, throw(?ALERT_REC(?FATAL, ?PROTOCOL_VERSION)) end. -supported_hashsigns(undefined) -> - undefined; -supported_hashsigns(SigAlgs) -> - ssl_cipher:signature_schemes_1_2(SigAlgs). - handle_client_hello_extensions(Version, Type, Random, CipherSuites, HelloExt, SslOpts, Session0, ConnectionStates0, Renegotiation, HashSign) -> diff --git a/lib/ssl/src/tls_handshake_1_3.erl b/lib/ssl/src/tls_handshake_1_3.erl index 3185ccf05544..2bd286deb985 100644 --- a/lib/ssl/src/tls_handshake_1_3.erl +++ b/lib/ssl/src/tls_handshake_1_3.erl @@ -245,7 +245,9 @@ add_signature_algorithms_cert(Extensions, SignAlgsCert) -> filter_tls13_algs(undefined) -> undefined; filter_tls13_algs(Algo) -> - lists:foldl(fun(Atom, Acc) when is_atom(Atom) -> + lists:foldl(fun(default, Acc) -> + Acc; + (Atom, Acc) when is_atom(Atom) -> [Atom | Acc]; ({sha512, rsa}, Acc) -> [rsa_pkcs1_sha512 | Acc]; diff --git a/lib/ssl/test/ssl_api_SUITE.erl b/lib/ssl/test/ssl_api_SUITE.erl index 37ef7fa82acf..4601db0bc286 100644 --- a/lib/ssl/test/ssl_api_SUITE.erl +++ b/lib/ssl/test/ssl_api_SUITE.erl @@ -58,6 +58,8 @@ select_best_cert/1, select_sha1_cert/0, select_sha1_cert/1, + root_any_sign/0, + root_any_sign/1, connection_information/0, connection_information/1, secret_connection_info/0, @@ -270,7 +272,8 @@ since_1_2() -> [ conf_signature_algs, no_common_signature_algs, - versions_option_based_on_sni + versions_option_based_on_sni, + root_any_sign ]. pre_1_3() -> @@ -593,6 +596,54 @@ select_sha1_cert(Config) when is_list(Config) -> {key, {namedCurve, secp256r1}}]}}), test_sha1_cert_conf(Version, TestConfRSA, TestConfECDSA, Config). +%%-------------------------------------------------------------------- +root_any_sign() -> + [{doc,"Use cert signed with unsupported signature for the root will succeed, " + "as it is not verified"}]. + +root_any_sign(Config) when is_list(Config) -> + Version = ssl_test_lib:protocol_version(Config), + #{client_config := CSucess, server_config := SSucess} = + public_key:pkix_test_data(#{server_chain => + #{root => [{digest, sha}, + {key, ssl_test_lib:hardcode_rsa_key(1)}], + intermediates => [[{digest, sha256}, + {key, ssl_test_lib:hardcode_rsa_key(2)}]], + peer => [{digest, sha256}, {key, ssl_test_lib:hardcode_rsa_key(3)}] + }, + client_chain => + #{root => [{digest, sha}, + {key, ssl_test_lib:hardcode_rsa_key(3)}], + intermediates => [[{digest, sha256}, + {key, ssl_test_lib:hardcode_rsa_key(2)}]], + peer => [{digest, sha256}, + {key, ssl_test_lib:hardcode_rsa_key(1)}]}}), + + #{client_config := CFail, server_config := SFail} = + public_key:pkix_test_data(#{server_chain => + #{root => [{digest, sha256}, + {key, ssl_test_lib:hardcode_rsa_key(1)}], + intermediates => [[{digest, sha}, + {key, ssl_test_lib:hardcode_rsa_key(2)}]], + peer => [{digest, sha256}, {key, ssl_test_lib:hardcode_rsa_key(3)}] + }, + client_chain => + #{root => [{digest, sha256}, + {key, ssl_test_lib:hardcode_rsa_key(3)}], + intermediates => [[{digest, sha}, + {key, ssl_test_lib:hardcode_rsa_key(2)}]], + peer => [{digest, sha256}, + {key, ssl_test_lib:hardcode_rsa_key(1)}]}}), + + %% Makes sha1 disallowed for certificate signatures when set explicitly + %% (default for signature_algs_cert was changed to allow them if signatures_algs is not set explicitly) + SigAlgs = ssl:signature_algs(default, Version), + %% Root signatures are not validated, so its signature will not fail the connection + ssl_test_lib:basic_test(CSucess, [{verify, verify_peer}, {signature_algs, SigAlgs} | SSucess], Config), + %% Intermediate cert signatures are validated, so sha1 signatures will fail connection + ssl_test_lib:basic_alert(CFail, [{verify, verify_peer}, {signature_algs, SigAlgs} | SFail], + Config, unsupported_certificate). + %%-------------------------------------------------------------------- connection_information() -> [{doc,"Test the API function ssl:connection_information/1"}]. @@ -3132,7 +3183,7 @@ options_sni(_Config) -> %% server_name_indication ok. options_sign_alg(_Config) -> %% signature_algs[_cert] - ?OK(#{signature_algs := [_|_], signature_algs_cert := undefined}, + ?OK(#{signature_algs := [_|_], signature_algs_cert := [_|_]}, [], client), ?OK(#{signature_algs := [rsa_pss_rsae_sha512,{sha512,rsa}], signature_algs_cert := undefined}, [{signature_algs, [rsa_pss_rsae_sha512,{sha512,rsa}]}], client), @@ -4584,5 +4635,3 @@ run_sha1_cert_conf(_, #{client_config := ClientOpts, server_config := ServerOpts NVersion = ssl_test_lib:n_version(proplists:get_value(version, Config)), SigOpts = ssl_test_lib:sig_algs(LegacyAlg, NVersion), ssl_test_lib:basic_test([{verify, verify_peer} | ClientOpts] ++ SigOpts, ServerOpts, Config). - - diff --git a/lib/ssl/test/ssl_cert_SUITE.erl b/lib/ssl/test/ssl_cert_SUITE.erl index 03c2f04fcdef..9639e60b7024 100644 --- a/lib/ssl/test/ssl_cert_SUITE.erl +++ b/lib/ssl/test/ssl_cert_SUITE.erl @@ -426,7 +426,7 @@ init_per_testcase(signature_algorithms_bad_curve_secp521r1, Config) -> init_ecdsa_opts(Config, secp521r1); init_per_testcase(_TestCase, Config) -> ssl_test_lib:ct_log_supported_protocol_versions(Config), - ct:timetrap({seconds, 10}), + ct:timetrap({seconds, 15}), Config. end_per_testcase(_TestCase, Config) -> @@ -1224,7 +1224,7 @@ unsupported_sign_algo_cert_client_auth(Config) -> 'tlsv1.3' -> ssl_test_lib:basic_alert(ClientOpts, ServerOpts, Config, certificate_required); _ -> - ssl_test_lib:basic_alert(ClientOpts, ServerOpts, Config, bad_certificate) + ssl_test_lib:basic_alert(ClientOpts, ServerOpts, Config, insufficient_security) end. %%-------------------------------------------------------------------- diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index d4ce93718534..bbf695c1796b 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -462,15 +462,22 @@ default_ecc_cert_chain_conf(eddsa_1_3) -> default_ecc_cert_chain_conf(_) -> default_cert_chain_conf(). -sig_algs(rsa_pss_pss, _) -> +sig_algs(Alg, Version) when is_atom(Version)-> + do_sig_algs(Alg, tls_version(Version)); +sig_algs(Alg, {254,_} = Version) -> + do_sig_algs(Alg, dtls_v1:corresponding_tls_version(Version)); +sig_algs(Alg, Version) -> + do_sig_algs(Alg, Version). + +do_sig_algs(rsa_pss_pss, _) -> [{signature_algs, [rsa_pss_pss_sha512, rsa_pss_pss_sha384, rsa_pss_pss_sha256]}]; -sig_algs(rsa_pss_rsae, _) -> +do_sig_algs(rsa_pss_rsae, _) -> [{signature_algs, [rsa_pss_rsae_sha512, rsa_pss_rsae_sha384, rsa_pss_rsae_sha256]}]; -sig_algs(rsa, Version) when ?TLS_GTE(Version, ?TLS_1_2) -> +do_sig_algs(rsa, Version) when ?TLS_GTE(Version, ?TLS_1_2) -> [{signature_algs, [rsa_pss_rsae_sha512, rsa_pss_rsae_sha384, rsa_pss_rsae_sha256, @@ -479,15 +486,15 @@ sig_algs(rsa, Version) when ?TLS_GTE(Version, ?TLS_1_2) -> {sha256, rsa}, {sha, rsa} ]}]; -sig_algs(ecdsa, Version) when ?TLS_GTE(Version, ?TLS_1_2) -> +do_sig_algs(ecdsa, Version) when ?TLS_GTE(Version, ?TLS_1_2) -> [{signature_algs, [ {sha512, ecdsa}, {sha384, ecdsa}, {sha256, ecdsa}, {sha, ecdsa}]}]; -sig_algs(dsa, Version) when ?TLS_GTE(Version, ?TLS_1_2) -> +do_sig_algs(dsa, Version) when ?TLS_GTE(Version, ?TLS_1_2) -> [{signature_algs, [{sha,dsa}]}]; -sig_algs(_,_) -> +do_sig_algs(_,_) -> []. all_sig_algs() ->