diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index f15d541692e6..7deb4b5b5a4b 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 d079fb35e7a8..ddf9705e3f6f 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -407,8 +407,12 @@ 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. +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 +exeption of when signature_algs option is not explicitly specified, in which case it +will use the default value for signature_algs plus rsa_pkcs1_sha1 to allow +certificates to have this signature but still disallow sha1 use in the TLS protocol, +since @OTP-19152@. > #### Note {: .info } > @@ -4121,29 +4125,82 @@ 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_alg_cert + %% by default as long as signatures_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; + _ -> + assert_version_dep(signature_algs, Versions, ['tlsv1.2', 'tlsv1.3']), + Opts0#{signature_algs => undefined} + end, + case get_opt_list(signature_algs_cert, undefined, UserOpts, Opts) of + {default, undefined} -> + Opts#{signature_algs_cert => undefined}; + {old, _} -> + Opts; + _ -> + assert_version_dep(signature_algs_cert, Versions, ['tlsv1.2', 'tlsv1.3']), + Opts#{signature_algs_cert => undefined} + 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 8dc18a834476..4bcb647a01aa 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, @@ -3667,6 +3671,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) -> @@ -3893,7 +3903,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, @@ -3925,6 +3935,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 9ccd2f5f2b69..f741df25cc3c 100644 --- a/lib/ssl/test/ssl_api_SUITE.erl +++ b/lib/ssl/test/ssl_api_SUITE.erl @@ -605,6 +605,7 @@ root_any_sign() -> [{doc,"Use cert signed with unsported signature for the root will suceed, 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}, @@ -637,8 +638,10 @@ root_any_sign(Config) when is_list(Config) -> peer => [{digest, sha256}, {key, ssl_test_lib:hardcode_rsa_key(1)}]}}), - ssl_test_lib:basic_test(CSucess, [{verify, verify_peer} | SSucess], Config), - ssl_test_lib:basic_alert(CFail, [{verify, verify_peer} | SFail], Config, unsupported_certificate). + SigAlgs = ssl:signature_algs(default, Version), + ssl_test_lib:basic_test(CSucess, [{verify, verify_peer}, {signature_algs, SigAlgs} | SSucess], Config), + ssl_test_lib:basic_alert(CFail, [{verify, verify_peer}, {signature_algs, SigAlgs} | SFail], + Config, unsupported_certificate). %%-------------------------------------------------------------------- connection_information() -> @@ -3215,7 +3218,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), diff --git a/lib/ssl/test/ssl_cert_SUITE.erl b/lib/ssl/test/ssl_cert_SUITE.erl index 23bf6a21c522..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, unsupported_certificate) + ssl_test_lib:basic_alert(ClientOpts, ServerOpts, Config, insufficient_security) end. %%--------------------------------------------------------------------