X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/6cb6b7ede2d178e03fa817bc28474c175f5a93b9..a2d002aadb85c6411b55e3966247efb21eeff2b8:/dnscore.pas
diff --git a/dnscore.pas b/dnscore.pas
old mode 100755
new mode 100644
index ef4c2f1..3a9596f
--- a/dnscore.pas
+++ b/dnscore.pas
@@ -28,7 +28,7 @@
when a packet is received the application should put the packet in
recvbuf/recvbuflen , set state.parsepacket and call state_process again
- once the app gets action_done it can determine sucess or failure in the
+ once the app gets action_done it can determine success or failure in the
following ways.
on failure state.resultstr will be an empty string and state.resultbin will
@@ -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,13 +98,18 @@ 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;
- maxrrofakind=20;
+ querytype_txt=16;
+ querytype_spf=99;
+ maxrecursion=50;
+ maxrrofakind=32;
+ {the maximum number of RR of a kind of purely an extra sanity check and could be omitted.
+ before, i set it to 20, but valid replies can have more. dnscore only does udp requests,
+ and ordinary DNS, so up to 512 bytes. the maximum number of A records that fits seems to be 29}
retryafter=300000; //microseconds must be less than one second;
timeoutlag=1000000000; // penalty value to be treated as lag in the event of a timeout (microseconds)
@@ -118,16 +128,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,66 +168,94 @@ 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 ipv4 results in preference and ipv6
-//results if ipv4 results are not available;
-procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);
+//ipv6 results. Any other value will give only ipv4 results
+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;
var
- dnsserverlist : tstringlist;
+ dnsserverlist : tbiniplist;
+ dnsserverlag:tlist;
// currentdnsserverno : integer;
-function getcurrentsystemnameserver(var id:integer) :string;
+
+//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) :ansistring;
+function getcurrentsystemnameserverbin(var id:integer) :tbinip;
+procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout
//var
// unixnameservercache:string;
{ $endif}
-procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout
+{$ifdef ipv6}
+procedure initpreferredmode;
+
var
- failurereason:string;
+ preferredmodeinited:boolean;
+
+{$endif}
+
+var
+ failurereason:ansistring;
+
+function getquerytype(s:ansistring):integer;
implementation
uses
- {$ifdef win32}
- windows,
- {$endif}
-
+ lcorelocalips,
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);
@@ -252,9 +290,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 := '';
@@ -286,10 +324,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;
@@ -330,7 +368,7 @@ begin
failurereason := 'decoding name: got out of range2';
exit;
end;
- result := result + char(arr[a]);
+ result := result + ansichar(arr[a]);
end;
inc(numread,b+1);
@@ -348,6 +386,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);
@@ -379,6 +425,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);
@@ -386,7 +442,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 := '';
@@ -397,7 +453,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;
@@ -413,6 +469,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 := '';
@@ -442,7 +505,10 @@ begin
state.numrr2 := 0;
for a := 0 to 3 do begin
state.numrr1[a] := htons(state.recvpacket.rrcount[a]);
- if state.numrr1[a] > maxrrofakind then goto failure;
+ if state.numrr1[a] > maxrrofakind then begin
+ failurereason := 'exceeded maximum RR of a kind';
+ goto failure;
+ end;
inc(state.numrr2,state.numrr1[a]);
end;
@@ -516,23 +582,7 @@ begin
{no cnames found, no items of correct type found}
if state.forwardfamily <> 0 then goto failure;
-{$ifdef ipv6}
- if (state.requesttype = querytype_a) then begin
- {v6 only: in case of forward, look for AAAA in alternative section}
- for a := state.numrr1[0]+state.numrr1[1]+state.numrr1[2] to (state.numrr2-1) do begin
- rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
- rrtemp := rrptemp.p;
- b := rrptemp.len;
- if rrtemp.requesttype = querytype_aaaa then begin
- setstate_return(rrptemp^,b,state);
- exit;
- end;
- end;
- {no AAAA's found in alternative, do a recursive lookup for them}
- state.requesttype := querytype_aaaa;
- goto recursed;
- end;
-{$endif}
+
goto failure;
recursed:
{here it needs recursed lookup}
@@ -560,132 +610,59 @@ recursed:
failure:
setstate_failure(state);
end;
-{$ifdef win32}
- const
- MAX_HOSTNAME_LEN = 132;
- MAX_DOMAIN_NAME_LEN = 132;
- MAX_SCOPE_ID_LEN = 260 ;
- MAX_ADAPTER_NAME_LENGTH = 260;
- MAX_ADAPTER_ADDRESS_LENGTH = 8;
- MAX_ADAPTER_DESCRIPTION_LENGTH = 132;
- ERROR_BUFFER_OVERFLOW = 111;
- MIB_IF_TYPE_ETHERNET = 6;
- MIB_IF_TYPE_TOKENRING = 9;
- MIB_IF_TYPE_FDDI = 15;
- MIB_IF_TYPE_PPP = 23;
- MIB_IF_TYPE_LOOPBACK = 24;
- MIB_IF_TYPE_SLIP = 28;
-
-
- type
- tip_addr_string=packed record
- Next :pointer;
- IpAddress : array[0..15] of char;
- ipmask : array[0..15] of char;
- context : dword;
- end;
- pip_addr_string=^tip_addr_string;
- tFIXED_INFO=packed record
- HostName : array[0..MAX_HOSTNAME_LEN-1] of char;
- DomainName : array[0..MAX_DOMAIN_NAME_LEN-1] of char;
- currentdnsserver : pip_addr_string;
- dnsserverlist : tip_addr_string;
- nodetype : longint;
- ScopeId : array[0..MAX_SCOPE_ID_LEN + 4] of char;
- enablerouting : longbool;
- enableproxy : longbool;
- enabledns : longbool;
- end;
- pFIXED_INFO=^tFIXED_INFO;
- var
- iphlpapi : thandle;
- getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall;
-{$endif}
+
procedure populatednsserverlist;
var
- {$ifdef win32}
- fixed_info : pfixed_info;
- fixed_info_len : longint;
- currentdnsserver : pip_addr_string;
- {$else}
- t:textfile;
- s:string;
- a:integer;
- {$endif}
+ a:integer;
begin
- //result := '';
- if assigned(dnsserverlist) then begin
- dnsserverlist.clear;
+ if assigned(dnsserverlag) then begin
+ dnsserverlag.clear;
end else begin
- dnsserverlist := tstringlist.Create;
+ dnsserverlag := tlist.Create;
end;
- {$ifdef win32}
- if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');
- if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');
- if not assigned(getnetworkparams) then exit;
- fixed_info_len := 0;
- if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;
- //fixed_info_len :=sizeof(tfixed_info);
- getmem(fixed_info,fixed_info_len);
- if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin
- freemem(fixed_info);
- exit;
- end;
- currentdnsserver := @(fixed_info.dnsserverlist);
- while assigned(currentdnsserver) do begin
- dnsserverlist.Add(currentdnsserver.IpAddress);
- currentdnsserver := currentdnsserver.next;
- end;
- freemem(fixed_info);
- {$else}
- filemode := 0;
- assignfile(t,'/etc/resolv.conf');
- {$i-}reset(t);{$i+}
- if ioresult <> 0 then exit;
-
- while not eof(t) do begin
- readln(t,s);
- if not (copy(s,1,10) = 'nameserver') then continue;
- s := copy(s,11,500);
- while s <> '' do begin
- if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break;
- end;
- a := pos(' ',s);
- if a <> 0 then s := copy(s,1,a-1);
- a := pos(#9,s);
- if a <> 0 then s := copy(s,1,a-1);
- //result := s;
- //if result <> '' then break;
- dnsserverlist.Add(s);
- end;
- close(t);
- {$endif}
+
+ dnsserverlist := getsystemdnsservers;
+ for a := biniplist_getcount(dnsserverlist)-1 downto 0 do dnsserverlag.Add(nil);
end;
procedure cleardnsservercache;
begin
- if assigned(dnsserverlist) then begin
- dnsserverlist.destroy;
- dnsserverlist := nil;
+ if assigned(dnsserverlag) then begin
+ dnsserverlag.destroy;
+ dnsserverlag := nil;
+ dnsserverlist := '';
end;
end;
-function getcurrentsystemnameserver(var id:integer):string;
+function getcurrentsystemnameserverbin(var id:integer):tbinip;
var
counter : integer;
-
begin
- if not assigned(dnsserverlist) then populatednsserverlist;
- if dnsserverlist.count=0 then raise exception.create('no dns servers availible');
- id := 0;
- if dnsserverlist.count >1 then begin
+ {override the name server choice here, instead of overriding it whereever it's called
+ setting ID to -1 causes it to be ignored in reportlag}
+ if (overridednsserver <> '') then begin
+ result := ipstrtobinf(overridednsserver);
+ if result.family <> 0 then begin
+ id := -1;
+ exit;
+ end;
+ end;
- for counter := 1 to dnsserverlist.count-1 do begin
- if taddrint(dnsserverlist.objects[counter]) < taddrint(dnsserverlist.objects[id]) then id := counter;
+ if not assigned(dnsserverlag) then populatednsserverlist;
+ if dnsserverlag.count=0 then raise exception.create('no dns servers availible');
+ id := 0;
+ if dnsserverlag.count >1 then begin
+ for counter := dnsserverlag.count-1 downto 1 do begin
+ if taddrint(dnsserverlag[counter]) < taddrint(dnsserverlag[id]) then id := counter;
end;
end;
- result := dnsserverlist[id]
+ result := biniplist_get(dnsserverlist,id);
+end;
+
+function getcurrentsystemnameserver(var id:integer):ansistring;
+begin
+ result := ipbintostr(getcurrentsystemnameserverbin(id));
end;
procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout
@@ -693,16 +670,50 @@ var
counter : integer;
temp : integer;
begin
- if (id < 0) or (id >= dnsserverlist.count) then exit;
+ if (id < 0) or (id >= dnsserverlag.count) then exit;
if lag = -1 then lag := timeoutlag;
- for counter := 0 to dnsserverlist.count-1 do begin
- temp := taddrint(dnsserverlist.objects[counter]) *15;
+ for counter := 0 to dnsserverlag.count-1 do begin
+ temp := taddrint(dnsserverlag[counter]) *15;
if counter=id then temp := temp + lag;
- dnsserverlist.objects[counter] := tobject(temp div 16);
+ dnsserverlag[counter] := tobject(temp div 16);
end;
end;
+
+{$ifdef ipv6}
+
+procedure initpreferredmode;
+var
+ l:tbiniplist;
+ a:integer;
+ ip:tbinip;
+ ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;
+
+begin
+ if preferredmodeinited then exit;
+ if useaf <> useaf_default then exit;
+ l := getv6localips;
+ if biniplist_getcount(l) = 0 then exit;
+ useaf := useaf_preferv4;
+ ipstrtobin('2000::',ipmask_global);
+ ipstrtobin('2001::',ipmask_teredo);
+ ipstrtobin('2002::',ipmask_6to4);
+ {if there is any v6 IP which is globally routable and not 6to4 and not teredo, prefer v6}
+ for a := biniplist_getcount(l)-1 downto 0 do begin
+ ip := biniplist_get(l,a);
+ if not comparebinipmask(ip,ipmask_global,3) then continue;
+ if comparebinipmask(ip,ipmask_teredo,32) then continue;
+ if comparebinipmask(ip,ipmask_6to4,16) then continue;
+ useaf := useaf_preferv6;
+ preferredmodeinited := true;
+ exit;
+ end;
+end;
+
+{$endif}
+
+
{ quick and dirty description of dns packet structure to aid writing and
understanding of parser code, refer to appropriate RFCs for proper specs
- all words are network order