ssl: Buffer unsent encrypted data on send timeout

lib/ssl/src/tls_sender.erl

@@ -91,6 +91,13 @@
          low   = undefined
         }).
 
+%% Buffer for unsent encrypted data returned by gen_tcp:send
+%% as {error, {timeout, RestData}} when using {inet_backend, socket}
+-record(rest,
+        {
+         q_rev = []    %% Remaining encrypted data (iodata)
+        }).
+
 -define(IS_ASYNC(Tag), Tag =:= select; Tag =:= completion).
 
 %%%===================================================================
@@ -285,24 +292,52 @@ connection({call, From}, {post_handshake_data, HSData}, #data{buff = Buff} = Sta
     case Buff of
         undefined ->
             send_post_handshake_data(HSData, From, connection, StateData, [{reply, From, ok}]);
-        Async ->
-            {next_state, async_wait, StateData#data{buff = Async#async{low = 0}}, [postpone]}
+        #async{} = Async ->
+            {next_state, async_wait, StateData#data{buff = Async#async{low = 0}}, [postpone]};
+        #rest{} ->
+            case flush_rest_buffer(StateData) of
+                {ok, #data{buff = undefined} = StateData1} ->
+                    send_post_handshake_data(HSData, From, connection, StateData1, [{reply, From, ok}]);
+                {ok, StateData1} ->
+                    {keep_state, StateData1, [postpone]};
+                {error, Reason, StateData1} ->
+                    death_row_shutdown({error, Reason}, StateData1)
+            end
     end;
 connection({call, From}, {ack_alert, #alert{} = Alert}, #data{buff = Buff} = StateData0) ->
     case Buff of
         undefined ->
             StateData = send_tls_alert(Alert, StateData0),
             {next_state, connection, StateData, [{reply,From,ok}]};
-        Async ->
-            {next_state, async_wait, StateData0#data{buff = Async#async{low = 0}}, [postpone]}
+        #async{} = Async ->
+            {next_state, async_wait, StateData0#data{buff = Async#async{low = 0}}, [postpone]};
+        #rest{} ->
+            case flush_rest_buffer(StateData0) of
+                {ok, #data{buff = undefined} = StateData1} ->
+                    StateData = send_tls_alert(Alert, StateData1),
+                    {next_state, connection, StateData, [{reply,From,ok}]};
+                {ok, StateData1} ->
+                    {keep_state, StateData1, [postpone]};
+                {error, Reason, StateData1} ->
+                    death_row_shutdown({error, Reason}, StateData1)
+            end
     end;
 connection({call, From}, renegotiate,
            #data{connection_states = #{current_write := Write}, buff = Buff} = StateData) ->
     case Buff of
         undefined ->
             {next_state, handshake, StateData, [{reply, From, {ok, Write}}]};
-        Async ->
-            {next_state, async_wait, StateData#data{buff = Async#async{low = 0}}, [postpone]}
+        #async{} = Async ->
+            {next_state, async_wait, StateData#data{buff = Async#async{low = 0}}, [postpone]};
+        #rest{} ->
+            case flush_rest_buffer(StateData) of
+                {ok, #data{buff = undefined} = StateData1} ->
+                    {next_state, handshake, StateData1, [{reply, From, {ok, Write}}]};
+                {ok, StateData1} ->
+                    {keep_state, StateData1, [postpone]};
+                {error, Reason, StateData1} ->
+                    death_row_shutdown({error, Reason}, StateData1)
+            end
     end;
 connection({call, From}, downgrade, #data{connection_states =
                                               #{current_write := Write}} = StateData) ->
@@ -329,17 +364,36 @@ connection(internal, {post_handshake_data, From, HSData}, #data{buff = Buff} = S
      case Buff of
          undefined ->
              send_post_handshake_data(HSData, From, connection, StateData, []);
-         Async ->
-             {next_state, async_wait, StateData#data{buff = Async#async{low = 0}}, [postpone]}
+         #async{} = Async ->
+             {next_state, async_wait, StateData#data{buff = Async#async{low = 0}}, [postpone]};
+         #rest{} ->
+             case flush_rest_buffer(StateData) of
+                 {ok, #data{buff = undefined} = StateData1} ->
+                     send_post_handshake_data(HSData, From, connection, StateData1, []);
+                 {ok, StateData1} ->
+                     {keep_state, StateData1, [postpone]};
+                 {error, Reason, StateData1} ->
+                     death_row_shutdown({error, Reason}, StateData1)
+             end
      end;
 
 connection(cast, #alert{} = Alert,  #data{buff = Buff} = StateData0) ->
      case Buff of
          undefined ->
              StateData = send_tls_alert(Alert, StateData0),
              {next_state, connection, StateData};
-         Async ->
-             {next_state, async_wait, StateData0#data{buff = Async#async{low = 0}}, [postpone]}
+         #async{} = Async ->
+             {next_state, async_wait, StateData0#data{buff = Async#async{low = 0}}, [postpone]};
+         #rest{} ->
+             case flush_rest_buffer(StateData0) of
+                 {ok, #data{buff = undefined} = StateData1} ->
+                     StateData = send_tls_alert(Alert, StateData1),
+                     {next_state, connection, StateData};
+                 {ok, StateData1} ->
+                     {keep_state, StateData1, [postpone]};
+                 {error, Reason, StateData1} ->
+                     death_row_shutdown({error, Reason}, StateData1)
+             end
      end;
 connection(cast, {new_write, WritesState, Version, MaxFragLen},
            #data{connection_states = ConnectionStates0, env = Env} = StateData) ->
@@ -589,6 +643,12 @@ send_or_buffer(Transport, Socket, Msgs, From, #data{buff = undefined} = StateDat
         ok ->
             send_reply(From, ok),
             {ok, StateData0};
+        {error, {timeout, RestData}} ->
+            %% gen_tcp:send with {inet_backend, socket} returns unsent
+            %% encrypted data on timeout. Buffer it for retry on next send.
+            %% Reply {error, timeout} to simulate {inet_backend, inet} behavior.
+            send_reply(From, {error, timeout}),
+            {ok, StateData0#data{buff = #rest{q_rev = RestData}}};
         {error, timeout} = Error ->
             %% This clause is to retain some backwards compatibility with
             %% inet-driver behavior for gen_tcp:send timeout. That
@@ -626,7 +686,25 @@ send_or_buffer(Transport, Socket, Msgs, From, #data{buff = undefined} = StateDat
                     {block, StateData0#data{buff = Async#async{reply_to = From}}}
             end
     end;
-%% Buffer exists, push more data to buffer
+%% Rest buffer exists, flush buffered data together with new data.
+%% Transport is gen_tcp, no async select/completion results.
+send_or_buffer(Transport, Socket, Msgs, From,
+               #data{buff = #rest{q_rev = BuffData}} = StateData0) ->
+    case tls_socket:send(Transport, Socket, [BuffData | Msgs]) of
+        ok ->
+            send_reply(From, ok),
+            {ok, StateData0#data{buff = undefined}};
+        {error, {timeout, RestData}} ->
+            send_reply(From, {error, timeout}),
+            {ok, StateData0#data{buff = #rest{q_rev = RestData}}};
+        {error, timeout} = Error ->
+            send_reply(From, Error),
+            {ok, StateData0#data{buff = undefined}};
+        {error, _Err} = Error ->
+            send_reply(From, Error),
+            Error
+    end;
+%% Async buffer exists, push more data to buffer
 send_or_buffer(_Transport, _Socket, Msgs, From, #data{buff = Async0} = StateData) ->
     #async{high = High, size = Sz0, q_rev = Q} = Async0,
     Sz = Sz0 + iolist_size(Msgs),
@@ -639,6 +717,22 @@ send_or_buffer(_Transport, _Socket, Msgs, From, #data{buff = Async0} = StateData
             {block, StateData#data{buff = Async#async{reply_to = From}}}
     end.
 
+%% Try to flush the #rest{} buffer. Returns {ok, #data{}} on success
+%% or timeout, {error, Reason, #data{}} on hard send failure.
+flush_rest_buffer(#data{env = #env{socket = Socket,
+                                   transport_cb = Transport},
+                        buff = #rest{q_rev = BuffData}} = StateData) ->
+    case tls_socket:send(Transport, Socket, BuffData) of
+        ok ->
+            {ok, StateData#data{buff = undefined}};
+        {error, {timeout, RestData}} ->
+            {ok, StateData#data{buff = #rest{q_rev = RestData}}};
+        {error, timeout} ->
+            {ok, StateData#data{buff = undefined}};
+        {error, Reason} ->
+            {error, Reason, StateData#data{buff = undefined}}
+    end.
+
 do_async_send(_Transport, _Socket, _Handle, _Nextstate, {error, Err} = Error,
               #data{buff = #async{reply_to = From}} = StateData) ->
     send_reply(From, Error),

lib/ssl/test/ssl_api_SUITE.erl

@@ -63,6 +63,8 @@
          select_sha1_cert/1,
          inet_backend_option_order/0,
          inet_backend_option_order/1,
+         send_timeout_buffering/0,
+         send_timeout_buffering/1,
          root_any_sign/0,
          root_any_sign/1,
          connection_information/0,
@@ -230,6 +232,8 @@
          suite_check/2,
          ecdsa_cert_check/1,
          check_peercert/2,
+         send_timeout_sink/2,
+         send_timeout_fill/2,
          %%TODO Keep?
          run_error_server/1,
          run_client_error/1
@@ -267,9 +271,11 @@
      {'tlsv1.1', [parallel],  gen_api_tests() ++ handshake_paus_tests() ++ pre_1_3() ++ pre_1_2()},
      {'tlsv1', [parallel],  gen_api_tests() ++ handshake_paus_tests() ++ pre_1_3() ++ pre_1_2() ++
           beast_mitigation_test()},
-     {'dtlsv1.2', [parallel], gen_api_tests() -- [new_options_in_handshake, hibernate_server] ++
+     {'dtlsv1.2', [parallel], gen_api_tests() -- [new_options_in_handshake, hibernate_server,
+                                                   send_timeout_buffering] ++
           handshake_paus_tests() -- [handshake_continue_tls13_client] ++ pre_1_3()},
-     {'dtlsv1', [parallel],  gen_api_tests() -- [new_options_in_handshake, hibernate_server] ++
+     {'dtlsv1', [parallel],  gen_api_tests() -- [new_options_in_handshake, hibernate_server,
+                                                   send_timeout_buffering] ++
           handshake_paus_tests() -- [handshake_continue_tls13_client] ++ pre_1_3() ++ pre_1_2()},
      {transport_socket,  [parallel], gen_api_tests() -- [ssl_not_started, dh_params]}
     ].
@@ -309,6 +315,7 @@
      peercert_with_client_cert,
      select_sha1_cert,
      inet_backend_option_order,
+     send_timeout_buffering,
      connection_information,
      secret_connection_info,
      keylog_connection_info,
@@ -677,6 +684,92 @@
     ssl_test_lib:close(Server),
     ssl_test_lib:close(Client).
 
+%%--------------------------------------------------------------------
+send_timeout_buffering() ->
+    [{doc,"Test that ssl buffers unsent encrypted data on send timeout "
+      "when using {inet_backend, socket} and retries on next send"}].
+send_timeout_buffering(Config) when is_list(Config) ->
+    ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config),
+    ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+    {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+    %% Spawn a coordinator that relays signals between client and server.
+    Coord = spawn_link(fun send_timeout_coord/0),
+    Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+                                        {from, self()},
+                                        {mfa, {?MODULE, send_timeout_sink, [Coord]}},
+                                        {options, [{inet_backend, socket},
+                                                   {active, false}
+                                                   | ServerOpts]}]),
+    Port = ssl_test_lib:inet_port(Server),
+    Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+                                        {host, Hostname},
+                                        {from, self()},
+                                        {mfa, {?MODULE, send_timeout_fill, [Coord]}},
+                                        {options, [{inet_backend, socket},
+                                                   {active, false},
+                                                   {sndbuf, 4096},
+                                                   {send_timeout, 50}
+                                                   | ClientOpts]}]),
+
+    ssl_test_lib:check_result(Server, ok, Client, ok),
+
+    ssl_test_lib:close(Server),
+    ssl_test_lib:close(Client).
+
+%% Coordinator process: relays start_recv from client to server,
+%% and drained from server back to client.
+send_timeout_coord() ->
+    ServerPid = receive {server_ready, Pid} -> Pid
+                after 5000 -> exit(coord_no_server)
+                end,
+    ClientPid = receive {start_recv, Pid2} -> Pid2
+                after 5000 -> exit(coord_no_start_recv)
+                end,
+    ServerPid ! start_recv,
+    receive drained -> ClientPid ! drained
+    after 5000 -> exit(coord_no_drained)
+    end.
+
+send_timeout_sink(Socket, Coord) ->
+    %% Server side: announce to coordinator, wait for signal, drain, signal back.
+    Coord ! {server_ready, self()},
+    receive start_recv -> ok
+    after 5000 -> ct:fail(server_timeout_waiting_for_start_recv)
+    end,
+    send_timeout_recv_loop(Socket),
+    Coord ! drained,
+    ok.
+
+send_timeout_recv_loop(Socket) ->
+    case ssl:recv(Socket, 0, 1000) of
+        {ok, _} -> send_timeout_recv_loop(Socket);
+        {error, timeout} -> ok;
+        {error, closed} -> ok
+    end.
+
+send_timeout_fill(Socket, Coord) ->
+    %% Client side: fill buffer, signal server via coordinator, wait for drain.
+    Data = <<0:(1024*8)>>,
+    send_timeout_fill_loop(Socket, Data, 0, Coord).
+
+send_timeout_fill_loop(Socket, Data, N, Coord) ->
+    case ssl:send(Socket, Data) of
+        ok ->
+            send_timeout_fill_loop(Socket, Data, N + 1, Coord);
+        {error, timeout} when N > 0 ->
+            %% Buffer filled. Signal server to start draining.
+            Coord ! {start_recv, self()},
+            %% Wait for server to finish draining.
+            receive drained -> ok
+            after 5000 -> ct:fail(client_timeout_waiting_for_drained)
+            end,
+            %% Verify connection is still usable.
+            ok = ssl:send(Socket, <<"still alive">>),
+            ok;
+        {error, _} = Error ->
+            Error
+    end.
+
 %%--------------------------------------------------------------------
 connection_information() ->
     [{doc,"Test the API function ssl:connection_information/1"}].