Teach VM not to dump core on bad dist message structure

1 files changed, 252 insertions, 39 deletions

diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl
index 79252d0593..4b44a2b420 100644
--- a/erts/emulator/test/distribution_SUITE.erl
+++ b/erts/emulator/test/distribution_SUITE.erl
@@ -39,6 +39,7 @@
 	 atom_roundtrip/1,
 	 atom_roundtrip_r12b/1,
 	 contended_atom_cache_entry/1,
+	 bad_dist_structure/1,
 	 bad_dist_ext/1,
 	 bad_dist_ext_receive/1,
 	 bad_dist_ext_process_info/1,
@@ -61,6 +62,7 @@ all(suite) -> [
 	       stop_dist, trap_bif, dist_auto_connect, dist_parallel_send,
 	       atom_roundtrip, atom_roundtrip_r12b,
 	       contended_atom_cache_entry,
+	       bad_dist_structure,
 	       bad_dist_ext
 	      ].
 
@@ -174,7 +176,7 @@ bulk_sendsend2(Terms, BinSize, BusyBufSize) ->
     ?line {ok, NodeRecv} = start_node(bulk_receiver),
     ?line Recv = spawn(NodeRecv, erlang, apply, [fun receiver/2, [0, 0]]),
     ?line Bin = list_to_binary(lists:duplicate(BinSize*1024, 253)),
-    ?line Size = Terms*size(Bin),
+    %%?line Size = Terms*size(Bin),
 
     %% SLF LEFT OFF HERE.
     %% When the caller uses small hunks, like 4k via
@@ -187,7 +189,7 @@ bulk_sendsend2(Terms, BinSize, BusyBufSize) ->
 
     ?line {ok, NodeSend} = start_node(bulk_sender, "+zdbbl " ++ integer_to_list(BusyBufSize)),
     ?line _Send = spawn(NodeSend, erlang, apply, [fun sendersender/4, [self(), Recv, Bin, Terms]]),
-    ?line {Elapsed, {TermsN, SizeN}, MonitorCount} =
+    ?line {Elapsed, {_TermsN, SizeN}, MonitorCount} =
         receive {sendersender, BigRes} ->
                 BigRes
         end,
@@ -227,7 +229,7 @@ sendersender3(To, _Bin, 0, SendDone, MonitorCount) ->
             ok
     end,
     receive
-        {monitor, _Pid, _Type, _Info} = M ->
+        {monitor, _Pid, _Type, _Info} ->
             sendersender3(To, _Bin, 0, SendDone, MonitorCount + 1)
     after 0 ->
             if SendDone ->
@@ -522,7 +524,7 @@ sink1() ->
 
 lost_exit(doc) ->
     "Test that EXIT and DOWN messages send to another node are not lost if "
-	"if the distribution port is busy.";
+	"the distribution port is busy.";
 lost_exit(Config) when is_list(Config) ->
     ?line {ok, Node} = start_node(lost_exit),
 
@@ -1143,8 +1145,7 @@ contended_atom_cache_entry(Config) when is_list(Config) ->
     ?line {ok, SNode} = start_node(Config),
     ?line {ok, RNode} = start_node(Config),
     ?line Success = make_ref(),
-    ?line Mstr
-	= spawn_link(
+    ?line spawn_link(
 	    SNode,
 	    fun () ->
 		    erts_debug:set_internal_state(available_internal_state,
@@ -1201,13 +1202,13 @@ contended_atom_cache_entry(Config) when is_list(Config) ->
     ?line stop_node(RNode),
     ?line ok.
 
-send_ref_atom(To, Ref, Atom, 0) ->
+send_ref_atom(_To, _Ref, _Atom, 0) ->
     ok;
 send_ref_atom(To, Ref, Atom, N) ->
     To ! {Ref, Atom},
     send_ref_atom(To, Ref, Atom, N-1).
 
-receive_ref_atom(Ref, Atom, 0) ->
+receive_ref_atom(_Ref, _Atom, 0) ->
     ok;
 receive_ref_atom(Ref, Atom, N) ->
     receive
@@ -1242,7 +1243,7 @@ unwanted_cixs() ->
 	      nodes()).
     
     
-get_conflicting_atoms(CIX, 0) ->
+get_conflicting_atoms(_CIX, 0) ->
     [];
 get_conflicting_atoms(CIX, N) ->
     {A, B, C} = now(),
@@ -1256,6 +1257,187 @@ get_conflicting_atoms(CIX, N) ->
 	    get_conflicting_atoms(CIX, N)
     end.
 
+-define(COOKIE, '').
+-define(DOP_LINK,		1).
+-define(DOP_SEND,		2).
+-define(DOP_EXIT,		3).
+-define(DOP_UNLINK,		4).
+-define(DOP_NODE_LINK,		5).
+-define(DOP_REG_SEND,		6).
+-define(DOP_GROUP_LEADER,	7).
+-define(DOP_EXIT2,		8).
+
+-define(DOP_SEND_TT,		12).
+-define(DOP_EXIT_TT,		13).
+-define(DOP_REG_SEND_TT,	16).
+-define(DOP_EXIT2_TT,		18).
+
+-define(DOP_MONITOR_P,		19).
+-define(DOP_DEMONITOR_P,	20).
+-define(DOP_MONITOR_P_EXIT,	21).
+
+start_monitor(Offender,P) ->
+    ?line Parent = self(),
+    ?line Q = spawn(Offender,
+		    fun () -> 
+			    Ref = erlang:monitor(process,P),
+			    Parent ! {self(),ref,Ref},
+			    receive
+				just_stay_alive -> ok
+			    end
+		    end),
+    ?line Ref = receive
+		    {Q,ref,R} ->
+			R
+		after  5000 ->
+			error
+		end,
+    io:format("Ref is ~p~n",[Ref]),
+    ok.
+start_link(Offender,P) ->
+    ?line Parent = self(),
+    ?line Q = spawn(Offender,
+		    fun () ->
+			    process_flag(trap_exit,true),
+			    link(P),
+			    Parent ! {self(),ref,P},
+			    receive
+				just_stay_alive -> ok
+			    end
+		    end),
+    ?line Ref = receive
+		    {Q,ref,R} ->
+			R
+		after  5000 ->
+			error
+		end,
+    io:format("Ref is ~p~n",[Ref]),
+    ok.
+
+bad_dist_structure(suite) ->
+    [];
+bad_dist_structure(doc) ->
+    ["Test dist messages with valid structure (binary to term ok) but malformed"
+     "control content"];
+bad_dist_structure(Config) when is_list(Config) ->
+    %process_flag(trap_exit,true),
+    ODog = ?config(watchdog, Config),
+    ?t:timetrap_cancel(ODog),
+    Dog = ?t:timetrap(?t:seconds(15)),
+
+    ?line {ok, Offender} = start_node(bad_dist_structure_offender),
+    ?line {ok, Victim} = start_node(bad_dist_structure_victim),
+    ?line start_node_monitors([Offender,Victim]),
+    ?line Parent = self(),
+    ?line P = spawn(Victim,
+		    fun () ->
+			    process_flag(trap_exit,true),
+			    Parent ! {self(), started},
+			    receive check_msgs -> ok end,
+			    bad_dist_struct_check_msgs([one,
+							two]),
+			    Parent ! {self(), messages_checked},
+			    receive done -> ok end
+		    end),
+    ?line receive {P, started} -> ok end,
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line verify_up(Offender, Victim),
+    ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])),
+    ?line start_monitor(Offender,P),
+    ?line P ! one,
+    ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal},2),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line start_monitor(Offender,P),
+    ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal,normal},2),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line start_link(Offender,P),
+    ?line send_bad_structure(Offender, P,{?DOP_LINK},0),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line start_link(Offender,P),
+    ?line send_bad_structure(Offender, P,{?DOP_UNLINK,'replace'},2),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line start_link(Offender,P),
+    ?line send_bad_structure(Offender, P,{?DOP_UNLINK,'replace',make_ref()},2),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line start_link(Offender,P),
+    ?line send_bad_structure(Offender, P,{?DOP_UNLINK,make_ref(),P},0),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line start_link(Offender,P),
+    ?line send_bad_structure(Offender, P,{?DOP_UNLINK,normal,normal},0),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line start_monitor(Offender,P),
+    ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P},2),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line start_monitor(Offender,P),
+    ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P,normal},2),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line start_monitor(Offender,P),
+    ?line send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P},2),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line start_monitor(Offender,P),
+    ?line send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P,normal},2),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_EXIT,'replace',P},2),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_EXIT,make_ref(),normal,normal},0),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_EXIT_TT,'replace',token,P},2),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_EXIT_TT,make_ref(),token,normal,normal},0),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_EXIT2,'replace',P},2),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_EXIT2,make_ref(),normal,normal},0),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_EXIT2_TT,'replace',token,P},2),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_EXIT2_TT,make_ref(),token,normal,normal},0),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace'},2),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace','atomic'},2),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace',P},0),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name},2,{message}),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name,token},0,{message}),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace',''},2,{message}),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',P},0,{message}),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name},0,{message}),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name,{token}},2,{message}),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_SEND_TT,'',P},0,{message}),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_SEND_TT,'',name,token},0,{message}),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_SEND,''},0,{message}),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_SEND,'',name},0,{message}),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line send_bad_structure(Offender, P,{?DOP_SEND,'',P,{token}},0,{message}),
+    ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
+    ?line P ! two,
+    ?line P ! check_msgs,
+    ?line receive 
+	      {P, messages_checked} -> ok 
+	  after 5000 ->
+		  exit(victim_is_dead)
+	  end,
+
+    ?line {message_queue_len, 0}
+	= rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
+    
+    ?line unlink(P),
+    ?line P ! done,
+    ?line stop_node(Offender),
+    ?line stop_node(Victim),
+    ?t:timetrap_cancel(Dog),
+    ok.
 
 bad_dist_ext(doc) -> [];
 bad_dist_ext(suite) ->
@@ -1483,6 +1665,22 @@ bad_dist_ext_connection_id(Config) when is_list(Config) ->
     ?line stop_node(Victim).
 
 
+bad_dist_struct_check_msgs([]) ->
+    receive
+	Msg ->
+	    exit({unexpected_message, Msg})
+    after 0 ->
+	    ok
+    end;
+bad_dist_struct_check_msgs([M|Ms]) ->
+    receive
+	{'EXIT',_,_} = EM ->
+	    io:format("Ignoring exit message: ~p~n",[EM]),
+	    bad_dist_struct_check_msgs([M|Ms]);
+	Msg ->
+	    M = Msg,
+	    bad_dist_struct_check_msgs(Ms)
+    end.
 bad_dist_ext_check_msgs([]) ->
     receive
 	Msg ->
@@ -1497,24 +1695,6 @@ bad_dist_ext_check_msgs([M|Ms]) ->
 	    bad_dist_ext_check_msgs(Ms)
     end.
     
--define(COOKIE, '').
--define(DOP_LINK,		1).
--define(DOP_SEND,		2).
--define(DOP_EXIT,		3).
--define(DOP_UNLINK,		4).
--define(DOP_NODE_LINK,		5).
--define(DOP_REG_SEND,		6).
--define(DOP_GROUP_LEADER,	7).
--define(DOP_EXIT2,		8).
-
--define(DOP_SEND_TT,		12).
--define(DOP_EXIT_TT,		13).
--define(DOP_REG_SEND_TT,	16).
--define(DOP_EXIT2_TT,		18).
-
--define(DOP_MONITOR_P,		19).
--define(DOP_DEMONITOR_P,	20).
--define(DOP_MONITOR_P_EXIT,	21).
 
 dport_reg_send(Node, Name, Msg) ->
     DPrt = case dport(Node) of
@@ -1546,6 +1726,39 @@ dport_send(To, Msg) ->
 				  ?COOKIE,
 				  To}),
 			dmsg_ext(Msg)]).
+send_bad_structure(Offender,Victim,Bad,WhereToPutSelf) ->
+    send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,[]).
+send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) ->
+    Parent = self(),
+    Done = make_ref(),
+    spawn(Offender,
+	  fun () ->
+		  Node = node(Victim),
+		  pong = net_adm:ping(Node),
+		  DPrt = dport(Node),
+		  Bad1 = case WhereToPutSelf of
+			     0 -> 
+				 Bad;
+			     N when N > 0 ->
+				 setelement(N,Bad,self())
+			 end,
+		  DData = [dmsg_hdr(),
+			   dmsg_ext(Bad1)] ++
+		      case PayLoad of
+			  [] -> [];
+			  _Other -> [dmsg_ext(PayLoad)]
+		      end,
+		  port_command(DPrt, DData),
+		  Parent ! {DData,Done}
+	  end),
+    receive 
+	{WhatSent,Done} -> 
+	    io:format("Offender sent ~p~n",[WhatSent]),
+	    ok
+    after 5000 ->
+	    exit(unable_to_send)
+    end.
+   
 
 %% send_bad_msgs():
 %% Send a valid distribution header and control message
@@ -1629,10 +1842,10 @@ dmsg_bad_hdr() ->
      255].  % 255 atom references
     
 
-dmsg_fake_hdr1() ->
-    A = <<"fake header atom 1">>,
-    [131, % Version Magic
-     $D, 1, 16#8, 0, size(A), A]. % Fake header
+%% dmsg_fake_hdr1() ->
+%%     A = <<"fake header atom 1">>,
+%%     [131, % Version Magic
+%%      $D, 1, 16#8, 0, size(A), A]. % Fake header
 
 dmsg_fake_hdr2() ->
     A1 = <<"fake header atom 1">>,
@@ -1817,7 +2030,7 @@ flush_node_changes() ->
 
 node_monitor_loop(Master) ->
     receive
-	{nodeup, Node, InfoList} = Msg ->
+	{nodeup, Node, _InfoList} = Msg ->
 	    Master ! {nodeup, node(), Node},
 	    ?t:format("~p ~p: ~p~n", [node(), erlang:now(), Msg]),
 	    node_monitor_loop(Master);
@@ -1854,9 +2067,9 @@ verify_no_down(A, B) ->
 	    ok
     end.
 
-verify_down(A, B) ->
-    receive {nodedown, A, B, _} -> ok end,
-    receive {nodedown, B, A, _} -> ok end.
+%% verify_down(A, B) ->
+%%     receive {nodedown, A, B, _} -> ok end,
+%%     receive {nodedown, B, A, _} -> ok end.
 
 verify_down(A, ReasonA, B, ReasonB) ->
     receive
@@ -1876,11 +2089,11 @@ from(H, [H | T]) -> T;
 from(H, [_ | T]) -> from(H, T);
 from(_, []) -> [].
 
-fun_spawn(Fun) ->
-    fun_spawn(Fun, []).
+%% fun_spawn(Fun) ->
+%%     fun_spawn(Fun, []).
 
-fun_spawn(Fun, Args) ->
-    spawn_link(erlang, apply, [Fun, Args]).
+%% fun_spawn(Fun, Args) ->
+%%     spawn_link(erlang, apply, [Fun, Args]).
 
 
 long_or_short() ->