18bbf79351
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@45 7c85be65-684b-0410-a082-b2ed4fbef004
378 lines
11 KiB
ObjectPascal
378 lines
11 KiB
ObjectPascal
{==============================================================================|
|
|
| Project : Delphree - Synapse | 001.001.001 |
|
|
|==============================================================================|
|
|
| Content: DNS client |
|
|
|==============================================================================|
|
|
| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
|
|
| (the "License"); you may not use this file except in compliance with the |
|
|
| License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ |
|
|
| |
|
|
| 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. |
|
|
|==============================================================================|
|
|
| The Original Code is Synapse Delphi Library. |
|
|
|==============================================================================|
|
|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
|
|
| Portions created by Lukas Gebauer are Copyright (c)2000. |
|
|
| All Rights Reserved. |
|
|
|==============================================================================|
|
|
| Contributor(s): |
|
|
|==============================================================================|
|
|
| History: see HISTORY.HTM from distribution package |
|
|
| (Found at URL: http://www.ararat.cz/synapse/) |
|
|
|==============================================================================}
|
|
|
|
//RFC-1035, RFC-1183, RFC1706, RFC1712, RFC2163, RFC2230
|
|
|
|
unit DNSsend;
|
|
|
|
interface
|
|
uses
|
|
Blcksock, sysutils, classes, SynaUtil;
|
|
|
|
const
|
|
Qtype_A =1;
|
|
Qtype_NS =2;
|
|
Qtype_MD =3;
|
|
Qtype_MF =4;
|
|
Qtype_CNAME =5;
|
|
Qtype_SOA =6;
|
|
Qtype_MB =7;
|
|
Qtype_MG =8;
|
|
Qtype_MR =9;
|
|
Qtype_NULL =10;
|
|
Qtype_WKS =11; //
|
|
Qtype_PTR =12;
|
|
Qtype_HINFO =13;
|
|
Qtype_MINFO =14;
|
|
Qtype_MX =15;
|
|
Qtype_TXT =16;
|
|
|
|
Qtype_RP =17;
|
|
Qtype_AFSDB =18;
|
|
Qtype_X25 =19;
|
|
Qtype_ISDN =20;
|
|
Qtype_RT =21;
|
|
Qtype_NSAP =22;
|
|
Qtype_NSAPPTR=23;
|
|
Qtype_SIG =24; //RFC-2065
|
|
Qtype_KEY =25; //RFC-2065
|
|
Qtype_PX =26;
|
|
Qtype_GPOS =27;
|
|
Qtype_AAAA =28; //IP6 Address [Susan Thomson]
|
|
Qtype_LOC =29; //RFC-1876
|
|
Qtype_NXT =30; //RFC-2065
|
|
|
|
Qtype_SRV =33; //RFC-2052
|
|
Qtype_NAPTR =35; //RFC-2168
|
|
Qtype_KX =36;
|
|
|
|
Qtype_AXFR =252; //
|
|
Qtype_MAILB =253; //
|
|
Qtype_MAILA =254; //
|
|
Qtype_ALL =255; //
|
|
|
|
type
|
|
TDNSSend = class
|
|
private
|
|
Buffer:string;
|
|
Sock:TUDPBlockSocket;
|
|
function CompressName(Value:string):string;
|
|
function CodeHeader:string;
|
|
function CodeQuery(Name:string; Qtype:integer):string;
|
|
function DecodeLabels(var From:integer):string;
|
|
function DecodeResource(var i:integer; Name:string; Qtype:integer):string;
|
|
public
|
|
timeout:integer;
|
|
DNSHost:string;
|
|
RCode:integer;
|
|
Constructor Create;
|
|
Destructor Destroy; override;
|
|
Function DNSQuery(Name:string;Qtype:integer;Reply:TStrings):Boolean;
|
|
end;
|
|
|
|
function GetMailServers (DNSHost, domain:string; servers:TStringList):Boolean;
|
|
|
|
implementation
|
|
|
|
{TDNSSend.Create}
|
|
Constructor TDNSSend.Create;
|
|
begin
|
|
inherited Create;
|
|
sock:=TUDPBlockSocket.create;
|
|
sock.CreateSocket;
|
|
timeout:=5000;
|
|
DNShost:='localhost';
|
|
end;
|
|
|
|
{TDNSSend.Destroy}
|
|
Destructor TDNSSend.Destroy;
|
|
begin
|
|
Sock.free;
|
|
inherited destroy;
|
|
end;
|
|
|
|
{TDNSSend.ComressName}
|
|
function TDNSSend.CompressName(Value:string):string;
|
|
var
|
|
n:integer;
|
|
s:String;
|
|
begin
|
|
Result:='';
|
|
if Value='' then Result:=char(0)
|
|
else
|
|
begin
|
|
s:='';
|
|
for n:=1 to Length(Value) do
|
|
if Value[n]='.' then
|
|
begin
|
|
Result:=Result+char(Length(s))+s;
|
|
s:='';
|
|
end
|
|
else s:=s+Value[n];
|
|
if s<>'' then Result:=Result+char(Length(s))+s;
|
|
Result:=Result+char(0);
|
|
end;
|
|
end;
|
|
|
|
{TDNSSend.CodeHeader}
|
|
function TDNSSend.CodeHeader:string;
|
|
begin
|
|
Randomize;
|
|
Result:=Codeint(Random(32767)); //ID
|
|
Result:=Result+Codeint($0100); //flags
|
|
Result:=Result+Codeint(1); //QDCount
|
|
Result:=Result+Codeint(0); //ANCount
|
|
Result:=Result+Codeint(0); //NSCount
|
|
Result:=Result+Codeint(0); //ARCount
|
|
end;
|
|
|
|
{TDNSSend.CodeQuery}
|
|
function TDNSSend.CodeQuery(Name:string; Qtype:integer):string;
|
|
begin
|
|
Result:=Compressname(Name);
|
|
Result:=Result+Codeint(Qtype);
|
|
Result:=Result+Codeint(1); //Type INTERNET
|
|
end;
|
|
|
|
{TDNSSend.DecodeLabels}
|
|
function TDNSSend.DecodeLabels(var From:integer):string;
|
|
var
|
|
l,f:integer;
|
|
begin
|
|
Result:='';
|
|
while True do
|
|
begin
|
|
l:=Ord(Buffer[From]);
|
|
Inc(From);
|
|
if l=0 then break;
|
|
if Result<>'' then Result:=Result+'.';
|
|
if (l and $C0)=$C0
|
|
then
|
|
begin
|
|
f:=l and $3F;
|
|
f:=f*256+Ord(Buffer[From])+1;
|
|
Inc(From);
|
|
Result:=Result+Self.decodelabels(f);
|
|
break;
|
|
end
|
|
else
|
|
begin
|
|
Result:=Result+Copy(Buffer,From,l);
|
|
Inc(From,l);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{TDNSSend.DecodeResource}
|
|
function TDNSSend.DecodeResource(var i:integer; Name:string;
|
|
Qtype:integer):string;
|
|
var
|
|
Rname:string;
|
|
RType,Len,j,x,n:integer;
|
|
begin
|
|
Result:='';
|
|
Rname:=decodelabels(i);
|
|
Rtype:=DeCodeint(Buffer,i);
|
|
Inc(i,8);
|
|
Len:=DeCodeint(Buffer,i);
|
|
Inc(i,2); //i point to begin of data
|
|
j:=i;
|
|
i:=i+len; //i point to next record
|
|
if (Name=Rname) and (Qtype=RType) then
|
|
begin
|
|
case Rtype of
|
|
Qtype_A :
|
|
begin
|
|
Result:=IntToStr(Ord(Buffer[j]));
|
|
Inc(j);
|
|
Result:=Result+'.'+IntToStr(Ord(Buffer[j]));
|
|
Inc(j);
|
|
Result:=Result+'.'+IntToStr(Ord(Buffer[j]));
|
|
Inc(j);
|
|
Result:=Result+'.'+IntToStr(Ord(Buffer[j]));
|
|
end;
|
|
Qtype_NS,
|
|
Qtype_MD,
|
|
Qtype_MF,
|
|
Qtype_CNAME,
|
|
Qtype_MB,
|
|
Qtype_MG,
|
|
Qtype_MR,
|
|
Qtype_PTR,
|
|
Qtype_X25,
|
|
Qtype_NSAP,
|
|
Qtype_NSAPPTR:
|
|
begin
|
|
Result:=Decodelabels(j);
|
|
end;
|
|
Qtype_SOA :
|
|
begin
|
|
Result:=Decodelabels(j);
|
|
Result:=Result+','+Decodelabels(j);
|
|
for n:=1 to 5 do
|
|
begin
|
|
x:=DecodeInt(Buffer,j)*65536+DecodeInt(Buffer,j+2);
|
|
Inc(j,4);
|
|
Result:=Result+','+IntToStr(x);
|
|
end;
|
|
end;
|
|
Qtype_NULL :
|
|
begin
|
|
end;
|
|
Qtype_WKS :
|
|
begin
|
|
end;
|
|
Qtype_HINFO,
|
|
Qtype_MINFO,
|
|
Qtype_RP,
|
|
Qtype_ISDN :
|
|
begin
|
|
Result:=Decodelabels(j);
|
|
Result:=Result+','+Decodelabels(j);
|
|
end;
|
|
Qtype_MX,
|
|
Qtype_AFSDB,
|
|
Qtype_RT,
|
|
Qtype_KX :
|
|
begin
|
|
x:=DecodeInt(Buffer,j);
|
|
Inc(j,2);
|
|
Result:=IntToStr(x);
|
|
Result:=Result+','+Decodelabels(j);
|
|
end;
|
|
Qtype_TXT :
|
|
begin
|
|
Result:=Decodelabels(j);
|
|
end;
|
|
Qtype_GPOS :
|
|
begin
|
|
Result:=Decodelabels(j);
|
|
Result:=Result+','+Decodelabels(j);
|
|
Result:=Result+','+Decodelabels(j);
|
|
end;
|
|
Qtype_PX :
|
|
begin
|
|
x:=DecodeInt(Buffer,j);
|
|
Inc(j,2);
|
|
Result:=IntToStr(x);
|
|
Result:=Result+','+Decodelabels(j);
|
|
Result:=Result+','+Decodelabels(j);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{TDNSSend.DNSQuery}
|
|
Function TDNSSend.DNSQuery(Name:string;Qtype:integer;Reply:TStrings):Boolean;
|
|
var
|
|
x,n,i:integer;
|
|
flag,qdcount, ancount, nscount, arcount:integer;
|
|
s:string;
|
|
begin
|
|
Result:=False;
|
|
Reply.Clear;
|
|
if IsIP(Name) then Name:=ReverseIP(Name)+'.in-addr.arpa';
|
|
Buffer:=Codeheader+CodeQuery(Name,QType);
|
|
sock.connect(DNSHost,'domain');
|
|
// dump(Buffer,'c:\dnslog.Txt');
|
|
sock.sendstring(Buffer);
|
|
if sock.canread(timeout)
|
|
then begin
|
|
x:=sock.waitingdata;
|
|
setlength(Buffer,x);
|
|
sock.recvbuffer(Pointer(Buffer),x);
|
|
// dump(Buffer,'c:\dnslogr.Txt');
|
|
flag:=DeCodeint(Buffer,3);
|
|
RCode:=Flag and $000F;
|
|
if RCode=0 then
|
|
begin
|
|
qdcount:=DeCodeint(Buffer,5);
|
|
ancount:=DeCodeint(Buffer,7);
|
|
nscount:=DeCodeint(Buffer,9);
|
|
arcount:=DeCodeint(Buffer,11);
|
|
i:=13; //begin of body
|
|
if qdcount>0 then //skip questions
|
|
for n:=1 to qdcount do
|
|
begin
|
|
while (Buffer[i]<>#0) and ((Ord(Buffer[i]) and $C0)<>$C0) do
|
|
Inc(i);
|
|
Inc(i,5);
|
|
end;
|
|
if ancount>0 then
|
|
for n:=1 to ancount do
|
|
begin
|
|
s:=DecodeResource(i, Name, Qtype);
|
|
if s<>'' then
|
|
Reply.Add(s);
|
|
end;
|
|
Result:=True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{==============================================================================}
|
|
|
|
function GetMailServers (DNSHost, domain:string; servers:TStringList):Boolean;
|
|
var
|
|
DNS:TDNSSend;
|
|
t:TStringList;
|
|
n,m,x:integer;
|
|
begin
|
|
Result:=False;
|
|
servers.Clear;
|
|
t:=TStringList.Create;
|
|
DNS:=TDNSSend.Create;
|
|
try
|
|
DNS.DNSHost:=DNSHost;
|
|
if DNS.DNSQuery(domain,QType_MX,t) then
|
|
begin
|
|
{normalize preference number to 5 digits}
|
|
for n:=0 to t.Count-1 do
|
|
begin
|
|
x:=Pos(',',t[n]);
|
|
if x>0 then
|
|
for m:=1 to 6-x do
|
|
t[n]:='0'+t[n];
|
|
end;
|
|
{sort server list}
|
|
t.Sorted:=True;
|
|
{result is sorted list without preference numbers}
|
|
for n:=0 to t.Count-1 do
|
|
begin
|
|
x:=Pos(',',t[n]);
|
|
servers.Add(Copy(t[n],x+1,Length(t[n])-x));
|
|
end;
|
|
Result:=True;
|
|
end;
|
|
finally
|
|
DNS.Free;
|
|
t.Free;
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|
|
|