Merge branch 'kuba/ssl/tls_downgrade_fix/OTP-17393' into maint-24

* kuba/ssl/tls_downgrade_fix/OTP-17393:
  ssl: TLS downgrade fix

6 files changed, 42 insertions, 18 deletions

diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index bd676c0af5..700d8be5fb 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -1631,7 +1631,10 @@ fun(srp, Username :: binary(), UserState :: term()) ->
       <desc><p>Closes or downgrades a TLS connection. In the latter case the transport
       connection will be handed over to the <c>NewController</c> process after receiving
       the TLS close alert from the peer. The returned transport socket will have
-      the following options set: <c>[{active, false}, {packet, 0}, {mode, binary}]</c></p>
+      the following options set: <c>[{active, false}, {packet, 0}, {mode, binary}]</c>.</p>
+      <p>In case of downgrade, the close function might return some binary data
+      that should be treated by the user as the first bytes received on the downgraded
+      connection.</p>
       </desc>
     </func>
     
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 6da4615e5e..672cd6ef14 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -803,9 +803,10 @@ close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_,_,_,_}
     Transport:close(ListenSocket).
 
 %%--------------------------------------------------------------------
--spec  close(SslSocket, How) -> ok | {ok, port()} | {error,Reason} when
+-spec  close(SslSocket, How) -> ok | {ok, port()} | {ok, port(), Data} | {error,Reason} when
       SslSocket :: sslsocket(),
       How :: timeout() | {NewController::pid(), timeout()},
+      Data :: binary(),
       Reason :: any().
 %%
 %% Description: Close an ssl connection
diff --git a/lib/ssl/src/ssl_gen_statem.erl b/lib/ssl/src/ssl_gen_statem.erl
index 165668289e..5528d39908 100644
--- a/lib/ssl/src/ssl_gen_statem.erl
+++ b/lib/ssl/src/ssl_gen_statem.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2007-2020. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2021. All Rights Reserved.
 %%
 %% Licensed under the Apache License, Version 2.0 (the "License");
 %% you may not use this file except in compliance with the License.
@@ -32,6 +32,7 @@
 -include("ssl_connection.hrl").
 -include("ssl_alert.hrl").
 -include("tls_handshake.hrl").
+-include("tls_connection.hrl").
 
 %% Initial Erlang process setup
 -export([start_link/7,
@@ -658,10 +659,19 @@ connection(Type, Msg, State) ->
 downgrade(internal, #alert{description = ?CLOSE_NOTIFY},
 	  #state{static_env = #static_env{transport_cb = Transport,
                                           socket = Socket},
-		 connection_env = #connection_env{downgrade = {Pid, From}}} = State) ->
+		 connection_env = #connection_env{downgrade = {Pid, From}},
+                 protocol_buffers = #protocol_buffers{tls_record_buffer = TlsRecordBuffer}
+                } = State) ->
     tls_socket:setopts(Transport, Socket, [{active, false}, {packet, 0}, {mode, binary}]),
     Transport:controlling_process(Socket, Pid),
-    {stop_and_reply, {shutdown, downgrade},[{reply, From, {ok, Socket}}], State};
+    ReturnValue = case TlsRecordBuffer of
+                      {undefined,{[Bin] = _Front, _Size, []}} ->
+                          %% Buffered non TLS data returned to downgrade caller
+                          {ok, Socket, Bin};
+                      _ ->
+                          {ok, Socket}
+                  end,
+    {stop_and_reply, {shutdown, downgrade},[{reply, From, ReturnValue}], State};
 downgrade(timeout, downgrade, #state{ connection_env = #connection_env{downgrade = {_, From}}} = State) ->
     {stop_and_reply, {shutdown, normal},[{reply, From, {error, timeout}}], State};
 downgrade(info, {CloseTag, Socket},
diff --git a/lib/ssl/src/tls_gen_connection.erl b/lib/ssl/src/tls_gen_connection.erl
index fa8972e833..217620f62e 100644
--- a/lib/ssl/src/tls_gen_connection.erl
+++ b/lib/ssl/src/tls_gen_connection.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2020-2020. All Rights Reserved.
+%% Copyright Ericsson AB 2020-2021. All Rights Reserved.
 %%
 %% Licensed under the Apache License, Version 2.0 (the "License");
 %% you may not use this file except in compliance with the License.
@@ -528,10 +528,12 @@ encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) ->
     tls_record:encode_change_cipher_spec(Version, ConnectionStates).
 
 next_tls_record(Data, StateName,
-                         #state{protocol_buffers =
-                                    #protocol_buffers{tls_record_buffer = Buf0,
-                                                      tls_cipher_texts = CT0} = Buffers,
-                                ssl_options = SslOpts} = State0) ->
+                #state{protocol_buffers =
+                           #protocol_buffers{tls_record_buffer = Buf0,
+                                             tls_cipher_texts = CT0} = Buffers,
+                       connection_env = #connection_env{
+                                           downgrade = Downgrade},
+                       ssl_options = SslOpts0} = State0) ->
     Versions =
         %% TLSPlaintext.legacy_record_version is ignored in TLS 1.3 and thus all
         %% record version are accepted when receiving initial ClientHello and
@@ -551,6 +553,7 @@ next_tls_record(Data, StateName,
                 State0#state.connection_env#connection_env.negotiated_version
         end,
     #{current_write := #{max_fragment_length := MaxFragLen}} = State0#state.connection_states,
+    SslOpts = maps:put(downgrade, Downgrade, SslOpts0),
     case tls_record:get_tls_records(Data, Versions, Buf0, MaxFragLen, SslOpts) of
 	{Records, Buf1} ->
 	    CT1 = CT0 ++ Records,
diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl
index 9ec5490aa6..a551718c38 100644
--- a/lib/ssl/src/tls_record.erl
+++ b/lib/ssl/src/tls_record.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2007-2020. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2021. All Rights Reserved.
 %%
 %% Licensed under the Apache License, Version 2.0 (the "License");
 %% you may not use this file except in compliance with the License.
@@ -583,7 +583,7 @@ validate_tls_record_length(_Versions, Q, _MaxFragLen, _SslOpts, Acc, Type, Versi
     {lists:reverse(Acc),
      {#ssl_tls{type = Type, version = Version, fragment = undefined}, Q}};
 validate_tls_record_length(Versions, {_,Size0,_} = Q0, MaxFragLen,
-                           #{log_level := LogLevel} = SslOpts,
+                           #{log_level := LogLevel, downgrade := Downgrade} = SslOpts,
                            Acc, Type, Version, Length) ->
     Max = if is_integer(MaxFragLen) ->
                         MaxFragLen + ?MAX_PADDING_LENGTH + ?MAX_MAC_LENGTH;
@@ -598,7 +598,13 @@ validate_tls_record_length(Versions, {_,Size0,_} = Q0, MaxFragLen,
                     {Fragment, Q} = binary_from_front(Length, Q0),
                     Record = #ssl_tls{type = Type, version = Version, fragment = Fragment},
                     ssl_logger:debug(LogLevel, inbound, 'record', Record),
-                    decode_tls_records(Versions, Q, MaxFragLen, SslOpts, [Record|Acc], undefined, undefined, undefined);
+                    case Downgrade of
+                        {_Pid, _From} ->
+                            %% parse only single record for downgrade scenario, buffer remaining data
+                            {[Record], {undefined, Q}};
+                        _ ->
+                            decode_tls_records(Versions, Q, MaxFragLen, SslOpts, [Record|Acc], undefined, undefined, undefined)
+                    end;
                 true ->
                     {lists:reverse(Acc),
                      {#ssl_tls{type = Type, version = Version, fragment = Length}, Q0}}
diff --git a/lib/ssl/test/tls_api_SUITE.erl b/lib/ssl/test/tls_api_SUITE.erl
index a3b642ab3f..841d7c35af 100644
--- a/lib/ssl/test/tls_api_SUITE.erl
+++ b/lib/ssl/test/tls_api_SUITE.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2019-2019. All Rights Reserved.
+%% Copyright Ericsson AB 2019-2021. All Rights Reserved.
 %%
 %% Licensed under the Apache License, Version 2.0 (the "License");
 %% you may not use this file except in compliance with the License.
@@ -167,9 +167,6 @@ init_per_group(GroupName, Config) ->
 end_per_group(GroupName, Config) ->
   ssl_test_lib:end_per_group(GroupName, Config).
 
-end_per_testcase(_TestCase, Config) ->     
-    Config.
-
 %%--------------------------------------------------------------------
 %% Test Cases --------------------------------------------------------
 %%--------------------------------------------------------------------
@@ -930,11 +927,15 @@ tls_downgrade_result(Socket, Pid) ->
             ok
     end,
     case ssl:close(Socket, {self(), 10000})  of
-	{ok, TCPSocket} -> 
+	{ok, TCPSocket} ->
             inet:setopts(TCPSocket, [{active, true}]),
 	    gen_tcp:send(TCPSocket, "Downgraded"),
             <<"Downgraded">> = active_tcp_recv(TCPSocket, length("Downgraded")),
             ok;
+	{ok, TCPSocket, Bin} ->
+	    gen_tcp:send(TCPSocket, "Downgraded"),
+            <<"Downgraded">> = Bin,
+            ok;
 	{error, timeout} ->
 	    ct:comment("Timed out, downgrade aborted"),
 	    ok;