diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 104301129ba9..fe5090572c76 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -93,5 +93,5 @@ {env, []}, {mod, {ssl_app, []}}, {runtime_dependencies, ["stdlib-@OTP-19345@","public_key-1.16.4","kernel-9.0", - "erts-15.0","crypto-5.0", "inets-5.10.7", + "erts-15.0","crypto-@OTP-19426@", "inets-5.10.7", "runtime_tools-1.15.1"]}]}. diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index c8ceaba4fc6d..54b04660ace8 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -44,6 +44,7 @@ cipher/5, aead_encrypt/6, aead_decrypt/6, + aead_type/2, suites/1, all_suites/1, crypto_support_filters/0, diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index b105ecbfd0a1..8629855016c3 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -122,7 +122,7 @@ activate_pending_connection_state_1(Current, Pending, Connection) -> %%-------------------------------------------------------------------- -spec step_encryption_state(#state{}) -> #state{}. %% -%% Description: Activates the next encyrption state (e.g. handshake +%% Description: Activates the next encryption state (e.g. handshake %% encryption). %%-------------------------------------------------------------------- step_encryption_state(#state{connection_states = @@ -131,20 +131,20 @@ step_encryption_state(#state{connection_states = NewRead = PendingRead#{sequence_number => 0}, NewWrite = PendingWrite#{sequence_number => 0}, State#state{connection_states = - ConnStates#{current_read => NewRead, - current_write => NewWrite}}. + ConnStates#{current_read => maps:remove(aead_handle, NewRead), + current_write => maps:remove(aead_handle, NewWrite)}}. step_encryption_state_read(#state{connection_states = #{pending_read := PendingRead} = ConnStates} = State) -> NewRead = PendingRead#{sequence_number => 0}, State#state{connection_states = - ConnStates#{current_read => NewRead}}. + ConnStates#{current_read => maps:remove(aead_handle, NewRead)}}. step_encryption_state_write(#state{connection_states = #{pending_write := PendingWrite} = ConnStates} = State) -> NewWrite = PendingWrite#{sequence_number => 0}, State#state{connection_states = - ConnStates#{current_write => NewWrite}}. + ConnStates#{current_write => maps:remove(aead_handle, NewWrite)}}. %%-------------------------------------------------------------------- -spec set_security_params(#security_parameters{}, #security_parameters{}, diff --git a/lib/ssl/src/tls_gen_connection_1_3.erl b/lib/ssl/src/tls_gen_connection_1_3.erl index d787240ebe69..abeb70e7b1f0 100644 --- a/lib/ssl/src/tls_gen_connection_1_3.erl +++ b/lib/ssl/src/tls_gen_connection_1_3.erl @@ -300,25 +300,22 @@ update_cipher_key(ConnStateName, #state{connection_states = CS0} = State0) -> State0#state{connection_states = CS}; update_cipher_key(ConnStateName, CS0) -> #{security_parameters := SecParams0, - cipher_state := CipherState0} = ConnState0 = maps:get(ConnStateName, CS0), + cipher_state := CipherState0} = ConnStateOld0 = maps:get(ConnStateName, CS0), HKDF = SecParams0#security_parameters.prf_algorithm, CipherSuite = SecParams0#security_parameters.cipher_suite, - ApplicationTrafficSecret0 = - SecParams0#security_parameters.application_traffic_secret, - ApplicationTrafficSecret = - tls_v1:update_traffic_secret(HKDF, - ApplicationTrafficSecret0), + ApplicationTrafficSecret0 = SecParams0#security_parameters.application_traffic_secret, + ApplicationTrafficSecret = tls_v1:update_traffic_secret(HKDF,ApplicationTrafficSecret0), %% Calculate traffic keys KeyLength = tls_v1:key_length(CipherSuite), - {Key, IV} = tls_v1:calculate_traffic_keys(HKDF, KeyLength, - ApplicationTrafficSecret), + {Key, IV} = tls_v1:calculate_traffic_keys(HKDF, KeyLength, ApplicationTrafficSecret), SecParams = SecParams0#security_parameters{application_traffic_secret = ApplicationTrafficSecret}, CipherState = CipherState0#cipher_state{key = Key, iv = IV}, - ConnState = ConnState0#{security_parameters => SecParams, - cipher_state => CipherState, - sequence_number => 0}, + ConnStateOld = maps:remove(aead_handle, ConnStateOld0), + ConnState = ConnStateOld#{security_parameters => SecParams, + cipher_state => CipherState, + sequence_number => 0}, CS0#{ConnStateName => ConnState}. %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/tls_record_1_3.erl b/lib/ssl/src/tls_record_1_3.erl index 48832edd7512..8f8b51ed88a0 100644 --- a/lib/ssl/src/tls_record_1_3.erl +++ b/lib/ssl/src/tls_record_1_3.erl @@ -77,10 +77,6 @@ encode_data(Frag, ConnectionStates) -> Data = tls_record:split_iovec(Frag, MaxLength), encode_iolist(?APPLICATION_DATA, Data, ConnectionStates). -encode_plain_text(Type, Data, ConnectionStates) -> - PadLen = 0, %% TODO where to specify PadLen? - encode_plain_text(Type, Data, PadLen, ConnectionStates). - encode_iolist(Type, Data, ConnectionStates) -> encode_iolist(Type, Data, ConnectionStates, []). @@ -90,6 +86,11 @@ encode_iolist(Type, [Text|Rest], CS0, Encoded) -> encode_iolist(_Type, [], CS, Encoded) -> {lists:reverse(Encoded), CS}. +encode_plain_text(Type, Data, ConnectionStates) -> + PadLen = 0, %% TODO where to specify PadLen? + encode_plain_text(Type, Data, PadLen, ConnectionStates). + + %%==================================================================== %% Decoding %%==================================================================== @@ -103,9 +104,25 @@ encode_iolist(_Type, [], CS, Encoded) -> %% tls_cipher_text in decoding context so that we can reuse the code %% from earlier versions. %% -------------------------------------------------------------------- -decode_cipher_text(#ssl_tls{type = ?OPAQUE_TYPE, - version = ?LEGACY_VERSION, - fragment = CipherFragment}, +decode_cipher_text(#ssl_tls{type = ?OPAQUE_TYPE,version = ?LEGACY_VERSION,fragment = CipherFragment}, + #{current_read := + #{aead_handle := Handle, + sequence_number := Seq, + cipher_state := #cipher_state{iv = IV} + } = ReadState0 + } = ConnectionStates0) -> + case decipher_aead(Handle, CipherFragment, Seq, IV) of + #alert{} = Alert -> + Alert; + PlainFragment -> + ConnectionStates = + ConnectionStates0#{current_read => + ReadState0#{sequence_number => Seq + 1, + aead_handle => Handle + }}, + {decode_inner_plaintext(PlainFragment), ConnectionStates} + end; +decode_cipher_text(#ssl_tls{type = ?OPAQUE_TYPE,version = ?LEGACY_VERSION,fragment = CipherFragment}, #{current_read := #{sequence_number := Seq, cipher_state := #cipher_state{key = Key, @@ -122,7 +139,10 @@ decode_cipher_text(#ssl_tls{type = ?OPAQUE_TYPE, early_data_accepted := EarlyDataAccepted } } = ReadState0} = ConnectionStates0) -> - case decipher_aead(CipherFragment, BulkCipherAlgo, Key, Seq, IV, TagLen) of + Cipher = ssl_cipher:aead_type(BulkCipherAlgo,byte_size(Key)), + Handle = crypto:crypto_one_time_aead_init(Cipher, Key, TagLen, false), + + case decipher_aead(Handle, CipherFragment, Seq, IV) of #alert{} when TrialDecryption =:= true andalso EarlyDataAccepted =:= false andalso PendingMaxEarlyDataSize0 > 0 -> %% Trial decryption @@ -139,7 +159,9 @@ decode_cipher_text(#ssl_tls{type = ?OPAQUE_TYPE, PlainFragment -> ConnectionStates = ConnectionStates0#{current_read => - ReadState0#{sequence_number => Seq + 1}}, + ReadState0#{sequence_number => Seq + 1, + aead_handle => Handle + }}, {decode_inner_plaintext(PlainFragment), ConnectionStates} end; @@ -243,6 +265,22 @@ process_early_data(ConnectionStates0, #{early_data:=EarlyData0} = ReadState0, end end. +encode_plain_text(Type, Data, 0, + #{current_write := + #{aead_handle := Handle, + sequence_number := Seq, + cipher_state := #cipher_state{iv = IV, tag_len = TagLen} + } = Write + } = CS) -> + %% Pad = <<0:(Length*8)>>, + TLSInnerPlainText = [Data, Type], %% ++ Pad (currently always zero) + Encoded = cipher_aead(Handle, TLSInnerPlainText, Seq, IV, TagLen), + + { + encode_tls_cipher_text(?OPAQUE_TYPE, ?LEGACY_VERSION, Encoded), + CS#{current_write := Write#{sequence_number := Seq+1}} + }; + encode_plain_text(Type, Data, 0, #{current_write := #{cipher_state := @@ -257,12 +295,16 @@ encode_plain_text(Type, Data, 0, } = Write} = CS) -> %% Pad = <<0:(Length*8)>>, TLSInnerPlainText = [Data, Type], %% ++ Pad (currently always zero) - Encoded = cipher_aead(TLSInnerPlainText, BulkCipherAlgo, Key, Seq, IV, TagLen), + Cipher = ssl_cipher:aead_type(BulkCipherAlgo,byte_size(Key)), + Handle = crypto:crypto_one_time_aead_init(Cipher, Key, TagLen, true), + Encoded = cipher_aead(Handle, TLSInnerPlainText, Seq, IV, TagLen), + %% 23 (application_data) for outward compatibility { encode_tls_cipher_text(?OPAQUE_TYPE, ?LEGACY_VERSION, Encoded), - CS#{current_write := Write#{sequence_number := Seq+1}} + CS#{current_write := Write#{sequence_number := Seq+1, aead_handle => Handle}} }; + encode_plain_text(Type, Data, 0, #{current_write := #{sequence_number := Seq, @@ -278,6 +320,11 @@ encode_plain_text(Type, Data, 0, CS#{current_write := Write#{sequence_number := Seq+1}} }. +cipher_aead(Handle, Fragment, Seq, IV, TagLen) -> + AAD = additional_data(erlang:iolist_size(Fragment) + TagLen), + Nonce = nonce(Seq, IV), + crypto:crypto_one_time_aead(Handle, Nonce, Fragment, AAD). + additional_data(Length) -> <>. @@ -293,28 +340,23 @@ additional_data(Length) -> %% The resulting quantity (of length iv_length) is used as the %% per-record nonce. nonce(Seq, IV) -> - crypto:exor(<<0:(bit_size(IV)-64),?UINT64(Seq)>>, IV). - -cipher_aead(Fragment, BulkCipherAlgo, Key, Seq, IV, TagLen) -> - AAD = additional_data(erlang:iolist_size(Fragment) + TagLen), - Nonce = nonce(Seq, IV), - {Content, CipherTag} = - ssl_cipher:aead_encrypt(BulkCipherAlgo, Key, Nonce, Fragment, AAD, TagLen), - <>. + %% crypto:exor(<<0:(bit_size(IV)-64),?UINT64(Seq)>>, IV). + Size = (bit_size(IV)-64), + <> = IV, + Seq0 = Seq band 16#FFFF_FFFF, + Seq1 = (Seq bsr 32) band 16#FFFF_FFFF, + <>. encode_tls_cipher_text(Type, {MajVer,MinVer}, Encoded) -> Length = erlang:iolist_size(Encoded), [<>, Encoded]. -decipher_aead(CipherFragment0, BulkCipherAlgo, Key, Seq, IV, TagLen) -> +decipher_aead(Handle, CipherFragment, Seq, IV) -> try - CipherFragment = iolist_to_binary(CipherFragment0), - FragLen = byte_size(CipherFragment), + FragLen = iolist_size(CipherFragment), %% Includes TagLen AAD = additional_data(FragLen), Nonce = nonce(Seq, IV), - CipherLen = FragLen - TagLen, - <> = CipherFragment, - case ssl_cipher:aead_decrypt(BulkCipherAlgo, Key, Nonce, CipherText, CipherTag, AAD) of + case crypto:crypto_one_time_aead(Handle, Nonce, CipherFragment, AAD) of Content when is_binary(Content) -> Content; Reason -> diff --git a/lib/ssl/src/tls_sender.erl b/lib/ssl/src/tls_sender.erl index f104b90fdc98..ec3ca4c41812 100644 --- a/lib/ssl/src/tls_sender.erl +++ b/lib/ssl/src/tls_sender.erl @@ -311,7 +311,7 @@ connection(cast, {new_write, WritesState, Version}, #data{connection_states = ConnectionStates, static = Static} = StateData) -> hibernate_after(connection, StateData#data{connection_states = - ConnectionStates#{current_write => WritesState}, + ConnectionStates#{current_write => maps:remove(aead_handle, WritesState)}, static = Static#static{negotiated_version = Version}}, []); %% @@ -357,8 +357,8 @@ handshake(cast, {new_write, WriteState, Version}, #data{connection_states = ConnectionStates, static = #static{key_update_at = KeyUpdateAt0} = Static} = StateData) -> KeyUpdateAt = key_update_at(Version, WriteState, KeyUpdateAt0), - {next_state, connection, - StateData#data{connection_states = ConnectionStates#{current_write => WriteState}, + {next_state, connection, + StateData#data{connection_states = ConnectionStates#{current_write => maps:remove(aead_handle, WriteState)}, static = Static#static{negotiated_version = Version, key_update_at = KeyUpdateAt}}}; handshake(info, dist_data, _) ->