X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/4782a5c5afee47721cc617daa40dd29828342c2b..3d939725e66414faa7684bbcd5f4ffe95ee2108d:/dnscore.pas
diff --git a/dnscore.pas b/dnscore.pas
index bb4fab4..600581d 100755
--- a/dnscore.pas
+++ b/dnscore.pas
@@ -54,25 +54,33 @@
}
unit dnscore;
-
-
{$ifdef fpc}{$mode delphi}{$endif}
-
-
-
+{$include lcoreconfig.inc}
interface
uses binipstuff,classes,pgtypes;
var usewindns : boolean = {$ifdef win32}true{$else}false{$endif};
-//hint to users of this unit that they should use windows dns instead.
-//May be disabled by applications if desired. (e.g. if setting a custom
-//dnsserverlist).
+{hint to users of this unit that they should use windows dns instead.
+May be disabled by applications if desired. (e.g. if setting a custom
+dnsserverlist).
-//note: this unit will not be able to self populate it's dns server list on
-//older versions of windows.
+note: this unit will not be able to self populate it's dns server list on
+older versions of windows.}
+
+const
+ useaf_default=0;
+ useaf_preferv4=1;
+ useaf_preferv6=2;
+ useaf_v4=3;
+ useaf_v6=4;
+{
+hint to users of this unit to how to deal with connecting to hostnames regarding ipv4 or ipv6 usage
+can be set by apps as desired
+}
+var useaf:integer = useaf_default;
const
maxnamelength=127;
@@ -115,6 +123,7 @@ type
parsepacket:boolean;
resultstr:string;
resultbin:tbinip;
+ resultlist:tbiniplist;
resultaction:integer;
numrr1:array[0..3] of integer;
numrr2:integer;
@@ -147,13 +156,14 @@ type
//if you must but please document them at the same time --plugwash
//function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;
-//function makereversename(const binip:tbinip):string;
+
+//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;
procedure setstate_request_init(const name:string;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;
+//ipv6 results. Any other value will give only ipv4 results
procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);
procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);
@@ -177,14 +187,27 @@ var
dnsserverlist : tstringlist;
// currentdnsserverno : integer;
+
+//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;
+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 linux}{$ifdef ipv6}
+function getv6localips:tbiniplist;
+procedure initpreferredmode;
+
+var
+ preferredmodeinited:boolean;
+
+{$endif}{$endif}
+
var
failurereason:string;
@@ -337,25 +360,37 @@ end;
{==============================================================================}
-procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);
-var
- a:integer;
+function getipfromrr(const rrp:trrpointer;len:integer):tbinip;
begin
- state.resultaction := action_done;
- state.resultstr := '';
+ fillchar(result,sizeof(result),0);
case trr(rrp.p^).requesttype of
querytype_a: begin
if htons(trr(rrp.p^).datalen) <> 4 then exit;
- move(trr(rrp.p^).data,state.resultbin.ip,4);
- state.resultbin.family :=AF_INET;
+ move(trr(rrp.p^).data,result.ip,4);
+ result.family :=AF_INET;
end;
{$ifdef ipv6}
querytype_aaaa: begin
if htons(trr(rrp.p^).datalen) <> 16 then exit;
- state.resultbin.family := AF_INET6;
- move(trr(rrp.p^).data,state.resultbin.ip6,16);
+ result.family := AF_INET6;
+ move(trr(rrp.p^).data,result.ip6,16);
end;
{$endif}
+ else
+ {}
+ end;
+end;
+
+procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);
+var
+ a:integer;
+begin
+ state.resultaction := action_done;
+ state.resultstr := '';
+ case trr(rrp.p^).requesttype of
+ querytype_a{$ifdef ipv6},querytype_aaaa{$endif}: begin
+ state.resultbin := getipfromrr(rrp,len);
+ 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);
@@ -456,6 +491,19 @@ begin
goto failure;
end;
+ {if we requested A or AAAA build a list of all replies}
+ if (state.requesttype = querytype_a) or (state.requesttype = querytype_aaaa) then begin
+ state.resultlist := biniplist_new;
+ for a := state.numrr1[0] to (state.numrr1[0]+state.numrr1[1]-1) do begin
+ rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
+ rrtemp := rrptemp.p;
+ b := rrptemp.len;
+ if rrtemp.requesttype = state.requesttype then begin
+ biniplist_add(state.resultlist,getipfromrr(rrptemp^,b));
+ end;
+ end;
+ end;
+
{- check for items of the requested type in answer section, if so return success first}
for a := state.numrr1[0] to (state.numrr1[0]+state.numrr1[1]-1) do begin
rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
@@ -480,23 +528,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}
@@ -587,6 +619,7 @@ begin
{$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);
@@ -635,7 +668,7 @@ begin
end;
function getcurrentsystemnameserver(var id:integer):string;
-var
+var
counter : integer;
begin
@@ -666,6 +699,65 @@ begin
end;
+
+
+{$ifdef linux}{$ifdef ipv6}
+function getv6localips:tbiniplist;
+var
+ t:textfile;
+ s,s2:string;
+ ip:tbinip;
+ a:integer;
+begin
+ result := biniplist_new;
+
+ assignfile(t,'/proc/net/if_inet6');
+ {$i-}reset(t);{$i+}
+ if ioresult <> 0 then exit; {none found, return empty list}
+
+ while not eof(t) do begin
+ readln(t,s);
+ s2 := '';
+ for a := 0 to 7 do begin
+ if (s2 <> '') then s2 := s2 + ':';
+ s2 := s2 + copy(s,(a shl 2)+1,4);
+ end;
+ ipstrtobin(s2,ip);
+ if ip.family <> 0 then biniplist_add(result,ip);
+ end;
+ closefile(t);
+end;
+
+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;
+ useaf := useaf_preferv4;
+ l := getv6localips;
+ 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}{$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