%%
%% %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,QdTC} = decode_query_section(QdBuf,QdCount,Buffer),
{NsBuf,AnList,AnTC} = decode_rr_section(AnBuf,AnCount,Buffer),
{ArBuf,NsList,NsTC} = decode_rr_section(NsBuf,NsCount,Buffer),
{Rest,ArList,ArTC} = decode_rr_section(ArBuf,ArCount,Buffer),
case Rest of
<<>> ->
HdrTC = decode_boolean(TC),
DnsHdr =
#dns_header{id=Id,
qr=decode_boolean(QR),
opcode=decode_opcode(Opcode),
aa=decode_boolean(AA),
tc=HdrTC,
rd=decode_boolean(RD),
ra=decode_boolean(RA),
pr=decode_boolean(PR),
rcode=Rcode},
case QdTC or AnTC or NsTC or ArTC of
true when not HdrTC ->
throw(?DECODE_ERROR);
_ ->
#dns_rec{header=DnsHdr,
qdlist=QdList,
anlist=AnList,
nslist=NsList,
arlist=ArList}
end;
_ ->
%% 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, N, _Buffer, Qs) ->
{Rest,reverse(Qs),N =/= 0};
decode_query_section(Rest, 0, _Buffer, Qs) ->
{Rest,reverse(Qs),false};
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, N, _Buffer, RRs) ->
{Rest,reverse(RRs),N =/= 0};
decode_rr_section(Rest, 0, _Buffer, RRs) ->
{Rest,reverse(RRs),false};
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.
