fix handling of block_decipher/5 failure

A wrong decryption key would cause a badmatch in
generic_block_cipher_from_bin/2. The try in block_decipher/5 was
probably intendend to deal with that, but was misplace for this.

Additionaly, generating a failure alert erly, without computing the
record MAC, creates vector for a timing attack on CBC padding (for
details check TLS 1.2 RFC 5246, Sect. 6.2.3.2.). This attach vector
and the counter meassure applies to all SSL/TLS versions.

As a counter messure, compute the MAC even when decryption or padding
checks fail. A invalid padding will force a MAC failure by intentionaly
invalidating the content.

3 files changed, 220 insertions, 25 deletions

diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl
index 72f02a4362..95a5efd6d0 100644
--- a/lib/ssl/src/ssl_cipher.erl
+++ b/lib/ssl/src/ssl_cipher.erl
@@ -154,18 +154,23 @@ decipher(?AES, HashSz, CipherState, Fragment, Version) ->
 
 block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, 
 	       HashSz, Fragment, Version) ->
-    try Fun(Key, IV, Fragment) of
-	Text ->
-	    GBC = generic_block_cipher_from_bin(Text, HashSz),
-	    case is_correct_padding(GBC, Version) of
-		true ->
-		    Content = GBC#generic_block_cipher.content,
-		    Mac = GBC#generic_block_cipher.mac,
-		    CipherState1 = CipherState0#cipher_state{iv=next_iv(Fragment, IV)},
-		    {Content, Mac, CipherState1};
-		false ->
-		    ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC)
-	    end
+    try 
+	Text = Fun(Key, IV, Fragment),
+	GBC = generic_block_cipher_from_bin(Text, HashSz),
+	Content = GBC#generic_block_cipher.content,
+	Mac = GBC#generic_block_cipher.mac,
+	CipherState1 = CipherState0#cipher_state{iv=next_iv(Fragment, IV)},
+	case is_correct_padding(GBC, Version) of
+	    true ->
+		{Content, Mac, CipherState1};
+	    false ->
+		%% decryption failed or invalid padding,
+		%% intentionally break Content to make
+		%% sure a packet with a an invalid padding
+		%% but otherwise correct data will fail
+		%% the MAC test later
+		{<<16#F0, Content/binary>>, Mac, CipherState1}
+	end
     catch
 	_:_ ->
 	    %% This is a DECRYPTION_FAILED but
@@ -500,14 +505,38 @@ hash_size(md5) ->
 hash_size(sha) ->
     20.
 
+%% RFC 5246: 6.2.3.2.  CBC Block Cipher
+%%
+%%   Implementation note: Canvel et al. [CBCTIME] have demonstrated a
+%%   timing attack on CBC padding based on the time required to compute
+%%   the MAC.  In order to defend against this attack, implementations
+%%   MUST ensure that record processing time is essentially the same
+%%   whether or not the padding is correct.  In general, the best way to
+%%   do this is to compute the MAC even if the padding is incorrect, and
+%%   only then reject the packet.  For instance, if the pad appears to be
+%%   incorrect, the implementation might assume a zero-length pad and then
+%%   compute the MAC.  This leaves a small timing channel, since MAC
+%%   performance depends to some extent on the size of the data fragment,
+%%   but it is not believed to be large enough to be exploitable, due to
+%%   the large block size of existing MACs and the small size of the
+%%   timing signal.
+%%
+%% implementation note:
+%%   We return the original (possibly invalid) PadLength in any case.
+%%   A invalid PadLength will be cought by is_correct_padding/2
+%%
 generic_block_cipher_from_bin(T, HashSize) ->
     Sz1 = byte_size(T) - 1,
-    <<_:Sz1/binary, ?BYTE(PadLength)>> = T,
+    <<_:Sz1/binary, ?BYTE(PadLength0)>> = T,
+    PadLength = if
+		    PadLength0 >= Sz1 -> 0;
+		    true -> PadLength0
+		end,
     CompressedLength = byte_size(T) - PadLength - 1 - HashSize,
     <<Content:CompressedLength/binary, Mac:HashSize/binary,
-     Padding:PadLength/binary, ?BYTE(PadLength)>> = T,
+     Padding:PadLength/binary, ?BYTE(PadLength0)>> = T,
     #generic_block_cipher{content=Content, mac=Mac,
-			  padding=Padding, padding_length=PadLength}.
+			  padding=Padding, padding_length=PadLength0}.
 
 generic_stream_cipher_from_bin(T, HashSz) ->
     Sz = byte_size(T),
@@ -516,17 +545,18 @@ generic_stream_cipher_from_bin(T, HashSz) ->
     #generic_stream_cipher{content=Content,
 			   mac=Mac}.
 
-is_correct_padding(_, {3, 0}) ->
-    true; 
-%% For interoperability reasons we do not check the padding in TLS 1.0 as it
-%% is not strictly required and breaks interopability with for instance 
-%% Google. 
-is_correct_padding(_, {3, 1}) ->
-    true; 
+%% For interoperability reasons we do not check the padding content in
+%% SSL 3.0 and TLS 1.0 as it is not strictly required and breaks
+%% interopability with for instance Google. 
+is_correct_padding(#generic_block_cipher{padding_length = Len,
+										 padding = Padding}, {3, N})
+  when N == 0; N == 1 ->
+    Len == byte_size(Padding); 
 %% Padding must be check in TLS 1.1 and after  
-is_correct_padding(#generic_block_cipher{padding_length = Len, padding = Padding}, _) ->
-    list_to_binary(lists:duplicate(Len, Len))  == Padding.
-
+is_correct_padding(#generic_block_cipher{padding_length = Len,
+										 padding = Padding}, _) ->
+    Len == byte_size(Padding) andalso
+		list_to_binary(lists:duplicate(Len, Len)) == Padding.
 										      
 get_padding(Length, BlockSize) ->
     get_padding_aux(BlockSize, Length rem BlockSize).
diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile
index 23a9a23190..6b1da63d08 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -39,6 +39,7 @@ MODULES = \
 	ssl_basic_SUITE \
 	ssl_handshake_SUITE \
 	ssl_packet_SUITE \
+	ssl_cipher_SUITE \
 	ssl_payload_SUITE \
 	ssl_to_openssl_SUITE \
 	ssl_session_cache_SUITE	\
@@ -55,6 +56,7 @@ HRL_FILES_SRC = \
 	ssl_internal.hrl\
 	ssl_alert.hrl \
 	ssl_handshake.hrl \
+	ssl_cipher.hrl \
 	ssl_record.hrl
 
 HRL_FILES_INC = 
diff --git a/lib/ssl/test/ssl_cipher_SUITE.erl b/lib/ssl/test/ssl_cipher_SUITE.erl
new file mode 100644
index 0000000000..87478e13bc
--- /dev/null
+++ b/lib/ssl/test/ssl_cipher_SUITE.erl
@@ -0,0 +1,163 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(ssl_cipher_SUITE).
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+
+-include("ssl_internal.hrl").
+-include("ssl_record.hrl").
+-include("ssl_cipher.hrl").
+
+-define(TIMEOUT, 600000).
+
+%% Test server callback functions
+%%--------------------------------------------------------------------
+%% Function: init_per_suite(Config) -> Config
+%% Config - [tuple()]
+%%   A list of key/value pairs, holding the test case configuration.
+%% Description: Initialization before the whole suite
+%%
+%% Note: This function is free to add any key/value pairs to the Config
+%% variable, but should NOT alter/remove any existing entries.
+%%--------------------------------------------------------------------
+init_per_suite(Config) ->
+    try crypto:start() of
+	ok ->
+	    Config
+    catch _:_  ->
+	    {skip, "Crypto did not start"}
+    end.
+%%--------------------------------------------------------------------
+%% Function: end_per_suite(Config) -> _
+%% Config - [tuple()]
+%%   A list of key/value pairs, holding the test case configuration.
+%% Description: Cleanup after the whole suite
+%%--------------------------------------------------------------------
+end_per_suite(_Config) ->
+    ssl:stop(),
+    application:stop(crypto).
+
+%%--------------------------------------------------------------------
+%% Function: init_per_testcase(TestCase, Config) -> Config
+%% Case - atom()
+%%   Name of the test case that is about to be run.
+%% Config - [tuple()]
+%%   A list of key/value pairs, holding the test case configuration.
+%%
+%% Description: Initialization before each test case
+%%
+%% Note: This function is free to add any key/value pairs to the Config
+%% variable, but should NOT alter/remove any existing entries.
+%% Description: Initialization before each test case
+%%--------------------------------------------------------------------
+init_per_testcase(_TestCase, Config0) ->
+    Config = lists:keydelete(watchdog, 1, Config0),
+    Dog = ssl_test_lib:timetrap(?TIMEOUT),
+    [{watchdog, Dog} | Config].
+
+%%--------------------------------------------------------------------
+%% Function: end_per_testcase(TestCase, Config) -> _
+%% Case - atom()
+%%   Name of the test case that is about to be run.
+%% Config - [tuple()]
+%%   A list of key/value pairs, holding the test case configuration.
+%% Description: Cleanup after each test case
+%%--------------------------------------------------------------------
+end_per_testcase(_TestCase, Config) ->
+    Dog = ?config(watchdog, Config),
+    case Dog of 
+	undefined ->
+	    ok;
+	_ ->
+	    test_server:timetrap_cancel(Dog)
+    end.
+
+%%--------------------------------------------------------------------
+%% Function: all(Clause) -> TestCases
+%% Clause - atom() - suite | doc
+%% TestCases - [Case] 
+%% Case - atom()
+%%   Name of a test case.
+%% Description: Returns a list of all test cases in this test suite
+%%--------------------------------------------------------------------
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() -> 
+    [aes_decipher_good, aes_decipher_fail].
+
+groups() -> 
+    [].
+
+init_per_group(_GroupName, Config) ->
+    Config.
+
+end_per_group(_GroupName, Config) ->
+    Config.
+
+
+%% Test cases starts here.
+%%--------------------------------------------------------------------
+aes_decipher_good(doc) -> 
+    ["Decipher a known cryptotext."];
+
+aes_decipher_good(suite) -> 
+    [];
+
+aes_decipher_good(Config) when is_list(Config) ->
+    HashSz = 32,
+    CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>,
+				key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,148>>},
+    Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8,
+		 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160,
+		 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122,
+		 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>,
+    Version = {3,3},
+    Content = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56,72,69,76,76,79,10>>,
+    Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>,
+    {Content, Mac, CipherState1} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version),
+    ok.
+
+%%--------------------------------------------------------------------
+
+aes_decipher_fail(doc) -> 
+    ["Decipher a known cryptotext."];
+
+aes_decipher_fail(suite) -> 
+    [];
+
+%% same as above, last byte of key replaced
+aes_decipher_fail(Config) when is_list(Config) ->
+    HashSz = 32,
+    CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>,
+				key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,254>>},
+    Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8,
+		 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160,
+		 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122,
+		 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>,
+    Version = {3,3},
+    {Content, Mac, CipherState1} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version),
+    32 = byte_size(Content),
+    32 = byte_size(Mac),
+    ok.
+
+%%--------------------------------------------------------------------