From 7dcca29bf8a72ce51c236e19fdc459d44ebd5093 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Tue, 27 Jun 2023 09:53:36 +0200 Subject: [PATCH] ssl: Remove compress handling Compress is deprecated and deemed unsecure so we will never implement it, remove all handling of it to save memory and performance. --- lib/ssl/src/dtls_handshake.erl | 40 ++++----- lib/ssl/src/dtls_record.erl | 69 ++++++--------- lib/ssl/src/ssl_alert.erl | 4 - lib/ssl/src/ssl_alert.hrl | 2 +- lib/ssl/src/ssl_cipher.erl | 14 +-- lib/ssl/src/ssl_connection.hrl | 2 - lib/ssl/src/ssl_handshake.erl | 86 ++++++++----------- lib/ssl/src/ssl_handshake.hrl | 4 +- lib/ssl/src/ssl_internal.hrl | 3 + lib/ssl/src/ssl_manager.erl | 2 - lib/ssl/src/ssl_record.erl | 25 +----- lib/ssl/src/ssl_record.hrl | 12 --- lib/ssl/src/ssl_session.erl | 3 +- lib/ssl/src/ssl_trace.erl | 2 +- lib/ssl/src/tls_dtls_connection.erl | 27 +++--- lib/ssl/src/tls_handshake.erl | 20 ++--- lib/ssl/src/tls_handshake.hrl | 1 - lib/ssl/src/tls_handshake_1_3.erl | 8 +- lib/ssl/src/tls_record.erl | 84 ++++++++---------- .../test/property_test/ssl_eqc_handshake.erl | 10 --- lib/ssl/test/ssl_alert_SUITE.erl | 2 +- lib/ssl/test/ssl_npn_hello_SUITE.erl | 3 - lib/ssl/test/ssl_session_SUITE.erl | 4 +- lib/ssl/test/tls_1_3_record_SUITE.erl | 4 +- .../test/tls_server_session_ticket_SUITE.erl | 1 - 25 files changed, 147 insertions(+), 285 deletions(-) diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index 85faad11b686..1f85bae2ce1d 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -91,7 +91,6 @@ client_hello(_Host, _Port, Cookie, ConnectionStates, cipher_suites = ssl_handshake:cipher_suites(CipherSuites, Renegotiation, Fallback), - compression_methods = ssl_record:compressions(), random = SecParams#security_parameters.client_random, cookie = Cookie, extensions = Extensions @@ -99,7 +98,6 @@ client_hello(_Host, _Port, Cookie, ConnectionStates, hello(#server_hello{server_version = Version, random = Random, cipher_suite = CipherSuite, - compression_method = Compression, session_id = SessionId, extensions = HelloExt}, #{versions := SupportedVersions} = SslOpt, ConnectionStates0, Renegotiation, OldId) -> @@ -107,7 +105,7 @@ hello(#server_hello{server_version = Version, random = Random, case dtls_record:is_acceptable_version(Version, SupportedVersions) of true -> handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, - Compression, HelloExt, SslOpt, + HelloExt, SslOpt, ConnectionStates0, Renegotiation, IsNew); false -> throw(?ALERT_REC(?FATAL, ?PROTOCOL_VERSION)) @@ -121,12 +119,11 @@ hello(#client_hello{client_version = ClientVersion} = Hello, cookie(Key, Address, Port, #client_hello{client_version = Version, random = Random, session_id = SessionId, - cipher_suites = CipherSuites, - compression_methods = CompressionMethods}) -> + cipher_suites = CipherSuites}) -> {Major, Minor} = Version, CookieData = [address_to_bin(Address, Port), <>, - Random, SessionId, CipherSuites, CompressionMethods], + Random, SessionId, CipherSuites, [?NO_COMPRESSION]], crypto:mac(hmac, sha, Key, CookieData). %%-------------------------------------------------------------------- -spec hello_verify_request(binary(), ssl_record:ssl_version()) -> #hello_verify_request{}. @@ -174,7 +171,6 @@ get_dtls_handshake(Version, Fragment, ProtocolBuffers, Options) -> handle_client_hello(Version, #client_hello{session_id = SugesstedId, cipher_suites = CipherSuites, - compression_methods = Compressions, random = Random, extensions = HelloExt}, #{versions := Versions, @@ -193,10 +189,10 @@ handle_client_hello(Version, ECCCurve = ssl_handshake:select_curve(Curves, SupportedECCs, ECCOrder), {Type, #session{cipher_suite = CipherSuite, own_certificates = [OwnCert |_]} = Session1} - = ssl_handshake:select_session(SugesstedId, CipherSuites, - AvailableHashSigns, Compressions, - SessIdTracker, Session0#session{ecc = ECCCurve}, TLSVersion, - SslOpts, CertKeyPairs), + = ssl_handshake:select_session(SugesstedId, CipherSuites, + AvailableHashSigns, + SessIdTracker, Session0#session{ecc = ECCCurve}, + TLSVersion, SslOpts, CertKeyPairs), case CipherSuite of no_suite -> throw(?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY)); @@ -228,11 +224,11 @@ handle_client_hello_extensions(Version, Type, Random, CipherSuites, {Version, {Type, Session}, ConnectionStates, Protocol, ServerHelloExt, HashSign}. handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, - Compression, HelloExt, SslOpt, ConnectionStates0, + HelloExt, SslOpt, ConnectionStates0, Renegotiation, IsNew) -> {ConnectionStates, ProtoExt, Protocol, OcspState} = ssl_handshake:handle_server_hello_extensions( - dtls_record, Random, CipherSuite, Compression, HelloExt, + dtls_record, Random, CipherSuite, HelloExt, dtls_v1:corresponding_tls_version(Version), SslOpt, ConnectionStates0, Renegotiation, IsNew), {Version, SessionId, ConnectionStates, ProtoExt, Protocol, OcspState}. @@ -240,7 +236,7 @@ handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, %%-------------------------------------------------------------------- enc_handshake(#hello_verify_request{protocol_version = Version, - cookie = Cookie}, _Version) -> + cookie = Cookie}, _Version) -> CookieLength = byte_size(Cookie), {Major,Minor} = Version, {?HELLO_VERIFY_REQUEST, < {?HELLO_REQUEST, <<>>}; enc_handshake(#client_hello{client_version = ClientVersion, - random = Random, - session_id = SessionID, - cookie = Cookie, - cipher_suites = CipherSuites, - compression_methods = CompMethods, - extensions = HelloExtensions}, _Version) -> + random = Random, + session_id = SessionID, + cookie = Cookie, + cipher_suites = CipherSuites, + extensions = HelloExtensions}, _Version) -> SIDLength = byte_size(SessionID), CookieLength = byte_size(Cookie), - BinCompMethods = list_to_binary(CompMethods), + BinCompMethods = list_to_binary([?NO_COMPRESSION]), CmLength = byte_size(BinCompMethods), BinCipherSuites = list_to_binary(CipherSuites), CsLength = byte_size(BinCipherSuites), @@ -345,7 +340,7 @@ decode_handshake(Version, ?CLIENT_HELLO, <>) -> TLSVersion = dtls_v1:corresponding_tls_version(Version), LegacyVersion = dtls_v1:corresponding_tls_version({Major, Minor}), @@ -358,7 +353,6 @@ decode_handshake(Version, ?CLIENT_HELLO, < {[binary()], binary()} | #alert{}. %% %% Description: Given old buffer and new data from UDP/SCTP, packs up a records -%% and returns it as a list of tls_compressed binaries also returns leftover +%% and returns it as a list of binaries also returns leftover %% data %%-------------------------------------------------------------------- get_dtls_records(Data, Vinfo, Buffer, #{log_level := LogLevel}) -> @@ -412,7 +412,6 @@ initial_connection_state(ConnectionEnd, BeastMitigation) -> sequence_number => 0, replay_window => init_replay_window(), beast_mitigation => BeastMitigation, - compression_state => undefined, cipher_state => undefined, mac_secret => undefined, secure_renegotiation => undefined, @@ -537,66 +536,52 @@ encode_dtls_cipher_text(Type, Version, Fragment, ?UINT48(Seq), ?UINT16(Length)>>, Fragment], WriteState#{sequence_number => Seq + 1}}. -encode_plain_text(Type, Version, Data, #{compression_state := CompS0, - cipher_state := CipherS0, +encode_plain_text(Type, Version, Data, #{cipher_state := CipherS0, epoch := Epoch, sequence_number := Seq, security_parameters := #security_parameters{ cipher_type = ?AEAD, - bulk_cipher_algorithm = BCAlg, - compression_algorithm = CompAlg} + bulk_cipher_algorithm = BCAlg} } = WriteState0) -> - {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), AAD = start_additional_data(Type, Version, Epoch, Seq), CipherS = ssl_record:nonce_seed(BCAlg, <>, CipherS0), - WriteState = WriteState0#{compression_state => CompS1, - cipher_state => CipherS}, + WriteState = WriteState0#{cipher_state => CipherS}, TLSVersion = dtls_v1:corresponding_tls_version(Version), - ssl_record:cipher_aead(TLSVersion, Comp, WriteState, AAD); -encode_plain_text(Type, Version, Fragment, #{compression_state := CompS0, - epoch := Epoch, - sequence_number := Seq, - cipher_state := CipherS0, - security_parameters := - #security_parameters{compression_algorithm = CompAlg, - bulk_cipher_algorithm = - BulkCipherAlgo} - }= WriteState0) -> - {Comp, CompS1} = ssl_record:compress(CompAlg, Fragment, CompS0), - WriteState1 = WriteState0#{compression_state => CompS1}, - MAC = calc_mac_hash(Type, Version, WriteState1, Epoch, Seq, Comp), + ssl_record:cipher_aead(TLSVersion, Data, WriteState, AAD); +encode_plain_text(Type, Version, Fragment, #{epoch := Epoch, + sequence_number := Seq, + cipher_state := CipherS0, + security_parameters := + #security_parameters{bulk_cipher_algorithm = + BulkCipherAlgo} + }= WriteState) -> + MAC = calc_mac_hash(Type, Version, WriteState, Epoch, Seq, Fragment), TLSVersion = dtls_v1:corresponding_tls_version(Version), - {CipherFragment, CipherS1} = - ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MAC, Fragment, TLSVersion), - {CipherFragment, WriteState0#{cipher_state => CipherS1}}. + {CipherFrag, CipherS1} = ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MAC, Fragment, TLSVersion), + {CipherFrag, WriteState#{cipher_state => CipherS1}}. %%-------------------------------------------------------------------- decode_cipher_text(#ssl_tls{type = Type, version = Version, epoch = Epoch, sequence_number = Seq, fragment = CipherFragment} = CipherText, - #{compression_state := CompressionS0, - cipher_state := CipherS0, + #{cipher_state := CipherS0, security_parameters := #security_parameters{ cipher_type = ?AEAD, - bulk_cipher_algorithm = - BulkCipherAlgo, - compression_algorithm = CompAlg}} = ReadState0, + bulk_cipher_algorithm = BulkCipherAlgo + }} = ReadState0, ConnnectionStates0) -> AAD = start_additional_data(Type, Version, Epoch, Seq), CipherS = ssl_record:nonce_seed(BulkCipherAlgo, <>, CipherS0), TLSVersion = dtls_v1:corresponding_tls_version(Version), case ssl_record:decipher_aead(BulkCipherAlgo, CipherS, AAD, CipherFragment, TLSVersion) of PlainFragment when is_binary(PlainFragment) -> - {Plain, CompressionS} = ssl_record:uncompress(CompAlg, - PlainFragment, CompressionS0), - ReadState1 = ReadState0#{compression_state := CompressionS, - cipher_state := CipherS}, + ReadState1 = ReadState0#{cipher_state := CipherS}, ReadState = update_replay_window(Seq, ReadState1), ConnnectionStates = set_connection_state_by_epoch(ReadState, Epoch, ConnnectionStates0, read), - {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; + {CipherText#ssl_tls{fragment = PlainFragment}, ConnnectionStates}; #alert{} = Alert -> Alert end; @@ -604,26 +589,20 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, epoch = Epoch, sequence_number = Seq, fragment = CipherFragment} = CipherText, - #{compression_state := CompressionS0, - security_parameters := - #security_parameters{ - compression_algorithm = CompAlg}} = ReadState0, + ReadState0, ConnnectionStates0) -> {PlainFragment, Mac, ReadState1} = ssl_record:decipher(dtls_v1:corresponding_tls_version(Version), CipherFragment, ReadState0, true), MacHash = calc_mac_hash(Type, Version, ReadState1, Epoch, Seq, PlainFragment), case ssl_record:is_correct_mac(Mac, MacHash) of true -> - {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, - PlainFragment, CompressionS0), - - ReadState2 = ReadState1#{compression_state => CompressionS1}, - ReadState = update_replay_window(Seq, ReadState2), + ReadState = update_replay_window(Seq, ReadState1), ConnnectionStates = set_connection_state_by_epoch(ReadState, Epoch, ConnnectionStates0, read), - {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; + {CipherText#ssl_tls{fragment = PlainFragment}, ConnnectionStates}; false -> ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) end. + %%-------------------------------------------------------------------- calc_mac_hash(Type, Version, #{mac_secret := MacSecret, diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index 6421c3ea5038..e23db08ffbba 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -155,8 +155,6 @@ description_txt(?DECRYPTION_FAILED_RESERVED) -> "Decryption Failed Reserved"; description_txt(?RECORD_OVERFLOW) -> "Record Overflow"; -description_txt(?DECOMPRESSION_FAILURE) -> - "Decompression Failure"; description_txt(?HANDSHAKE_FAILURE) -> "Handshake Failure"; description_txt(?NO_CERTIFICATE_RESERVED) -> @@ -226,8 +224,6 @@ description_atom(?DECRYPTION_FAILED_RESERVED) -> decryption_failed_reserved; description_atom(?RECORD_OVERFLOW) -> record_overflow; -description_atom(?DECOMPRESSION_FAILURE) -> - decompression_failure; description_atom(?HANDSHAKE_FAILURE) -> handshake_failure; description_atom(?NO_CERTIFICATE_RESERVED) -> diff --git a/lib/ssl/src/ssl_alert.hrl b/lib/ssl/src/ssl_alert.hrl index 90e32a4b2d55..de7f61746e9a 100644 --- a/lib/ssl/src/ssl_alert.hrl +++ b/lib/ssl/src/ssl_alert.hrl @@ -85,7 +85,7 @@ -define(BAD_RECORD_MAC, 20). -define(DECRYPTION_FAILED_RESERVED, 21). -define(RECORD_OVERFLOW, 22). --define(DECOMPRESSION_FAILURE, 30). +%%-define(DECOMPRESSION_FAILURE, 30). NOT USED -define(HANDSHAKE_FAILURE, 40). -define(NO_CERTIFICATE_RESERVED, 41). -define(BAD_CERTIFICATE, 42). diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 8d982f7fa205..33085bb7cf64 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -925,9 +925,9 @@ generic_block_cipher_from_bin(?TLS_1_0, T, IV, HashSize)-> PadLength0 >= Sz1 -> 0; true -> PadLength0 end, - CompressedLength = byte_size(T) - PadLength - 1 - HashSize, - <> = T, + Length = byte_size(T) - PadLength - 1 - HashSize, + <> = T, #generic_block_cipher{content=Content, mac=Mac, padding=Padding, padding_length=PadLength0, next_iv = IV}; @@ -937,8 +937,8 @@ generic_block_cipher_from_bin(Version, T, IV, HashSize) Sz1 = byte_size(T) - 1, <<_:Sz1/binary, ?BYTE(PadLength)>> = T, IVLength = byte_size(IV), - CompressedLength = byte_size(T) - IVLength - PadLength - 1 - HashSize, - <> = T, #generic_block_cipher{content=Content, mac=Mac, padding=Padding, padding_length=PadLength, @@ -946,8 +946,8 @@ generic_block_cipher_from_bin(Version, T, IV, HashSize) generic_stream_cipher_from_bin(T, HashSz) -> Sz = byte_size(T), - CompressedLength = Sz - HashSz, - <> = T, + Length = Sz - HashSz, + <> = T, #generic_stream_cipher{content=Content, mac=Mac}. diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index c8295f339fbd..6c0a937b04ce 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -172,7 +172,6 @@ %% %% connection_state :: map() %% -%% compression_state - not used %% mac_secret - not used %% sequence_number - not used %% secure_renegotiation - not used, no renegotiation_info in TLS 1.3 @@ -190,7 +189,6 @@ %% mac_algorithm - not used %% prf_algorithm - not used %% hash_size - not used -%% compression_algorithm - not used %% master_secret - used for multiple secret types in TLS 1.3 %% client_random - not used %% server_random - not used diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index dbbf0a44967d..54cceadb8ec5 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -70,13 +70,13 @@ %% Cipher suites handling -export([available_suites/2, available_signature_algs/2, available_signature_algs/3, - cipher_suites/3, prf/6, select_session/9, + cipher_suites/3, prf/6, select_session/8, premaster_secret/2, premaster_secret/3, premaster_secret/4]). %% Extensions handling -export([client_hello_extensions/10, handle_client_hello_extensions/10, %% Returns server hello extensions - handle_server_hello_extensions/10, select_curve/2, select_curve/3, + handle_server_hello_extensions/9, select_curve/2, select_curve/3, select_hashsign/4, select_hashsign/5, select_hashsign_algs/3, empty_extensions/2, add_server_share/3, add_alpn/2, add_selected_version/1, decode_alpn/1, max_frag_enum/1 @@ -115,8 +115,6 @@ server_hello(SessionId, Version, ConnectionStates, Extensions) -> ssl_record:pending_connection_state(ConnectionStates, read), #server_hello{server_version = Version, cipher_suite = SecParams#security_parameters.cipher_suite, - compression_method = - SecParams#security_parameters.compression_algorithm, random = SecParams#security_parameters.server_random, session_id = SessionId, extensions = Extensions @@ -544,14 +542,13 @@ encode_handshake(#server_hello{server_version = ServerVersion, random = Random, session_id = Session_ID, cipher_suite = CipherSuite, - compression_method = Comp_method, extensions = Extensions}, _Version) -> SID_length = byte_size(Session_ID), {Major,Minor} = ServerVersion, ExtensionsBin = encode_hello_extensions(Extensions), {?SERVER_HELLO, <>}; + ?BYTE(SID_length), Session_ID/binary, + CipherSuite/binary, ?BYTE(?NO_COMPRESSION), ExtensionsBin/binary>>}; encode_handshake(#certificate{asn1_certificates = ASN1CertList}, _Version) -> ASN1Certs = certs_from_list(ASN1CertList), ACLen = erlang:iolist_size(ASN1Certs), @@ -850,28 +847,26 @@ decode_handshake(_, ?NEXT_PROTOCOL, <>) -> + ?BYTE(SID_length), Session_ID:SID_length/binary, + Cipher_suite:2/binary, ?BYTE(?NO_COMPRESSION)>>) -> #server_hello{ server_version = {Major,Minor}, random = Random, session_id = Session_ID, cipher_suite = Cipher_suite, - compression_method = Comp_method, extensions = empty_extensions(Version, server_hello)}; -decode_handshake(Version, ?SERVER_HELLO, <>) -> +decode_handshake(Version, ?SERVER_HELLO, + <>) -> HelloExtensions = decode_hello_extensions(Extensions, Version, {Major, Minor}, server_hello), - #server_hello{ server_version = {Major,Minor}, random = Random, session_id = Session_ID, cipher_suite = Cipher_suite, - compression_method = Comp_method, extensions = HelloExtensions}; decode_handshake(_Version, ?CERTIFICATE, <>) -> #certificate{asn1_certificates = certs_to_list(ASN1Certs)}; @@ -1064,7 +1059,8 @@ prf(Version, PRFAlgo, Secret, Label, Seed, WantedLength) when ?TLS_1_X(Version)-> {ok, tls_v1:prf(PRFAlgo, Secret, Label, Seed, WantedLength)}. -select_session(SuggestedSessionId, CipherSuites, HashSigns, Compressions, SessIdTracker, Session0, Version, SslOpts, CertKeyAlts) -> +select_session(SuggestedSessionId, CipherSuites, HashSigns, SessIdTracker, Session0, + Version, SslOpts, CertKeyAlts) -> CertKeyPairs = ssl_certificate:available_cert_key_pairs(CertKeyAlts, Version), {SessionId, Resumed} = ssl_session:server_select_session(Version, SessIdTracker, SuggestedSessionId, SslOpts, CertKeyPairs), @@ -1072,25 +1068,22 @@ select_session(SuggestedSessionId, CipherSuites, HashSigns, Compressions, SessId undefined -> %% Select Cert Session = new_session_parameters(SessionId, Session0, CipherSuites, - SslOpts, Version, Compressions, - HashSigns, CertKeyPairs), + SslOpts, Version, HashSigns, CertKeyPairs), {new, Session}; _ -> {resumed, Resumed} end. - new_session_parameters(SessionId, #session{ecc = ECCCurve0} = Session, CipherSuites, SslOpts, - Version, Compressions, HashSigns, CertKeyPairs) -> - Compression = select_compression(Compressions), - {Certs, Key, {ECCCurve, CipherSuite}} = server_select_cert_key_pair_and_params(CipherSuites, CertKeyPairs, HashSigns, - ECCCurve0, SslOpts, Version), + Version, HashSigns, CertKeyPairs) -> + {Certs, Key, {ECCCurve, CipherSuite}} = + server_select_cert_key_pair_and_params(CipherSuites, CertKeyPairs, HashSigns, + ECCCurve0, SslOpts, Version), Session#session{session_id = SessionId, ecc = ECCCurve, own_certificates = Certs, private_key = Key, - cipher_suite = CipherSuite, - compression_method = Compression}. + cipher_suite = CipherSuite}. %% Possibly support part of "trusted_ca_keys" extension that corresponds to TLS-1.3 certificate_authorities?! @@ -1473,15 +1466,14 @@ handle_client_hello_extensions(RecordCB, Random, ClientCipherSuites, Exts, Version, #{secure_renegotiate := SecureRenegotation, alpn_preferred_protocols := ALPNPreferredProtocols} = Opts, - #session{cipher_suite = NegotiatedCipherSuite, - compression_method = Compression} = Session0, + #session{cipher_suite = NegotiatedCipherSuite} = Session0, ConnectionStates0, Renegotiation, IsResumed) -> Session = handle_srp_extension(maps:get(srp, Exts, undefined), Session0), MaxFragEnum = handle_mfl_extension(maps:get(max_frag_enum, Exts, undefined)), ConnectionStates1 = ssl_record:set_max_fragment_length(MaxFragEnum, ConnectionStates0), ConnectionStates = handle_renegotiation_extension(server, RecordCB, Version, maps:get(renegotiation_info, Exts, undefined), Random, NegotiatedCipherSuite, - ClientCipherSuites, Compression, + ClientCipherSuites, ConnectionStates1, Renegotiation, SecureRenegotation), Empty = empty_extensions(Version, server_hello), @@ -1515,7 +1507,7 @@ handle_client_hello_extensions(RecordCB, Random, ClientCipherSuites, encode_protocols_advertised_on_server(ProtocolsToAdvertise)}} end. -handle_server_hello_extensions(RecordCB, Random, CipherSuite, Compression, +handle_server_hello_extensions(RecordCB, Random, CipherSuite, Exts, Version, #{secure_renegotiate := SecureRenegotation} = SslOpts, @@ -1523,7 +1515,7 @@ handle_server_hello_extensions(RecordCB, Random, CipherSuite, Compression, ConnectionStates = handle_renegotiation_extension(client, RecordCB, Version, maps:get(renegotiation_info, Exts, undefined), Random, CipherSuite, undefined, - Compression, ConnectionStates0, + ConnectionStates0, Renegotiation, SecureRenegotation), %% RFC 6066: handle received/expected maximum fragment length @@ -2376,7 +2368,7 @@ calc_master_secret(Version, PrfAlgo, PremasterSecret, ClientRandom, ServerRandom %% hello messages %% NOTE : Role is the role of the receiver of the hello message %% currently being processed. -hello_pending_connection_states(_RecordCB, Role, Version, CipherSuite, Random, Compression, +hello_pending_connection_states(_RecordCB, Role, Version, CipherSuite, Random, ConnectionStates) -> ReadState = ssl_record:pending_connection_state(ConnectionStates, read), @@ -2384,36 +2376,27 @@ hello_pending_connection_states(_RecordCB, Role, Version, CipherSuite, Random, C ssl_record:pending_connection_state(ConnectionStates, write), NewReadSecParams = - hello_security_parameters(Role, Version, ReadState, CipherSuite, - Random, Compression), - + hello_security_parameters(Role, Version, ReadState, CipherSuite, Random), + NewWriteSecParams = - hello_security_parameters(Role, Version, WriteState, CipherSuite, - Random, Compression), + hello_security_parameters(Role, Version, WriteState, CipherSuite, Random), ssl_record:set_security_params(NewReadSecParams, NewWriteSecParams, ConnectionStates). -hello_security_parameters(client, Version, #{security_parameters := SecParams}, CipherSuite, Random, - Compression) -> +hello_security_parameters(client, Version, #{security_parameters := SecParams}, + CipherSuite, Random) -> NewSecParams = ssl_cipher:security_parameters(Version, CipherSuite, SecParams), - NewSecParams#security_parameters{ - server_random = Random, - compression_algorithm = Compression - }; + NewSecParams#security_parameters{server_random = Random}; -hello_security_parameters(server, Version, #{security_parameters := SecParams}, CipherSuite, Random, - Compression) -> +hello_security_parameters(server, Version, #{security_parameters := SecParams}, + CipherSuite, Random) -> NewSecParams = ssl_cipher:security_parameters(Version, CipherSuite, SecParams), NewSecParams#security_parameters{ - client_random = Random, - compression_algorithm = Compression + client_random = Random }. -select_compression(_CompressionMetodes) -> - ?NULL. - do_select_version(_, ClientVersion, []) -> ClientVersion; do_select_version(RecordCB, ClientVersion, [Version | Versions]) -> @@ -3413,7 +3396,7 @@ filter_unavailable_ecc_suites(_, Suites) -> %%-------------Extension handling -------------------------------- handle_renegotiation_extension(Role, RecordCB, Version, Info, Random, NegotiatedCipherSuite, - ClientCipherSuites, Compression, + ClientCipherSuites, ConnectionStates0, Renegotiation, SecureRenegotation) -> {ok, ConnectionStates} = handle_renegotiation_info(Version, RecordCB, Role, Info, ConnectionStates0, Renegotiation, SecureRenegotation, @@ -3422,7 +3405,6 @@ handle_renegotiation_extension(Role, RecordCB, Version, Info, Random, Negotiated Version, NegotiatedCipherSuite, Random, - Compression, ConnectionStates). %% Receive protocols, choose one from the list, return it. diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index ada0c774d56a..522a8bfd628e 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -43,7 +43,6 @@ peer_certificate, own_certificates, private_key, - compression_method, cipher_suite, master_secret, srp_username, @@ -123,10 +122,9 @@ -record(server_hello, { server_version, - random, + random, session_id, % opaque SessionID<0..32> cipher_suite, % cipher_suites - compression_method, % compression_method extensions }). diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index f98be277bfe5..cbe497616aa4 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -74,6 +74,9 @@ -define(TRUE, 0). -define(FALSE, 1). + +-define(NO_COMPRESSION, ?NULL). + %% sslv3 is considered insecure due to lack of padding check (Poodle attack) %% Keep as interop with legacy software but do not support as default %% tlsv1.0 and tlsv1.1 is now also considered legacy diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index f01c2825b20f..58019b53bc54 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -550,14 +550,12 @@ exists_equivalent(_, []) -> exists_equivalent(#session{ peer_certificate = PeerCert, own_certificates = [OwnCert | _], - compression_method = Compress, cipher_suite = CipherSuite, srp_username = SRP, ecc = ECC} , [#session{ peer_certificate = PeerCert, own_certificates = [OwnCert | _], - compression_method = Compress, cipher_suite = CipherSuite, srp_username = SRP, ecc = ECC} | _]) -> diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 9daee92c5bac..bef51b3d21d4 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -48,9 +48,6 @@ step_encryption_state_read/1, step_encryption_state_write/1]). -%% Compression --export([compress/3, uncompress/3, compressions/0]). - %% Payload encryption/decryption -export([cipher/4, cipher/5, decipher/4, cipher_aead/4, cipher_aead/5, decipher_aead/5, @@ -335,24 +332,6 @@ set_pending_cipher_state(#{pending_read := Read, pending_read => Read#{cipher_state => ServerState}, pending_write => Write#{cipher_state => ClientState}}. -%%==================================================================== -%% Compression -%%==================================================================== - -uncompress(?NULL, Data, CS) -> - {Data, CS}. - -compress(?NULL, Data, CS) -> - {Data, CS}. - -%%-------------------------------------------------------------------- --spec compressions() -> [integer()]. -%% -%% Description: return a list of compressions supported (currently none) -%%-------------------------------------------------------------------- -compressions() -> - [?NULL]. - %%==================================================================== %% Payload encryption/decryption %%==================================================================== @@ -476,7 +455,6 @@ empty_connection_state(ConnectionEnd, Version, SecParams = init_security_parameters(ConnectionEnd, Version), #{security_parameters => SecParams, beast_mitigation => BeastMitigation, - compression_state => undefined, cipher_state => undefined, mac_secret => undefined, secure_renegotiation => undefined, @@ -516,8 +494,7 @@ record_protocol_role(server) -> ?SERVER. initial_security_params(ConnectionEnd) -> - SecParams = #security_parameters{connection_end = ConnectionEnd, - compression_algorithm = ?NULL}, + SecParams = #security_parameters{connection_end = ConnectionEnd}, ssl_cipher:security_parameters(?TLS_NULL_WITH_NULL_NULL, SecParams). -define(end_additional_data(AAD, Len), << (begin(AAD)end)/binary, ?UINT16(begin(Len)end) >>). diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl index c58a931ab539..c3ef944a7770 100644 --- a/lib/ssl/src/ssl_record.hrl +++ b/lib/ssl/src/ssl_record.hrl @@ -33,7 +33,6 @@ %% For documentation purposes are now maps in implementation %% -record(connection_state, { %% security_parameters, -%% compression_state, %% cipher_state, %% mac_secret, %% sequence_number, @@ -64,7 +63,6 @@ mac_algorithm, % unit 8 prf_algorithm, % unit 8 hash_size, % unit 8 - compression_algorithm, % unit 8 master_secret, % opaque 48 resumption_master_secret, application_traffic_secret, @@ -124,15 +122,6 @@ -define(SHA384, 5). -define(SHA512, 6). -%% CompressionMethod -% -define(NULL, 0). %% Already defined by ssl_internal.hrl - - --record(compression_state, { - method, - state - }). - %% See also cipher.hrl for #cipher_state{} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -152,7 +141,6 @@ -define(KNOWN_RECORD_TYPE(Type), (is_integer(Type) andalso (20 =< (Type)) andalso ((Type) =< 23))). -define(MAX_PLAIN_TEXT_LENGTH, 16384). --define(MAX_COMPRESSED_LENGTH, (?MAX_PLAIN_TEXT_LENGTH+1024)). -define(MAX_CIPHER_TEXT_LENGTH, (?MAX_PLAIN_TEXT_LENGTH+2048)). -define(TLS13_MAX_CIPHER_TEXT_LENGTH, (?MAX_PLAIN_TEXT_LENGTH+256)). -define(MAX_PADDING_LENGTH,256). diff --git a/lib/ssl/src/ssl_session.erl b/lib/ssl/src/ssl_session.erl index 721a9ef4d50d..3f1a7ea5bceb 100644 --- a/lib/ssl/src/ssl_session.erl +++ b/lib/ssl/src/ssl_session.erl @@ -200,14 +200,13 @@ is_resumable(SuggestedSessionId, SessIdTracker, case ssl_server_session_cache:reuse_session(SessIdTracker, SuggestedSessionId) of #session{cipher_suite = CipherSuite, own_certificates = [SessionOwnCert | _], - compression_method = Compression, is_resumable = IsResumable, peer_certificate = PeerCert} = Session -> case resumable(IsResumable) andalso is_owncert(SessionOwnCert, OwnCertKeyPairs) andalso reusable_options(Options, Session) andalso ReuseFun(SuggestedSessionId, PeerCert, - Compression, CipherSuite) + ?NO_COMPRESSION, CipherSuite) of true -> {true, Session}; false -> {false, undefined} diff --git a/lib/ssl/src/ssl_trace.erl b/lib/ssl/src/ssl_trace.erl index c8ac32712e7b..8daeb816d182 100644 --- a/lib/ssl/src/ssl_trace.erl +++ b/lib/ssl/src/ssl_trace.erl @@ -432,7 +432,7 @@ trace_profiles() -> {client_hello_extensions, 10}, {cert_status_check, 5}, {get_ocsp_responder_list, 1}, {handle_ocsp_extension, 2}, {path_validation, 10}, - {handle_server_hello_extensions, 10}, + {handle_server_hello_extensions, 9}, {handle_client_hello_extensions, 10}, {cert_status_check, 5}]}, {public_key, [{ocsp_extensions, 1}, {pkix_ocsp_validate, 5}, diff --git a/lib/ssl/src/tls_dtls_connection.erl b/lib/ssl/src/tls_dtls_connection.erl index c2edbffe3000..3512a5fbc07f 100644 --- a/lib/ssl/src/tls_dtls_connection.erl +++ b/lib/ssl/src/tls_dtls_connection.erl @@ -108,8 +108,7 @@ prf(ConnectionPid, Secret, Label, Seed, WantedLength) -> binary(), ssl_record:connection_states(), _,_, #state{}) -> gen_statem:state_function_result(). %%-------------------------------------------------------------------- -handle_session(#server_hello{cipher_suite = CipherSuite, - compression_method = Compression}, +handle_session(#server_hello{cipher_suite = CipherSuite}, Version, NewId, ConnectionStates, ProtoExt, Protocol0, #state{session = Session, handshake_env = #handshake_env{negotiated_protocol = CurrentProtocol} = HsEnv, @@ -134,11 +133,9 @@ handle_session(#server_hello{cipher_suite = CipherSuite, case ssl_session:is_new(Session, NewId) of true -> - handle_new_session(NewId, CipherSuite, Compression, - State#state{connection_states = ConnectionStates}); + handle_new_session(NewId, CipherSuite, State#state{connection_states = ConnectionStates}); false -> - handle_resumed_session(NewId, - State#state{connection_states = ConnectionStates}) + handle_resumed_session(NewId, State#state{connection_states = ConnectionStates}) end. @@ -832,21 +829,18 @@ override_server_random(Random, _, _) -> Random. new_server_hello(#server_hello{cipher_suite = CipherSuite, - compression_method = Compression, - session_id = SessionId}, - #state{session = Session0, - static_env = #static_env{protocol_cb = Connection}} = State0, Connection) -> + session_id = SessionId}, + #state{session = Session0} = State0, Connection) -> #state{} = State1 = server_certify_and_key_exchange(State0, Connection), {State, Actions} = server_hello_done(State1, Connection), Session = Session0#session{session_id = SessionId, - cipher_suite = CipherSuite, - compression_method = Compression}, + cipher_suite = CipherSuite}, Connection:next_event(certify, no_record, State#state{session = Session}, Actions). resumed_server_hello(#state{session = Session, connection_states = ConnectionStates0, - static_env = #static_env{protocol_cb = Connection}, - connection_env = #connection_env{negotiated_version = Version}} = State0, Connection) -> + connection_env = #connection_env{negotiated_version = Version}} = State0, + Connection) -> case ssl_handshake:master_secret(ssl:tls_version(Version), Session, ConnectionStates0, server) of @@ -1612,13 +1606,12 @@ host_id(client, _Host, #{server_name_indication := Hostname}) when is_list(Hostn host_id(_, Host, _) -> Host. -handle_new_session(NewId, CipherSuite, Compression, +handle_new_session(NewId, CipherSuite, #state{static_env = #static_env{protocol_cb = Connection}, session = Session0 } = State0) -> Session = Session0#session{session_id = NewId, - cipher_suite = CipherSuite, - compression_method = Compression}, + cipher_suite = CipherSuite}, Connection:next_event(certify, no_record, State0#state{session = Session}). handle_resumed_session(SessId, #state{static_env = #static_env{host = Host, diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index ec53b65959a1..33c5a28fb08f 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -95,7 +95,6 @@ client_hello(_Host, _Port, ConnectionStates, #client_hello{session_id = Id, client_version = LegacyVersion, cipher_suites = CipherSuites, - compression_methods = ssl_record:compressions(), random = SecParams#security_parameters.client_random, extensions = Extensions }. @@ -155,7 +154,6 @@ hello(#server_hello{server_version = {Major, Minor}, hello(#server_hello{server_version = LegacyVersion, random = Random, cipher_suite = CipherSuite, - compression_method = Compression, session_id = SessionId, extensions = #{server_hello_selected_version := @@ -180,7 +178,7 @@ hello(#server_hello{server_version = LegacyVersion, IsNew = ssl_session:is_new(OldId, SessionId), %% TLS 1.2 ServerHello with "supported_versions" (special case) handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, - Compression, HelloExt, SslOpt, + HelloExt, SslOpt, ConnectionStates0, Renegotiation, IsNew); SelectedVersion -> %% TLS 1.3 @@ -196,7 +194,6 @@ hello(#server_hello{server_version = LegacyVersion, hello(#server_hello{server_version = Version, random = Random, cipher_suite = CipherSuite, - compression_method = Compression, session_id = SessionId, extensions = HelloExt}, #{versions := SupportedVersions} = SslOpt, @@ -205,7 +202,7 @@ hello(#server_hello{server_version = Version, case tls_record:is_acceptable_version(Version, SupportedVersions) of true -> handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, - Compression, HelloExt, SslOpt, + HelloExt, SslOpt, ConnectionStates0, Renegotiation, IsNew); false -> throw(?ALERT_REC(?FATAL, ?PROTOCOL_VERSION)) @@ -326,7 +323,6 @@ ocsp_nonce(SslOpts) -> handle_client_hello(Version, #client_hello{session_id = SugesstedId, cipher_suites = CipherSuites, - compression_methods = Compressions, random = Random, extensions = HelloExt}, #{versions := Versions, @@ -346,7 +342,7 @@ handle_client_hello(Version, {Type, #session{cipher_suite = CipherSuite, own_certificates = [OwnCert |_]} = Session1} = ssl_handshake:select_session(SugesstedId, CipherSuites, - AvailableHashSigns, Compressions, + AvailableHashSigns, SessIdTracker, Session0#session{ecc = ECCCurve}, Version, SslOpts, CertKeyPairs), case CipherSuite of @@ -384,10 +380,10 @@ handle_client_hello_extensions(Version, Type, Random, CipherSuites, {Version, {Type, Session}, ConnectionStates, Protocol, ServerHelloExt, HashSign}. handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, - Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation, IsNew) -> + HelloExt, SslOpt, ConnectionStates0, Renegotiation, IsNew) -> {ConnectionStates, ProtoExt, Protocol, OcspState} = ssl_handshake:handle_server_hello_extensions(tls_record, Random, CipherSuite, - Compression, HelloExt, Version, + HelloExt, Version, SslOpt, ConnectionStates0, Renegotiation, IsNew), {Version, SessionId, ConnectionStates, ProtoExt, Protocol, OcspState}. @@ -415,10 +411,9 @@ enc_handshake(#client_hello{client_version = ServerVersion, random = Random, session_id = SessionID, cipher_suites = CipherSuites, - compression_methods = CompMethods, extensions = HelloExtensions}, _Version) -> SIDLength = byte_size(SessionID), - BinCompMethods = list_to_binary(CompMethods), + BinCompMethods = list_to_binary([?NO_COMPRESSION]), CmLength = byte_size(BinCompMethods), BinCipherSuites = list_to_binary(CipherSuites), CsLength = byte_size(BinCipherSuites), @@ -458,7 +453,7 @@ decode_handshake(Version, ?CLIENT_HELLO, <>) -> Exts = ssl_handshake:decode_vector(Extensions), DecodedExtensions = ssl_handshake:decode_hello_extensions(Exts, Version, {Major, Minor}, @@ -468,7 +463,6 @@ decode_handshake(Version, ?CLIENT_HELLO, random = Random, session_id = Session_ID, cipher_suites = ssl_handshake:decode_suites('2_bytes', CipherSuites), - compression_methods = erlang:binary_to_list(Comp_methods), extensions = DecodedExtensions }; decode_handshake(?TLS_1_3, Tag, Msg) -> diff --git a/lib/ssl/src/tls_handshake.hrl b/lib/ssl/src/tls_handshake.hrl index f06b7b3b3317..63bf05334749 100644 --- a/lib/ssl/src/tls_handshake.hrl +++ b/lib/ssl/src/tls_handshake.hrl @@ -34,7 +34,6 @@ session_id, % opaque SessionID<0..32> cookie, % opaque<2..2^16-1> cipher_suites, % cipher_suites<2..2^16-1> - compression_methods, % compression_methods<1..2^8-1>, %% Extensions extensions }). diff --git a/lib/ssl/src/tls_handshake_1_3.erl b/lib/ssl/src/tls_handshake_1_3.erl index 0861db4607e5..95520d7a35f7 100644 --- a/lib/ssl/src/tls_handshake_1_3.erl +++ b/lib/ssl/src/tls_handshake_1_3.erl @@ -108,7 +108,6 @@ server_hello(MsgType, SessionId, KeyShare, PSK, ConnectionStates) -> Extensions = server_hello_extensions(MsgType, KeyShare, PSK), #server_hello{server_version = ?LEGACY_VERSION, %% legacy_version cipher_suite = SecParams#security_parameters.cipher_suite, - compression_method = 0, %% legacy attribute random = server_hello_random(MsgType, SecParams), session_id = SessionId, extensions = Extensions @@ -384,13 +383,11 @@ create_change_cipher_spec(#state{ssl_options = #{log_level := LogLevel}}) -> %% Dummy connection_states with NULL cipher ConnectionStates = #{current_write => - #{compression_state => undefined, - cipher_state => undefined, + #{cipher_state => undefined, sequence_number => 1, security_parameters => #security_parameters{ bulk_cipher_algorithm = 0, - compression_algorithm = ?NULL, mac_algorithm = ?NULL }, mac_secret => undefined}}, @@ -602,7 +599,7 @@ encode_early_data(Cipher, decode_handshake(?SERVER_HELLO, <>) when Random =:= ?HELLO_RETRY_REQUEST_RANDOM -> HelloExtensions = ssl_handshake:decode_hello_extensions(Extensions, ?TLS_1_3, {Major, Minor}, @@ -612,7 +609,6 @@ decode_handshake(?SERVER_HELLO, <>) -> Exts = decode_extensions(EncExts, certificate_request), diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index 01f85624bfd2..3decaf6535bc 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -111,7 +111,7 @@ init_connection_states(Role, Version, BeastMitigation, MaxEarlyDataSize) -> Buffer :: {'undefined' | #ssl_tls{}, {[binary()],non_neg_integer(),[binary()]}}} | #alert{}. %% -%% and returns it as a list of tls_compressed binaries also returns leftover +%% and returns it as a list of binaries also returns leftover %% Description: Given old buffer and new data from TCP, packs up a records %% data %%-------------------------------------------------------------------- @@ -227,17 +227,11 @@ decode_cipher_text(_, CipherTextRecord, BulkCipherAlgo, CipherS, StartAdditionalData, Fragment, Version) of PlainFragment when is_binary(PlainFragment) -> - #{current_read := - #{security_parameters := SecParams, - compression_state := CompressionS0} = ReadState0} = ConnectionStates0, - {Plain, CompressionS} = ssl_record:uncompress(SecParams#security_parameters.compression_algorithm, - PlainFragment, CompressionS0), - ConnectionStates = ConnectionStates0#{ - current_read => ReadState0#{ - cipher_state => CipherS, - sequence_number => Seq + 1, - compression_state => CompressionS}}, - {CipherTextRecord#ssl_tls{fragment = Plain}, ConnectionStates}; + #{current_read := ReadState0} = ConnectionStates0, + ConnectionStates = + ConnectionStates0#{current_read => ReadState0#{cipher_state => CipherS, + sequence_number => Seq + 1}}, + {CipherTextRecord#ssl_tls{fragment = PlainFragment}, ConnectionStates}; #alert{} = Alert -> Alert end; @@ -247,24 +241,19 @@ decode_cipher_text(_, #ssl_tls{version = Version, #{current_read := ReadState0} = ConnnectionStates0, PaddingCheck) -> case ssl_record:decipher(Version, CipherFragment, ReadState0, PaddingCheck) of {PlainFragment, Mac, ReadState1} -> - MacHash = ssl_cipher:calc_mac_hash(CipherTextRecord#ssl_tls.type, Version, PlainFragment, ReadState1), + MacHash = ssl_cipher:calc_mac_hash(CipherTextRecord#ssl_tls.type, Version, + PlainFragment, ReadState1), case ssl_record:is_correct_mac(Mac, MacHash) of true -> - #{sequence_number := Seq, - compression_state := CompressionS0, - security_parameters := - #security_parameters{compression_algorithm = CompAlg}} = ReadState0, - {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, - PlainFragment, CompressionS0), + #{sequence_number := Seq} = ReadState0, ConnnectionStates = ConnnectionStates0#{current_read => - ReadState1#{sequence_number => Seq + 1, - compression_state => CompressionS1}}, - {CipherTextRecord#ssl_tls{fragment = Plain}, ConnnectionStates}; + ReadState1#{sequence_number => Seq + 1}}, + {CipherTextRecord#ssl_tls{fragment = PlainFragment}, ConnnectionStates}; false -> ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) end; - #alert{} = Alert -> + #alert{} = Alert -> Alert end. @@ -483,7 +472,6 @@ initial_connection_state(ConnectionEnd, BeastMitigation, MaxEarlyDataSize) -> ssl_record:initial_security_params(ConnectionEnd), sequence_number => 0, beast_mitigation => BeastMitigation, - compression_state => undefined, cipher_state => undefined, mac_secret => undefined, secure_renegotiation => undefined, @@ -666,47 +654,43 @@ encode_plain_text(Type, Version, Data, ConnectionStates0) -> {CipherText,ConnectionStates}. %%-------------------------------------------------------------------- encode_fragments(Type, Version, Data, - #{current_write := #{compression_state := CompS, - cipher_state := CipherS, - sequence_number := Seq}} = ConnectionStates) -> - encode_fragments(Type, Version, Data, ConnectionStates, CompS, CipherS, Seq, []). + #{current_write := #{cipher_state := CipherS, + sequence_number := Seq}} = ConnectionStates) -> + encode_fragments(Type, Version, Data, ConnectionStates, CipherS, Seq, []). %% encode_fragments(_Type, _Version, [], #{current_write := WriteS} = CS, - CompS, CipherS, Seq, CipherFragments) -> + CipherS, Seq, CipherFragments) -> {lists:reverse(CipherFragments), - CS#{current_write := WriteS#{compression_state := CompS, - cipher_state := CipherS, - sequence_number := Seq}}}; + CS#{current_write := WriteS#{cipher_state := CipherS, sequence_number := Seq}}}; encode_fragments(Type, Version, [Text|Data], - #{current_write := #{security_parameters := - #security_parameters{cipher_type = ?AEAD, - bulk_cipher_algorithm = BCAlg, - compression_algorithm = CompAlg} = SecPars}} = CS, - CompS0, CipherS0, Seq, CipherFragments) -> - {CompText, CompS} = ssl_record:compress(CompAlg, Text, CompS0), + #{current_write := + #{security_parameters := + #security_parameters{cipher_type = ?AEAD, + bulk_cipher_algorithm = BCAlg} = SecPars}} = CS, + CipherS0, Seq, CipherFragments) -> SeqBin = <>, CipherS1 = ssl_record:nonce_seed(BCAlg, SeqBin, CipherS0), {MajVer, MinVer} = Version, VersionBin = <>, StartAdditionalData = <>, - {CipherFragment,CipherS} = ssl_record:cipher_aead(Version, CompText, CipherS1, StartAdditionalData, SecPars), + {CipherFragment,CipherS} = ssl_record:cipher_aead(Version, Text, CipherS1, + StartAdditionalData, SecPars), Length = byte_size(CipherFragment), CipherHeader = <>, - encode_fragments(Type, Version, Data, CS, CompS, CipherS, Seq + 1, - [[CipherHeader, CipherFragment] | CipherFragments]); + encode_fragments(Type, Version, Data, CS, CipherS, Seq + 1, + [[CipherHeader, CipherFragment] | CipherFragments]); encode_fragments(Type, Version, [Text|Data], - #{current_write := #{security_parameters := - #security_parameters{compression_algorithm = CompAlg, - mac_algorithm = MacAlgorithm} = SecPars, - mac_secret := MacSecret}} = CS, - CompS0, CipherS0, Seq, CipherFragments) -> - {CompText, CompS} = ssl_record:compress(CompAlg, Text, CompS0), - MacHash = ssl_cipher:calc_mac_hash(Type, Version, CompText, MacAlgorithm, MacSecret, Seq), - {CipherFragment,CipherS} = ssl_record:cipher(Version, CompText, CipherS0, MacHash, SecPars), + #{current_write := + #{security_parameters := + #security_parameters{mac_algorithm = MacAlgorithm} = SecPars, + mac_secret := MacSecret}} = CS, + CipherS0, Seq, CipherFragments) -> + MacHash = ssl_cipher:calc_mac_hash(Type, Version, Text, MacAlgorithm, MacSecret, Seq), + {CipherFragment,CipherS} = ssl_record:cipher(Version, Text, CipherS0, MacHash, SecPars), Length = byte_size(CipherFragment), {MajVer, MinVer} = Version, CipherHeader = <>, - encode_fragments(Type, Version, Data, CS, CompS, CipherS, Seq + 1, + encode_fragments(Type, Version, Data, CS, CipherS, Seq + 1, [[CipherHeader, CipherFragment] | CipherFragments]). diff --git a/lib/ssl/test/property_test/ssl_eqc_handshake.erl b/lib/ssl/test/property_test/ssl_eqc_handshake.erl index 8f5aaedd1cc9..c01f548ca44a 100644 --- a/lib/ssl/test/property_test/ssl_eqc_handshake.erl +++ b/lib/ssl/test/property_test/ssl_eqc_handshake.erl @@ -117,7 +117,6 @@ client_hello(?TLS_1_3 = Version) -> #client_hello{session_id = session_id(), client_version = ?TLS_1_2, cipher_suites = cipher_suites(Version), - compression_methods = compressions(Version), random = client_random(Version), extensions = client_hello_extensions(Version) }; @@ -125,7 +124,6 @@ client_hello(Version) -> #client_hello{session_id = session_id(), client_version = Version, cipher_suites = cipher_suites(Version), - compression_methods = compressions(Version), random = client_random(Version), extensions = client_hello_extensions(Version) }. @@ -135,7 +133,6 @@ server_hello(?TLS_1_3 = Version) -> session_id = session_id(), random = server_random(Version), cipher_suite = cipher_suite(Version), - compression_method = compression(Version), extensions = server_hello_extensions(Version) }; server_hello(Version) -> @@ -143,7 +140,6 @@ server_hello(Version) -> session_id = session_id(), random = server_random(Version), cipher_suite = cipher_suite(Version), - compression_method = compression(Version), extensions = server_hello_extensions(Version) }. @@ -204,12 +200,6 @@ cipher_suites(Version) -> session_id() -> crypto:strong_rand_bytes(?NUM_OF_SESSION_ID_BYTES). - -compression(Version) -> - oneof(compressions(Version)). - -compressions(_) -> - ssl_record:compressions(). client_random(_) -> crypto:strong_rand_bytes(32). diff --git a/lib/ssl/test/ssl_alert_SUITE.erl b/lib/ssl/test/ssl_alert_SUITE.erl index d6b132cc6397..d8c79134dadf 100644 --- a/lib/ssl/test/ssl_alert_SUITE.erl +++ b/lib/ssl/test/ssl_alert_SUITE.erl @@ -83,7 +83,7 @@ alerts() -> [{doc, "Test ssl_alert formatting code"}]. alerts(Config) when is_list(Config) -> Descriptions = [?CLOSE_NOTIFY, ?UNEXPECTED_MESSAGE, ?BAD_RECORD_MAC, - ?DECRYPTION_FAILED_RESERVED, ?RECORD_OVERFLOW, ?DECOMPRESSION_FAILURE, + ?DECRYPTION_FAILED_RESERVED, ?RECORD_OVERFLOW, ?HANDSHAKE_FAILURE, ?BAD_CERTIFICATE, ?UNSUPPORTED_CERTIFICATE, ?CERTIFICATE_REVOKED,?CERTIFICATE_EXPIRED, ?CERTIFICATE_UNKNOWN, ?ILLEGAL_PARAMETER, ?UNKNOWN_CA, ?ACCESS_DENIED, ?DECODE_ERROR, diff --git a/lib/ssl/test/ssl_npn_hello_SUITE.erl b/lib/ssl/test/ssl_npn_hello_SUITE.erl index b097a311eb68..b2e8cf1bbf03 100644 --- a/lib/ssl/test/ssl_npn_hello_SUITE.erl +++ b/lib/ssl/test/ssl_npn_hello_SUITE.erl @@ -142,7 +142,6 @@ create_client_handshake(Npn) -> random = <<1:256>>, session_id = <<>>, cipher_suites = [?TLS_DHE_DSS_WITH_DES_CBC_SHA], - compression_methods = "", extensions = #{next_protocol_negotiation => Npn, renegotiation_info => #renegotiation_info{}} }, Vsn). @@ -154,7 +153,6 @@ create_server_handshake(Npn) -> random = <<1:256>>, session_id = <<>>, cipher_suite = ?TLS_DHE_DSS_WITH_DES_CBC_SHA, - compression_method = 1, extensions = #{next_protocol_negotiation => Npn, renegotiation_info => #renegotiation_info{}} }, Vsn). @@ -162,7 +160,6 @@ create_server_handshake(Npn) -> create_connection_states() -> #{pending_read => #{security_parameters => #security_parameters{ server_random = <<1:256>>, - compression_algorithm = 1, cipher_suite = ?TLS_DHE_DSS_WITH_DES_CBC_SHA } }, diff --git a/lib/ssl/test/ssl_session_SUITE.erl b/lib/ssl/test/ssl_session_SUITE.erl index 6a33e3ef79db..47cf517b8eb6 100644 --- a/lib/ssl/test/ssl_session_SUITE.erl +++ b/lib/ssl/test/ssl_session_SUITE.erl @@ -754,14 +754,13 @@ client_hello(Random) -> random = Random, session_id = crypto:strong_rand_bytes(32), cipher_suites = CipherSuites, - compression_methods = [0], extensions = Extensions }. connection_states(Random) -> #{current_write => #{beast_mitigation => one_n_minus_one,cipher_state => undefined, - client_verify_data => undefined,compression_state => undefined, + client_verify_data => undefined, mac_secret => undefined,secure_renegotiation => undefined, security_parameters => #security_parameters{ @@ -776,7 +775,6 @@ connection_states(Random) -> mac_algorithm = 0, prf_algorithm = 0, hash_size = 0, - compression_algorithm = 0, master_secret = undefined, resumption_master_secret = undefined, client_random = Random, diff --git a/lib/ssl/test/tls_1_3_record_SUITE.erl b/lib/ssl/test/tls_1_3_record_SUITE.erl index c08bd90a02f9..7d488b665be8 100644 --- a/lib/ssl/test/tls_1_3_record_SUITE.erl +++ b/lib/ssl/test/tls_1_3_record_SUITE.erl @@ -87,7 +87,7 @@ encode_decode(_Config) -> <<197,54,168,218,54,91,157,58,30,201,197,142,51,58,53,231,228, 131,57,122,170,78,82,196,30,48,23,16,95,255,185,236>>, undefined,undefined,undefined,16}, - client_verify_data => undefined,compression_state => undefined, + client_verify_data => undefined, mac_secret => undefined,secure_renegotiation => undefined, security_parameters => #security_parameters{ @@ -118,7 +118,7 @@ encode_decode(_Config) -> <<197,54,168,218,54,91,157,58,30,201,197,142,51,58,53,231,228, 131,57,122,170,78,82,196,30,48,23,16,95,255,185,236>>, undefined,undefined,undefined,16}, - client_verify_data => undefined,compression_state => undefined, + client_verify_data => undefined, mac_secret => undefined,secure_renegotiation => undefined, security_parameters => #security_parameters{ diff --git a/lib/ssl/test/tls_server_session_ticket_SUITE.erl b/lib/ssl/test/tls_server_session_ticket_SUITE.erl index 3f5b0f71b259..283f91b73410 100644 --- a/lib/ssl/test/tls_server_session_ticket_SUITE.erl +++ b/lib/ssl/test/tls_server_session_ticket_SUITE.erl @@ -268,7 +268,6 @@ get_client_hello(OfferedPSKs) -> random = <<1:256>>, session_id = <<>>, cipher_suites = [?TLS_AES_256_GCM_SHA384], - compression_methods = "", extensions = Ext0#{pre_shared_key => PreSharedKey}}. get_replay_expected_result(Config, AcceptResponse) ->