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.

3 files changed, 107 insertions, 63 deletions

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") ->