X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/d53fe26eaac895d1e7a0ba2b2b8965cf77932de8..d0705a212a4b27b3cf9a3aaf007db8b6db443092:/dnscore.pas
diff --git a/dnscore.pas b/dnscore.pas
old mode 100755
new mode 100644
index 600581d..86cad69
--- a/dnscore.pas
+++ b/dnscore.pas
@@ -60,7 +60,7 @@ unit dnscore;
interface
-uses binipstuff,classes,pgtypes;
+uses binipstuff,classes,pgtypes,lcorernd;
var usewindns : boolean = {$ifdef win32}true{$else}false{$endif};
{hint to users of this unit that they should use windows dns instead.
@@ -82,6 +82,11 @@ can be set by apps as desired
}
var useaf:integer = useaf_default;
+{
+(temporarily) use a different nameserver, regardless of the dnsserverlist
+}
+var overridednsserver:ansistring;
+
const
maxnamelength=127;
maxnamefieldlen=63;
@@ -93,12 +98,14 @@ const
querytype_a=1;
querytype_cname=5;
querytype_aaaa=28;
+ querytype_a6=38;
querytype_ptr=12;
querytype_ns=2;
querytype_soa=6;
querytype_mx=15;
-
- maxrecursion=10;
+ querytype_txt=16;
+ querytype_spf=99;
+ maxrecursion=50;
maxrrofakind=20;
retryafter=300000; //microseconds must be less than one second;
@@ -118,16 +125,16 @@ type
tdnsstate=record
id:word;
recursioncount:integer;
- queryname:string;
+ queryname:ansistring;
requesttype:word;
parsepacket:boolean;
- resultstr:string;
+ resultstr:ansistring;
resultbin:tbinip;
resultlist:tbiniplist;
resultaction:integer;
numrr1:array[0..3] of integer;
numrr2:integer;
- rrdata:string;
+ rrdata:ansistring;
sendpacketlen:integer;
sendpacket:tdnspacket;
recvpacketlen:integer;
@@ -158,28 +165,25 @@ type
//function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;
//returns the DNS name used to reverse look up an IP, such as 4.3.2.1.in-addr.arpa for 1.2.3.4
-function makereversename(const binip:tbinip):string;
+function makereversename(const binip:tbinip):ansistring;
-procedure setstate_request_init(const name:string;var state:tdnsstate);
+procedure setstate_request_init(const name:ansistring;var state:tdnsstate);
//set up state for a foward lookup. A family value of AF_INET6 will give only
//ipv6 results. Any other value will give only ipv4 results
-procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);
+procedure setstate_forward(const name:ansistring;var state:tdnsstate;family:integer);
procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);
procedure setstate_failure(var state:tdnsstate);
//procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);
+//for custom raw lookups such as TXT, as desired by the user
+procedure setstate_custom(const name:ansistring; requesttype:integer; var state:tdnsstate);
procedure state_process(var state:tdnsstate);
//function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;
-//presumablly this is exported to allow more secure random functions
-//to be substituted?
-var randomfunction:function:integer;
-
-
procedure populatednsserverlist;
procedure cleardnsservercache;
@@ -191,7 +195,7 @@ var
//getcurrentsystemnameserver returns the nameserver the app should use and sets
//id to the id of that nameserver. id should later be used to report how laggy
//the servers response was and if it was timed out.
-function getcurrentsystemnameserver(var id:integer) :string;
+function getcurrentsystemnameserver(var id:integer) :ansistring;
procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout
//var
@@ -199,17 +203,19 @@ procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and
{ $endif}
-{$ifdef linux}{$ifdef ipv6}
+{$ifdef ipv6}
function getv6localips:tbiniplist;
procedure initpreferredmode;
var
preferredmodeinited:boolean;
-{$endif}{$endif}
+{$endif}
var
- failurereason:string;
+ failurereason:ansistring;
+
+function getquerytype(s:ansistring):integer;
implementation
@@ -220,16 +226,35 @@ uses
sysutils;
-function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;
+
+
+function getquerytype(s:ansistring):integer;
+begin
+ s := uppercase(s);
+ result := 0;
+ if (s = 'A') then result := querytype_a else
+ if (s = 'CNAME') then result := querytype_cname else
+ if (s = 'AAAA') then result := querytype_aaaa else
+ if (s = 'PTR') then result := querytype_ptr else
+ if (s = 'NS') then result := querytype_ns else
+ if (s = 'MX') then result := querytype_mx else
+ if (s = 'A6') then result := querytype_a6 else
+ if (s = 'TXT') then result := querytype_txt else
+ if (s = 'SOA') then result := querytype_soa else
+ if (s = 'SPF') then result := querytype_spf;
+end;
+
+function buildrequest(const name:ansistring;var packet:tdnspacket;requesttype:word):integer;
var
a,b:integer;
- s:string;
+ s:ansistring;
arr:array[0..sizeof(packet)-1] of byte absolute packet;
begin
{ writeln('buildrequest: name: ',name);}
result := 0;
fillchar(packet,sizeof(packet),0);
- if assigned(randomfunction) then packet.id := (randomfunction and $ffff) else packet.id := random(65536);
+ packet.id := randominteger($10000);
+
packet.flags := htons($0100);
packet.rrcount[0] := htons($0001);
@@ -264,9 +289,9 @@ begin
arr[result-4] := requesttype shr 8;
end;
-function makereversename(const binip:tbinip):string;
+function makereversename(const binip:tbinip):ansistring;
var
- name:string;
+ name:ansistring;
a,b:integer;
begin
name := '';
@@ -298,10 +323,10 @@ doesnt read beyond len.
empty result + non null failurereason: failure
empty result + null failurereason: internal use
}
-function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;
+function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):ansistring;
var
arr:array[0..sizeof(packet)-1] of byte absolute packet;
- s:string;
+ s:ansistring;
a,b:integer;
begin
numread := 0;
@@ -360,6 +385,14 @@ end;
{==============================================================================}
+function getrawfromrr(const rrp:trrpointer;len:integer):ansistring;
+begin
+ setlength(result,htons(trr(rrp.p^).datalen));
+ uniquestring(result);
+ move(trr(rrp.p^).data,result[1],length(result));
+end;
+
+
function getipfromrr(const rrp:trrpointer;len:integer):tbinip;
begin
fillchar(result,sizeof(result),0);
@@ -391,6 +424,16 @@ begin
querytype_a{$ifdef ipv6},querytype_aaaa{$endif}: begin
state.resultbin := getipfromrr(rrp,len);
end;
+ querytype_txt:begin
+ {TXT returns a raw string}
+ state.resultstr := copy(getrawfromrr(rrp,len),2,9999);
+ fillchar(state.resultbin,sizeof(state.resultbin),0);
+ end;
+ querytype_mx:begin
+ {MX is a name after a 16 bits word}
+ state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+12,0,a);
+ fillchar(state.resultbin,sizeof(state.resultbin),0);
+ end;
else
{other reply types (PTR, MX) return a hostname}
state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+10,0,a);
@@ -398,7 +441,7 @@ begin
end;
end;
-procedure setstate_request_init(const name:string;var state:tdnsstate);
+procedure setstate_request_init(const name:ansistring;var state:tdnsstate);
begin
{destroy things properly}
state.resultstr := '';
@@ -409,7 +452,7 @@ begin
state.parsepacket := false;
end;
-procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);
+procedure setstate_forward(const name:ansistring;var state:tdnsstate;family:integer);
begin
setstate_request_init(name,state);
state.forwardfamily := family;
@@ -425,6 +468,13 @@ begin
state.requesttype := querytype_ptr;
end;
+procedure setstate_custom(const name:ansistring; requesttype:integer; var state:tdnsstate);
+begin
+ setstate_request_init(name,state);
+ state.requesttype := requesttype;
+end;
+
+
procedure setstate_failure(var state:tdnsstate);
begin
state.resultstr := '';
@@ -606,7 +656,7 @@ var
currentdnsserver : pip_addr_string;
{$else}
t:textfile;
- s:string;
+ s:ansistring;
a:integer;
{$endif}
begin
@@ -667,7 +717,7 @@ begin
end;
end;
-function getcurrentsystemnameserver(var id:integer):string;
+function getcurrentsystemnameserver(var id:integer):ansistring;
var
counter : integer;
@@ -701,11 +751,13 @@ end;
-{$ifdef linux}{$ifdef ipv6}
+{$ifdef ipv6}
+
+{$ifdef linux}
function getv6localips:tbiniplist;
var
t:textfile;
- s,s2:string;
+ s,s2:ansistring;
ip:tbinip;
a:integer;
begin
@@ -728,6 +780,13 @@ begin
closefile(t);
end;
+{$else}
+function getv6localips:tbiniplist;
+begin
+ result := biniplist_new;
+end;
+{$endif}
+
procedure initpreferredmode;
var
l:tbiniplist;
@@ -738,8 +797,9 @@ var
begin
if preferredmodeinited then exit;
if useaf <> useaf_default then exit;
- useaf := useaf_preferv4;
l := getv6localips;
+ if biniplist_getcount(l) = 0 then exit;
+ useaf := useaf_preferv4;
ipstrtobin('2000::',ipmask_global);
ipstrtobin('2001::',ipmask_teredo);
ipstrtobin('2002::',ipmask_6to4);
@@ -755,7 +815,7 @@ begin
end;
end;
-{$endif}{$endif}
+{$endif}
{ quick and dirty description of dns packet structure to aid writing and