Merge branch 'maint'

* maint:
  Do not build binary until needed
  Do not drop random mode after getting econnrefused
  Be prepared for broken UTF-8
  Do not presume that the caller has checked the QR field
  Compare MAC:s in constant time
  Fix MAC size calculation to consistently use bytes
  Check supported algs list before asking crypto for size
  Fix decode of truncated messages to throw the approproate error code
  Rework decode_name to cap the decoded length according to RFC 1035

Author: RaimoNiskanen

lib/kernel/src/inet_dns.erl

@@ -173,6 +173,7 @@ decode_reply(Buffer, #dns_rec{} = Q, Mdns)
             {error, Reason}
     end.
 
+-define(MSG_HDR_SIZE, 12). % Must align with the following pattern
 do_decode(
   <<Id:16,
     QR:1,Opcode:4,AA:1,TC:1,RD:1,
@@ -196,14 +197,19 @@ do_decode(
            pr     = decode_boolean(PR),
            rcode  = Rcode},
     do_decode(
-      Buffer, DnsHdr, QdList, AnBuf, AnCount, NsCount, ArCount, {Opcode,Mdns}).
+      Buffer, DnsHdr, QdList, AnBuf, AnCount, NsCount, ArCount, {Opcode,Mdns});
+do_decode(<<_/binary>>, _Mdns) ->
+    throw(?DECODE_ERROR).
+
 
 do_decode_reply(
   <<Id:16, _/binary>> = Buffer,
   #dns_rec{ header = Q_H, qdlist = [Q_RR] },
   Mdns) ->
     Id =:= Q_H#dns_header.id orelse throw(badid),
-    do_decode_reply(Buffer, Q_H, Q_RR, Id, Mdns).
+    do_decode_reply(Buffer, Q_H, Q_RR, Id, Mdns);
+do_decode_reply(<<_/binary>>, _Q, _Mdns) ->
+    throw(?DECODE_ERROR).
 
 do_decode_reply(
   <<_:16,
@@ -223,27 +229,33 @@ do_decode_reply(
     %%
     QdCount == 1
         orelse throw(noquery),
-    {AnBuf, [RR], QdTC} = decode_query_section(QdBuf, QdCount, Buffer, Mdns),
-    RR#dns_query.class    =:= Q_RR#dns_query.class andalso
-        RR#dns_query.type =:= Q_RR#dns_query.type  andalso
-        inet_db:eq_domains(RR#dns_query.domain, Q_RR#dns_query.domain)
-        orelse throw(noquery),
-    H_TC = decode_boolean(TC),
-    QdTC andalso not H_TC
-        andalso throw(?DECODE_ERROR),
-    DnsHdr =
-        #dns_header{
-           id     = Id,
-           qr     = H_QR,
-           opcode = H_Opcode,
-           aa     = decode_boolean(AA),
-           tc     = H_TC,
-           rd     = H_RD,
-           ra     = decode_boolean(RA),
-           pr     = decode_boolean(PR),
-           rcode  = Rcode},
-    do_decode(
-      Buffer, DnsHdr, [RR], AnBuf, AnCount, NsCount, ArCount, {Opcode,Mdns});
+    {AnBuf, RRs, QdTC} = decode_query_section(QdBuf, QdCount, Buffer, Mdns),
+    case RRs of
+        [RR] ->
+            RR#dns_query.class    =:= Q_RR#dns_query.class andalso
+                RR#dns_query.type =:= Q_RR#dns_query.type  andalso
+                inet_db:eq_domains(RR#dns_query.domain, Q_RR#dns_query.domain)
+                orelse throw(noquery),
+            H_TC = decode_boolean(TC),
+            QdTC andalso not H_TC
+                andalso throw(?DECODE_ERROR),
+            DnsHdr =
+                #dns_header{
+                   id     = Id,
+                   qr     = H_QR,
+                   opcode = H_Opcode,
+                   aa     = decode_boolean(AA),
+                   tc     = H_TC,
+                   rd     = H_RD,
+                   ra     = decode_boolean(RA),
+                   pr     = decode_boolean(PR),
+                   rcode  = Rcode},
+            do_decode(
+              Buffer, DnsHdr, [RR], AnBuf, AnCount, NsCount, ArCount,
+              {Opcode,Mdns});
+        _ ->
+            throw(?DECODE_ERROR)
+    end;
 do_decode_reply(<<_/binary>>, _Q_H, _Q_RR, _Id, _Mdns) ->
     throw(unknown).
 
@@ -776,7 +788,11 @@ decode_characters(Data, Encoding) ->
     ?MATCH_ELSE_DECODE_ERROR(
        Data,
        <<Len,Bin:Len/binary,Rest/binary>>,
-       {Rest,unicode:characters_to_list(Bin, Encoding)}).
+       ?MATCH_ELSE_DECODE_ERROR(
+          unicode:characters_to_list(Bin, Encoding),
+          String,
+          is_list(String),
+          {Rest,String})).
 
 %% One domain name only, there must be nothing after
 %%
@@ -786,32 +802,55 @@ decode_domain(Bin, Buffer) ->
 %% Domain name -> {RestBin,Name}
 %%
 decode_name(Bin, Buffer) ->
-    decode_name(Bin, Buffer, [], Bin, 0).
-
-%% Tail advances with Rest until the first indirection is followed
-%% then it stays put at that Rest.
-decode_name(_, Buffer, _Labels, _Tail, Cnt) when Cnt > byte_size(Buffer) ->
-    throw(?DECODE_ERROR); %% Insanity bailout - this must be a decode loop
-decode_name(<<0,Rest/binary>>, _Buffer, Labels, Tail, Cnt) ->
-    %% Root domain, we have all labels for the domain name
-    {if Cnt =/= 0 -> Tail; true -> Rest end,
+    decode_name(Bin, Buffer, [], Bin, 0, 0).
+
+decode_name(_Bin, _Buffer, _Labels, _Cont, NameLen, _PtrCnt)
+  when NameLen >= 255 ->
+    %% There must also be room for the root label in 255 octets
+    %%
+    %% One might also cap PtrCnt heuristicly at 20..50 but there is no
+    %% support for that in RFC 1035, although almost certainly not a problem,
+    %% and not an uncommon defensive practice.
+    %%
+    %% Now it is possible to craft a message that will have long
+    %% backwards pointer chains causing high, but not catastrophically high,
+    %% decode work.
+    throw(?DECODE_ERROR);
+decode_name(<<0,Rest/binary>>, _Buffer, Labels, Cont, _NameLen, PtrCnt) ->
+    %% Root domain; we have all labels for the domain name
+    {decode_name_rest(Rest, Cont, PtrCnt),
      decode_name_labels(Labels)};
-decode_name(<<0:2,Len:6,Label:Len/binary,Rest/binary>>,
-	     Buffer, Labels, Tail, Cnt) ->
+decode_name(
+  <<0:2,Len:6,Label:Len/binary,Rest/binary>>,
+  Buffer, Labels, Cont, NameLen, PtrCnt) ->
     %% One plain label here
-    decode_name(Rest, Buffer, [Label|Labels],
-		if Cnt =/= 0 -> Tail; true -> Rest end,
-		Cnt);
-decode_name(<<3:2,Ptr:14,Rest/binary>>, Buffer, Labels, Tail, Cnt) ->
-    %% Indirection - reposition in buffer and recurse
+    decode_name(
+      Rest, Buffer, [Label|Labels], decode_name_rest(Rest, Cont, PtrCnt),
+      NameLen + 1 + Len, PtrCnt);
+decode_name(
+  <<3:2,Ptr:14,Rest/binary>>, Buffer, Labels, Cont, NameLen, PtrCnt)
+  when
+      %% Indirection *should* point to lower offset
+      %% (stricter than RFC1035, but commonly used common sense),
+      %% and *must* not point into the header.
+      %%
+      %% This forces a pointer loop to either end when clashing
+      %% into the header, or get content and end on max NameLen.
+      Ptr < byte_size(Buffer) - (byte_size(Rest) + 2),
+      Ptr >= ?MSG_HDR_SIZE ->
+    %% Indirection - reposition in buffer
     ?MATCH_ELSE_DECODE_ERROR(
        Buffer,
        <<_:Ptr/binary,Bin/binary>>,
        decode_name(
-         Bin, Buffer, Labels,
-         if Cnt =/= 0 -> Tail; true -> Rest end,
-         Cnt+2)); % size of indirection pointer
-decode_name(_, _, _, _, _) -> throw(?DECODE_ERROR).
+         Bin, Buffer, Labels, decode_name_rest(Rest, Cont, PtrCnt),
+         NameLen, PtrCnt + 1));
+decode_name(_Bin, _Buffer, _Labels, _Cont, _NameLen, _PtrCnt) ->
+    throw(?DECODE_ERROR).
+
+decode_name_rest(Rest, _Cont, 0)        -> Rest;
+decode_name_rest(_Rest, Cont, _PtrCnt)  -> Cont.
+
 
 %% Reverse list of labels (binaries) -> domain name (string)
 decode_name_labels([]) -> ".";
@@ -940,11 +979,15 @@ encode_data(Comp, Pos, ?S_NAPTR, Data) ->
     B0 = <<Order:16,Preference:16>>,
     B1 = encode_string(B0, iolist_to_binary(Flags)),
     B2 = encode_string(B1, iolist_to_binary(Services)),
-    B3 = encode_string(B2, unicode:characters_to_binary(Regexp,
-							unicode, utf8)),
-    %% Bypass name compression (RFC 2915: section 2)
-    {B,_} = encode_name(B3, gb_trees:empty(), Pos+byte_size(B3), Replacement),
-    {B,Comp};
+    case unicode:characters_to_binary(Regexp, unicode, utf8) of
+        EncRegexp when is_binary(EncRegexp) ->
+            B3 = encode_string(B2, EncRegexp),
+            %% Bypass name compression (RFC 2915: section 2)
+            {B,_} =
+                encode_name(
+                  B3, gb_trees:empty(), Pos+byte_size(B3), Replacement),
+            {B,Comp}
+    end;
 encode_data(Comp, _, ?S_TXT, Data) -> {encode_txt(Data),Comp};
 encode_data(Comp, _, ?S_SPF, Data) -> {encode_txt(Data),Comp};
 encode_data(Comp, _, ?S_URI, Data) ->

lib/kernel/src/inet_dns_tsig.erl

@@ -169,7 +169,7 @@ do_verify(Pkt,
                          header = #dns_header{ qr = QR },
                          arlist = ARList },
           TS0 = #tsig_state{ id = undefined }) ->
-    QR = false, % ASSERT that the caller has not passed a response
+    QR =:= false orelse throw(formerr),
     case ARList =/= [] andalso lists:last(ARList) of
         false ->
             {error,{notauth,badsig}};
@@ -179,14 +179,28 @@ do_verify(Pkt,
            original_id = OriginalId,
            error = ?NOERROR
           } = TSigRR ->
-            {Alg,AlgSize} =
+            {Alg,AlgSize} = % AlgSize in bytes
                 case inet_dns:decode_algname(AlgName) of
-                    {A,S} ->
-                        {A,S};
-                    A ->
-                        {A,maps:get(size, crypto:hash_info(A))}
+                    {A,S} when is_atom(A), is_integer(S), S >= 96 ->
+                        %% {sha,96} is the smallest we know of, 96 bits
+                        lists:member(A, ?ALGS_SUPPORTED)
+                            orelse throw({notauth,badkey}),
+                        {A,S bsr 3}; % Bits -> Bytes
+                    A when is_atom(A) ->
+                        lists:member(A, ?ALGS_SUPPORTED)
+                            orelse throw({notauth,badkey}),
+                        try crypto:hash_info(A) of
+                            #{ size := S } when is_integer(S), S >= 12 ->
+                                %% sha(96) => 12 bytes
+                                {A,S};
+                            #{} ->
+                                throw({notauth,badkey})
+                        catch error : badarg ->
+                                throw({notauth,badkey})
+                        end;
+                    _ ->
+                        throw({notauth,badkey})
                 end,
-            lists:member(Alg, ?ALGS_SUPPORTED) orelse throw({notauth,badkey}),
             Key = lists:keyfind(Name, 1, TS0#tsig_state.key),
             Key == false andalso throw({notauth,badkey}),
             TS = TS0#tsig_state{
@@ -213,8 +227,10 @@ do_verify(Pkt,
           Response = #dns_rec{
                         header = #dns_header{ qr = QR },
                         arlist = ARList },
-          TS = #tsig_state{ qr = TSQR })
-  when QR =:= (TSQR > 0) -> % Query/response status the same in header and state
+          TS = #tsig_state{ qr = TSQR }) ->
+    %% Query/response status the same in header and state
+    QR =:= (TSQR > 0) orelse throw(formerr),
+    %%
     case ARList =/= [] andalso lists:last(ARList) of
         %% RFC8945, section 5.3.1: TSIG on TCP Connections
         false when TSQR == 3 -> % not 2 as we must start with a TSIG RR
@@ -257,28 +273,32 @@ do_verify(Pkt, _Response, TS = #tsig_state{ alg = {_Alg,AlgSize} }, TSigRR) ->
                 andalso
                MACSize =< AlgSize,
     MACValid orelse throw(formerr),
-    PktS = iolist_to_binary([
-        <<(TS#tsig_state.id):16>>,
-        binary:part(Pkt, {2,8}),
-        begin
-            <<ARC:16>> = binary:part(Pkt, {10,2}),
-            <<(ARC - 1):16>>
+    MACCalc =
+        if
+            element(1, TS#tsig_state.mac) == ?MODULE ->
+                PktS =
+                    iolist_to_binary(
+                      [binary_part(Pkt, 0, 10),
+                       begin
+                           <<ARC:16>> = binary_part(Pkt, 10, 2),
+                           <<(ARC - 1):16>>
+                       end,
+                       binary_part(Pkt, 12, Offset-12)]),
+                mac(PktS, TS, Error, NowSigned, OtherData);
+            %% RFC8945, section 5.3.1: TSIG on TCP Connections
+            true ->
+                mac(TS, Error, NowSigned, OtherData)
         end,
-        binary:part(Pkt, {12,Offset - 12})
-    ]),
-    MACCalc = if
-        element(1, TS#tsig_state.mac) == ?MODULE ->
-            mac(PktS, TS, Error, NowSigned, OtherData);
-        %% RFC8945, section 5.3.1: TSIG on TCP Connections
-        true ->
-            mac(TS, Error, NowSigned, OtherData)
-    end,
+    MACEq =
+        MACSize == byte_size(MACCalc)
+        andalso
+        crypto:hash_equals(MAC, MACCalc),
     if
         %% RFC8945, section 5.2 - MUST check time after MAC
-        MAC == MACCalc, NowSigned - Fudge < Now, NowSigned + Fudge > Now ->
+        MACEq, NowSigned - Fudge < Now, NowSigned + Fudge > Now ->
             QR = if TS#tsig_state.qr == 0 -> 1; true -> 2 end,
             {ok,TS#tsig_state{ qr = QR, mac = {?MODULE,MAC} }};
-        MAC == MACCalc ->
+        MACEq ->
             {error,{notauth,badtime}};
         true ->
             {error,{notauth,badsig}}
@@ -313,7 +333,7 @@ macN({?MODULE,MAC}, #tsig_state{ mac = {crypto,MACState} }) ->
 macN(Pkt, TS = #tsig_state{ mac = {crypto,MACState} }) ->
     {crypto,crypto:mac_update(MACState, [
        <<(TS#tsig_state.id):16>>,
-       binary:part(Pkt, {2,byte_size(Pkt) - 2})
+       binary_part(Pkt, 2, byte_size(Pkt)-2)
     ])}.
 
 %% RFC8945, section 5.3.2: Generation of TSIG on Error Returns

lib/kernel/src/inet_res.erl

@@ -1456,8 +1456,10 @@ query_ns(S0, {Msg, Buffer}, IP, Port, Timer, Retry, I,
                               query_tcp(
                                 TcpTimeout, Msg, Buffer, IP, Port, Verbose)};
 			{error, econnrefused} = Err ->
-                            ok = udp_close(S),
-	                    {#sock{}, Err};
+                             ok = udp_close(S),
+                             {if  S =:= undefined -> S;
+                                  true            -> #sock{}
+                              end, Err};
 			Reply -> {S, Reply}
 		     end;
 		Error ->