* add multiip support to dnsasync

[lcore.git] / dnscore.pas

diff --git a/dnscore.pas b/dnscore.pas
index ef4c2f1fd660ee4eac3c8076d5938233aefa3d72..600581dface0910f25ddabd48b44fdfbf31e6880 100755 (executable)
--- a/dnscore.pas
+++ b/dnscore.pas
@@ -163,8 +163,7 @@ function makereversename(const binip:tbinip):string;
 procedure setstate_request_init(const name:string;var state:tdnsstate);\r
 \r
 //set up state for a foward lookup. A family value of AF_INET6 will give only\r
 procedure setstate_request_init(const name:string;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
+//ipv6 results. Any other value will give only ipv4 results\r

 procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);\r
 \r
 procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);\r
 procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);\r
 \r
 procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);\r


@@ -188,14 +187,27 @@ var
   dnsserverlist : tstringlist;\r
 //  currentdnsserverno : integer;\r
 \r
   dnsserverlist : tstringlist;\r
 //  currentdnsserverno : integer;\r
 \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) :string;\r
 function getcurrentsystemnameserver(var id:integer) :string;\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
 \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 linux}{$ifdef ipv6}\r
+function getv6localips:tbiniplist;\r
+procedure initpreferredmode;\r
+\r
+var\r
+  preferredmodeinited:boolean;\r
+\r
+{$endif}{$endif}\r
+\r

 var\r
   failurereason:string;\r
 \r
 var\r
   failurereason:string;\r
 \r


@@ -516,23 +528,7 @@ begin
 \r
     {no cnames found, no items of correct type found}\r
     if state.forwardfamily <> 0 then goto failure;\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
     goto failure;\r
 recursed:\r
     {here it needs recursed lookup}\r


@@ -703,6 +699,65 @@ begin
 \r
 end;\r
 \r
 \r
 end;\r
 \r

+\r
+\r
+{$ifdef linux}{$ifdef ipv6}\r
+function getv6localips:tbiniplist;\r
+var\r
+  t:textfile;\r
+  s,s2:string;\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
+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
+  useaf := useaf_preferv4;\r
+  l := getv6localips;\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}{$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
 {  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