ssh: Make tests for bad packet_len and field lengths inside packets

Includes a ssh_transport:pack/3 function for generating invalid packets

3 files changed, 85 insertions, 5 deletions

diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl
index 8b65806dc6..d622ec27fc 100644
--- a/lib/ssh/src/ssh_transport.erl
+++ b/lib/ssh/src/ssh_transport.erl
@@ -45,7 +45,7 @@
 	 handle_kex_ecdh_init/2,
 	 handle_kex_ecdh_reply/2,
 	 extract_public_key/1,
-	 unpack/3, decompress/2, ssh_packet/2, pack/2, msg_data/1,
+	 unpack/3, decompress/2, ssh_packet/2, pack/2, pack/3, msg_data/1,
 	 sign/3, verify/4]).
 
 %%%----------------------------------------------------------------------------
@@ -929,11 +929,18 @@ ssh_packet(Msg, Ssh) ->
     BinMsg = ssh_message:encode(Msg),
     pack(BinMsg, Ssh).
 
+pack(Data, Ssh=#ssh{}) ->
+    pack(Data, Ssh, 0).
+
+%%% Note: pack/3 is only to be called from tests that wants
+%%% to deliberetly send packets with wrong PacketLength!
+%%% Use pack/2 for all other purposes!
 pack(Data0, #ssh{encrypt_block_size = BlockSize, 
 		 send_sequence = SeqNum, send_mac = MacAlg,
 		 send_mac_key = MacKey,
 		 random_length_padding = RandomLengthPadding} 
-     = Ssh0) when is_binary(Data0) ->
+     = Ssh0,
+     PacketLenDeviationForTests) when is_binary(Data0) ->
     {Ssh1, Data} = compress(Ssh0, Data0),
     PL = (BlockSize - ((4 + 1 + size(Data)) rem BlockSize)) rem BlockSize,
     MinPaddingLen = if PL <  4 -> PL + BlockSize;
@@ -946,7 +953,7 @@ pack(Data0, #ssh{encrypt_block_size = BlockSize,
 		      end,
     PaddingLen = MinPaddingLen + ExtraPaddingLen,
     Padding = ssh_bits:random(PaddingLen),
-    PacketLen = 1 + PaddingLen + size(Data),
+    PacketLen = 1 + PaddingLen + size(Data) + PacketLenDeviationForTests,
     PacketData = <<?UINT32(PacketLen),?BYTE(PaddingLen), 
 		  Data/binary, Padding/binary>>,
     {Ssh2, EncPacket} = encrypt(Ssh1, PacketData),
diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl
index 03c2ce53cb..b84ccac885 100644
--- a/lib/ssh/test/ssh_protocol_SUITE.erl
+++ b/lib/ssh/test/ssh_protocol_SUITE.erl
@@ -47,7 +47,9 @@ suite() ->
 all() -> 
     [{group,tool_tests},
      {group,kex},
-     {group,service_requests}
+     {group,service_requests},
+     {group,packet_size_error},
+     {group,field_size_error}
     ].
 
 groups() ->
@@ -56,6 +58,12 @@ groups() ->
 		       lib_match,
 		       lib_no_match
 		      ]},
+     {packet_size_error, [], [packet_length_too_large,
+			      packet_length_too_short]},
+      
+     {field_size_error, [], [service_name_length_too_large,
+			     service_name_length_too_short]},
+      
      {kex, [], [no_common_alg_server_disconnects,
 		no_common_alg_client_disconnects,
 		gex_client_init_default_noexact,
@@ -409,6 +417,64 @@ bad_service_name(Config, Name) ->
 		    receive_msg}
 	  ], InitialState).
 
+%%%--------------------------------------------------------------------
+packet_length_too_large(Config) -> bad_packet_length(Config, +4).
+
+packet_length_too_short(Config) -> bad_packet_length(Config, -4).
+    
+bad_packet_length(Config, LengthExcess) ->
+    PacketFun = 
+	fun(Msg, Ssh) ->
+		BinMsg = ssh_message:encode(Msg),
+		ssh_transport:pack(BinMsg, Ssh, LengthExcess)
+	end,
+    {ok,InitialState} = connect_and_kex(Config),
+    {ok,_} =
+	ssh_trpt_test_lib:exec(
+	  [{set_options, [print_ops, print_seqnums, print_messages]},
+	   {send, {special,
+		   #ssh_msg_service_request{name="ssh-userauth"},
+		   PacketFun}},
+	   %% Prohibit remote decoder starvation:	   
+	   {send, #ssh_msg_service_request{name="ssh-userauth"}},
+	   {match, {'or',[#ssh_msg_disconnect{_='_'},
+			  tcp_closed
+			 ]},
+		    receive_msg}
+	  ], InitialState).
+
+%%%--------------------------------------------------------------------
+service_name_length_too_large(Config) -> bad_service_name_length(Config, +4).
+
+service_name_length_too_short(Config) -> bad_service_name_length(Config, -4).
+
+
+bad_service_name_length(Config, LengthExcess) ->
+    PacketFun = 
+	fun(#ssh_msg_service_request{name=Service}, Ssh) ->
+		BinName = list_to_binary(Service),
+		BinMsg = 
+		    <<?BYTE(?SSH_MSG_SERVICE_REQUEST),
+		      %% A bad string encoding of Service:
+		      ?UINT32(size(BinName)+LengthExcess), BinName/binary
+		    >>,
+		ssh_transport:pack(BinMsg, Ssh)
+	end,
+    {ok,InitialState} = connect_and_kex(Config),
+    {ok,_} =
+	ssh_trpt_test_lib:exec(
+	  [{set_options, [print_ops, print_seqnums, print_messages]},
+	   {send, {special,
+		   #ssh_msg_service_request{name="ssh-userauth"}, 
+		   PacketFun} },
+	   %% Prohibit remote decoder starvation:	   
+	   {send, #ssh_msg_service_request{name="ssh-userauth"}},
+	   {match, {'or',[#ssh_msg_disconnect{_='_'},
+			  tcp_closed
+			 ]},
+	    receive_msg}
+	  ], InitialState).
+    
 %%%================================================================
 %%%==== Internal functions ========================================
 %%%================================================================
diff --git a/lib/ssh/test/ssh_trpt_test_lib.erl b/lib/ssh/test/ssh_trpt_test_lib.erl
index 5080b33249..4269529ae8 100644
--- a/lib/ssh/test/ssh_trpt_test_lib.erl
+++ b/lib/ssh/test/ssh_trpt_test_lib.erl
@@ -386,7 +386,14 @@ send(S0, Line) when is_binary(Line) ->
 	    fun(X) when X==true;X==detail -> {"Send line~n~p~n",[Line]} end),
     send_bytes(Line, S#s{return_value = Line});
 
-%%% Msg = #ssh_msg_*{}
+send(S0, {special,Msg,PacketFun}) when is_tuple(Msg),
+				       is_function(PacketFun,2) ->
+    S = opt(print_messages, S0,
+	    fun(X) when X==true;X==detail -> {"Send~n~s~n",[format_msg(Msg)]} end),
+    {Packet, C} = PacketFun(Msg, S#s.ssh),
+    send_bytes(Packet, S#s{ssh = C, %%inc_send_seq_num(C),
+			   return_value = Msg});
+
 send(S0, Msg) when is_tuple(Msg) ->
     S = opt(print_messages, S0,
 	    fun(X) when X==true;X==detail -> {"Send~n~s~n",[format_msg(Msg)]} end),