The R13B03 release.OTP_R13B03

1 files changed, 701 insertions, 0 deletions

diff --git a/lib/kernel/src/inet_dns.erl b/lib/kernel/src/inet_dns.erl
new file mode 100644
index 0000000000..669a361c9d
--- /dev/null
+++ b/lib/kernel/src/inet_dns.erl
@@ -0,0 +1,701 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 1997-2009. 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(inet_dns).
+
+%% Dns record encode/decode
+%%
+%% RFC 1035: Domain Names - Implementation and Specification
+%% RFC 2181: Clarifications to the DNS Specification
+%% RFC 2671: Extension Mechanisms for DNS (EDNS0)
+%% RFC 2782: A DNS RR for specifying the location of services (DNS SRV)
+%% RFC 2915: The Naming Authority Pointer (NAPTR) DNS Resource Rec
+
+-export([decode/1, encode/1]).
+
+-import(lists, [reverse/1, reverse/2, nthtail/2]).
+
+-include("inet_int.hrl").
+-include("inet_dns.hrl").
+
+-export([record_type/1, rr/1, rr/2]).
+-export([make_rr/0, make_rr/1, make_rr/2, make_rr/3]).
+%% ADTs exports. The make_* functions are undocumented.
+-export([msg/1, msg/2,
+	 make_msg/0, make_msg/1, make_msg/2, make_msg/3]).
+-export([header/1, header/2,
+	 make_header/0, make_header/1, make_header/2, make_header/3]).
+-export([dns_query/1, dns_query/2,
+	 make_dns_query/0, make_dns_query/1,
+	 make_dns_query/2, make_dns_query/3]).
+-include("inet_dns_record_adts.hrl").
+
+%% Function merge of #dns_rr{} and #dns_rr_opt{}
+%%
+
+record_type(#dns_rr{}) -> rr;
+record_type(#dns_rr_opt{}) -> rr;
+record_type(Rec) ->
+    record_adts(Rec).
+
+rr(#dns_rr{}=RR) -> dns_rr(RR);
+rr(#dns_rr_opt{}=RR) -> dns_rr_opt(RR).
+
+rr(#dns_rr{}=RR, L) -> dns_rr(RR, L);
+rr(#dns_rr_opt{}=RR, L) -> dns_rr_opt(RR, L).
+
+make_rr() -> make_dns_rr().
+
+make_rr(L) when is_list(L) ->
+    case rr_type(L, any) of
+	opt -> make_dns_rr_opt(L);
+	_ -> make_dns_rr(L)
+    end.
+
+make_rr(type, opt) -> make_dns_rr_opt();
+make_rr(F, V) when is_atom(F) -> make_dns_rr(F, V);
+make_rr(#dns_rr{}=RR, L) when is_list(L) ->
+    case rr_type(L, RR#dns_rr.type) of
+	opt ->
+	    Ts = common_fields__rr__rr_opt(),
+	    make_dns_rr_opt([Opt || {T,_}=Opt <- dns_rr(RR),
+				    lists_member(T, Ts)] ++ L);
+	_ -> make_dns_rr(RR, L)
+    end;
+make_rr(#dns_rr_opt{}=RR, L) when is_list(L) ->
+    case rr_type(L, RR#dns_rr_opt.type) of
+	opt ->
+	     make_dns_rr_opt(RR, L);
+	_ ->
+	    Ts = common_fields__rr__rr_opt(),
+	    make_dns_rr([Opt || {T,_}=Opt <- dns_rr_opt(RR),
+				lists_member(T, Ts)] ++ L)
+    end.
+
+make_rr(#dns_rr{}=RR, type, opt) -> make_rr(RR, [{type,opt}]);
+make_rr(#dns_rr{}=RR, F, V) -> make_dns_rr(RR, F, V);
+make_rr(#dns_rr_opt{}=RR, type, opt) -> RR;
+make_rr(#dns_rr_opt{}=RR, type, T) -> make_rr(RR, [{type,T}]);
+make_rr(#dns_rr_opt{}=RR, F, V) -> make_dns_rr_opt(RR, F, V).
+
+-compile({inline, [rr_type/2]}).
+rr_type([], T) -> T;
+rr_type([{type,T}|Opts], _) -> rr_type(Opts, T);
+rr_type([_|Opts], T) -> rr_type(Opts, T).
+
+common_fields__rr__rr_opt() ->
+    [T || T <- record_info(fields, dns_rr_opt),
+	  lists_member(T, record_info(fields, dns_rr))].
+
+-compile({inline, [lists_member/2]}).
+lists_member(_, []) -> false;
+lists_member(H, [H|_]) -> true;
+lists_member(H, [_|T]) -> lists_member(H, T).
+
+
+
+-define(DECODE_ERROR, fmt). % must match a clause in inet_res:query_nss_e?dns
+
+%%
+%% Decode a dns buffer.
+%%
+
+decode(Buffer) when is_binary(Buffer) ->
+    try do_decode(Buffer) of
+	DnsRec ->
+	    {ok,DnsRec}
+    catch
+	Reason ->
+	    {error,Reason}
+    end.
+
+do_decode(<<Id:16,
+	   QR:1,Opcode:4,AA:1,TC:1,RD:1,
+	   RA:1,PR:1,_:2,Rcode:4,
+	   QdCount:16,AnCount:16,NsCount:16,ArCount:16,
+	   QdBuf/binary>>=Buffer) ->
+    {AnBuf,QdList} = decode_query_section(QdBuf,QdCount,Buffer),
+    {NsBuf,AnList} = decode_rr_section(AnBuf,AnCount,Buffer),
+    {ArBuf,NsList} = decode_rr_section(NsBuf,NsCount,Buffer),
+    {Rest,ArList} = decode_rr_section(ArBuf,ArCount,Buffer),
+	case Rest of
+	    <<>> ->
+		DnsHdr =
+		    #dns_header{id=Id,
+				qr=decode_boolean(QR),
+				opcode=decode_opcode(Opcode),
+				aa=decode_boolean(AA),
+				tc=decode_boolean(TC),
+				rd=decode_boolean(RD),
+				ra=decode_boolean(RA),
+				pr=decode_boolean(PR),
+				rcode=Rcode},
+		#dns_rec{header=DnsHdr,
+			 qdlist=QdList,
+			 anlist=AnList,
+			 nslist=NsList,
+			 arlist=ArList};
+	    _ ->
+		%% Garbage data after DNS message
+		throw(?DECODE_ERROR)
+	end;
+do_decode(_) ->
+    %% DNS message does not even match header
+    throw(?DECODE_ERROR).
+
+decode_query_section(Bin, N, Buffer) ->
+    decode_query_section(Bin, N, Buffer, []).
+
+decode_query_section(Rest, 0, _Buffer, Qs) ->
+    {Rest,reverse(Qs)};
+decode_query_section(Bin, N, Buffer, Qs) ->
+    case decode_name(Bin, Buffer) of
+	{<<Type:16,Class:16,Rest/binary>>,Name} ->
+	    DnsQuery =
+		#dns_query{domain=Name,
+			   type=decode_type(Type),
+			   class=decode_class(Class)},
+	    decode_query_section(Rest, N-1, Buffer, [DnsQuery|Qs]);
+	_ ->
+	    %% Broken question
+	    throw(?DECODE_ERROR)
+    end.
+
+decode_rr_section(Bin, N, Buffer) ->
+    decode_rr_section(Bin, N, Buffer, []).
+
+decode_rr_section(Rest, 0, _Buffer, RRs) ->
+    {Rest,reverse(RRs)};
+decode_rr_section(Bin, N, Buffer, RRs) ->
+    case decode_name(Bin, Buffer) of
+	{<<T:16/unsigned,C:16/unsigned,TTL:4/binary,
+	  Len:16,D:Len/binary,Rest/binary>>,
+	 Name} ->
+	    Type = decode_type(T),
+	    Class = decode_class(C),
+	    Data = decode_data(D, Class, Type, Buffer),
+	    RR =
+		case Type of
+		    opt ->
+			<<ExtRcode,Version,Z:16>> = TTL,
+			#dns_rr_opt{domain=Name,
+				    type=Type,
+				    udp_payload_size=C,
+				    ext_rcode=ExtRcode,
+				    version=Version,
+				    z=Z,
+				    data=Data};
+		    _ ->
+			<<TimeToLive:32/signed>> = TTL,
+			#dns_rr{domain=Name,
+				type=Type,
+				class=Class,
+				ttl=if TimeToLive < 0 -> 0;
+				       true -> TimeToLive end,
+				data=Data}
+		end,
+	    decode_rr_section(Rest, N-1, Buffer, [RR|RRs]);
+	_ ->
+	    %% Broken RR
+	    throw(?DECODE_ERROR)
+    end.
+
+%%
+%% Encode a user query
+%%
+
+encode(Q) ->
+    QdCount = length(Q#dns_rec.qdlist),
+    AnCount = length(Q#dns_rec.anlist),
+    NsCount = length(Q#dns_rec.nslist),
+    ArCount = length(Q#dns_rec.arlist),
+    B0 = encode_header(Q#dns_rec.header, QdCount, AnCount, NsCount, ArCount),
+    C0 = gb_trees:empty(),
+    {B1,C1} = encode_query_section(B0, C0, Q#dns_rec.qdlist),
+    {B2,C2} = encode_res_section(B1, C1, Q#dns_rec.anlist),
+    {B3,C3} = encode_res_section(B2, C2, Q#dns_rec.nslist),
+    {B,_} = encode_res_section(B3, C3, Q#dns_rec.arlist),
+    B.
+
+
+%% RFC 1035: 4.1.1. Header section format
+%%
+encode_header(#dns_header{id=Id}=H, QdCount, AnCount, NsCount, ArCount) ->
+    QR = encode_boolean(H#dns_header.qr),
+    Opcode = encode_opcode(H#dns_header.opcode),
+    AA = encode_boolean(H#dns_header.aa),
+    TC = encode_boolean(H#dns_header.tc),
+    RD = encode_boolean(H#dns_header.rd),
+    RA = encode_boolean(H#dns_header.ra),
+    PR = encode_boolean(H#dns_header.pr),
+    Rcode = H#dns_header.rcode,
+    <<Id:16,
+     QR:1,Opcode:4,AA:1,TC:1,RD:1,
+     RA:1,PR:1,0:2,Rcode:4,
+     QdCount:16,AnCount:16,NsCount:16,ArCount:16>>.
+
+%% RFC 1035: 4.1.2. Question section format
+%%
+encode_query_section(Bin, Comp, []) -> {Bin,Comp};
+encode_query_section(Bin0, Comp0, [#dns_query{domain=DName}=Q | Qs]) ->
+    Type = encode_type(Q#dns_query.type),
+    Class = encode_class(Q#dns_query.class),
+    {Bin,Comp} = encode_name(Bin0, Comp0, byte_size(Bin0), DName),
+    encode_query_section(<<Bin/binary,Type:16,Class:16>>, Comp, Qs).
+
+%% RFC 1035: 4.1.3. Resource record format
+%% RFC 2671: 4.3, 4.4, 4.6 OPT RR format
+%%
+encode_res_section(Bin, Comp, []) -> {Bin,Comp};
+encode_res_section(Bin, Comp, [#dns_rr {domain = DName,
+					type = Type,
+					class = Class,
+					ttl = TTL,
+					data = Data} | Rs]) ->
+    encode_res_section_rr(Bin, Comp, Rs,
+			  DName, Type, Class, <<TTL:32/signed>>, Data);
+encode_res_section(Bin, Comp, [#dns_rr_opt {domain = DName,
+					    udp_payload_size = UdpPayloadSize,
+					    ext_rcode = ExtRCode,
+					    version = Version,
+					    z = Z,
+					    data = Data} | Rs]) ->
+    encode_res_section_rr(Bin, Comp, Rs,
+			  DName, ?S_OPT, UdpPayloadSize,
+			  <<ExtRCode,Version,Z:16>>, Data).
+
+encode_res_section_rr(Bin0, Comp0, Rs, DName, Type, Class, TTL, Data) ->
+    T = encode_type(Type),
+    C = encode_class(Class),
+    {Bin,Comp1} = encode_name(Bin0, Comp0, byte_size(Bin0), DName),
+    {DataBin,Comp} = encode_data(Comp1, byte_size(Bin)+2+2+byte_size(TTL)+2,
+				 Type, Class, Data),
+    DataSize = byte_size(DataBin),
+    encode_res_section(<<Bin/binary,T:16,C:16,
+			TTL/binary,DataSize:16,DataBin/binary>>, Comp, Rs).
+
+%%
+%% Resource types
+%%
+decode_type(Type) ->
+    case Type of
+	?T_A -> ?S_A;
+	?T_NS -> ?S_NS;
+	?T_MD -> ?S_MD;
+	?T_MF -> ?S_MF;
+	?T_CNAME -> ?S_CNAME;
+	?T_SOA -> ?S_SOA;
+	?T_MB  -> ?S_MB;
+	?T_MG  -> ?S_MG;
+	?T_MR  -> ?S_MR;
+	?T_NULL -> ?S_NULL;
+	?T_WKS  -> ?S_WKS;
+	?T_PTR  -> ?S_PTR;
+	?T_HINFO -> ?S_HINFO;
+	?T_MINFO -> ?S_MINFO;
+	?T_MX -> ?S_MX;
+	?T_TXT -> ?S_TXT;
+	?T_AAAA -> ?S_AAAA;
+	?T_SRV -> ?S_SRV;
+	?T_NAPTR -> ?S_NAPTR;
+	?T_OPT -> ?S_OPT;
+	?T_SPF -> ?S_SPF;
+	%% non standard
+	?T_UINFO -> ?S_UINFO;
+	?T_UID -> ?S_UID;
+	?T_GID -> ?S_GID;
+	?T_UNSPEC -> ?S_UNSPEC;
+	%% Query type values which do not appear in resource records
+	?T_AXFR -> ?S_AXFR;
+	?T_MAILB -> ?S_MAILB;
+	?T_MAILA -> ?S_MAILA;
+	?T_ANY  -> ?S_ANY;
+	_ -> Type    %% raw unknown type
+    end.
+
+%%
+%% Resource types
+%%
+encode_type(Type) ->
+    case Type of
+	?S_A -> ?T_A;
+	?S_NS -> ?T_NS;
+	?S_MD -> ?T_MD;
+	?S_MF -> ?T_MF;
+	?S_CNAME -> ?T_CNAME;
+	?S_SOA -> ?T_SOA;
+	?S_MB -> ?T_MB;
+	?S_MG -> ?T_MG;
+	?S_MR -> ?T_MR;
+	?S_NULL -> ?T_NULL;
+	?S_WKS -> ?T_WKS;
+	?S_PTR -> ?T_PTR;
+	?S_HINFO -> ?T_HINFO;
+	?S_MINFO -> ?T_MINFO;
+	?S_MX -> ?T_MX;
+	?S_TXT -> ?T_TXT;
+	?S_AAAA -> ?T_AAAA;
+	?S_SRV -> ?T_SRV;
+	?S_NAPTR -> ?T_NAPTR;
+	?S_OPT -> ?T_OPT;
+	?S_SPF -> ?T_SPF;
+	%% non standard
+	?S_UINFO -> ?T_UINFO;
+	?S_UID -> ?T_UID;
+	?S_GID -> ?T_GID;
+	?S_UNSPEC -> ?T_UNSPEC;
+	%% Query type values which do not appear in resource records
+	?S_AXFR -> ?T_AXFR;
+	?S_MAILB -> ?T_MAILB;
+	?S_MAILA -> ?T_MAILA;
+	?S_ANY -> ?T_ANY;
+	Type when is_integer(Type) -> Type    %% raw unknown type
+    end.
+
+%%
+%% Resource clases
+%%
+
+decode_class(Class) ->
+    case Class of
+	?C_IN -> in;
+	?C_CHAOS ->  chaos;
+	?C_HS -> hs;
+	?C_ANY -> any;
+	_ -> Class    %% raw unknown class
+    end.
+
+encode_class(Class) ->
+    case Class of
+	in -> ?C_IN;
+	chaos -> ?C_CHAOS;
+	hs -> ?C_HS;
+	any -> ?C_ANY;
+	Class when is_integer(Class) -> Class    %% raw unknown class
+    end.
+
+decode_opcode(Opcode) ->
+    case Opcode of
+	?QUERY -> 'query';
+	?IQUERY -> iquery;
+	?STATUS -> status;
+	_ when is_integer(Opcode) -> Opcode %% non-standard opcode
+    end.
+
+encode_opcode(Opcode) ->
+    case Opcode of
+	'query' -> ?QUERY;
+	iquery -> ?IQUERY;
+	status -> ?STATUS;
+	_ when is_integer(Opcode) -> Opcode %% non-standard opcode
+    end.
+	    
+
+encode_boolean(true) -> 1;
+encode_boolean(false) -> 0;
+encode_boolean(B) when is_integer(B) -> B.
+
+decode_boolean(0) -> false;
+decode_boolean(I) when is_integer(I) -> true.
+
+%%
+%% Data field -> term() content representation
+%%
+decode_data(<<A,B,C,D>>, in, ?S_A,  _)   -> {A,B,C,D};
+decode_data(<<A:16,B:16,C:16,D:16,E:16,F:16,G:16,H:16>>, in, ?S_AAAA, _) ->
+    {A,B,C,D,E,F,G,H};
+decode_data(Dom, _, ?S_NS, Buffer)    -> decode_domain(Dom, Buffer);
+decode_data(Dom, _, ?S_MD, Buffer)    -> decode_domain(Dom, Buffer); 
+decode_data(Dom, _, ?S_MF, Buffer)    -> decode_domain(Dom, Buffer); 
+decode_data(Dom, _, ?S_CNAME, Buffer) -> decode_domain(Dom, Buffer);
+decode_data(Data0, _, ?S_SOA, Buffer) ->
+    {Data1,MName} = decode_name(Data0, Buffer),
+    {Data,RName} = decode_name(Data1, Buffer),
+    case Data of
+	<<Serial:32,Refresh:32/signed,Retry:32/signed,
+	 Expiry:32/signed,Minimum:32>> ->
+	    {MName,RName,Serial,Refresh,Retry,Expiry,Minimum};
+	_ ->
+	    %% Broken SOA RR data
+	    throw(?DECODE_ERROR)
+    end;
+decode_data(Dom, _, ?S_MB, Buffer)    -> decode_domain(Dom, Buffer); 
+decode_data(Dom, _, ?S_MG, Buffer)    -> decode_domain(Dom, Buffer); 
+decode_data(Dom, _, ?S_MR, Buffer)    -> decode_domain(Dom, Buffer); 
+decode_data(Data, _, ?S_NULL, _) -> Data;
+decode_data(<<A,B,C,D,Proto,BitMap/binary>>, in, ?S_WKS, _Buffer) -> 
+    {{A,B,C,D},Proto,BitMap};
+decode_data(Dom, _, ?S_PTR, Buffer)   -> decode_domain(Dom, Buffer);
+decode_data(<<CpuLen,CPU:CpuLen/binary,
+	     OsLen,OS:OsLen/binary>>, _, ?S_HINFO, _) ->
+    {binary_to_list(CPU),binary_to_list(OS)};
+decode_data(Data0, _, ?S_MINFO, Buffer) ->
+    {Data1,RM} = decode_name(Data0, Buffer),
+    {Data,EM} = decode_name(Data1, Buffer),
+    case Data of
+	<<>> -> {RM,EM};
+	_ ->
+	    %% Broken MINFO data
+	    throw(?DECODE_ERROR)
+    end;
+decode_data(<<Prio:16,Dom/binary>>, _, ?S_MX, Buffer) ->
+    {Prio,decode_domain(Dom, Buffer)};
+decode_data(<<Prio:16,Weight:16,Port:16,Dom/binary>>, _, ?S_SRV, Buffer) ->
+    {Prio,Weight,Port,decode_domain(Dom, Buffer)};
+decode_data(<<Order:16,Preference:16,Data0/binary>>, _, ?S_NAPTR, Buffer) ->
+    {Data1,Flags} = decode_string(Data0),
+    {Data2,Services} = decode_string(Data1),
+    {Data,Regexp} = decode_characters(Data2, utf8),
+    Replacement = decode_domain(Data, Buffer),
+    {Order,Preference,string:to_lower(Flags),string:to_lower(Services),
+     Regexp,Replacement};
+%% ?S_OPT falls through to default
+decode_data(Data, _, ?S_TXT, _) ->
+    decode_txt(Data);
+decode_data(Data, _, ?S_SPF, _) ->
+    decode_txt(Data);
+%% sofar unknown or non standard
+decode_data(Data, _, _, _) ->
+    Data.
+
+%% Array of strings
+%%
+decode_txt(<<>>) -> [];
+decode_txt(Bin) ->
+    {Rest,String} = decode_string(Bin),
+    [String|decode_txt(Rest)].
+
+decode_string(<<Len,Bin:Len/binary,Rest/binary>>) ->
+    {Rest,binary_to_list(Bin)};
+decode_string(_) ->
+    %% Broken string
+    throw(?DECODE_ERROR).
+
+decode_characters(<<Len,Bin:Len/binary,Rest/binary>>, Encoding) ->
+    {Rest,unicode:characters_to_list(Bin, Encoding)};
+decode_characters(_, _) ->
+    %% Broken encoded string
+    throw(?DECODE_ERROR).
+
+%% One domain name only, there must be nothing after
+%%
+decode_domain(Bin, Buffer) ->
+    case decode_name(Bin, Buffer) of
+	{<<>>,Name} -> Name;
+	_ ->
+	    %% Garbage after domain name
+	    throw(?DECODE_ERROR)
+    end.
+
+%% 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); %% Insantiy 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_labels(Labels)};
+decode_name(<<0:2,Len:6,Label:Len/binary,Rest/binary>>,
+	     Buffer, Labels, Tail, Cnt) ->
+    %% 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
+    case Buffer of
+	<<_:Ptr/binary,Bin/binary>> ->
+	    decode_name(Bin, Buffer, Labels,
+			if Cnt =/= 0 -> Tail; true -> Rest end,
+			Cnt+2); % size of indirection pointer
+	_ ->
+	    %% Indirection pointer outside buffer
+	    throw(?DECODE_ERROR)
+    end;
+decode_name(_, _, _, _, _) -> throw(?DECODE_ERROR).
+
+%% Reverse list of labels (binaries) -> domain name (string)
+decode_name_labels([]) -> ".";
+decode_name_labels(Labels) ->
+    decode_name_labels(Labels, "").
+
+decode_name_labels([Label], Name) ->
+    decode_name_label(Label, Name);
+decode_name_labels([Label|Labels], Name) ->
+    decode_name_labels(Labels, "."++decode_name_label(Label, Name)).
+
+decode_name_label(<<>>, _Name) ->
+    %% Empty label is only allowed for the root domain, 
+    %% and that is handled above.
+    throw(?DECODE_ERROR);
+decode_name_label(Label, Name) ->
+    decode_name_label(Label, Name, byte_size(Label)).
+
+%% Decode $. and $\\ to become $\\ escaped characters
+%% in the string representation.
+-compile({inline, [decode_name_label/3]}).
+decode_name_label(_, Name, 0) -> Name;
+decode_name_label(Label, Name, N) ->
+    M = N-1,
+    case Label of
+	<<_:M/binary,($\\),_/binary>> ->
+	    decode_name_label(Label, "\\\\"++Name, M);
+	<<_:M/binary,($.),_/binary>> ->
+	    decode_name_label(Label, "\\."++Name, M);
+	<<_:M/binary,C,_/binary>> ->
+	    decode_name_label(Label, [C|Name], M);
+	_ ->
+	    %% This should not happen but makes surrounding
+	    %% programming errors easier to locate.
+	    erlang:error(badarg, [Label,Name,N])
+    end.
+
+%%
+%% Data field -> {binary(),NewCompressionTable}
+%%
+encode_data(Comp, _, ?S_A, in, {A,B,C,D}) -> {<<A,B,C,D>>,Comp};
+encode_data(Comp, _, ?S_AAAA, in, {A,B,C,D,E,F,G,H}) ->
+    {<<A:16,B:16,C:16,D:16,E:16,F:16,G:16,H:16>>,Comp};
+encode_data(Comp, Pos, ?S_NS, in, Domain) -> encode_name(Comp, Pos, Domain);
+encode_data(Comp, Pos, ?S_MD, in, Domain) -> encode_name(Comp, Pos, Domain);
+encode_data(Comp, Pos, ?S_MF, in, Domain) -> encode_name(Comp, Pos, Domain);
+encode_data(Comp, Pos, ?S_CNAME, in, Domain) -> encode_name(Comp, Pos, Domain);
+encode_data(Comp0, Pos, ?S_SOA, in,
+	    {MName,RName,Serial,Refresh,Retry,Expiry,Minimum}) ->
+    {B1,Comp1} = encode_name(Comp0, Pos, MName),
+    {B,Comp} = encode_name(B1, Comp1, Pos+byte_size(B1), RName),
+    {<<B/binary,Serial:32,Refresh:32/signed,Retry:32/signed,
+      Expiry:32/signed,Minimum:32>>,
+     Comp};
+encode_data(Comp, Pos, ?S_MB, in, Domain) -> encode_name(Comp, Pos, Domain);
+encode_data(Comp, Pos, ?S_MG, in, Domain) -> encode_name(Comp, Pos, Domain);
+encode_data(Comp, Pos, ?S_MR, in, Domain) -> encode_name(Comp, Pos, Domain);
+encode_data(Comp, _, ?S_NULL, in, Data) ->
+    {iolist_to_binary(Data),Comp};
+encode_data(Comp, _, ?S_WKS, in, {{A,B,C,D},Proto,BitMap}) ->
+    BitMapBin = iolist_to_binary(BitMap),
+    {<<A,B,C,D,Proto,BitMapBin/binary>>,Comp};
+encode_data(Comp, Pos, ?S_PTR, in, Domain) -> encode_name(Comp, Pos, Domain);
+encode_data(Comp, _, ?S_HINFO, in, {CPU,OS}) ->
+    Bin = encode_string(iolist_to_binary(CPU)),
+    {encode_string(Bin, iolist_to_binary(OS)),Comp};
+encode_data(Comp0, Pos, ?S_MINFO, in, {RM,EM}) ->
+    {Bin,Comp} = encode_name(Comp0, Pos, RM),
+    encode_name(Bin, Comp, Pos+byte_size(Bin), EM);
+encode_data(Comp, Pos, ?S_MX, in, {Pref,Exch}) ->
+    encode_name(<<Pref:16>>, Comp, Pos+2, Exch);
+encode_data(Comp, Pos, ?S_SRV, in, {Prio,Weight,Port,Target}) ->
+    encode_name(<<Prio:16,Weight:16,Port:16>>, Comp, Pos+2+2+2, Target);
+encode_data(Comp, Pos, ?S_NAPTR, in, 
+	    {Order,Preference,Flags,Services,Regexp,Replacement}) ->
+    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};
+%% ?S_OPT falls through to default
+encode_data(Comp, _, ?S_TXT, in, Data) -> {encode_txt(Data),Comp};
+encode_data(Comp, _, ?S_SPF, in, Data) -> {encode_txt(Data),Comp};
+encode_data(Comp, _Pos, _Type, _Class, Data) -> {iolist_to_binary(Data),Comp}.
+
+%% Array of strings
+%%
+encode_txt(Strings) ->
+    encode_txt(<<>>, Strings).
+%%
+encode_txt(Bin, []) -> Bin;
+encode_txt(Bin, [S|Ss]) ->
+    encode_txt(encode_string(Bin, iolist_to_binary(S)), Ss).
+
+%% Singular string
+%%
+encode_string(StringBin) ->
+    encode_string(<<>>, StringBin).
+%%
+encode_string(Bin, StringBin) ->
+    Size = byte_size(StringBin),
+    if Size =< 255 ->
+	    <<Bin/binary,Size,StringBin/binary>>
+    end.
+
+%% Domain name
+%%
+encode_name(Comp, Pos, Name) ->
+    encode_name(<<>>, Comp, Pos, Name).
+%%
+%% Bin = target binary
+%% Comp = compression lookup table; label list -> buffer position
+%% Pos = position in DNS message
+%% Name = domain name to encode
+%%
+%% The name compression does not make the case conversions
+%% it could. This means case will be preserved at the cost
+%% of missed compression opportunities. But if the encoded
+%% message use the same case for different instances of
+%% the same domain name there is no problem, and if not it is
+%% only compression that suffers. Furthermore encode+decode
+%% this way becomes an identity operation for any decoded
+%% DNS message which is nice for testing encode.
+%% 
+encode_name(Bin0, Comp0, Pos, Name) ->
+    case encode_labels(Bin0, Comp0, Pos, name2labels(Name)) of
+	{Bin,_}=Result when byte_size(Bin) - byte_size(Bin0) =< 255 -> Result;
+	_ ->
+	    %% Fail on too long name
+	    erlang:error(badarg, [Bin0,Comp0,Pos,Name])
+    end.
+
+name2labels("") -> [];
+name2labels(".") -> [];
+name2labels(Cs) -> name2labels(<<>>, Cs).
+%%
+-compile({inline, [name2labels/2]}).
+name2labels(Label, "") -> [Label];
+name2labels(Label, ".") -> [Label];
+name2labels(Label, "."++Cs) -> [Label|name2labels(<<>>, Cs)];
+name2labels(Label, "\\"++[C|Cs]) -> name2labels(<<Label/binary,C>>, Cs);
+name2labels(Label, [C|Cs]) -> name2labels(<<Label/binary,C>>, Cs).
+
+%% Fail on empty or too long labels.
+encode_labels(Bin, Comp, _Pos, []) ->
+    {<<Bin/binary,0>>,Comp};
+encode_labels(Bin, Comp0, Pos, [L|Ls]=Labels)
+  when 1 =< byte_size(L), byte_size(L) =< 63 ->
+    case gb_trees:lookup(Labels, Comp0) of
+	none ->
+	    Comp = if Pos < (3 bsl 14) ->
+			   %% Just in case - compression
+			   %% pointers can not reach further
+			   gb_trees:insert(Labels, Pos, Comp0);
+		      true -> Comp0
+		   end,
+	    Size = byte_size(L),
+	    encode_labels(<<Bin/binary,Size,L/binary>>,
+			  Comp, Pos+1+Size, Ls);
+	{value,Ptr} ->
+	    %% Name compression - point to already encoded name
+	    {<<Bin/binary,3:2,Ptr:14>>,Comp0}
+    end.