Merge branch 'raimo/inet_res-crash-rest-time-0/OTP-9221' into dev

* raimo/inet_res-crash-rest-time-0/OTP-9221:
  Do not UDP send when there is 0 ms left to wait for reply
  Check return values from UDP send functions
  Cleanup timeout handling, fix bug for remaining time =:= 0
  Add DNS proxy and first test case for late answer

2 files changed, 233 insertions, 97 deletions

diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl
index de0f23bf24..93563c6011 100644
--- a/lib/kernel/src/inet_res.erl
+++ b/lib/kernel/src/inet_res.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1997-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
@@ -539,27 +539,41 @@ udp_send(#sock{inet=I}, {A,B,C,D}=IP, Port, Buffer)
   when ?ip(A,B,C,D), ?port(Port) ->
     gen_udp:send(I, IP, Port, Buffer).
 
-udp_recv(#sock{inet6=I}, {A,B,C,D,E,F,G,H}=IP, Port, Timeout)
+udp_recv(#sock{inet6=I}, {A,B,C,D,E,F,G,H}=IP, Port, Timeout, Decode)
   when ?ip6(A,B,C,D,E,F,G,H), ?port(Port) ->
-    do_udp_recv(fun(T) -> gen_udp:recv(I, 0, T) end, IP, Port, Timeout);
-udp_recv(#sock{inet=I}, {A,B,C,D}=IP, Port, Timeout)
+    do_udp_recv(I, IP, Port, Timeout, Decode, erlang:now(), Timeout);
+udp_recv(#sock{inet=I}, {A,B,C,D}=IP, Port, Timeout, Decode)
   when ?ip(A,B,C,D), ?port(Port) ->
-    do_udp_recv(fun(T) -> gen_udp:recv(I, 0, T) end, IP, Port, Timeout).
-
-do_udp_recv(Recv, IP, Port, Timeout) ->
-    do_udp_recv(Recv, IP, Port, Timeout, 
-		if Timeout =/= 0 -> erlang:now(); true -> undefined end).
-
-do_udp_recv(Recv, IP, Port, Timeout, Then) ->
-    case Recv(Timeout) of
-	{ok,{IP,Port,Answer}} ->
-	    {ok,Answer,erlang:max(0, Timeout - now_ms(erlang:now(), Then))};
-	{ok,_} when Timeout =:= 0 ->
-	    {error,timeout};
-	{ok,_} ->
-	    Now = erlang:now(),
-	    T = erlang:max(0, Timeout - now_ms(Now, Then)),
-	    do_udp_recv(Recv, IP, Port, T, Now);
+    do_udp_recv(I, IP, Port, Timeout, Decode, erlang:now(), Timeout).
+
+do_udp_recv(_I, _IP, _Port, 0, _Decode, _Start, _T) ->
+    timeout;
+do_udp_recv(I, IP, Port, Timeout, Decode, Start, T) ->
+    case gen_udp:recv(I, 0, T) of
+	{ok,Reply} ->
+	    case Decode(Reply) of
+		false when T =:= 0 ->
+		    %% This is a compromize between the hard way i.e
+		    %% in the clause below if NewT becomes 0 bailout
+		    %% immediately and risk that the right reply lies
+		    %% ahead after some bad id replies, and the
+		    %% forgiving way i.e go on with Timeout 0 until
+		    %% the right reply comes or no reply (timeout)
+		    %% which opens for a DOS attack by a malicious
+		    %% DNS server flooding with bad id replies causing
+		    %% an infinite loop here.
+		    %%
+		    %% Timeout is used as a sanity limit counter
+		    %% just to put an end to the loop.
+		    NewTimeout = erlang:max(0, Timeout - 50),
+		    do_udp_recv(I, IP, Port, NewTimeout, Decode, Start, T);
+		false ->
+		    Now = erlang:now(),
+		    NewT = erlang:max(0, Timeout - now_ms(Now, Start)),
+		    do_udp_recv(I, IP, Port, Timeout, Decode, Start, NewT);
+		Result ->
+		    Result
+	    end;
 	Error -> Error
     end.
 
@@ -580,6 +594,17 @@ udp_close(#sock{inet=I,inet6=I6}) ->
 %%     end
 %%  end
 %%
+%% But that man page also says dig always use num_servers = 1.
+%%
+%% Our man page says: timeout/retry, then double for next retry, i.e
+%%  for i = 0 to retry - 1
+%%     foreach nameserver
+%%        send query
+%%        wait((time * (2**i)) / retry)
+%%     end
+%%  end
+%%
+%% And that is what the code seems to do, now fixed, hopefully...
 
 do_query(_Q, [], _Timer) ->
     {error,nxdomain};
@@ -589,19 +614,16 @@ do_query(#q{options=#options{retry=Retry}}=Q, NSs, Timer) ->
 query_retries(_Q, _NSs, _Timer, Retry, Retry, S) ->
     udp_close(S),
     {error,timeout};
+query_retries(_Q, [], _Timer, _Retry, _I, S) ->
+    udp_close(S),
+    {error,timeout};
 query_retries(Q, NSs, Timer, Retry, I, S0) ->
-    Num = length(NSs),
-    if Num =:= 0 ->
-	    udp_close(S0),
-	    {error,timeout};
-       true ->
-	    case query_nss(Q, NSs, Timer, Retry, I, S0, []) of
-		{S,{noanswer,ErrNSs}} -> %% remove unreachable nameservers
-		    query_retries(Q, NSs--ErrNSs, Timer, Retry, I+1, S);
-		{S,Result} ->
-		    udp_close(S),
-		    Result
-	    end
+    case query_nss(Q, NSs, Timer, Retry, I, S0, []) of
+	{S,{noanswer,ErrNSs}} -> %% remove unreachable nameservers
+	    query_retries(Q, NSs--ErrNSs, Timer, Retry, I+1, S);
+	{S,Result} ->
+	    udp_close(S),
+	    Result
     end.
 
 query_nss(_Q, [], _Timer, _Retry, _I, S, ErrNSs) ->
@@ -611,13 +633,13 @@ query_nss(#q{edns=undefined}=Q, NSs, Timer, Retry, I, S, ErrNSs) ->
 query_nss(Q, NSs, Timer, Retry, I, S, ErrNSs) ->
     query_nss_edns(Q, NSs, Timer, Retry, I, S, ErrNSs).
 
-query_nss_edns(#q{options=#options{udp_payload_size=PSz}=Options,
-		  edns={Id,Buffer}}=Q,
-	       [{IP,Port}=NS|NSs]=NSs0, Timer, Retry, I, S0, ErrNSs) ->
-    {S,Res}=Reply = query_ns(S0, Id, Buffer, IP, Port, Timer,
-		       Retry, I, Options, PSz),
+query_nss_edns(
+  #q{options=#options{udp_payload_size=PSz}=Options,edns={Id,Buffer}}=Q,
+  [{IP,Port}=NS|NSs]=NSs0, Timer, Retry, I, S0, ErrNSs) ->
+    {S,Res}=Reply =
+	query_ns(S0, Id, Buffer, IP, Port, Timer, Retry, I, Options, PSz),
     case Res of
-	timeout -> {S,{error,timeout}};
+	timeout -> {S,{error,timeout}}; % Bailout timeout
 	{ok,_} -> Reply;
 	{error,{nxdomain,_}} -> Reply;
 	{error,{E,_}} when E =:= qfmterror; E =:= notimp; E =:= servfail;
@@ -629,17 +651,19 @@ query_nss_edns(#q{options=#options{udp_payload_size=PSz}=Options,
 	    query_nss(Q, NSs, Timer, Retry, I, S, ErrNSs)
     end.
 
-query_nss_dns(#q{dns=Qdns}=Q0, [{IP,Port}=NS|NSs],
-	      Timer, Retry, I, S0, ErrNSs) ->
+query_nss_dns(
+  #q{dns=Qdns}=Q0,
+  [{IP,Port}=NS|NSs], Timer, Retry, I, S0, ErrNSs) ->
     #q{options=Options,dns={Id,Buffer}}=Q =
 	if
 	    is_function(Qdns, 0) -> Q0#q{dns=Qdns()};
 	    true -> Q0
 	end,
-    {S,Res}=Reply = query_ns(S0, Id, Buffer, IP, Port, Timer,
-			Retry, I, Options, ?PACKETSZ),
+    {S,Res}=Reply =
+	query_ns(
+	  S0, Id, Buffer, IP, Port, Timer, Retry, I, Options, ?PACKETSZ),
     case Res of
-	timeout -> {S,{error,timeout}};
+	timeout -> {S,{error,timeout}}; % Bailout timeout
 	{ok,_} -> Reply;
 	{error,{E,_}} when E =:= nxdomain; E =:= qfmterror -> Reply;
 	{error,E} when E =:= fmt; E =:= enetunreach; E =:= econnrefused ->
@@ -653,48 +677,66 @@ query_ns(S0, Id, Buffer, IP, Port, Timer, Retry, I,
 	 PSz) ->
     case UseVC orelse iolist_size(Buffer) > PSz of
 	true ->
-	    {S0,query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose)};
+	    TcpTimeout = inet:timeout(Tm*5, Timer),
+	    {S0,query_tcp(TcpTimeout, Id, Buffer, IP, Port, Verbose)};
 	false ->
 	    case udp_open(S0, IP) of
 		{ok,S} ->
-		    {S,case query_udp(S, Id, Buffer, IP, Port, Timer,
-					  Retry, I, Tm, Verbose) of
-			   {ok,#dns_rec{header=H}} when H#dns_header.tc ->
-			       query_tcp(Tm, Id, Buffer,
-					 IP, Port, Timer, Verbose);
-			   Reply -> Reply
-		       end};
+		    Timeout =
+			inet:timeout( (Tm * (1 bsl I)) div Retry, Timer),
+		    {S,
+		     case query_udp(
+			    S, Id, Buffer, IP, Port, Timeout, Verbose) of
+			 {ok,#dns_rec{header=H}} when H#dns_header.tc ->
+			     TcpTimeout = inet:timeout(Tm*5, Timer),
+			     query_tcp(
+			       TcpTimeout, Id, Buffer, IP, Port, Verbose);
+			 Reply -> Reply
+		     end};
 		Error ->
 		    {S0,Error}
 	    end
     end.
 
-query_udp(S, Id, Buffer, IP, Port, Timer, Retry, I, Tm, Verbose) ->
-    Timeout = inet:timeout( (Tm * (1 bsl I)) div Retry, Timer),
+query_udp(_S, _Id, _Buffer, _IP, _Port, 0, Verbose) ->
+    timeout;
+query_udp(S, Id, Buffer, IP, Port, Timeout, Verbose) ->
     ?verbose(Verbose, "Try UDP server : ~p:~p (timeout=~w)\n",
-	     [IP, Port, Timeout]),
-    udp_connect(S, IP, Port),
-    udp_send(S, IP, Port, Buffer),
-    query_udp_recv(S, IP, Port, Id, Timeout, Verbose).
-
-query_udp_recv(S, IP, Port, Id, Timeout, Verbose) ->
-    case udp_recv(S, IP, Port, Timeout) of
-	{ok,Answer,T} ->
-	    case decode_answer(Answer, Id, Verbose) of
-		{error, badid} ->
-		    query_udp_recv(S, IP, Port, Id, T, Verbose);
-		Reply -> Reply
+	     [IP,Port,Timeout]),
+    case
+	case udp_connect(S, IP, Port) of
+	    ok ->
+		udp_send(S, IP, Port, Buffer);
+	    E1 ->
+		E1 end of
+	ok ->
+	    Decode =
+		fun ({RecIP,RecPort,Answer})
+		      when RecIP =:= IP, RecPort =:= Port ->
+			case decode_answer(Answer, Id, Verbose) of
+			    {error,badid} ->
+				false;
+			    Reply ->
+				Reply
+			end;
+		    ({_,_,_}) ->
+			false
+		end,
+	    case udp_recv(S, IP, Port, Timeout, Decode) of
+		{ok,_}=Result ->
+		    Result;
+		E2 ->
+		    ?verbose(Verbose, "UDP server error: ~p\n", [E2]),
+		    E2
 	    end;
-	{error, timeout} when Timeout =:= 0 ->
-	    ?verbose(Verbose, "UDP server timeout\n", []),
-	    timeout;
-	Error -> 
-	    ?verbose(Verbose, "UDP server error: ~p\n", [Error]),
-	    Error
+	E3 ->
+	    ?verbose(Verbose, "UDP send failed: ~p\n", [E3]),
+	    {error,econnrefused}
     end.
 
-query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose) ->
-    Timeout = inet:timeout(Tm*5, Timer),
+query_tcp(0, _Id, _Buffer, _IP, _Port, Verbose) ->
+    timeout;
+query_tcp(Timeout, Id, Buffer, IP, Port, Verbose) ->
     ?verbose(Verbose, "Try TCP server : ~p:~p (timeout=~w)\n",
 	     [IP, Port, Timeout]),
     Family = case IP of
@@ -716,19 +758,10 @@ query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose) ->
 		    end;
 		Error ->
 		    gen_tcp:close(S),
-		    case Error of
-			{error, timeout} when Timeout =:= 0 ->
-			    ?verbose(Verbose, "TCP server recv timeout\n", []),
-			    timeout;
-			_ ->
-			    ?verbose(Verbose, "TCP server recv error: ~p\n",
-				    [Error]),
-			    Error
-		    end
+		    ?verbose(Verbose, "TCP server recv error: ~p\n",
+			     [Error]),
+		    Error
 	    end;
-	{error, timeout} when Timeout =:= 0 ->
-	    ?verbose(Verbose, "TCP server connect timeout\n", []),
-	    timeout;
 	Error ->
 	    ?verbose(Verbose, "TCP server error: ~p\n", [Error]),
 	    Error
diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl
index 5fc8df475d..6064a9b2d9 100644
--- a/lib/kernel/test/inet_res_SUITE.erl
+++ b/lib/kernel/test/inet_res_SUITE.erl
@@ -27,7 +27,8 @@
 -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
 	 init_per_group/2,end_per_group/2,
 	 init_per_testcase/2, end_per_testcase/2]).
--export([basic/1, resolve/1, edns0/1, txt_record/1, files_monitor/1]).
+-export([basic/1, resolve/1, edns0/1, txt_record/1, files_monitor/1,
+	 last_ms_answer/1]).
 -export([
 	 gethostbyaddr/0, gethostbyaddr/1,
 	 gethostbyaddr_v6/0, gethostbyaddr_v6/1,
@@ -45,6 +46,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
 
 all() -> 
     [basic, resolve, edns0, txt_record, files_monitor,
+     last_ms_answer,
      gethostbyaddr, gethostbyaddr_v6, gethostbyname,
      gethostbyname_v6, getaddr, getaddr_v6, ipv4_to_ipv6,
      host_and_addr].
@@ -64,16 +66,15 @@ init_per_group(_GroupName, Config) ->
 end_per_group(_GroupName, Config) ->
     Config.
 
-zone_dir(basic) ->
-    otptest;
-zone_dir(resolve) ->
-    otptest;
-zone_dir(edns0) ->
-    otptest;
-zone_dir(files_monitor) ->
-    otptest;
-zone_dir(_) ->
-    undefined.
+zone_dir(TC) ->
+    case TC of
+	basic -> otptest;
+	resolve -> otptest;
+	edns0 -> otptest;
+	files_monitor -> otptest;
+	last_ms_answer -> otptest;
+	_ -> undefined
+    end.
 
 init_per_testcase(Func, Config) ->
     PrivDir = ?config(priv_dir, Config),
@@ -184,6 +185,88 @@ ns_printlog(Fname) ->
 	    ok
     end.
 
+%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Behaviour modifying nameserver proxy
+
+proxy_start(TC, {NS,P}) ->
+    Tag = make_ref(),
+    Parent = self(),
+    Pid =
+	spawn_link(
+	  fun () ->
+		  try proxy_start(TC, NS, P, Parent, Tag)
+		  catch C:X ->
+			  io:format(
+			    "~w: ~w:~p ~p~n",
+			    [self(),C,X,erlang:get_stacktrace()])
+		  end
+	  end),
+    receive {started,Tag,Port} ->
+	    ProxyNS = {{127,0,0,1},Port},
+	    {proxy,Pid,Tag,ProxyNS}
+    end.
+
+proxy_start(TC, NS, P, Parent, Tag) ->
+    {ok,Outbound} = gen_udp:open(0, [binary]),
+    ok = gen_udp:connect(Outbound, NS, P),
+    {ok,Inbound} = gen_udp:open(0, [binary]),
+    {ok,Port} = inet:port(Inbound),
+    Parent ! {started,Tag,Port},
+    proxy(TC, Outbound, NS, P, Inbound).
+
+
+%% To provoke the last_ms_answer bug (OTP-9221) the proxy
+%% * Relays the query to the right nameserver
+%% * Intercepts the reply but holds it until the timer that
+%%   was started when receiving the query fires.
+%% * Repeats the reply with incorrect query ID a number of
+%%   times with a short interval.
+%% * Sends the correct reply, to give a correct test result
+%%   after bug correction.
+%%
+%% The repetition of an incorrect answer with tight interval will keep
+%% inet_res in an inner loop in the code that decrements the remaining
+%% time until it hits 0 which triggers a crash, if the outer timeout
+%% parameter to inet_res:resolve is so short that it runs out during
+%% these repetitions.
+proxy(last_ms_answer, Outbound, NS, P, Inbound) ->
+    receive
+	{udp,Inbound,SrcIP,SrcPort,Data} ->
+	    Time =
+		inet_db:res_option(timeout) div inet_db:res_option(retry),
+	    Tag = erlang:make_ref(),
+	    erlang:send_after(Time - 10, self(), {time,Tag}),
+	    ok = gen_udp:send(Outbound, NS, P, Data),
+	    receive
+		{udp,Outbound,NS,P,Reply} ->
+		    {ok,Msg} = inet_dns:decode(Reply),
+		    Hdr = inet_dns:msg(Msg, header),
+		    Id = inet_dns:header(Hdr, id),
+		    BadHdr =
+			inet_dns:make_header(Hdr, id, (Id+1) band 16#ffff),
+		    BadMsg = inet_dns:make_msg(Msg, header, BadHdr),
+		    BadReply = inet_dns:encode(BadMsg),
+		    receive
+			{time,Tag} ->
+			    proxy__last_ms_answer(
+			      Inbound, SrcIP, SrcPort, BadReply, Reply, 30)
+		    end
+	    end
+    end.
+
+proxy__last_ms_answer(Socket, IP, Port, _, Reply, 0) ->
+    ok = gen_udp:send(Socket, IP, Port, Reply);
+proxy__last_ms_answer(Socket, IP, Port, BadReply, Reply, N) ->
+    ok = gen_udp:send(Socket, IP, Port, BadReply),
+    receive after 1 -> ok end,
+    proxy__last_ms_answer(Socket, IP, Port, BadReply, Reply, N-1).
+
+proxy_wait({proxy,Pid,_,_}) ->
+    Mref = erlang:monitor(process, Pid),
+    receive {'DOWN',Mref,_,_,_} -> ok end.
+
+proxy_ns({proxy,_,_,ProxyNS}) -> ProxyNS.
+
 %%
 %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
@@ -204,7 +287,7 @@ basic(Config) when is_list(Config) ->
     {ok,Msg1} = inet_dns:decode(Bin1),
     %%
     %% resolve
-    {ok,Msg2} = inet_res:resolve(Name, in, a, [{nameservers,[NS]}]),
+    {ok,Msg2} = inet_res:resolve(Name, in, a, [{nameservers,[NS]},verbose]),
     io:format("~p~n", [Msg2]),
     [RR2] = inet_dns:msg(Msg2, anlist),
     IP = inet_dns:rr(RR2, data),
@@ -474,6 +557,26 @@ do_files_monitor(Config) ->
     ok.
 
 %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+last_ms_answer(doc) ->
+    ["Answer just when timeout is triggered (OTP-9221)"];
+last_ms_answer(Config) when is_list(Config) ->
+    NS = ns(Config),
+    Name = "ns.otptest",
+    %%IP = {127,0,0,254},
+    Time = inet_db:res_option(timeout) div inet_db:res_option(retry),
+    PSpec = proxy_start(last_ms_answer, NS),
+    ProxyNS = proxy_ns(PSpec),
+    %%
+    %% resolve; whith short timeout to trigger Timeout =:= 0 in inet_res
+    {error,timeout} =
+	inet_res:resolve(
+	  Name, in, a, [{nameservers,[ProxyNS]},verbose], Time + 10),
+    %%
+    proxy_wait(PSpec),
+    ok.
+
+%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %% Compatibility tests. Call the inet_SUITE tests, but with
 %% lookup = [file,dns] instead of [native]