when a packet is received the application should put the packet in\r
recvbuf/recvbuflen , set state.parsepacket and call state_process again\r
\r
- once the app gets action_done it can determine sucess or failure in the\r
+ once the app gets action_done it can determine success or failure in the\r
following ways.\r
\r
on failure state.resultstr will be an empty string and state.resultbin will\r
\r
interface\r
\r
-uses binipstuff,classes,pgtypes;\r
+uses binipstuff,classes,pgtypes,lcorernd;\r
\r
var usewindns : boolean = {$ifdef win32}true{$else}false{$endif};\r
{hint to users of this unit that they should use windows dns instead.\r
}\r
var useaf:integer = useaf_default;\r
\r
+{\r
+(temporarily) use a different nameserver, regardless of the dnsserverlist\r
+}\r
+var overridednsserver:ansistring;\r
+\r
const\r
maxnamelength=127;\r
maxnamefieldlen=63;\r
querytype_a=1;\r
querytype_cname=5;\r
querytype_aaaa=28;\r
+ querytype_a6=38;\r
querytype_ptr=12;\r
querytype_ns=2;\r
querytype_soa=6;\r
querytype_mx=15;\r
-\r
- maxrecursion=10;\r
+ querytype_txt=16;\r
+ querytype_spf=99;\r
+ maxrecursion=50;\r
maxrrofakind=20;\r
\r
retryafter=300000; //microseconds must be less than one second;\r
tdnsstate=record\r
id:word;\r
recursioncount:integer;\r
- queryname:string;\r
+ queryname:ansistring;\r
requesttype:word;\r
parsepacket:boolean;\r
- resultstr:string;\r
+ resultstr:ansistring;\r
resultbin:tbinip;\r
resultlist:tbiniplist;\r
resultaction:integer;\r
numrr1:array[0..3] of integer;\r
numrr2:integer;\r
- rrdata:string;\r
+ rrdata:ansistring;\r
sendpacketlen:integer;\r
sendpacket:tdnspacket;\r
recvpacketlen:integer;\r
//function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;\r
\r
//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\r
-function makereversename(const binip:tbinip):string;\r
+function makereversename(const binip:tbinip):ansistring;\r
\r
-procedure setstate_request_init(const name:string;var state:tdnsstate);\r
+procedure setstate_request_init(const name:ansistring;var state:tdnsstate);\r
\r
//set up state for a foward lookup. A family value of AF_INET6 will give only\r
-//ipv6 results. Any other value will give ipv4 results in preference and ipv6\r
-//results if ipv4 results are not available;\r
-procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);\r
+//ipv6 results. Any other value will give only ipv4 results\r
+procedure setstate_forward(const name:ansistring;var state:tdnsstate;family:integer);\r
\r
procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);\r
procedure setstate_failure(var state:tdnsstate);\r
//procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);\r
\r
+//for custom raw lookups such as TXT, as desired by the user\r
+procedure setstate_custom(const name:ansistring; requesttype:integer; var state:tdnsstate);\r
\r
procedure state_process(var state:tdnsstate);\r
\r
//function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;\r
\r
-//presumablly this is exported to allow more secure random functions\r
-//to be substituted?\r
-var randomfunction:function:integer;\r
-\r
-\r
procedure populatednsserverlist;\r
procedure cleardnsservercache;\r
\r
dnsserverlist : tstringlist;\r
// currentdnsserverno : integer;\r
\r
-function getcurrentsystemnameserver(var id:integer) :string;\r
+\r
+//getcurrentsystemnameserver returns the nameserver the app should use and sets\r
+//id to the id of that nameserver. id should later be used to report how laggy\r
+//the servers response was and if it was timed out.\r
+function getcurrentsystemnameserver(var id:integer) :ansistring;\r
+procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout\r
\r
//var\r
// unixnameservercache:string;\r
{ $endif}\r
\r
\r
-procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout\r
+{$ifdef ipv6}\r
+function getv6localips:tbiniplist;\r
+procedure initpreferredmode;\r
+\r
var\r
- failurereason:string;\r
+ preferredmodeinited:boolean;\r
+\r
+{$endif}\r
+\r
+var\r
+ failurereason:ansistring;\r
+\r
+function getquerytype(s:ansistring):integer;\r
\r
implementation\r
\r
\r
sysutils;\r
\r
-function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;\r
+\r
+\r
+function getquerytype(s:ansistring):integer;\r
+begin\r
+ s := uppercase(s);\r
+ result := 0;\r
+ if (s = 'A') then result := querytype_a else\r
+ if (s = 'CNAME') then result := querytype_cname else\r
+ if (s = 'AAAA') then result := querytype_aaaa else\r
+ if (s = 'PTR') then result := querytype_ptr else\r
+ if (s = 'NS') then result := querytype_ns else\r
+ if (s = 'MX') then result := querytype_mx else\r
+ if (s = 'A6') then result := querytype_a6 else\r
+ if (s = 'TXT') then result := querytype_txt else\r
+ if (s = 'SOA') then result := querytype_soa else\r
+ if (s = 'SPF') then result := querytype_spf;\r
+end;\r
+\r
+function buildrequest(const name:ansistring;var packet:tdnspacket;requesttype:word):integer;\r
var\r
a,b:integer;\r
- s:string;\r
+ s:ansistring;\r
arr:array[0..sizeof(packet)-1] of byte absolute packet;\r
begin\r
{ writeln('buildrequest: name: ',name);}\r
result := 0;\r
fillchar(packet,sizeof(packet),0);\r
- if assigned(randomfunction) then packet.id := (randomfunction and $ffff) else packet.id := random(65536);\r
+ packet.id := randominteger($10000);\r
+\r
packet.flags := htons($0100);\r
packet.rrcount[0] := htons($0001);\r
\r
arr[result-4] := requesttype shr 8;\r
end;\r
\r
-function makereversename(const binip:tbinip):string;\r
+function makereversename(const binip:tbinip):ansistring;\r
var\r
- name:string;\r
+ name:ansistring;\r
a,b:integer;\r
begin\r
name := '';\r
empty result + non null failurereason: failure\r
empty result + null failurereason: internal use\r
}\r
-function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;\r
+function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):ansistring;\r
var\r
arr:array[0..sizeof(packet)-1] of byte absolute packet;\r
- s:string;\r
+ s:ansistring;\r
a,b:integer;\r
begin\r
numread := 0;\r
failurereason := 'decoding name: got out of range2';\r
exit;\r
end;\r
- result := result + char(arr[a]);\r
+ result := result + ansichar(arr[a]);\r
end;\r
inc(numread,b+1);\r
\r
\r
{==============================================================================}\r
\r
+function getrawfromrr(const rrp:trrpointer;len:integer):ansistring;\r
+begin\r
+ setlength(result,htons(trr(rrp.p^).datalen));\r
+ uniquestring(result);\r
+ move(trr(rrp.p^).data,result[1],length(result));\r
+end;\r
+\r
+\r
function getipfromrr(const rrp:trrpointer;len:integer):tbinip;\r
begin\r
fillchar(result,sizeof(result),0);\r
querytype_a{$ifdef ipv6},querytype_aaaa{$endif}: begin\r
state.resultbin := getipfromrr(rrp,len);\r
end;\r
+ querytype_txt:begin\r
+ {TXT returns a raw string}\r
+ state.resultstr := copy(getrawfromrr(rrp,len),2,9999);\r
+ fillchar(state.resultbin,sizeof(state.resultbin),0);\r
+ end;\r
+ querytype_mx:begin\r
+ {MX is a name after a 16 bits word}\r
+ state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+12,0,a);\r
+ fillchar(state.resultbin,sizeof(state.resultbin),0);\r
+ end;\r
else\r
{other reply types (PTR, MX) return a hostname}\r
state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+10,0,a);\r
end;\r
end;\r
\r
-procedure setstate_request_init(const name:string;var state:tdnsstate);\r
+procedure setstate_request_init(const name:ansistring;var state:tdnsstate);\r
begin\r
{destroy things properly}\r
state.resultstr := '';\r
state.parsepacket := false;\r
end;\r
\r
-procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);\r
+procedure setstate_forward(const name:ansistring;var state:tdnsstate;family:integer);\r
begin\r
setstate_request_init(name,state);\r
state.forwardfamily := family;\r
state.requesttype := querytype_ptr;\r
end;\r
\r
+procedure setstate_custom(const name:ansistring; requesttype:integer; var state:tdnsstate);\r
+begin\r
+ setstate_request_init(name,state);\r
+ state.requesttype := requesttype;\r
+end;\r
+\r
+\r
procedure setstate_failure(var state:tdnsstate);\r
begin\r
state.resultstr := '';\r
\r
{no cnames found, no items of correct type found}\r
if state.forwardfamily <> 0 then goto failure;\r
-{$ifdef ipv6}\r
- if (state.requesttype = querytype_a) then begin\r
- {v6 only: in case of forward, look for AAAA in alternative section}\r
- for a := state.numrr1[0]+state.numrr1[1]+state.numrr1[2] to (state.numrr2-1) do begin\r
- rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];\r
- rrtemp := rrptemp.p;\r
- b := rrptemp.len;\r
- if rrtemp.requesttype = querytype_aaaa then begin\r
- setstate_return(rrptemp^,b,state);\r
- exit;\r
- end;\r
- end;\r
- {no AAAA's found in alternative, do a recursive lookup for them}\r
- state.requesttype := querytype_aaaa;\r
- goto recursed;\r
- end;\r
-{$endif}\r
+\r
goto failure;\r
recursed:\r
{here it needs recursed lookup}\r
type\r
tip_addr_string=packed record\r
Next :pointer;\r
- IpAddress : array[0..15] of char;\r
- ipmask : array[0..15] of char;\r
+ IpAddress : array[0..15] of ansichar;\r
+ ipmask : array[0..15] of ansichar;\r
context : dword;\r
end;\r
pip_addr_string=^tip_addr_string;\r
tFIXED_INFO=packed record\r
- HostName : array[0..MAX_HOSTNAME_LEN-1] of char;\r
- DomainName : array[0..MAX_DOMAIN_NAME_LEN-1] of char;\r
+ HostName : array[0..MAX_HOSTNAME_LEN-1] of ansichar;\r
+ DomainName : array[0..MAX_DOMAIN_NAME_LEN-1] of ansichar;\r
currentdnsserver : pip_addr_string;\r
dnsserverlist : tip_addr_string;\r
nodetype : longint;\r
- ScopeId : array[0..MAX_SCOPE_ID_LEN + 4] of char;\r
+ ScopeId : array[0..MAX_SCOPE_ID_LEN + 4] of ansichar;\r
enablerouting : longbool;\r
enableproxy : longbool;\r
enabledns : longbool;\r
currentdnsserver : pip_addr_string;\r
{$else}\r
t:textfile;\r
- s:string;\r
+ s:ansistring;\r
a:integer;\r
{$endif}\r
begin\r
end;\r
end;\r
\r
-function getcurrentsystemnameserver(var id:integer):string;\r
+function getcurrentsystemnameserver(var id:integer):ansistring;\r
var\r
counter : integer;\r
\r
\r
end;\r
\r
+\r
+\r
+{$ifdef ipv6}\r
+\r
+{$ifdef linux}\r
+function getv6localips:tbiniplist;\r
+var\r
+ t:textfile;\r
+ s,s2:ansistring;\r
+ ip:tbinip;\r
+ a:integer;\r
+begin\r
+ result := biniplist_new;\r
+\r
+ assignfile(t,'/proc/net/if_inet6');\r
+ {$i-}reset(t);{$i+}\r
+ if ioresult <> 0 then exit; {none found, return empty list}\r
+\r
+ while not eof(t) do begin\r
+ readln(t,s);\r
+ s2 := '';\r
+ for a := 0 to 7 do begin\r
+ if (s2 <> '') then s2 := s2 + ':';\r
+ s2 := s2 + copy(s,(a shl 2)+1,4);\r
+ end;\r
+ ipstrtobin(s2,ip);\r
+ if ip.family <> 0 then biniplist_add(result,ip);\r
+ end;\r
+ closefile(t);\r
+end;\r
+\r
+{$else}\r
+function getv6localips:tbiniplist;\r
+begin\r
+ result := biniplist_new;\r
+end;\r
+{$endif}\r
+\r
+procedure initpreferredmode;\r
+var\r
+ l:tbiniplist;\r
+ a:integer;\r
+ ip:tbinip;\r
+ ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;\r
+\r
+begin\r
+ if preferredmodeinited then exit;\r
+ if useaf <> useaf_default then exit;\r
+ l := getv6localips;\r
+ if biniplist_getcount(l) = 0 then exit;\r
+ useaf := useaf_preferv4;\r
+ ipstrtobin('2000::',ipmask_global);\r
+ ipstrtobin('2001::',ipmask_teredo);\r
+ ipstrtobin('2002::',ipmask_6to4);\r
+ {if there is any v6 IP which is globally routable and not 6to4 and not teredo, prefer v6}\r
+ for a := biniplist_getcount(l)-1 downto 0 do begin\r
+ ip := biniplist_get(l,a);\r
+ if not comparebinipmask(ip,ipmask_global,3) then continue;\r
+ if comparebinipmask(ip,ipmask_teredo,32) then continue;\r
+ if comparebinipmask(ip,ipmask_6to4,16) then continue;\r
+ useaf := useaf_preferv6;\r
+ preferredmodeinited := true;\r
+ exit;\r
+ end;\r
+end;\r
+\r
+{$endif}\r
+\r
+\r
{ quick and dirty description of dns packet structure to aid writing and\r
understanding of parser code, refer to appropriate RFCs for proper specs\r
- all words are network order\r
lcore.org gitweb / lcore.git / blobdiff