ssl: Improve shutdown logic

Add possibility to downgrade an SSL/TLS connection to a tcp connection,
and give back the socket control to a user process.

Add application setting to be able to change fatal alert shutdown
timeout, also shorten the  default timeout. The fatal alert timeout is
the number of milliseconds between sending of a fatal alert and
closing the connection. Waiting a little while improves the
peers chances to properly receiving the alert so it may
shutdown gracefully.

6 files changed, 208 insertions, 64 deletions

diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index 6c977bdb74..22ac98c24e 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -766,6 +766,21 @@ fun(srp, Username :: string(), UserState :: term()) ->
     </func>
 
     <func>
+      <name>close(SslSocket, How) -> ok | {ok, port()} | {error, Reason}</name>
+      <fsummary>Closes an SSL connection.</fsummary>
+      <type>
+	  <v>SslSocket = sslsocket()</v>
+	  <v>How =  timeout() | {NewController::pid(), timeout()} </v>
+	  <v>Reason = term()</v>
+      </type>
+      <desc><p>Closes or downgrades an SSL connection, in the later case the transport
+      connection will be handed over to the <c>NewController</c> process after reciving
+      the TLS close alert from the peer. The retuned transport socket will have
+      the following options set [{active, false}, {packet, 0}, {mode, binary}].</p>
+      </desc>
+    </func>
+
+    <func>
 	<name>connection_info(SslSocket) ->
 	  {ok, {ProtocolVersion, CipherSuite}} | {error, Reason}</name>
       <fsummary>Returns the Negotiated Protocol version and cipher suite.
diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml
index 2b6dc7e8be..51ce0cedf1 100644
--- a/lib/ssl/doc/src/ssl_app.xml
+++ b/lib/ssl/doc/src/ssl_app.xml
@@ -87,6 +87,17 @@
 	    marker="ssl#clear_pem_cache-0">ssl:clear_pem_cache/0</seealso>
 	
       </item>
+      <tag><c><![CDATA[alert_timeout = integer() <optional>]]></c></tag>
+      <item>
+	<p>
+	  Number of milliseconds between sending of a fatal alert and
+	  closing the connection. Waiting a little while improves the
+	  peers chances to properly receiving the alert so it may
+	  shutdown gracefully. Defaults to 5000 milliseconds.   
+	</p>
+      </item>
+
+      
     </taglist>
   </section>
 
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 120e8b59ed..f611079912 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -34,7 +34,7 @@
 	 listen/2, transport_accept/1, transport_accept/2,
 	 ssl_accept/1, ssl_accept/2, ssl_accept/3,
 	 controlling_process/2, peername/1, peercert/1, sockname/1,
-	 close/1, shutdown/2, recv/2, recv/3, send/2, getopts/2, setopts/2
+	 close/1, close/2, shutdown/2, recv/2, recv/3, send/2, getopts/2, setopts/2
 	]).
 %% SSL/TLS protocol handling
 -export([cipher_suites/0, cipher_suites/1, suite_definition/1,
@@ -247,11 +247,27 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) ->
 %% Description: Close an ssl connection
 %%--------------------------------------------------------------------
 close(#sslsocket{pid = Pid}) when is_pid(Pid) ->
-    ssl_connection:close(Pid);
+    ssl_connection:close(Pid, {close, ?DEFAULT_TIMEOUT});
 close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _}}}}) ->
     Transport:close(ListenSocket).
 
 %%--------------------------------------------------------------------
+-spec  close(#sslsocket{}, integer() | {pid(), integer()}) -> term().
+%%
+%% Description: Close an ssl connection
+%%--------------------------------------------------------------------
+close(#sslsocket{pid = TLSPid}, 
+      {Pid, Timeout} = DownGrade) when is_pid(TLSPid), 
+				       is_pid(Pid), 
+				       (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) ->
+    ssl_connection:close(TLSPid, {close, DownGrade});
+close(#sslsocket{pid = TLSPid}, Timeout) when is_pid(TLSPid), 
+					      (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) ->
+    ssl_connection:close(TLSPid, {close, Timeout});
+close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _}}}}, _) ->
+    Transport:close(ListenSocket).
+
+%%--------------------------------------------------------------------
 -spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}.
 %%
 %% Description: Sends data over the ssl connection
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index 5b754c16bc..f8afbdb41d 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -41,7 +41,7 @@
 	 socket_control/4, socket_control/5]).
 
 %% User Events 
--export([send/2, recv/3, close/1, shutdown/2,
+-export([send/2, recv/3, close/2, shutdown/2,
 	 new_user/2, get_opts/2, set_opts/2, session_info/1, 
 	 peer_certificate/1, renegotiation/1, negotiated_protocol/1, prf/5,
 	 connection_information/1
@@ -171,18 +171,19 @@ connection_information(Pid) when is_pid(Pid) ->
     sync_send_all_state_event(Pid, connection_information).
 
 %%--------------------------------------------------------------------
--spec close(pid()) -> ok | {error, reason()}.  
+-spec close(pid(), {close, Timeout::integer() | 
+				    {NewController::pid(), Timeout::integer()}}) -> 
+		   ok | {ok, port()} | {error, reason()}.  
 %%
 %% Description:  Close an ssl connection
 %%--------------------------------------------------------------------
-close(ConnectionPid) ->
-    case sync_send_all_state_event(ConnectionPid, close) of
+close(ConnectionPid, How) ->
+    case sync_send_all_state_event(ConnectionPid, How) of
 	{error, closed} ->
 	    ok;
 	Other ->
 	    Other
     end.
-
 %%--------------------------------------------------------------------
 -spec shutdown(pid(), atom()) -> ok | {error, reason()}.  
 %%
@@ -706,12 +707,12 @@ handle_sync_event({start, Timeout}, StartFrom, StateName,  #state{role = Role, s
 	    {stop, normal, {error, Error}, State0}
     end;	
 
-handle_sync_event(close, _, StateName, #state{protocol_cb = Connection} = State) ->
-    %% Run terminate before returning
-    %% so that the reuseaddr inet-option will work
-    %% as intended.
-    (catch Connection:terminate(user_close, StateName, State)),
-    {stop, normal, ok, State#state{terminated = true}};
+handle_sync_event({close, _} = Close, _, StateName, #state{protocol_cb = Connection} = State) ->
+    %% Run terminate before returning so that the reuseaddr
+    %% inet-option and possible downgrade will work as intended.
+    Result = Connection:terminate(Close, StateName, State),
+    {stop, normal, Result, State#state{terminated = true}};
+
 handle_sync_event({shutdown, How0}, _, StateName,
 		  #state{transport_cb = Transport,
 			 negotiated_version = Version,
@@ -901,41 +902,46 @@ terminate(_, _, #state{terminated = true}) ->
     %% we want to guarantee that Transport:close has been called
     %% when ssl:close/1 returns.
     ok;
-terminate({shutdown, transport_closed}, StateName, #state{send_queue = SendQueue,
-							  renegotiation = Renegotiate} = State) ->
-    handle_unrecv_data(StateName, State),
+terminate({shutdown, transport_closed} = Reason, 
+	  _StateName, #state{send_queue = SendQueue, protocol_cb = Connection,
+			     socket = Socket, transport_cb = Transport,
+			     renegotiation = Renegotiate} = State) ->
     handle_trusted_certs_db(State),
     notify_senders(SendQueue),
-    notify_renegotiater(Renegotiate);
-
-terminate({shutdown, own_alert}, _StateName, #state{send_queue = SendQueue,
-				      renegotiation = Renegotiate} = State) ->
+    notify_renegotiater(Renegotiate),
+    Connection:close(Reason, Socket, Transport, undefined, undefined);
+terminate({shutdown, own_alert}, _StateName, #state{send_queue = SendQueue, protocol_cb = Connection,
+						    socket = Socket, transport_cb = Transport,
+						    renegotiation = Renegotiate} = State) ->
     handle_trusted_certs_db(State),
     notify_senders(SendQueue),
-    notify_renegotiater(Renegotiate);
+    notify_renegotiater(Renegotiate),
+    case application:get_env(ssl, alert_timeout) of
+	{ok, Timeout} when is_integer(Timeout) ->
+	    Connection:close({timeout, Timeout}, Socket, Transport, undefined, undefined);
+	_ ->
+	    Connection:close({timeout, ?DEFAULT_TIMEOUT}, Socket, Transport, undefined, undefined)
+    end;
 terminate(Reason, connection, #state{negotiated_version = Version,
 				     protocol_cb = Connection,
-				     connection_states = ConnectionStates, 
+				     connection_states = ConnectionStates0, 
+				     ssl_options = #ssl_options{padding_check = Check},
 				     transport_cb = Transport, socket = Socket, 
 				     send_queue = SendQueue, renegotiation = Renegotiate} = State) ->
     handle_trusted_certs_db(State),
     notify_senders(SendQueue),
     notify_renegotiater(Renegotiate),
-    BinAlert = terminate_alert(Reason, Version, ConnectionStates),
+    {BinAlert, ConnectionStates} = terminate_alert(Reason, Version, ConnectionStates0),
     Transport:send(Socket, BinAlert),
-    case Connection of
-	tls_connection ->
-	    tls_connection:workaround_transport_delivery_problems(Socket, Transport);
-	_ ->
-	    ok
-    end;
-terminate(_Reason, _StateName, #state{transport_cb = Transport,
+    Connection:close(Reason, Socket, Transport, ConnectionStates, Check);
+
+terminate(Reason, _StateName, #state{transport_cb = Transport, protocol_cb = Connection,
 				      socket = Socket, send_queue = SendQueue,
 				      renegotiation = Renegotiate} = State) ->
     handle_trusted_certs_db(State),
     notify_senders(SendQueue),
     notify_renegotiater(Renegotiate),
-    Transport:close(Socket).
+    Connection:close(Reason, Socket, Transport, undefined, undefined).
 
 format_status(normal, [_, State]) ->
     [{data, [{"StateData", State}]}];  
@@ -1758,30 +1764,17 @@ get_timeout(#state{ssl_options=#ssl_options{hibernate_after = undefined}}) ->
 get_timeout(#state{ssl_options=#ssl_options{hibernate_after = HibernateAfter}}) ->
     HibernateAfter.
 
-terminate_alert(Reason, Version, ConnectionStates) when Reason == normal;
-							Reason == user_close ->
-    {BinAlert, _} = ssl_alert:encode(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY),
-				 Version, ConnectionStates),
-    BinAlert;
-terminate_alert({shutdown, _}, Version, ConnectionStates) ->
-    {BinAlert, _} = ssl_alert:encode(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY),
-				 Version, ConnectionStates),
-    BinAlert;
+terminate_alert(normal, Version, ConnectionStates)  ->
+    ssl_alert:encode(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY),
+		     Version, ConnectionStates);
+terminate_alert({Reason, _}, Version, ConnectionStates) when Reason == close;
+							     Reason == shutdown ->
+    ssl_alert:encode(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY),
+		     Version, ConnectionStates);
 
 terminate_alert(_, Version, ConnectionStates) ->
-    {BinAlert, _} = ssl_alert:encode(?ALERT_REC(?FATAL, ?INTERNAL_ERROR),
-				 Version, ConnectionStates),
-    BinAlert.
-
-handle_unrecv_data(StateName, #state{socket = Socket, transport_cb = Transport,
-				     protocol_cb = Connection} = State) ->
-    ssl_socket:setopts(Transport, Socket, [{active, false}]),
-    case Transport:recv(Socket, 0, 0) of
-	{error, closed} ->
-	    ok;
-	{ok, Data} ->
-	    Connection:handle_close_alert(Data, StateName, State)
-    end.
+    ssl_alert:encode(?ALERT_REC(?FATAL, ?INTERNAL_ERROR),
+		     Version, ConnectionStates).
 
 handle_trusted_certs_db(#state{ssl_options = #ssl_options{cacertfile = <<>>, cacerts = []}}) ->
     %% No trusted certs specified
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index 7fda2377ee..3093508f61 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -54,7 +54,7 @@
 %% Alert and close handling
 -export([send_alert/2, handle_own_alert/4, handle_close_alert/3,
 	 handle_normal_shutdown/3, handle_unexpected_message/3,
-	 workaround_transport_delivery_problems/2, alert_user/6, alert_user/9
+	 close/5, alert_user/6, alert_user/9
 	]).
 
 %% Data handling
@@ -924,8 +924,7 @@ handle_own_alert(Alert, Version, StateName,
     try %% Try to tell the other side
 	{BinMsg, _} =
 	ssl_alert:encode(Alert, Version, ConnectionStates),
-	Transport:send(Socket, BinMsg),
-	workaround_transport_delivery_problems(Socket, Transport)
+	Transport:send(Socket, BinMsg)
     catch _:_ ->  %% Can crash if we are in a uninitialized state
 	    ignore
     end,
@@ -977,21 +976,57 @@ invalidate_session(client, Host, Port, Session) ->
 invalidate_session(server, _, Port, Session) ->
     ssl_manager:invalidate_session(Port, Session).
 
-workaround_transport_delivery_problems(Socket, gen_tcp = Transport) ->
+%% User downgrades connection
+%% When downgrading an TLS connection to a transport connection
+%% we must recive the close message before releasing the 
+%% transport socket.
+close({close, {Pid, Timeout}}, Socket, Transport, ConnectionStates, Check) when is_pid(Pid) -> 
+    ssl_socket:setopts(Transport, Socket, [{active, false}, {packet, ssl_tls}]),
+    case Transport:recv(Socket, 0, Timeout) of
+	{ok, {ssl_tls, Socket, ?ALERT, Version,  Fragment}} ->
+	    case tls_record:decode_cipher_text(#ssl_tls{type = ?ALERT,
+							version = Version,
+							fragment = Fragment
+						       }, ConnectionStates, Check) of
+		{#ssl_tls{fragment = Plain}, _} ->
+		    [Alert| _] = decode_alerts(Plain),
+		    downgrade(Alert, Transport, Socket, Pid)
+	    end;
+	{error, timeout} ->
+	    {error, timeout};
+	_ ->
+	    {error, no_tls_close}
+    end;
+%% User closes or recursive call!
+close({close, Timeout}, Socket, Transport = gen_tcp, _,_) ->
+    ssl_socket:setopts(Transport, Socket, [{active, false}]),
+    Transport:shutdown(Socket, write),
+    _ = Transport:recv(Socket, 0, Timeout),
+    ok;
+%% Peer closed socket
+close({shutdown, transport_closed}, Socket, Transport = gen_tcp, ConnectionStates, Check) ->
+    close({close, 0}, Socket, Transport, ConnectionStates, Check);
+%% We generate fatal alert
+close({shutdown, own_alert}, Socket, Transport = gen_tcp, ConnectionStates, Check) ->
     %% Standard trick to try to make sure all
     %% data sent to the tcp port is really delivered to the
     %% peer application before tcp port is closed so that the peer will
     %% get the correct TLS alert message and not only a transport close.
-    ssl_socket:setopts(Transport, Socket, [{active, false}]),
-    Transport:shutdown(Socket, write),
-    %% Will return when other side has closed or after 30 s
+    %% Will return when other side has closed or after timout millisec
     %% e.g. we do not want to hang if something goes wrong
     %% with the network but we want to maximise the odds that
     %% peer application gets all data sent on the tcp connection.
-    Transport:recv(Socket, 0, 30000);
-workaround_transport_delivery_problems(Socket, Transport) ->
+    close({close, ?DEFAULT_TIMEOUT}, Socket, Transport, ConnectionStates, Check);
+%% Other
+close(_, Socket, Transport, _,_) -> 
     Transport:close(Socket).
-
+downgrade(#alert{description = ?CLOSE_NOTIFY}, Transport, Socket, Pid) ->
+    ssl_socket:setopts(Transport, Socket, [{active, false}, {packet, 0}, {mode, binary}]),
+    Transport:controlling_process(Socket, Pid),
+    {ok, Socket};
+downgrade(_, _,_,_) ->
+    {error, no_tls_close}.
+	       
 convert_state(#state{ssl_options = Options} = State, up, "5.3.5", "5.3.6") ->
     State#state{ssl_options = convert_options_partial_chain(Options, up)};
 convert_state(#state{ssl_options = Options} = State, down, "5.3.6", "5.3.5") ->
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 378f42c2ee..82c3c4ac74 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -129,6 +129,8 @@ api_tests() ->
      controlling_process,
      upgrade,
      upgrade_with_timeout,
+     downgrade,
+     close_with_timeout,
      shutdown,
      shutdown_write,
      shutdown_both,
@@ -320,7 +322,8 @@ init_per_testcase(rizzo, Config) ->
     Config;
 
 init_per_testcase(TestCase, Config) when TestCase == ssl_accept_timeout;
-					 TestCase == client_closes_socket ->
+					 TestCase == client_closes_socket;
+					 TestCase == downgrade ->
     ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]),
     ct:timetrap({seconds, 15}),
     Config;
@@ -1408,6 +1411,53 @@ upgrade_with_timeout(Config) when is_list(Config) ->
     ssl_test_lib:close(Client).
 
 %%--------------------------------------------------------------------
+downgrade() ->
+      [{doc,"Test that you can downgarde an ssl connection to an tcp connection"}].
+downgrade(Config) when is_list(Config) -> 
+    ClientOpts = ?config(client_opts, Config),
+    ServerOpts = ?config(server_opts, Config),
+    
+    {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
+    Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+					{from, self()},
+					{mfa, {?MODULE, tls_downgrade, []}},
+					{options, [{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, tls_downgrade, []}},
+					{options, [{active, false} |ClientOpts]}]),
+
+    ssl_test_lib:check_result(Server, ok, Client, ok),
+    ssl_test_lib:close(Server),
+    ssl_test_lib:close(Client).
+
+%%--------------------------------------------------------------------
+close_with_timeout() ->
+      [{doc,"Test normal (not downgrade) ssl:close/2"}].
+close_with_timeout(Config) when is_list(Config) -> 
+    ClientOpts = ?config(client_opts, Config),
+    ServerOpts = ?config(server_opts, Config),
+    
+    {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
+    Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+					{from, self()},
+					{mfa, {?MODULE, tls_close, []}},
+					{options,[{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, tls_close, []}},
+					{options, [{active, false} |ClientOpts]}]),
+
+    ssl_test_lib:check_result(Server, ok, Client, ok).
+
+
+%%--------------------------------------------------------------------
 tcp_connect() ->
     [{doc,"Test what happens when a tcp tries to connect, i,e. a bad (ssl) packet is sent first"}].
 
@@ -3931,6 +3981,30 @@ connect_dist_c(S) ->
     {ok, Test} = ssl:recv(S, 0, 10000),
     ok.
 
+tls_downgrade(Socket) ->
+    ok = ssl_test_lib:send_recv_result(Socket),
+    case ssl:close(Socket, {self(), 5000})  of
+	{ok, TCPSocket} -> 
+	    inet:setopts(TCPSocket, [{active, true}]),
+	    gen_tcp:send(TCPSocket, "Downgraded"),
+	    receive 
+		{tcp, TCPSocket, <<"Downgraded">>} ->
+		    ok;
+		Other ->
+		   {error, Other}
+	    end;
+	{error, timeout} ->
+	    ct:pal("Timed out, downgrade aborted"),
+	    ok;
+	Fail ->
+	    {error, Fail}
+    end.
+
+tls_close(Socket) ->
+    ok = ssl_test_lib:send_recv_result(Socket),
+    ok = ssl:close(Socket, 5000).
+    
+
  %% First two clauses handles 1/n-1 splitting countermeasure Rizzo/Duong-Beast
 treashold(N, {3,0}) ->
     (N div 2) + 1;